diff options
Diffstat (limited to 'test/Crypto/Macaroon/Instances.hs')
-rw-r--r-- | test/Crypto/Macaroon/Instances.hs | 21 |
1 files changed, 20 insertions, 1 deletions
diff --git a/test/Crypto/Macaroon/Instances.hs b/test/Crypto/Macaroon/Instances.hs index 4e2f39f..c82bbd3 100644 --- a/test/Crypto/Macaroon/Instances.hs +++ b/test/Crypto/Macaroon/Instances.hs | |||
@@ -26,9 +26,16 @@ import Crypto.Macaroon | |||
26 | 26 | ||
27 | -- | Adjust the size parameter, by transforming it with the given | 27 | -- | Adjust the size parameter, by transforming it with the given |
28 | -- function. | 28 | -- function. |
29 | -- Copied over from QuickCheck 2.8 | ||
29 | scale :: (Int -> Int) -> Gen a -> Gen a | 30 | scale :: (Int -> Int) -> Gen a -> Gen a |
30 | scale f g = sized (\n -> resize (f n) g) | 31 | scale f g = sized (\n -> resize (f n) g) |
31 | 32 | ||
33 | |||
34 | -- | Generates a random subsequence of the given list. | ||
35 | -- Copied over from QuickCheck 2.8 | ||
36 | sublistOf :: [a] -> Gen [a] | ||
37 | sublistOf = filterM (\_ -> choose (False, True)) | ||
38 | |||
32 | newtype Url = Url { unUrl :: BS.ByteString } deriving (Show) | 39 | newtype Url = Url { unUrl :: BS.ByteString } deriving (Show) |
33 | 40 | ||
34 | instance Arbitrary Url where | 41 | instance Arbitrary Url where |
@@ -48,6 +55,16 @@ newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show) | |||
48 | instance Arbitrary Identifier where | 55 | instance Arbitrary Identifier where |
49 | arbitrary = Identifier . B8.pack <$>(scale (*3) . listOf1 . elements $ ['a'..'z']) | 56 | arbitrary = Identifier . B8.pack <$>(scale (*3) . listOf1 . elements $ ['a'..'z']) |
50 | 57 | ||
58 | newtype EquationLike = EquationLike { unEqlike :: BS.ByteString } deriving (Show) | ||
59 | |||
60 | instance Arbitrary EquationLike where | ||
61 | arbitrary = do | ||
62 | keylen <- choose (3,8) | ||
63 | key <- B8.pack <$> vectorOf keylen (elements ['a'..'z']) | ||
64 | val <- B8.pack <$> (scale (*3) . listOf1 . elements $ ['a'..'z']) | ||
65 | return $ EquationLike (BS.concat [ key, " = ", val]) | ||
66 | |||
67 | |||
51 | data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show | 68 | data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show |
52 | 69 | ||
53 | instance Arbitrary SimpleMac where | 70 | instance Arbitrary SimpleMac where |
@@ -55,6 +72,8 @@ instance Arbitrary SimpleMac where | |||
55 | secret <- unSecret <$> arbitrary | 72 | secret <- unSecret <$> arbitrary |
56 | location <- unUrl <$> arbitrary | 73 | location <- unUrl <$> arbitrary |
57 | ident <- unIdent <$> arbitrary | 74 | ident <- unIdent <$> arbitrary |
58 | return $ SimpleMac secret (create secret ident location) | 75 | fpcavs <- listOf arbitrary |
76 | let mac = foldl (flip addFirstPartyCaveat) (create secret ident location) (map unEqlike fpcavs) | ||
77 | return $ SimpleMac secret mac | ||
59 | 78 | ||
60 | 79 | ||