{-# LANGUAGE OverloadedStrings #-} {-| Copyright : (c) 2015 Julien Tanguy License : BSD3 Maintainer : julien.tanguy@jhome.fr This test suite is based on the pymacaroons test suite: -} module Crypto.Macaroon.Verifier.Internal.Tests where import Data.Bool import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import Data.Either import Data.Either.Validation import Data.List import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (Failure, Success) import Crypto.Macaroon import Crypto.Macaroon.Verifier.Internal import Crypto.Macaroon.Instances tests :: TestTree tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs , firstParty ] {- - Test fixtures -} sec = B8.pack "this is our super secret key; only we should know it" m :: Macaroon m = create sec key loc where key = B8.pack "we used our sec key" loc = B8.pack "http://mybank/" m2 :: Macaroon m2 = addFirstPartyCaveat "test = caveat" m vtest :: Caveat -> IO (Maybe (Either ValidationError ())) vtest c = return $ if "test" `BS.isPrefixOf` cid c then Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "test = caveat" == cid c else Nothing m3 :: Macaroon m3 = addFirstPartyCaveat "value = 42" m2 vval :: Caveat -> IO (Maybe (Either ValidationError ())) vval c = return $ if "value" `BS.isPrefixOf` cid c then Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "value = 42" == cid c else Nothing {- - Tests -} sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm) firstParty = testGroup "First party caveats" [ testCase "Zero caveat" $ do res <- verifyCavs [] m :: IO (Either ValidationError Macaroon) Right m @=? res , testCase "One caveat empty" $ do res <- verifyCavs [] m2 :: IO (Either ValidationError Macaroon) Left NoVerifier @=? res , testCase "One caveat fail" $ do res <- verifyCavs [vval] m2 :: IO (Either ValidationError Macaroon) Left NoVerifier @=? res , testCase "One caveat win" $ do res <- verifyCavs [vtest] m2 :: IO (Either ValidationError Macaroon) Right m2 @=? res , testCase "Two caveat win" $ do res <- verifyCavs [vtest, vval] m3 :: IO (Either ValidationError Macaroon) Right m3 @=? res ]