1 {-# LANGUAGE OverloadedStrings #-}
2 module FuncTorrent.Bencode
10 import Prelude hiding (length, concat)
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
20 data BVal = Bint Integer
24 deriving (Ord, Eq, Show)
26 type InfoDict = Map String BVal
29 -- >>> import Data.Either
33 -- >>> parse bencStr "Bstr" (pack "4:spam")
35 -- >>> parse bencStr "Bstr" (pack "0:")
37 -- >>> parse bencStr "Bstr" (pack "0:hello")
40 bencStr :: ParsecBS.Parser ByteString
41 bencStr = do _ <- spaces
42 ds <- many1 digit <* char ':'
43 s <- count (read ds) anyChar
48 -- >>> parse bencInt "Bint" (pack "i42e")
50 -- >>> parse bencInt "Bint" (pack "i123e")
52 -- >>> parse bencInt "Bint" (pack "i1e")
54 -- >>> parse bencInt "Bint" (pack "i0e")
56 -- >>> parse bencInt "Bint" (pack "i-1e")
58 -- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
60 -- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
62 -- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
64 bencInt :: ParsecBS.Parser Integer
65 bencInt = do _ <- spaces
66 ds <- between (char 'i') (char 'e') numbers
68 where numbers = do d' <- char '-' <|> digit
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'')
79 -- >>> parse bencList "Blist" (pack "le")
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)
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
107 bencVal :: ParsecBS.Parser BVal
108 bencVal = Bstr <$> bencStr <|>
110 Blist <$> bencList <|>
113 decode :: ByteString -> Either ParseError BVal
114 decode = parse bencVal "BVal"
116 -- Encode BVal into a bencoded ByteString. Inverse of decode
118 -- TODO: Use builders and lazy byte string to get O(1) concatenation over O(n)
119 -- provided by lists.
121 -- TODO: encode . decode pair might be a good candidate for Quickcheck.
122 -- | encode bencoded-values
124 -- >>> encode (Bstr (pack ""))
126 -- >>> encode (Bstr (pack "spam"))
128 -- >>> encode (Bint 0)
130 -- >>> encode (Bint 42)
132 -- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
134 -- >>> encode (Blist [])
136 -- >>> encode (Bdict (fromList [("spam", Bstr $ pack "eggs")]))
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]
145 bstrToString :: BVal -> Maybe String
146 bstrToString (Bstr s) = Just $ unpack s
147 bstrToString _ = Nothing