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 Secret = Secret { unSecret :: BS.ByteString } deriving (Show)
  36
  37 instance Arbitrary Secret where
  38     arbitrary = Secret . 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 data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show
  46
  47 instance Arbitrary SimpleMac where
  48     arbitrary = do
  49         secret <- unSecret <$> arbitrary
  50         location <- unUrl <$> arbitrary
  51         ident <- unIdent <$> arbitrary
  52         return $ SimpleMac secret (create secret ident location)
  53
  54