Add basic exact caveat verifiers

Need more tests

Touching #2 Verify first party caveats

1 files changed, 43 insertions, 4 deletions

diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index e257f5f..cb64c9d 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,7 +12,14 @@ Portability : portable
 
 
 -}
-module Crypto.Macaroon.Verifier where
+module Crypto.Macaroon.Verifier (
+    Verified(..)
+  , verifySig
+  , verifyExact
+  , verifyCavs
+  -- , module Data.Attoparsec.ByteString
+  , module Data.Attoparsec.ByteString.Char8
+) where
 
 
 import           Crypto.Hash
@@ -19,16 +27,47 @@ import           Data.Bool
 import qualified Data.ByteString            as BS
 import           Data.Byteable
 import           Data.Foldable
+import           Data.Maybe
+import Data.Attoparsec.ByteString
+import Data.Attoparsec.ByteString.Char8
 
 import           Crypto.Macaroon.Internal
 
 
 -- | Opaque datatype for now. Might need more explicit errors
-data VResult = VSuccess | VFailure deriving (Show,Eq)
+data Verified = Ok | Failed deriving (Show,Eq)
 
-verifySig :: Key -> Macaroon -> VResult
-verifySig k m = bool VFailure VSuccess $
+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 $
       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 :: (Show a, Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified
+verifyExact key expected parser cav = if key `BS.isPrefixOf` cid cav then
+        case parseOnly kvparser (cid cav) of
+          Right v -> verify <$> Just v
+          Left _ -> Just Failed
+        else Nothing
+  where
+    kvparser = do
+      key <- string key
+      skipSpace
+      string "="
+      skipSpace
+      parser
+
+      -- *> skipSpace *> string "=" *> skipSpace *> parser <* endOfInput
+    verify a = bool Failed Ok (a == expected)