5 files changed, 90 insertions, 56 deletions

diff --git a/README.md b/README.md
index f3fd91a..45b84e0 100644
--- a/README.md
+++ b/README.md
@@ -5,14 +5,34 @@ Macaroons is a pure haskell implementation of macaroons. It aims to provide
 compatibility at a serialized level with the [reference implementation](https://github.com/rescrv/libmacaroons)
 and the [python implementation](https://github.com/ecordell/pymacaroons)
 
-[Google paper on macaroons](http://research.google.com/pubs/pub41892.html)
-[Macaroons at Mozilla](https://air.mozilla.org/macaroons-cookies-with-contextual-caveats-for-decentralized-authorization-in-the-cloud/)
-[Time for better security in NoSQL](http://hackingdistributed.com/2014/11/23/macaroons-in-hyperdex/)
-[Pure java implementation](https://github.com/nitram509/jmacaroons)
+**WARNING: This library has not been audited by security experts.**
+**There is no error handling at the moment, everyhting is silently accepted**
+
+It is developed in the purpose of exploration purposes, and would need much
+more attention if it were to be used in production.
+
+References
+==========
+
+Papers and articles
+-------------------
+
+- [Google paper on macaroons](http://research.google.com/pubs/pub41892.html)
+- [Macaroons at Mozilla](https://air.mozilla.org/macaroons-cookies-with-contextual-caveats-for-decentralized-authorization-in-the-cloud/)
+- [Time for better security in NoSQL](http://hackingdistributed.com/2014/11/23/macaroons-in-hyperdex/)
+
+Implementations
+---------------
+
+- [C](https://github.com/rescrv/libmacaroons)
+- [Java](https://github.com/nitram509/jmacaroons)
+- [Python](https://github.com/ecordell/pymacaroons)
 
 TODO
 ====
 
-- Verifiy Macaroons
+- Verify Macaroons
 - Discharge Macaroons
-
+- JSON serialization
+- Quickcheck tests
+- Error handling
diff --git a/src/Crypto/Macaroon.hs b/src/Crypto/Macaroon.hs
index 819a9eb..42e4a07 100644
--- a/src/Crypto/Macaroon.hs
+++ b/src/Crypto/Macaroon.hs
@@ -8,18 +8,16 @@ Maintainer  : julien.tanguy@jhome.fr
 Stability   : experimental
 Portability : portable
 
-
 Pure haskell implementations of macaroons.
 
 Warning: this implementation has not been audited by security experts.
-Use it with caution.
+Do not use in production
 
 
 References:
 
 - Macaroons: Cookies with Contextual Caveats for Decentralized Authorization in the Cloud <http://research.google.com/pubs/pub41892.html>
 - Time for better security in NoSQL <http://hackingdistributed.com/2014/11/23/macaroons-in-hyperdex>
-
 -}
 module Crypto.Macaroon (
     -- * Types
@@ -50,11 +48,14 @@ module Crypto.Macaroon (
 
 import           Crypto.Cipher.AES
 import           Crypto.Hash
+import           Data.Char
 import           Data.Byteable
 import qualified Data.ByteString            as BS
 import qualified Data.ByteString.Base64.URL as B64
 import qualified Data.ByteString.Char8      as B8
 import           Data.Hex
+import           Data.Word
+import           Data.Serialize
 
 import           Crypto.Macaroon.Internal
 
@@ -62,7 +63,7 @@ import           Crypto.Macaroon.Internal
 create :: Key -> 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)
+    derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256)
 
 caveatLoc :: Caveat -> Location
 caveatLoc = cl
@@ -74,17 +75,7 @@ caveatVId :: Caveat -> Key
 caveatVId = vid
 
 inspect :: Macaroon -> String
-inspect m = unlines [ "location " ++ show (location m)
-                    , "identifier " ++ show (identifier m)
-                    , (concatMap (showCav (location m)) (caveats m))
-                    , "signature " ++ show (hex $ signature m)
-                    ]
-  where
-    showCav loc c | cl c == loc && vid c == BS.empty = "cid " ++ show (cid c)
-                  | otherwise = unlines [ "cid " ++ show (cid c)
-                                        , "vid " ++ show (vid c)
-                                        , "cl " ++ show (cl c)
-                                        ]
+inspect = show
 
 serialize :: Macaroon -> BS.ByteString
 serialize m = B8.filter (/= '=') . B64.encode $ packets
@@ -100,6 +91,16 @@ serialize m = B8.filter (/= '=') . B64.encode $ packets
                                             , putPacket "vid" (vid c)
                                             , putPacket "cl" (cl c)
                                             ]
+    putPacket key dat = BS.concat [
+        B8.map toLower . hex . encode $ (fromIntegral size :: Word16)
+        , key
+        , " "
+        , dat
+        , "\n"
+        ]
+      where
+        size = 4 + 2 + BS.length key + BS.length dat
+
 
 
 
diff --git a/src/Crypto/Macaroon/Binder.hs b/src/Crypto/Macaroon/Binder.hs
index 3ec3d67..91f07ce 100644
--- a/src/Crypto/Macaroon/Binder.hs
+++ b/src/Crypto/Macaroon/Binder.hs
@@ -24,5 +24,5 @@ newtype Binder = Binder { bind :: Macaroon -> Macaroon -> BS.ByteString }
 
 -- | Binder which concatenates the two signatures and hashes them
 hashSigs :: Binder
-hashSigs = Binder $ \m m' -> toBytes $ (HMAC . hash $ BS.append (toBytes $ signature m') (toBytes $ signature m) :: HMAC SHA256)
+hashSigs = Binder $ \m m' -> toBytes (HMAC . hash $ BS.append (toBytes $ signature m') (toBytes $ signature m) :: HMAC SHA256)
 
diff --git a/src/Crypto/Macaroon/Internal.hs b/src/Crypto/Macaroon/Internal.hs
index fc50486..82ce0b4 100644
--- a/src/Crypto/Macaroon/Internal.hs
+++ b/src/Crypto/Macaroon/Internal.hs
@@ -21,10 +21,8 @@ import           Data.Byteable
 import qualified Data.ByteString        as BS
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8  as B8
-import           Data.Char
 import           Data.Hex
-import           Data.Serialize
-import           Data.Word
+import           Data.List
 
 -- |Type alias for Macaroons and Caveat keys and identifiers
 type Key = BS.ByteString
@@ -45,6 +43,14 @@ data Macaroon = MkMacaroon { location   :: Location
                            -- ^ Macaroon HMAC signature
                            } deriving (Eq)
 
+instance Show Macaroon where
+    -- We use intercalate because unlines would add a trailing newline
+    show (MkMacaroon l i c s) = intercalate "\n" [
+                      "location " ++ B8.unpack l
+                    , "identifier " ++ B8.unpack i
+                    , concatMap show c
+                    , "signature " ++ B8.unpack (hex s)
+                    ]
 
 instance NFData Macaroon where
     rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig
@@ -60,21 +66,18 @@ data Caveat = MkCaveat { cid :: Key
 
                        } deriving (Eq)
 
+instance Show Caveat where
+    show (MkCaveat c v l) | v == BS.empty = "cid " ++ B8.unpack c
+                          | otherwise = unlines [ "cid " ++ B8.unpack c
+                                                , "vid " ++ B8.unpack v
+                                                , "cl " ++ B8.unpack l
+                                                ]
+
+
 instance NFData Caveat where
     rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl
 
 
-putPacket :: BS.ByteString -> BS.ByteString -> BS.ByteString
-putPacket key dat = BS.concat [
-    B8.map toLower . hex . encode $ (fromIntegral size :: Word16)
-    , key
-    , " "
-    , dat
-    , "\n"
-    ]
-  where
-    size = 4 + 2 + BS.length key + BS.length dat
-
 addCaveat :: Location
           -> Key
           -> Key
@@ -84,5 +87,5 @@ addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig}
   where
     cavs = caveats m
     cav' = MkCaveat cid vid loc
-    sig = toBytes $ (hmac (signature m) (BS.append vid cid) :: HMAC SHA256)
+    sig = toBytes (hmac (signature m) (BS.append vid cid) :: HMAC SHA256)
 
diff --git a/test/Crypto/Macaroon/Tests.hs b/test/Crypto/Macaroon/Tests.hs
index cdfb620..f57bec3 100644
--- a/test/Crypto/Macaroon/Tests.hs
+++ b/test/Crypto/Macaroon/Tests.hs
@@ -23,6 +23,7 @@ tests :: TestTree
 tests = testGroup "Crypto.Macaroon" [ basicSignature
                                     , basicSerialize
                                     , basicMint
+                                    , basicInspect
                                     , basicMintTrimmed
                                     ]
 
@@ -34,12 +35,39 @@ m = create secret key loc
     key = B8.pack "we used our secret key"
     loc = B8.pack "http://mybank/"
 
+basicSignature = testCase "Basic signature" $
+    "E3D9E02908526C4C0039AE15114115D97FDD68BF2BA379B342AAF0F617D0552F" @=? (hex . signature) m
+
+basicSerialize = testCase "Serialization" $
+    "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudG\
+    \lmaWVyIHdlIHVzZWQgb3VyIHNlY3JldCBrZXkKMDAyZnNpZ25h\
+    \dHVyZSDj2eApCFJsTAA5rhURQRXZf91ovyujebNCqvD2F9BVLwo" @=? serialize m
+
 m2 :: Macaroon
 m2 = addFirstPartyCaveat "test = caveat" m
 
+basicInspect = testCase "Inspect" $
+    "location http://mybank/\nidentifier we used\
+    \ our secret key\ncid test = caveat\nsignature\
+    \ 197BAC7A044AF33332865B9266E26D49\
+    \3BDD668A660E44D88CE1A998C23DBD67" @=? inspect m2
+
+
+basicMint = testCase "First Party Caveat" $
+    "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudGlmaWVyIHdlIHVzZ\
+    \WQgb3VyIHNlY3JldCBrZXkKMDAxNmNpZCB0ZXN0ID0gY2F2ZWF0CjAwMmZzaWduYXR1cmUgGXusegR\
+    \K8zMyhluSZuJtSTvdZopmDkTYjOGpmMI9vWcK" @=? serialize m2
+
+
 m3 :: Macaroon
 m3 = addFirstPartyCaveat "test = acaveat" m
 
+basicMintTrimmed = testCase "Trimmed base64" $
+    "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudGlmaWVyIHdlIHVz\
+    \ZWQgb3VyIHNlY3JldCBrZXkKMDAxN2NpZCB0ZXN0ID0gYWNhdmVhdAowMDJmc2ln\
+    \bmF0dXJlIJRJ_V3WNJQnqlVq5eez7spnltwU_AXs8NIRY739sHooCg" @=? serialize m3
+
+
 m4 :: Macaroon
 m4 = addThirdPartyCaveat caveat_key caveat_id caveat_loc n
   where
@@ -52,23 +80,5 @@ m4 = addThirdPartyCaveat caveat_key caveat_id caveat_loc n
     caveat_loc = B8.pack "http://auth.mybank/"
 
 
-basicSignature = testCase "Basic signature" $
-    "E3D9E02908526C4C0039AE15114115D97FDD68BF2BA379B342AAF0F617D0552F" @=? (hex . signature) m
-
-basicSerialize = testCase "Serialization" $
-    "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudG\
-    \lmaWVyIHdlIHVzZWQgb3VyIHNlY3JldCBrZXkKMDAyZnNpZ25h\
-    \dHVyZSDj2eApCFJsTAA5rhURQRXZf91ovyujebNCqvD2F9BVLwo" @=? serialize m
-
-basicMint = testCase "First Party Caveat" $
-    "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudGlmaWVyIHdlIHVzZ\
-    \WQgb3VyIHNlY3JldCBrZXkKMDAxNmNpZCB0ZXN0ID0gY2F2ZWF0CjAwMmZzaWduYXR1cmUgGXusegR\
-    \K8zMyhluSZuJtSTvdZopmDkTYjOGpmMI9vWcK" @=? serialize m2
-
-basicMintTrimmed = testCase "Trimmed base64" $ 
-    "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudGlmaWVyIHdlIHVz\
-    \ZWQgb3VyIHNlY3JldCBrZXkKMDAxN2NpZCB0ZXN0ID0gYWNhdmVhdAowMDJmc2ln\
-    \bmF0dXJlIJRJ_V3WNJQnqlVq5eez7spnltwU_AXs8NIRY739sHooCg" @=? serialize m3
-
-basicThirdParty = testCase "Third Party Caveat" $ 
+basicThirdParty = testCase "Third Party Caveat" $
     "6B99EDB2EC6D7A4382071D7D41A0BF7DFA27D87D2F9FEA86E330D7850FFDA2B2" @=? (hex . signature) m4