bencode-0.6.0.0/0000755000000000000000000000000012523463173011446 5ustar0000000000000000bencode-0.6.0.0/bencode.cabal0000644000000000000000000000244412523463173014035 0ustar0000000000000000Name: bencode Version: 0.6.0.0 Maintainer: Christopher Reichert Author: Lemmih (lemmih@gmail.com), Jesper Louis Andersen Copyright: (c) 2005-2009, David Himmelstrup, 2006 Lemmih , 2005 Jesper Louis Andersen License-File: LICENSE License: BSD3 Build-Type: Simple Category: Text Tested-With: GHC == 7.10.1, GHC == 7.8.4, GHC == 7.8.3, GHC == 7.6.3 Cabal-Version: >= 1.10 Synopsis: Parser and printer for bencoded data. Description: 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. Source-Repository head type: git location: https://github.com/creichert/bencode Library GHC-Options: -Wall Default-Extensions: PatternGuards Hs-Source-Dirs: src Default-Language: Haskell2010 Exposed-Modules: Data.BEncode Data.BEncode.Lexer Data.BEncode.Parser Build-Depends: base<5 , parsec , bytestring , containers , binary bencode-0.6.0.0/Setup.lhs0000644000000000000000000000021212523463173013251 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMainWithHooks defaultUserHooks bencode-0.6.0.0/LICENSE0000644000000000000000000000320212523463173012450 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.0.0/src/0000755000000000000000000000000012523463173012235 5ustar0000000000000000bencode-0.6.0.0/src/Data/0000755000000000000000000000000012523463173013106 5ustar0000000000000000bencode-0.6.0.0/src/Data/BEncode.hs0000644000000000000000000001074312523463173014746 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : 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 possition 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 =<< many1 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.0.0/src/Data/BEncode/0000755000000000000000000000000012523463173014405 5ustar0000000000000000bencode-0.6.0.0/src/Data/BEncode/Lexer.hs0000644000000000000000000000316012523463173016020 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : 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.0.0/src/Data/BEncode/Parser.hs0000644000000000000000000000674412523463173016210 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 ( 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 data BParser a = BParser (BEncode -> Reply a) instance Alternative BParser where empty = mzero (<|>) a b = a `mplus` b 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 fail str = BParser $ \_ -> Error str instance Functor BParser where fmap fn p = do a <- p return (fn a) 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