Deserialize Macaroons

- Refactor serialization/deserialization into its own module
- Refactor tests

4 files changed, 127 insertions, 45 deletions

diff --git a/hmacaroons.cabal b/hmacaroons.cabal
index a9f6ea5..9733a18 100644
--- a/hmacaroons.cabal
+++ b/hmacaroons.cabal
@@ -15,9 +15,11 @@ cabal-version:       >=1.10
 library
   exposed-modules:     Crypto.Macaroon,
                        Crypto.Macaroon.Binder
+                       Crypto.Macaroon.Serializer.Base64
   other-modules:       Crypto.Macaroon.Internal
   -- other-extensions:    
   build-depends:  base >=4 && < 5,
+                  attoparsec >=0.12,
                   bytestring >=0.10,
                   base64-bytestring >= 1.0,
                   byteable >= 0.1 && <0.2,
@@ -36,6 +38,7 @@ benchmark bench
   main-is:          bench.hs
   ghc-options:      -O2
   build-depends:  base >= 4 && <5,
+                  attoparsec >=0.12,
                   bytestring >=0.10,
                   base64-bytestring >= 1.0,
                   cereal >= 0.4,
@@ -52,6 +55,7 @@ test-suite test
   hs-source-dirs: test
   main-is: tests.hs
   build-depends:  base >= 4 && <5,
+                  attoparsec >=0.12,
                   bytestring >=0.10,
                   base64-bytestring >= 1.0,
                   byteable >= 0.1 && <0.2,
diff --git a/src/Crypto/Macaroon.hs b/src/Crypto/Macaroon.hs
index 07043f7..36aecf9 100644
--- a/src/Crypto/Macaroon.hs
+++ b/src/Crypto/Macaroon.hs
@@ -42,21 +42,14 @@ module Crypto.Macaroon (
     , inspect
     , addFirstPartyCaveat
     , addThirdPartyCaveat
-
-    -- * Prepare Macaroons for transfer
-    , serialize
     ) where
 
 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
 
@@ -82,34 +75,6 @@ caveatVId = vid
 inspect :: Macaroon -> String
 inspect = show
 
--- | Serialize a macaroon in an URL-safe Base64 encoding
-serialize :: Macaroon -> BS.ByteString
-serialize m = B8.filter (/= '=') . B64.encode $ packets
-  where
-    packets = BS.concat [ putPacket "location" (location m)
-                        , putPacket "identifier" (identifier m)
-                        , caveatPackets
-                        , putPacket "signature" (signature m)
-                        ]
-    caveatPackets = BS.concat $ map (cavPacket (location m)) (caveats m)
-    cavPacket loc c | cl c == loc && vid c == BS.empty = putPacket "cid" (cid c)
-                    | otherwise = BS.concat [ putPacket "cid" (cid c)
-                                            , 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
-
-
-
-
 -- | Add a first party Caveat to a Macaroon, with its identifier
 addFirstPartyCaveat :: Key -> Macaroon -> Macaroon
 addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m
diff --git a/src/Crypto/Macaroon/Serializer/Base64.hs b/src/Crypto/Macaroon/Serializer/Base64.hs
new file mode 100644
index 0000000..6fc8fcb
--- /dev/null
+++ b/src/Crypto/Macaroon/Serializer/Base64.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module      : Crypto.Macaroon.Serializer.Base64
+Copyright   : (c) 2015 Julien Tanguy
+License     : BSD3
+
+Maintainer  : julien.tanguy@jhome.fr
+Stability   : experimental
+Portability : portable
+
+Base64 serializer/deserializer
+
+-}
+module Crypto.Macaroon.Serializer.Base64 (
+        serialize
+      , deserialize
+      ) where
+
+import Control.Applicative
+import Control.Monad
+import qualified Data.ByteString            as BS
+import qualified Data.ByteString.Base64.URL as B64
+import qualified Data.ByteString.Char8      as B8
+import Data.Attoparsec.ByteString
+import qualified Data.Attoparsec.ByteString.Char8 as A8
+import           Data.Bits
+import           Data.Char
+import           Data.Hex
+import           Data.Int
+import           Data.List
+import           Data.Maybe
+import           Data.Word
+import           Data.Serialize
+import Crypto.Macaroon.Internal
+
+
+-- | Serialize a macaroon in an URL-safe Base64 encoding
+serialize :: Macaroon -> BS.ByteString
+serialize m = B8.filter (/= '=') . B64.encode . runPut $ do
+    packetize "location" (location m)
+    packetize "identifier" (identifier m)
+    forM_ (caveats m) $ \c -> do
+        packetize "cid" (cid c)
+        unless (cl c == location m && vid c == BS.empty) $ do
+            packetize "vid" (vid c)
+            packetize "cl" (cl c)
+    packetize "signature" (signature m)
+
+packetize :: BS.ByteString -> BS.ByteString -> Put
+packetize key dat = do
+    let size = 4 + 2 + BS.length key + BS.length dat
+    putByteString $ B8.map toLower . hex . encode $ (fromIntegral size :: Word16)
+    putByteString key
+    putByteString " "
+    putByteString dat
+    putByteString "\n"
+
+deserialize :: BS.ByteString -> Either String Macaroon
+deserialize = parseOnly macaroon . B64.decodeLenient
+
+
+macaroon :: Parser Macaroon
+macaroon = do
+    ps <- many packet <* endOfInput
+    let ([("location",l),("identifier",i)],ps') = splitAt 2 ps
+    let (caveats,sig) = splitAt (length ps' - 1) ps'
+    let [("signature",s)] = sig
+    return $ MkMacaroon l i (map (mkCaveat l) (groupBy splitCavs caveats)) s
+  where
+    mkCaveat _ [("cid",c),("vid",v),("cl",l)] = MkCaveat c v l
+    mkCaveat l [("cid",c)] = MkCaveat c BS.empty l
+    mkCaveat _ _ = error "Malformed caveat"
+    splitCavs _ ("cid",_) = False
+    splitCavs _ _ = True
+
+packet :: Parser (BS.ByteString, BS.ByteString)
+packet = do
+    size <- A8.take 4
+    case A8.parseOnly (A8.hexadecimal :: Parser Word16) size of
+        Left e -> fail e
+        Right s -> do
+            bs <- A8.take (fromIntegral $ s - 4)
+            let (key, dat) = B8.break (== ' ') bs
+            return (key, B8.tail $ B8.init dat)
+
diff --git a/test/Crypto/Macaroon/Tests.hs b/test/Crypto/Macaroon/Tests.hs
index f57bec3..6fa6504 100644
--- a/test/Crypto/Macaroon/Tests.hs
+++ b/test/Crypto/Macaroon/Tests.hs
@@ -18,13 +18,13 @@ import           Test.Tasty
 import           Test.Tasty.HUnit
 
 import           Crypto.Macaroon
+import           Crypto.Macaroon.Serializer.Base64
 
 tests :: TestTree
-tests = testGroup "Crypto.Macaroon" [ basicSignature
-                                    , basicSerialize
-                                    , basicMint
-                                    , basicInspect
-                                    , basicMintTrimmed
+tests = testGroup "Crypto.Macaroon" [ basic
+                                    , minted
+                                    , minted2
+                                    , minted3
                                     ]
 
 
@@ -35,7 +35,13 @@ m = create secret key loc
     key = B8.pack "we used our secret key"
     loc = B8.pack "http://mybank/"
 
-basicSignature = testCase "Basic signature" $
+basic :: TestTree
+basic = testGroup "Basic macaroon" [ basicSignature
+                                   , basicSerialize
+                                   , basicDeserialize
+                                   ]
+
+basicSignature = testCase "Signature" $
     "E3D9E02908526C4C0039AE15114115D97FDD68BF2BA379B342AAF0F617D0552F" @=? (hex . signature) m
 
 basicSerialize = testCase "Serialization" $
@@ -43,30 +49,49 @@ basicSerialize = testCase "Serialization" $
     \lmaWVyIHdlIHVzZWQgb3VyIHNlY3JldCBrZXkKMDAyZnNpZ25h\
     \dHVyZSDj2eApCFJsTAA5rhURQRXZf91ovyujebNCqvD2F9BVLwo" @=? serialize m
 
+basicDeserialize = testCase "Deserialization" $
+    Right m @=? (deserialize . serialize) m
+
 m2 :: Macaroon
 m2 = addFirstPartyCaveat "test = caveat" m
 
-basicInspect = testCase "Inspect" $
+minted :: TestTree
+minted = testGroup "Macaroon with first party caveat" [ mintInspect
+                                                      , mintSerialize
+                                                      , mintDeserialize
+                                                      ]
+
+mintInspect = testCase "Inspect" $
     "location http://mybank/\nidentifier we used\
     \ our secret key\ncid test = caveat\nsignature\
     \ 197BAC7A044AF33332865B9266E26D49\
     \3BDD668A660E44D88CE1A998C23DBD67" @=? inspect m2
 
 
-basicMint = testCase "First Party Caveat" $
+mintSerialize = testCase "Serialization" $
     "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudGlmaWVyIHdlIHVzZ\
     \WQgb3VyIHNlY3JldCBrZXkKMDAxNmNpZCB0ZXN0ID0gY2F2ZWF0CjAwMmZzaWduYXR1cmUgGXusegR\
     \K8zMyhluSZuJtSTvdZopmDkTYjOGpmMI9vWcK" @=? serialize m2
 
+mintDeserialize = testCase "Deserialization" $
+    Right m2 @=? (deserialize . serialize) m2
+
 
 m3 :: Macaroon
 m3 = addFirstPartyCaveat "test = acaveat" m
 
-basicMintTrimmed = testCase "Trimmed base64" $
+minted2 :: TestTree
+minted2 = testGroup "Macaroon with first party caveats" [ mint2Trimmed
+                                                        , mint2Des
+                                                        ]
+
+mint2Trimmed = testCase "Serialization" $
     "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudGlmaWVyIHdlIHVz\
     \ZWQgb3VyIHNlY3JldCBrZXkKMDAxN2NpZCB0ZXN0ID0gYWNhdmVhdAowMDJmc2ln\
     \bmF0dXJlIJRJ_V3WNJQnqlVq5eez7spnltwU_AXs8NIRY739sHooCg" @=? serialize m3
 
+mint2Des = testCase "Deserialization" $
+    Right m3 @=? (deserialize . serialize) m3
 
 m4 :: Macaroon
 m4 = addThirdPartyCaveat caveat_key caveat_id caveat_loc n
@@ -79,6 +104,9 @@ m4 = addThirdPartyCaveat caveat_key caveat_id caveat_loc n
     caveat_id = B8.pack "this was how we remind auth of key/pred"
     caveat_loc = B8.pack "http://auth.mybank/"
 
+minted3 :: TestTree
+minted3 = testGroup "Macaroon with first and third party caveats" [ mint3sig ]
+
 
-basicThirdParty = testCase "Third Party Caveat" $
+mint3sig = testCase "Signature" $
     "6B99EDB2EC6D7A4382071D7D41A0BF7DFA27D87D2F9FEA86E330D7850FFDA2B2" @=? (hex . signature) m4