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,
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,
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,
, 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
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
--- /dev/null
+{-# 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)
+
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
]
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" $
\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
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
projects / github / fretlink / hmacaroons.git / commitdiff
