test/Crypto/Macaroon/Verifier/Internal/Tests.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.Verifier.Internal.Tests where
  13
  14 import           Data.Bool
  15 import qualified Data.ByteString                   as BS
  16 import qualified Data.ByteString.Char8             as B8
  17 import           Data.Either
  18 import           Data.Either.Validation
  19 import           Data.List
  20 import           Test.Tasty
  21 import           Test.Tasty.HUnit
  22 import           Test.Tasty.QuickCheck             hiding (Failure, Success)
  23
  24 import           Crypto.Macaroon
  25 import           Crypto.Macaroon.Verifier.Internal
  26
  27 import           Crypto.Macaroon.Instances
  28
  29 tests :: TestTree
  30 tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs
  31                                                       , firstParty
  32                                                       ]
  33
  34 {-
  35  - Test fixtures
  36  -}
  37 sec = B8.pack "this is our super secret key; only we should know it"
  38
  39 m :: Macaroon
  40 m = create sec key loc
  41   where
  42     key = B8.pack "we used our sec key"
  43     loc = B8.pack "http://mybank/"
  44
  45 m2 :: Macaroon
  46 m2 = addFirstPartyCaveat "test = caveat" m
  47
  48 vtest :: Caveat -> IO (Maybe (Either ValidationError ()))
  49 vtest c = return $ if "test" `BS.isPrefixOf` cid c then
  50     Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "test = caveat" == cid c
  51     else Nothing
  52
  53
  54 m3 :: Macaroon
  55 m3 = addFirstPartyCaveat "value = 42" m2
  56
  57 vval :: Caveat -> IO (Maybe (Either ValidationError ()))
  58 vval c = return $ if "value" `BS.isPrefixOf` cid c then
  59     Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "value = 42" == cid c
  60     else Nothing
  61
  62
  63 {-
  64  - Tests
  65  -}
  66
  67 sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm)
  68
  69
  70 firstParty = testGroup "First party caveats" [
  71     testCase "Zero caveat" $ do
  72         res <- verifyCavs [] m :: IO (Either ValidationError Macaroon)
  73         Right m @=? res
  74     , testCase "One caveat empty" $ do
  75         res <- verifyCavs [] m2 :: IO (Either ValidationError Macaroon)
  76         Left NoVerifier @=? res
  77     , testCase "One caveat fail" $ do
  78         res <- verifyCavs [vval] m2 :: IO (Either ValidationError Macaroon)
  79         Left NoVerifier @=? res
  80     , testCase "One caveat win" $ do
  81         res <- verifyCavs [vtest] m2 :: IO (Either ValidationError Macaroon)
  82         Right m2 @=? res
  83     , testCase "Two caveat win" $ do
  84         res <- verifyCavs [vtest, vval] m3 :: IO (Either ValidationError Macaroon)
  85         Right m3 @=? res
  86       ]