hspec tests for single/multi torrent, bencode etc

[functorrent.git] / src / FuncTorrent / Bencode.hs

diff --git a/src/FuncTorrent/Bencode.hs b/src/FuncTorrent/Bencode.hs
new file mode 100644 (file)
index 0000000..294ad89
--- /dev/null
+++ b/src/FuncTorrent/Bencode.hs
@@ -0,0 +1,97 @@
+{-
+ - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
+ -
+ - This file is part of FuncTorrent.
+ -
+ - FuncTorrent is free software; you can redistribute it and/or modify
+ - it under the terms of the GNU General Public License as published by
+ - the Free Software Foundation; either version 3 of the License, or
+ - (at your option) any later version.
+ -
+ - FuncTorrent is distributed in the hope that it will be useful,
+ - but WITHOUT ANY WARRANTY; without even the implied warranty of
+ - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ - GNU General Public License for more details.
+ -
+ - You should have received a copy of the GNU General Public License
+ - along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+module FuncTorrent.Bencode
+    (BVal(..)
+    , bValToInteger
+    , bstrToString
+    , decode
+    , encode
+    ) where
+
+import Prelude hiding (length, concat)
+
+import Data.ByteString (ByteString, length, concat)
+import Data.ByteString.Char8 (unpack, pack)
+import Data.Map.Strict (Map, fromList, toList)
+import Text.ParserCombinators.Parsec
+import qualified Text.Parsec.ByteString as ParsecBS
+
+data BVal = Bint Integer
+          | Bstr ByteString
+          | Blist [BVal]
+          | Bdict (Map String BVal)
+            deriving (Ord, Eq, Show)
+
+-- getters
+bValToInteger :: BVal -> Maybe Integer
+bValToInteger (Bint x) = Just x
+bValToInteger _        = Nothing
+
+bstrToString :: BVal -> Maybe String
+bstrToString bval = unpack <$> bValToBytestr bval
+  where bValToBytestr :: BVal  -> Maybe ByteString
+        bValToBytestr (Bstr bs) = Just bs
+        bValToBytestr _         = Nothing
+
+bencStr :: ParsecBS.Parser ByteString
+bencStr = do ds <- many1 digit <* char ':'
+             s <- count (read ds) anyChar
+             return (pack s)
+
+bencInt :: ParsecBS.Parser Integer
+bencInt = do ds <- between (char 'i') (char 'e') numbers
+             return (read ds)
+               where numbers = do d' <- char '-' <|> digit
+                                  ds' <- many digit
+                                  parseNumber d' ds'
+                     parseNumber '0' []  = return "0"
+                     parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
+                     parseNumber '-' []  = unexpected "sign without any digits"
+                     parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
+                     parseNumber d'' ds'' = return (d'':ds'')
+
+bencList :: ParsecBS.Parser [BVal]
+bencList = between (char 'l') (char 'e') (many bencVal)
+
+bencDict :: ParsecBS.Parser (Map String BVal)
+bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
+  where kvpair = do k <- bencStr
+                    v <- bencVal
+                    return (unpack k, v)
+
+bencVal :: ParsecBS.Parser BVal
+bencVal = Bstr <$> bencStr <|>
+          Bint <$> bencInt <|>
+          Blist <$> bencList <|>
+          Bdict <$> bencDict
+
+decode :: ByteString -> Either ParseError BVal
+decode = parse bencVal "BVal"
+
+encode :: BVal -> ByteString
+encode (Bstr bs) = pack $ show (length bs) ++ ":" ++ unpack bs
+encode (Bint i) = pack $ "i" ++ show i ++ "e"
+encode (Blist xs) = concat ["l", concat $ map encode xs, "e"]
+encode (Bdict d) = concat ["d", concat kvlist, "e"]
+    where
+      kvlist :: [ByteString]
+      kvlist = [encPair kv | kv <- toList d]
+      encPair (k, v) = concat [encode . Bstr . pack $ k, encode v]