2 - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
4 - This file is part of FuncTorrent.
6 - FuncTorrent is free software; you can redistribute it and/or modify
7 - it under the terms of the GNU General Public License as published by
8 - the Free Software Foundation; either version 3 of the License, or
9 - (at your option) any later version.
11 - FuncTorrent is distributed in the hope that it will be useful,
12 - but WITHOUT ANY WARRANTY; without even the implied warranty of
13 - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 - GNU General Public License for more details.
16 - You should have received a copy of the GNU General Public License
17 - along with FuncTorrent; if not, see <http://www.gnu.org/licenses/>
20 {-# LANGUAGE OverloadedStrings #-}
21 module FuncTorrent.Bencode
30 import Prelude hiding (length, concat)
32 import Data.ByteString (ByteString, length, concat)
33 import Data.ByteString.Char8 (unpack, pack)
34 import Data.Char (isLetter, isAscii)
35 import Data.Map.Strict (Map, fromList, toList)
36 import Text.ParserCombinators.Parsec
37 import qualified Text.Parsec.ByteString as ParsecBS
38 import Test.QuickCheck
40 data BVal = Bint Integer
43 | Bdict (Map String BVal)
44 deriving (Ord, Eq, Show)
46 genNonEmptyString :: Gen String
47 genNonEmptyString = arbitrary `suchThat` (\s -> ((s /= "") &&
51 instance Arbitrary ByteString where
52 arbitrary = pack <$> arbitrary
54 instance Arbitrary BVal where
55 arbitrary = sized bval
57 bval :: Int -> Gen BVal
58 bval 0 = oneof [ Bint <$> arbitrary
60 bval n = oneof [ Bint <$> arbitrary
62 , Blist <$> vectorOf (n `div` 2) (bval (n `div` 4))
63 , do keys <- vectorOf (n `div` 2) genNonEmptyString
64 vals <- vectorOf (n `div` 2) (bval (n `div` 4))
65 return $ Bdict $ fromList $ zip keys vals ]
68 bValToInteger :: BVal -> Maybe Integer
69 bValToInteger (Bint x) = Just x
70 bValToInteger _ = Nothing
72 bValToBytestr :: BVal -> Maybe ByteString
73 bValToBytestr (Bstr bs) = Just bs
74 bValToBytestr _ = Nothing
76 bstrToString :: BVal -> Maybe String
77 bstrToString bval = unpack <$> bValToBytestr bval
80 -- >>> import Data.Either
84 -- >>> parse bencStr "Bstr" (pack "4:spam")
86 -- >>> parse bencStr "Bstr" (pack "0:")
88 -- >>> parse bencStr "Bstr" (pack "0:hello")
91 bencStr :: ParsecBS.Parser ByteString
92 bencStr = do ds <- many1 digit <* char ':'
93 s <- count (read ds) anyChar
98 -- >>> parse bencInt "Bint" (pack "i42e")
100 -- >>> parse bencInt "Bint" (pack "i123e")
102 -- >>> parse bencInt "Bint" (pack "i1e")
104 -- >>> parse bencInt "Bint" (pack "i0e")
106 -- >>> parse bencInt "Bint" (pack "i-1e")
108 -- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
110 -- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
112 -- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
114 bencInt :: ParsecBS.Parser Integer
115 bencInt = do ds <- between (char 'i') (char 'e') numbers
117 where numbers = do d' <- char '-' <|> digit
120 parseNumber '0' [] = return "0"
121 parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
122 parseNumber '-' [] = unexpected "sign without any digits"
123 parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
124 parseNumber d'' ds'' = return (d'':ds'')
128 -- >>> parse bencList "Blist" (pack "le")
130 -- >>> parse bencList "Blist" (pack "l4:spam4:eggse")
131 -- Right [Bstr "spam",Bstr "eggs"]
132 -- >>> parse bencList "Blist" (pack "l4:spami42ee")
133 -- Right [Bstr "spam",Bint 42]
134 -- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
135 -- Right [Bstr "spam",Bstr "eggs",Blist [Bint 42]]
136 bencList :: ParsecBS.Parser [BVal]
137 bencList = between (char 'l') (char 'e') (many bencVal)
141 -- >>> parse bencDict "Bdict" (pack "de")
142 -- Right (fromList [])
143 -- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse")
144 -- Right (fromList [("cow",Bstr "moo"),("spam",Bstr "eggs")])
145 -- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee")
146 -- Right (fromList [("spam",Blist [Bstr "a",Bstr "b"])])
147 -- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
148 -- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")])
149 bencDict :: ParsecBS.Parser (Map String BVal)
150 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
151 where kvpair = do k <- bdictKey
155 ds <- many1 digit <* char ':'
156 s <- count (read ds) anyChar
160 bencVal :: ParsecBS.Parser BVal
161 bencVal = Bstr <$> bencStr <|>
163 Blist <$> bencList <|>
166 decode :: ByteString -> Either ParseError BVal
167 decode = parse bencVal "BVal"
169 decodeWithLeftOvers :: ByteString -> Either ParseError (BVal, ByteString)
170 decodeWithLeftOvers = parse ((,) <$> bencVal <*> (fmap pack leftOvers)) "BVal with LeftOvers"
171 where leftOvers = manyTill anyToken eof
173 -- Encode BVal into a bencoded ByteString. Inverse of decode
175 -- TODO: Use builders and lazy byte string to get O(1) concatenation over O(n)
176 -- provided by lists.
178 -- TODO: encode . decode pair might be a good candidate for Quickcheck.
179 -- | encode bencoded-values
181 -- >>> encode (Bstr (pack ""))
183 -- >>> encode (Bstr (pack "spam"))
185 -- >>> encode (Bint 0)
187 -- >>> encode (Bint 42)
189 -- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
191 -- >>> encode (Blist [])
193 -- >>> encode (Bdict (fromList [("spam", Bstr $ pack "eggs")]))
195 encode :: BVal -> ByteString
196 encode (Bstr bs) = pack $ show (length bs) ++ ":" ++ unpack bs
197 encode (Bint i) = pack $ "i" ++ show i ++ "e"
198 encode (Blist xs) = concat ["l", concat $ map encode xs, "e"]
199 encode (Bdict d) = concat ["d", concat kvlist, "e"]
201 kvlist :: [ByteString]
202 kvlist = [encPair kv | kv <- toList d]
203 encPair (k, v) = concat [encode (Bstr (pack k)), encode v]