diff --git a/AttoBencode.cabal b/AttoBencode.cabal new file mode 100644 --- /dev/null +++ b/AttoBencode.cabal @@ -0,0 +1,52 @@ +Name: AttoBencode +Version: 0.2 +Synopsis: Fast Bencode encoding and parsing library +Homepage: http://bitbucket.org/FlorianHartwig/attobencode +License: BSD3 +License-file: LICENSE +Author: Florian Hartwig +Maintainer: Florian Hartwig +Category: Data +Build-type: Simple +Cabal-version: >=1.8 +Description: + A library for encoding and decoding the Bencode data serialisation format + used by BitTorrent. The focus of this library are good performance (good + enough to be used in a BitTorrent client) and ease of + use. + +Library + Exposed-modules: + Data.AttoBencode, + Data.AttoBencode.Parser + + Other-modules: + Data.AttoBencode.Encode, + Data.AttoBencode.Types + + Build-depends: + attoparsec, + base == 4.*, + blaze-builder, + blaze-textual, + bytestring, + containers + + Ghc-options: -O2 -Wall + Hs-source-dirs: src + +Test-suite tests + Type: exitcode-stdio-1.0 + Hs-source-dirs: tests + Main-is: qc.hs + Build-depends: AttoBencode, + base == 4.*, + bytestring, + containers, + test-framework, + test-framework-quickcheck2, + QuickCheck >= 2.4 && < 2.5 + +source-repository head + Type: mercurial + Location: https://bitbucket.org/FlorianHartwig/attobencode diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2012, Florian Hartwig + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Florian Hartwig nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Data/AttoBencode.hs b/src/Data/AttoBencode.hs new file mode 100644 --- /dev/null +++ b/src/Data/AttoBencode.hs @@ -0,0 +1,27 @@ +-- | +-- Module: Data.AttoBencode +-- Copyright: Florian Hartwig +-- License: BSD3 +-- Maintainer: Florian Hartwig +-- Stability: experimental +-- Portability: GHC +-- +module Data.AttoBencode + ( + -- * BEncode Types + BValue(..) + , Dict + -- * Encoding and Decoding + , decode + , encode + , FromBencode(..) + , ToBencode(..) + -- * Convencience Functions + , (.:) + , dict + , (.=) + ) where + +import Data.AttoBencode.Types +import Data.AttoBencode.Parser (decode) +import Data.AttoBencode.Encode (encode) diff --git a/src/Data/AttoBencode/Encode.hs b/src/Data/AttoBencode/Encode.hs new file mode 100644 --- /dev/null +++ b/src/Data/AttoBencode/Encode.hs @@ -0,0 +1,41 @@ +-- | +-- Module: Data.AttoBencode.Encode +-- Copyright: Florian Hartwig +-- License: BSD3 +-- Maintainer: Florian Hartwig +-- Stability: experimental +-- Portability: GHC + +module Data.AttoBencode.Encode (encode) where + +import Data.AttoBencode.Types +import Blaze.ByteString.Builder +import Blaze.Text.Int (integral) +import Data.Map (toAscList) +import Data.Monoid +import qualified Data.ByteString.Char8 as B +import Data.Word (Word8) + +-- | Serialise a Bencode value to a (strict) ByteString +encode :: ToBencode a => a -> B.ByteString +encode = toByteString . fromBValue . toBencode + +dWord, iWord, eWord, lWord, colon :: Word8 +dWord = 100 +eWord = 101 +lWord = 108 +iWord = 105 +colon = 58 + +fromBValue :: BValue -> Builder +fromBValue (BString s) = fromString s +fromBValue (BList l) = fromWord8 lWord <> (mconcat . map fromBValue) l <> fromWord8 eWord +fromBValue (BDict d) = fromWord8 dWord <> (mconcat . map fromPair) (toAscList d) <> fromWord8 eWord +fromBValue (BInt n) = fromWord8 iWord <> integral n <> fromWord8 eWord + +fromString :: B.ByteString -> Builder +fromString s = integral (B.length s) <> fromWord8 colon <> fromByteString s +{-# INLINE fromString #-} + +fromPair :: (B.ByteString, BValue) -> Builder +fromPair (k, v) = fromString k <> fromBValue v diff --git a/src/Data/AttoBencode/Parser.hs b/src/Data/AttoBencode/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Data/AttoBencode/Parser.hs @@ -0,0 +1,59 @@ +-- | +-- Module: Data.AttoBencode.Parser +-- Copyright: Florian Hartwig +-- License: BSD3 +-- Maintainer: Florian Hartwig +-- Stability: experimental +-- Portability: GHC + +{-# LANGUAGE BangPatterns #-} +module Data.AttoBencode.Parser + ( decode + , bValue + ) where + +import Data.AttoBencode.Types +import Prelude hiding (take) +import Data.Attoparsec (maybeResult, parse, Parser) +import Data.Attoparsec.Char8 (char, decimal, signed, take) +import Control.Applicative (many, (<$>), (<|>), (*>), (<*)) +import Data.Map (fromList) +import qualified Data.ByteString as B + +-- | Deserialise a bencoded ByteString. +-- If parsing or conversion fails, Nothing is returned. +decode :: (FromBencode a) => B.ByteString -> Maybe a +decode bs = maybeResult (parse bValue bs) >>= fromBencode + +-- | Parser for Bencode values +bValue :: Parser BValue +bValue = stringParser <|> intParser <|> listParser <|> dictParser + +bsParser :: Parser B.ByteString +bsParser = + do l <- decimal + _ <- char ':' + take l +{-# INLINE bsParser #-} + +stringParser :: Parser BValue +stringParser = BString <$> bsParser + +intParser :: Parser BValue +intParser = BInt <$> (char 'i' *> signed decimal <* char 'e') + +listParser :: Parser BValue +listParser = BList <$> (char 'l' *> many bValue <* char 'e') + +pairParser :: Parser (B.ByteString, BValue) +pairParser = + do !key <- bsParser + !value <- bValue + return (key, value) + +dictParser :: Parser BValue +dictParser = + do _ <- char 'd' + !pairs <- many pairParser + _ <- char 'e' + return $ BDict $ fromList pairs -- TODO: fromAscList? diff --git a/src/Data/AttoBencode/Types.hs b/src/Data/AttoBencode/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/AttoBencode/Types.hs @@ -0,0 +1,103 @@ +-- | +-- Module: Data.AttoBencode.Types +-- Copyright: Florian Hartwig +-- License: BSD3 +-- Maintainer: Florian Hartwig +-- Stability: experimental +-- Portability: GHC + +{-# LANGUAGE FlexibleInstances #-} + +module Data.AttoBencode.Types + ( BValue(..) + , Dict + , FromBencode(..) + , ToBencode(..) + , (.:) + , dict + , (.=) + ) where + +import qualified Data.Map as M +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B +import Data.Traversable (traverse) + +-- | The Haskell data type for Bencode values +data BValue = BString !ByteString + | BInt !Integer + | BList ![BValue] + | BDict !Dict + deriving (Show, Eq) + +-- | A Bencode dictionary. Dictionaries have 'ByteString' keys and 'BValue' +-- values. +type Dict = M.Map ByteString BValue + +-- TODO: example +-- | A type that can be converted to a 'BValue'. +class ToBencode a where + toBencode :: a -> BValue + +-- TODO: example +-- | A type that can be converted from a 'BValue'. The conversion can fail. +class FromBencode a where + fromBencode :: BValue -> Maybe a + +instance ToBencode ByteString where + toBencode = BString + +instance ToBencode String where + toBencode = BString . B.pack + +instance ToBencode Integer where + toBencode = BInt + +instance ToBencode Int where + toBencode = BInt . fromIntegral + +instance ToBencode a => ToBencode [a] where + toBencode = BList . map toBencode + +instance ToBencode a => ToBencode (M.Map ByteString a) where + toBencode = BDict . M.map toBencode + +instance ToBencode a => ToBencode [(ByteString, a)] where + toBencode = BDict . M.fromList . map (\(k, v) -> (k, toBencode v)) + +instance ToBencode BValue where + toBencode = id +-- TODO: make sure these are inlined + + +instance FromBencode ByteString where + fromBencode (BString bs) = Just bs + fromBencode _ = Nothing + +instance FromBencode Integer where + fromBencode (BInt n) = Just n + fromBencode _ = Nothing + +instance (FromBencode a) => FromBencode (M.Map ByteString a) where + fromBencode (BDict d) = traverse fromBencode d + fromBencode _ = Nothing + +instance (FromBencode a) => FromBencode [a] where + fromBencode (BList l) = mapM fromBencode l + fromBencode _ = Nothing + +-- | Look up the value corresponding to a (ByteString) key from a dictionary. +-- Returns 'Nothing' if the key is not in the dictionary or if the 'BValue' +-- cannot be converted to the expected type. +(.:) :: FromBencode a => Dict -> ByteString -> Maybe a +d .: s = M.lookup s d >>= fromBencode + +-- | Make a BDict from a list of (key, value) tuples. +dict :: [(ByteString, BValue)] -> BValue +dict = BDict . M.fromList + +-- | Create a (key, value) tuple from a ByteString key and some bencode-able +-- value. Can be used with the 'dict' function as a convenient way to create +-- 'BDict's. +(.=) :: ToBencode a => ByteString -> a -> (ByteString, BValue) +key .= value = (key, toBencode value) diff --git a/tests/qc.hs b/tests/qc.hs new file mode 100644 --- /dev/null +++ b/tests/qc.hs @@ -0,0 +1,53 @@ +import Test.QuickCheck +import Data.AttoBencode +import Control.Monad (liftM) +import Data.Map (Map, fromList) +import Test.Framework (Test, defaultMain) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import qualified Data.ByteString.Char8 as B + +instance Arbitrary BValue where + arbitrary = sized f + -- need to mess with size to prevent generation of infinite test cases + -- for recursive constructors + where f 0 = oneof [liftM BString arbitrary + ,liftM BInt arbitrary] + f n = oneof [liftM BString arbitrary + ,liftM BInt arbitrary + ,liftM BList $ listOf $ f $ n `div` 5 + ,liftM BDict $ dict $ n `div` 5] + + dict :: Int -> Gen Dict + dict n = liftM fromList (listOf (pair n)) + + pair :: Int -> Gen (B.ByteString, BValue) + pair n = do bs <- arbitrary + bv <- f n + return (bs, bv) + +instance Arbitrary B.ByteString where + arbitrary = fmap B.pack arbitrary + + +instance FromBencode BValue where + fromBencode = Just + +prop_EncodeInteger :: Integer -> Bool +prop_EncodeInteger n = encode (BInt n) == B.pack ("i" ++ show n ++ "e") + +prop_EncodeString :: B.ByteString -> Bool +prop_EncodeString bs = + encode (BString bs) == B.pack (show (B.length bs) ++ ":") `B.append` bs + +prop_EncodeDecode :: BValue -> Bool +prop_EncodeDecode bv = case decode (encode bv) of + Just bv' -> bv == bv' + Nothing -> False + +main :: IO () +main = defaultMain tests + +tests :: [Test] +tests = [testProperty "prop_EncodeInteger" prop_EncodeInteger + ,testProperty "prop_EncodeString" prop_EncodeString + ,testProperty "prop_EncodeDecode" prop_EncodeDecode]