1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE RankNTypes #-}
4 Module : Crypto.Macaroon.Verifier
5 Copyright : (c) 2015 Julien Tanguy
8 Maintainer : julien.tanguy@jhome.fr
9 Stability : experimental
10 Portability : portable
15 module Crypto.Macaroon.Verifier (
23 , module Data.Attoparsec.ByteString.Char8
30 import qualified Data.ByteString as BS
35 import Data.Traversable
36 import Data.Attoparsec.ByteString
37 import Data.Attoparsec.ByteString.Char8
39 import Crypto.Macaroon.Internal
42 -- | Opaque datatype for now. Might need more explicit errors
43 data Verified = Ok | Failed deriving (Show,Eq)
45 instance Monoid Verified where
51 data CaveatVerifier = CV { vFun :: Caveat -> Maybe Verified , helpText :: String}
53 instance Eq CaveatVerifier where
54 (==) = (==) `on` helpText
56 instance Show CaveatVerifier where
59 (<???>) :: (Caveat -> Maybe Verified) -> String -> CaveatVerifier
62 verifySig :: Key -> Macaroon -> Verified
63 verifySig k m = bool Failed Ok $
64 signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m)
66 hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256)
67 derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256)
69 verifyMacaroon :: Key -> [CaveatVerifier] -> Macaroon -> Verified
70 verifyMacaroon secret verifiers m = verifySig secret m `mappend` verifyCavs verifiers m
73 verifyCavs :: [CaveatVerifier] -> Macaroon -> Verified
74 verifyCavs verifiers m = foldMap (\c -> fromMaybe Failed $ foldMap (($ c) . vFun) verifiers) (caveats m)
76 verifyExact :: (Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified
77 verifyExact k expected = verifyFun k (expected ==)
79 verifyFun :: Key -> (a -> Bool) -> Parser a -> Caveat -> Maybe Verified
80 verifyFun key f parser cav = if key `BS.isPrefixOf` cid cav then
81 case parseOnly kvparser (cid cav) of
82 Right v -> (bool Failed Ok . f) <$> Just v