1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
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 Crypto.Macaroon.Internal
import Data.Attoparsec.ByteString
import qualified Data.Attoparsec.ByteString.Char8 as A8
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64.URL as B64
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Hex
import Data.Int
import Data.List
import Data.Maybe
import Data.Serialize
import Data.Word
-- | 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)
|
