aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--hmacaroons.cabal10
-rw-r--r--src/Crypto/Macaroon.hs21
-rw-r--r--src/Crypto/Macaroon/Internal.hs6
-rw-r--r--src/Crypto/Macaroon/Verifier.hs35
-rw-r--r--src/Crypto/Macaroon/Verifier/Internal.hs30
-rw-r--r--test/Crypto/Macaroon/Instances.hs6
-rw-r--r--test/Crypto/Macaroon/Verifier/Internal/Tests.hs30
-rw-r--r--test/Crypto/Macaroon/Verifier/Tests.hs28
-rw-r--r--test/main.hs10
9 files changed, 104 insertions, 72 deletions
diff --git a/hmacaroons.cabal b/hmacaroons.cabal
index 9424f22..83b2cd7 100644
--- a/hmacaroons.cabal
+++ b/hmacaroons.cabal
@@ -1,5 +1,5 @@
1name: hmacaroons 1name: hmacaroons
2version: 0.2.0.0 2version: 0.3.0.0
3synopsis: Haskell implementation of macaroons 3synopsis: Haskell implementation of macaroons
4description: 4description:
5 Hmacaroons is a pure haskell implementation of macaroons. It aims to 5 Hmacaroons is a pure haskell implementation of macaroons. It aims to
@@ -51,10 +51,11 @@ source-repository head
51 51
52library 52library
53 exposed-modules: Crypto.Macaroon 53 exposed-modules: Crypto.Macaroon
54 Crypto.Macaroon.Binder 54 -- Crypto.Macaroon.Binder
55 Crypto.Macaroon.Serializer.Base64 55 Crypto.Macaroon.Serializer.Base64
56 Crypto.Macaroon.Verifier 56 Crypto.Macaroon.Verifier
57 other-modules: Crypto.Macaroon.Internal 57 other-modules: Crypto.Macaroon.Internal
58 Crypto.Macaroon.Verifier.Internal
58 build-depends: base >=4 && < 5, 59 build-depends: base >=4 && < 5,
59 attoparsec >=0.12, 60 attoparsec >=0.12,
60 transformers >= 0.4, 61 transformers >= 0.4,
@@ -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,
@@ -108,4 +109,5 @@ test-suite test
108 tasty-hunit >= 0.9, 109 tasty-hunit >= 0.9,
109 tasty-quickcheck >= 0.8, 110 tasty-quickcheck >= 0.8,
110 QuickCheck >= 2.8, 111 QuickCheck >= 2.8,
111 hmacaroons 112 deepseq >= 1.1,
113 transformers >= 0.4
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 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
56verify :: 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
71verify :: MonadIO m => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon)
57verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers) 72verify 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
67verifyParser :: (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))
68verifyParser 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{-|
4Module : Crypto.Macaroon.Verifier.Internal 4Module : Crypto.Macaroon.Verifier.Internal
5Copyright : (c) 2015 Julien Tanguy 5Copyright : (c) 2015 Julien Tanguy
@@ -19,22 +19,26 @@ import Control.Monad.IO.Class
19import Crypto.Hash 19import Crypto.Hash
20import Data.Bool 20import Data.Bool
21import Data.Byteable 21import Data.Byteable
22import qualified Data.ByteString as BS 22import qualified Data.ByteString as BS
23import Data.Either 23import Data.Either
24import Data.Either.Validation 24import Data.Either.Validation
25import Data.Foldable 25import Data.Foldable
26import Data.Maybe 26import Data.Maybe
27import Data.Monoid
27 28
28import Crypto.Macaroon.Internal 29import Crypto.Macaroon.Internal
29 30
30data Win = Win 31-- | Type representing different validation errors.
31 32-- Only 'ParseError' and 'ValidatorError' are exported, 'SigMismatch' and
32data ValidationError = SigMismatch 33-- 'NoVerifier' are used internally and should not be used by the user
33 | NoVerifier 34data 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
38instance Monoid ValidationError where 42instance 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
56verifyCavs :: MonadIO m 60verifyCavs :: 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)
60verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) 64verifyCavs 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
diff --git a/test/Crypto/Macaroon/Instances.hs b/test/Crypto/Macaroon/Instances.hs
index 9c89857..6348c56 100644
--- a/test/Crypto/Macaroon/Instances.hs
+++ b/test/Crypto/Macaroon/Instances.hs
@@ -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/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 670c991..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 hiding (Success, Failure) 19import Data.Either
20import Data.Either 20import Test.Tasty.QuickCheck hiding (Failure, Success)
21 21
22import Crypto.Macaroon 22import Crypto.Macaroon
23import Crypto.Macaroon.Verifier 23import Crypto.Macaroon.Verifier
24 24
25import Crypto.Macaroon.Instances 25import Crypto.Macaroon.Instances
26 26
27tests :: TestTree 27tests :: TestTree
28tests = testGroup "Crypto.Macaroon.Verifier" [ sigs 28tests = testGroup "Crypto.Macaroon.Verifier" [ ]
29 ]
30 29
31{- 30{-
32 - Test fixtures 31 - Test fixtures
@@ -45,22 +44,9 @@ m2 = addFirstPartyCaveat "test = caveat" m
45m3 :: Macaroon 44m3 :: Macaroon
46m3 = addFirstPartyCaveat "value = 42" m2 45m3 = addFirstPartyCaveat "value = 42" m2
47 46
48-- exTC = verifyExact "test" "caveat" (many' letter_ascii)
49-- exTZ = verifyExact "test" "bleh" (many' letter_ascii)
50-- exV42 = verifyExact "value" 42 decimal
51-- exV43 = verifyExact "value" 43 decimal
52
53-- funTCPre = verifyFun "test" (string "test = " *> many' letter_ascii)
54-- (\e -> if "cav" `isPrefixOf` e then Right e else Left "Does not start with cav" )
55-- funTV43lte = verifyFun "value" (string "value = " *> decimal)
56-- (\v -> if v <= 43 then Right v else Left "Greater than 43")
57
58-- allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte]
59
60{- 47{-
61 - Tests 48 - Tests
62 -} 49 -}
63sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm)
64 50
65-- TODO: Re-do tests 51-- TODO: Re-do tests
66{- 52{-
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