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