From be278da91e6c97e31c5611721b1bbd593fcd99b9 Mon Sep 17 00:00:00 2001
From: Julien Tanguy <julien.tanguy@jhome.fr>
Date: Mon, 5 Oct 2015 18:35:03 +0200
Subject: 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
---
 src/Crypto/Macaroon/Verifier/Internal.hs | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

(limited to 'src/Crypto/Macaroon/Verifier')

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
 
 import           Crypto.Macaroon.Internal
 
+
+-- | Type representing the result of a validator
+data VerifierResult = Verified -- ^ The caveat is correctly parsed and verified
+                    | Refused ValidationError -- ^ The caveat is refused (Either a parse error or a validation error
+                    | Unrelated -- ^ The given verifier does not verify the caveat
+                    deriving (Show, Eq)
+
 -- | Type representing different validation errors.
 -- Only 'ParseError' and 'ValidatorError' are exported, @SigMismatch@ and
 -- @NoVerifier@ are used internally and should not be used by the user
@@ -59,7 +66,7 @@ verifySig k m = bool (Left SigMismatch) (Right m) $
 
 -- | Given a list of verifiers, verify each caveat of the given macaroon
 verifyCavs :: (Functor m, MonadIO m)
-           => [Caveat -> m (Maybe (Either ValidationError ()))]
+           => [Caveat -> m VerifierResult]
            -> Macaroon
            -> m (Either ValidationError Macaroon)
 verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m)
@@ -70,7 +77,11 @@ verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m)
      - starting value for the foldM. We are guaranteed to have a `Just something`
      - from it.
      -}
-    validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers
+    validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation . vResult2MaybeEither <$> v c) (defErr c) verifiers
+    -- vResult2MaybeEither :: VerifierResult -> Maybe (Either ValidationError ())
+    vResult2MaybeEither Unrelated = Nothing
+    vResult2MaybeEither Verified = Just (Right ())
+    vResult2MaybeEither (Refused e)= Just (Left e)
     -- defErr :: Caveat -> Maybe (Validation String Caveat)
     defErr c = Just $ Failure NoVerifier
     -- gatherEithers :: [Validation String Caveat] -> Either String Caveat
-- 
cgit v1.2.3