aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Crypto/Macaroon/Verifier/Internal.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Crypto/Macaroon/Verifier/Internal.hs')
-rw-r--r--src/Crypto/Macaroon/Verifier/Internal.hs30
1 files changed, 17 insertions, 13 deletions
diff --git a/src/Crypto/Macaroon/Verifier/Internal.hs b/src/Crypto/Macaroon/Verifier/Internal.hs
index b65b62d..2af55d3 100644
--- a/src/Crypto/Macaroon/Verifier/Internal.hs
+++ b/src/Crypto/Macaroon/Verifier/Internal.hs
@@ -1,5 +1,5 @@
1{-# LANGUAGE OverloadedStrings #-} 1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RankNTypes #-} 2{-# LANGUAGE RankNTypes #-}
3{-| 3{-|
4Module : Crypto.Macaroon.Verifier.Internal 4Module : Crypto.Macaroon.Verifier.Internal
5Copyright : (c) 2015 Julien Tanguy 5Copyright : (c) 2015 Julien Tanguy
@@ -19,22 +19,26 @@ import Control.Monad.IO.Class
19import Crypto.Hash 19import Crypto.Hash
20import Data.Bool 20import Data.Bool
21import Data.Byteable 21import Data.Byteable
22import qualified Data.ByteString as BS 22import qualified Data.ByteString as BS
23import Data.Either 23import Data.Either
24import Data.Either.Validation 24import Data.Either.Validation
25import Data.Foldable 25import Data.Foldable
26import Data.Maybe 26import Data.Maybe
27import Data.Monoid
27 28
28import Crypto.Macaroon.Internal 29import Crypto.Macaroon.Internal
29 30
30data Win = Win 31-- | Type representing different validation errors.
31 32-- Only 'ParseError' and 'ValidatorError' are exported, 'SigMismatch' and
32data ValidationError = SigMismatch 33-- 'NoVerifier' are used internally and should not be used by the user
33 | NoVerifier 34data ValidationError = SigMismatch -- ^ Signatures do not match
34 | ParseError String 35 | NoVerifier -- ^ No verifier can handle a given caveat
35 | ValidatorError String 36 | ParseError String -- ^ A verifier had a parse error
36 deriving Show 37 | ValidatorError String -- ^ A verifier failed
38 deriving (Show,Eq)
37 39
40-- | The 'Monoid' instance is written so 'SigMismatch' is an annihilator,
41-- and 'NoVerifier' is the identity element
38instance Monoid ValidationError where 42instance Monoid ValidationError where
39 mempty = NoVerifier 43 mempty = NoVerifier
40 NoVerifier `mappend` e = e 44 NoVerifier `mappend` e = e
@@ -52,9 +56,9 @@ verifySig k m = bool (Left SigMismatch) (Right m) $
52 hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) 56 hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256)
53 derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) 57 derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256)
54 58
55 59-- | Given a list of verifiers, verify each caveat of the given macaroon
56verifyCavs :: MonadIO m 60verifyCavs :: MonadIO m
57 => [Caveat -> m (Maybe (Either ValidationError Caveat))] 61 => [Caveat -> m (Maybe (Either ValidationError ()))]
58 -> Macaroon 62 -> Macaroon
59 -> m (Either ValidationError Macaroon) 63 -> m (Either ValidationError Macaroon)
60verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) 64verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m)
@@ -65,7 +69,7 @@ verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m)
65 - starting value for the foldM. We are guaranteed to have a `Just something` 69 - starting value for the foldM. We are guaranteed to have a `Just something`
66 - from it. 70 - from it.
67 -} 71 -}
68 validateCaveat c = fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers 72 validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers
69 -- defErr :: Caveat -> Maybe (Validation String Caveat) 73 -- defErr :: Caveat -> Maybe (Validation String Caveat)
70 defErr c = Just $ Failure NoVerifier 74 defErr c = Just $ Failure NoVerifier
71 -- gatherEithers :: [Validation String Caveat] -> Either String Caveat 75 -- gatherEithers :: [Validation String Caveat] -> Either String Caveat