]>
Commit | Line | Data |
---|---|---|
b92e3c15 JT |
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 | ||
86f38823 JT |
15 | import qualified Data.ByteString.Char8 as B8 |
16 | import Data.List | |
17 | import Test.Tasty | |
90695615 | 18 | -- import Test.Tasty.HUnit |
86f38823 JT |
19 | import Data.Either |
20 | import Test.Tasty.QuickCheck hiding (Failure, Success) | |
b92e3c15 JT |
21 | |
22 | import Crypto.Macaroon | |
23 | import Crypto.Macaroon.Verifier | |
24 | ||
86f38823 | 25 | import Crypto.Macaroon.Instances |
b92e3c15 JT |
26 | |
27 | tests :: TestTree | |
86f38823 | 28 | tests = testGroup "Crypto.Macaroon.Verifier" [ ] |
b92e3c15 | 29 | |
5d1b7d51 JT |
30 | {- |
31 | - Test fixtures | |
32 | -} | |
b92e3c15 JT |
33 | sec = B8.pack "this is our super secret key; only we should know it" |
34 | ||
35 | m :: Macaroon | |
36 | m = create sec key loc | |
37 | where | |
38 | key = B8.pack "we used our sec key" | |
39 | loc = B8.pack "http://mybank/" | |
40 | ||
41 | m2 :: Macaroon | |
42 | m2 = addFirstPartyCaveat "test = caveat" m | |
43 | ||
44 | m3 :: Macaroon | |
6f3c0dca JT |
45 | m3 = addFirstPartyCaveat "value = 42" m2 |
46 | ||
5d1b7d51 JT |
47 | {- |
48 | - Tests | |
49 | -} | |
c830f7c2 JT |
50 | |
51 | -- TODO: Re-do tests | |
7f9f7386 JT |
52 | {- |
53 | firstParty = testGroup "First party caveats" [ | |
54 | testGroup "Pure verifiers" [ | |
55 | testProperty "Zero caveat" $ | |
56 | forAll (sublistOf allvs) (\vs -> Right m == verifyCavs vs m) | |
57 | , testProperty "One caveat" $ | |
58 | forAll (sublistOf allvs) (\vs -> disjoin [ | |
59 | Right m2 == verifyCavs vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) | |
60 | , True === isLeft( verifyCavs vs m2) | |
61 | ]) | |
62 | , testProperty "Two Exact" $ | |
63 | forAll (sublistOf allvs) (\vs -> disjoin [ | |
64 | Right m3 == verifyCavs vs m3 .&&. | |
65 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. | |
66 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) | |
67 | , True === isLeft (verifyCavs vs m3) | |
68 | ]) | |
69 | ] | |
70 | , testGroup "Pure verifiers with sig" [ | |
71 | testProperty "Zero caveat" $ | |
72 | forAll (sublistOf allvs) (\vs -> Right m == verifyMacaroon sec vs m) | |
73 | , testProperty "One caveat" $ | |
74 | forAll (sublistOf allvs) (\vs -> disjoin [ | |
75 | Right m2 == verifyMacaroon sec vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) | |
76 | , True === isLeft (verifyMacaroon sec vs m2) | |
77 | ]) | |
78 | , testProperty "Two Exact" $ | |
79 | forAll (sublistOf allvs) (\vs -> disjoin [ | |
80 | Right m3 == verifyMacaroon sec vs m3 .&&. | |
81 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. | |
82 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) | |
83 | , True === isLeft (verifyMacaroon sec vs m3) | |
84 | ]) | |
85 | ] | |
86 | ] | |
87 | -} |