Add basic macaroon verification

3 files changed, 79 insertions, 23 deletions

diff --git a/test/Crypto/Macaroon/Instances.hs b/test/Crypto/Macaroon/Instances.hs
index 4e2f39f..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
@@ -48,6 +55,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 +72,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
 
 
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..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:
 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
 import           Crypto.Macaroon.Verifier
@@ -23,8 +25,12 @@ import Crypto.Macaroon.Instances
 
 tests :: TestTree
 tests = testGroup "Crypto.Macaroon.Verifier" [ sigs
+                                             , firstParty
                                              ]
 
+{-
+ - Test fixtures
+ -}
 sec = B8.pack "this is our super secret key; only we should know it"
 
 m :: Macaroon
@@ -37,23 +43,54 @@ m2 :: Macaroon
 m2 = addFirstPartyCaveat "test = caveat" m
 
 m3 :: Macaroon
-m3 = addFirstPartyCaveat "test = acaveat" m
-
-sigs = testGroup "Signatures" [ basic
-                              , minted
-                              ]
-
-basic = testCase "Basic Macaroon Signature" $
-    Success @=? verifySig sec m
-
-
-minted :: TestTree
-minted = testGroup "Macaroon with first party caveats" [ one
-                                                       , two
-                                                       ]
-one = testCase "One caveat" $
-    Success @=? verifySig sec m2
-
-two = testCase "Two caveats" $
-    Success @=? verifySig sec m3
-
+m3 = addFirstPartyCaveat "value = 42" m2
+
+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 = 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
+            ])
+      ]
+    , 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
+            ])
+      ]
+    ]