blob: 69556378b5bd6965e98b51ed92644befd8d763a1 (
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
|
{-# 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
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
|
