diff options
author | Julien Tanguy <julien.tanguy@jhome.fr> | 2015-08-17 19:40:19 +0200 |
---|---|---|
committer | Julien Tanguy <julien.tanguy@jhome.fr> | 2015-08-17 19:40:19 +0200 |
commit | cfeb65a103cb58048328b2ca3ce74351017f70d1 (patch) | |
tree | 8a96cc66aba8d8171045c0e0a6dcdd040b7bc588 /src/Crypto | |
parent | a1b6481db1e02013f668851096b084ff6088f682 (diff) | |
parent | 27d5a3a43c7d736f8cd842f14f3178d532de9152 (diff) | |
download | hmacaroons-cfeb65a103cb58048328b2ca3ce74351017f70d1.tar.gz hmacaroons-cfeb65a103cb58048328b2ca3ce74351017f70d1.tar.zst hmacaroons-cfeb65a103cb58048328b2ca3ce74351017f70d1.zip |
Merge branch 'verification'
Diffstat (limited to 'src/Crypto')
-rw-r--r-- | src/Crypto/Macaroon.hs | 33 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Internal.hs | 6 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Verifier.hs | 142 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Verifier/Internal.hs | 79 |
4 files changed, 167 insertions, 93 deletions
diff --git a/src/Crypto/Macaroon.hs b/src/Crypto/Macaroon.hs index bfcf8df..86d8eb7 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,44 +34,36 @@ 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 |
42 | , inspect | 43 | , inspect |
43 | , addFirstPartyCaveat | 44 | , addFirstPartyCaveat |
44 | -- , addThirdPartyCaveat | 45 | -- , addThirdPartyCaveat |
46 | -- * Serialize | ||
47 | , module Crypto.Macaroon.Serializer.Base64 | ||
48 | -- * Verify | ||
49 | , module Crypto.Macaroon.Verifier | ||
45 | ) where | 50 | ) where |
46 | 51 | ||
47 | -- import Crypto.Cipher.AES | 52 | -- import Crypto.Cipher.AES |
48 | import Crypto.Hash | 53 | import Crypto.Hash |
49 | import Data.Byteable | 54 | import Data.Byteable |
50 | import qualified Data.ByteString as BS | 55 | import qualified Data.ByteString as BS |
51 | import qualified Data.ByteString.Base64.URL as B64 | ||
52 | import qualified Data.ByteString.Char8 as B8 | ||
53 | 56 | ||
54 | import Crypto.Macaroon.Internal | 57 | import Crypto.Macaroon.Internal |
58 | import Crypto.Macaroon.Serializer.Base64 | ||
59 | import Crypto.Macaroon.Verifier | ||
55 | 60 | ||
56 | -- | Create a Macaroon from its key, identifier and location | 61 | -- | Create a Macaroon from its key, identifier and location |
57 | create :: Key -> Key -> Location -> Macaroon | 62 | create :: Secret -> Key -> Location -> Macaroon |
58 | create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) | 63 | create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) |
59 | where | 64 | where |
60 | derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256) | 65 | derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256) |
61 | 66 | ||
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. | 67 | -- | Inspect a macaroon's contents. For debugging purposes. |
75 | inspect :: Macaroon -> String | 68 | inspect :: Macaroon -> String |
76 | inspect = show | 69 | inspect = show |
@@ -89,5 +82,3 @@ addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m | |||
89 | -- addThirdPartyCaveat key cid loc m = addCaveat loc cid vid m | 82 | -- addThirdPartyCaveat key cid loc m = addCaveat loc cid vid m |
90 | -- where | 83 | -- where |
91 | -- vid = encryptECB (initAES (signature m)) key | 84 | -- vid = encryptECB (initAES (signature m)) key |
92 | |||
93 | |||
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 ed24ea4..4fc6aff 100644 --- a/src/Crypto/Macaroon/Verifier.hs +++ b/src/Crypto/Macaroon/Verifier.hs | |||
@@ -1,5 +1,8 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE FlexibleInstances #-} |
2 | {-# LANGUAGE RankNTypes #-} | 2 | {-# LANGUAGE OverloadedStrings #-} |
3 | {-# LANGUAGE RankNTypes #-} | ||
4 | {-# LANGUAGE TypeSynonymInstances #-} | ||
5 | {-# LANGUAGE UndecidableInstances #-} | ||
3 | {-| | 6 | {-| |
4 | Module : Crypto.Macaroon.Verifier | 7 | Module : Crypto.Macaroon.Verifier |
5 | Copyright : (c) 2015 Julien Tanguy | 8 | Copyright : (c) 2015 Julien Tanguy |
@@ -13,80 +16,77 @@ Portability : portable | |||
13 | 16 | ||
14 | -} | 17 | -} |
15 | module Crypto.Macaroon.Verifier ( | 18 | module Crypto.Macaroon.Verifier ( |
16 | Verified(..) | 19 | verify |
17 | , CaveatVerifier | 20 | , ValidationError(ValidatorError, ParseError) |
18 | , (<???>) | 21 | -- , (.<), (.<=), (.==), (.>), (.>=) |
19 | , verifyMacaroon | 22 | -- , module Data.Attoparsec.ByteString.Char8 |
20 | , verifySig | ||
21 | , verifyExact | ||
22 | , verifyFun | ||
23 | , module Data.Attoparsec.ByteString.Char8 | ||
24 | , verifyCavs | ||
25 | ) where | 23 | ) where |
26 | 24 | ||
27 | 25 | ||
28 | import Crypto.Hash | 26 | import Control.Applicative |
27 | import Control.Monad hiding (forM) | ||
28 | import Control.Monad.IO.Class | ||
29 | import Data.Attoparsec.ByteString | ||
30 | import Data.Attoparsec.ByteString.Char8 | ||
29 | import Data.Bool | 31 | import Data.Bool |
30 | import qualified Data.ByteString as BS | ||
31 | import Data.Byteable | ||
32 | import Data.Foldable | ||
33 | import Data.Function | ||
34 | import Data.Maybe | ||
35 | import Data.Monoid | ||
36 | import Data.Traversable | 32 | import Data.Traversable |
37 | import Data.Attoparsec.ByteString | 33 | import qualified Data.ByteString as BS |
38 | import Data.Attoparsec.ByteString.Char8 | 34 | import Data.Either.Combinators |
39 | 35 | ||
40 | import Crypto.Macaroon.Internal | 36 | import Crypto.Macaroon.Internal |
37 | import Crypto.Macaroon.Verifier.Internal | ||
38 | |||
39 | |||
40 | |||
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 | ||
58 | -- and verifiers. | ||
59 | -- | ||
60 | -- A verifier is a function of type | ||
61 | -- @'MonadIO' m => 'Caveat' -> m ('Maybe' ('Either' 'ValidatorError' 'Caveat'))@. | ||
62 | -- | ||
63 | -- It should return: | ||
64 | -- | ||
65 | -- * 'Nothing' if the caveat is not related to the verifier | ||
66 | -- (for instance a time verifier is given an action caveat); | ||
67 | -- * 'Just' ('Left' ('ParseError' reason)) if the verifier is related to the | ||
68 | -- caveat, but failed to parse it completely; | ||
69 | -- * 'Just' ('Left' ('ValidatorError' reason)) if the verifier is related to the | ||
70 | -- caveat, parsed it and invalidated it; | ||
71 | -- * 'Just' ('Right' '()') if the verifier has successfully verified the | ||
72 | -- given caveat | ||
73 | verify :: (Functor m, MonadIO m) => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon) | ||
74 | verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers) | ||
75 | |||
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 | ||
41 | 92 | ||
42 | |||
43 | -- | Opaque datatype for now. Might need more explicit errors | ||
44 | data Verified = Ok | Failed deriving (Show,Eq) | ||
45 | |||
46 | instance Monoid Verified where | ||
47 | mempty = Ok | ||
48 | mappend Ok Ok = Ok | ||
49 | mappend _ _ = Failed | ||
50 | |||
51 | |||
52 | data CaveatVerifier = CV { vFun :: Caveat -> Maybe Verified , helpText :: String} | ||
53 | |||
54 | instance Eq CaveatVerifier where | ||
55 | (==) = (==) `on` helpText | ||
56 | |||
57 | instance Show CaveatVerifier where | ||
58 | show = helpText | ||
59 | |||
60 | (<???>) :: (Caveat -> Maybe Verified) -> String -> CaveatVerifier | ||
61 | f <???> t = CV f t | ||
62 | |||
63 | verifySig :: Key -> Macaroon -> Verified | ||
64 | verifySig k m = bool Failed Ok $ | ||
65 | signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m) | ||
66 | where | ||
67 | hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) | ||
68 | derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) | ||
69 | |||
70 | verifyMacaroon :: Key -> [CaveatVerifier] -> Macaroon -> Verified | ||
71 | verifyMacaroon secret verifiers m = verifySig secret m `mappend` verifyCavs verifiers m | ||
72 | |||
73 | |||
74 | verifyCavs :: [CaveatVerifier] -> Macaroon -> Verified | ||
75 | verifyCavs verifiers m = foldMap (\c -> fromMaybe Failed $ foldMap (($ c) . vFun) verifiers) (caveats m) | ||
76 | |||
77 | verifyExact :: (Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified | ||
78 | verifyExact k expected = verifyFun k (expected ==) | ||
79 | |||
80 | verifyFun :: Key -> (a -> Bool) -> Parser a -> Caveat -> Maybe Verified | ||
81 | verifyFun key f parser cav = if key `BS.isPrefixOf` cid cav then | ||
82 | case parseOnly kvparser (cid cav) of | ||
83 | Right v -> (bool Failed Ok . f) <$> Just v | ||
84 | Left _ -> Just Failed | ||
85 | else Nothing | ||
86 | where | ||
87 | kvparser = do | ||
88 | key <- string key | ||
89 | skipSpace | ||
90 | string "=" | ||
91 | skipSpace | ||
92 | parser <* endOfInput | ||
diff --git a/src/Crypto/Macaroon/Verifier/Internal.hs b/src/Crypto/Macaroon/Verifier/Internal.hs new file mode 100644 index 0000000..b3ad7f2 --- /dev/null +++ b/src/Crypto/Macaroon/Verifier/Internal.hs | |||
@@ -0,0 +1,79 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | {-# LANGUAGE RankNTypes #-} | ||
3 | {-| | ||
4 | Module : Crypto.Macaroon.Verifier.Internal | ||
5 | Copyright : (c) 2015 Julien Tanguy | ||
6 | License : BSD3 | ||
7 | |||
8 | Maintainer : julien.tanguy@jhome.fr | ||
9 | Stability : experimental | ||
10 | Portability : portable | ||
11 | |||
12 | |||
13 | |||
14 | -} | ||
15 | module Crypto.Macaroon.Verifier.Internal where | ||
16 | |||
17 | import Control.Applicative | ||
18 | import Control.Monad | ||
19 | import Control.Monad.IO.Class | ||
20 | import Crypto.Hash | ||
21 | import Data.Bool | ||
22 | import Data.Byteable | ||
23 | import qualified Data.ByteString as BS | ||
24 | import Data.Either | ||
25 | import Data.Either.Validation | ||
26 | import Data.Foldable | ||
27 | import Data.Maybe | ||
28 | import Data.Monoid | ||
29 | |||
30 | import Crypto.Macaroon.Internal | ||
31 | |||
32 | -- | Type representing different validation errors. | ||
33 | -- Only 'ParseError' and 'ValidatorError' are exported, @SigMismatch@ and | ||
34 | -- @NoVerifier@ are used internally and should not be used by the user | ||
35 | data ValidationError = SigMismatch -- ^ Signatures do not match | ||
36 | | NoVerifier -- ^ No verifier can handle a given caveat | ||
37 | | ParseError String -- ^ A verifier had a parse error | ||
38 | | ValidatorError String -- ^ A verifier failed | ||
39 | deriving (Show,Eq) | ||
40 | |||
41 | -- | The 'Monoid' instance is written so @SigMismatch@ is an annihilator, | ||
42 | -- and @NoVerifier@ is the identity element | ||
43 | instance Monoid ValidationError where | ||
44 | mempty = NoVerifier | ||
45 | NoVerifier `mappend` e = e | ||
46 | e `mappend` NoVerifier = e | ||
47 | SigMismatch `mappend` _ = SigMismatch | ||
48 | _ `mappend` SigMismatch = SigMismatch | ||
49 | (ValidatorError e) `mappend` (ParseError _) = ValidatorError e | ||
50 | (ParseError _) `mappend` (ValidatorError e) = ValidatorError e | ||
51 | |||
52 | -- | Check that the given macaroon has a correct signature | ||
53 | verifySig :: Key -> Macaroon -> Either ValidationError Macaroon | ||
54 | verifySig k m = bool (Left SigMismatch) (Right m) $ | ||
55 | signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m) | ||
56 | where | ||
57 | hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) | ||
58 | derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) | ||
59 | |||
60 | -- | Given a list of verifiers, verify each caveat of the given macaroon | ||
61 | verifyCavs :: (Functor m, MonadIO m) | ||
62 | => [Caveat -> m (Maybe (Either ValidationError ()))] | ||
63 | -> Macaroon | ||
64 | -> m (Either ValidationError Macaroon) | ||
65 | verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) | ||
66 | where | ||
67 | {- | ||
68 | - validateCaveat :: Caveat -> m (Validation String Caveat) | ||
69 | - We can use fromJust here safely since we use a `Just Failure` as a | ||
70 | - starting value for the foldM. We are guaranteed to have a `Just something` | ||
71 | - from it. | ||
72 | -} | ||
73 | validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers | ||
74 | -- defErr :: Caveat -> Maybe (Validation String Caveat) | ||
75 | defErr c = Just $ Failure NoVerifier | ||
76 | -- gatherEithers :: [Validation String Caveat] -> Either String Caveat | ||
77 | gatherEithers vs = case partitionEithers . map validationToEither $ vs of | ||
78 | ([],_) -> Right m | ||
79 | (errs,_) -> Left (mconcat errs) | ||