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