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.hs15
1 files changed, 13 insertions, 2 deletions
diff --git a/src/Crypto/Macaroon/Verifier/Internal.hs b/src/Crypto/Macaroon/Verifier/Internal.hs
index b3ad7f2..6228608 100644
--- a/src/Crypto/Macaroon/Verifier/Internal.hs
+++ b/src/Crypto/Macaroon/Verifier/Internal.hs
@@ -29,6 +29,13 @@ import Data.Monoid
29 29
30import Crypto.Macaroon.Internal 30import Crypto.Macaroon.Internal
31 31
32
33-- | Type representing the result of a validator
34data VerifierResult = Verified -- ^ The caveat is correctly parsed and verified
35 | Refused ValidationError -- ^ The caveat is refused (Either a parse error or a validation error
36 | Unrelated -- ^ The given verifier does not verify the caveat
37 deriving (Show, Eq)
38
32-- | Type representing different validation errors. 39-- | Type representing different validation errors.
33-- Only 'ParseError' and 'ValidatorError' are exported, @SigMismatch@ and 40-- Only 'ParseError' and 'ValidatorError' are exported, @SigMismatch@ and
34-- @NoVerifier@ are used internally and should not be used by the user 41-- @NoVerifier@ are used internally and should not be used by the user
@@ -59,7 +66,7 @@ verifySig k m = bool (Left SigMismatch) (Right m) $
59 66
60-- | Given a list of verifiers, verify each caveat of the given macaroon 67-- | Given a list of verifiers, verify each caveat of the given macaroon
61verifyCavs :: (Functor m, MonadIO m) 68verifyCavs :: (Functor m, MonadIO m)
62 => [Caveat -> m (Maybe (Either ValidationError ()))] 69 => [Caveat -> m VerifierResult]
63 -> Macaroon 70 -> Macaroon
64 -> m (Either ValidationError Macaroon) 71 -> m (Either ValidationError Macaroon)
65verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) 72verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m)
@@ -70,7 +77,11 @@ verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m)
70 - starting value for the foldM. We are guaranteed to have a `Just something` 77 - starting value for the foldM. We are guaranteed to have a `Just something`
71 - from it. 78 - from it.
72 -} 79 -}
73 validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers 80 validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation . vResult2MaybeEither <$> v c) (defErr c) verifiers
81 -- vResult2MaybeEither :: VerifierResult -> Maybe (Either ValidationError ())
82 vResult2MaybeEither Unrelated = Nothing
83 vResult2MaybeEither Verified = Just (Right ())
84 vResult2MaybeEither (Refused e)= Just (Left e)
74 -- defErr :: Caveat -> Maybe (Validation String Caveat) 85 -- defErr :: Caveat -> Maybe (Validation String Caveat)
75 defErr c = Just $ Failure NoVerifier 86 defErr c = Just $ Failure NoVerifier
76 -- gatherEithers :: [Validation String Caveat] -> Either String Caveat 87 -- gatherEithers :: [Validation String Caveat] -> Either String Caveat