aboutsummaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Crypto/Macaroon/Verifier.hs48
-rw-r--r--src/Crypto/Macaroon/Verifier/Internal.hs15
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-}
18module Crypto.Macaroon.Verifier ( 18module 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
73verify :: (Functor m, MonadIO m) => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon) 56verify :: (Functor m, MonadIO m) => Secret -> [Caveat -> m VerifierResult] -> Macaroon -> m (Either ValidationError Macaroon)
74verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers) 57verify 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
30import Crypto.Macaroon.Internal 30import Crypto.Macaroon.Internal
31 31
32
33-- | Type representing the result of a validator
34data 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
61verifyCavs :: (Functor m, MonadIO m) 68verifyCavs :: (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)
65verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) 72verifyCavs 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