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 -- Copied over from QuickCheck 2.8
  30 scale :: (Int -> Int) -> Gen a -> Gen a
  31 scale f g = sized (\n -> resize (f n) g)
  32
  33
  34 -- | Generates a random subsequence of the given list.
  35 -- Copied over from QuickCheck 2.8
  36 sublistOf :: [a] -> Gen [a]
  37 sublistOf = filterM (\_ -> choose (False, True))
  38
  39 newtype Url = Url { unUrl :: BS.ByteString } deriving (Show)
  40
  41 instance Arbitrary Url where
  42     arbitrary = do
  43         protocol <- elements ["http://"]
  44         name <-  fmap (intercalate ".") <$> listOf1 . listOf1 $ elements ['a'..'z']
  45         domain <- elements [".com",".net"]
  46         return . Url . B8.pack $ (protocol ++ name ++ domain)
  47
  48 newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show)
  49
  50 instance Arbitrary Secret where
  51     arbitrary = Secret . B8.pack <$> scale (*3) arbitrary
  52
  53 newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show)
  54
  55 instance Arbitrary Identifier where
  56     arbitrary = Identifier . B8.pack <$>(scale (*3) . listOf1 . elements $ ['a'..'z'])
  57
  58 newtype EquationLike = EquationLike { unEqlike :: BS.ByteString } deriving (Show)
  59
  60 instance Arbitrary EquationLike where
  61     arbitrary = do
  62         keylen <- choose (3,8)
  63         key <- B8.pack <$> vectorOf keylen (elements ['a'..'z'])
  64         val <- B8.pack <$> (scale (*3) . listOf1 . elements $ ['a'..'z'])
  65         return $ EquationLike (BS.concat [ key, " = ", val])
  66
  67
  68 data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show
  69
  70 instance Arbitrary SimpleMac where
  71     arbitrary = do
  72         secret <- unSecret <$> arbitrary
  73         location <- unUrl <$> arbitrary
  74         ident <- unIdent <$> arbitrary
  75         fpcavs <- listOf arbitrary
  76         let mac = foldl (flip addFirstPartyCaveat) (create secret ident location) (map unEqlike fpcavs)
  77         return $ SimpleMac secret mac
  78
  79