X-Git-Url: https://git.immae.eu/?a=blobdiff_plain;ds=sidebyside;f=src%2FCrypto%2FMacaroon%2FVerifier.hs;h=713a9714359ea947630fe2d8ebe5c95a15894d87;hb=c830f7c2cf925ce340f4097d76ea2a3bc94cb4a6;hp=012d156454f243f753c14547b4e908981fe3d61d;hpb=857f2f3ba8ba2de9ab65ea3c66eafb718fe4e1a6;p=github%2Ffretlink%2Fhmacaroons.git

diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index 012d156..713a971 100644
--- a/src/Crypto/Macaroon/Verifier.hs
+++ b/src/Crypto/Macaroon/Verifier.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RankNTypes        #-}
 {-|
 Module      : Crypto.Macaroon.Verifier
 Copyright   : (c) 2015 Julien Tanguy
@@ -13,62 +13,50 @@ Portability : portable
 
 -}
 module Crypto.Macaroon.Verifier (
-    Verified(..)
+    Verifier
+  , verifyMacaroon
   , verifySig
-  , verifyExact
-  , verifyFun
-  , verifyCavs
-  -- , module Data.Attoparsec.ByteString
+  -- , 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.Attoparsec.ByteString
-import Data.Attoparsec.ByteString.Char8
+import           Data.Traversable
 
 import           Crypto.Macaroon.Internal
 
+type Verifier = Caveat -> Maybe (Either String Caveat)
 
--- | Opaque datatype for now. Might need more explicit errors
-data Verified = Ok | Failed deriving (Show,Eq)
-
-instance Monoid Verified where
-  mempty = Ok
-  mappend Ok Ok = Ok
-  mappend _ _ = Failed
-
-
-type CaveatVerifier = Caveat -> Maybe Verified
-
-verifySig :: Key -> Macaroon -> Verified
-verifySig k m = bool Failed Ok $
+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)
 
-verifyCavs :: [Caveat -> Maybe Verified] -> Macaroon -> Verified
-verifyCavs verifiers m = mconcat $ map (\c -> mconcat . catMaybes $ map ($ c) verifiers) (caveats m)
-
-verifyExact :: (Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified
-verifyExact k expected = verifyFun k (expected ==)
+verifyMacaroon :: Key -> [Verifier] -> Macaroon -> Either String Macaroon
+verifyMacaroon secret verifiers m = verifySig secret m >>= verifyCavs verifiers
 
-verifyFun :: Key -> (a -> Bool) -> Parser a -> Caveat -> Maybe Verified
-verifyFun key f parser cav = if key `BS.isPrefixOf` cid cav then
-        case parseOnly kvparser (cid cav) of
-          Right v -> (bool Failed Ok . f) <$> Just v
-          Left _ -> Just Failed
-        else Nothing
+verifyCavs :: [Verifier] -> Macaroon -> Either String Macaroon
+verifyCavs verifiers m = case partitionEithers verifiedCaveats of
+    ([],_) -> Right m
+    (errs,_) -> Left (mconcat errs)
   where
-    kvparser = do
-      key <- string key
-      skipSpace
-      string "="
-      skipSpace
-      parser <* endOfInput
+    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