src/Bencode.hs

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