test/Crypto/Macaroon/Verifier/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.Tests where
  13
  14
  15 import Data.List
  16 import qualified Data.ByteString.Char8 as B8
  17 import Test.Tasty
  18 -- import Test.Tasty.HUnit
  19 import Test.Tasty.QuickCheck
  20
  21 import           Crypto.Macaroon
  22 import           Crypto.Macaroon.Verifier
  23
  24 import Crypto.Macaroon.Instances
  25
  26 tests :: TestTree
  27 tests = testGroup "Crypto.Macaroon.Verifier" [ sigs
  28                                              , firstParty
  29                                              ]
  30
  31 {-
  32  - Test fixtures
  33  -}
  34 sec = B8.pack "this is our super secret key; only we should know it"
  35
  36 m :: Macaroon
  37 m = create sec key loc
  38   where
  39     key = B8.pack "we used our sec key"
  40     loc = B8.pack "http://mybank/"
  41
  42 m2 :: Macaroon
  43 m2 = addFirstPartyCaveat "test = caveat" m
  44
  45 m3 :: Macaroon
  46 m3 = addFirstPartyCaveat "value = 42" m2
  47
  48 exTC = verifyExact "test" "caveat" (many' letter_ascii) <???> "test = caveat"
  49 exTZ = verifyExact "test" "bleh" (many' letter_ascii) <???> "test = bleh"
  50 exV42 = verifyExact "value" 42 decimal <???> "value = 42"
  51 exV43 = verifyExact "value" 43 decimal <???> "value = 43"
  52
  53 funTCPre = verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) <???> "test startsWith cav"
  54 funTV43lte = verifyFun "value" (<= 43) decimal <???> "value <= 43"
  55
  56 allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte]
  57
  58 {-
  59  - Tests
  60  -}
  61 sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Ok
  62
  63 firstParty = testGroup "First party caveats" [
  64     testGroup "Pure verifiers" [
  65         testProperty "Zero caveat" $
  66                 forAll (sublistOf allvs) (\vs -> Ok == verifyCavs vs m)
  67       , testProperty "One caveat" $
  68           forAll (sublistOf allvs) (\vs -> disjoin [
  69               Ok == verifyCavs vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs)
  70             , Failed === verifyCavs vs m2
  71             ])
  72       , testProperty "Two Exact" $
  73           forAll (sublistOf allvs) (\vs -> disjoin [
  74               Ok == verifyCavs vs m3 .&&.
  75                 any (`elem` vs) [exTC,funTCPre] .&&.  (exTZ `notElem` vs) .&&.
  76                 any (`elem` vs) [exV42,funTV43lte] .&&.  (exV43 `notElem` vs)
  77             , Failed === verifyCavs vs m3
  78             ])
  79       ]
  80     ]