From b92e3c159fad49b86fe4bd115f487057c04e3c18 Mon Sep 17 00:00:00 2001
From: Julien Tanguy <julien.tanguy@jhome.fr>
Date: Thu, 14 May 2015 19:00:50 +0200
Subject: Basic verification of macaroons

- Only signatures are checked
---
 hmacaroons.cabal                       |  3 +-
 src/Crypto/Macaroon/Verifier.hs        | 34 ++++++++++++++++++++
 test/Crypto/Macaroon/Verifier/Tests.hs | 59 ++++++++++++++++++++++++++++++++++
 test/main.hs                           |  2 ++
 4 files changed, 97 insertions(+), 1 deletion(-)
 create mode 100644 src/Crypto/Macaroon/Verifier.hs
 create mode 100644 test/Crypto/Macaroon/Verifier/Tests.hs

diff --git a/hmacaroons.cabal b/hmacaroons.cabal
index e80cfa4..48e2cfe 100644
--- a/hmacaroons.cabal
+++ b/hmacaroons.cabal
@@ -53,9 +53,10 @@ source-repository head
     location:   https://github.com/jtanguy/hmacaroons
 
 library
-  exposed-modules:     Crypto.Macaroon,
+  exposed-modules:     Crypto.Macaroon
                        Crypto.Macaroon.Binder
                        Crypto.Macaroon.Serializer.Base64
+                       Crypto.Macaroon.Verifier
   other-modules:       Crypto.Macaroon.Internal
   build-depends:  base >=4 && < 5,
                   attoparsec >=0.12,
diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
new file mode 100644
index 0000000..0d1636c
--- /dev/null
+++ b/src/Crypto/Macaroon/Verifier.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module      : Crypto.Macaroon.Verifier
+Copyright   : (c) 2015 Julien Tanguy
+License     : BSD3
+
+Maintainer  : julien.tanguy@jhome.fr
+Stability   : experimental
+Portability : portable
+
+
+
+-}
+module Crypto.Macaroon.Verifier where
+
+
+import           Crypto.Hash
+import           Data.Bool
+import qualified Data.ByteString            as BS
+import           Data.Byteable
+import           Data.Foldable
+
+import           Crypto.Macaroon.Internal
+
+
+-- | Opaque datatype for now. Might need more explicit errors
+data Result = Success | Failure deriving (Show,Eq)
+
+verifySig :: Key -> Macaroon -> Result
+verifySig k m = bool Failure Success $
+      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)
diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs
new file mode 100644
index 0000000..92a8a21
--- /dev/null
+++ b/test/Crypto/Macaroon/Verifier/Tests.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Copyright   : (c) 2015 Julien Tanguy
+License     : BSD3
+
+Maintainer  : julien.tanguy@jhome.fr
+
+
+This test suite is based on the pymacaroons test suite:
+<https://github.com/ecordell/pymacaroons>
+-}
+module Crypto.Macaroon.Verifier.Tests where
+
+
+import qualified Data.ByteString.Char8 as B8
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import           Crypto.Macaroon
+import           Crypto.Macaroon.Verifier
+
+import Crypto.Macaroon.Instances
+
+tests :: TestTree
+tests = testGroup "Crypto.Macaroon.Verifier" [ sigs
+                                             ]
+
+sec = B8.pack "this is our super secret key; only we should know it"
+
+m :: Macaroon
+m = create sec key loc
+  where
+    key = B8.pack "we used our sec key"
+    loc = B8.pack "http://mybank/"
+
+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
+
diff --git a/test/main.hs b/test/main.hs
index 48519b9..3edbe54 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -6,6 +6,7 @@ import Test.Tasty.HUnit
 import qualified Sanity
 import qualified Crypto.Macaroon.Tests
 import qualified Crypto.Macaroon.Serializer.Base64.Tests
+import qualified Crypto.Macaroon.Verifier.Tests
 
 main = defaultMain tests
 
@@ -13,5 +14,6 @@ tests :: TestTree
 tests = testGroup "Tests" [ Sanity.tests
                           , Crypto.Macaroon.Tests.tests
                           , Crypto.Macaroon.Serializer.Base64.Tests.tests
+                          , Crypto.Macaroon.Verifier.Tests.tests
                           ]
 
-- 
cgit v1.2.3