diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Crypto/Macaroon.hs | 21 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Internal.hs | 6 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Verifier.hs | 35 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Verifier/Internal.hs | 30 |
4 files changed, 52 insertions, 40 deletions
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 ( | |||
23 | -- * Types | 23 | -- * Types |
24 | Macaroon | 24 | Macaroon |
25 | , Caveat | 25 | , Caveat |
26 | , Secret | ||
26 | , Key | 27 | , Key |
27 | , Location | 28 | , Location |
28 | , Sig | 29 | , Sig |
@@ -33,9 +34,9 @@ module Crypto.Macaroon ( | |||
33 | , caveats | 34 | , caveats |
34 | , signature | 35 | , signature |
35 | -- ** Caveats | 36 | -- ** Caveats |
36 | , caveatLoc | 37 | , cl |
37 | , caveatId | 38 | , cid |
38 | , caveatVId | 39 | , vid |
39 | 40 | ||
40 | -- * Create Macaroons | 41 | -- * Create Macaroons |
41 | , create | 42 | , create |
@@ -54,23 +55,11 @@ import qualified Data.ByteString.Char8 as B8 | |||
54 | import Crypto.Macaroon.Internal | 55 | import Crypto.Macaroon.Internal |
55 | 56 | ||
56 | -- | Create a Macaroon from its key, identifier and location | 57 | -- | Create a Macaroon from its key, identifier and location |
57 | create :: Key -> Key -> Location -> Macaroon | 58 | create :: Secret -> Key -> Location -> Macaroon |
58 | create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) | 59 | create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) |
59 | where | 60 | where |
60 | derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256) | 61 | derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256) |
61 | 62 | ||
62 | -- | Caveat target location | ||
63 | caveatLoc :: Caveat -> Location | ||
64 | caveatLoc = cl | ||
65 | |||
66 | -- | Caveat identifier | ||
67 | caveatId :: Caveat -> Key | ||
68 | caveatId = cid | ||
69 | |||
70 | -- | Caveat verification identifier | ||
71 | caveatVId :: Caveat -> Key | ||
72 | caveatVId = vid | ||
73 | |||
74 | -- | Inspect a macaroon's contents. For debugging purposes. | 63 | -- | Inspect a macaroon's contents. For debugging purposes. |
75 | inspect :: Macaroon -> String | 64 | inspect :: Macaroon -> String |
76 | inspect = show | 65 | 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 | |||
23 | import Data.Hex | 23 | import Data.Hex |
24 | import Data.List | 24 | import Data.List |
25 | 25 | ||
26 | -- |Type alias for Macaroons and Caveat keys and identifiers | 26 | |
27 | -- |Type alias for Macaroons secret keys | ||
28 | type Secret = BS.ByteString | ||
29 | |||
30 | -- |Type alias for Macaroons and Caveat and identifiers | ||
27 | type Key = BS.ByteString | 31 | type Key = BS.ByteString |
28 | 32 | ||
29 | -- |Type alias for Macaroons and Caveat locations | 33 | -- |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 | |||
52 | -- (.>=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | 52 | -- (.>=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) |
53 | -- (.>=) = verifyOpBool "Strictly less" (>=) ">=" | 53 | -- (.>=) = verifyOpBool "Strictly less" (>=) ">=" |
54 | 54 | ||
55 | 55 | -- | Verify a Macaroon's signature and caveats, given the corresponding Secret | |
56 | verify :: MonadIO m => Key -> [Caveat -> m (Maybe (Either ValidationError Caveat))] -> Macaroon -> m (Either ValidationError Macaroon) | 56 | -- and verifiers. |
57 | -- | ||
58 | -- A verifier is a function of type | ||
59 | -- @'MonadIO' m => 'Caveat' -> m ('Maybe' ('Either' 'ValidatorError' 'Caveat'))@. | ||
60 | -- | ||
61 | -- It should return: | ||
62 | -- | ||
63 | -- * 'Nothing' if the caveat is not related to the verifier | ||
64 | -- (for instance a time verifier is given an action caveat); | ||
65 | -- * 'Just' ('Left' ('ParseError' reason)) if the verifier is related to the | ||
66 | -- caveat, but failed to parse it completely; | ||
67 | -- * 'Just' ('Left' ('ValidatorError' reason)) if the verifier is related to the | ||
68 | -- caveat, parsed it and invalidated it; | ||
69 | -- * 'Just' ('Right' '()') if the verifier has successfully verified the | ||
70 | -- given caveat | ||
71 | verify :: MonadIO m => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon) | ||
57 | verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers) | 72 | verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers) |
58 | 73 | ||
59 | 74 | ||
@@ -64,12 +79,12 @@ verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verif | |||
64 | -- where | 79 | -- where |
65 | -- valueParser = string op *> skipSpace *> takeByteString | 80 | -- valueParser = string op *> skipSpace *> takeByteString |
66 | 81 | ||
67 | verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat)) | 82 | -- verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat)) |
68 | verifyParser k p f c = case parseOnly keyParser . cid $ c of | 83 | -- verifyParser k p f c = case parseOnly keyParser . cid $ c of |
69 | Left _ -> return Nothing | 84 | -- Left _ -> return Nothing |
70 | Right bs -> Just <$> case parseOnly p bs of | 85 | -- Right bs -> Just <$> case parseOnly p bs of |
71 | Left err -> return $ Left $ ParseError err | 86 | -- Left err -> return $ Left $ ParseError err |
72 | Right a -> fmap (const c) <$> f a | 87 | -- Right a -> fmap (const c) <$> f a |
73 | where | 88 | -- where |
74 | keyParser = string k *> skipSpace *> takeByteString | 89 | -- keyParser = string k *> skipSpace *> takeByteString |
75 | 90 | ||
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 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | {-# LANGUAGE RankNTypes #-} | 2 | {-# LANGUAGE RankNTypes #-} |
3 | {-| | 3 | {-| |
4 | Module : Crypto.Macaroon.Verifier.Internal | 4 | Module : Crypto.Macaroon.Verifier.Internal |
5 | Copyright : (c) 2015 Julien Tanguy | 5 | Copyright : (c) 2015 Julien Tanguy |
@@ -19,22 +19,26 @@ import Control.Monad.IO.Class | |||
19 | import Crypto.Hash | 19 | import Crypto.Hash |
20 | import Data.Bool | 20 | import Data.Bool |
21 | import Data.Byteable | 21 | import Data.Byteable |
22 | import qualified Data.ByteString as BS | 22 | import qualified Data.ByteString as BS |
23 | import Data.Either | 23 | import Data.Either |
24 | import Data.Either.Validation | 24 | import Data.Either.Validation |
25 | import Data.Foldable | 25 | import Data.Foldable |
26 | import Data.Maybe | 26 | import Data.Maybe |
27 | import Data.Monoid | ||
27 | 28 | ||
28 | import Crypto.Macaroon.Internal | 29 | import Crypto.Macaroon.Internal |
29 | 30 | ||
30 | data Win = Win | 31 | -- | Type representing different validation errors. |
31 | 32 | -- Only 'ParseError' and 'ValidatorError' are exported, 'SigMismatch' and | |
32 | data ValidationError = SigMismatch | 33 | -- 'NoVerifier' are used internally and should not be used by the user |
33 | | NoVerifier | 34 | data ValidationError = SigMismatch -- ^ Signatures do not match |
34 | | ParseError String | 35 | | NoVerifier -- ^ No verifier can handle a given caveat |
35 | | ValidatorError String | 36 | | ParseError String -- ^ A verifier had a parse error |
36 | deriving Show | 37 | | ValidatorError String -- ^ A verifier failed |
38 | deriving (Show,Eq) | ||
37 | 39 | ||
40 | -- | The 'Monoid' instance is written so 'SigMismatch' is an annihilator, | ||
41 | -- and 'NoVerifier' is the identity element | ||
38 | instance Monoid ValidationError where | 42 | instance Monoid ValidationError where |
39 | mempty = NoVerifier | 43 | mempty = NoVerifier |
40 | NoVerifier `mappend` e = e | 44 | NoVerifier `mappend` e = e |
@@ -52,9 +56,9 @@ verifySig k m = bool (Left SigMismatch) (Right m) $ | |||
52 | hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) | 56 | hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) |
53 | derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) | 57 | derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) |
54 | 58 | ||
55 | 59 | -- | Given a list of verifiers, verify each caveat of the given macaroon | |
56 | verifyCavs :: MonadIO m | 60 | verifyCavs :: MonadIO m |
57 | => [Caveat -> m (Maybe (Either ValidationError Caveat))] | 61 | => [Caveat -> m (Maybe (Either ValidationError ()))] |
58 | -> Macaroon | 62 | -> Macaroon |
59 | -> m (Either ValidationError Macaroon) | 63 | -> m (Either ValidationError Macaroon) |
60 | verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) | 64 | verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) |
@@ -65,7 +69,7 @@ verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) | |||
65 | - starting value for the foldM. We are guaranteed to have a `Just something` | 69 | - starting value for the foldM. We are guaranteed to have a `Just something` |
66 | - from it. | 70 | - from it. |
67 | -} | 71 | -} |
68 | validateCaveat c = fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers | 72 | validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers |
69 | -- defErr :: Caveat -> Maybe (Validation String Caveat) | 73 | -- defErr :: Caveat -> Maybe (Validation String Caveat) |
70 | defErr c = Just $ Failure NoVerifier | 74 | defErr c = Just $ Failure NoVerifier |
71 | -- gatherEithers :: [Validation String Caveat] -> Either String Caveat | 75 | -- gatherEithers :: [Validation String Caveat] -> Either String Caveat |