From be278da91e6c97e31c5611721b1bbd593fcd99b9 Mon Sep 17 00:00:00 2001 From: Julien Tanguy Date: Mon, 5 Oct 2015 18:35:03 +0200 Subject: [PATCH] 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 --- default.nix | 6 +-- hmacaroons.cabal | 2 +- src/Crypto/Macaroon/Verifier.hs | 48 +++---------------- src/Crypto/Macaroon/Verifier/Internal.hs | 15 +++++- .../Macaroon/Verifier/Internal/Tests.hs | 12 ++--- 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 {- -- 2.41.0