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