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