aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--src/Crypto/Macaroon/Verifier.hs47
-rw-r--r--test/Crypto/Macaroon/Verifier/Tests.hs32
2 files changed, 69 insertions, 10 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 @@
1{-# LANGUAGE OverloadedStrings #-} 1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RankNTypes #-}
2{-| 3{-|
3Module : Crypto.Macaroon.Verifier 4Module : Crypto.Macaroon.Verifier
4Copyright : (c) 2015 Julien Tanguy 5Copyright : (c) 2015 Julien Tanguy
@@ -11,7 +12,14 @@ Portability : portable
11 12
12 13
13-} 14-}
14module Crypto.Macaroon.Verifier where 15module Crypto.Macaroon.Verifier (
16 Verified(..)
17 , verifySig
18 , verifyExact
19 , verifyCavs
20 -- , module Data.Attoparsec.ByteString
21 , module Data.Attoparsec.ByteString.Char8
22) where
15 23
16 24
17import Crypto.Hash 25import Crypto.Hash
@@ -19,16 +27,47 @@ import Data.Bool
19import qualified Data.ByteString as BS 27import qualified Data.ByteString as BS
20import Data.Byteable 28import Data.Byteable
21import Data.Foldable 29import Data.Foldable
30import Data.Maybe
31import Data.Attoparsec.ByteString
32import Data.Attoparsec.ByteString.Char8
22 33
23import Crypto.Macaroon.Internal 34import Crypto.Macaroon.Internal
24 35
25 36
26-- | Opaque datatype for now. Might need more explicit errors 37-- | Opaque datatype for now. Might need more explicit errors
27data VResult = VSuccess | VFailure deriving (Show,Eq) 38data Verified = Ok | Failed deriving (Show,Eq)
28 39
29verifySig :: Key -> Macaroon -> VResult 40instance Monoid Verified where
30verifySig k m = bool VFailure VSuccess $ 41 mempty = Ok
42 mappend Ok Ok = Ok
43 mappend _ _ = Failed
44
45
46type CaveatVerifier = Caveat -> Maybe Verified
47
48verifySig :: Key -> Macaroon -> Verified
49verifySig k m = bool Failed Ok $
31 signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m) 50 signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m)
32 where 51 where
33 hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) 52 hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256)
34 derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) 53 derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256)
54
55verifyCavs :: [Caveat -> Maybe Verified] -> Macaroon -> Verified
56verifyCavs verifiers m = mconcat $ map (\c -> mconcat . catMaybes $ map ($ c) verifiers) (caveats m)
57
58verifyExact :: (Show a, Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified
59verifyExact key expected parser cav = if key `BS.isPrefixOf` cid cav then
60 case parseOnly kvparser (cid cav) of
61 Right v -> verify <$> Just v
62 Left _ -> Just Failed
63 else Nothing
64 where
65 kvparser = do
66 key <- string key
67 skipSpace
68 string "="
69 skipSpace
70 parser
71
72 -- *> skipSpace *> string "=" *> skipSpace *> parser <* endOfInput
73 verify a = bool Failed Ok (a == expected)
diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs
index f87f192..37d0230 100644
--- a/test/Crypto/Macaroon/Verifier/Tests.hs
+++ b/test/Crypto/Macaroon/Verifier/Tests.hs
@@ -24,6 +24,7 @@ import Crypto.Macaroon.Instances
24 24
25tests :: TestTree 25tests :: TestTree
26tests = testGroup "Crypto.Macaroon.Verifier" [ sigs 26tests = testGroup "Crypto.Macaroon.Verifier" [ sigs
27 , exactCavs
27 ] 28 ]
28 29
29{- 30{-
@@ -41,7 +42,14 @@ m2 :: Macaroon
41m2 = addFirstPartyCaveat "test = caveat" m 42m2 = addFirstPartyCaveat "test = caveat" m
42 43
43m3 :: Macaroon 44m3 :: Macaroon
44m3 = addFirstPartyCaveat "test = acaveat" m 45m3 = addFirstPartyCaveat "value = 42" m2
46
47exVerifiers = [ verifyExact "test" "caveat" (many' letter_ascii)
48 , verifyExact "value" 42 decimal
49 ]
50exVerifiers' = [ verifyExact "test" "caveat" (many' letter_ascii)
51 , verifyExact "value" 43 decimal
52 ]
45 53
46{- 54{-
47 - Tests 55 - Tests
@@ -54,14 +62,26 @@ sigs = testGroup "Signatures" [ basic
54basic = testGroup "Basic Macaroon" [ none , sigQC ] 62basic = testGroup "Basic Macaroon" [ none , sigQC ]
55 63
56none = testCase "No caveat" $ 64none = testCase "No caveat" $
57 VSuccess @=? verifySig sec m 65 Ok @=? verifySig sec m
58 66
59sigQC = testProperty "Random" $ 67sigQC = testProperty "Random" $
60 \sm -> verifySig (secret sm) (macaroon sm) == VSuccess 68 \sm -> verifySig (secret sm) (macaroon sm) == Ok
61 69
62one = testCase "Macaroon with one caveat" $ 70one = testCase "Macaroon with one caveat" $
63 VSuccess @=? verifySig sec m2 71 Ok @=? verifySig sec m2
64 72
65two = testCase "Macaroon with two caveats" $ 73two = testCase "Macaroon with two caveats" $
66 VSuccess @=? verifySig sec m3 74 Ok @=? verifySig sec m3
67 75
76exactCavs = testGroup "Exact Caveats" [ zero', one', two' , one'', two'']
77
78zero' = testCase "Zero caveat win" $
79 Ok @=? verifyCavs exVerifiers m
80one' = testCase "One caveat win" $
81 Ok @=? verifyCavs exVerifiers m2
82one'' = testCase "Ignoring non-relevant" $
83 Ok @=? verifyCavs exVerifiers' m2
84two' = testCase "Two caveat win" $
85 Ok @=? verifyCavs exVerifiers m3
86two'' = testCase "Two caveat fail" $
87 Failed @=? verifyCavs exVerifiers' m3