src/FuncTorrent/Bencode.hs

   1 {-
   2  - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
   3  -
   4  - This file is part of FuncTorrent.
   5  -
   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.
  10  -
  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.
  15  -
  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/>
  18  -}
  19
  20 {-# LANGUAGE OverloadedStrings #-}
  21 module FuncTorrent.Bencode
  22     (BVal(..)
  23     , bValToInteger
  24     , bstrToString
  25     , decode
  26     , encode
  27     ) where
  28
  29 import Prelude hiding (length, concat)
  30
  31 import Data.ByteString (ByteString, length, concat)
  32 import Data.ByteString.Char8 (unpack, pack)
  33 import Data.Map.Strict (Map, fromList, toList)
  34 import Text.ParserCombinators.Parsec
  35 import qualified Text.Parsec.ByteString as ParsecBS
  36
  37 data BVal = Bint Integer
  38           | Bstr ByteString
  39           | Blist [BVal]
  40           | Bdict (Map String BVal)
  41             deriving (Ord, Eq, Show)
  42
  43 -- getters
  44 bValToInteger :: BVal -> Maybe Integer
  45 bValToInteger (Bint x) = Just x
  46 bValToInteger _        = Nothing
  47
  48 bstrToString :: BVal -> Maybe String
  49 bstrToString bval = unpack <$> bValToBytestr bval
  50   where bValToBytestr :: BVal  -> Maybe ByteString
  51         bValToBytestr (Bstr bs) = Just bs
  52         bValToBytestr _         = Nothing
  53
  54 bencStr :: ParsecBS.Parser ByteString
  55 bencStr = do ds <- many1 digit <* char ':'
  56              s <- count (read ds) anyChar
  57              return (pack s)
  58
  59 bencInt :: ParsecBS.Parser Integer
  60 bencInt = do ds <- between (char 'i') (char 'e') numbers
  61              return (read ds)
  62                where numbers = do d' <- char '-' <|> digit
  63                                   ds' <- many digit
  64                                   parseNumber d' ds'
  65                      parseNumber '0' []  = return "0"
  66                      parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
  67                      parseNumber '-' []  = unexpected "sign without any digits"
  68                      parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
  69                      parseNumber d'' ds'' = return (d'':ds'')
  70
  71 bencList :: ParsecBS.Parser [BVal]
  72 bencList = between (char 'l') (char 'e') (many bencVal)
  73
  74 bencDict :: ParsecBS.Parser (Map String BVal)
  75 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
  76   where kvpair = do k <- bencStr
  77                     v <- bencVal
  78                     return (unpack k, v)
  79
  80 bencVal :: ParsecBS.Parser BVal
  81 bencVal = Bstr <$> bencStr <|>
  82           Bint <$> bencInt <|>
  83           Blist <$> bencList <|>
  84           Bdict <$> bencDict
  85
  86 decode :: ByteString -> Either ParseError BVal
  87 decode = parse bencVal "BVal"
  88
  89 encode :: BVal -> ByteString
  90 encode (Bstr bs) = pack $ show (length bs) ++ ":" ++ unpack bs
  91 encode (Bint i) = pack $ "i" ++ show i ++ "e"
  92 encode (Blist xs) = concat ["l", concat $ map encode xs, "e"]
  93 encode (Bdict d) = concat ["d", concat kvlist, "e"]
  94     where
  95       kvlist :: [ByteString]
  96       kvlist = [encPair kv | kv <- toList d]
  97       encPair (k, v) = concat [encode . Bstr . pack $ k, encode v]