dbus 0.10.11 → 0.10.12
raw patch · 3 files changed
+44/−36 lines, 3 filesdep ~QuickCheckdep ~bytestringdep ~cerealPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: QuickCheck, bytestring, cereal, deepseq, network, text, transformers, unix, vector
API changes (from Hackage documentation)
Files
- dbus.cabal +6/−6
- lib/DBus/Transport.hs +8/−7
- lib/DBus/Wire.hs +30/−23
dbus.cabal view
@@ -1,5 +1,5 @@ name: dbus-version: 0.10.11+version: 0.10.12 license: GPL-3 license-file: license.txt author: John Millikin <john@john-millikin.com>@@ -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
lib/DBus/Transport.hs view
@@ -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
lib/DBus/Wire.hs view
@@ -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