diff options
Diffstat (limited to 'src/Crypto')
-rw-r--r-- | src/Crypto/Macaroon/Verifier.hs | 48 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Verifier/Internal.hs | 15 |
2 files changed, 20 insertions, 43 deletions
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 |