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/Macaroon/Instances.hs | |
parent | 46af385cc6f7c7e378ef7866a3da4ad9fb6e941c (diff) | |
download | hmacaroons-a22bcdb648d1f540ae895cb246997dcdcce7b568.tar.gz hmacaroons-a22bcdb648d1f540ae895cb246997dcdcce7b568.tar.zst hmacaroons-a22bcdb648d1f540ae895cb246997dcdcce7b568.zip |
Add quickchecked serialization properties
Diffstat (limited to 'test/Crypto/Macaroon/Instances.hs')
-rw-r--r-- | test/Crypto/Macaroon/Instances.hs | 54 |
1 files changed, 54 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 | |||