Rewrite Verifier with Validation

[github/fretlink/hmacaroons.git] / src / Crypto / Macaroon / Verifier.hs

diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index e257f5f71d4a5edf098c8425d4f788ae19d93b5d..713a9714359ea947630fe2d8ebe5c95a15894d87 100644 (file)
--- 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