From 86f3882318d323d1920ca1c7da6e816f0ed376da Mon Sep 17 00:00:00 2001 From: Julien Tanguy Date: Mon, 17 Aug 2015 17:38:24 +0200 Subject: Change verifier api and split Verifier module - Added haddocks --- src/Crypto/Macaroon.hs | 21 +++++-------------- src/Crypto/Macaroon/Internal.hs | 6 +++++- src/Crypto/Macaroon/Verifier.hs | 35 +++++++++++++++++++++++--------- src/Crypto/Macaroon/Verifier/Internal.hs | 30 +++++++++++++++------------ 4 files changed, 52 insertions(+), 40 deletions(-) (limited to 'src/Crypto') diff --git a/src/Crypto/Macaroon.hs b/src/Crypto/Macaroon.hs index bfcf8df..c9c8c21 100644 --- a/src/Crypto/Macaroon.hs +++ b/src/Crypto/Macaroon.hs @@ -23,6 +23,7 @@ module Crypto.Macaroon ( -- * Types Macaroon , Caveat + , Secret , Key , Location , Sig @@ -33,9 +34,9 @@ module Crypto.Macaroon ( , caveats , signature -- ** Caveats - , caveatLoc - , caveatId - , caveatVId + , cl + , cid + , vid -- * Create Macaroons , create @@ -54,23 +55,11 @@ import qualified Data.ByteString.Char8 as B8 import Crypto.Macaroon.Internal -- | Create a Macaroon from its key, identifier and location -create :: Key -> Key -> Location -> Macaroon +create :: Secret -> Key -> Location -> Macaroon create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) where derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256) --- | Caveat target location -caveatLoc :: Caveat -> Location -caveatLoc = cl - --- | Caveat identifier -caveatId :: Caveat -> Key -caveatId = cid - --- | Caveat verification identifier -caveatVId :: Caveat -> Key -caveatVId = vid - -- | Inspect a macaroon's contents. For debugging purposes. inspect :: Macaroon -> String inspect = show diff --git a/src/Crypto/Macaroon/Internal.hs b/src/Crypto/Macaroon/Internal.hs index 2f56512..d6e80d3 100644 --- a/src/Crypto/Macaroon/Internal.hs +++ b/src/Crypto/Macaroon/Internal.hs @@ -23,7 +23,11 @@ import qualified Data.ByteString.Char8 as B8 import Data.Hex import Data.List --- |Type alias for Macaroons and Caveat keys and identifiers + +-- |Type alias for Macaroons secret keys +type Secret = BS.ByteString + +-- |Type alias for Macaroons and Caveat and identifiers type Key = BS.ByteString -- |Type alias for Macaroons and Caveat locations diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs index 7d5f094..a739437 100644 --- a/src/Crypto/Macaroon/Verifier.hs +++ b/src/Crypto/Macaroon/Verifier.hs @@ -52,8 +52,23 @@ import Crypto.Macaroon.Verifier.Internal -- (.>=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) -- (.>=) = verifyOpBool "Strictly less" (>=) ">=" - -verify :: MonadIO m => Key -> [Caveat -> m (Maybe (Either ValidationError Caveat))] -> Macaroon -> m (Either ValidationError Macaroon) +-- | 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'))@. +-- +-- It should return: +-- +-- * 'Nothing' 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 +-- caveat, but failed to parse it completely; +-- * 'Just' ('Left' ('ValidatorError' reason)) if the verifier is related to the +-- caveat, parsed it and invalidated it; +-- * 'Just' ('Right' '()') if the verifier has successfully verified the +-- given caveat +verify :: MonadIO m => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon) verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers) @@ -64,12 +79,12 @@ verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verif -- 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 +-- 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 b65b62d..2af55d3 100644 --- a/src/Crypto/Macaroon/Verifier/Internal.hs +++ b/src/Crypto/Macaroon/Verifier/Internal.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-| Module : Crypto.Macaroon.Verifier.Internal Copyright : (c) 2015 Julien Tanguy @@ -19,22 +19,26 @@ import Control.Monad.IO.Class import Crypto.Hash import Data.Bool import Data.Byteable -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS import Data.Either import Data.Either.Validation import Data.Foldable import Data.Maybe +import Data.Monoid import Crypto.Macaroon.Internal -data Win = Win - -data ValidationError = SigMismatch - | NoVerifier - | ParseError String - | ValidatorError String - deriving Show +-- | 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 +data ValidationError = SigMismatch -- ^ Signatures do not match + | NoVerifier -- ^ No verifier can handle a given caveat + | ParseError String -- ^ A verifier had a parse error + | ValidatorError String -- ^ A verifier failed + deriving (Show,Eq) +-- | The 'Monoid' instance is written so 'SigMismatch' is an annihilator, +-- and 'NoVerifier' is the identity element instance Monoid ValidationError where mempty = NoVerifier NoVerifier `mappend` e = e @@ -52,9 +56,9 @@ verifySig k m = bool (Left SigMismatch) (Right m) $ hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) - +-- | Given a list of verifiers, verify each caveat of the given macaroon verifyCavs :: MonadIO m - => [Caveat -> m (Maybe (Either ValidationError Caveat))] + => [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon) verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) @@ -65,7 +69,7 @@ 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 = 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 <$> v c) (defErr c) verifiers -- defErr :: Caveat -> Maybe (Validation String Caveat) defErr c = Just $ Failure NoVerifier -- gatherEithers :: [Validation String Caveat] -> Either String Caveat -- cgit v1.2.3