diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 --- a/.travis.yml +++ /dev/null @@ -1,10 +0,0 @@ -language: haskell - -notifications: - email: false - -install: - cabal install --enable-tests --enable-benchmark --force-reinstalls --only-dependencies - -script: - cabal configure --enable-tests --enable-benchmark && cabal build && cabal test diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,19 +1,30 @@ -Copyright (c) 2012 Sam T. +Copyright (c) 2013, Sam Truzjan -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies -of the Software, and to permit persons to whom the Software is furnished to do -so, subject to the following conditions: +All rights reserved. -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. + * 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 Sam Truzjan 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/bencoding.cabal b/bencoding.cabal --- a/bencoding.cabal +++ b/bencoding.cabal @@ -1,17 +1,19 @@ name: bencoding -version: 0.2.0.0 -synopsis: A library for encoding and decoding of BEncode data. -homepage: https://github.com/cobit/bencoding -bug-reports: https://github.com/cobit/bencoding/issues -license: MIT +version: 0.2.1.0 +license: BSD3 license-file: LICENSE -author: Sam T. -maintainer: Sam T. -copyright: (c) 2013, Sam T. +author: Sam Truzjan +maintainer: Sam Truzjan +copyright: (c) 2013, Sam Truzjan category: Data build-type: Simple +stability: Experimental cabal-version: >= 1.10 -tested-with: GHC==7.4.1, GHC==7.6.3 +tested-with: GHC==7.4.1 + , GHC==7.6.3 +homepage: https://github.com/cobit/bencoding +bug-reports: https://github.com/cobit/bencoding/issues +synopsis: A library for encoding and decoding of BEncode data. description: A library for encoding and decoding of BEncode data. @@ -21,15 +23,22 @@ * /0.1.0.0:/ Initial version. . * /0.2.0.0:/ Added default decoders/encoders using GHC Generics. - + . + * /0.2.1.0:/ Arbitrary length integers. (by specification) extra-source-files: README.md - .travis.yml source-repository head type: git location: git://github.com/cobit/bencoding.git + branch: master +source-repository this + type: git + location: git://github.com/cobit/bencoding.git + branch: master + tag: v0.2.1.0 + library default-language: Haskell2010 default-extensions: PatternGuards @@ -44,15 +53,6 @@ , text >= 0.11 , pretty ghc-options: -Wall -fno-warn-unused-do-bind - -executable pp - default-language: Haskell2010 - hs-source-dirs: pp - main-is: pp.hs - build-depends: base == 4.* - , bytestring - , bencoding - ghc-options: -Wall test-suite properties diff --git a/pp/pp.hs b/pp/pp.hs deleted file mode 100644 --- a/pp/pp.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Main (main) where - -import Data.BEncode -import qualified Data.ByteString as B -import System.IO -import System.Environment - -main :: IO () -main = do - path : _ <- getArgs - content <- B.readFile path - case decode content of - Left e -> hPutStrLn stderr e - Right be -> print $ ppBEncode be diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs @@ -1,12 +1,9 @@ --- TODO: make int's instances platform independent so we can make --- library portable. - -- | --- Copyright : (c) Sam T. 2013 --- License : MIT +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 -- Maintainer : pxqr.sta@gmail.com -- Stability : stable --- Portability : non-portable +-- Portability : portable -- -- This module provides convinient and fast way to serialize, -- deserealize and construct/destructure Bencoded values with @@ -53,15 +50,19 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} #endif module Data.BEncode ( -- * Datatype - BEncode(..) - , Dict + BInteger + , BString + , BList + , BDict + , BKey + + , BEncode(..) , ppBEncode -- * Conversion @@ -106,7 +107,7 @@ import Control.Monad import Data.Int import Data.Maybe (mapMaybe) -import Data.Monoid -- (mempty, (<>)) +import Data.Monoid import Data.Foldable (foldMap) import Data.Traversable (traverse) import Data.Word (Word8, Word16, Word32, Word64, Word) @@ -125,6 +126,7 @@ import Data.ByteString.Internal as B (c2w, w2c) import Data.Text (Text) import qualified Data.Text.Encoding as T +import Data.Typeable import Data.Version import Text.PrettyPrint hiding ((<>)) import qualified Text.ParserCombinators.ReadP as ReadP @@ -133,18 +135,22 @@ import GHC.Generics #endif --- | BEncode key-value dictionary. -type Dict = Map ByteString BEncode +type BInteger = Integer +type BString = ByteString +type BList = [BEncode] +type BDict = Map BKey BEncode +type BKey = ByteString + -- | 'BEncode' is straightforward ADT for b-encoded values. Please -- note that since dictionaries are sorted, in most cases we can -- compare BEncoded values without serialization and vice versa. -- Lists is not required to be sorted through. -- -data BEncode = BInteger {-# UNPACK #-} !Int64 - | BString !ByteString - | BList [BEncode] - | BDict Dict +data BEncode = BInteger !BInteger -- ^ bencode integers; + | BString !BString -- ^ bencode strings; + | BList BList -- ^ list of bencode values; + | BDict BDict -- ^ bencode key-value dictionary. deriving (Show, Read, Eq, Ord) instance NFData BEncode where @@ -248,8 +254,8 @@ | x == mempty = pure U1 | otherwise = decodingError "U1" -instance (GBEncodable a [BEncode], GBEncodable b [BEncode]) - => GBEncodable (a :*: b) [BEncode] where +instance (GBEncodable a BList, GBEncodable b BList) + => GBEncodable (a :*: b) BList where {-# INLINE gto #-} gto (a :*: b) = gto a ++ gto b @@ -257,8 +263,8 @@ gfrom (x : xs) = (:*:) <$> gfrom [x] <*> gfrom xs gfrom [] = decodingError "generic: not enough fields" -instance (GBEncodable a Dict, GBEncodable b Dict) - => GBEncodable (a :*: b) Dict where +instance (GBEncodable a BDict, GBEncodable b BDict) + => GBEncodable (a :*: b) BDict where {-# INLINE gto #-} gto (a :*: b) = gto a <> gto b @@ -286,7 +292,7 @@ gfromM1S :: forall c. Selector c => GBEncodable f BEncode - => Dict -> Result (M1 i c f p) + => BDict -> Result (M1 i c f p) gfromM1S dict | Just va <- M.lookup (BC.pack (selRename name)) dict = M1 <$> gfrom va | otherwise = decodingError $ "generic: Selector not found " ++ show name @@ -294,7 +300,7 @@ name = selName (error "gfromM1S: impossible" :: M1 i c f p) instance (Selector s, GBEncodable f BEncode) - => GBEncodable (M1 S s f) Dict where + => GBEncodable (M1 S s f) BDict where {-# INLINE gto #-} gto s @ (M1 x) = BC.pack (selRename (selName s)) `M.singleton` gto x @@ -303,7 +309,7 @@ -- TODO DList instance GBEncodable f BEncode - => GBEncodable (M1 S s f) [BEncode] where + => GBEncodable (M1 S s f) BList where {-# INLINE gto #-} gto (M1 x) = [gto x] @@ -311,7 +317,7 @@ gfrom _ = decodingError "generic: empty selector" {-# INLINE gfrom #-} -instance (Constructor c, GBEncodable f Dict, GBEncodable f [BEncode]) +instance (Constructor c, GBEncodable f BDict, GBEncodable f BList) => GBEncodable (M1 C c f) BEncode where {-# INLINE gto #-} gto con @ (M1 x) @@ -334,56 +340,153 @@ #endif {-------------------------------------------------------------------- - Basic instances +-- Native instances --------------------------------------------------------------------} instance BEncodable BEncode where - {-# SPECIALIZE instance BEncodable BEncode #-} toBEncode = id {-# INLINE toBEncode #-} - fromBEncode = Right + fromBEncode = pure {-# INLINE fromBEncode #-} -instance BEncodable Int where - {-# SPECIALIZE instance BEncodable Int #-} - toBEncode = BInteger . fromIntegral +instance BEncodable BInteger where + toBEncode = BInteger {-# INLINE toBEncode #-} - fromBEncode (BInteger i) = Right (fromIntegral i) - fromBEncode _ = decodingError "integer" + fromBEncode (BInteger i) = pure i + fromBEncode _ = decodingError "BInteger" {-# INLINE fromBEncode #-} -instance BEncodable Bool where - toBEncode = toBEncode . fromEnum +instance BEncodable BString where + toBEncode = BString {-# INLINE toBEncode #-} - fromBEncode b = do - i <- fromBEncode b - case i :: Int of - 0 -> return False - 1 -> return True - _ -> decodingError "bool" + fromBEncode (BString s) = pure s + fromBEncode _ = decodingError "BString" {-# INLINE fromBEncode #-} +instance BEncodable BList where + toBEncode = BList + {-# INLINE toBEncode #-} -instance BEncodable Integer where - toBEncode = BInteger . fromIntegral + fromBEncode (BList xs) = pure xs + fromBEncode _ = decodingError "BList" + {-# INLINE fromBEncode #-} + +instance BEncodable BDict where + toBEncode = BDict {-# INLINE toBEncode #-} - fromBEncode b = fromIntegral <$> (fromBEncode b :: Result Int) + fromBEncode (BDict d) = pure d + fromBEncode _ = decodingError "BDict" {-# INLINE fromBEncode #-} +{-------------------------------------------------------------------- +-- Integral instances +--------------------------------------------------------------------} -instance BEncodable ByteString where - toBEncode = BString +{- NOTE: instance Integral a => BEncodable a + requires -XUndecidableInstances, so we avoid it +-} + +toBEncodeIntegral :: Integral a => a -> BEncode +toBEncodeIntegral = BInteger . fromIntegral +{-# INLINE toBEncodeIntegral #-} + +fromBEncodeIntegral :: forall a. Typeable a => Integral a => BEncode -> Result a +fromBEncodeIntegral (BInteger i) = pure (fromIntegral i) +fromBEncodeIntegral _ + = decodingError $ show $ typeOf (undefined :: a) +{-# INLINE fromBEncodeIntegral #-} + + +instance BEncodable Word8 where + toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} - fromBEncode (BString s) = Right s - fromBEncode _ = decodingError "string" + fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} +instance BEncodable Word16 where + toBEncode = toBEncodeIntegral + {-# INLINE toBEncode #-} + fromBEncode = fromBEncodeIntegral + {-# INLINE fromBEncode #-} + +instance BEncodable Word32 where + toBEncode = toBEncodeIntegral + {-# INLINE toBEncode #-} + + fromBEncode = fromBEncodeIntegral + {-# INLINE fromBEncode #-} + +instance BEncodable Word64 where + toBEncode = toBEncodeIntegral + {-# INLINE toBEncode #-} + + fromBEncode = fromBEncodeIntegral + {-# INLINE fromBEncode #-} + +instance BEncodable Word where + toBEncode = toBEncodeIntegral + {-# INLINE toBEncode #-} + + fromBEncode = fromBEncodeIntegral + {-# INLINE fromBEncode #-} + +instance BEncodable Int8 where + toBEncode = toBEncodeIntegral + {-# INLINE toBEncode #-} + + fromBEncode = fromBEncodeIntegral + {-# INLINE fromBEncode #-} + +instance BEncodable Int16 where + toBEncode = toBEncodeIntegral + {-# INLINE toBEncode #-} + + fromBEncode = fromBEncodeIntegral + {-# INLINE fromBEncode #-} + +instance BEncodable Int32 where + toBEncode = toBEncodeIntegral + {-# INLINE toBEncode #-} + + fromBEncode = fromBEncodeIntegral + {-# INLINE fromBEncode #-} + +instance BEncodable Int64 where + toBEncode = toBEncodeIntegral + {-# INLINE toBEncode #-} + + fromBEncode = fromBEncodeIntegral + {-# INLINE fromBEncode #-} + +instance BEncodable Int where + toBEncode = toBEncodeIntegral + {-# INLINE toBEncode #-} + + fromBEncode = fromBEncodeIntegral + {-# INLINE fromBEncode #-} + +{-------------------------------------------------------------------- +-- Derived instances +--------------------------------------------------------------------} + +instance BEncodable Bool where + toBEncode = toBEncode . fromEnum + {-# INLINE toBEncode #-} + + fromBEncode b = do + i <- fromBEncode b + case i :: Int of + 0 -> return False + 1 -> return True + _ -> decodingError "Bool" + {-# INLINE fromBEncode #-} + instance BEncodable Text where toBEncode = toBEncode . T.encodeUtf8 {-# INLINE toBEncode #-} @@ -393,7 +496,6 @@ instance BEncodable a => BEncodable [a] where {-# SPECIALIZE instance BEncodable [BEncode] #-} - toBEncode = BList . map toBEncode {-# INLINE toBEncode #-} @@ -401,10 +503,8 @@ fromBEncode _ = decodingError "list" {-# INLINE fromBEncode #-} - instance BEncodable a => BEncodable (Map ByteString a) where {-# SPECIALIZE instance BEncodable (Map ByteString BEncode) #-} - toBEncode = BDict . M.map toBEncode {-# INLINE toBEncode #-} @@ -413,7 +513,7 @@ {-# INLINE fromBEncode #-} instance (Eq a, BEncodable a) => BEncodable (Set a) where - {-# SPECIALIZE instance (Eq a, BEncodable a) => BEncodable (Set a) #-} + {-# SPECIALIZE instance BEncodable (Set BEncode) #-} toBEncode = BList . map toBEncode . S.toAscList {-# INLINE toBEncode #-} @@ -421,8 +521,21 @@ fromBEncode _ = decodingError "Data.Set" {-# INLINE fromBEncode #-} +instance BEncodable Version where + toBEncode = toBEncode . BC.pack . showVersion + {-# INLINE toBEncode #-} + + fromBEncode (BString bs) + | [(v, _)] <- ReadP.readP_to_S parseVersion (BC.unpack bs) + = return v + fromBEncode _ = decodingError "Data.Version" + {-# INLINE fromBEncode #-} + +{-------------------------------------------------------------------- +-- Tuple instances +--------------------------------------------------------------------} + instance BEncodable () where - {-# SPECIALIZE instance BEncodable () #-} toBEncode () = BList [] {-# INLINE toBEncode #-} @@ -431,7 +544,9 @@ {-# INLINE fromBEncode #-} instance (BEncodable a, BEncodable b) => BEncodable (a, b) where - {-# SPECIALIZE instance (BEncodable a, BEncodable b) => BEncodable (a, b) #-} + {-# SPECIALIZE instance (BEncodable b) => BEncodable (BEncode, b) #-} + {-# SPECIALIZE instance (BEncodable a) => BEncodable (a, BEncode) #-} + {-# SPECIALIZE instance BEncodable (BEncode, BEncode) #-} toBEncode (a, b) = BList [toBEncode a, toBEncode b] {-# INLINE toBEncode #-} @@ -440,10 +555,8 @@ {-# INLINE fromBEncode #-} instance (BEncodable a, BEncodable b, BEncodable c) => BEncodable (a, b, c) where - {-# SPECIALIZE instance (BEncodable a, BEncodable b, BEncodable c) - => BEncodable (a, b, c) #-} - {-# INLINE toBEncode #-} toBEncode (a, b, c) = BList [toBEncode a, toBEncode b, toBEncode c] + {-# INLINE toBEncode #-} fromBEncode (BList [a, b, c]) = (,,) <$> fromBEncode a <*> fromBEncode b <*> fromBEncode c @@ -452,12 +565,10 @@ instance (BEncodable a, BEncodable b, BEncodable c, BEncodable d) => BEncodable (a, b, c, d) where - {-# SPECIALIZE instance (BEncodable a, BEncodable b, BEncodable c, BEncodable d) - => BEncodable (a, b, c, d) #-} - {-# INLINE toBEncode #-} toBEncode (a, b, c, d) = BList [ toBEncode a, toBEncode b , toBEncode c, toBEncode d ] + {-# INLINE toBEncode #-} fromBEncode (BList [a, b, c, d]) = (,,,) <$> fromBEncode a <*> fromBEncode b @@ -466,16 +577,12 @@ {-# INLINE fromBEncode #-} instance (BEncodable a, BEncodable b, BEncodable c, BEncodable d, BEncodable e) - => BEncodable (a, b, c, d, e) where - {-# SPECIALIZE instance ( BEncodable a, BEncodable b - , BEncodable c, BEncodable d - , BEncodable e) - => BEncodable (a, b, c, d, e) #-} - {-# INLINE toBEncode #-} + => BEncodable (a, b, c, d, e) where toBEncode (a, b, c, d, e) = BList [ toBEncode a, toBEncode b , toBEncode c, toBEncode d , toBEncode e ] + {-# INLINE toBEncode #-} fromBEncode (BList [a, b, c, d, e]) = (,,,,) <$> fromBEncode a <*> fromBEncode b @@ -483,17 +590,6 @@ fromBEncode _ = decodingError "Unable to decode a tuple5" {-# INLINE fromBEncode #-} -instance BEncodable Version where - {-# SPECIALIZE instance BEncodable Version #-} - {-# INLINE toBEncode #-} - toBEncode = toBEncode . BC.pack . showVersion - - fromBEncode (BString bs) - | [(v, _)] <- ReadP.readP_to_S parseVersion (BC.unpack bs) - = return v - fromBEncode _ = decodingError "Data.Version" - {-# INLINE fromBEncode #-} - {-------------------------------------------------------------------- Building dictionaries --------------------------------------------------------------------} @@ -568,7 +664,7 @@ -- -- The /reqKey/ is used to extract required key — if lookup is failed -- then whole destructuring fail. -reqKey :: BEncodable a => Dict -> ByteString -> Result a +reqKey :: BEncodable a => BDict -> BKey -> Result a reqKey d key | Just b <- M.lookup key d = fromBEncode b | otherwise = Left msg @@ -577,19 +673,19 @@ -- | Used to extract optional key — if lookup is failed returns -- 'Nothing'. -optKey :: BEncodable a => Dict -> ByteString -> Result (Maybe a) +optKey :: BEncodable a => BDict -> BKey -> Result (Maybe a) optKey d key | Just b <- M.lookup key d , Right r <- fromBEncode b = return (Just r) | otherwise = return Nothing -- | Infix version of the 'reqKey'. -(>--) :: BEncodable a => Dict -> ByteString -> Result a +(>--) :: BEncodable a => BDict -> BKey -> Result a (>--) = reqKey {-# INLINE (>--) #-} -- | Infix version of the 'optKey'. -(>--?) :: BEncodable a => Dict -> ByteString -> Result (Maybe a) +(>--?) :: BEncodable a => BDict -> BKey -> Result (Maybe a) (>--?) = optKey {-# INLINE (>--?) #-} @@ -652,7 +748,7 @@ builder = go where go (BInteger i) = B.word8 (c2w 'i') <> - B.int64Dec i <> + B.integerDec i <> B.word8 (c2w 'e') go (BString s) = buildString s go (BList l) = B.word8 (c2w 'l') <> @@ -704,7 +800,7 @@ P.take n {-# INLINE stringP #-} - integerP :: Parser Int64 + integerP :: Parser Integer integerP = do c <- P.peekChar case c of @@ -731,42 +827,3 @@ = braces $ vcat $ punctuate comma $ map ppKV $ M.toAscList d where ppKV (k, v) = ppBS k <+> colon <+> ppBEncode v - -{-------------------------------------------------------------------- - Other instances ---------------------------------------------------------------------} - -instance BEncodable Word8 where - {-# SPECIALIZE instance BEncodable Word8 #-} - toBEncode = toBEncode . (fromIntegral :: Word8 -> Word64) - {-# INLINE toBEncode #-} - fromBEncode b = (fromIntegral :: Word64 -> Word8) <$> fromBEncode b - {-# INLINE fromBEncode #-} - -instance BEncodable Word16 where - {-# SPECIALIZE instance BEncodable Word16 #-} - toBEncode = toBEncode . (fromIntegral :: Word16 -> Word64) - {-# INLINE toBEncode #-} - fromBEncode b = (fromIntegral :: Word64 -> Word16) <$> fromBEncode b - {-# INLINE fromBEncode #-} - -instance BEncodable Word32 where - {-# SPECIALIZE instance BEncodable Word32 #-} - toBEncode = toBEncode . (fromIntegral :: Word32 -> Word64) - {-# INLINE toBEncode #-} - fromBEncode b = (fromIntegral :: Word64 -> Word32) <$> fromBEncode b - {-# INLINE fromBEncode #-} - -instance BEncodable Word64 where - {-# SPECIALIZE instance BEncodable Word64 #-} - toBEncode = toBEncode . (fromIntegral :: Word64 -> Int) - {-# INLINE toBEncode #-} - fromBEncode b = (fromIntegral :: Int -> Word64) <$> fromBEncode b - {-# INLINE fromBEncode #-} - -instance BEncodable Word where -- TODO: make platform independent - {-# SPECIALIZE instance BEncodable Word #-} - toBEncode = toBEncode . (fromIntegral :: Word -> Int) - {-# INLINE toBEncode #-} - fromBEncode b = (fromIntegral :: Int -> Word) <$> fromBEncode b - {-# INLINE fromBEncode #-}