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 hiding (Success, Failure)
  20 import Data.Either
  21
  22 import           Crypto.Macaroon
  23 import           Crypto.Macaroon.Verifier
  24
  25 import Crypto.Macaroon.Instances
  26
  27 tests :: TestTree
  28 tests = testGroup "Crypto.Macaroon.Verifier" [ sigs
  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)
  49 -- exTZ = verifyExact "test" "bleh" (many' letter_ascii)
  50 -- exV42 = verifyExact "value" 42 decimal
  51 -- exV43 = verifyExact "value" 43 decimal
  52
  53 -- funTCPre = verifyFun "test" (string "test = " *> many' letter_ascii)
  54 --                             (\e ->  if "cav" `isPrefixOf` e then Right e else Left "Does not start with cav" )
  55 -- funTV43lte = verifyFun "value" (string "value = " *> decimal)
  56 --                                (\v -> if v <= 43 then Right v else Left "Greater than 43")
  57
  58 -- allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte]
  59
  60 {-
  61  - Tests
  62  -}
  63 sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm)
  64
  65 -- TODO: Re-do tests
  66 {-
  67 firstParty = testGroup "First party caveats" [
  68     testGroup "Pure verifiers" [
  69         testProperty "Zero caveat" $
  70                 forAll (sublistOf allvs) (\vs -> Right m == verifyCavs vs m)
  71       , testProperty "One caveat" $
  72           forAll (sublistOf allvs) (\vs -> disjoin [
  73               Right m2 == verifyCavs vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs)
  74             , True === isLeft( verifyCavs vs m2)
  75             ])
  76       , testProperty "Two Exact" $
  77           forAll (sublistOf allvs) (\vs -> disjoin [
  78               Right m3 == verifyCavs vs m3 .&&.
  79                 any (`elem` vs) [exTC,funTCPre] .&&.  (exTZ `notElem` vs) .&&.
  80                 any (`elem` vs) [exV42,funTV43lte] .&&.  (exV43 `notElem` vs)
  81             , True === isLeft (verifyCavs vs m3)
  82             ])
  83       ]
  84     , testGroup "Pure verifiers with sig" [
  85         testProperty "Zero caveat" $
  86                 forAll (sublistOf allvs) (\vs -> Right m == verifyMacaroon sec vs m)
  87       , testProperty "One caveat" $
  88           forAll (sublistOf allvs) (\vs -> disjoin [
  89               Right m2 == verifyMacaroon sec vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs)
  90             , True === isLeft (verifyMacaroon sec vs m2)
  91             ])
  92       , testProperty "Two Exact" $
  93           forAll (sublistOf allvs) (\vs -> disjoin [
  94               Right m3 == verifyMacaroon sec vs m3 .&&.
  95                 any (`elem` vs) [exTC,funTCPre] .&&.  (exTZ `notElem` vs) .&&.
  96                 any (`elem` vs) [exV42,funTV43lte] .&&.  (exV43 `notElem` vs)
  97             , True === isLeft (verifyMacaroon sec vs m3)
  98             ])
  99       ]
 100     ]
 101     -}