]> git.rkrishnan.org Git - functorrent.git/blob - src/FuncTorrent/Bencode.hs
96600e2aa620e16c32de126e530ec9cabc846f1f
[functorrent.git] / src / FuncTorrent / Bencode.hs
1 {-# LANGUAGE OverloadedStrings #-}
2 module FuncTorrent.Bencode
3     (BVal(..),
4      InfoDict,
5      bstrToString,
6      encode,
7      decode
8     ) where
9
10 import Prelude hiding (length, concat)
11
12 import Control.Applicative ((<*))
13 import Data.ByteString (ByteString, length, concat)
14 import Data.ByteString.Char8 (unpack, pack)
15 import Data.Functor ((<$>))
16 import Data.Map.Strict (Map, fromList, keys, (!))
17 import Text.ParserCombinators.Parsec
18 import qualified Text.Parsec.ByteString as ParsecBS
19
20 data BVal = Bint Integer
21           | Bstr ByteString
22           | Blist [BVal]
23           | Bdict InfoDict
24             deriving (Ord, Eq, Show)
25
26 type InfoDict = Map String BVal
27
28 -- $setup
29 -- >>> import Data.Either
30
31 -- | parse strings
32 --
33 -- >>> parse bencStr "Bstr" (pack "4:spam")
34 -- Right "spam"
35 -- >>> parse bencStr "Bstr" (pack "0:")
36 -- Right ""
37 -- >>> parse bencStr "Bstr" (pack "0:hello")
38 -- Right ""
39 --
40 bencStr :: ParsecBS.Parser ByteString
41 bencStr = do _ <- spaces
42              ds <- many1 digit <* char ':'
43              s <- count (read ds) anyChar
44              return (pack s)
45
46 -- | parse integers
47 --
48 -- >>> parse bencInt "Bint" (pack "i42e")
49 -- Right 42
50 -- >>> parse bencInt "Bint" (pack "i123e")
51 -- Right 123
52 -- >>> parse bencInt "Bint" (pack "i1e")
53 -- Right 1
54 -- >>> parse bencInt "Bint" (pack "i0e")
55 -- Right 0
56 -- >>> parse bencInt "Bint" (pack "i-1e")
57 -- Right (-1)
58 -- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
59 -- True
60 -- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
61 -- True
62 -- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
63 -- True
64 bencInt :: ParsecBS.Parser Integer
65 bencInt = do _ <- spaces
66              ds <- between (char 'i') (char 'e') numbers
67              return (read ds)
68                where numbers = do d' <- char '-' <|> digit
69                                   ds' <- many digit
70                                   parseNumber d' ds'
71                      parseNumber '0' []  = return "0"
72                      parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
73                      parseNumber '-' []  = unexpected "sign without any digits"
74                      parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
75                      parseNumber d'' ds'' = return (d'':ds'')
76
77 -- | parse lists
78 --
79 -- >>> parse bencList "Blist" (pack "le")
80 -- Right []
81 -- >>> parse bencList "Blist" (pack "l4:spam4:eggse")
82 -- Right [Bstr "spam",Bstr "eggs"]
83 -- >>> parse bencList "Blist" (pack "l4:spami42ee")
84 -- Right [Bstr "spam",Bint 42]
85 -- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
86 -- Right [Bstr "spam",Bstr "eggs",Blist [Bint 42]]
87 bencList :: ParsecBS.Parser [BVal]
88 bencList = do _ <- spaces
89               between (char 'l') (char 'e') (many bencVal)
90
91 -- | parse dict
92 --
93 -- >>> parse bencDict "Bdict" (pack "de")
94 -- Right (fromList [])
95 -- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse")
96 -- Right (fromList [("cow",Bstr "moo"),("spam",Bstr "eggs")])
97 -- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee")
98 -- Right (fromList [("spam",Blist [Bstr "a",Bstr "b"])])
99 -- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
100 -- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")])
101 bencDict :: ParsecBS.Parser InfoDict
102 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
103   where kvpair = do k <- bencStr
104                     v <- bencVal
105                     return (unpack k, v)
106
107 bencVal :: ParsecBS.Parser BVal
108 bencVal = Bstr <$> bencStr <|>
109           Bint <$> bencInt <|>
110           Blist <$> bencList <|>
111           Bdict <$> bencDict
112
113 decode :: ByteString -> Either ParseError BVal
114 decode = parse bencVal "BVal"
115
116 -- Encode BVal into a bencoded ByteString. Inverse of decode
117
118 -- TODO: Use builders and lazy byte string to get O(1) concatenation over O(n)
119 -- provided by lists.
120
121 -- TODO: encode . decode pair might be a good candidate for Quickcheck.
122 -- | encode bencoded-values
123 --
124 -- >>> encode (Bstr (pack ""))
125 -- "0:"
126 -- >>> encode (Bstr (pack "spam"))
127 -- "4:spam"
128 -- >>> encode (Bint 0)
129 -- "i0e"
130 -- >>> encode (Bint 42)
131 -- "i42e"
132 -- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
133 -- "l4:spam4:eggse"
134 -- >>> encode (Blist [])
135 -- "le"
136 -- >>> encode (Bdict (fromList [("spam", Bstr $ pack "eggs")]))
137 -- "d4:spam4:eggse"
138 encode :: BVal -> ByteString
139 encode (Bstr bs) = pack $ show (length bs) ++ ":" ++ unpack bs
140 encode (Bint i) = pack $ "i" ++ show i ++ "e"
141 encode (Blist xs) = pack $ "l" ++ unpack (concat $ map encode xs) ++ "e"
142 encode (Bdict d) = concat [concat ["d", encode . Bstr . pack $ k , encode (d ! k) , "e"] | k <- keys d]
143
144 -- getters
145 bstrToString :: BVal -> Maybe String
146 bstrToString (Bstr s) = Just $ unpack s
147 bstrToString _ = Nothing