-}
module Crypto.Macaroon.Verifier (
verify
+ , VerifierResult(..)
, ValidationError(ValidatorError, ParseError)
- -- , (.<), (.<=), (.==), (.>), (.>=)
- -- , module Data.Attoparsec.ByteString.Char8
) where
-
--- (.<) :: (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
-
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
-- | 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)
- 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
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
{-