blob: c82bbd3b5d1822199fbb68f52be8125e36ead49e (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
{-# LANGUAGE OverloadedStrings #-}
{-|
Copyright : (c) 2015 Julien Tanguy
License : BSD3
Maintainer : julien.tanguy@jhome.fr
This test suite is based on the pymacaroons test suite:
<https://github.com/ecordell/pymacaroons>
-}
module Crypto.Macaroon.Instances where
import Control.Monad
import Data.Byteable
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import Data.Hex
import Data.List
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Crypto.Macaroon
-- | Adjust the size parameter, by transforming it with the given
-- function.
-- Copied over from QuickCheck 2.8
scale :: (Int -> Int) -> Gen a -> Gen a
scale f g = sized (\n -> resize (f n) g)
-- | Generates a random subsequence of the given list.
-- Copied over from QuickCheck 2.8
sublistOf :: [a] -> Gen [a]
sublistOf = filterM (\_ -> choose (False, True))
newtype Url = Url { unUrl :: BS.ByteString } deriving (Show)
instance Arbitrary Url where
arbitrary = do
protocol <- elements ["http://"]
name <- fmap (intercalate ".") <$> listOf1 . listOf1 $ elements ['a'..'z']
domain <- elements [".com",".net"]
return . Url . B8.pack $ (protocol ++ name ++ domain)
newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show)
instance Arbitrary Secret where
arbitrary = Secret . B8.pack <$> scale (*3) arbitrary
newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show)
instance Arbitrary Identifier where
arbitrary = Identifier . B8.pack <$>(scale (*3) . listOf1 . elements $ ['a'..'z'])
newtype EquationLike = EquationLike { unEqlike :: BS.ByteString } deriving (Show)
instance Arbitrary EquationLike where
arbitrary = do
keylen <- choose (3,8)
key <- B8.pack <$> vectorOf keylen (elements ['a'..'z'])
val <- B8.pack <$> (scale (*3) . listOf1 . elements $ ['a'..'z'])
return $ EquationLike (BS.concat [ key, " = ", val])
data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show
instance Arbitrary SimpleMac where
arbitrary = do
secret <- unSecret <$> arbitrary
location <- unUrl <$> arbitrary
ident <- unIdent <$> arbitrary
fpcavs <- listOf arbitrary
let mac = foldl (flip addFirstPartyCaveat) (create secret ident location) (map unEqlike fpcavs)
return $ SimpleMac secret mac
|
