blob: 4282cbf7661a5d9c86126c335e057a1202b961eb (
plain)
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
-- |
-- Copyright : (c) Sam Truzjan 2013
-- License : BSD3
-- Maintainer : pxqr.sta@gmail.com
-- Stability : stable
-- Portability : portable
--
-- This module provides bencode values serialization. Normally, you
-- don't need to import this module, use 'Data.BEncode' instead.
--
module Data.BEncode.Internal
( -- * Parsing
parser
, parse
-- * Rendering
, builder
, build
, ppBEncode
) where
import Control.Applicative
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as P
import Data.ByteString as B
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Lazy.Builder as B
import qualified Data.ByteString.Lazy.Builder.ASCII as B
import Data.ByteString.Internal as B (c2w, w2c)
import Data.Foldable
import Data.List as L
import Data.Monoid
import Text.PrettyPrint hiding ((<>))
import Data.BEncode.Types
import Data.BEncode.BDict as BD
{--------------------------------------------------------------------
-- Serialization
--------------------------------------------------------------------}
-- | BEncode format encoder according to specification.
builder :: BValue -> B.Builder
builder = go
where
go (BInteger i) = B.word8 (c2w 'i') <>
B.integerDec i <>
B.word8 (c2w 'e')
go (BString s) = buildString s
go (BList l) = B.word8 (c2w 'l') <>
foldMap go l <>
B.word8 (c2w 'e')
go (BDict d) = B.word8 (c2w 'd') <>
bifoldMap mkKV d <>
B.word8 (c2w 'e')
where
mkKV k v = buildString k <> go v
buildString s = B.intDec (B.length s) <>
B.word8 (c2w ':') <>
B.byteString s
{-# INLINE buildString #-}
-- | Convert bencoded value to raw bytestring according to the
-- specification.
build :: BValue -> Lazy.ByteString
build = B.toLazyByteString . builder
{--------------------------------------------------------------------
-- Deserialization
--------------------------------------------------------------------}
-- TODO try to replace peekChar with something else
-- | BEncode format parser according to specification.
parser :: Parser BValue
parser = valueP
where
valueP = do
mc <- P.peekChar
case mc of
Nothing -> fail "end of input"
Just c ->
case c of
-- if we have digit it always should be string length
di | di <= '9' -> BString <$> stringP
'i' -> P.anyChar *> ((BInteger <$> integerP) <* P.anyChar)
'l' -> P.anyChar *> ((BList <$> listBodyP) <* P.anyChar)
'd' -> P.anyChar *> (BDict <$> dictBodyP) <* P.anyChar
t -> fail ("bencode unknown tag: " ++ [t])
dictBodyP :: Parser BDict
dictBodyP = Cons <$> stringP <*> valueP <*> dictBodyP
<|> pure Nil
listBodyP = do
c <- P.peekChar
case c of
Just 'e' -> return []
_ -> (:) <$> valueP <*> listBodyP
stringP :: Parser ByteString
stringP = do
n <- P.decimal :: Parser Int
P.char ':'
P.take n
{-# INLINE stringP #-}
integerP :: Parser Integer
integerP = do
c <- P.peekChar
case c of
Just '-' -> do
P.anyChar
negate <$> P.decimal
_ -> P.decimal
{-# INLINE integerP #-}
-- | Try to convert raw bytestring to bencoded value according to
-- specification.
parse :: ByteString -> Either String BValue
parse = P.parseOnly parser
{--------------------------------------------------------------------
Pretty Printing
--------------------------------------------------------------------}
ppBS :: ByteString -> Doc
ppBS = text . L.map w2c . B.unpack
-- | Convert to easily readable JSON-like document. Typically used for
-- debugging purposes.
ppBEncode :: BValue -> Doc
ppBEncode (BInteger i) = int $ fromIntegral i
ppBEncode (BString s) = ppBS s
ppBEncode (BList l)
= brackets $ hsep $ punctuate comma $ L.map ppBEncode l
ppBEncode (BDict d)
= braces $ vcat $ punctuate comma $ L.map ppKV $ BD.toAscList d
where
ppKV (k, v) = ppBS k <+> colon <+> ppBEncode v
|
