1 {-# LANGUAGE OverloadedStrings #-}
2 module FuncTorrent.Bencode
9 import Prelude hiding (length, concat)
11 import Control.Applicative ((<*))
12 import Data.ByteString (ByteString, length, concat)
13 import Data.ByteString.Char8 (unpack, pack)
14 import Data.Functor ((<$>))
15 import Data.Map.Strict (Map, fromList, keys, (!))
16 import Text.ParserCombinators.Parsec
17 import qualified Text.Parsec.ByteString as ParsecBS
19 data BVal = Bint Integer
23 deriving (Ord, Eq, Show)
25 type InfoDict = Map String BVal
28 -- >>> import Data.Either
32 -- >>> parse bencStr "Bstr" (pack "4:spam")
34 -- >>> parse bencStr "Bstr" (pack "0:")
36 -- >>> parse bencStr "Bstr" (pack "0:hello")
39 bencStr :: ParsecBS.Parser ByteString
40 bencStr = do _ <- spaces
41 ds <- many1 digit <* char ':'
42 s <- count (read ds) anyChar
47 -- >>> parse bencInt "Bint" (pack "i42e")
49 -- >>> parse bencInt "Bint" (pack "i123e")
51 -- >>> parse bencInt "Bint" (pack "i1e")
53 -- >>> parse bencInt "Bint" (pack "i0e")
55 -- >>> parse bencInt "Bint" (pack "i-1e")
57 -- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
59 -- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
61 -- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
63 bencInt :: ParsecBS.Parser Integer
64 bencInt = do _ <- spaces
65 ds <- between (char 'i') (char 'e') numbers
67 where numbers = do d' <- char '-' <|> digit
70 parseNumber '0' [] = return "0"
71 parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
72 parseNumber '-' [] = unexpected "sign without any digits"
73 parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
74 parseNumber d'' ds'' = return (d'':ds'')
78 -- >>> parse bencList "Blist" (pack "le")
80 -- >>> parse bencList "Blist" (pack "l4:spam4:eggse")
81 -- Right [Bstr "spam",Bstr "eggs"]
82 -- >>> parse bencList "Blist" (pack "l4:spami42ee")
83 -- Right [Bstr "spam",Bint 42]
84 -- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
85 -- Right [Bstr "spam",Bstr "eggs",Blist [Bint 42]]
86 bencList :: ParsecBS.Parser [BVal]
87 bencList = do _ <- spaces
88 between (char 'l') (char 'e') (many bencVal)
92 -- >>> parse bencDict "Bdict" (pack "de")
93 -- Right (fromList [])
94 -- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse")
95 -- Right (fromList [("cow",Bstr "moo"),("spam",Bstr "eggs")])
96 -- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee")
97 -- Right (fromList [("spam",Blist [Bstr "a",Bstr "b"])])
98 -- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
99 -- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")])
100 bencDict :: ParsecBS.Parser InfoDict
101 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
102 where kvpair = do k <- bencStr
106 bencVal :: ParsecBS.Parser BVal
107 bencVal = Bstr <$> bencStr <|>
109 Blist <$> bencList <|>
112 decode :: ByteString -> Either ParseError BVal
113 decode = parse bencVal "BVal"
115 -- Encode BVal into a bencoded ByteString. Inverse of decode
117 -- TODO: Use builders and lazy byte string to get O(1) concatenation over O(n)
118 -- provided by lists.
120 -- TODO: encode . decode pair might be a good candidate for Quickcheck.
121 -- | encode bencoded-values
123 -- >>> encode (Bstr (pack ""))
125 -- >>> encode (Bstr (pack "spam"))
127 -- >>> encode (Bint 0)
129 -- >>> encode (Bint 42)
131 -- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
133 -- >>> encode (Blist [])
135 -- >>> encode (Bdict (fromList [("spam", Bstr $ pack "eggs")]))
137 encode :: BVal -> ByteString
138 encode (Bstr bs) = pack $ show (length bs) ++ ":" ++ unpack bs
139 encode (Bint i) = pack $ "i" ++ show i ++ "e"
140 encode (Blist xs) = pack $ "l" ++ unpack (concat $ map encode xs) ++ "e"
141 encode (Bdict d) = concat [concat ["d", encode . Bstr . pack $ k , encode (d ! k) , "e"] | k <- keys d]