src/FuncTorrent/Bencode.hs

   1 module FuncTorrent.Bencode
   2     (BVal(..),
   3      InfoDict,
   4      encode,
   5      decode
   6     ) where
   7
   8 import Control.Applicative ((<*))
   9 import Data.ByteString.Char8 (ByteString, pack, unpack)
  10 import Data.Functor ((<$>))
  11 import Data.Map.Strict (Map, fromList, keys, (!))
  12 import Text.ParserCombinators.Parsec
  13 import qualified Text.Parsec.ByteString as ParsecBS
  14
  15 data BVal = Bint Integer
  16           | Bstr ByteString
  17           | Blist [BVal]
  18           | Bdict InfoDict
  19             deriving (Ord, Eq, Show)
  20
  21 type InfoDict = Map BVal BVal
  22
  23 -- $setup
  24 -- >>> import Data.Either
  25
  26 -- | parse strings
  27 --
  28 -- >>> parse bencStr "Bstr" (pack "4:spam")
  29 -- Right "spam"
  30 -- >>> parse bencStr "Bstr" (pack "0:")
  31 -- Right ""
  32 -- >>> parse bencStr "Bstr" (pack "0:hello")
  33 -- Right ""
  34 --
  35 bencStr :: ParsecBS.Parser ByteString
  36 bencStr = do _ <- spaces
  37              ds <- many1 digit <* char ':'
  38              s <- count (read ds) anyChar
  39              return (pack s)
  40
  41 -- | parse integers
  42 --
  43 -- >>> parse bencInt "Bint" (pack "i42e")
  44 -- Right 42
  45 -- >>> parse bencInt "Bint" (pack "i123e")
  46 -- Right 123
  47 -- >>> parse bencInt "Bint" (pack "i1e")
  48 -- Right 1
  49 -- >>> parse bencInt "Bint" (pack "i0e")
  50 -- Right 0
  51 -- >>> parse bencInt "Bint" (pack "i-1e")
  52 -- Right (-1)
  53 -- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
  54 -- True
  55 -- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
  56 -- True
  57 -- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
  58 -- True
  59 bencInt :: ParsecBS.Parser Integer
  60 bencInt = do _ <- spaces
  61              ds <- between (char 'i') (char 'e') numbers
  62              return (read ds)
  63                where numbers = do d' <- char '-' <|> digit
  64                                   ds' <- many digit
  65                                   parseNumber d' ds'
  66                      parseNumber '0' []  = return "0"
  67                      parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
  68                      parseNumber '-' []  = unexpected "sign without any digits"
  69                      parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
  70                      parseNumber d'' ds'' = return (d'':ds'')
  71
  72 -- | parse lists
  73 --
  74 -- >>> parse bencList "Blist" (pack "le")
  75 -- Right []
  76 -- >>> parse bencList "Blist" (pack "l4:spam4:eggse")
  77 -- Right ["spam","eggs"]
  78 -- >>> parse bencList "Blist" (pack "l4:spami42ee")
  79 -- Right ["spam",42]
  80 -- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
  81 -- Right ["spam","eggs",[42]]
  82 bencList :: ParsecBS.Parser [BVal]
  83 bencList = do _ <- spaces
  84               between (char 'l') (char 'e') (many bencVal)
  85
  86 -- | parse dict
  87 --
  88 -- >>> parse bencDict "Bdict" (pack "de")
  89 -- Right (fromList [])
  90 -- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse")
  91 -- Right (fromList [("cow","moo"),("spam","eggs")])
  92 -- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee")
  93 -- Right (fromList [("spam",["a","b"])])
  94 -- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
  95 -- Right (fromList [("publisher","bob"),("publisher-webpage","www.example.com"),("publisher.location","home")])
  96 bencDict :: ParsecBS.Parser (Map BVal BVal)
  97 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
  98   where kvpair = do k <- bencStr
  99                     v <- bencVal
 100                     return (Bstr k, v)
 101
 102 bencVal :: ParsecBS.Parser BVal
 103 bencVal = Bstr <$> bencStr <|>
 104           Bint <$> bencInt <|>
 105           Blist <$> bencList <|>
 106           Bdict <$> bencDict
 107
 108 decode :: ByteString -> Either ParseError BVal
 109 decode = parse bencVal "BVal"
 110
 111 -- given an input dict or int or string, encode
 112 -- it into a bencoded bytestring.
 113 -- | encode bencoded-values
 114 --
 115 -- >>> encode (Bstr (pack ""))
 116 -- "0:"
 117 -- >>> encode (Bstr (pack "spam"))
 118 -- "4:spam"
 119 -- >>> encode (Bint 0)
 120 -- "i0e"
 121 -- >>> encode (Bint 42)
 122 -- "i42e"
 123 -- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
 124 -- "l4:spam4:eggse"
 125 -- >>> encode (Blist [])
 126 -- "le"
 127 -- >>> encode (Bdict (fromList [(Bstr $ pack "spam", Bstr $ pack "eggs")]))
 128 -- "d4:spam4:eggse"
 129 encode :: BVal -> String
 130 encode (Bstr bs) = let s = unpack bs
 131                    in show (length s) ++ ":" ++ s
 132 encode (Bint i) = "i" ++ show i ++ "e"
 133 encode (Blist xs) = "l" ++ encodeList xs ++ "e"
 134   where encodeList = foldr ((++) . encode) ""
 135 encode (Bdict d) = "d" ++ encodeDict d ++ "e"
 136   where encodeDict m = concat [encode k ++ encode (m ! k) | k <- keys m]