dbus 0.10.9.2 → 0.10.10

raw patch · 7 files changed

+48/−6 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• dbus.cabal +2/−2
• lib/DBus/Message.hs +2/−1
• lib/DBus/Types.hs +9/−0
• lib/DBus/Wire.hs +20/−0
• tests/DBusTests/Serialization.hs +10/−0
• tests/DBusTests/Signature.hs +2/−3
• tests/DBusTests/Variant.hs +3/−0

@@ -1,5 +1,5 @@ name: dbus-version: 0.10.9.2+version: 0.10.10 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.9.2+  tag: haskell-dbus_0.10.10  library   ghc-options: -Wall -O2

@@ -31,7 +31,7 @@  import           Data.Bits ((.|.), (.&.)) import           Data.Maybe (fromMaybe, listToMaybe)-import           Data.Word (Word8)+import           Data.Word (Word8, Word32)  import           DBus.Types @@ -62,6 +62,7 @@ 	| HeaderDestination BusName 	| HeaderSender      BusName 	| HeaderSignature   Signature+	| HeaderUnixFds     Word32 	deriving (Show, Eq)  -- | A method call is a request to run some procedure exported by the

@@ -43,6 +43,7 @@ import           Data.Word import qualified Foreign import           System.IO.Unsafe (unsafePerformIO)+import           System.Posix.Types (Fd)  import qualified Text.ParserCombinators.Parsec as Parsec import           Text.ParserCombinators.Parsec ((<|>), oneOf)@@ -57,6 +58,7 @@ 	| TypeInt32 	| TypeInt64 	| TypeDouble+	| TypeUnixFd 	| TypeString 	| TypeSignature 	| TypeObjectPath@@ -80,6 +82,7 @@ 	TypeInt32 -> "Int32" 	TypeInt64 -> "Int64" 	TypeDouble -> "Double"+	TypeUnixFd -> "UnixFd" 	TypeString -> "String" 	TypeSignature -> "Signature" 	TypeObjectPath -> "ObjectPath"@@ -126,6 +129,7 @@ typeCode TypeInt32      = "i" typeCode TypeInt64      = "x" typeCode TypeDouble     = "d"+typeCode TypeUnixFd     = "h" typeCode TypeString     = "s" typeCode TypeSignature  = "g" typeCode TypeObjectPath = "o"@@ -210,6 +214,7 @@ 	0x75 -> yes TypeWord32 	0x74 -> yes TypeWord64 	0x64 -> yes TypeDouble+	0x68 -> yes TypeUnixFd 	0x73 -> yes TypeString 	0x67 -> yes TypeSignature 	0x6F -> yes TypeObjectPath@@ -357,6 +362,7 @@ 	| AtomInt32 Int32 	| AtomInt64 Int64 	| AtomDouble Double+	| AtomUnixFd Fd 	| AtomText Text 	| AtomSignature Signature 	| AtomObjectPath ObjectPath@@ -390,6 +396,7 @@ showAtom _ (AtomInt32 x) = show x showAtom _ (AtomInt64 x) = show x showAtom _ (AtomDouble x) = show x+showAtom p (AtomUnixFd x) = showParen p (showString "UnixFd " . shows x) "" showAtom _ (AtomText x) = show x showAtom p (AtomSignature x) = showsPrec (if p then 11 else 0) x "" showAtom p (AtomObjectPath x) = showsPrec (if p then 11 else 0) x ""@@ -440,6 +447,7 @@ atomType (AtomInt32 _) = TypeInt32 atomType (AtomInt64 _) = TypeInt64 atomType (AtomDouble _) = TypeDouble+atomType (AtomUnixFd _) = TypeUnixFd atomType (AtomText _) = TypeString atomType (AtomSignature _) = TypeSignature atomType (AtomObjectPath _) = TypeObjectPath@@ -470,6 +478,7 @@ IS_ATOM(Int32,      AtomInt32,      TypeInt32) IS_ATOM(Int64,      AtomInt64,      TypeInt64) IS_ATOM(Double,     AtomDouble,     TypeDouble)+IS_ATOM(Fd,         AtomUnixFd,     TypeUnixFd) IS_ATOM(Text,       AtomText,       TypeString) IS_ATOM(Signature,  AtomSignature,  TypeSignature) IS_ATOM(ObjectPath, AtomObjectPath, TypeObjectPath)

@@ -40,6 +40,8 @@ import qualified Data.Vector import           Data.Vector (Vector) import           Data.Word (Word8, Word16, Word32, Word64)+import           Foreign.C.Types (CInt)+import           System.Posix.Types (Fd(..))  import qualified Data.Serialize.Builder as Builder import qualified Data.Serialize.Get as Get@@ -71,6 +73,7 @@ alignment TypeInt32 = 4 alignment TypeInt64 = 8 alignment TypeDouble = 8+alignment TypeUnixFd = 4 alignment TypeString = 4 alignment TypeObjectPath = 4 alignment TypeSignature = 1@@ -167,6 +170,7 @@ marshalAtom (AtomInt32 x) = marshalInt32 x marshalAtom (AtomInt64 x) = marshalInt64 x marshalAtom (AtomDouble x) = marshalDouble x+marshalAtom (AtomUnixFd x) = marshalUnixFd x marshalAtom (AtomBool x) = marshalBool x marshalAtom (AtomText x) = marshalText x marshalAtom (AtomObjectPath x) = marshalObjectPath x@@ -219,6 +223,7 @@ unmarshal TypeInt32 = liftM toValue unmarshalInt32 unmarshal TypeInt64 = liftM toValue unmarshalInt64 unmarshal TypeDouble = liftM toValue unmarshalDouble+unmarshal TypeUnixFd = liftM toValue unmarshalUnixFd unmarshal TypeBoolean = liftM toValue unmarshalBool unmarshal TypeString = liftM toValue unmarshalText unmarshal TypeObjectPath = liftM toValue unmarshalObjectPath@@ -332,6 +337,19 @@ 	getFloat64be 	getFloat64le +marshalUnixFd :: Fd -> Marshal ()+marshalUnixFd (Fd x)+	| x < 0 = throwError ("Invalid file descriptor: " ++ show x)+	| toInteger x > toInteger (maxBound :: Word32) = throwError ("D-Bus forbids file descriptors exceeding UINT32_MAX: " ++ show x)+	| otherwise = marshalWord32 (fromIntegral x)++unmarshalUnixFd :: Unmarshal Fd+unmarshalUnixFd = do+	x <- unmarshalWord32+	when (toInteger x > toInteger (maxBound :: CInt))+		(throwError ("Invalid file descriptor: " ++ show x))+	return (Fd (fromIntegral x))+ marshalBool :: Bool -> Marshal () marshalBool False = marshalWord32 0 marshalBool True  = marshalWord32 1@@ -512,6 +530,7 @@ encodeField (HeaderDestination x) = encodeField' 6 x encodeField (HeaderSender x)      = encodeField' 7 x encodeField (HeaderSignature x)   = encodeField' 8 x+encodeField (HeaderUnixFds x)     = encodeField' 9 x  encodeField' :: IsVariant a => Word8 -> a -> Value encodeField' code x = toValue (code, toVariant x)@@ -527,6 +546,7 @@ 	(6, x) -> decodeField' x HeaderDestination "destination" 	(7, x) -> decodeField' x HeaderSender "sender" 	(8, x) -> decodeField' x HeaderSignature "signature"+	(9, x) -> decodeField' x HeaderUnixFds "unix fds" 	_      -> return []  decodeField' :: IsVariant a => Variant -> (a -> b) -> String

@@ -29,6 +29,8 @@ import           Data.Map (Map) import qualified Data.Map import qualified Data.Vector+import           Foreign.C.Types (CInt)+import           System.Posix.Types (Fd)  import           DBus import qualified DBus.Types@@ -92,10 +94,18 @@ 	, fmap toVariant (arbitrary :: Gen Int64) 	, fmap toVariant (arbitrary :: Gen Bool) 	, fmap toVariant (arbitrary :: Gen Double)+	, fmap toVariant gen_UnixFd 	, fmap toVariant (arbitrary :: Gen Text) 	, fmap toVariant (arbitrary :: Gen ObjectPath) 	, fmap toVariant (arbitrary :: Gen Signature) 	]++gen_UnixFd :: Gen Fd+gen_UnixFd = do+	let maxWord32 = toInteger (maxBound :: Word32)+	let maxCInt = toInteger (maxBound :: CInt)+	x <- choose (0, toInteger (min maxWord32 maxCInt))+	return (fromInteger x)  gen_Variant :: Gen Variant gen_Variant = oneof

@@ -73,9 +73,6 @@ 	-- non-atomic dict key 	$expect (nothing (parseSignature "a{vy}")) 	$expect (nothing (signature [TypeDictionary TypeVariant TypeVariant]))-	-	-- unix fd (intentionally not supported in haskell-dbus)-	$expect (nothing (parseSignature "h"))  test_FormatSignature :: Test test_FormatSignature = property "formatSignature" prop where@@ -101,6 +98,7 @@ 	$expect (equal "Int32" (show TypeInt32)) 	$expect (equal "Int64" (show TypeInt64)) 	$expect (equal "Double" (show TypeDouble))+	$expect (equal "UnixFd" (show TypeUnixFd)) 	$expect (equal "String" (show TypeString)) 	$expect (equal "Signature" (show TypeSignature)) 	$expect (equal "ObjectPath" (show TypeObjectPath))@@ -127,6 +125,7 @@ 		, ("i", TypeInt32) 		, ("x", TypeInt64) 		, ("d", TypeDouble)+		, ("h", TypeUnixFd) 		, ("s", TypeString) 		, ("o", TypeObjectPath) 		, ("g", TypeSignature)

@@ -30,6 +30,7 @@ import           Data.Int (Int16, Int32, Int64) import qualified Data.Map import qualified Data.Vector+import           System.Posix.Types (Fd)  import           DBus import           DBus.Types (toValue)@@ -55,6 +56,7 @@ 	assertAtom TypeInt32 (0 :: Int32) 	assertAtom TypeInt64 (0 :: Int64) 	assertAtom TypeDouble (0 :: Double)+	assertAtom TypeUnixFd (0 :: Fd) 	assertAtom TypeString (Data.Text.pack "") 	assertAtom TypeString (Data.Text.Lazy.pack "") 	assertAtom TypeString ("" :: String)@@ -95,6 +97,7 @@ 	$expect $ equal "Variant 0" (show (toVariant (0 :: Int32))) 	$expect $ equal "Variant 0" (show (toVariant (0 :: Int64))) 	$expect $ equal "Variant 0.1" (show (toVariant (0.1 :: Double)))+	$expect $ equal "Variant (UnixFd 1)" (show (toVariant (1 :: Fd))) 	$expect $ equal "Variant \"\"" (show (toVariant (T.pack ""))) 	$expect $ equal "Variant (ObjectPath \"/\")" (show (toVariant (objectPath_ "/"))) 	$expect $ equal "Variant (Signature \"\")" (show (toVariant (signature_ [])))