diff options
Diffstat (limited to 'test/Crypto/Macaroon/Verifier')
-rw-r--r-- | test/Crypto/Macaroon/Verifier/Tests.hs | 73 |
1 files changed, 30 insertions, 43 deletions
diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs index 54c8db1..5f09bca 100644 --- a/test/Crypto/Macaroon/Verifier/Tests.hs +++ b/test/Crypto/Macaroon/Verifier/Tests.hs | |||
@@ -15,7 +15,7 @@ module Crypto.Macaroon.Verifier.Tests where | |||
15 | import Data.List | 15 | import Data.List |
16 | import qualified Data.ByteString.Char8 as B8 | 16 | import qualified Data.ByteString.Char8 as B8 |
17 | import Test.Tasty | 17 | import Test.Tasty |
18 | import Test.Tasty.HUnit | 18 | -- import Test.Tasty.HUnit |
19 | import Test.Tasty.QuickCheck | 19 | import Test.Tasty.QuickCheck |
20 | 20 | ||
21 | import Crypto.Macaroon | 21 | import Crypto.Macaroon |
@@ -25,7 +25,7 @@ import Crypto.Macaroon.Instances | |||
25 | 25 | ||
26 | tests :: TestTree | 26 | tests :: TestTree |
27 | tests = testGroup "Crypto.Macaroon.Verifier" [ sigs | 27 | tests = testGroup "Crypto.Macaroon.Verifier" [ sigs |
28 | , exactCavs | 28 | , firstParty |
29 | ] | 29 | ] |
30 | 30 | ||
31 | {- | 31 | {- |
@@ -45,49 +45,36 @@ m2 = addFirstPartyCaveat "test = caveat" m | |||
45 | m3 :: Macaroon | 45 | m3 :: Macaroon |
46 | m3 = addFirstPartyCaveat "value = 42" m2 | 46 | m3 = addFirstPartyCaveat "value = 42" m2 |
47 | 47 | ||
48 | exVerifiers = [ verifyExact "test" "caveat" (many' letter_ascii) | 48 | exTC = verifyExact "test" "caveat" (many' letter_ascii) <???> "test = caveat" |
49 | , verifyExact "value" 42 decimal | 49 | exTZ = verifyExact "test" "bleh" (many' letter_ascii) <???> "test = bleh" |
50 | ] | 50 | exV42 = verifyExact "value" 42 decimal <???> "value = 42" |
51 | exVerifiers' = [ verifyExact "test" "caveat" (many' letter_ascii) | 51 | exV43 = verifyExact "value" 43 decimal <???> "value = 43" |
52 | , verifyExact "value" 43 decimal | 52 | |
53 | ] | 53 | funTCPre = verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) <???> "test startsWith cav" |
54 | funVerifiers = [ verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) | 54 | funTV43lte = verifyFun "value" (<= 43) decimal <???> "value <= 43" |
55 | , verifyFun "value" (<= 43) decimal | 55 | |
56 | ] | 56 | allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte] |
57 | 57 | ||
58 | {- | 58 | {- |
59 | - Tests | 59 | - Tests |
60 | -} | 60 | -} |
61 | sigs = testGroup "Signatures" [ basic | 61 | sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Ok |
62 | , one | 62 | |
63 | , two | 63 | firstParty = testGroup "First party caveats" [ |
64 | ] | 64 | testGroup "Pure verifiers" [ |
65 | 65 | testProperty "Zero caveat" $ | |
66 | basic = testGroup "Basic Macaroon" [ none , sigQC ] | 66 | forAll (sublistOf allvs) (\vs -> Ok == verifyCavs vs m) |
67 | 67 | , testProperty "One caveat" $ | |
68 | none = testCase "No caveat" $ | 68 | forAll (sublistOf allvs) (\vs -> disjoin [ |
69 | Ok @=? verifySig sec m | 69 | Ok == verifyCavs vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) |
70 | 70 | , Failed === verifyCavs vs m2 | |
71 | sigQC = testProperty "Random" $ | 71 | ]) |
72 | \sm -> verifySig (secret sm) (macaroon sm) == Ok | 72 | , testProperty "Two Exact" $ |
73 | 73 | forAll (sublistOf allvs) (\vs -> disjoin [ | |
74 | one = testCase "Macaroon with one caveat" $ | 74 | Ok == verifyCavs vs m3 .&&. |
75 | Ok @=? verifySig sec m2 | 75 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. |
76 | 76 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) | |
77 | two = testCase "Macaroon with two caveats" $ | 77 | , Failed === verifyCavs vs m3 |
78 | Ok @=? verifySig sec m3 | 78 | ]) |
79 | |||
80 | exactCavs = testGroup "Exact Caveats" [ | ||
81 | testGroup "Ignoring non-relevant" [ | ||
82 | testCase "Zero caveat" $ Ok @=? verifyCavs exVerifiers m | ||
83 | , testCase "One caveat" $ Ok @=? verifyCavs exVerifiers' m2 | ||
84 | ] | 79 | ] |
85 | , testCase "One caveat win" $ Ok @=? verifyCavs exVerifiers m2 | 80 | ] |
86 | , testCase "Two caveat win" $ Ok @=? verifyCavs exVerifiers m3 | ||
87 | , testCase "Two caveat fail" $ Failed @=? verifyCavs exVerifiers' m3 | ||
88 | ] | ||
89 | |||
90 | funCavs = testGroup "Function Caveats" [ | ||
91 | testCase "One caveat win" $ Ok @=? verifyCavs funVerifiers m2 | ||
92 | , testCase "Two caveat win" $ Ok @=? verifyCavs funVerifiers m3 | ||
93 | ] | ||