From a20c77f85bcbc74b70c108f440435c70b29ab822 Mon Sep 17 00:00:00 2001 From: Julien Tanguy Date: Tue, 14 Apr 2015 17:40:08 +0200 Subject: Deserialize Macaroons - Refactor serialization/deserialization into its own module - Refactor tests --- hmacaroons.cabal | 4 ++ src/Crypto/Macaroon.hs | 35 ------------- src/Crypto/Macaroon/Serializer/Base64.hs | 85 ++++++++++++++++++++++++++++++++ test/Crypto/Macaroon/Tests.hs | 48 ++++++++++++++---- 4 files changed, 127 insertions(+), 45 deletions(-) create mode 100644 src/Crypto/Macaroon/Serializer/Base64.hs 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 -- cgit v1.2.3