diff options
author | Julien Tanguy <julien.tanguy@jhome.fr> | 2015-04-15 15:30:28 +0200 |
---|---|---|
committer | Julien Tanguy <julien.tanguy@jhome.fr> | 2015-04-15 15:30:28 +0200 |
commit | a22bcdb648d1f540ae895cb246997dcdcce7b568 (patch) | |
tree | 9b69685f806b1419bea9f1304f73655420ed12b3 /test/Crypto | |
parent | 46af385cc6f7c7e378ef7866a3da4ad9fb6e941c (diff) | |
download | hmacaroons-a22bcdb648d1f540ae895cb246997dcdcce7b568.tar.gz hmacaroons-a22bcdb648d1f540ae895cb246997dcdcce7b568.tar.zst hmacaroons-a22bcdb648d1f540ae895cb246997dcdcce7b568.zip |
Add quickchecked serialization properties
Diffstat (limited to 'test/Crypto')
-rw-r--r-- | test/Crypto/Macaroon/Instances.hs | 54 | ||||
-rw-r--r-- | test/Crypto/Macaroon/Serializer/Base64/Tests.hs | 6 |
2 files changed, 60 insertions, 0 deletions
diff --git a/test/Crypto/Macaroon/Instances.hs b/test/Crypto/Macaroon/Instances.hs new file mode 100644 index 0000000..5d4b062 --- /dev/null +++ b/test/Crypto/Macaroon/Instances.hs | |||
@@ -0,0 +1,54 @@ | |||
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.Instances where | ||
13 | |||
14 | import Control.Monad | ||
15 | import Data.Byteable | ||
16 | import qualified Data.ByteString as BS | ||
17 | import qualified Data.ByteString.Char8 as B8 | ||
18 | import Data.Hex | ||
19 | import Data.List | ||
20 | import Test.Tasty | ||
21 | import Test.Tasty.HUnit | ||
22 | import Test.Tasty.QuickCheck | ||
23 | |||
24 | import Crypto.Macaroon | ||
25 | |||
26 | newtype Url = Url { unUrl :: BS.ByteString } deriving (Show) | ||
27 | |||
28 | instance Arbitrary Url where | ||
29 | arbitrary = do | ||
30 | protocol <- elements ["http://"] | ||
31 | name <- fmap (intercalate ".") <$> listOf1 . listOf1 $ elements ['a'..'z'] | ||
32 | domain <- elements [".com",".net"] | ||
33 | return . Url . B8.pack $ (protocol ++ name ++ domain) | ||
34 | |||
35 | newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show) | ||
36 | |||
37 | instance Arbitrary Secret where | ||
38 | arbitrary = Secret . B8.pack <$> scale (*3) arbitrary | ||
39 | |||
40 | newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show) | ||
41 | |||
42 | instance Arbitrary Identifier where | ||
43 | arbitrary = Identifier . B8.pack <$>(scale (*3) . listOf1 . elements $ ['a'..'z']) | ||
44 | |||
45 | data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show | ||
46 | |||
47 | instance Arbitrary SimpleMac where | ||
48 | arbitrary = do | ||
49 | secret <- unSecret <$> arbitrary | ||
50 | location <- unUrl <$> arbitrary | ||
51 | ident <- unIdent <$> arbitrary | ||
52 | return $ SimpleMac secret (create secret ident location) | ||
53 | |||
54 | |||
diff --git a/test/Crypto/Macaroon/Serializer/Base64/Tests.hs b/test/Crypto/Macaroon/Serializer/Base64/Tests.hs index 9c49e96..fe5352e 100644 --- a/test/Crypto/Macaroon/Serializer/Base64/Tests.hs +++ b/test/Crypto/Macaroon/Serializer/Base64/Tests.hs | |||
@@ -15,17 +15,23 @@ module Crypto.Macaroon.Serializer.Base64.Tests where | |||
15 | import qualified Data.ByteString.Char8 as B8 | 15 | import qualified Data.ByteString.Char8 as B8 |
16 | import Test.Tasty | 16 | import Test.Tasty |
17 | import Test.Tasty.HUnit | 17 | import Test.Tasty.HUnit |
18 | import Test.Tasty.QuickCheck | ||
18 | 19 | ||
19 | import Crypto.Macaroon | 20 | import Crypto.Macaroon |
20 | import Crypto.Macaroon.Serializer.Base64 | 21 | import Crypto.Macaroon.Serializer.Base64 |
21 | 22 | ||
23 | import Crypto.Macaroon.Instances | ||
24 | |||
22 | tests :: TestTree | 25 | tests :: TestTree |
23 | tests = testGroup "Crypto.Macaroon.Serializer.Base64" [ basic | 26 | tests = testGroup "Crypto.Macaroon.Serializer.Base64" [ basic |
27 | , basicQC | ||
24 | , minted | 28 | , minted |
25 | , minted2 | 29 | , minted2 |
26 | -- , minted3 | 30 | -- , minted3 |
27 | ] | 31 | ] |
28 | 32 | ||
33 | basicQC = testProperty "Reversibility" $ | ||
34 | forAll (macaroon <$> arbitrary) (\m -> deserialize (serialize m) == Right m) | ||
29 | 35 | ||
30 | m :: Macaroon | 36 | m :: Macaroon |
31 | m = create secret key loc | 37 | m = create secret key loc |