From 5d1b7d51854d355bf5b6438c1a96ce9e743fd810 Mon Sep 17 00:00:00 2001
From: Julien Tanguy <julien.tanguy@jhome.fr>
Date: Fri, 15 May 2015 16:03:30 +0200
Subject: Add quickcheck properties

---
 src/Crypto/Macaroon/Verifier.hs                 |  6 ++---
 test/Crypto/Macaroon/Serializer/Base64/Tests.hs |  2 +-
 test/Crypto/Macaroon/Verifier/Tests.hs          | 30 ++++++++++++++++---------
 3 files changed, 23 insertions(+), 15 deletions(-)

diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index 0d1636c..e257f5f 100644
--- a/src/Crypto/Macaroon/Verifier.hs
+++ b/src/Crypto/Macaroon/Verifier.hs
@@ -24,10 +24,10 @@ import           Crypto.Macaroon.Internal
 
 
 -- | Opaque datatype for now. Might need more explicit errors
-data Result = Success | Failure deriving (Show,Eq)
+data VResult = VSuccess | VFailure deriving (Show,Eq)
 
-verifySig :: Key -> Macaroon -> Result
-verifySig k m = bool Failure Success $
+verifySig :: Key -> Macaroon -> VResult
+verifySig k m = bool VFailure VSuccess $
       signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m)
   where
     hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256)
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 b7889567b811ac347acff9983d15ab0e91c76876 Mon Sep 17 00:00:00 2001
From: Julien Tanguy <julien.tanguy@jhome.fr>
Date: Fri, 15 May 2015 18:17:13 +0200
Subject: Add newlines between Caveats in Macaroon's show

[ci skip]
---
 src/Crypto/Macaroon/Internal.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Crypto/Macaroon/Internal.hs b/src/Crypto/Macaroon/Internal.hs
index 116f5ed..2f56512 100644
--- a/src/Crypto/Macaroon/Internal.hs
+++ b/src/Crypto/Macaroon/Internal.hs
@@ -58,7 +58,7 @@ instance Show Macaroon where
     show (MkMacaroon l i c s) = intercalate "\n" [
                       "location " ++ B8.unpack l
                     , "identifier " ++ B8.unpack i
-                    , concatMap show c
+                    , intercalate "\n" (map show c)
                     , "signature " ++ B8.unpack (hex s)
                     ]
 
-- 
cgit v1.2.3


From 2ba8d1c3034fb99723ba42c066b56ed6b0691a2f Mon Sep 17 00:00:00 2001
From: Julien Tanguy <julien.tanguy@jhome.fr>
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(-)

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 <julien.tanguy@jhome.fr>
Date: Fri, 15 May 2015 22:31:05 +0200
Subject: Add basic exact caveat verifiers

Need more tests

Touching #2 Verify first party caveats
---
 src/Crypto/Macaroon/Verifier.hs        | 47 +++++++++++++++++++++++++++++++---
 test/Crypto/Macaroon/Verifier/Tests.hs | 32 ++++++++++++++++++-----
 2 files changed, 69 insertions(+), 10 deletions(-)

diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index e257f5f..cb64c9d 100644
--- a/src/Crypto/Macaroon/Verifier.hs
+++ b/src/Crypto/Macaroon/Verifier.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-|
 Module      : Crypto.Macaroon.Verifier
 Copyright   : (c) 2015 Julien Tanguy
@@ -11,7 +12,14 @@ Portability : portable
 
 
 -}
-module Crypto.Macaroon.Verifier where
+module Crypto.Macaroon.Verifier (
+    Verified(..)
+  , verifySig
+  , verifyExact
+  , verifyCavs
+  -- , module Data.Attoparsec.ByteString
+  , module Data.Attoparsec.ByteString.Char8
+) where
 
 
 import           Crypto.Hash
@@ -19,16 +27,47 @@ import           Data.Bool
 import qualified Data.ByteString            as BS
 import           Data.Byteable
 import           Data.Foldable
+import           Data.Maybe
+import Data.Attoparsec.ByteString
+import Data.Attoparsec.ByteString.Char8
 
 import           Crypto.Macaroon.Internal
 
 
 -- | Opaque datatype for now. Might need more explicit errors
-data VResult = VSuccess | VFailure deriving (Show,Eq)
+data Verified = Ok | Failed deriving (Show,Eq)
 
-verifySig :: Key -> Macaroon -> VResult
-verifySig k m = bool VFailure VSuccess $
+instance Monoid Verified where
+  mempty = Ok
+  mappend Ok Ok = Ok
+  mappend _ _ = Failed
+
+
+type CaveatVerifier = Caveat -> Maybe Verified
+
+verifySig :: Key -> Macaroon -> Verified
+verifySig k m = bool Failed Ok $
       signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m)
   where
     hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256)
     derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256)
+
+verifyCavs :: [Caveat -> Maybe Verified] -> Macaroon -> Verified
+verifyCavs verifiers m = mconcat $ map (\c -> mconcat . catMaybes $ map ($ c) verifiers) (caveats m)
+
+verifyExact :: (Show a, Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified
+verifyExact key expected parser cav = if key `BS.isPrefixOf` cid cav then
+        case parseOnly kvparser (cid cav) of
+          Right v -> verify <$> Just v
+          Left _ -> Just Failed
+        else Nothing
+  where
+    kvparser = do
+      key <- string key
+      skipSpace
+      string "="
+      skipSpace
+      parser
+
+      -- *> skipSpace *> string "=" *> skipSpace *> parser <* endOfInput
+    verify a = bool Failed Ok (a == expected)
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 <julien.tanguy@jhome.fr>
Date: Fri, 15 May 2015 23:02:22 +0200
Subject: Add generalized function verifier

---
 src/Crypto/Macaroon/Verifier.hs        | 15 ++++++++-------
 test/Crypto/Macaroon/Verifier/Tests.hs | 30 ++++++++++++++++++------------
 2 files changed, 26 insertions(+), 19 deletions(-)

diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index cb64c9d..012d156 100644
--- a/src/Crypto/Macaroon/Verifier.hs
+++ b/src/Crypto/Macaroon/Verifier.hs
@@ -16,6 +16,7 @@ module Crypto.Macaroon.Verifier (
     Verified(..)
   , verifySig
   , verifyExact
+  , verifyFun
   , verifyCavs
   -- , module Data.Attoparsec.ByteString
   , module Data.Attoparsec.ByteString.Char8
@@ -55,10 +56,13 @@ verifySig k m = bool Failed Ok $
 verifyCavs :: [Caveat -> Maybe Verified] -> Macaroon -> Verified
 verifyCavs verifiers m = mconcat $ map (\c -> mconcat . catMaybes $ map ($ c) verifiers) (caveats m)
 
-verifyExact :: (Show a, Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified
-verifyExact key expected parser cav = if key `BS.isPrefixOf` cid cav then
+verifyExact :: (Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified
+verifyExact k expected = verifyFun k (expected ==)
+
+verifyFun :: Key -> (a -> Bool) -> Parser a -> Caveat -> Maybe Verified
+verifyFun key f parser cav = if key `BS.isPrefixOf` cid cav then
         case parseOnly kvparser (cid cav) of
-          Right v -> verify <$> Just v
+          Right v -> (bool Failed Ok . f) <$> Just v
           Left _ -> Just Failed
         else Nothing
   where
@@ -67,7 +71,4 @@ verifyExact key expected parser cav = if key `BS.isPrefixOf` cid cav then
       skipSpace
       string "="
       skipSpace
-      parser
-
-      -- *> skipSpace *> string "=" *> skipSpace *> parser <* endOfInput
-    verify a = bool Failed Ok (a == expected)
+      parser <* endOfInput
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 <julien.tanguy@jhome.fr>
Date: Sat, 16 May 2015 02:12:14 +0200
Subject: Fix caveat verification

QuickCheck properties > HUnit tests
---
 src/Crypto/Macaroon/Verifier.hs        | 19 +++++++--
 test/Crypto/Macaroon/Instances.hs      |  7 ++++
 test/Crypto/Macaroon/Verifier/Tests.hs | 73 ++++++++++++++--------------------
 3 files changed, 53 insertions(+), 46 deletions(-)

diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index 012d156..4eedff5 100644
--- a/src/Crypto/Macaroon/Verifier.hs
+++ b/src/Crypto/Macaroon/Verifier.hs
@@ -14,6 +14,8 @@ Portability : portable
 -}
 module Crypto.Macaroon.Verifier (
     Verified(..)
+  , CaveatVerifier(..)
+  , (<???>)
   , verifySig
   , verifyExact
   , verifyFun
@@ -28,7 +30,9 @@ import           Data.Bool
 import qualified Data.ByteString            as BS
 import           Data.Byteable
 import           Data.Foldable
+import           Data.Function
 import           Data.Maybe
+import           Data.Traversable
 import Data.Attoparsec.ByteString
 import Data.Attoparsec.ByteString.Char8
 
@@ -44,7 +48,16 @@ instance Monoid Verified where
   mappend _ _ = Failed
 
 
-type CaveatVerifier = Caveat -> Maybe Verified
+data CaveatVerifier = CV { vFun :: Caveat -> Maybe Verified , helpText :: String}
+
+instance Eq CaveatVerifier where
+  (==) = (==) `on` helpText
+
+instance Show CaveatVerifier where
+    show = helpText
+
+(<???>) :: (Caveat -> Maybe Verified) -> String -> CaveatVerifier
+f <???> t = CV f t
 
 verifySig :: Key -> Macaroon -> Verified
 verifySig k m = bool Failed Ok $
@@ -53,8 +66,8 @@ verifySig k m = bool Failed Ok $
     hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256)
     derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256)
 
-verifyCavs :: [Caveat -> Maybe Verified] -> Macaroon -> Verified
-verifyCavs verifiers m = mconcat $ map (\c -> mconcat . catMaybes $ map ($ c) verifiers) (caveats m)
+verifyCavs :: [CaveatVerifier] -> Macaroon -> Verified
+verifyCavs verifiers m = foldMap (\c -> fromMaybe Failed $ foldMap (($ c) . vFun) verifiers) (caveats m)
 
 verifyExact :: (Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified
 verifyExact k expected = verifyFun k (expected ==)
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 <julien.tanguy@jhome.fr>
Date: Sat, 16 May 2015 12:51:22 +0200
Subject: Add Sig/cav verifier

[ci skip]
---
 src/Crypto/Macaroon/Verifier.hs        | 10 +++++++---
 test/Crypto/Macaroon/Verifier/Tests.hs | 18 +++++++++++++++++-
 2 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index 4eedff5..02cb448 100644
--- a/src/Crypto/Macaroon/Verifier.hs
+++ b/src/Crypto/Macaroon/Verifier.hs
@@ -14,14 +14,14 @@ Portability : portable
 -}
 module Crypto.Macaroon.Verifier (
     Verified(..)
-  , CaveatVerifier(..)
+  , CaveatVerifier
   , (<???>)
+  , verifyMacaroon
   , verifySig
   , verifyExact
   , verifyFun
-  , verifyCavs
-  -- , module Data.Attoparsec.ByteString
   , module Data.Attoparsec.ByteString.Char8
+  , verifyCavs
 ) where
 
 
@@ -66,6 +66,10 @@ verifySig k m = bool Failed Ok $
     hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256)
     derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256)
 
+verifyMacaroon :: Key -> [CaveatVerifier] -> Macaroon -> Verified
+verifyMacaroon secret verifiers m = verifySig secret m `mappend` verifyCavs verifiers m
+
+
 verifyCavs :: [CaveatVerifier] -> Macaroon -> Verified
 verifyCavs verifiers m = foldMap (\c -> fromMaybe Failed $ foldMap (($ c) . vFun) verifiers) (caveats m)
 
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