bencode-0.6.1.1/0000755000000000000000000000000007346545000011445 5ustar0000000000000000bencode-0.6.1.1/LICENSE0000644000000000000000000000320207346545000012447 0ustar0000000000000000Copyright (c) 2005-2007, David Himmelstrup 2005-2006 Lemmih 2005 Jesper Louis Andersen 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 David Himmelstrup 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. bencode-0.6.1.1/README.md0000755000000000000000000000145607346545000012735 0ustar0000000000000000# 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 bencode-0.6.1.1/Setup.lhs0000644000000000000000000000017407346545000013257 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main (main) where > > import Distribution.Simple > > main :: IO () > main = defaultMain bencode-0.6.1.1/bencode.cabal0000644000000000000000000000361207346545000014032 0ustar0000000000000000name: 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 , (c) 2005 Jesper Louis Andersen author: Lemmih , Jesper Louis Andersen , Christopher Reichert maintainer: Peter Simons 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 bencode-0.6.1.1/src/Data/0000755000000000000000000000000007346545000013105 5ustar0000000000000000bencode-0.6.1.1/src/Data/BEncode.hs0000644000000000000000000001075207346545000014745 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.BEncode -- Copyright : (c) 2005 Jesper Louis Andersen -- 2006 Lemmih -- License : BSD3 -- Maintainer : lemmih@gmail.com -- Stability : believed to be stable -- Portability : portable -- -- Provides a BEncode data type is well as functions for converting this -- data type to and from a String. -- -- Also supplies a number of properties which the module must satisfy. ----------------------------------------------------------------------------- module Data.BEncode ( -- * Data types BEncode(..), -- * Functions bRead, bShow, bPack ) where import qualified Data.Map as Map import Data.Map (Map) import Data.List (sort) import Text.ParserCombinators.Parsec import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Char8 as BS import Data.Binary import Data.BEncode.Lexer ( Token (..), lexer ) type BParser a = GenParser Token () a {- | The B-coding defines an abstract syntax tree given as a simple data type here -} data BEncode = BInt Integer | BString L.ByteString | BList [BEncode] | BDict (Map String BEncode) deriving (Eq, Ord, Show) instance Binary BEncode where put e = put (BS.concat $ L.toChunks $ bPack e) get = do s <- get case bRead (L.fromChunks [s]) of Just e -> return e Nothing -> fail "Failed to parse BEncoded data" -- Source position is pretty useless in BEncoded data. FIXME updatePos :: (SourcePos -> Token -> [Token] -> SourcePos) updatePos pos _ _ = pos bToken :: Token -> BParser () bToken t = tokenPrim show updatePos fn where fn t' | t' == t = Just () fn _ = Nothing token' :: (Token -> Maybe a) -> BParser a token' = tokenPrim show updatePos tnumber :: BParser Integer tnumber = token' fn where fn (TNumber i) = Just i fn _ = Nothing tstring :: BParser L.ByteString tstring = token' fn where fn (TString str) = Just str fn _ = Nothing withToken :: Token -> BParser a -> BParser a withToken tok = between (bToken tok) (bToken TEnd) -------------------------------------------------------------- -------------------------------------------------------------- bInt :: BParser BEncode bInt = withToken TInt $ fmap BInt tnumber bString :: BParser BEncode bString = fmap BString tstring bList :: BParser BEncode bList = withToken TList $ fmap BList (many bParse) bDict :: BParser BEncode 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 return (L.unpack str,value) bParse :: BParser BEncode bParse = bDict <|> bList <|> bString <|> bInt {- | bRead is a conversion routine. It assumes a B-coded string as input and attempts a parse of it into a BEncode data type -} bRead :: L.ByteString -> Maybe BEncode bRead str = case parse bParse "" (lexer str) of Left _err -> Nothing Right b -> Just b -- | Render a BEncode structure to a B-coded string bShow :: BEncode -> ShowS bShow = bShow' where sc = showChar ss = showString sKV (k,v) = sString k (length k) . bShow' v 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 BInt i -> sc 'i' . shows i . sc 'e' BString s -> sString (L.unpack s) (L.length s) BList bl -> sc 'l' . sList bl . sc 'e' BDict bd -> sc 'd' . sDict bd . sc 'e' bPack :: BEncode -> L.ByteString bPack be = L.fromChunks (bPack' be []) where intTag = BS.pack "i" colonTag = BS.pack ":" endTag = BS.pack "e" listTag = BS.pack "l" dictTag = BS.pack "d" sString s r = BS.pack (show (L.length s)) : colonTag : L.toChunks s ++ r bPack' (BInt i) r = intTag : BS.pack (show i) : endTag : r bPack' (BString s) r = sString s r bPack' (BList bl) r = listTag : foldr bPack' (endTag : r) bl bPack' (BDict bd) r = dictTag : foldr (\(k,v) -> sString (L.pack k) . bPack' v) (endTag : r) (Map.toAscList bd) --check be = bShow be "" == L.unpack (bPack be) bencode-0.6.1.1/src/Data/BEncode/0000755000000000000000000000000007346545000014404 5ustar0000000000000000bencode-0.6.1.1/src/Data/BEncode/Lexer.hs0000644000000000000000000000316507346545000016024 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.BEncode.Lexer -- Copyright : (c) 2005 Jesper Louis Andersen -- 2006 Lemmih -- License : BSD3 -- Maintainer : lemmih@gmail.com -- Stability : believed to be stable -- Portability : portable ----------------------------------------------------------------------------- module Data.BEncode.Lexer where import Data.Char import qualified Data.ByteString.Lazy.Char8 as L data Token = TDict | TList | TInt | TString L.ByteString | TNumber Integer | TEnd deriving (Show,Eq) lexer :: L.ByteString -> [Token] lexer fs | L.null fs = [] lexer fs = case ch of 'd' -> TDict : lexer rest 'l' -> TList : lexer rest 'i' -> TInt : lexer rest 'e' -> TEnd : lexer rest '-' -> let (digits,rest') = L.span isDigit rest number = read (L.unpack digits) in TNumber (-number) : lexer rest' _ | isDigit ch -> let (digits,rest') = L.span isDigit fs number = read (L.unpack digits) in if L.null rest' then [TNumber number] else case L.head rest' of ':' -> let (str, rest'') = L.splitAt (fromIntegral number) (L.tail rest') in TString str : lexer rest'' _ -> TNumber number : lexer rest' | otherwise -> error "Lexer error." where ch = L.head fs rest = L.tail fs bencode-0.6.1.1/src/Data/BEncode/Parser.hs0000644000000000000000000000724107346545000016200 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : BParser -- Copyright : (c) 2005 Lemmih -- License : BSD3 -- Maintainer : lemmih@gmail.com -- Stability : stable -- Portability : portable -- -- A parsec style parser for BEncoded data ----------------------------------------------------------------------------- module Data.BEncode.Parser {-# DEPRECATED "Use \"Data.BEncode.Reader\" instead" #-} ( BParser , runParser , token , dict , list , optional , bstring , bbytestring , bint , setInput , (<|>) ) where import Control.Applicative hiding (optional) import Control.Monad import Data.BEncode import qualified Data.ByteString.Lazy.Char8 as L 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 Error _err -> b st ok -> ok runB :: BParser a -> BEncode -> Reply a runB (BParser b) = b data Reply a = 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 = liftM runParser :: BParser a -> BEncode -> Either String a runParser parser b = case runB parser b of Ok a _ -> Right a Error str -> Left str token :: BParser BEncode token = BParser $ \b -> Ok b b dict :: String -> BParser BEncode dict name = BParser $ \b -> case b of BDict bmap | Just code <- Map.lookup name bmap -> Ok code b BDict _ -> Error $ "Name not found in dictionary: " ++ name _ -> Error $ "Not a dictionary: " ++ name list :: String -> BParser a -> BParser [a] list name p = dict name >>= \lst -> BParser $ \b -> case lst of 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 cat (Error str) _ = Error str optional :: BParser a -> BParser (Maybe a) optional p = liftM Just p <|> return Nothing bstring :: BParser BEncode -> BParser String bstring p = do b <- p case b of BString str -> return (L.unpack str) _ -> fail $ "Expected BString, found: " ++ show b bbytestring :: BParser BEncode -> BParser L.ByteString bbytestring p = do b <- p case b of BString str -> return str _ -> fail $ "Expected BString, found: " ++ show b bint :: BParser BEncode -> BParser Integer bint p = do b <- p case b of BInt int -> return int _ -> fail $ "Expected BInt, found: " ++ show b setInput :: BEncode -> BParser () setInput b = BParser $ \_ -> Ok () b bencode-0.6.1.1/src/Data/BEncode/Reader.hs0000644000000000000000000001023107346545000016137 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_HADDOCK show-extensions #-} ----------------------------------------------------------------------------- -- | -- Module : Data.BEncode.Reader -- Copyright : (c) 2015 Matthew Leon -- 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"] bencode-0.6.1.1/tests/0000755000000000000000000000000007346545000012607 5ustar0000000000000000bencode-0.6.1.1/tests/Spec.hs0000644000000000000000000000570507346545000014044 0ustar0000000000000000{-# 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])