1 module FuncTorrent.Bencode
8 import Control.Applicative ((<*))
9 import Data.ByteString.Char8 (ByteString, pack, unpack)
10 import Data.Functor ((<$>))
11 import Data.Map.Strict (Map, fromList, keys, (!))
12 import Text.ParserCombinators.Parsec
13 import qualified Text.Parsec.ByteString as ParsecBS
15 data BVal = Bint Integer
19 deriving (Ord, Eq, Show)
21 type InfoDict = Map BVal BVal
24 -- >>> import Data.Either
28 -- >>> parse bencStr "Bstr" (pack "4:spam")
30 -- >>> parse bencStr "Bstr" (pack "0:")
32 -- >>> parse bencStr "Bstr" (pack "0:hello")
35 bencStr :: ParsecBS.Parser ByteString
36 bencStr = do _ <- spaces
37 ds <- many1 digit <* char ':'
38 s <- count (read ds) anyChar
43 -- >>> parse bencInt "Bint" (pack "i42e")
45 -- >>> parse bencInt "Bint" (pack "i123e")
47 -- >>> parse bencInt "Bint" (pack "i1e")
49 -- >>> parse bencInt "Bint" (pack "i0e")
51 -- >>> parse bencInt "Bint" (pack "i-1e")
53 -- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
55 -- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
57 -- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
59 bencInt :: ParsecBS.Parser Integer
60 bencInt = do _ <- spaces
61 ds <- between (char 'i') (char 'e') numbers
63 where numbers = do d' <- char '-' <|> digit
66 parseNumber '0' [] = return "0"
67 parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
68 parseNumber '-' [] = unexpected "sign without any digits"
69 parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
70 parseNumber d'' ds'' = return (d'':ds'')
74 -- >>> parse bencList "Blist" (pack "le")
76 -- >>> parse bencList "Blist" (pack "l4:spam4:eggse")
77 -- Right ["spam","eggs"]
78 -- >>> parse bencList "Blist" (pack "l4:spami42ee")
80 -- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
81 -- Right ["spam","eggs",[42]]
82 bencList :: ParsecBS.Parser [BVal]
83 bencList = do _ <- spaces
84 between (char 'l') (char 'e') (many bencVal)
88 -- >>> parse bencDict "Bdict" (pack "de")
89 -- Right (fromList [])
90 -- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse")
91 -- Right (fromList [("cow","moo"),("spam","eggs")])
92 -- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee")
93 -- Right (fromList [("spam",["a","b"])])
94 -- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
95 -- Right (fromList [("publisher","bob"),("publisher-webpage","www.example.com"),("publisher.location","home")])
96 bencDict :: ParsecBS.Parser (Map BVal BVal)
97 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
98 where kvpair = do k <- bencStr
102 bencVal :: ParsecBS.Parser BVal
103 bencVal = Bstr <$> bencStr <|>
105 Blist <$> bencList <|>
108 decode :: ByteString -> Either ParseError BVal
109 decode = parse bencVal "BVal"
111 -- given an input dict or int or string, encode
112 -- it into a bencoded bytestring.
113 -- | encode bencoded-values
115 -- >>> encode (Bstr (pack ""))
117 -- >>> encode (Bstr (pack "spam"))
119 -- >>> encode (Bint 0)
121 -- >>> encode (Bint 42)
123 -- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
125 -- >>> encode (Blist [])
127 -- >>> encode (Bdict (fromList [(Bstr $ pack "spam", Bstr $ pack "eggs")]))
129 encode :: BVal -> String
130 encode (Bstr bs) = let s = unpack bs
131 in show (length s) ++ ":" ++ s
132 encode (Bint i) = "i" ++ show i ++ "e"
133 encode (Blist xs) = "l" ++ encodeList xs ++ "e"
134 where encodeList = foldr ((++) . encode) ""
135 encode (Bdict d) = "d" ++ encodeDict d ++ "e"
136 where encodeDict m = concat [encode k ++ encode (m ! k) | k <- keys m]