diff --git a/dbus.cabal b/dbus.cabal --- a/dbus.cabal +++ b/dbus.cabal @@ -1,5 +1,5 @@ name: dbus -version: 0.10.11 +version: 0.10.12 license: GPL-3 license-file: license.txt author: John Millikin @@ -83,7 +83,7 @@ source-repository this type: git location: https://john-millikin.com/code/haskell-dbus/ - tag: haskell-dbus_0.10.11 + tag: haskell-dbus_0.10.12 library ghc-options: -Wall -O2 @@ -95,8 +95,8 @@ -- IMPORTANT: keep these in sync with the test suite build-depends: base >= 4.0 && < 5.0 - , bytestring >= 0.9 - , cereal >= 0.3.4 && < 0.5 + , bytestring >= 0.10.2 + , cereal >= 0.3.4 && < 0.6 , containers >= 0.1 && < 0.6 , libxml-sax >= 0.7 && < 0.8 , network >= 2.2.3 @@ -131,8 +131,8 @@ build-depends: base >= 4.0 && < 5.0 - , bytestring >= 0.9 - , cereal >= 0.3.4 && < 0.5 + , bytestring >= 0.10.2 + , cereal >= 0.3.4 && < 0.6 , chell >= 0.4 && < 0.5 , chell-quickcheck >= 0.2 && < 0.3 , containers >= 0.1 && < 0.6 diff --git a/lib/DBus/Transport.hs b/lib/DBus/Transport.hs --- a/lib/DBus/Transport.hs +++ b/lib/DBus/Transport.hs @@ -40,15 +40,16 @@ import Control.Exception import qualified Data.ByteString import Data.ByteString (ByteString) +import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.Lazy as Lazy import qualified Data.Map as Map +import Data.Monoid (mappend, mempty) import Data.Typeable (Typeable) import Foreign.C (CUInt) import Network.Socket hiding (recv) import Network.Socket.ByteString (sendAll, recv) import qualified System.Info -import qualified Data.Serialize.Builder as Builder - import DBus -- | Thrown from transport methods when an error occurs. @@ -149,24 +150,24 @@ transportClose (SocketTransport addr s) = catchIOException addr (sClose s) recvLoop :: Socket -> Int -> IO ByteString -recvLoop s = loop Builder.empty where +recvLoop s = \n -> Lazy.toStrict `fmap` loop mempty n where chunkSize = 4096 loop acc n = if n > chunkSize then do chunk <- recv s chunkSize - let builder = Builder.append acc (Builder.fromByteString chunk) + let builder = mappend acc (Builder.byteString chunk) loop builder (n - Data.ByteString.length chunk) else do chunk <- recv s n case Data.ByteString.length chunk of -- Unexpected end of connection; maybe the remote end went away. -- Return what we've got so far. - 0 -> return (Builder.toByteString acc) + 0 -> return (Builder.toLazyByteString acc) len -> do - let builder = Builder.append acc (Builder.fromByteString chunk) + let builder = mappend acc (Builder.byteString chunk) if len == n - then return (Builder.toByteString builder) + then return (Builder.toLazyByteString builder) else loop builder (n - Data.ByteString.length chunk) instance TransportOpen SocketTransport where diff --git a/lib/DBus/Wire.hs b/lib/DBus/Wire.hs --- a/lib/DBus/Wire.hs +++ b/lib/DBus/Wire.hs @@ -30,11 +30,14 @@ import Control.Monad (ap, liftM, when, unless) import qualified Data.ByteString import Data.ByteString (ByteString) +import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Char8 +import qualified Data.ByteString.Lazy as Lazy import Data.Int (Int16, Int32, Int64) import qualified Data.Map import Data.Map (Map) import Data.Maybe (fromJust, listToMaybe, fromMaybe) +import Data.Monoid (mappend, mempty) import Data.Text (Text) import qualified Data.Text.Encoding import qualified Data.Vector @@ -43,7 +46,6 @@ import Foreign.C.Types (CInt) import System.Posix.Types (Fd(..)) -import qualified Data.Serialize.Builder as Builder import qualified Data.Serialize.Get as Get import Data.Serialize.IEEE754 (getFloat64be, getFloat64le, putFloat64be, putFloat64le) import Data.Serialize.Put (runPut) @@ -178,15 +180,20 @@ appendB :: Word64 -> Builder.Builder -> Marshal () appendB size bytes = Wire (\_ (MarshalState builder count) -> let - builder' = Builder.append builder bytes + builder' = mappend builder bytes count' = count + size in WireRR () (MarshalState builder' count')) appendS :: ByteString -> Marshal () appendS bytes = appendB (fromIntegral (Data.ByteString.length bytes)) - (Builder.fromByteString bytes) + (Builder.byteString bytes) +appendL :: Lazy.ByteString -> Marshal () +appendL bytes = appendB + (fromIntegral (Lazy.length bytes)) + (Builder.lazyByteString bytes) + pad :: Word8 -> Marshal () pad count = do (MarshalState _ existing) <- getState @@ -273,25 +280,25 @@ return ret marshalWord8 :: Word8 -> Marshal () -marshalWord8 x = appendB 1 (Builder.singleton x) +marshalWord8 x = appendB 1 (Builder.word8 x) unmarshalWord8 :: Unmarshal Word8 unmarshalWord8 = liftM Data.ByteString.head (consume 1) marshalWord16 :: Word16 -> Marshal () marshalWord16 = marshalBuilder 2 - Builder.putWord16be - Builder.putWord16le + Builder.word16BE + Builder.word16LE marshalWord32 :: Word32 -> Marshal () marshalWord32 = marshalBuilder 4 - Builder.putWord32be - Builder.putWord32le + Builder.word32BE + Builder.word32LE marshalWord64 :: Word64 -> Marshal () marshalWord64 = marshalBuilder 8 - Builder.putWord64be - Builder.putWord64le + Builder.word64BE + Builder.word64LE marshalInt16 :: Int16 -> Marshal () marshalInt16 = marshalWord16 . fromIntegral @@ -414,35 +421,35 @@ skipTerminator fromMaybeU "signature" parseSignatureBytes bytes -arrayMaximumLength :: Int +arrayMaximumLength :: Int64 arrayMaximumLength = 67108864 marshalVector :: Type -> Vector Value -> Marshal () marshalVector t x = do (arrayPadding, arrayBytes) <- getArrayBytes t x - let arrayLen = Data.ByteString.length arrayBytes + let arrayLen = Lazy.length arrayBytes when (arrayLen > arrayMaximumLength) (throwError ("Marshaled array size (" ++ show arrayLen ++ " bytes) exceeds maximum limit of (" ++ show arrayMaximumLength ++ " bytes).")) marshalWord32 (fromIntegral arrayLen) appendS (Data.ByteString.replicate arrayPadding 0) - appendS arrayBytes + appendL arrayBytes marshalStrictBytes :: ByteString -> Marshal () marshalStrictBytes bytes = do - let arrayLen = Data.ByteString.length bytes + let arrayLen = Lazy.length (Lazy.fromStrict bytes) when (fromIntegral arrayLen > arrayMaximumLength) (throwError ("Marshaled array size (" ++ show arrayLen ++ " bytes) exceeds maximum limit of (" ++ show arrayMaximumLength ++ " bytes).")) marshalWord32 (fromIntegral arrayLen) appendS bytes -getArrayBytes :: Type -> Vector Value -> Marshal (Int, ByteString) +getArrayBytes :: Type -> Vector Value -> Marshal (Int, Lazy.ByteString) getArrayBytes itemType vs = do s <- getState (MarshalState _ afterLength) <- marshalWord32 0 >> getState (MarshalState _ afterPadding) <- pad (alignment itemType) >> getState - putState (MarshalState Builder.empty afterPadding) + putState (MarshalState mempty afterPadding) (MarshalState itemBuilder _) <- Data.Vector.mapM_ marshal vs >> getState - let itemBytes = Builder.toByteString itemBuilder + let itemBytes = Builder.toLazyByteString itemBuilder paddingSize = fromIntegral (afterPadding - afterLength) putState s @@ -556,7 +563,7 @@ Nothing -> throwErrorM (UnmarshalError ("Header field " ++ show label ++ " contains invalid value " ++ show x)) marshalMessage :: Message a => Endianness -> Serial -> a - -> Either MarshalError Data.ByteString.ByteString + -> Either MarshalError ByteString marshalMessage e serial msg = runMarshal where body = messageBody msg marshaler = do @@ -566,15 +573,15 @@ (MarshalState bodyBytesB _) <- getState putState empty marshal (toValue (encodeEndianness e)) - let bodyBytes = Builder.toByteString bodyBytesB - marshalHeader msg serial sig (fromIntegral (Data.ByteString.length bodyBytes)) + let bodyBytes = Builder.toLazyByteString bodyBytesB + marshalHeader msg serial sig (fromIntegral (Lazy.length bodyBytes)) pad 8 - appendS bodyBytes + appendL bodyBytes checkMaximumSize - emptyState = MarshalState Builder.empty 0 + emptyState = MarshalState mempty 0 runMarshal = case unWire marshaler e emptyState of WireRL err -> Left (MarshalError err) - WireRR _ (MarshalState builder _) -> Right (Builder.toByteString builder) + WireRR _ (MarshalState builder _) -> Right (Lazy.toStrict (Builder.toLazyByteString builder)) checkBodySig :: [Variant] -> Marshal Signature checkBodySig vs = case signature (map variantType vs) of