src/FuncTorrent/Bencode.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module FuncTorrent.Bencode
   3     (BVal(..)
   4     , bValToBList
   5     , bValToBytestr
   6     , bValToInfoDict
   7     , bValToInteger
   8     , bstrToString
   9     , decode
  10     , encode
  11     ) where
  12
  13 import Prelude hiding (length, concat)
  14
  15 import Control.Applicative ((<*))
  16 import Data.ByteString (ByteString, length, concat)
  17 import Data.ByteString.Char8 (unpack, pack)
  18 import Data.Functor ((<$>))
  19 import Data.Map.Strict (Map, fromList, toList)
  20 import Text.ParserCombinators.Parsec
  21 import qualified Text.Parsec.ByteString as ParsecBS
  22
  23 data BVal = Bint Integer
  24           | Bstr ByteString
  25           | Blist [BVal]
  26           | Bdict (Map String BVal)
  27             deriving (Ord, Eq, Show)
  28
  29 -- getters
  30 bValToInteger :: BVal -> Maybe Integer
  31 bValToInteger (Bint x) = Just x
  32 bValToInteger _        = Nothing
  33
  34 bValToBytestr :: BVal  -> Maybe ByteString
  35 bValToBytestr (Bstr bs) = Just bs
  36 bValToBytestr _         = Nothing
  37
  38 bValToBList :: BVal    -> Maybe [BVal]
  39 bValToBList (Blist lst) = Just lst
  40 bValToBList _           = Nothing
  41
  42 bValToInfoDict :: BVal     -> Maybe (Map String BVal)
  43 bValToInfoDict (Bdict dict) = Just dict
  44 bValToInfoDict _            = Nothing
  45
  46 bstrToString :: BVal -> Maybe String
  47 bstrToString bval     = unpack <$> bValToBytestr bval
  48
  49 -- $setup
  50 -- >>> import Data.Either
  51
  52 -- | parse strings
  53 --
  54 -- >>> parse bencStr "Bstr" (pack "4:spam")
  55 -- Right "spam"
  56 -- >>> parse bencStr "Bstr" (pack "0:")
  57 -- Right ""
  58 -- >>> parse bencStr "Bstr" (pack "0:hello")
  59 -- Right ""
  60 --
  61 bencStr :: ParsecBS.Parser ByteString
  62 bencStr = do ds <- many1 digit <* char ':'
  63              s <- count (read ds) anyChar
  64              return (pack s)
  65
  66 -- | parse integers
  67 --
  68 -- >>> parse bencInt "Bint" (pack "i42e")
  69 -- Right 42
  70 -- >>> parse bencInt "Bint" (pack "i123e")
  71 -- Right 123
  72 -- >>> parse bencInt "Bint" (pack "i1e")
  73 -- Right 1
  74 -- >>> parse bencInt "Bint" (pack "i0e")
  75 -- Right 0
  76 -- >>> parse bencInt "Bint" (pack "i-1e")
  77 -- Right (-1)
  78 -- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
  79 -- True
  80 -- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
  81 -- True
  82 -- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
  83 -- True
  84 bencInt :: ParsecBS.Parser Integer
  85 bencInt = do ds <- between (char 'i') (char 'e') numbers
  86              return (read ds)
  87                where numbers = do d' <- char '-' <|> digit
  88                                   ds' <- many digit
  89                                   parseNumber d' ds'
  90                      parseNumber '0' []  = return "0"
  91                      parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
  92                      parseNumber '-' []  = unexpected "sign without any digits"
  93                      parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
  94                      parseNumber d'' ds'' = return (d'':ds'')
  95
  96 -- | parse lists
  97 --
  98 -- >>> parse bencList "Blist" (pack "le")
  99 -- Right []
 100 -- >>> parse bencList "Blist" (pack "l4:spam4:eggse")
 101 -- Right [Bstr "spam",Bstr "eggs"]
 102 -- >>> parse bencList "Blist" (pack "l4:spami42ee")
 103 -- Right [Bstr "spam",Bint 42]
 104 -- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
 105 -- Right [Bstr "spam",Bstr "eggs",Blist [Bint 42]]
 106 bencList :: ParsecBS.Parser [BVal]
 107 bencList = between (char 'l') (char 'e') (many bencVal)
 108
 109 -- | parse dict
 110 --
 111 -- >>> parse bencDict "Bdict" (pack "de")
 112 -- Right (fromList [])
 113 -- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse")
 114 -- Right (fromList [("cow",Bstr "moo"),("spam",Bstr "eggs")])
 115 -- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee")
 116 -- Right (fromList [("spam",Blist [Bstr "a",Bstr "b"])])
 117 -- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
 118 -- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")])
 119 bencDict :: ParsecBS.Parser (Map String BVal)
 120 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
 121   where kvpair = do k <- bencStr
 122                     v <- bencVal
 123                     return (unpack k, v)
 124
 125 bencVal :: ParsecBS.Parser BVal
 126 bencVal = Bstr <$> bencStr <|>
 127           Bint <$> bencInt <|>
 128           Blist <$> bencList <|>
 129           Bdict <$> bencDict
 130
 131 decode :: ByteString -> Either ParseError BVal
 132 decode = parse bencVal "BVal"
 133
 134 -- Encode BVal into a bencoded ByteString. Inverse of decode
 135
 136 -- TODO: Use builders and lazy byte string to get O(1) concatenation over O(n)
 137 -- provided by lists.
 138
 139 -- TODO: encode . decode pair might be a good candidate for Quickcheck.
 140 -- | encode bencoded-values
 141 --
 142 -- >>> encode (Bstr (pack ""))
 143 -- "0:"
 144 -- >>> encode (Bstr (pack "spam"))
 145 -- "4:spam"
 146 -- >>> encode (Bint 0)
 147 -- "i0e"
 148 -- >>> encode (Bint 42)
 149 -- "i42e"
 150 -- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
 151 -- "l4:spam4:eggse"
 152 -- >>> encode (Blist [])
 153 -- "le"
 154 -- >>> encode (Bdict (fromList [("spam", Bstr $ pack "eggs")]))
 155 -- "d4:spam4:eggse"
 156 encode :: BVal -> ByteString
 157 encode (Bstr bs) = pack $ show (length bs) ++ ":" ++ unpack bs
 158 encode (Bint i) = pack $ "i" ++ show i ++ "e"
 159 encode (Blist xs) = concat ["l", concat $ map encode xs, "e"]
 160 encode (Bdict d) = concat ["d", concat kvlist, "e"]
 161     where
 162       kvlist :: [ByteString]
 163       kvlist = [encPair kv | kv <- toList d]
 164       encPair (k, v) = concat [encode . Bstr . pack $ k, encode v]