aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--default.nix10
-rw-r--r--hmacaroons.cabal21
-rw-r--r--shell.nix4
-rw-r--r--src/Crypto/Macaroon.hs21
-rw-r--r--src/Crypto/Macaroon/Internal.hs6
-rw-r--r--src/Crypto/Macaroon/Verifier.hs141
-rw-r--r--src/Crypto/Macaroon/Verifier/Internal.hs78
-rw-r--r--test/Crypto/Macaroon/Instances.hs10
-rw-r--r--test/Crypto/Macaroon/Tests.hs2
-rw-r--r--test/Crypto/Macaroon/Verifier/Internal/Tests.hs30
-rw-r--r--test/Crypto/Macaroon/Verifier/Tests.hs49
-rw-r--r--test/Sanity.hs26
-rw-r--r--test/main.hs10
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}:
5mkDerivation { 5mkDerivation {
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 @@
1name: hmacaroons 1name: hmacaroons
2version: 0.1.0.0 2version: 0.3.0.0
3synopsis: Haskell implementation of macaroons 3synopsis: Haskell implementation of macaroons
4description: 4description:
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
55library 52library
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
93test-suite test 94test-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
diff --git a/shell.nix b/shell.nix
index 07952fc..3846dd5 100644
--- a/shell.nix
+++ b/shell.nix
@@ -1,5 +1,5 @@
1with (import <nixpkgs> {}).pkgs; 1{ pkgs ? import <nixpkgs> {}, compiler ? "ghc7101" }:
2let hspkgs = haskell-ng.packages.ghc7101.override { 2let 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
54import Crypto.Macaroon.Internal 55import 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
57create :: Key -> Key -> Location -> Macaroon 58create :: Secret -> Key -> Location -> Macaroon
58create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) 59create 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
63caveatLoc :: Caveat -> Location
64caveatLoc = cl
65
66-- | Caveat identifier
67caveatId :: Caveat -> Key
68caveatId = cid
69
70-- | Caveat verification identifier
71caveatVId :: Caveat -> Key
72caveatVId = vid
73
74-- | Inspect a macaroon's contents. For debugging purposes. 63-- | Inspect a macaroon's contents. For debugging purposes.
75inspect :: Macaroon -> String 64inspect :: Macaroon -> String
76inspect = show 65inspect = 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
23import Data.Hex 23import Data.Hex
24import Data.List 24import Data.List
25 25
26-- |Type alias for Macaroons and Caveat keys and identifiers 26
27-- |Type alias for Macaroons secret keys
28type Secret = BS.ByteString
29
30-- |Type alias for Macaroons and Caveat and identifiers
27type Key = BS.ByteString 31type 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{-|
4Module : Crypto.Macaroon.Verifier 7Module : Crypto.Macaroon.Verifier
5Copyright : (c) 2015 Julien Tanguy 8Copyright : (c) 2015 Julien Tanguy
@@ -13,79 +16,75 @@ Portability : portable
13 16
14-} 17-}
15module Crypto.Macaroon.Verifier ( 18module 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
28import Crypto.Hash 26import Control.Monad
27import Control.Monad.IO.Class
28import Data.Attoparsec.ByteString
29import Data.Attoparsec.ByteString.Char8
29import Data.Bool 30import Data.Bool
30import qualified Data.ByteString as BS 31import qualified Data.ByteString as BS
31import Data.Byteable 32import Data.Either.Combinators
32import Data.Foldable
33import Data.Function
34import Data.Maybe
35import Data.Traversable
36import Data.Attoparsec.ByteString
37import Data.Attoparsec.ByteString.Char8
38 33
39import Crypto.Macaroon.Internal 34import Crypto.Macaroon.Internal
35import 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
71verify :: MonadIO m => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon)
72verify 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
43data Verified = Ok | Failed deriving (Show,Eq)
44
45instance Monoid Verified where
46 mempty = Ok
47 mappend Ok Ok = Ok
48 mappend _ _ = Failed
49
50
51data CaveatVerifier = CV { vFun :: Caveat -> Maybe Verified , helpText :: String}
52
53instance Eq CaveatVerifier where
54 (==) = (==) `on` helpText
55
56instance Show CaveatVerifier where
57 show = helpText
58
59(<???>) :: (Caveat -> Maybe Verified) -> String -> CaveatVerifier
60f <???> t = CV f t
61
62verifySig :: Key -> Macaroon -> Verified
63verifySig 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
69verifyMacaroon :: Key -> [CaveatVerifier] -> Macaroon -> Verified
70verifyMacaroon secret verifiers m = verifySig secret m `mappend` verifyCavs verifiers m
71
72
73verifyCavs :: [CaveatVerifier] -> Macaroon -> Verified
74verifyCavs verifiers m = foldMap (\c -> fromMaybe Failed $ foldMap (($ c) . vFun) verifiers) (caveats m)
75
76verifyExact :: (Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified
77verifyExact k expected = verifyFun k (expected ==)
78
79verifyFun :: Key -> (a -> Bool) -> Parser a -> Caveat -> Maybe Verified
80verifyFun 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{-|
4Module : Crypto.Macaroon.Verifier.Internal
5Copyright : (c) 2015 Julien Tanguy
6License : BSD3
7
8Maintainer : julien.tanguy@jhome.fr
9Stability : experimental
10Portability : portable
11
12
13
14-}
15module Crypto.Macaroon.Verifier.Internal where
16
17import Control.Monad
18import Control.Monad.IO.Class
19import Crypto.Hash
20import Data.Bool
21import Data.Byteable
22import qualified Data.ByteString as BS
23import Data.Either
24import Data.Either.Validation
25import Data.Foldable
26import Data.Maybe
27import Data.Monoid
28
29import 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
34data 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
42instance 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
52verifySig :: Key -> Macaroon -> Either ValidationError Macaroon
53verifySig 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
60verifyCavs :: MonadIO m
61 => [Caveat -> m (Maybe (Either ValidationError ()))]
62 -> Macaroon
63 -> m (Either ValidationError Macaroon)
64verifyCavs 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-}
12module Crypto.Macaroon.Instances where 12module Crypto.Macaroon.Instances where
13 13
14import Control.Monad 14import Control.Monad
15import Data.Byteable 15import Data.Byteable
16import qualified Data.ByteString as BS 16import qualified Data.ByteString as BS
17import qualified Data.ByteString.Char8 as B8 17import qualified Data.ByteString.Char8 as B8
18import Data.Hex 18import Data.Hex
19import Data.List 19import 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
35newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show) 35newtype BSSecret = BSSecret { unSecret :: BS.ByteString } deriving (Show)
36 36
37instance Arbitrary Secret where 37instance Arbitrary BSSecret where
38 arbitrary = Secret . B8.pack <$> scale (*3) arbitrary 38 arbitrary = BSSecret . B8.pack <$> scale (*3) arbitrary
39 39
40newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show) 40newtype 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:
12module Crypto.Macaroon.Tests where 12module Crypto.Macaroon.Tests where
13 13
14import Data.Byteable 14import Data.Byteable
15import qualified Data.ByteString.Char8 as B8 15import qualified Data.ByteString.Char8 as B8
16import Data.Hex 16import Data.Hex
17import Test.Tasty 17import Test.Tasty
18import Test.Tasty.HUnit 18import 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{-|
3Copyright : (c) 2015 Julien Tanguy
4License : BSD3
5
6Maintainer : julien.tanguy@jhome.fr
7
8
9This test suite is based on the pymacaroons test suite:
10<https://github.com/ecordell/pymacaroons>
11-}
12module Crypto.Macaroon.Verifier.Internal.Tests where
13
14import qualified Data.ByteString.Char8 as B8
15import Data.List
16import Test.Tasty
17-- import Test.Tasty.HUnit
18import Data.Either
19import Test.Tasty.QuickCheck hiding (Failure, Success)
20
21import Crypto.Macaroon
22import Crypto.Macaroon.Verifier.Internal
23
24import Crypto.Macaroon.Instances
25
26tests :: TestTree
27tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs
28 ]
29
30sigs = 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:
12module Crypto.Macaroon.Verifier.Tests where 12module Crypto.Macaroon.Verifier.Tests where
13 13
14 14
15import Data.List 15import qualified Data.ByteString.Char8 as B8
16import qualified Data.ByteString.Char8 as B8 16import Data.List
17import Test.Tasty 17import Test.Tasty
18-- import Test.Tasty.HUnit 18-- import Test.Tasty.HUnit
19import Test.Tasty.QuickCheck 19import Data.Either
20import Test.Tasty.QuickCheck hiding (Failure, Success)
20 21
21import Crypto.Macaroon 22import Crypto.Macaroon
22import Crypto.Macaroon.Verifier 23import Crypto.Macaroon.Verifier
23 24
24import Crypto.Macaroon.Instances 25import Crypto.Macaroon.Instances
25 26
26tests :: TestTree 27tests :: TestTree
27tests = testGroup "Crypto.Macaroon.Verifier" [ sigs 28tests = 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
45m3 :: Macaroon 44m3 :: Macaroon
46m3 = addFirstPartyCaveat "value = 42" m2 45m3 = addFirstPartyCaveat "value = 42" m2
47 46
48exTC = verifyExact "test" "caveat" (many' letter_ascii) <???> "test = caveat"
49exTZ = verifyExact "test" "bleh" (many' letter_ascii) <???> "test = bleh"
50exV42 = verifyExact "value" 42 decimal <???> "value = 42"
51exV43 = verifyExact "value" 43 decimal <???> "value = 43"
52
53funTCPre = verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) <???> "test startsWith cav"
54funTV43lte = verifyFun "value" (<= 43) decimal <???> "value <= 43"
55
56allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte]
57
58{- 47{-
59 - Tests 48 - Tests
60 -} 49 -}
61sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Ok
62 50
51-- TODO: Re-do tests
52{-
63firstParty = testGroup "First party caveats" [ 53firstParty = 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 #-}
2module Sanity where 2module Sanity where
3 3
4import Crypto.Hash 4import Crypto.Hash
5import Data.ByteString (ByteString) 5import Data.Byteable
6import qualified Data.ByteString as B 6import Data.ByteString (ByteString)
7import Data.Hex 7import qualified Data.ByteString as B
8import Data.Byteable 8import Data.Hex
9 9
10import Test.Tasty 10import Test.Tasty
11import Test.Tasty.HUnit 11import Test.Tasty.HUnit
12 12
13import qualified Crypto.Macaroon.Tests
14import qualified Crypto.Macaroon.Serializer.Base64.Tests 13import qualified Crypto.Macaroon.Serializer.Base64.Tests
14import qualified Crypto.Macaroon.Tests
15 15
16tests :: TestTree 16tests :: TestTree
17tests = testGroup "Python HMAC Sanity check" [ checkKey 17tests = testGroup "Python HMAC Sanity check" [ checkKey
@@ -44,18 +44,18 @@ mac4 :: ByteString
44mac4 = toBytes (hmac mac3 "email = alice@example.org" :: HMAC SHA256) 44mac4 = toBytes (hmac mac3 "email = alice@example.org" :: HMAC SHA256)
45 45
46 46
47checkKey = testCase "Truncated key" $ 47checkKey = testCase "Truncated key" $
48 key @?= "this is our super secret key; on" 48 key @?= "this is our super secret key; on"
49 49
50checkMac1 = testCase "HMAC key" $ 50checkMac1 = testCase "HMAC key" $
51 "C60B4B3540BB1B2F2EF28D1C895691CC4A5E07A38A9D3B1C3379FB485293372F" @=? hex mac1 51 "C60B4B3540BB1B2F2EF28D1C895691CC4A5E07A38A9D3B1C3379FB485293372F" @=? hex mac1
52 52
53checkMac2 = testCase "HMAC key account" $ 53checkMac2 = testCase "HMAC key account" $
54 "5C933DC9A7D036DFCD1740B4F26D737397A1FF635EAC900F3226973503CAAAA5" @=? hex mac2 54 "5C933DC9A7D036DFCD1740B4F26D737397A1FF635EAC900F3226973503CAAAA5" @=? hex mac2
55 55
56checkMac3 = testCase "HMAC key account time" $ 56checkMac3 = testCase "HMAC key account time" $
57 "7A559B20C8B607009EBCE138C200585E9D0DECA6D23B3EAD6C5E0BA6861D3858" @=? hex mac3 57 "7A559B20C8B607009EBCE138C200585E9D0DECA6D23B3EAD6C5E0BA6861D3858" @=? hex mac3
58 58
59checkMac4 = testCase "HMAC key account time email" $ 59checkMac4 = 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 @@
1module Main where 1module Main where
2 2
3import Test.Tasty 3import Test.Tasty
4import Test.Tasty.HUnit 4import Test.Tasty.HUnit
5 5
6import qualified Sanity
7import qualified Crypto.Macaroon.Tests
8import qualified Crypto.Macaroon.Serializer.Base64.Tests 6import qualified Crypto.Macaroon.Serializer.Base64.Tests
7import qualified Crypto.Macaroon.Tests
8import qualified Crypto.Macaroon.Verifier.Internal.Tests
9import qualified Crypto.Macaroon.Verifier.Tests 9import qualified Crypto.Macaroon.Verifier.Tests
10import qualified Sanity
10 11
11main = defaultMain tests 12main = 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