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
29 import Prelude hiding (length, concat)
31 import Data.ByteString (ByteString, length, concat)
32 import Data.ByteString.Char8 (unpack, pack)
33 import Data.Char (isLetter, isAscii)
34 import Data.Map.Strict (Map, fromList, toList)
35 import Text.ParserCombinators.Parsec
36 import qualified Text.Parsec.ByteString as ParsecBS
37 import Test.QuickCheck
39 data BVal = Bint Integer
42 | Bdict (Map String BVal)
43 deriving (Ord, Eq, Show)
45 genNonEmptyString :: Gen String
46 genNonEmptyString = arbitrary `suchThat` (\s -> ((s /= "") &&
50 instance Arbitrary ByteString where
51 arbitrary = pack <$> arbitrary
53 instance Arbitrary BVal where
54 arbitrary = sized bval
56 bval :: Int -> Gen BVal
57 bval 0 = oneof [ Bint <$> arbitrary
59 bval n = oneof [ Bint <$> arbitrary
61 , Blist <$> vectorOf n (bval (n `div` 4))
62 , do keys <- vectorOf n genNonEmptyString
63 vals <- vectorOf n (bval (n `div` 4))
64 return $ Bdict $ fromList $ zip keys vals ]
67 bValToInteger :: BVal -> Maybe Integer
68 bValToInteger (Bint x) = Just x
69 bValToInteger _ = Nothing
71 bValToBytestr :: BVal -> Maybe ByteString
72 bValToBytestr (Bstr bs) = Just bs
73 bValToBytestr _ = Nothing
75 bstrToString :: BVal -> Maybe String
76 bstrToString bval = unpack <$> bValToBytestr bval
79 -- >>> import Data.Either
83 -- >>> parse bencStr "Bstr" (pack "4:spam")
85 -- >>> parse bencStr "Bstr" (pack "0:")
87 -- >>> parse bencStr "Bstr" (pack "0:hello")
90 bencStr :: ParsecBS.Parser ByteString
91 bencStr = do ds <- many1 digit <* char ':'
92 s <- count (read ds) anyChar
97 -- >>> parse bencInt "Bint" (pack "i42e")
99 -- >>> parse bencInt "Bint" (pack "i123e")
101 -- >>> parse bencInt "Bint" (pack "i1e")
103 -- >>> parse bencInt "Bint" (pack "i0e")
105 -- >>> parse bencInt "Bint" (pack "i-1e")
107 -- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
109 -- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
111 -- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
113 bencInt :: ParsecBS.Parser Integer
114 bencInt = do ds <- between (char 'i') (char 'e') numbers
116 where numbers = do d' <- char '-' <|> digit
119 parseNumber '0' [] = return "0"
120 parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
121 parseNumber '-' [] = unexpected "sign without any digits"
122 parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
123 parseNumber d'' ds'' = return (d'':ds'')
127 -- >>> parse bencList "Blist" (pack "le")
129 -- >>> parse bencList "Blist" (pack "l4:spam4:eggse")
130 -- Right [Bstr "spam",Bstr "eggs"]
131 -- >>> parse bencList "Blist" (pack "l4:spami42ee")
132 -- Right [Bstr "spam",Bint 42]
133 -- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
134 -- Right [Bstr "spam",Bstr "eggs",Blist [Bint 42]]
135 bencList :: ParsecBS.Parser [BVal]
136 bencList = between (char 'l') (char 'e') (many bencVal)
140 -- >>> parse bencDict "Bdict" (pack "de")
141 -- Right (fromList [])
142 -- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse")
143 -- Right (fromList [("cow",Bstr "moo"),("spam",Bstr "eggs")])
144 -- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee")
145 -- Right (fromList [("spam",Blist [Bstr "a",Bstr "b"])])
146 -- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
147 -- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")])
148 bencDict :: ParsecBS.Parser (Map String BVal)
149 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
150 where kvpair = do k <- bdictKey
154 ds <- many1 digit <* char ':'
155 s <- count (read ds) alphaNum
159 bencVal :: ParsecBS.Parser BVal
160 bencVal = Bstr <$> bencStr <|>
162 Blist <$> bencList <|>
165 decode :: ByteString -> Either ParseError BVal
166 decode = parse bencVal "BVal"
168 -- Encode BVal into a bencoded ByteString. Inverse of decode
170 -- TODO: Use builders and lazy byte string to get O(1) concatenation over O(n)
171 -- provided by lists.
173 -- TODO: encode . decode pair might be a good candidate for Quickcheck.
174 -- | encode bencoded-values
176 -- >>> encode (Bstr (pack ""))
178 -- >>> encode (Bstr (pack "spam"))
180 -- >>> encode (Bint 0)
182 -- >>> encode (Bint 42)
184 -- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
186 -- >>> encode (Blist [])
188 -- >>> encode (Bdict (fromList [("spam", Bstr $ pack "eggs")]))
190 encode :: BVal -> ByteString
191 encode (Bstr bs) = pack $ show (length bs) ++ ":" ++ unpack bs
192 encode (Bint i) = pack $ "i" ++ show i ++ "e"
193 encode (Blist xs) = concat ["l", concat $ map encode xs, "e"]
194 encode (Bdict d) = concat ["d", concat kvlist, "e"]
196 kvlist :: [ByteString]
197 kvlist = [encPair kv | kv <- toList d]
198 encPair (k, v) = concat [encode (Bstr (pack k)), encode v]