diff options
Diffstat (limited to 'test/Crypto/Macaroon/Verifier')
-rw-r--r-- | test/Crypto/Macaroon/Verifier/Tests.hs | 79 |
1 files changed, 58 insertions, 21 deletions
diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs index 92a8a21..101fa26 100644 --- a/test/Crypto/Macaroon/Verifier/Tests.hs +++ b/test/Crypto/Macaroon/Verifier/Tests.hs | |||
@@ -12,9 +12,11 @@ This test suite is based on the pymacaroons test suite: | |||
12 | module Crypto.Macaroon.Verifier.Tests where | 12 | module Crypto.Macaroon.Verifier.Tests where |
13 | 13 | ||
14 | 14 | ||
15 | import Data.List | ||
15 | import qualified Data.ByteString.Char8 as B8 | 16 | import qualified Data.ByteString.Char8 as B8 |
16 | import Test.Tasty | 17 | import Test.Tasty |
17 | import Test.Tasty.HUnit | 18 | -- import Test.Tasty.HUnit |
19 | import Test.Tasty.QuickCheck | ||
18 | 20 | ||
19 | import Crypto.Macaroon | 21 | import Crypto.Macaroon |
20 | import Crypto.Macaroon.Verifier | 22 | import Crypto.Macaroon.Verifier |
@@ -23,8 +25,12 @@ import Crypto.Macaroon.Instances | |||
23 | 25 | ||
24 | tests :: TestTree | 26 | tests :: TestTree |
25 | tests = testGroup "Crypto.Macaroon.Verifier" [ sigs | 27 | tests = testGroup "Crypto.Macaroon.Verifier" [ sigs |
28 | , firstParty | ||
26 | ] | 29 | ] |
27 | 30 | ||
31 | {- | ||
32 | - Test fixtures | ||
33 | -} | ||
28 | sec = B8.pack "this is our super secret key; only we should know it" | 34 | sec = B8.pack "this is our super secret key; only we should know it" |
29 | 35 | ||
30 | m :: Macaroon | 36 | m :: Macaroon |
@@ -37,23 +43,54 @@ m2 :: Macaroon | |||
37 | m2 = addFirstPartyCaveat "test = caveat" m | 43 | m2 = addFirstPartyCaveat "test = caveat" m |
38 | 44 | ||
39 | m3 :: Macaroon | 45 | m3 :: Macaroon |
40 | m3 = addFirstPartyCaveat "test = acaveat" m | 46 | m3 = addFirstPartyCaveat "value = 42" m2 |
41 | 47 | ||
42 | sigs = testGroup "Signatures" [ basic | 48 | exTC = verifyExact "test" "caveat" (many' letter_ascii) <???> "test = caveat" |
43 | , minted | 49 | exTZ = verifyExact "test" "bleh" (many' letter_ascii) <???> "test = bleh" |
44 | ] | 50 | exV42 = verifyExact "value" 42 decimal <???> "value = 42" |
45 | 51 | exV43 = verifyExact "value" 43 decimal <???> "value = 43" | |
46 | basic = testCase "Basic Macaroon Signature" $ | 52 | |
47 | Success @=? verifySig sec m | 53 | funTCPre = verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) <???> "test startsWith cav" |
48 | 54 | funTV43lte = verifyFun "value" (<= 43) decimal <???> "value <= 43" | |
49 | 55 | ||
50 | minted :: TestTree | 56 | allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte] |
51 | minted = testGroup "Macaroon with first party caveats" [ one | 57 | |
52 | , two | 58 | {- |
53 | ] | 59 | - Tests |
54 | one = testCase "One caveat" $ | 60 | -} |
55 | Success @=? verifySig sec m2 | 61 | sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Ok |
56 | 62 | ||
57 | two = testCase "Two caveats" $ | 63 | firstParty = testGroup "First party caveats" [ |
58 | Success @=? verifySig sec m3 | 64 | testGroup "Pure verifiers" [ |
59 | 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 | , testGroup "Pure verifiers with sig" [ | ||
81 | testProperty "Zero caveat" $ | ||
82 | forAll (sublistOf allvs) (\vs -> Ok == verifyMacaroon sec vs m) | ||
83 | , testProperty "One caveat" $ | ||
84 | forAll (sublistOf allvs) (\vs -> disjoin [ | ||
85 | Ok == verifyMacaroon sec vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) | ||
86 | , Failed === verifyMacaroon sec vs m2 | ||
87 | ]) | ||
88 | , testProperty "Two Exact" $ | ||
89 | forAll (sublistOf allvs) (\vs -> disjoin [ | ||
90 | Ok == verifyMacaroon sec vs m3 .&&. | ||
91 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. | ||
92 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) | ||
93 | , Failed === verifyMacaroon sec vs m3 | ||
94 | ]) | ||
95 | ] | ||
96 | ] | ||