X-Git-Url: https://git.immae.eu/?a=blobdiff_plain;f=src%2FCrypto%2FMacaroon%2FVerifier.hs;h=713a9714359ea947630fe2d8ebe5c95a15894d87;hb=c830f7c2cf925ce340f4097d76ea2a3bc94cb4a6;hp=e257f5f71d4a5edf098c8425d4f788ae19d93b5d;hpb=5d1b7d51854d355bf5b6438c1a96ce9e743fd810;p=github%2Ffretlink%2Fhmacaroons.git diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs index e257f5f..713a971 100644 --- a/src/Crypto/Macaroon/Verifier.hs +++ b/src/Crypto/Macaroon/Verifier.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-| Module : Crypto.Macaroon.Verifier Copyright : (c) 2015 Julien Tanguy @@ -11,24 +12,51 @@ Portability : portable -} -module Crypto.Macaroon.Verifier where +module Crypto.Macaroon.Verifier ( + Verifier + , verifyMacaroon + , verifySig + -- , verifyExact + -- , verifyFun + , module Data.Attoparsec.ByteString.Char8 + , verifyCavs +) where import Crypto.Hash +import Data.Attoparsec.ByteString +import Data.Attoparsec.ByteString.Char8 import Data.Bool -import qualified Data.ByteString as BS import Data.Byteable +import qualified Data.ByteString as BS +import Data.Either +import Data.Either.Validation import Data.Foldable +import Data.Function +import Data.Maybe +import Data.Traversable import Crypto.Macaroon.Internal +type Verifier = Caveat -> Maybe (Either String Caveat) --- | Opaque datatype for now. Might need more explicit errors -data VResult = VSuccess | VFailure deriving (Show,Eq) - -verifySig :: Key -> Macaroon -> VResult -verifySig k m = bool VFailure VSuccess $ +verifySig :: Key -> Macaroon -> Either String Macaroon +verifySig k m = bool (Left "Signatures do not match") (Right m) $ signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m) where hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) + +verifyMacaroon :: Key -> [Verifier] -> Macaroon -> Either String Macaroon +verifyMacaroon secret verifiers m = verifySig secret m >>= verifyCavs verifiers + +verifyCavs :: [Verifier] -> Macaroon -> Either String Macaroon +verifyCavs verifiers m = case partitionEithers verifiedCaveats of + ([],_) -> Right m + (errs,_) -> Left (mconcat errs) + where + verifiedCaveats = map (\c -> defaultFail c $ foldMap (fmap eitherToValidation . ($c)) verifiers) $ caveats m + defaultFail c = maybe (Left ("No validation for this caveat: " ++ show c)) validationToEither + + +-- TODO: define API