diff options
Diffstat (limited to 'src/Crypto/Macaroon/Verifier/Internal.hs')
-rw-r--r-- | src/Crypto/Macaroon/Verifier/Internal.hs | 30 |
1 files changed, 17 insertions, 13 deletions
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 |