diff options
author | Julien Tanguy <julien.tanguy@jhome.fr> | 2015-10-05 18:35:03 +0200 |
---|---|---|
committer | Julien Tanguy <julien.tanguy@jhome.fr> | 2015-10-05 18:36:55 +0200 |
commit | be278da91e6c97e31c5611721b1bbd593fcd99b9 (patch) | |
tree | a7a0e90bc843a592e88da10fda21e63ddcaea6a8 /src/Crypto/Macaroon/Verifier | |
parent | 27d15c27e396a98f445cdc16b2325d5838e6c734 (diff) | |
download | hmacaroons-be278da91e6c97e31c5611721b1bbd593fcd99b9.tar.gz hmacaroons-be278da91e6c97e31c5611721b1bbd593fcd99b9.tar.zst hmacaroons-be278da91e6c97e31c5611721b1bbd593fcd99b9.zip |
Dedicated VerifierResult
The Maybe (Either ValidationError ()) return type was too cryptic, now there is
a real datatype for it.
The validation part is unchanged and still uses the Maybe Either type
Diffstat (limited to 'src/Crypto/Macaroon/Verifier')
-rw-r--r-- | src/Crypto/Macaroon/Verifier/Internal.hs | 15 |
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 | ||
30 | import Crypto.Macaroon.Internal | 30 | import Crypto.Macaroon.Internal |
31 | 31 | ||
32 | |||
33 | -- | Type representing the result of a validator | ||
34 | data 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 |
61 | verifyCavs :: (Functor m, MonadIO m) | 68 | verifyCavs :: (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) |
65 | verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) | 72 | verifyCavs 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 |