bencode 0.5.0.1 → 0.6.1.1
raw patch · 8 files changed
Files
- README.md +26/−0
- Setup.lhs +5/−2
- bencode.cabal +48/−21
- src/Data/BEncode.hs +15/−14
- src/Data/BEncode/Lexer.hs +1/−1
- src/Data/BEncode/Parser.hs +24/−9
- src/Data/BEncode/Reader.hs +130/−0
- tests/Spec.hs +79/−0
+ README.md view
@@ -0,0 +1,26 @@+# bencode++[![travis][badge-travis]][travis]+[![hackage][badge-hackage]][hackage]+[![license][badge-license]][license]++Haskell Parser and printer for bencoded data.++Bencode (pronounced like B encode) is the encoding used by the+peer-to-peer file sharing system BitTorrent for storing and+transmitting loosely structured data.+++# Support++- [Issue tracker][issues]++++[badge-travis]: https://travis-ci.org/creichert/bencode.svg?branch=master+[travis]: https://travis-ci.org/creichert/bencode+[badge-hackage]: https://img.shields.io/hackage/v/bencode.svg?dummy+[hackage]: https://hackage.haskell.org/package/bencode+[badge-license]: https://img.shields.io/badge/license-BSD3-green.svg?dummy+[license]: https://github.com/creichert/bencode/blob/master/LICENSE+[issues]: https://github.com/creichert/bencode/issues
Setup.lhs view
@@ -1,5 +1,8 @@ #!/usr/bin/env runhaskell-> module Main where++> module Main (main) where+> > import Distribution.Simple+> > main :: IO ()-> main = defaultMainWithHooks defaultUserHooks+> main = defaultMain
bencode.cabal view
@@ -1,21 +1,48 @@-Name: bencode-Version: 0.5.0.1-Maintainer: Lemmih (lemmih@gmail.com)-Author: Lemmih (lemmih@gmail.com), Jesper Louis Andersen-Copyright: (c) 2005-2009, David Himmelstrup- 2006 Lemmih <lemmih@gmail.com>- 2005 Jesper Louis Andersen <jlouis@mongers.org>-License-File: LICENSE-License: BSD3-Build-Depends: base<5, parsec, bytestring, containers, binary-Build-Type: Simple-Category: Text-Synopsis: Parser and printer for bencoded data.-Tested-with: GHC ==6.8.1, GHC ==6.10.2-Extensions: PatternGuards-Exposed-Modules:- Data.BEncode- Data.BEncode.Lexer- Data.BEncode.Parser-GHC-Options: -Wall-Hs-Source-Dirs: src+name: bencode+version: 0.6.1.1+synopsis: Parsers and printers for bencoded data.+description: Parsers and printers for bencoded data. Bencode (pronounced like B+ encode) is the encoding used by the peer-to-peer file sharing system+ BitTorrent for storing and transmitting loosely structured data.+license: BSD3+license-file: LICENSE+copyright: (c) 2005-2009, David Himmelstrup,+ (c) 2006 Lemmih <lemmih@gmail.com>,+ (c) 2005 Jesper Louis Andersen <jlouis@mongers.org>+author: Lemmih <lemmih@gmail.com>,+ Jesper Louis Andersen <jlouis@mongers.org>,+ Christopher Reichert <creichert07@gmail.com>+maintainer: Peter Simons <simons@cryp.to>+tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2,+ GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.2+category: Text+build-type: Simple+extra-source-files: README.md+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/creichert/bencode++library+ exposed-modules: Data.BEncode+ Data.BEncode.Lexer+ Data.BEncode.Parser+ Data.BEncode.Reader+ hs-source-dirs: src+ build-depends: base == 4.*+ , binary+ , bytestring+ , containers+ , parsec+ , transformers+ , transformers-compat >= 0.4+ default-language: Haskell2010+ default-extensions: PatternGuards++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: tests+ build-depends: base, QuickCheck, bencode, bytestring, containers, hspec+ default-language: Haskell2010
src/Data/BEncode.hs view
@@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- |--- Module : BEncode+-- Module : Data.BEncode -- Copyright : (c) 2005 Jesper Louis Andersen <jlouis@mongers.org> -- 2006 Lemmih <lemmih@gmail.com> -- License : BSD3@@ -41,10 +41,10 @@ data type here -} data BEncode = BInt Integer- | BString L.ByteString- | BList [BEncode]+ | BString L.ByteString+ | BList [BEncode] | BDict (Map String BEncode)- deriving (Eq, Ord, Show)+ deriving (Eq, Ord, Show) instance Binary BEncode where put e = put (BS.concat $ L.toChunks $ bPack e)@@ -53,7 +53,7 @@ Just e -> return e Nothing -> fail "Failed to parse BEncoded data" --- Source possition is pretty useless in BEncoded data. FIXME+-- Source position is pretty useless in BEncoded data. FIXME updatePos :: (SourcePos -> Token -> [Token] -> SourcePos) updatePos pos _ _ = pos @@ -92,10 +92,11 @@ bList = withToken TList $ fmap BList (many bParse) bDict :: BParser BEncode-bDict = withToken TDict $ fmap (BDict . Map.fromAscList) (checkList =<< many1 bAssocList)- where checkList lst = if (lst /= sort lst)- then fail "dictionary not sorted"- else return lst+bDict = withToken TDict $+ fmap (BDict . Map.fromAscList) (checkList =<< many bAssocList)+ where checkList lst = if lst /= sort lst+ then fail "dictionary not sorted"+ else return lst bAssocList = do str <- tstring value <- bParse@@ -109,18 +110,18 @@ -} bRead :: L.ByteString -> Maybe BEncode bRead str = case parse bParse "" (lexer str) of- Left _err -> Nothing- Right b -> Just b+ Left _err -> Nothing+ Right b -> Just b -- | Render a BEncode structure to a B-coded string bShow :: BEncode -> ShowS-bShow be = bShow' be+bShow = bShow' where sc = showChar ss = showString sKV (k,v) = sString k (length k) . bShow' v- sDict dict = foldr (.) id (map sKV (Map.toAscList dict))- sList list = foldr (.) id (map bShow' list)+ sDict dict = foldr ((.) . sKV) id (Map.toAscList dict)+ sList = foldr ((.) . bShow') id sString str len = shows len . sc ':' . ss str bShow' b = case b of
src/Data/BEncode/Lexer.hs view
@@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- |--- Module : BEncode.Lexer+-- Module : Data.BEncode.Lexer -- Copyright : (c) 2005 Jesper Louis Andersen <jlouis@mongers.org> -- 2006 Lemmih <lemmih@gmail.com> -- License : BSD3
src/Data/BEncode/Parser.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : BParser@@ -9,7 +10,8 @@ -- -- A parsec style parser for BEncoded data ------------------------------------------------------------------------------module Data.BEncode.Parser+module Data.BEncode.Parser {-#+ DEPRECATED "Use \"Data.BEncode.Reader\" instead" #-} ( BParser , runParser , token@@ -24,14 +26,23 @@ ) where -import Data.BEncode-import qualified Data.Map as Map+import Control.Applicative hiding (optional)+import Control.Monad+import Data.BEncode import qualified Data.ByteString.Lazy.Char8 as L-import Control.Monad+import qualified Data.Map as Map +#if MIN_VERSION_base(4,13,0)+import qualified Control.Monad.Fail as Fail+#endif+ data BParser a = BParser (BEncode -> Reply a) +instance Alternative BParser where+ (<|>) = mplus+ empty = mzero+ instance MonadPlus BParser where mzero = BParser $ \_ -> Error "mzero" mplus (BParser a) (BParser b) = BParser $ \st -> case a st of@@ -46,19 +57,23 @@ = Ok a BEncode | Error String +instance Applicative BParser where+ pure = return+ (<*>) = ap+ instance Monad BParser where (BParser p) >>= f = BParser $ \b -> case p b of Ok a b' -> runB (f a) b' Error str -> Error str return val = BParser $ Ok val+#if MIN_VERSION_base(4,13,0)+instance Fail.MonadFail BParser where+#endif fail str = BParser $ \_ -> Error str instance Functor BParser where- fmap fn p = do a <- p- return (fn a)+ fmap = liftM -(<|>) :: BParser a -> BParser a -> BParser a-a <|> b = a `mplus` b runParser :: BParser a -> BEncode -> Either String a runParser parser b = case runB parser b of@@ -79,7 +94,7 @@ list name p = dict name >>= \lst -> BParser $ \b -> case lst of- BList bs -> foldr cat (Ok [] b) (map (runB p) bs)+ BList bs -> foldr (cat . runB p) (Ok [] b) bs _ -> Error $ "Not a list: " ++ name where cat (Ok v _) (Ok vs b) = Ok (v:vs) b cat (Ok _ _) (Error str) = Error str
+ src/Data/BEncode/Reader.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_HADDOCK show-extensions #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.BEncode.Reader+-- Copyright : (c) 2015 Matthew Leon <ml@matthewleon.com>+-- License : BSD3+-- Maintainer : creichert07@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Reader monad and combinators for BEncoded data.+--+-- This is intended to replace the older "Data.BEncode.Parser" module.+--+-- Usage example:+--+-- >>> :set -XOverloadedStrings+-- >>> let bd = (BDict $ Map.fromList [("baz", BInt 1), ("foo", BString "bar")])+-- >>> :{+-- let bReader = do+-- baz <- dict "baz" bint+-- foo <- dict "foo" bstring+-- shouldBeNothing <- optional $ dict "optionalKey" bint+-- return (foo, baz, shouldBeNothing)+-- in runBReader bReader bd+-- :}+-- Right ("bar",1,Nothing)+-----------------------------------------------------------------------------++module Data.BEncode.Reader (+ -- * Reader Monad+ BReader, runBReader,+ -- * Combinators+ bint, bbytestring, bstring, optional, list, dict+ ) where++import Control.Applicative+import Control.Monad (MonadPlus)+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Except+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.Map as Map++import Data.BEncode++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++newtype BReader a = BReader (ExceptT String (Reader BEncode) a)+ deriving (Functor, Applicative, Alternative, Monad, MonadPlus)+-- ^Reader monad for extracting data from a BEncoded structure.++breader :: (BEncode -> (Either String a)) -> BReader a+breader = BReader . ExceptT . reader+-- ^BReader constructor. Private.++runBReader :: BReader a -> BEncode -> Either String a+runBReader (BReader br) = runReader $ runExceptT br+-- ^Run a BReader. See usage examples elsewhere in this file.++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++bbytestring :: BReader L.ByteString+bbytestring = breader $ \b -> case b of+ BString str -> return str+ _ -> Left $ "Expected BString, found: " ++ show b+-- ^ Usage same as bstring, below.+-- (sadly, doctests for this cause errors on GHC 7.4)++bstring :: BReader String+bstring = fmap L.unpack bbytestring+-- ^+-- >>> runBReader bstring (BString "foo")+-- Right "foo"+--++bint :: BReader Integer+bint = breader $ \b -> case b of+ BInt int -> return int+ _ -> Left $ "Expected BInt, found: " ++ show b+-- ^+-- >>> runBReader bint (BInt 42)+-- Right 42+--++list :: BReader a -> BReader [a]+list br = breader $ \b -> case b of+ BList bs -> mapM (runBReader br) bs+ _ -> Left $ "Not a list: " ++ show b+-- ^ Read a list of BEncoded data+--+-- >>> runBReader (list bint) (BList [BInt 1, BInt 2])+-- Right [1,2]+--+-- >>> runBReader (list bint) (BList [])+-- Right []+--+-- >>> let bs = (BList [BList [BString "foo", BString "bar"], BList []])+-- >>> runBReader (list $ list bstring) bs+-- Right [["foo","bar"],[]]++dict :: String -> BReader a -> BReader a+dict name br = breader $ \b -> case b of+ BDict bmap | (Just code) <- Map.lookup name bmap -> runBReader br code+ BDict _ -> Left $ "Name not found in dictionary: " ++ name+ _ -> Left $ "Not a dictionary: " ++ show b+-- ^ Read the values of a BDict corresponding to a string key+--+-- >>> let bd = (BDict $ Map.fromList [("bar", BInt 2), ("foo", BInt 1)])+-- >>> runBReader (dict "foo" bint) bd+-- Right 1+--+--+-- >>> :{+-- let bs = (BList [BDict $ Map.fromList [("baz", BInt 2),+-- ("foo", BString "bar")],+-- BDict $ Map.singleton "foo" (BString "bam")])+-- in runBReader (list $ dict "foo" bstring) bs+-- :}+-- Right ["bar","bam"]+--+-- >>> :{+-- let bd = (BDict $ Map.singleton "foo" (BList [+-- BString "foo", BString "bar"+-- ]))+-- in runBReader (dict "foo" $ list $ bstring) bd+-- :}+-- Right ["foo","bar"]
+ tests/Spec.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- orphan Arbitrary instance is fine++import qualified Data.Map as Map++import Test.Hspec+import Test.QuickCheck++import Data.BEncode+import Data.ByteString.Lazy (pack)++instance Arbitrary BEncode where arbitrary = sized bencode'++bencode' :: Int -> Gen BEncode+bencode' 0 = oneof [BInt `fmap` arbitrary, (BString . pack) `fmap` arbitrary]+bencode' n = oneof [+ BInt `fmap` arbitrary,+ (BString . pack) `fmap` arbitrary :: Gen BEncode,+ BList `fmap` (resize (n `div` 2) arbitrary),+ (BDict . Map.fromList) `fmap` (resize (n `div` 2) arbitrary)+ ]++main :: IO ()+main = hspec $ do++ let bll = BList [BInt (-1), BInt 0, BInt 1, BInt 2, BInt 3, BString "four"]++ describe "Data.BEncode encoding" $ do+ it "encodes integers" $+ bRead "i42e" `shouldBe` Just (BInt 42)+ it "encodes strings" $+ bRead "3:foo" `shouldBe` Just (BString "foo")+ it "encodes strings with special characters in Haskell source" $+ bRead "5:café" `shouldBe` Just (BString "café")+ it "encodes lists" $+ bRead "l5:helloi42eli-1ei0ei1ei2ei3e4:fouree"+ `shouldBe` Just (BList [ BString "hello", BInt 42, bll ])+ it "encodes nested lists" $+ bRead "ll5:helloi62eel3:fooee"+ `shouldBe` Just (BList+ [ BList [ BString "hello", BInt 62 ],+ BList [ BString "foo" ] ])+ it "encodes dictionaries" $+ bRead "d3:baz3:moo3:foo3:bare"+ `shouldBe` Just+ (BDict (Map.fromList+ [("baz",BString "moo"),("foo",BString "bar")]))+ it "encodes empty dictionaries" $+ bRead "de" `shouldBe` Just (BDict Map.empty)++ describe "Data.BEncode decoding" $ do+ -- TODO failing+ -- it "is the inverse of encoding" $ property $ \bencode ->+ -- (bRead . bPack) bencode == Just bencode+ it "decodes int" $+ bPack (BInt 42) `shouldBe` "i42e"+ it "decodes null int" $+ bPack (BInt 0) `shouldBe` "i0e"+ it "decodes negative int" $+ bPack (BInt (-42)) `shouldBe` "i-42e"+ it "decodes string" $ do+ bPack (BString "foo") `shouldBe` "3:foo"+ bPack (BString "") `shouldBe` "0:"+ it "decodes lists" $+ bPack (BList [BInt 1, BInt 2, BInt 3]) `shouldBe` "li1ei2ei3ee"+ it "decodes lists of lists" $+ bPack (BList [ BList [BInt 1], BInt 1, BInt 2, BInt 3])+ `shouldBe` "lli1eei1ei2ei3ee"+ it "decodes hash" $ do+ let d = Map.fromList [("foo", BString "bar"), ("baz",BString "qux")]+ bPack (BDict d) `shouldBe` "d3:baz3:qux3:foo3:bare"+ -- FIX+ -- it "decodes unicode" $ do+ -- bPack (BString "café") `shouldBe` "5:café"+ -- bPack (BList [BString "你好", BString "中文"]) `shouldBe` "l6:你好6:中文e"+ it "decodes lists of lists" $+ bRead "l5:helloi42eli-1ei0ei1ei2ei3e4:fouree"+ `shouldBe` Just (BList [ BString "hello", BInt 42, bll])