binary-conduit-1.2.4.1/0000755000000000000000000000000012727336053013002 5ustar0000000000000000binary-conduit-1.2.4.1/LICENSE0000644000000000000000000000243012727336053014006 0ustar0000000000000000Copyright (c) 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: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 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. [Except as contained in this notice, the name of shall not be used in advertising or otherwise to promote the sale, use or other dealings in this Software without prior written authorization from .] binary-conduit-1.2.4.1/Setup.hs0000644000000000000000000000005612727336053014437 0ustar0000000000000000import Distribution.Simple main = defaultMain binary-conduit-1.2.4.1/binary-conduit.cabal0000644000000000000000000000253012727336053016715 0ustar0000000000000000name: binary-conduit version: 1.2.4.1 synopsis: data serialization/deserialization conduit library description: The binary-conduit package. Allow binary serialization using iterative conduit interface. license: MIT license-file: LICENSE author: Alexander Vershilov maintainer: alexander.vershilov@gmail.com copyright: 2013-2016 Alexander Vershilov category: Conduit stability: Experimental homepage: http://github.com/qnikst/binary-conduit/ bug-reports: http://github.com/qnikst/binary-conduit/issues build-type: Simple cabal-version: >=1.8 library exposed-modules: Data.Conduit.Serialization.Binary build-depends: base >=4 && <5, conduit >= 1.1 && < 1.3, bytestring >= 0.9.2 && < 10.3, binary >= 0.6 && < 0.9, vector >= 0.10, resourcet >= 1.1 ghc-options: -Wall test-suite test-binary-conduit type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test/ build-depends: base, QuickCheck, quickcheck-assertions, binary-conduit, hspec, conduit, binary, bytestring, resourcet source-repository head type: git location: git://github.com/qnikst/binary-conduit/ binary-conduit-1.2.4.1/Data/0000755000000000000000000000000012727336053013653 5ustar0000000000000000binary-conduit-1.2.4.1/Data/Conduit/0000755000000000000000000000000012727336053015260 5ustar0000000000000000binary-conduit-1.2.4.1/Data/Conduit/Serialization/0000755000000000000000000000000012727336053020075 5ustar0000000000000000binary-conduit-1.2.4.1/Data/Conduit/Serialization/Binary.hs0000644000000000000000000001113612727336053021657 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE CPP #-} module Data.Conduit.Serialization.Binary ( conduitDecode , conduitEncode , conduitMsgEncode , conduitGet , conduitPut , conduitPutList , conduitPutLBS , conduitPutMany , sourcePut , sinkGet , ParseError(..) ) where import Control.Exception import Data.Binary import Data.Binary.Get import Data.Binary.Put import Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Conduit import qualified Data.Conduit.List as CL import Data.Typeable import qualified Data.Vector as V import Control.Monad.Trans.Resource (MonadThrow , monadThrow) data ParseError = ParseError { unconsumed :: ByteString -- ^ Data left unconsumed in single stream input value. , offset :: ByteOffset -- ^ Number of bytes consumed from single stream input value. , content :: String -- ^ Error content. } deriving (Show, Typeable) instance Exception ParseError -- | Runs default 'Decoder' repeatedly on a input stream. conduitDecode :: (Binary b, MonadThrow m) => Conduit ByteString m b conduitDecode = conduitGet get -- | Runs default encoder on a input stream. -- -- This function produces a stream of bytes where for each input -- value you will have a number of 'ByteString's, and no boundary -- between different values. conduitEncode :: (Binary b, MonadThrow m) => Conduit b m ByteString conduitEncode = CL.map put =$= conduitPut -- | Runs default encoder on input stream. -- -- This function produces a ByteString per each incomming packet, -- it may be useful in datagram based protocols. -- Function maintains following property -- -- > 'conduitMsgEncode' xs == 'CL.map' 'Data.ByteString.encode' =$= 'CL.map' 'LBS.toStrict' -- -- This invariant is maintaind by the cost of additional data copy, -- so if you packets can be serialized to the large data chunks or -- you interested in iterative packet serialization -- concider using 'conduitPutList' or 'conduitPutMany' -- conduitMsgEncode :: (Binary b, MonadThrow m) => Conduit b m ByteString conduitMsgEncode = CL.map put =$= conduitMsg -- | Runs getter repeatedly on a input stream. conduitGet :: MonadThrow m => Get b -> Conduit ByteString m b conduitGet g = start where start = do mx <- await case mx of Nothing -> return () Just x -> go (runGetIncremental g `pushChunk` x) go (Done bs _ v) = do yield v if BS.null bs then start else go (runGetIncremental g `pushChunk` bs) go (Fail u o e) = monadThrow (ParseError u o e) go (Partial n) = await >>= (go . n) -- \o/ #define conduitPutGeneric(name,yi) \ name = conduit \ where \ conduit = do {mx <- await;\ case mx of;\ Nothing -> return ();\ Just x -> do { yi ; conduit}} -- | Runs putter repeatedly on a input stream, returns an output stream. conduitPut :: MonadThrow m => Conduit Put m ByteString conduitPutGeneric(conduitPut, (sourcePut x $$ CL.mapM_ yield)) -- | Runs a putter repeatedly on a input stream, returns a packets. conduitMsg :: MonadThrow m => Conduit Put m ByteString conduitPutGeneric(conduitMsg, (yield (LBS.toStrict $ runPut x))) -- | Runs putter repeatedly on a input stream. -- Returns a lazy butestring so it's possible to use vectorized -- IO on the result either by calling' LBS.toChunks' or by -- calling 'Network.Socket.ByteString.Lazy.send'. conduitPutLBS :: MonadThrow m => Conduit Put m LBS.ByteString conduitPutGeneric(conduitPutLBS, yield (runPut x)) -- | Vectorized variant of 'conduitPut' returning list contains -- all chunks from one element representation conduitPutList :: MonadThrow m => Conduit Put m [ByteString] conduitPutGeneric(conduitPutList, yield (LBS.toChunks (runPut x))) -- | Vectorized variant of 'conduitPut'. conduitPutMany :: MonadThrow m => Conduit Put m (V.Vector ByteString) conduitPutGeneric(conduitPutMany, yield (V.fromList (LBS.toChunks (runPut x)))) -- | Create stream of strict bytestrings from 'Put' value. sourcePut :: MonadThrow m => Put -> Producer m ByteString sourcePut = CL.sourceList . LBS.toChunks . runPut -- | Decode message from input stream. sinkGet :: MonadThrow m => Get b -> Consumer ByteString m b sinkGet f = sink (runGetIncremental f) where sink (Done bs _ v) = leftover bs >> return v sink (Fail u o e) = monadThrow (ParseError u o e) sink (Partial next) = await >>= sink . next binary-conduit-1.2.4.1/test/0000755000000000000000000000000012727336053013761 5ustar0000000000000000binary-conduit-1.2.4.1/test/Main.hs0000644000000000000000000001247712727336053015214 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} import Control.Applicative import Control.Monad (forM_, when) import Data.Binary import Data.Binary.Put import Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Conduit import qualified Data.Conduit.List as CL import Data.Conduit.Serialization.Binary import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck.Assertions import Test.QuickCheck.Property import Test.QuickCheck.Monadic import Test.QuickCheck import Control.Monad.Trans.Resource import GHC.Generics -- | check conduitEncode =$= conduitDecode == id prop_eq :: (Binary a,Eq a) => [a] -> Property prop_eq xs = monadicIO $ do xs' <- runExceptionT $ CL.sourceList xs $= enc xs =$= dec xs $$ CL.consume case xs' of Left e -> fail "exception" Right x -> assert $ x == xs where enc :: (Binary a, MonadThrow m) => [a] -> Conduit a m ByteString enc _ = conduitEncode dec :: (Binary a, MonadThrow m) => [a] -> Conduit ByteString m a dec _ = conduitDecode prop_sink :: (Binary a,Eq a) => (a,a) -> Property prop_sink (a,b) = monadicIO $ do Right (a',b') <- runExceptionT $ CL.sourceList [a,b] $= enc a $$ do a' <- sinkGet get b' <- CL.consume return (a',b') assert $ a == a' assert $ runPut (put b) == LBS.fromChunks b' where enc :: (Binary a, MonadThrow m) => a -> Conduit a m ByteString enc _ = conduitEncode dec :: (Binary a, MonadThrow m) => a -> Conduit ByteString m a dec _ = conduitDecode prop_part2 :: [Int] -> Property prop_part2 xs = monadicIO $ do let m = BS.concat . Prelude.concatMap (LBS.toChunks . runPut . put) $ xs when (Prelude.length xs>0) $ do forM_ [0..BS.length m] $ \l -> do let (l1,l2) = BS.splitAt l m ma <- runExceptionT $ CL.sourceList [l1,l2] $= conduitDecode $$ CL.consume case ma of Left _ -> fail "exception in conduit" Right a -> stop (xs ?== a) prop_part3 :: [Int] -> Property prop_part3 xs = monadicIO $ do let m = BS.concat . Prelude.concatMap (LBS.toChunks . runPut . put) $ xs when (Prelude.length xs>0) $ do forM_ [1..BS.length m] $ \l -> do let (l1,l2) = BS.splitAt l m when (BS.length l2 > 0) $ do forM_ [1..BS.length l2] $ \l' -> do let (l2_1,l2_2) = BS.splitAt l' l2 ma <- runExceptionT $ CL.sourceList [l1,l2_1,l2_2] $= conduitDecode $$ CL.consume case ma of Left _ -> fail "exception in conduit" Right a -> stop $ xs ?== a data A = A ByteString ByteString deriving (Eq, Show, Generic) instance Binary A instance Arbitrary A where arbitrary = A <$> fmap BS.pack arbitrary <*> fmap BS.pack arbitrary prop_eq_plus :: (Binary a, Eq a) => [a] -> Property prop_eq_plus xs = monadicIO $ do x <- runExceptionT $ CL.sourceList xs $= CL.map encode =$= CL.map LBS.toStrict $$ CL.consume y <- runExceptionT $ CL.sourceList xs $= conduitMsgEncode $$ CL.consume case liftA2 (?==) x y of Left _ -> fail "exception in conduit" Right a -> stop a main = hspec $ do describe "QC properties: conduitEncode =$= conduitDecode == id" $ do prop "int" $ (prop_eq :: [Int] -> Property) prop "string" $ (prop_eq :: [String] -> Property) prop "maybe int" $ (prop_eq :: [Maybe Int] -> Property) prop "either int string" $ (prop_eq :: [Either Int String] -> Property) prop "(Int,Int)" $ (prop_sink :: (Int,Int) -> Property) prop "(String,String)" $ (prop_sink :: (String,String) -> Property) prop "A" $ (prop_eq :: [A] -> Property) describe "QC properties partial lists" $ do prop "break data in 2 parts" $ (prop_part2) prop "break data in 3 parts" $ (prop_part3) describe "QC properites: CL.conduitMsgEncode returns a correct chunks" $ do prop "int" $ (prop_eq_plus :: [Int] -> Property) prop "string" $ (prop_eq_plus :: [String] -> Property) prop "maybe int" $ (prop_eq_plus :: [Maybe Int] -> Property) prop "either int string" $ (prop_eq_plus :: [Either Int String] -> Property) prop "A" $ (prop_eq_plus :: [A] -> Property) describe "HUnit properties:" $ do it "decodes message splitted to chunks" $ do let i = -32 l = runPut (put (i::Int)) (l1,l2) = LBS.splitAt (LBS.length l `div` 2) l t = BS.concat . LBS.toChunks x <- CL.sourceList [t l1,t l2] $= conduitDecode $$ CL.consume x `shouldBe` [i] it "decodes message with list of values inside" $ do let is = [-32,45::Int] ls = BS.concat . Prelude.concatMap (LBS.toChunks .runPut . put) $ is (ls1,ls2) = BS.splitAt ((BS.length ls `div` 2) +1) ls x <- CL.sourceList [ls,ls] $= conduitDecode $$ CL.consume x' <- CL.sourceList [ls1,ls2] $= conduitDecode $$ CL.consume x `shouldBe` is++is x' `shouldBe` is