1 {-# LANGUAGE OverloadedStrings #-}
3 Copyright : (c) 2015 Julien Tanguy
6 Maintainer : julien.tanguy@jhome.fr
9 This test suite is based on the pymacaroons test suite:
10 <https://github.com/ecordell/pymacaroons>
12 module Crypto.Macaroon.Instances where
16 import qualified Data.ByteString as BS
17 import qualified Data.ByteString.Char8 as B8
21 import Test.Tasty.HUnit
22 import Test.Tasty.QuickCheck
24 import Crypto.Macaroon
27 -- | Adjust the size parameter, by transforming it with the given
29 -- Copied over from QuickCheck 2.8
30 scale :: (Int -> Int) -> Gen a -> Gen a
31 scale f g = sized (\n -> resize (f n) g)
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))
39 newtype Url = Url { unUrl :: BS.ByteString } deriving (Show)
41 instance Arbitrary Url where
43 protocol <- elements ["http://"]
44 name <- fmap (intercalate ".") <$> listOf1 . listOf1 $ elements ['a'..'z']
45 domain <- elements [".com",".net"]
46 return . Url . B8.pack $ (protocol ++ name ++ domain)
48 newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show)
50 instance Arbitrary Secret where
51 arbitrary = Secret . B8.pack <$> scale (*3) arbitrary
53 newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show)
55 instance Arbitrary Identifier where
56 arbitrary = Identifier . B8.pack <$>(scale (*3) . listOf1 . elements $ ['a'..'z'])
58 newtype EquationLike = EquationLike { unEqlike :: BS.ByteString } deriving (Show)
60 instance Arbitrary EquationLike where
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])
68 data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show
70 instance Arbitrary SimpleMac where
72 secret <- unSecret <$> arbitrary
73 location <- unUrl <$> arbitrary
74 ident <- unIdent <$> arbitrary
75 fpcavs <- listOf arbitrary
76 let mac = foldl (flip addFirstPartyCaveat) (create secret ident location) (map unEqlike fpcavs)
77 return $ SimpleMac secret mac