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 data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show
  52
  53 instance Arbitrary SimpleMac where
  54     arbitrary = do
  55         secret <- unSecret <$> arbitrary
  56         location <- unUrl <$> arbitrary
  57         ident <- unIdent <$> arbitrary
  58         return $ SimpleMac secret (create secret ident location)
  59
  60