]> git.immae.eu Git - github/fretlink/hmacaroons.git/blobdiff - test/Crypto/Macaroon/Instances.hs
ghc<7.10.1 compat
[github/fretlink/hmacaroons.git] / test / Crypto / Macaroon / Instances.hs
index 5d4b0624150aea5da8004eeabd05f322b9eeb123..019c094c26bcbd8ee09d3c1a9c5a74a0218c8d0f 100644 (file)
@@ -11,9 +11,10 @@ This test suite is based on the pymacaroons test suite:
 -}
 module Crypto.Macaroon.Instances where
 
-import Control.Monad
+import           Control.Applicative
+import           Control.Monad
 import           Data.Byteable
-import qualified Data.ByteString as BS
+import qualified Data.ByteString       as BS
 import qualified Data.ByteString.Char8 as B8
 import           Data.Hex
 import           Data.List
@@ -32,16 +33,26 @@ instance Arbitrary Url where
         domain <- elements [".com",".net"]
         return . Url . B8.pack $ (protocol ++ name ++ domain)
 
-newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show)
+newtype BSSecret = BSSecret { unSecret :: BS.ByteString } deriving (Show)
 
-instance Arbitrary Secret where
-    arbitrary = Secret . B8.pack <$> scale (*3) arbitrary
+instance Arbitrary BSSecret where
+    arbitrary = BSSecret . 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
@@ -49,6 +60,8 @@ instance Arbitrary SimpleMac where
         secret <- unSecret <$> arbitrary
         location <- unUrl <$> arbitrary
         ident <- unIdent <$> arbitrary
-        return $ SimpleMac secret (create secret ident location)
+        fpcavs <- listOf arbitrary
+        let mac = foldl (flip addFirstPartyCaveat) (create secret ident location) (map unEqlike fpcavs)
+        return $ SimpleMac secret mac