diff options
author | Julien Tanguy <julien.tanguy@jhome.fr> | 2015-10-05 18:35:03 +0200 |
---|---|---|
committer | Julien Tanguy <julien.tanguy@jhome.fr> | 2015-10-05 18:36:55 +0200 |
commit | be278da91e6c97e31c5611721b1bbd593fcd99b9 (patch) | |
tree | a7a0e90bc843a592e88da10fda21e63ddcaea6a8 | |
parent | 27d15c27e396a98f445cdc16b2325d5838e6c734 (diff) | |
download | hmacaroons-be278da91e6c97e31c5611721b1bbd593fcd99b9.tar.gz hmacaroons-be278da91e6c97e31c5611721b1bbd593fcd99b9.tar.zst hmacaroons-be278da91e6c97e31c5611721b1bbd593fcd99b9.zip |
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
-rw-r--r-- | default.nix | 6 | ||||
-rw-r--r-- | hmacaroons.cabal | 2 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Verifier.hs | 48 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Verifier/Internal.hs | 15 | ||||
-rw-r--r-- | test/Crypto/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 @@ | |||
4 | }: | 4 | }: |
5 | mkDerivation { | 5 | mkDerivation { |
6 | pname = "hmacaroons"; | 6 | pname = "hmacaroons"; |
7 | version = "0.4.0.0"; | 7 | version = "0.5.0.0"; |
8 | src = ./.; | 8 | src = ./.; |
9 | buildDepends = [ | 9 | libraryHaskellDepends = [ |
10 | attoparsec base base64-bytestring byteable bytestring cereal | 10 | attoparsec base base64-bytestring byteable bytestring cereal |
11 | cryptohash deepseq either hex transformers | 11 | cryptohash deepseq either hex transformers |
12 | ]; | 12 | ]; |
13 | testDepends = [ | 13 | testHaskellDepends = [ |
14 | attoparsec base base64-bytestring byteable bytestring cereal | 14 | attoparsec base base64-bytestring byteable bytestring cereal |
15 | cryptohash deepseq either hex QuickCheck tasty tasty-hunit | 15 | cryptohash deepseq either hex QuickCheck tasty tasty-hunit |
16 | tasty-quickcheck transformers | 16 | 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 @@ | |||
1 | name: hmacaroons | 1 | name: hmacaroons |
2 | version: 0.4.0.0 | 2 | version: 0.5.0.0 |
3 | synopsis: Haskell implementation of macaroons | 3 | synopsis: Haskell implementation of macaroons |
4 | description: | 4 | description: |
5 | Hmacaroons is a pure haskell implementation of macaroons. It aims to | 5 | 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 | |||
17 | -} | 17 | -} |
18 | module Crypto.Macaroon.Verifier ( | 18 | module Crypto.Macaroon.Verifier ( |
19 | verify | 19 | verify |
20 | , VerifierResult(..) | ||
20 | , ValidationError(ValidatorError, ParseError) | 21 | , ValidationError(ValidatorError, ParseError) |
21 | -- , (.<), (.<=), (.==), (.>), (.>=) | ||
22 | -- , module Data.Attoparsec.ByteString.Char8 | ||
23 | ) where | 22 | ) where |
24 | 23 | ||
25 | 24 | ||
@@ -38,55 +37,22 @@ import Crypto.Macaroon.Verifier.Internal | |||
38 | 37 | ||
39 | 38 | ||
40 | 39 | ||
41 | |||
42 | -- (.<) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
43 | -- (.<) = verifyOpBool "Greater or equal" (<) "<" | ||
44 | |||
45 | -- (.<=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
46 | -- (.<=) = verifyOpBool "Strictly greater" (<=) "<=" | ||
47 | |||
48 | -- (.==) :: (MonadIO m, Eq a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
49 | -- (.==) = verifyOpBool "Not equal" (==) "=" | ||
50 | |||
51 | -- (.>) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
52 | -- (.>) = verifyOpBool "Less or equal" (>) ">" | ||
53 | |||
54 | -- (.>=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
55 | -- (.>=) = verifyOpBool "Strictly less" (>=) ">=" | ||
56 | |||
57 | -- | Verify a Macaroon's signature and caveats, given the corresponding Secret | 40 | -- | Verify a Macaroon's signature and caveats, given the corresponding Secret |
58 | -- and verifiers. | 41 | -- and verifiers. |
59 | -- | 42 | -- |
60 | -- A verifier is a function of type | 43 | -- A verifier is a function of type |
61 | -- @'MonadIO' m => 'Caveat' -> m ('Maybe' ('Either' 'ValidatorError' 'Caveat'))@. | 44 | -- @'MonadIO' m => 'Caveat' -> m VerifierResult@. |
62 | -- | 45 | -- |
63 | -- It should return: | 46 | -- It should return: |
64 | -- | 47 | -- |
65 | -- * 'Nothing' if the caveat is not related to the verifier | 48 | -- * 'Unrelated' if the caveat is not related to the verifier |
66 | -- (for instance a time verifier is given an action caveat); | 49 | -- (for instance a time verifier is given an action caveat); |
67 | -- * 'Just' ('Left' ('ParseError' reason)) if the verifier is related to the | 50 | -- * 'Refused' ('ParseError' reason) if the verifier is related to the |
68 | -- caveat, but failed to parse it completely; | 51 | -- caveat, but failed to parse it completely; |
69 | -- * 'Just' ('Left' ('ValidatorError' reason)) if the verifier is related to the | 52 | -- * 'Refused' ('ValidatorError' reason) if the verifier is related to the |
70 | -- caveat, parsed it and invalidated it; | 53 | -- caveat, parsed it and invalidated it; |
71 | -- * 'Just' ('Right' '()') if the verifier has successfully verified the | 54 | -- * 'Verified' if the verifier has successfully verified the |
72 | -- given caveat | 55 | -- given caveat |
73 | verify :: (Functor m, MonadIO m) => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon) | 56 | verify :: (Functor m, MonadIO m) => Secret -> [Caveat -> m VerifierResult] -> Macaroon -> m (Either ValidationError Macaroon) |
74 | verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers) | 57 | verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers) |
75 | 58 | ||
76 | |||
77 | -- verifyOpBool :: MonadIO m => String -> Parser a -> (a -> a -> Bool) -> BS.ByteString -> Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
78 | -- verifyOpBool err p f op k val = verifyParser k valueParser $ \s -> do | ||
79 | -- expected <- val | ||
80 | -- return $ bool (Left $ ValidatorError err) (Right Win) =<< f expected <$> mapLeft ParseError (parseOnly p s) | ||
81 | -- where | ||
82 | -- valueParser = string op *> skipSpace *> takeByteString | ||
83 | |||
84 | -- verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
85 | -- verifyParser k p f c = case parseOnly keyParser . cid $ c of | ||
86 | -- Left _ -> return Nothing | ||
87 | -- Right bs -> Just <$> case parseOnly p bs of | ||
88 | -- Left err -> return $ Left $ ParseError err | ||
89 | -- Right a -> fmap (const c) <$> f a | ||
90 | -- where | ||
91 | -- keyParser = string k *> skipSpace *> takeByteString | ||
92 | |||
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 | |||
29 | 29 | ||
30 | import Crypto.Macaroon.Internal | 30 | import Crypto.Macaroon.Internal |
31 | 31 | ||
32 | |||
33 | -- | Type representing the result of a validator | ||
34 | data VerifierResult = Verified -- ^ The caveat is correctly parsed and verified | ||
35 | | Refused ValidationError -- ^ The caveat is refused (Either a parse error or a validation error | ||
36 | | Unrelated -- ^ The given verifier does not verify the caveat | ||
37 | deriving (Show, Eq) | ||
38 | |||
32 | -- | Type representing different validation errors. | 39 | -- | Type representing different validation errors. |
33 | -- Only 'ParseError' and 'ValidatorError' are exported, @SigMismatch@ and | 40 | -- Only 'ParseError' and 'ValidatorError' are exported, @SigMismatch@ and |
34 | -- @NoVerifier@ are used internally and should not be used by the user | 41 | -- @NoVerifier@ are used internally and should not be used by the user |
@@ -59,7 +66,7 @@ verifySig k m = bool (Left SigMismatch) (Right m) $ | |||
59 | 66 | ||
60 | -- | Given a list of verifiers, verify each caveat of the given macaroon | 67 | -- | Given a list of verifiers, verify each caveat of the given macaroon |
61 | verifyCavs :: (Functor m, MonadIO m) | 68 | verifyCavs :: (Functor m, MonadIO m) |
62 | => [Caveat -> m (Maybe (Either ValidationError ()))] | 69 | => [Caveat -> m VerifierResult] |
63 | -> Macaroon | 70 | -> Macaroon |
64 | -> m (Either ValidationError Macaroon) | 71 | -> m (Either ValidationError Macaroon) |
65 | verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) | 72 | verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) |
@@ -70,7 +77,11 @@ verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) | |||
70 | - starting value for the foldM. We are guaranteed to have a `Just something` | 77 | - starting value for the foldM. We are guaranteed to have a `Just something` |
71 | - from it. | 78 | - from it. |
72 | -} | 79 | -} |
73 | validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers | 80 | validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation . vResult2MaybeEither <$> v c) (defErr c) verifiers |
81 | -- vResult2MaybeEither :: VerifierResult -> Maybe (Either ValidationError ()) | ||
82 | vResult2MaybeEither Unrelated = Nothing | ||
83 | vResult2MaybeEither Verified = Just (Right ()) | ||
84 | vResult2MaybeEither (Refused e)= Just (Left e) | ||
74 | -- defErr :: Caveat -> Maybe (Validation String Caveat) | 85 | -- defErr :: Caveat -> Maybe (Validation String Caveat) |
75 | defErr c = Just $ Failure NoVerifier | 86 | defErr c = Just $ Failure NoVerifier |
76 | -- gatherEithers :: [Validation String Caveat] -> Either String Caveat | 87 | -- 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 | |||
45 | m2 :: Macaroon | 45 | m2 :: Macaroon |
46 | m2 = addFirstPartyCaveat "test = caveat" m | 46 | m2 = addFirstPartyCaveat "test = caveat" m |
47 | 47 | ||
48 | vtest :: Caveat -> IO (Maybe (Either ValidationError ())) | 48 | vtest :: Caveat -> IO VerifierResult |
49 | vtest c = return $ if "test" `BS.isPrefixOf` cid c then | 49 | vtest c = return $ if "test" `BS.isPrefixOf` cid c then |
50 | Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "test = caveat" == cid c | 50 | bool (Refused (ValidatorError "Failed")) Verified $ "test = caveat" == cid c |
51 | else Nothing | 51 | else Unrelated |
52 | 52 | ||
53 | 53 | ||
54 | m3 :: Macaroon | 54 | m3 :: Macaroon |
55 | m3 = addFirstPartyCaveat "value = 42" m2 | 55 | m3 = addFirstPartyCaveat "value = 42" m2 |
56 | 56 | ||
57 | vval :: Caveat -> IO (Maybe (Either ValidationError ())) | 57 | vval :: Caveat -> IO VerifierResult |
58 | vval c = return $ if "value" `BS.isPrefixOf` cid c then | 58 | vval c = return $ if "value" `BS.isPrefixOf` cid c then |
59 | Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "value = 42" == cid c | 59 | bool (Refused (ValidatorError "Failed")) Verified $ "value = 42" == cid c |
60 | else Nothing | 60 | else Unrelated |
61 | 61 | ||
62 | 62 | ||
63 | {- | 63 | {- |