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