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.hs | 48 ++++++-----------------------------------
 1 file changed, 7 insertions(+), 41 deletions(-)

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

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
-
-- 
cgit v1.2.3