src/Bencode.hs

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