aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Crypto
diff options
context:
space:
mode:
Diffstat (limited to 'src/Crypto')
-rw-r--r--src/Crypto/Macaroon/Verifier.hs73
1 files changed, 22 insertions, 51 deletions
diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index 02cb448..713a971 100644
--- a/src/Crypto/Macaroon/Verifier.hs
+++ b/src/Crypto/Macaroon/Verifier.hs
@@ -1,5 +1,5 @@
1{-# LANGUAGE OverloadedStrings #-} 1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RankNTypes #-} 2{-# LANGUAGE RankNTypes #-}
3{-| 3{-|
4Module : Crypto.Macaroon.Verifier 4Module : Crypto.Macaroon.Verifier
5Copyright : (c) 2015 Julien Tanguy 5Copyright : (c) 2015 Julien Tanguy
@@ -13,79 +13,50 @@ Portability : portable
13 13
14-} 14-}
15module Crypto.Macaroon.Verifier ( 15module Crypto.Macaroon.Verifier (
16 Verified(..) 16 Verifier
17 , CaveatVerifier
18 , (<???>)
19 , verifyMacaroon 17 , verifyMacaroon
20 , verifySig 18 , verifySig
21 , verifyExact 19 -- , verifyExact
22 , verifyFun 20 -- , verifyFun
23 , module Data.Attoparsec.ByteString.Char8 21 , module Data.Attoparsec.ByteString.Char8
24 , verifyCavs 22 , verifyCavs
25) where 23) where
26 24
27 25
28import Crypto.Hash 26import Crypto.Hash
27import Data.Attoparsec.ByteString
28import Data.Attoparsec.ByteString.Char8
29import Data.Bool 29import Data.Bool
30import qualified Data.ByteString as BS
31import Data.Byteable 30import Data.Byteable
31import qualified Data.ByteString as BS
32import Data.Either
33import Data.Either.Validation
32import Data.Foldable 34import Data.Foldable
33import Data.Function 35import Data.Function
34import Data.Maybe 36import Data.Maybe
35import Data.Traversable 37import Data.Traversable
36import Data.Attoparsec.ByteString
37import Data.Attoparsec.ByteString.Char8
38 38
39import Crypto.Macaroon.Internal 39import Crypto.Macaroon.Internal
40 40
41type Verifier = Caveat -> Maybe (Either String Caveat)
41 42
42-- | Opaque datatype for now. Might need more explicit errors 43verifySig :: Key -> Macaroon -> Either String Macaroon
43data Verified = Ok | Failed deriving (Show,Eq) 44verifySig k m = bool (Left "Signatures do not match") (Right m) $
44
45instance Monoid Verified where
46 mempty = Ok
47 mappend Ok Ok = Ok
48 mappend _ _ = Failed
49
50
51data CaveatVerifier = CV { vFun :: Caveat -> Maybe Verified , helpText :: String}
52
53instance Eq CaveatVerifier where
54 (==) = (==) `on` helpText
55
56instance Show CaveatVerifier where
57 show = helpText
58
59(<???>) :: (Caveat -> Maybe Verified) -> String -> CaveatVerifier
60f <???> t = CV f t
61
62verifySig :: Key -> Macaroon -> Verified
63verifySig k m = bool Failed Ok $
64 signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m) 45 signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m)
65 where 46 where
66 hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) 47 hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256)
67 derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) 48 derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256)
68 49
69verifyMacaroon :: Key -> [CaveatVerifier] -> Macaroon -> Verified 50verifyMacaroon :: Key -> [Verifier] -> Macaroon -> Either String Macaroon
70verifyMacaroon secret verifiers m = verifySig secret m `mappend` verifyCavs verifiers m 51verifyMacaroon secret verifiers m = verifySig secret m >>= verifyCavs verifiers
71
72 52
73verifyCavs :: [CaveatVerifier] -> Macaroon -> Verified 53verifyCavs :: [Verifier] -> Macaroon -> Either String Macaroon
74verifyCavs verifiers m = foldMap (\c -> fromMaybe Failed $ foldMap (($ c) . vFun) verifiers) (caveats m) 54verifyCavs verifiers m = case partitionEithers verifiedCaveats of
55 ([],_) -> Right m
56 (errs,_) -> Left (mconcat errs)
57 where
58 verifiedCaveats = map (\c -> defaultFail c $ foldMap (fmap eitherToValidation . ($c)) verifiers) $ caveats m
59 defaultFail c = maybe (Left ("No validation for this caveat: " ++ show c)) validationToEither
75 60
76verifyExact :: (Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified
77verifyExact k expected = verifyFun k (expected ==)
78 61
79verifyFun :: Key -> (a -> Bool) -> Parser a -> Caveat -> Maybe Verified 62-- TODO: define API
80verifyFun key f parser cav = if key `BS.isPrefixOf` cid cav then
81 case parseOnly kvparser (cid cav) of
82 Right v -> (bool Failed Ok . f) <$> Just v
83 Left _ -> Just Failed
84 else Nothing
85 where
86 kvparser = do
87 key <- string key
88 skipSpace
89 string "="
90 skipSpace
91 parser <* endOfInput