9 files changed, 104 insertions, 72 deletions

diff --git a/hmacaroons.cabal b/hmacaroons.cabal
index 9424f22..83b2cd7 100644
--- a/hmacaroons.cabal
+++ b/hmacaroons.cabal
@@ -1,5 +1,5 @@
 name:                hmacaroons
-version:             0.2.0.0
+version:             0.3.0.0
 synopsis:            Haskell implementation of macaroons
 description:
   Hmacaroons is a pure haskell implementation of macaroons. It aims to
@@ -51,10 +51,11 @@ source-repository head
 
 library
   exposed-modules:     Crypto.Macaroon
-                       Crypto.Macaroon.Binder
+                       -- Crypto.Macaroon.Binder
                        Crypto.Macaroon.Serializer.Base64
                        Crypto.Macaroon.Verifier
   other-modules:       Crypto.Macaroon.Internal
+                       Crypto.Macaroon.Verifier.Internal
   build-depends:  base >=4 && < 5,
                   attoparsec >=0.12,
                   transformers >= 0.4,
@@ -93,7 +94,7 @@ benchmark bench
 test-suite test
   default-language: Haskell2010
   type: exitcode-stdio-1.0
-  hs-source-dirs: test
+  hs-source-dirs: src, test
   main-is: main.hs
   build-depends:  base >= 4 && <5,
                   attoparsec >=0.12,
@@ -108,4 +109,5 @@ test-suite test
                   tasty-hunit >= 0.9,
                   tasty-quickcheck >= 0.8,
                   QuickCheck >= 2.8,
-                  hmacaroons
+                  deepseq >= 1.1,
+                  transformers >= 0.4
diff --git a/src/Crypto/Macaroon.hs b/src/Crypto/Macaroon.hs
index bfcf8df..c9c8c21 100644
--- a/src/Crypto/Macaroon.hs
+++ b/src/Crypto/Macaroon.hs
@@ -23,6 +23,7 @@ module Crypto.Macaroon (
     -- * Types
       Macaroon
     , Caveat
+    , Secret
     , Key
     , Location
     , Sig
@@ -33,9 +34,9 @@ module Crypto.Macaroon (
     , caveats
     , signature
     -- ** Caveats
-    , caveatLoc
-    , caveatId
-    , caveatVId
+    , cl
+    , cid
+    , vid
 
     -- * Create Macaroons
     , create
@@ -54,23 +55,11 @@ import qualified Data.ByteString.Char8      as B8
 import           Crypto.Macaroon.Internal
 
 -- | Create a Macaroon from its key, identifier and location
-create :: Key -> Key -> Location -> Macaroon
+create :: Secret -> Key -> Location -> Macaroon
 create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256))
   where
     derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256)
 
--- | Caveat target location
-caveatLoc :: Caveat -> Location
-caveatLoc = cl
-
--- | Caveat identifier
-caveatId :: Caveat -> Key
-caveatId = cid
-
--- | Caveat verification identifier
-caveatVId :: Caveat -> Key
-caveatVId = vid
-
 -- | Inspect a macaroon's contents. For debugging purposes.
 inspect :: Macaroon -> String
 inspect = show
diff --git a/src/Crypto/Macaroon/Internal.hs b/src/Crypto/Macaroon/Internal.hs
index 2f56512..d6e80d3 100644
--- a/src/Crypto/Macaroon/Internal.hs
+++ b/src/Crypto/Macaroon/Internal.hs
@@ -23,7 +23,11 @@ import qualified Data.ByteString.Char8  as B8
 import           Data.Hex
 import           Data.List
 
--- |Type alias for Macaroons and Caveat keys and identifiers
+
+-- |Type alias for Macaroons secret keys
+type Secret = BS.ByteString
+
+-- |Type alias for Macaroons and Caveat and identifiers
 type Key = BS.ByteString
 
 -- |Type alias for Macaroons and Caveat locations
diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs
index 7d5f094..a739437 100644
--- a/src/Crypto/Macaroon/Verifier.hs
+++ b/src/Crypto/Macaroon/Verifier.hs
@@ -52,8 +52,23 @@ import           Crypto.Macaroon.Verifier.Internal
 -- (.>=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
 -- (.>=) = verifyOpBool "Strictly less" (>=) ">="
 
-
-verify :: MonadIO m => Key -> [Caveat -> m (Maybe (Either ValidationError Caveat))] -> Macaroon -> m (Either ValidationError Macaroon)
+-- | Verify a Macaroon's signature and caveats, given the corresponding Secret
+-- and verifiers.
+--
+-- A verifier is a function of type
+-- @'MonadIO' m => 'Caveat' -> m ('Maybe' ('Either' 'ValidatorError' 'Caveat'))@.
+--
+-- It should return:
+--
+-- * 'Nothing' if the caveat is not related to the verifier
+-- (for instance a time verifier is given an action caveat);
+-- * 'Just' ('Left' ('ParseError' reason)) if the verifier  is related to the
+-- caveat, but failed to parse it completely;
+-- * 'Just' ('Left' ('ValidatorError' reason)) if the verifier is related to the
+-- caveat, parsed it and invalidated it;
+-- * 'Just' ('Right' '()') if the verifier has successfully verified the
+-- given caveat
+verify :: MonadIO m => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon)
 verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers)
 
 
@@ -64,12 +79,12 @@ verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verif
 --   where
 --     valueParser = string op *> skipSpace *> takeByteString
 
-verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat))
-verifyParser k p f c = case parseOnly keyParser . cid $ c of
-    Left _ -> return Nothing
-    Right bs -> Just <$> case parseOnly p bs of
-      Left err -> return $ Left $ ParseError err
-      Right a -> fmap (const c) <$> f a
-  where
-    keyParser = string k *> skipSpace *> takeByteString
+-- verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat))
+-- verifyParser k p f c = case parseOnly keyParser . cid $ c of
+--     Left _ -> return Nothing
+--     Right bs -> Just <$> case parseOnly p bs of
+--       Left err -> return $ Left $ ParseError err
+--       Right a -> fmap (const c) <$> f a
+--   where
+--     keyParser = string k *> skipSpace *> takeByteString
 
diff --git a/src/Crypto/Macaroon/Verifier/Internal.hs b/src/Crypto/Macaroon/Verifier/Internal.hs
index b65b62d..2af55d3 100644
--- a/src/Crypto/Macaroon/Verifier/Internal.hs
+++ b/src/Crypto/Macaroon/Verifier/Internal.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE OverloadedStrings    #-}
-{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
 {-|
 Module      : Crypto.Macaroon.Verifier.Internal
 Copyright   : (c) 2015 Julien Tanguy
@@ -19,22 +19,26 @@ import           Control.Monad.IO.Class
 import           Crypto.Hash
 import           Data.Bool
 import           Data.Byteable
-import qualified Data.ByteString                  as BS
+import qualified Data.ByteString          as BS
 import           Data.Either
 import           Data.Either.Validation
 import           Data.Foldable
 import           Data.Maybe
+import           Data.Monoid
 
 import           Crypto.Macaroon.Internal
 
-data Win = Win
-
-data ValidationError = SigMismatch
-                     | NoVerifier
-                     | ParseError String
-                     | ValidatorError String
-                     deriving Show
+-- | Type representing different validation errors.
+-- Only 'ParseError' and 'ValidatorError' are exported, 'SigMismatch' and
+-- 'NoVerifier' are used internally and should not be used by the user
+data ValidationError = SigMismatch -- ^ Signatures do not match
+                     | NoVerifier -- ^ No verifier can handle a given caveat
+                     | ParseError String -- ^ A verifier had a parse error
+                     | ValidatorError String -- ^ A verifier failed
+                     deriving (Show,Eq)
 
+-- | The 'Monoid' instance is written so 'SigMismatch' is an annihilator,
+-- and 'NoVerifier' is the identity element
 instance Monoid ValidationError where
     mempty = NoVerifier
     NoVerifier `mappend` e = e
@@ -52,9 +56,9 @@ verifySig k m = bool (Left SigMismatch) (Right m) $
     hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256)
     derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256)
 
-
+-- | Given a list of verifiers, verify each caveat of the given macaroon
 verifyCavs :: MonadIO m
-           => [Caveat -> m (Maybe (Either ValidationError Caveat))]
+           => [Caveat -> m (Maybe (Either ValidationError ()))]
            -> Macaroon
            -> m (Either ValidationError Macaroon)
 verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m)
@@ -65,7 +69,7 @@ verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m)
      - starting value for the foldM. We are guaranteed to have a `Just something`
      - from it.
      -}
-    validateCaveat c = fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers
+    validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers
     -- defErr :: Caveat -> Maybe (Validation String Caveat)
     defErr c = Just $ Failure NoVerifier
     -- gatherEithers :: [Validation String Caveat] -> Either String Caveat
diff --git a/test/Crypto/Macaroon/Instances.hs b/test/Crypto/Macaroon/Instances.hs
index 9c89857..6348c56 100644
--- a/test/Crypto/Macaroon/Instances.hs
+++ b/test/Crypto/Macaroon/Instances.hs
@@ -32,10 +32,10 @@ instance Arbitrary Url where
         domain <- elements [".com",".net"]
         return . Url . B8.pack $ (protocol ++ name ++ domain)
 
-newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show)
+newtype BSSecret = BSSecret { unSecret :: BS.ByteString } deriving (Show)
 
-instance Arbitrary Secret where
-    arbitrary = Secret . B8.pack <$> scale (*3) arbitrary
+instance Arbitrary BSSecret where
+    arbitrary = BSSecret . B8.pack <$> scale (*3) arbitrary
 
 newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show)
 
diff --git a/test/Crypto/Macaroon/Verifier/Internal/Tests.hs b/test/Crypto/Macaroon/Verifier/Internal/Tests.hs
new file mode 100644
index 0000000..cd75118
--- /dev/null
+++ b/test/Crypto/Macaroon/Verifier/Internal/Tests.hs
@@ -0,0 +1,30 @@
+{-# 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.Internal.Tests where
+
+import qualified Data.ByteString.Char8             as B8
+import           Data.List
+import           Test.Tasty
+-- import Test.Tasty.HUnit
+import           Data.Either
+import           Test.Tasty.QuickCheck             hiding (Failure, Success)
+
+import           Crypto.Macaroon
+import           Crypto.Macaroon.Verifier.Internal
+
+import           Crypto.Macaroon.Instances
+
+tests :: TestTree
+tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs
+                                                      ]
+
+sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm)
diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs
index 670c991..b6220eb 100644
--- a/test/Crypto/Macaroon/Verifier/Tests.hs
+++ b/test/Crypto/Macaroon/Verifier/Tests.hs
@@ -12,21 +12,20 @@ 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 qualified Data.ByteString.Char8     as B8
+import           Data.List
+import           Test.Tasty
 -- import Test.Tasty.HUnit
-import Test.Tasty.QuickCheck hiding (Success, Failure)
-import Data.Either
+import           Data.Either
+import           Test.Tasty.QuickCheck     hiding (Failure, Success)
 
 import           Crypto.Macaroon
 import           Crypto.Macaroon.Verifier
 
-import Crypto.Macaroon.Instances
+import           Crypto.Macaroon.Instances
 
 tests :: TestTree
-tests = testGroup "Crypto.Macaroon.Verifier" [ sigs
-                                             ]
+tests = testGroup "Crypto.Macaroon.Verifier" [ ]
 
 {-
  - Test fixtures
@@ -45,22 +44,9 @@ m2 = addFirstPartyCaveat "test = caveat" m
 m3 :: Macaroon
 m3 = addFirstPartyCaveat "value = 42" m2
 
--- exTC = verifyExact "test" "caveat" (many' letter_ascii)
--- exTZ = verifyExact "test" "bleh" (many' letter_ascii)
--- exV42 = verifyExact "value" 42 decimal
--- exV43 = verifyExact "value" 43 decimal
-
--- funTCPre = verifyFun "test" (string "test = " *> many' letter_ascii)
---                             (\e ->  if "cav" `isPrefixOf` e then Right e else Left "Does not start with cav" )
--- funTV43lte = verifyFun "value" (string "value = " *> decimal)
---                                (\v -> if v <= 43 then Right v else Left "Greater than 43")
-
--- allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte]
-
 {-
  - Tests
  -}
-sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm)
 
 -- TODO: Re-do tests
 {-
diff --git a/test/main.hs b/test/main.hs
index 3edbe54..67ebcd5 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -1,12 +1,13 @@
 module Main where
 
-import Test.Tasty
-import Test.Tasty.HUnit
+import           Test.Tasty
+import           Test.Tasty.HUnit
 
-import qualified Sanity
-import qualified Crypto.Macaroon.Tests
 import qualified Crypto.Macaroon.Serializer.Base64.Tests
+import qualified Crypto.Macaroon.Tests
+import qualified Crypto.Macaroon.Verifier.Internal.Tests
 import qualified Crypto.Macaroon.Verifier.Tests
+import qualified Sanity
 
 main = defaultMain tests
 
@@ -15,5 +16,6 @@ tests = testGroup "Tests" [ Sanity.tests
                           , Crypto.Macaroon.Tests.tests
                           , Crypto.Macaroon.Serializer.Base64.Tests.tests
                           , Crypto.Macaroon.Verifier.Tests.tests
+                          , Crypto.Macaroon.Verifier.Internal.Tests.tests
                           ]