path: root/test/Crypto/Macaroon/Instances.hs

{-# 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