test/Crypto/Macaroon/Instances.hs

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