]>
Commit | Line | Data |
---|---|---|
a22bcdb6 JT |
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 | ||
a11f20be | 14 | import Control.Applicative |
bf31e290 | 15 | import Control.Monad |
a22bcdb6 | 16 | import Data.Byteable |
bf31e290 | 17 | import qualified Data.ByteString as BS |
a22bcdb6 JT |
18 | import qualified Data.ByteString.Char8 as B8 |
19 | import Data.Hex | |
20 | import Data.List | |
21 | import Test.Tasty | |
22 | import Test.Tasty.HUnit | |
23 | import Test.Tasty.QuickCheck | |
24 | ||
25 | import Crypto.Macaroon | |
26 | ||
27 | newtype Url = Url { unUrl :: BS.ByteString } deriving (Show) | |
28 | ||
29 | instance Arbitrary Url where | |
30 | arbitrary = do | |
31 | protocol <- elements ["http://"] | |
32 | name <- fmap (intercalate ".") <$> listOf1 . listOf1 $ elements ['a'..'z'] | |
33 | domain <- elements [".com",".net"] | |
34 | return . Url . B8.pack $ (protocol ++ name ++ domain) | |
35 | ||
86f38823 | 36 | newtype BSSecret = BSSecret { unSecret :: BS.ByteString } deriving (Show) |
a22bcdb6 | 37 | |
86f38823 JT |
38 | instance Arbitrary BSSecret where |
39 | arbitrary = BSSecret . B8.pack <$> scale (*3) arbitrary | |
a22bcdb6 JT |
40 | |
41 | newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show) | |
42 | ||
43 | instance Arbitrary Identifier where | |
44 | arbitrary = Identifier . B8.pack <$>(scale (*3) . listOf1 . elements $ ['a'..'z']) | |
45 | ||
2ba8d1c3 JT |
46 | newtype EquationLike = EquationLike { unEqlike :: BS.ByteString } deriving (Show) |
47 | ||
48 | instance Arbitrary EquationLike where | |
49 | arbitrary = do | |
50 | keylen <- choose (3,8) | |
51 | key <- B8.pack <$> vectorOf keylen (elements ['a'..'z']) | |
52 | val <- B8.pack <$> (scale (*3) . listOf1 . elements $ ['a'..'z']) | |
53 | return $ EquationLike (BS.concat [ key, " = ", val]) | |
54 | ||
55 | ||
a22bcdb6 JT |
56 | data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show |
57 | ||
58 | instance Arbitrary SimpleMac where | |
59 | arbitrary = do | |
60 | secret <- unSecret <$> arbitrary | |
61 | location <- unUrl <$> arbitrary | |
62 | ident <- unIdent <$> arbitrary | |
2ba8d1c3 JT |
63 | fpcavs <- listOf arbitrary |
64 | let mac = foldl (flip addFirstPartyCaveat) (create secret ident location) (map unEqlike fpcavs) | |
65 | return $ SimpleMac secret mac | |
a22bcdb6 JT |
66 | |
67 |