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

5 files changed, 30 insertions, 53 deletions

diff --git a/default.nix b/default.nix
index a392583..bcaf974 100644
--- a/default.nix
+++ b/default.nix
@@ -4,13 +4,13 @@
 }:
 mkDerivation {
   pname = "hmacaroons";
-  version = "0.4.0.0";
+  version = "0.5.0.0";
   src = ./.;
-  buildDepends = [
+  libraryHaskellDepends = [
     attoparsec base base64-bytestring byteable bytestring cereal
     cryptohash deepseq either hex transformers
   ];
-  testDepends = [
+  testHaskellDepends = [
     attoparsec base base64-bytestring byteable bytestring cereal
     cryptohash deepseq either hex QuickCheck tasty tasty-hunit
     tasty-quickcheck transformers
diff --git a/hmacaroons.cabal b/hmacaroons.cabal
index 3f0bd89..81a9c33 100644
--- a/hmacaroons.cabal
+++ b/hmacaroons.cabal
@@ -1,5 +1,5 @@
 name:                hmacaroons
-version:             0.4.0.0
+version:             0.5.0.0
 synopsis:            Haskell implementation of macaroons
 description:
   Hmacaroons is a pure haskell implementation of macaroons. It aims to
diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index 4fc6aff..a3bf5d4 100644
--- a/src/Crypto/Macaroon/Verifier.hs
+++ b/src/Crypto/Macaroon/Verifier.hs
@@ -17,9 +17,8 @@ Portability : portable
 -}
 module Crypto.Macaroon.Verifier (
     verify
+  , VerifierResult(..)
   , ValidationError(ValidatorError, ParseError)
-  -- , (.<), (.<=), (.==), (.>), (.>=)
-  -- , module Data.Attoparsec.ByteString.Char8
 ) where
 
 
@@ -38,55 +37,22 @@ import           Crypto.Macaroon.Verifier.Internal
 
 
 
-
--- (.<) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
--- (.<) = verifyOpBool "Greater or equal" (<) "<"
-
--- (.<=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
--- (.<=) = verifyOpBool "Strictly greater" (<=) "<="
-
--- (.==) :: (MonadIO m, Eq a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
--- (.==) = verifyOpBool "Not equal" (==) "="
-
--- (.>) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
--- (.>) = verifyOpBool "Less or equal" (>) ">"
-
--- (.>=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
--- (.>=) = verifyOpBool "Strictly less" (>=) ">="
-
 -- | Verify a Macaroon's signature and caveats, given the corresponding Secret
 -- and verifiers.
 --
 -- A verifier is a function of type
--- @'MonadIO' m => 'Caveat' -> m ('Maybe' ('Either' 'ValidatorError' 'Caveat'))@.
+-- @'MonadIO' m => 'Caveat' -> m VerifierResult@.
 --
 -- It should return:
 --
--- * 'Nothing' if the caveat is not related to the verifier
+-- * 'Unrelated' if the caveat is not related to the verifier
 -- (for instance a time verifier is given an action caveat);
--- * 'Just' ('Left' ('ParseError' reason)) if the verifier  is related to the
+-- * 'Refused' ('ParseError' reason) if the verifier  is related to the
 -- caveat, but failed to parse it completely;
--- * 'Just' ('Left' ('ValidatorError' reason)) if the verifier is related to the
+-- * 'Refused' ('ValidatorError' reason) if the verifier is related to the
 -- caveat, parsed it and invalidated it;
--- * 'Just' ('Right' '()') if the verifier has successfully verified the
+-- * 'Verified' if the verifier has successfully verified the
 -- given caveat
-verify :: (Functor m, MonadIO m) => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon)
+verify :: (Functor m, MonadIO m) => Secret -> [Caveat -> m VerifierResult] -> Macaroon -> m (Either ValidationError Macaroon)
 verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers)
 
-
--- verifyOpBool :: MonadIO m => String -> Parser a -> (a -> a -> Bool) -> BS.ByteString -> Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
--- verifyOpBool err p f op k val = verifyParser k valueParser $ \s -> do
---     expected <- val
---     return $ bool (Left $ ValidatorError err) (Right Win) =<< f expected <$> mapLeft ParseError (parseOnly p s)
---   where
---     valueParser = string op *> skipSpace *> takeByteString
-
--- verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat))
--- verifyParser k p f c = case parseOnly keyParser . cid $ c of
---     Left _ -> return Nothing
---     Right bs -> Just <$> case parseOnly p bs of
---       Left err -> return $ Left $ ParseError err
---       Right a -> fmap (const c) <$> f a
---   where
---     keyParser = string k *> skipSpace *> takeByteString
-
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
diff --git a/test/Crypto/Macaroon/Verifier/Internal/Tests.hs b/test/Crypto/Macaroon/Verifier/Internal/Tests.hs
index 826b631..59980de 100644
--- a/test/Crypto/Macaroon/Verifier/Internal/Tests.hs
+++ b/test/Crypto/Macaroon/Verifier/Internal/Tests.hs
@@ -45,19 +45,19 @@ m = create sec key loc
 m2 :: Macaroon
 m2 = addFirstPartyCaveat "test = caveat" m
 
-vtest :: Caveat -> IO (Maybe (Either ValidationError ()))
+vtest :: Caveat -> IO VerifierResult
 vtest c = return $ if "test" `BS.isPrefixOf` cid c then
-    Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "test = caveat" == cid c
-    else Nothing
+    bool (Refused (ValidatorError "Failed")) Verified $ "test = caveat" == cid c
+    else Unrelated
 
 
 m3 :: Macaroon
 m3 = addFirstPartyCaveat "value = 42" m2
 
-vval :: Caveat -> IO (Maybe (Either ValidationError ()))
+vval :: Caveat -> IO VerifierResult
 vval c = return $ if "value" `BS.isPrefixOf` cid c then
-    Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "value = 42" == cid c
-    else Nothing
+    bool (Refused (ValidatorError "Failed")) Verified $ "value = 42" == cid c
+    else Unrelated
 
 
 {-