diff options
-rw-r--r-- | default.nix | 10 | ||||
-rw-r--r-- | hmacaroons.cabal | 21 | ||||
-rw-r--r-- | shell.nix | 4 | ||||
-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 | 141 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Verifier/Internal.hs | 78 | ||||
-rw-r--r-- | test/Crypto/Macaroon/Instances.hs | 10 | ||||
-rw-r--r-- | test/Crypto/Macaroon/Tests.hs | 2 | ||||
-rw-r--r-- | test/Crypto/Macaroon/Verifier/Internal/Tests.hs | 30 | ||||
-rw-r--r-- | test/Crypto/Macaroon/Verifier/Tests.hs | 49 | ||||
-rw-r--r-- | test/Sanity.hs | 26 | ||||
-rw-r--r-- | test/main.hs | 10 |
13 files changed, 252 insertions, 156 deletions
diff --git a/default.nix b/default.nix index d968974..b1404ef 100644 --- a/default.nix +++ b/default.nix | |||
@@ -1,18 +1,18 @@ | |||
1 | { mkDerivation, attoparsec, base, base64-bytestring, byteable | 1 | { mkDerivation, attoparsec, base, base64-bytestring, byteable |
2 | , bytestring, cereal, cryptohash, deepseq, hex, QuickCheck, stdenv | 2 | , bytestring, cereal, cryptohash, deepseq, either, hex, QuickCheck |
3 | , tasty, tasty-hunit, tasty-quickcheck | 3 | , stdenv, tasty, tasty-hunit, tasty-quickcheck, transformers |
4 | }: | 4 | }: |
5 | mkDerivation { | 5 | mkDerivation { |
6 | pname = "hmacaroons"; | 6 | pname = "hmacaroons"; |
7 | version = "0.1.0.0"; | 7 | version = "0.2.0.0"; |
8 | src = ./.; | 8 | src = ./.; |
9 | buildDepends = [ | 9 | buildDepends = [ |
10 | attoparsec base base64-bytestring byteable bytestring cereal | 10 | attoparsec base base64-bytestring byteable bytestring cereal |
11 | cryptohash deepseq hex | 11 | cryptohash deepseq either hex transformers |
12 | ]; | 12 | ]; |
13 | testDepends = [ | 13 | testDepends = [ |
14 | attoparsec base base64-bytestring byteable bytestring cereal | 14 | attoparsec base base64-bytestring byteable bytestring cereal |
15 | cryptohash hex QuickCheck tasty tasty-hunit tasty-quickcheck | 15 | cryptohash either hex QuickCheck tasty tasty-hunit tasty-quickcheck |
16 | ]; | 16 | ]; |
17 | homepage = "https://github.com/jtanguy/hmacaroons"; | 17 | homepage = "https://github.com/jtanguy/hmacaroons"; |
18 | description = "Haskell implementation of macaroons"; | 18 | description = "Haskell implementation of macaroons"; |
diff --git a/hmacaroons.cabal b/hmacaroons.cabal index b70a984..83b2cd7 100644 --- a/hmacaroons.cabal +++ b/hmacaroons.cabal | |||
@@ -1,17 +1,14 @@ | |||
1 | name: hmacaroons | 1 | name: hmacaroons |
2 | version: 0.1.0.0 | 2 | version: 0.3.0.0 |
3 | synopsis: Haskell implementation of macaroons | 3 | synopsis: Haskell implementation of macaroons |
4 | description: | 4 | description: |
5 | = Macaroons: Pure haskell implementation of macaroons | 5 | Hmacaroons is a pure haskell implementation of macaroons. It aims to |
6 | #macaroons-pure-haskell-implementation-of-macaroons# | ||
7 | . | ||
8 | Macaroons is a pure haskell implementation of macaroons. It aims to | ||
9 | provide compatibility at a serialized level with the | 6 | provide compatibility at a serialized level with the |
10 | <https://github.com/rescrv/libmacaroons reference implementation> and | 7 | <https://github.com/rescrv/libmacaroons reference implementation> and |
11 | the <https://github.com/ecordell/pymacaroons python implementation> | 8 | the <https://github.com/ecordell/pymacaroons python implementation> |
12 | . | 9 | . |
13 | __WARNING: This library has not been audited by security experts.__ | 10 | __WARNING: This library has not been audited by security experts.__ |
14 | __There is no error handling at the moment, everyhting is silently accepted__ | 11 | __There is no error handling at the moment, everything is silently accepted__ |
15 | . | 12 | . |
16 | It is developed in the purpose of exploration purposes, and would need | 13 | It is developed in the purpose of exploration purposes, and would need |
17 | much more attention if it were to be used in production. | 14 | much more attention if it were to be used in production. |
@@ -54,18 +51,21 @@ source-repository head | |||
54 | 51 | ||
55 | library | 52 | library |
56 | exposed-modules: Crypto.Macaroon | 53 | exposed-modules: Crypto.Macaroon |
57 | Crypto.Macaroon.Binder | 54 | -- Crypto.Macaroon.Binder |
58 | Crypto.Macaroon.Serializer.Base64 | 55 | Crypto.Macaroon.Serializer.Base64 |
59 | Crypto.Macaroon.Verifier | 56 | Crypto.Macaroon.Verifier |
60 | other-modules: Crypto.Macaroon.Internal | 57 | other-modules: Crypto.Macaroon.Internal |
58 | Crypto.Macaroon.Verifier.Internal | ||
61 | build-depends: base >=4 && < 5, | 59 | build-depends: base >=4 && < 5, |
62 | attoparsec >=0.12, | 60 | attoparsec >=0.12, |
61 | transformers >= 0.4, | ||
63 | bytestring >=0.10, | 62 | bytestring >=0.10, |
64 | base64-bytestring >= 1.0, | 63 | base64-bytestring >= 1.0, |
65 | byteable >= 0.1 && <0.2, | 64 | byteable >= 0.1 && <0.2, |
66 | cereal >= 0.4, | 65 | cereal >= 0.4, |
67 | cryptohash >=0.11 && <0.12, | 66 | cryptohash >=0.11 && <0.12, |
68 | either >=4.4, | 67 | either >=4.4, |
68 | -- nonce, | ||
69 | -- cipher-aes >=0.2 && <0.3, | 69 | -- cipher-aes >=0.2 && <0.3, |
70 | deepseq >= 1.1, | 70 | deepseq >= 1.1, |
71 | hex >= 0.1 | 71 | hex >= 0.1 |
@@ -86,6 +86,7 @@ benchmark bench | |||
86 | cereal >= 0.4, | 86 | cereal >= 0.4, |
87 | cryptohash >=0.11 && <0.12, | 87 | cryptohash >=0.11 && <0.12, |
88 | -- cipher-aes >=0.2 && <0.3, | 88 | -- cipher-aes >=0.2 && <0.3, |
89 | either >=4.4, | ||
89 | hex >= 0.1, | 90 | hex >= 0.1, |
90 | deepseq >= 1.1, | 91 | deepseq >= 1.1, |
91 | criterion >= 1.1 | 92 | criterion >= 1.1 |
@@ -93,7 +94,7 @@ benchmark bench | |||
93 | test-suite test | 94 | test-suite test |
94 | default-language: Haskell2010 | 95 | default-language: Haskell2010 |
95 | type: exitcode-stdio-1.0 | 96 | type: exitcode-stdio-1.0 |
96 | hs-source-dirs: test | 97 | hs-source-dirs: src, test |
97 | main-is: main.hs | 98 | main-is: main.hs |
98 | build-depends: base >= 4 && <5, | 99 | build-depends: base >= 4 && <5, |
99 | attoparsec >=0.12, | 100 | attoparsec >=0.12, |
@@ -102,9 +103,11 @@ test-suite test | |||
102 | byteable >= 0.1 && <0.2, | 103 | byteable >= 0.1 && <0.2, |
103 | cereal >= 0.4, | 104 | cereal >= 0.4, |
104 | cryptohash >=0.11 && <0.12, | 105 | cryptohash >=0.11 && <0.12, |
106 | either >=4.4, | ||
105 | hex >= 0.1, | 107 | hex >= 0.1, |
106 | tasty >= 0.10, | 108 | tasty >= 0.10, |
107 | tasty-hunit >= 0.9, | 109 | tasty-hunit >= 0.9, |
108 | tasty-quickcheck >= 0.8, | 110 | tasty-quickcheck >= 0.8, |
109 | QuickCheck >= 2.8, | 111 | QuickCheck >= 2.8, |
110 | hmacaroons | 112 | deepseq >= 1.1, |
113 | transformers >= 0.4 | ||
@@ -1,5 +1,5 @@ | |||
1 | with (import <nixpkgs> {}).pkgs; | 1 | { pkgs ? import <nixpkgs> {}, compiler ? "ghc7101" }: |
2 | let hspkgs = haskell-ng.packages.ghc7101.override { | 2 | let hspkgs = pkgs.haskell.packages.${compiler}.override { |
3 | overrides = self: super: { | 3 | overrides = self: super: { |
4 | hmacaroons = self.callPackage ./. {}; | 4 | hmacaroons = self.callPackage ./. {}; |
5 | }; | 5 | }; |
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 02cb448..a739437 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,79 +16,75 @@ 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.Monad |
27 | import Control.Monad.IO.Class | ||
28 | import Data.Attoparsec.ByteString | ||
29 | import Data.Attoparsec.ByteString.Char8 | ||
29 | import Data.Bool | 30 | import Data.Bool |
30 | import qualified Data.ByteString as BS | 31 | import qualified Data.ByteString as BS |
31 | import Data.Byteable | 32 | import Data.Either.Combinators |
32 | import Data.Foldable | ||
33 | import Data.Function | ||
34 | import Data.Maybe | ||
35 | import Data.Traversable | ||
36 | import Data.Attoparsec.ByteString | ||
37 | import Data.Attoparsec.ByteString.Char8 | ||
38 | 33 | ||
39 | import Crypto.Macaroon.Internal | 34 | import Crypto.Macaroon.Internal |
35 | import Crypto.Macaroon.Verifier.Internal | ||
36 | |||
37 | |||
38 | |||
39 | |||
40 | -- (.<) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
41 | -- (.<) = verifyOpBool "Greater or equal" (<) "<" | ||
42 | |||
43 | -- (.<=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
44 | -- (.<=) = verifyOpBool "Strictly greater" (<=) "<=" | ||
45 | |||
46 | -- (.==) :: (MonadIO m, Eq a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
47 | -- (.==) = verifyOpBool "Not equal" (==) "=" | ||
48 | |||
49 | -- (.>) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
50 | -- (.>) = verifyOpBool "Less or equal" (>) ">" | ||
51 | |||
52 | -- (.>=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
53 | -- (.>=) = verifyOpBool "Strictly less" (>=) ">=" | ||
54 | |||
55 | -- | Verify a Macaroon's signature and caveats, given the corresponding Secret | ||
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) | ||
72 | verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers) | ||
73 | |||
74 | |||
75 | -- verifyOpBool :: MonadIO m => String -> Parser a -> (a -> a -> Bool) -> BS.ByteString -> Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
76 | -- verifyOpBool err p f op k val = verifyParser k valueParser $ \s -> do | ||
77 | -- expected <- val | ||
78 | -- return $ bool (Left $ ValidatorError err) (Right Win) =<< f expected <$> mapLeft ParseError (parseOnly p s) | ||
79 | -- where | ||
80 | -- valueParser = string op *> skipSpace *> takeByteString | ||
81 | |||
82 | -- verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat)) | ||
83 | -- verifyParser k p f c = case parseOnly keyParser . cid $ c of | ||
84 | -- Left _ -> return Nothing | ||
85 | -- Right bs -> Just <$> case parseOnly p bs of | ||
86 | -- Left err -> return $ Left $ ParseError err | ||
87 | -- Right a -> fmap (const c) <$> f a | ||
88 | -- where | ||
89 | -- keyParser = string k *> skipSpace *> takeByteString | ||
40 | 90 | ||
41 | |||
42 | -- | Opaque datatype for now. Might need more explicit errors | ||
43 | data Verified = Ok | Failed deriving (Show,Eq) | ||
44 | |||
45 | instance Monoid Verified where | ||
46 | mempty = Ok | ||
47 | mappend Ok Ok = Ok | ||
48 | mappend _ _ = Failed | ||
49 | |||
50 | |||
51 | data CaveatVerifier = CV { vFun :: Caveat -> Maybe Verified , helpText :: String} | ||
52 | |||
53 | instance Eq CaveatVerifier where | ||
54 | (==) = (==) `on` helpText | ||
55 | |||
56 | instance Show CaveatVerifier where | ||
57 | show = helpText | ||
58 | |||
59 | (<???>) :: (Caveat -> Maybe Verified) -> String -> CaveatVerifier | ||
60 | f <???> t = CV f t | ||
61 | |||
62 | verifySig :: Key -> Macaroon -> Verified | ||
63 | verifySig k m = bool Failed Ok $ | ||
64 | signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m) | ||
65 | where | ||
66 | hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) | ||
67 | derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) | ||
68 | |||
69 | verifyMacaroon :: Key -> [CaveatVerifier] -> Macaroon -> Verified | ||
70 | verifyMacaroon secret verifiers m = verifySig secret m `mappend` verifyCavs verifiers m | ||
71 | |||
72 | |||
73 | verifyCavs :: [CaveatVerifier] -> Macaroon -> Verified | ||
74 | verifyCavs verifiers m = foldMap (\c -> fromMaybe Failed $ foldMap (($ c) . vFun) verifiers) (caveats m) | ||
75 | |||
76 | verifyExact :: (Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified | ||
77 | verifyExact k expected = verifyFun k (expected ==) | ||
78 | |||
79 | verifyFun :: Key -> (a -> Bool) -> Parser a -> Caveat -> Maybe Verified | ||
80 | verifyFun key f parser cav = if key `BS.isPrefixOf` cid cav then | ||
81 | case parseOnly kvparser (cid cav) of | ||
82 | Right v -> (bool Failed Ok . f) <$> Just v | ||
83 | Left _ -> Just Failed | ||
84 | else Nothing | ||
85 | where | ||
86 | kvparser = do | ||
87 | key <- string key | ||
88 | skipSpace | ||
89 | string "=" | ||
90 | skipSpace | ||
91 | parser <* endOfInput | ||
diff --git a/src/Crypto/Macaroon/Verifier/Internal.hs b/src/Crypto/Macaroon/Verifier/Internal.hs new file mode 100644 index 0000000..2af55d3 --- /dev/null +++ b/src/Crypto/Macaroon/Verifier/Internal.hs | |||
@@ -0,0 +1,78 @@ | |||
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.Monad | ||
18 | import Control.Monad.IO.Class | ||
19 | import Crypto.Hash | ||
20 | import Data.Bool | ||
21 | import Data.Byteable | ||
22 | import qualified Data.ByteString as BS | ||
23 | import Data.Either | ||
24 | import Data.Either.Validation | ||
25 | import Data.Foldable | ||
26 | import Data.Maybe | ||
27 | import Data.Monoid | ||
28 | |||
29 | import Crypto.Macaroon.Internal | ||
30 | |||
31 | -- | Type representing different validation errors. | ||
32 | -- Only 'ParseError' and 'ValidatorError' are exported, 'SigMismatch' and | ||
33 | -- 'NoVerifier' are used internally and should not be used by the user | ||
34 | data ValidationError = SigMismatch -- ^ Signatures do not match | ||
35 | | NoVerifier -- ^ No verifier can handle a given caveat | ||
36 | | ParseError String -- ^ A verifier had a parse error | ||
37 | | ValidatorError String -- ^ A verifier failed | ||
38 | deriving (Show,Eq) | ||
39 | |||
40 | -- | The 'Monoid' instance is written so 'SigMismatch' is an annihilator, | ||
41 | -- and 'NoVerifier' is the identity element | ||
42 | instance Monoid ValidationError where | ||
43 | mempty = NoVerifier | ||
44 | NoVerifier `mappend` e = e | ||
45 | e `mappend` NoVerifier = e | ||
46 | SigMismatch `mappend` _ = SigMismatch | ||
47 | _ `mappend` SigMismatch = SigMismatch | ||
48 | (ValidatorError e) `mappend` (ParseError _) = ValidatorError e | ||
49 | (ParseError _) `mappend` (ValidatorError e) = ValidatorError e | ||
50 | |||
51 | -- | Check that the given macaroon has a correct signature | ||
52 | verifySig :: Key -> Macaroon -> Either ValidationError Macaroon | ||
53 | verifySig k m = bool (Left SigMismatch) (Right m) $ | ||
54 | signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m) | ||
55 | where | ||
56 | hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) | ||
57 | derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) | ||
58 | |||
59 | -- | Given a list of verifiers, verify each caveat of the given macaroon | ||
60 | verifyCavs :: MonadIO m | ||
61 | => [Caveat -> m (Maybe (Either ValidationError ()))] | ||
62 | -> Macaroon | ||
63 | -> m (Either ValidationError Macaroon) | ||
64 | verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) | ||
65 | where | ||
66 | {- | ||
67 | - validateCaveat :: Caveat -> m (Validation String Caveat) | ||
68 | - We can use fromJust here safely since we use a `Just Failure` as a | ||
69 | - starting value for the foldM. We are guaranteed to have a `Just something` | ||
70 | - from it. | ||
71 | -} | ||
72 | validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers | ||
73 | -- defErr :: Caveat -> Maybe (Validation String Caveat) | ||
74 | defErr c = Just $ Failure NoVerifier | ||
75 | -- gatherEithers :: [Validation String Caveat] -> Either String Caveat | ||
76 | gatherEithers vs = case partitionEithers . map validationToEither $ vs of | ||
77 | ([],_) -> Right m | ||
78 | (errs,_) -> Left (mconcat errs) | ||
diff --git a/test/Crypto/Macaroon/Instances.hs b/test/Crypto/Macaroon/Instances.hs index 6955637..6348c56 100644 --- a/test/Crypto/Macaroon/Instances.hs +++ b/test/Crypto/Macaroon/Instances.hs | |||
@@ -11,9 +11,9 @@ This test suite is based on the pymacaroons test suite: | |||
11 | -} | 11 | -} |
12 | module Crypto.Macaroon.Instances where | 12 | module Crypto.Macaroon.Instances where |
13 | 13 | ||
14 | import Control.Monad | 14 | import Control.Monad |
15 | import Data.Byteable | 15 | import Data.Byteable |
16 | import qualified Data.ByteString as BS | 16 | import qualified Data.ByteString as BS |
17 | import qualified Data.ByteString.Char8 as B8 | 17 | import qualified Data.ByteString.Char8 as B8 |
18 | import Data.Hex | 18 | import Data.Hex |
19 | import Data.List | 19 | import Data.List |
@@ -32,10 +32,10 @@ instance Arbitrary Url where | |||
32 | domain <- elements [".com",".net"] | 32 | domain <- elements [".com",".net"] |
33 | return . Url . B8.pack $ (protocol ++ name ++ domain) | 33 | return . Url . B8.pack $ (protocol ++ name ++ domain) |
34 | 34 | ||
35 | newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show) | 35 | newtype BSSecret = BSSecret { unSecret :: BS.ByteString } deriving (Show) |
36 | 36 | ||
37 | instance Arbitrary Secret where | 37 | instance Arbitrary BSSecret where |
38 | arbitrary = Secret . B8.pack <$> scale (*3) arbitrary | 38 | arbitrary = BSSecret . B8.pack <$> scale (*3) arbitrary |
39 | 39 | ||
40 | newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show) | 40 | newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show) |
41 | 41 | ||
diff --git a/test/Crypto/Macaroon/Tests.hs b/test/Crypto/Macaroon/Tests.hs index 25d77c8..c934cc1 100644 --- a/test/Crypto/Macaroon/Tests.hs +++ b/test/Crypto/Macaroon/Tests.hs | |||
@@ -12,7 +12,7 @@ This test suite is based on the pymacaroons test suite: | |||
12 | module Crypto.Macaroon.Tests where | 12 | module Crypto.Macaroon.Tests where |
13 | 13 | ||
14 | import Data.Byteable | 14 | import Data.Byteable |
15 | import qualified Data.ByteString.Char8 as B8 | 15 | import qualified Data.ByteString.Char8 as B8 |
16 | import Data.Hex | 16 | import Data.Hex |
17 | import Test.Tasty | 17 | import Test.Tasty |
18 | import Test.Tasty.HUnit | 18 | import Test.Tasty.HUnit |
diff --git a/test/Crypto/Macaroon/Verifier/Internal/Tests.hs b/test/Crypto/Macaroon/Verifier/Internal/Tests.hs new file mode 100644 index 0000000..cd75118 --- /dev/null +++ b/test/Crypto/Macaroon/Verifier/Internal/Tests.hs | |||
@@ -0,0 +1,30 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | {-| | ||
3 | Copyright : (c) 2015 Julien Tanguy | ||
4 | License : BSD3 | ||
5 | |||
6 | Maintainer : julien.tanguy@jhome.fr | ||
7 | |||
8 | |||
9 | This test suite is based on the pymacaroons test suite: | ||
10 | <https://github.com/ecordell/pymacaroons> | ||
11 | -} | ||
12 | module Crypto.Macaroon.Verifier.Internal.Tests where | ||
13 | |||
14 | import qualified Data.ByteString.Char8 as B8 | ||
15 | import Data.List | ||
16 | import Test.Tasty | ||
17 | -- import Test.Tasty.HUnit | ||
18 | import Data.Either | ||
19 | import Test.Tasty.QuickCheck hiding (Failure, Success) | ||
20 | |||
21 | import Crypto.Macaroon | ||
22 | import Crypto.Macaroon.Verifier.Internal | ||
23 | |||
24 | import Crypto.Macaroon.Instances | ||
25 | |||
26 | tests :: TestTree | ||
27 | tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs | ||
28 | ] | ||
29 | |||
30 | sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm) | ||
diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs index 101fa26..b6220eb 100644 --- a/test/Crypto/Macaroon/Verifier/Tests.hs +++ b/test/Crypto/Macaroon/Verifier/Tests.hs | |||
@@ -12,21 +12,20 @@ This test suite is based on the pymacaroons test suite: | |||
12 | module Crypto.Macaroon.Verifier.Tests where | 12 | module Crypto.Macaroon.Verifier.Tests where |
13 | 13 | ||
14 | 14 | ||
15 | import Data.List | 15 | import qualified Data.ByteString.Char8 as B8 |
16 | import qualified Data.ByteString.Char8 as B8 | 16 | import Data.List |
17 | import Test.Tasty | 17 | import Test.Tasty |
18 | -- import Test.Tasty.HUnit | 18 | -- import Test.Tasty.HUnit |
19 | import Test.Tasty.QuickCheck | 19 | import Data.Either |
20 | import Test.Tasty.QuickCheck hiding (Failure, Success) | ||
20 | 21 | ||
21 | import Crypto.Macaroon | 22 | import Crypto.Macaroon |
22 | import Crypto.Macaroon.Verifier | 23 | import Crypto.Macaroon.Verifier |
23 | 24 | ||
24 | import Crypto.Macaroon.Instances | 25 | import Crypto.Macaroon.Instances |
25 | 26 | ||
26 | tests :: TestTree | 27 | tests :: TestTree |
27 | tests = testGroup "Crypto.Macaroon.Verifier" [ sigs | 28 | tests = testGroup "Crypto.Macaroon.Verifier" [ ] |
28 | , firstParty | ||
29 | ] | ||
30 | 29 | ||
31 | {- | 30 | {- |
32 | - Test fixtures | 31 | - Test fixtures |
@@ -45,52 +44,44 @@ m2 = addFirstPartyCaveat "test = caveat" m | |||
45 | m3 :: Macaroon | 44 | m3 :: Macaroon |
46 | m3 = addFirstPartyCaveat "value = 42" m2 | 45 | m3 = addFirstPartyCaveat "value = 42" m2 |
47 | 46 | ||
48 | exTC = verifyExact "test" "caveat" (many' letter_ascii) <???> "test = caveat" | ||
49 | exTZ = verifyExact "test" "bleh" (many' letter_ascii) <???> "test = bleh" | ||
50 | exV42 = verifyExact "value" 42 decimal <???> "value = 42" | ||
51 | exV43 = verifyExact "value" 43 decimal <???> "value = 43" | ||
52 | |||
53 | funTCPre = verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) <???> "test startsWith cav" | ||
54 | funTV43lte = verifyFun "value" (<= 43) decimal <???> "value <= 43" | ||
55 | |||
56 | allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte] | ||
57 | |||
58 | {- | 47 | {- |
59 | - Tests | 48 | - Tests |
60 | -} | 49 | -} |
61 | sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Ok | ||
62 | 50 | ||
51 | -- TODO: Re-do tests | ||
52 | {- | ||
63 | firstParty = testGroup "First party caveats" [ | 53 | firstParty = testGroup "First party caveats" [ |
64 | testGroup "Pure verifiers" [ | 54 | testGroup "Pure verifiers" [ |
65 | testProperty "Zero caveat" $ | 55 | testProperty "Zero caveat" $ |
66 | forAll (sublistOf allvs) (\vs -> Ok == verifyCavs vs m) | 56 | forAll (sublistOf allvs) (\vs -> Right m == verifyCavs vs m) |
67 | , testProperty "One caveat" $ | 57 | , testProperty "One caveat" $ |
68 | forAll (sublistOf allvs) (\vs -> disjoin [ | 58 | forAll (sublistOf allvs) (\vs -> disjoin [ |
69 | Ok == verifyCavs vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) | 59 | Right m2 == verifyCavs vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) |
70 | , Failed === verifyCavs vs m2 | 60 | , True === isLeft( verifyCavs vs m2) |
71 | ]) | 61 | ]) |
72 | , testProperty "Two Exact" $ | 62 | , testProperty "Two Exact" $ |
73 | forAll (sublistOf allvs) (\vs -> disjoin [ | 63 | forAll (sublistOf allvs) (\vs -> disjoin [ |
74 | Ok == verifyCavs vs m3 .&&. | 64 | Right m3 == verifyCavs vs m3 .&&. |
75 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. | 65 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. |
76 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) | 66 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) |
77 | , Failed === verifyCavs vs m3 | 67 | , True === isLeft (verifyCavs vs m3) |
78 | ]) | 68 | ]) |
79 | ] | 69 | ] |
80 | , testGroup "Pure verifiers with sig" [ | 70 | , testGroup "Pure verifiers with sig" [ |
81 | testProperty "Zero caveat" $ | 71 | testProperty "Zero caveat" $ |
82 | forAll (sublistOf allvs) (\vs -> Ok == verifyMacaroon sec vs m) | 72 | forAll (sublistOf allvs) (\vs -> Right m == verifyMacaroon sec vs m) |
83 | , testProperty "One caveat" $ | 73 | , testProperty "One caveat" $ |
84 | forAll (sublistOf allvs) (\vs -> disjoin [ | 74 | forAll (sublistOf allvs) (\vs -> disjoin [ |
85 | Ok == verifyMacaroon sec vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) | 75 | Right m2 == verifyMacaroon sec vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) |
86 | , Failed === verifyMacaroon sec vs m2 | 76 | , True === isLeft (verifyMacaroon sec vs m2) |
87 | ]) | 77 | ]) |
88 | , testProperty "Two Exact" $ | 78 | , testProperty "Two Exact" $ |
89 | forAll (sublistOf allvs) (\vs -> disjoin [ | 79 | forAll (sublistOf allvs) (\vs -> disjoin [ |
90 | Ok == verifyMacaroon sec vs m3 .&&. | 80 | Right m3 == verifyMacaroon sec vs m3 .&&. |
91 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. | 81 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. |
92 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) | 82 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) |
93 | , Failed === verifyMacaroon sec vs m3 | 83 | , True === isLeft (verifyMacaroon sec vs m3) |
94 | ]) | 84 | ]) |
95 | ] | 85 | ] |
96 | ] | 86 | ] |
87 | -} | ||
diff --git a/test/Sanity.hs b/test/Sanity.hs index 8def3ca..635e627 100644 --- a/test/Sanity.hs +++ b/test/Sanity.hs | |||
@@ -1,17 +1,17 @@ | |||
1 | {-#LANGUAGE OverloadedStrings#-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | module Sanity where | 2 | module Sanity where |
3 | 3 | ||
4 | import Crypto.Hash | 4 | import Crypto.Hash |
5 | import Data.ByteString (ByteString) | 5 | import Data.Byteable |
6 | import qualified Data.ByteString as B | 6 | import Data.ByteString (ByteString) |
7 | import Data.Hex | 7 | import qualified Data.ByteString as B |
8 | import Data.Byteable | 8 | import Data.Hex |
9 | 9 | ||
10 | import Test.Tasty | 10 | import Test.Tasty |
11 | import Test.Tasty.HUnit | 11 | import Test.Tasty.HUnit |
12 | 12 | ||
13 | import qualified Crypto.Macaroon.Tests | ||
14 | import qualified Crypto.Macaroon.Serializer.Base64.Tests | 13 | import qualified Crypto.Macaroon.Serializer.Base64.Tests |
14 | import qualified Crypto.Macaroon.Tests | ||
15 | 15 | ||
16 | tests :: TestTree | 16 | tests :: TestTree |
17 | tests = testGroup "Python HMAC Sanity check" [ checkKey | 17 | tests = testGroup "Python HMAC Sanity check" [ checkKey |
@@ -44,18 +44,18 @@ mac4 :: ByteString | |||
44 | mac4 = toBytes (hmac mac3 "email = alice@example.org" :: HMAC SHA256) | 44 | mac4 = toBytes (hmac mac3 "email = alice@example.org" :: HMAC SHA256) |
45 | 45 | ||
46 | 46 | ||
47 | checkKey = testCase "Truncated key" $ | 47 | checkKey = testCase "Truncated key" $ |
48 | key @?= "this is our super secret key; on" | 48 | key @?= "this is our super secret key; on" |
49 | 49 | ||
50 | checkMac1 = testCase "HMAC key" $ | 50 | checkMac1 = testCase "HMAC key" $ |
51 | "C60B4B3540BB1B2F2EF28D1C895691CC4A5E07A38A9D3B1C3379FB485293372F" @=? hex mac1 | 51 | "C60B4B3540BB1B2F2EF28D1C895691CC4A5E07A38A9D3B1C3379FB485293372F" @=? hex mac1 |
52 | 52 | ||
53 | checkMac2 = testCase "HMAC key account" $ | 53 | checkMac2 = testCase "HMAC key account" $ |
54 | "5C933DC9A7D036DFCD1740B4F26D737397A1FF635EAC900F3226973503CAAAA5" @=? hex mac2 | 54 | "5C933DC9A7D036DFCD1740B4F26D737397A1FF635EAC900F3226973503CAAAA5" @=? hex mac2 |
55 | 55 | ||
56 | checkMac3 = testCase "HMAC key account time" $ | 56 | checkMac3 = testCase "HMAC key account time" $ |
57 | "7A559B20C8B607009EBCE138C200585E9D0DECA6D23B3EAD6C5E0BA6861D3858" @=? hex mac3 | 57 | "7A559B20C8B607009EBCE138C200585E9D0DECA6D23B3EAD6C5E0BA6861D3858" @=? hex mac3 |
58 | 58 | ||
59 | checkMac4 = testCase "HMAC key account time email" $ | 59 | checkMac4 = testCase "HMAC key account time email" $ |
60 | "E42BBB02A9A5A303483CB6295C497AE51AD1D5CB10003CBE548D907E7E62F5E4" @=? hex mac4 | 60 | "E42BBB02A9A5A303483CB6295C497AE51AD1D5CB10003CBE548D907E7E62F5E4" @=? hex mac4 |
61 | 61 | ||
diff --git a/test/main.hs b/test/main.hs index 3edbe54..67ebcd5 100644 --- a/test/main.hs +++ b/test/main.hs | |||
@@ -1,12 +1,13 @@ | |||
1 | module Main where | 1 | module Main where |
2 | 2 | ||
3 | import Test.Tasty | 3 | import Test.Tasty |
4 | import Test.Tasty.HUnit | 4 | import Test.Tasty.HUnit |
5 | 5 | ||
6 | import qualified Sanity | ||
7 | import qualified Crypto.Macaroon.Tests | ||
8 | import qualified Crypto.Macaroon.Serializer.Base64.Tests | 6 | import qualified Crypto.Macaroon.Serializer.Base64.Tests |
7 | import qualified Crypto.Macaroon.Tests | ||
8 | import qualified Crypto.Macaroon.Verifier.Internal.Tests | ||
9 | import qualified Crypto.Macaroon.Verifier.Tests | 9 | import qualified Crypto.Macaroon.Verifier.Tests |
10 | import qualified Sanity | ||
10 | 11 | ||
11 | main = defaultMain tests | 12 | main = defaultMain tests |
12 | 13 | ||
@@ -15,5 +16,6 @@ tests = testGroup "Tests" [ Sanity.tests | |||
15 | , Crypto.Macaroon.Tests.tests | 16 | , Crypto.Macaroon.Tests.tests |
16 | , Crypto.Macaroon.Serializer.Base64.Tests.tests | 17 | , Crypto.Macaroon.Serializer.Base64.Tests.tests |
17 | , Crypto.Macaroon.Verifier.Tests.tests | 18 | , Crypto.Macaroon.Verifier.Tests.tests |
19 | , Crypto.Macaroon.Verifier.Internal.Tests.tests | ||
18 | ] | 20 | ] |
19 | 21 | ||