aboutsummaryrefslogtreecommitdiffhomepage
path: root/test/Crypto/Macaroon
diff options
context:
space:
mode:
Diffstat (limited to 'test/Crypto/Macaroon')
-rw-r--r--test/Crypto/Macaroon/Instances.hs7
-rw-r--r--test/Crypto/Macaroon/Verifier/Tests.hs73
2 files changed, 37 insertions, 43 deletions
diff --git a/test/Crypto/Macaroon/Instances.hs b/test/Crypto/Macaroon/Instances.hs
index 17044a0..c82bbd3 100644
--- a/test/Crypto/Macaroon/Instances.hs
+++ b/test/Crypto/Macaroon/Instances.hs
@@ -26,9 +26,16 @@ import Crypto.Macaroon
26 26
27-- | Adjust the size parameter, by transforming it with the given 27-- | Adjust the size parameter, by transforming it with the given
28-- function. 28-- function.
29-- Copied over from QuickCheck 2.8
29scale :: (Int -> Int) -> Gen a -> Gen a 30scale :: (Int -> Int) -> Gen a -> Gen a
30scale f g = sized (\n -> resize (f n) g) 31scale f g = sized (\n -> resize (f n) g)
31 32
33
34-- | Generates a random subsequence of the given list.
35-- Copied over from QuickCheck 2.8
36sublistOf :: [a] -> Gen [a]
37sublistOf = filterM (\_ -> choose (False, True))
38
32newtype Url = Url { unUrl :: BS.ByteString } deriving (Show) 39newtype Url = Url { unUrl :: BS.ByteString } deriving (Show)
33 40
34instance Arbitrary Url where 41instance Arbitrary Url where
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
15import Data.List 15import Data.List
16import qualified Data.ByteString.Char8 as B8 16import qualified Data.ByteString.Char8 as B8
17import Test.Tasty 17import Test.Tasty
18import Test.Tasty.HUnit 18-- import Test.Tasty.HUnit
19import Test.Tasty.QuickCheck 19import Test.Tasty.QuickCheck
20 20
21import Crypto.Macaroon 21import Crypto.Macaroon
@@ -25,7 +25,7 @@ import Crypto.Macaroon.Instances
25 25
26tests :: TestTree 26tests :: TestTree
27tests = testGroup "Crypto.Macaroon.Verifier" [ sigs 27tests = testGroup "Crypto.Macaroon.Verifier" [ sigs
28 , exactCavs 28 , firstParty
29 ] 29 ]
30 30
31{- 31{-
@@ -45,49 +45,36 @@ m2 = addFirstPartyCaveat "test = caveat" m
45m3 :: Macaroon 45m3 :: Macaroon
46m3 = addFirstPartyCaveat "value = 42" m2 46m3 = addFirstPartyCaveat "value = 42" m2
47 47
48exVerifiers = [ verifyExact "test" "caveat" (many' letter_ascii) 48exTC = verifyExact "test" "caveat" (many' letter_ascii) <???> "test = caveat"
49 , verifyExact "value" 42 decimal 49exTZ = verifyExact "test" "bleh" (many' letter_ascii) <???> "test = bleh"
50 ] 50exV42 = verifyExact "value" 42 decimal <???> "value = 42"
51exVerifiers' = [ verifyExact "test" "caveat" (many' letter_ascii) 51exV43 = verifyExact "value" 43 decimal <???> "value = 43"
52 , verifyExact "value" 43 decimal 52
53 ] 53funTCPre = verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) <???> "test startsWith cav"
54funVerifiers = [ verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) 54funTV43lte = verifyFun "value" (<= 43) decimal <???> "value <= 43"
55 , verifyFun "value" (<= 43) decimal 55
56 ] 56allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte]
57 57
58{- 58{-
59 - Tests 59 - Tests
60 -} 60 -}
61sigs = testGroup "Signatures" [ basic 61sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Ok
62 , one 62
63 , two 63firstParty = testGroup "First party caveats" [
64 ] 64 testGroup "Pure verifiers" [
65 65 testProperty "Zero caveat" $
66basic = testGroup "Basic Macaroon" [ none , sigQC ] 66 forAll (sublistOf allvs) (\vs -> Ok == verifyCavs vs m)
67 67 , testProperty "One caveat" $
68none = 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
71sigQC = testProperty "Random" $ 71 ])
72 \sm -> verifySig (secret sm) (macaroon sm) == Ok 72 , testProperty "Two Exact" $
73 73 forAll (sublistOf allvs) (\vs -> disjoin [
74one = 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)
77two = testCase "Macaroon with two caveats" $ 77 , Failed === verifyCavs vs m3
78 Ok @=? verifySig sec m3 78 ])
79
80exactCavs = 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
90funCavs = testGroup "Function Caveats" [
91 testCase "One caveat win" $ Ok @=? verifyCavs funVerifiers m2
92 , testCase "Two caveat win" $ Ok @=? verifyCavs funVerifiers m3
93 ]