From be278da91e6c97e31c5611721b1bbd593fcd99b9 Mon Sep 17 00:00:00 2001 From: Julien Tanguy 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 +++++--------------------------- src/Crypto/Macaroon/Verifier/Internal.hs | 15 ++++++++-- 2 files changed, 20 insertions(+), 43 deletions(-) (limited to 'src') 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 -- cgit v1.2.3