From 5d1b7d51854d355bf5b6438c1a96ce9e743fd810 Mon Sep 17 00:00:00 2001 From: Julien Tanguy Date: Fri, 15 May 2015 16:03:30 +0200 Subject: Add quickcheck properties --- test/Crypto/Macaroon/Serializer/Base64/Tests.hs | 2 +- test/Crypto/Macaroon/Verifier/Tests.hs | 30 ++++++++++++++++--------- 2 files changed, 20 insertions(+), 12 deletions(-) (limited to 'test/Crypto') diff --git a/test/Crypto/Macaroon/Serializer/Base64/Tests.hs b/test/Crypto/Macaroon/Serializer/Base64/Tests.hs index 19084af..ea3bed9 100644 --- a/test/Crypto/Macaroon/Serializer/Base64/Tests.hs +++ b/test/Crypto/Macaroon/Serializer/Base64/Tests.hs @@ -30,7 +30,7 @@ tests = testGroup "Crypto.Macaroon.Serializer.Base64" [ basic ] basicQC = testProperty "Reversibility" $ - forAll (macaroon <$> arbitrary) (\m -> deserialize (serialize m) == Right m) + \sm -> deserialize (serialize (macaroon sm)) == Right (macaroon sm) m :: Macaroon m = create secret key loc diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs index 92a8a21..f87f192 100644 --- a/test/Crypto/Macaroon/Verifier/Tests.hs +++ b/test/Crypto/Macaroon/Verifier/Tests.hs @@ -15,6 +15,7 @@ module Crypto.Macaroon.Verifier.Tests where import qualified Data.ByteString.Char8 as B8 import Test.Tasty import Test.Tasty.HUnit +import Test.Tasty.QuickCheck import Crypto.Macaroon import Crypto.Macaroon.Verifier @@ -25,6 +26,9 @@ tests :: TestTree tests = testGroup "Crypto.Macaroon.Verifier" [ sigs ] +{- + - Test fixtures + -} sec = B8.pack "this is our super secret key; only we should know it" m :: Macaroon @@ -39,21 +43,25 @@ m2 = addFirstPartyCaveat "test = caveat" m m3 :: Macaroon m3 = addFirstPartyCaveat "test = acaveat" m +{- + - Tests + -} sigs = testGroup "Signatures" [ basic - , minted + , one + , two ] -basic = testCase "Basic Macaroon Signature" $ - Success @=? verifySig sec m +basic = testGroup "Basic Macaroon" [ none , sigQC ] +none = testCase "No caveat" $ + VSuccess @=? verifySig sec m -minted :: TestTree -minted = testGroup "Macaroon with first party caveats" [ one - , two - ] -one = testCase "One caveat" $ - Success @=? verifySig sec m2 +sigQC = testProperty "Random" $ + \sm -> verifySig (secret sm) (macaroon sm) == VSuccess -two = testCase "Two caveats" $ - Success @=? verifySig sec m3 +one = testCase "Macaroon with one caveat" $ + VSuccess @=? verifySig sec m2 + +two = testCase "Macaroon with two caveats" $ + VSuccess @=? verifySig sec m3 -- cgit v1.2.3 From 2ba8d1c3034fb99723ba42c066b56ed6b0691a2f Mon Sep 17 00:00:00 2001 From: Julien Tanguy Date: Fri, 15 May 2015 18:29:11 +0200 Subject: 1st party caveats to Macaroon Arbitrary instance --- test/Crypto/Macaroon/Instances.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'test/Crypto') diff --git a/test/Crypto/Macaroon/Instances.hs b/test/Crypto/Macaroon/Instances.hs index 4e2f39f..17044a0 100644 --- a/test/Crypto/Macaroon/Instances.hs +++ b/test/Crypto/Macaroon/Instances.hs @@ -48,6 +48,16 @@ newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show) instance Arbitrary Identifier where arbitrary = Identifier . B8.pack <$>(scale (*3) . listOf1 . elements $ ['a'..'z']) +newtype EquationLike = EquationLike { unEqlike :: BS.ByteString } deriving (Show) + +instance Arbitrary EquationLike where + arbitrary = do + keylen <- choose (3,8) + key <- B8.pack <$> vectorOf keylen (elements ['a'..'z']) + val <- B8.pack <$> (scale (*3) . listOf1 . elements $ ['a'..'z']) + return $ EquationLike (BS.concat [ key, " = ", val]) + + data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show instance Arbitrary SimpleMac where @@ -55,6 +65,8 @@ instance Arbitrary SimpleMac where secret <- unSecret <$> arbitrary location <- unUrl <$> arbitrary ident <- unIdent <$> arbitrary - return $ SimpleMac secret (create secret ident location) + fpcavs <- listOf arbitrary + let mac = foldl (flip addFirstPartyCaveat) (create secret ident location) (map unEqlike fpcavs) + return $ SimpleMac secret mac -- cgit v1.2.3 From 6f3c0dca02c1069115bc2592c439970d2af07cc5 Mon Sep 17 00:00:00 2001 From: Julien Tanguy Date: Fri, 15 May 2015 22:31:05 +0200 Subject: Add basic exact caveat verifiers Need more tests Touching #2 Verify first party caveats --- test/Crypto/Macaroon/Verifier/Tests.hs | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) (limited to 'test/Crypto') diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs index f87f192..37d0230 100644 --- a/test/Crypto/Macaroon/Verifier/Tests.hs +++ b/test/Crypto/Macaroon/Verifier/Tests.hs @@ -24,6 +24,7 @@ import Crypto.Macaroon.Instances tests :: TestTree tests = testGroup "Crypto.Macaroon.Verifier" [ sigs + , exactCavs ] {- @@ -41,7 +42,14 @@ m2 :: Macaroon m2 = addFirstPartyCaveat "test = caveat" m m3 :: Macaroon -m3 = addFirstPartyCaveat "test = acaveat" m +m3 = addFirstPartyCaveat "value = 42" m2 + +exVerifiers = [ verifyExact "test" "caveat" (many' letter_ascii) + , verifyExact "value" 42 decimal + ] +exVerifiers' = [ verifyExact "test" "caveat" (many' letter_ascii) + , verifyExact "value" 43 decimal + ] {- - Tests @@ -54,14 +62,26 @@ sigs = testGroup "Signatures" [ basic basic = testGroup "Basic Macaroon" [ none , sigQC ] none = testCase "No caveat" $ - VSuccess @=? verifySig sec m + Ok @=? verifySig sec m sigQC = testProperty "Random" $ - \sm -> verifySig (secret sm) (macaroon sm) == VSuccess + \sm -> verifySig (secret sm) (macaroon sm) == Ok one = testCase "Macaroon with one caveat" $ - VSuccess @=? verifySig sec m2 + Ok @=? verifySig sec m2 two = testCase "Macaroon with two caveats" $ - VSuccess @=? verifySig sec m3 - + Ok @=? verifySig sec m3 + +exactCavs = testGroup "Exact Caveats" [ zero', one', two' , one'', two''] + +zero' = testCase "Zero caveat win" $ + Ok @=? verifyCavs exVerifiers m +one' = testCase "One caveat win" $ + Ok @=? verifyCavs exVerifiers m2 +one'' = testCase "Ignoring non-relevant" $ + Ok @=? verifyCavs exVerifiers' m2 +two' = testCase "Two caveat win" $ + Ok @=? verifyCavs exVerifiers m3 +two'' = testCase "Two caveat fail" $ + Failed @=? verifyCavs exVerifiers' m3 -- cgit v1.2.3 From 857f2f3ba8ba2de9ab65ea3c66eafb718fe4e1a6 Mon Sep 17 00:00:00 2001 From: Julien Tanguy Date: Fri, 15 May 2015 23:02:22 +0200 Subject: Add generalized function verifier --- test/Crypto/Macaroon/Verifier/Tests.hs | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) (limited to 'test/Crypto') diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs index 37d0230..54c8db1 100644 --- a/test/Crypto/Macaroon/Verifier/Tests.hs +++ b/test/Crypto/Macaroon/Verifier/Tests.hs @@ -12,6 +12,7 @@ This test suite is based on the pymacaroons test suite: module Crypto.Macaroon.Verifier.Tests where +import Data.List import qualified Data.ByteString.Char8 as B8 import Test.Tasty import Test.Tasty.HUnit @@ -50,6 +51,9 @@ exVerifiers = [ verifyExact "test" "caveat" (many' letter_ascii) exVerifiers' = [ verifyExact "test" "caveat" (many' letter_ascii) , verifyExact "value" 43 decimal ] +funVerifiers = [ verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) + , verifyFun "value" (<= 43) decimal + ] {- - Tests @@ -73,15 +77,17 @@ one = testCase "Macaroon with one caveat" $ two = testCase "Macaroon with two caveats" $ Ok @=? verifySig sec m3 -exactCavs = testGroup "Exact Caveats" [ zero', one', two' , one'', two''] - -zero' = testCase "Zero caveat win" $ - Ok @=? verifyCavs exVerifiers m -one' = testCase "One caveat win" $ - Ok @=? verifyCavs exVerifiers m2 -one'' = testCase "Ignoring non-relevant" $ - Ok @=? verifyCavs exVerifiers' m2 -two' = testCase "Two caveat win" $ - Ok @=? verifyCavs exVerifiers m3 -two'' = testCase "Two caveat fail" $ - Failed @=? verifyCavs exVerifiers' m3 +exactCavs = testGroup "Exact Caveats" [ + testGroup "Ignoring non-relevant" [ + testCase "Zero caveat" $ Ok @=? verifyCavs exVerifiers m + , testCase "One caveat" $ Ok @=? verifyCavs exVerifiers' m2 + ] + , testCase "One caveat win" $ Ok @=? verifyCavs exVerifiers m2 + , testCase "Two caveat win" $ Ok @=? verifyCavs exVerifiers m3 + , testCase "Two caveat fail" $ Failed @=? verifyCavs exVerifiers' m3 + ] + +funCavs = testGroup "Function Caveats" [ + testCase "One caveat win" $ Ok @=? verifyCavs funVerifiers m2 + , testCase "Two caveat win" $ Ok @=? verifyCavs funVerifiers m3 + ] -- cgit v1.2.3 From 90695615c54b5939d7286e777cb1b19a221616b9 Mon Sep 17 00:00:00 2001 From: Julien Tanguy Date: Sat, 16 May 2015 02:12:14 +0200 Subject: Fix caveat verification QuickCheck properties > HUnit tests --- test/Crypto/Macaroon/Instances.hs | 7 ++++ test/Crypto/Macaroon/Verifier/Tests.hs | 73 ++++++++++++++-------------------- 2 files changed, 37 insertions(+), 43 deletions(-) (limited to 'test/Crypto') 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 -- | Adjust the size parameter, by transforming it with the given -- function. +-- Copied over from QuickCheck 2.8 scale :: (Int -> Int) -> Gen a -> Gen a scale f g = sized (\n -> resize (f n) g) + +-- | Generates a random subsequence of the given list. +-- Copied over from QuickCheck 2.8 +sublistOf :: [a] -> Gen [a] +sublistOf = filterM (\_ -> choose (False, True)) + newtype Url = Url { unUrl :: BS.ByteString } deriving (Show) instance 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 import Data.List import qualified Data.ByteString.Char8 as B8 import Test.Tasty -import Test.Tasty.HUnit +-- import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Crypto.Macaroon @@ -25,7 +25,7 @@ import Crypto.Macaroon.Instances tests :: TestTree tests = testGroup "Crypto.Macaroon.Verifier" [ sigs - , exactCavs + , firstParty ] {- @@ -45,49 +45,36 @@ m2 = addFirstPartyCaveat "test = caveat" m m3 :: Macaroon m3 = addFirstPartyCaveat "value = 42" m2 -exVerifiers = [ verifyExact "test" "caveat" (many' letter_ascii) - , verifyExact "value" 42 decimal - ] -exVerifiers' = [ verifyExact "test" "caveat" (many' letter_ascii) - , verifyExact "value" 43 decimal - ] -funVerifiers = [ verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) - , verifyFun "value" (<= 43) decimal - ] +exTC = verifyExact "test" "caveat" (many' letter_ascii) "test = caveat" +exTZ = verifyExact "test" "bleh" (many' letter_ascii) "test = bleh" +exV42 = verifyExact "value" 42 decimal "value = 42" +exV43 = verifyExact "value" 43 decimal "value = 43" + +funTCPre = verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) "test startsWith cav" +funTV43lte = verifyFun "value" (<= 43) decimal "value <= 43" + +allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte] {- - Tests -} -sigs = testGroup "Signatures" [ basic - , one - , two - ] - -basic = testGroup "Basic Macaroon" [ none , sigQC ] - -none = testCase "No caveat" $ - Ok @=? verifySig sec m - -sigQC = testProperty "Random" $ - \sm -> verifySig (secret sm) (macaroon sm) == Ok - -one = testCase "Macaroon with one caveat" $ - Ok @=? verifySig sec m2 - -two = testCase "Macaroon with two caveats" $ - Ok @=? verifySig sec m3 - -exactCavs = testGroup "Exact Caveats" [ - testGroup "Ignoring non-relevant" [ - testCase "Zero caveat" $ Ok @=? verifyCavs exVerifiers m - , testCase "One caveat" $ Ok @=? verifyCavs exVerifiers' m2 +sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Ok + +firstParty = testGroup "First party caveats" [ + testGroup "Pure verifiers" [ + testProperty "Zero caveat" $ + forAll (sublistOf allvs) (\vs -> Ok == verifyCavs vs m) + , testProperty "One caveat" $ + forAll (sublistOf allvs) (\vs -> disjoin [ + Ok == verifyCavs vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) + , Failed === verifyCavs vs m2 + ]) + , testProperty "Two Exact" $ + forAll (sublistOf allvs) (\vs -> disjoin [ + Ok == verifyCavs vs m3 .&&. + any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. + any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) + , Failed === verifyCavs vs m3 + ]) ] - , testCase "One caveat win" $ Ok @=? verifyCavs exVerifiers m2 - , testCase "Two caveat win" $ Ok @=? verifyCavs exVerifiers m3 - , testCase "Two caveat fail" $ Failed @=? verifyCavs exVerifiers' m3 - ] - -funCavs = testGroup "Function Caveats" [ - testCase "One caveat win" $ Ok @=? verifyCavs funVerifiers m2 - , testCase "Two caveat win" $ Ok @=? verifyCavs funVerifiers m3 - ] + ] -- cgit v1.2.3 From 62576139b8dbf2cd0d3c04e927b9df2d0805a199 Mon Sep 17 00:00:00 2001 From: Julien Tanguy Date: Sat, 16 May 2015 12:51:22 +0200 Subject: Add Sig/cav verifier [ci skip] --- test/Crypto/Macaroon/Verifier/Tests.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) (limited to 'test/Crypto') diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs index 5f09bca..101fa26 100644 --- a/test/Crypto/Macaroon/Verifier/Tests.hs +++ b/test/Crypto/Macaroon/Verifier/Tests.hs @@ -61,7 +61,7 @@ allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte] sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Ok firstParty = testGroup "First party caveats" [ - testGroup "Pure verifiers" [ + testGroup "Pure verifiers" [ testProperty "Zero caveat" $ forAll (sublistOf allvs) (\vs -> Ok == verifyCavs vs m) , testProperty "One caveat" $ @@ -77,4 +77,20 @@ firstParty = testGroup "First party caveats" [ , Failed === verifyCavs vs m3 ]) ] + , testGroup "Pure verifiers with sig" [ + testProperty "Zero caveat" $ + forAll (sublistOf allvs) (\vs -> Ok == verifyMacaroon sec vs m) + , testProperty "One caveat" $ + forAll (sublistOf allvs) (\vs -> disjoin [ + Ok == verifyMacaroon sec vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) + , Failed === verifyMacaroon sec vs m2 + ]) + , testProperty "Two Exact" $ + forAll (sublistOf allvs) (\vs -> disjoin [ + Ok == verifyMacaroon sec vs m3 .&&. + any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. + any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) + , Failed === verifyMacaroon sec vs m3 + ]) + ] ] -- cgit v1.2.3