desktop-portal 0.2.2.0 → 0.3.0.0

raw patch · 9 files changed

+202/−151 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• desktop-portal.cabal +1/−1
• src/Desktop/Portal.hs +3/−0
• src/Desktop/Portal/Documents.hs +6/−33
• src/Desktop/Portal/Internal.hs +34/−5
• src/Desktop/Portal/OpenURI.hs +17/−16
• test/Desktop/Portal/DocumentsSpec.hs +14/−35
• test/Desktop/Portal/OpenURISpec.hs +87/−59
• test/Desktop/Portal/TestUtil.hs +36/−2

@@ -1,3 +1,7 @@+## 0.3.0.0+### Fixed+- The OpenURI portal now supports OpenFile and OpenDirectory correctly. This uses the file descriptor support added with the Documents portal support.+ ## 0.2.2.0 ### Added - Add Documents portal support.

@@ -1,6 +1,6 @@ cabal-version:      1.12 name:               desktop-portal-version:            0.2.2.0+version:            0.3.0.0 license:            MIT license-file:       LICENSE maintainer:         garethdanielsmith@gmail.com

@@ -18,6 +18,9 @@     Internal.SignalHandler,     Internal.cancelSignalHandler, +    -- * Common Types+    Internal.FileSpec (..),+     -- * Portal Interfaces     module Desktop.Portal.Account,     module Desktop.Portal.Directories,

@@ -1,6 +1,5 @@ module Desktop.Portal.Documents   ( -- * Common Types-    FileIdentifier (..),     ApplicationId (..),     DocumentId (..),     AddFlag (..),@@ -19,7 +18,7 @@   ) where -import Control.Exception (bracket, throwIO)+import Control.Exception (throwIO) import Control.Monad (void) import DBus (BusName, InterfaceName, MemberName, ObjectPath, Variant) import DBus qualified@@ -30,18 +29,9 @@ import Data.String (IsString) import Data.Text (Text, unpack) import Data.Word (Word32)-import Desktop.Portal.Internal (Client, callMethod_)+import Desktop.Portal.Internal (Client, FileSpec, callMethod_, withFd, withFds) import Desktop.Portal.Util (decodeNullTerminatedUtf8, encodeNullTerminatedUtf8)-import System.Posix (Fd)-import System.Posix.IO (OpenMode (..), closeFd, defaultFileFlags, openFd) --- | Specifies a file, either with a file descriptor or a path (which will be resolved to a--- file descriptor before passing it to the portals API, since the API requires file descriptors).-data FileIdentifier-  = DocumentFilePath FilePath-  | DocumentFd Fd-  deriving (Eq, Show)- newtype ApplicationId = ApplicationId Text   deriving newtype (Eq, Ord, Show, IsString) @@ -86,7 +76,7 @@ add ::   Client ->   -- | The file to add to the documents store.-  FileIdentifier ->+  FileSpec ->   -- | Whether to re-use the existing entry in the documents store, if this file is already there.   Bool ->   -- | Whether this file should stay in the documents store after this app shuts down.@@ -111,7 +101,7 @@ addFull ::   Client ->   -- | The files to add to the documents store.-  [FileIdentifier] ->+  [FileSpec] ->   -- | The flags to apply to the files.   [AddFlag] ->   -- | The id of another application that will be granted access to the files.@@ -139,7 +129,7 @@ addNamed ::   Client ->   -- | The parent directory of the file to add to the documents store.-  FileIdentifier ->+  FileSpec ->   -- | The basename of the file.   Text ->   -- | Whether to re-use the existing entry in the documents store, if this file is already there.@@ -167,7 +157,7 @@ addNamedFull ::   Client ->   -- | The parent directory of the file to add to the documents store.-  FileIdentifier ->+  FileSpec ->   -- | The basename of the file.   Text ->   -- | The flags to apply to the file.@@ -221,23 +211,6 @@ callDocumentsMethod :: Client -> MemberName -> [Variant] -> IO [Variant] callDocumentsMethod client =   callMethod_ client documentsBusName documentsObject documentsInterface--withFd :: FileIdentifier -> (Fd -> IO a) -> IO a-withFd = \case-  DocumentFd fd ->-    ($ fd)-  DocumentFilePath path ->-    bracket (openFd path ReadOnly Nothing defaultFileFlags) closeFd--withFds :: forall a. [FileIdentifier] -> ([Fd] -> IO a) -> IO a-withFds files cmd = withFdsRec [] files-  where-    withFdsRec fds = \case-      [] ->-        cmd (reverse fds)-      file : files' ->-        withFd file $ \fd -> do-          withFdsRec (fd : fds) files'  encodeAddFlags :: [AddFlag] -> Word32 encodeAddFlags flags =

@@ -12,12 +12,15 @@     SignalHandler,     handleSignal,     cancelSignalHandler,+    FileSpec (..),+    withFd,+    withFds,   ) where  import Control.Concurrent (MVar, putMVar, readMVar, tryPutMVar) import Control.Concurrent.MVar (newEmptyMVar)-import Control.Exception (SomeException, catch, throwIO)+import Control.Exception (SomeException, bracket, catch, throwIO) import Control.Monad (void, when) import DBus (BusName, InterfaceName, MemberName, MethodCall, ObjectPath) import DBus qualified@@ -30,6 +33,7 @@ import Data.Map.Strict qualified as Map import Data.Text (Text, pack, unpack) import Data.Word (Word32, Word64)+import System.Posix (Fd, OpenMode (..), closeFd, defaultFileFlags, openFd) import System.Random.Stateful qualified as R  -- | A handle for an active desktop portal session. Can send requests and listen for signals.@@ -82,8 +86,8 @@       let socketAuthenticator = DBus.authenticatorWithUnixFds           clientSocketOptions = DBus.defaultSocketOptions {DBus.socketAuthenticator}           clientOptions = DBus.defaultClientOptions {DBus.clientSocketOptions}-      (dbusClient, clientName) <- DBus.connectWithName clientOptions addr-      pure Client {dbusClient, clientName}+      (dbusClient, cName) <- DBus.connectWithName clientOptions addr+      pure Client {dbusClient, clientName = cName}  disconnect :: Client -> IO () disconnect client = do@@ -244,9 +248,9 @@   pure ("haskell_desktop_portal_" <> pack (show rnd))  requestHandle :: BusName -> IO (ObjectPath, Text)-requestHandle clientName = do+requestHandle cName = do   token <- requestToken-  pure (DBus.objectPath_ ("/org/freedesktop/portal/desktop/request/" <> escapeClientName clientName <> "/" <> unpack token), token)+  pure (DBus.objectPath_ ("/org/freedesktop/portal/desktop/request/" <> escapeClientName cName <> "/" <> unpack token), token)   where     escapeClientName =       map (\case '.' -> '_'; c -> c) . drop 1 . DBus.formatBusName@@ -259,3 +263,28 @@  portalBusName :: BusName portalBusName = "org.freedesktop.portal.Desktop"++-- | Specifies a file, either with a file descriptor or a path (which will be+-- resolved to a file descriptor before passing it to the portals API, since+-- the API typically requires file descriptors).+data FileSpec+  = FileSpecPath FilePath+  | FileSpecFd Fd+  deriving (Eq, Show)++withFd :: FileSpec -> (Fd -> IO a) -> IO a+withFd = \case+  FileSpecFd fd ->+    ($ fd)+  FileSpecPath path ->+    bracket (openFd path ReadOnly Nothing defaultFileFlags) closeFd++withFds :: forall a. [FileSpec] -> ([Fd] -> IO a) -> IO a+withFds files cmd = withFdsRec [] files+  where+    withFdsRec fds = \case+      [] ->+        cmd (reverse fds)+      file : files' ->+        withFd file $ \fd -> do+          withFdsRec (fd : fds) files'

@@ -20,8 +20,7 @@ import Data.Map.Strict qualified as Map import Data.Maybe (catMaybes, fromMaybe) import Data.Text (Text)-import Data.Word (Word32)-import Desktop.Portal.Internal (Client, Request, sendRequest)+import Desktop.Portal.Internal (Client, FileSpec, Request, sendRequest, withFd) import Desktop.Portal.Util (toVariantPair) import Text.URI (URI) import Text.URI qualified as URI@@ -36,7 +35,7 @@   deriving (Eq, Show)  data OpenFileOptions = OpenFileOptions-  { fd :: Word32,+  { fileSpec :: FileSpec,     parentWindow :: Maybe Text,     writable :: Maybe Bool,     ask :: Maybe Bool,@@ -45,7 +44,7 @@   deriving (Eq, Show)  data OpenDirectoryOptions = OpenDirectoryOptions-  { fd :: Word32,+  { fileSpec :: FileSpec,     parentWindow :: Maybe Text,     activationToken :: Maybe Text   }@@ -65,12 +64,12 @@     }  openFileOptions ::-  -- | The file descriptor to open.-  Word32 ->+  -- | The file to open.+  FileSpec ->   OpenFileOptions-openFileOptions fd =+openFileOptions fileSpec =   OpenFileOptions-    { fd,+    { fileSpec,       parentWindow = Nothing,       writable = Nothing,       ask = Nothing,@@ -78,12 +77,12 @@     }  openDirectoryOptions ::-  -- | The file descriptor to open.-  Word32 ->+  -- | The directory to open.+  FileSpec ->   OpenDirectoryOptions-openDirectoryOptions fd =+openDirectoryOptions fileSpec =   OpenDirectoryOptions-    { fd,+    { fileSpec,       parentWindow = Nothing,       activationToken = Nothing     }@@ -106,9 +105,10 @@  openFile :: Client -> OpenFileOptions -> IO (Request ()) openFile client options =-  sendRequest client openURIInterface "OpenFile" args optionsArg parseUnitResponse+  withFd options.fileSpec $ \fd ->+    sendRequest client openURIInterface "OpenFile" (args fd) optionsArg parseUnitResponse   where-    args = [DBus.toVariant parentWindow, DBus.toVariant options.fd]+    args fd = [DBus.toVariant parentWindow, DBus.toVariant fd]     parentWindow = fromMaybe "" options.parentWindow     optionsArg =       Map.fromList . catMaybes $@@ -119,9 +119,10 @@  openDirectory :: Client -> OpenDirectoryOptions -> IO (Request ()) openDirectory client options =-  sendRequest client openURIInterface "OpenDirectory" args optionsArg parseUnitResponse+  withFd options.fileSpec $ \fd ->+    sendRequest client openURIInterface "OpenDirectory" (args fd) optionsArg parseUnitResponse   where-    args = [DBus.toVariant parentWindow, DBus.toVariant options.fd]+    args fd = [DBus.toVariant parentWindow, DBus.toVariant fd]     parentWindow = fromMaybe "" options.parentWindow     optionsArg =       Map.fromList . catMaybes $

@@ -1,15 +1,15 @@ module Desktop.Portal.DocumentsSpec (spec) where  import Control.Monad (void)-import DBus (BusName, InterfaceName, MemberName, ObjectPath, Type (..), Variant, fromVariant, toVariant, variantType)+import DBus (BusName, InterfaceName, MemberName, ObjectPath, Variant, toVariant) import Data.ByteString (ByteString) import Data.Text (Text) import Data.Word (Word32)-import Desktop.Portal.Documents (AddFlag (..), ExtraResults (..), FileIdentifier (..), GrantPermission (..))+import Desktop.Portal (FileSpec (..))+import Desktop.Portal.Documents (AddFlag (..), ExtraResults (..), GrantPermission (..)) import Desktop.Portal.Documents qualified as Documents import Desktop.Portal.TestUtil import Desktop.Portal.TestUtil qualified as DBus-import System.Posix (Fd) import Test.Hspec (Spec, around, describe, it, shouldBe, shouldReturn, shouldSatisfy)  documentsInterface :: InterfaceName@@ -41,7 +41,7 @@         let responseBody = [toVariantText "docId"]         withTempFd $ \fd -> do           body <- savingDocumentsMethodArguments handle "Add" responseBody $ do-            void $ Documents.add (client handle) (DocumentFd fd) False True+            void $ Documents.add (client handle) (FileSpecFd fd) False True           head body `shouldSatisfy` isDifferentUnixFd fd           tail body `shouldBe` [DBus.toVariant False, DBus.toVariant True] @@ -49,7 +49,7 @@         let responseBody = [toVariantText "docId"]         withTempFilePath $ \path -> do           body <- savingDocumentsMethodArguments handle "Add" responseBody $ do-            void $ Documents.add (client handle) (DocumentFilePath path) False True+            void $ Documents.add (client handle) (FileSpecPath path) False True           head body `shouldSatisfy` isUnixFd           tail body `shouldBe` [DBus.toVariant False, DBus.toVariant True] @@ -57,7 +57,7 @@         let responseBody = [toVariantText "docId"]         withTempFd $ \fd -> do           withDocumentsMethodResponse handle "Add" responseBody $ do-            Documents.add (client handle) (DocumentFd fd) False False+            Documents.add (client handle) (FileSpecFd fd) False False               `shouldReturn` "docId"      describe "addFull" $ do@@ -71,7 +71,7 @@             void $               Documents.addFull                 (client handle)-                (DocumentFd <$> fds)+                (FileSpecFd <$> fds)                 [AddReuseExisting, AddPersistent, AddAsNeededByApp, AddExportDirectory]                 (Just "appId")                 [GrantRead, GrantWrite, GrantGrantPermissions, GrantDelete]@@ -90,7 +90,7 @@                 ]           body <- savingDocumentsMethodArguments handle "AddFull" responseBody $ do             void $-              Documents.addFull (client handle) (DocumentFilePath <$> paths) [] Nothing []+              Documents.addFull (client handle) (FileSpecPath <$> paths) [] Nothing []           head body `shouldSatisfy` isUnixFds 8           tail body             `shouldBe` [DBus.toVariant (0 :: Word32), toVariantText "", DBus.toVariant ([] :: [Text])]@@ -109,7 +109,7 @@         withTempDirectoryFd $ \fd -> do           let responseBody = [toVariantText "docId"]           body <- savingDocumentsMethodArguments handle "AddNamed" responseBody $ do-            void $ Documents.addNamed (client handle) (DocumentFd fd) "filename" False True+            void $ Documents.addNamed (client handle) (FileSpecFd fd) "filename" False True           head body `shouldSatisfy` isDifferentUnixFd fd           tail body             `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString),@@ -121,7 +121,7 @@         withTempDirectoryFilePath $ \path -> do           let responseBody = [toVariantText "docId"]           body <- savingDocumentsMethodArguments handle "AddNamed" responseBody $ do-            void $ Documents.addNamed (client handle) (DocumentFilePath path) "filename" False True+            void $ Documents.addNamed (client handle) (FileSpecPath path) "filename" False True           head body `shouldSatisfy` isUnixFd           tail body             `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString),@@ -133,7 +133,7 @@         withTempDirectoryFd $ \fd -> do           let responseBody = [DBus.toVariantText "docId"]           withDocumentsMethodResponse handle "AddNamed" responseBody $ do-            Documents.addNamed (client handle) (DocumentFd fd) "filename\0" False False+            Documents.addNamed (client handle) (FileSpecFd fd) "filename\0" False False               `shouldReturn` "docId"      describe "addNamedFull" $ do@@ -147,7 +147,7 @@             void $               Documents.addNamedFull                 (client handle)-                (DocumentFd fd)+                (FileSpecFd fd)                 "filename"                 [AddReuseExisting, AddPersistent, AddAsNeededByApp, AddExportDirectory]                 (Just "appId")@@ -168,7 +168,7 @@                 ]           body <- savingDocumentsMethodArguments handle "AddNamedFull" responseBody $ do             void $-              Documents.addNamedFull (client handle) (DocumentFilePath path) "filename" [] Nothing []+              Documents.addNamedFull (client handle) (FileSpecPath path) "filename" [] Nothing []           head body `shouldSatisfy` isUnixFd           tail body             `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString),@@ -184,7 +184,7 @@                   toVariantMap [("mountpoint", DBus.toVariant ("/a/b/c\0" :: ByteString))]                 ]           withDocumentsMethodResponse handle "AddNamedFull" responseBody $ do-            Documents.addNamedFull (client handle) (DocumentFd fd) "filename\0" [] Nothing []+            Documents.addNamedFull (client handle) (FileSpecFd fd) "filename\0" [] Nothing []               `shouldReturn` ("docId", ExtraResults "/a/b/c")      describe "grantPermissions" $ do@@ -228,24 +228,3 @@ withDocumentsMethodResponse :: TestHandle -> MemberName -> [Variant] -> IO () -> IO () withDocumentsMethodResponse handle =   withMethodResponse_ handle documentsObject documentsInterface---- We send a Fd to DBUS and check that the receiving test portal server end gets it,--- but the Fd actually received will be a different value, since it gets duplicated--- as it traverses the Unix sockets: test portal client -> DBUS -> test portal server-isDifferentUnixFd :: Fd -> Variant -> Bool-isDifferentUnixFd fd = \case-  (fromVariant -> Just fd') -> fd' /= fd-  _ -> False--isDifferentUnixFds :: [Fd] -> Variant -> Bool-isDifferentUnixFds fds = \case-  (fromVariant -> Just fds') -> length fds' == length fds && fds' /= fds-  _ -> False--isUnixFd :: Variant -> Bool-isUnixFd v = DBus.variantType v == TypeUnixFd--isUnixFds :: Int -> Variant -> Bool-isUnixFds n v-  | Just (fds :: [Fd]) <- fromVariant v, length fds == n = True-  | otherwise = False

@@ -4,7 +4,7 @@  import Control.Monad (void) import DBus (InterfaceName, IsVariant (toVariant))-import Data.Word (Word32)+import Desktop.Portal (FileSpec (..)) import Desktop.Portal qualified as Portal import Desktop.Portal.OpenURI (OpenDirectoryOptions (..), OpenFileOptions (..), OpenURIOptions (..)) import Desktop.Portal.OpenURI qualified as OpenURI@@ -55,70 +55,98 @@      describe "openFile" $ do       it "should encode request with all Nothings" $ \handle -> do-        body <- savingRequestArguments handle openURIInterface "OpenFile" $ do-          void (OpenURI.openFile (client handle) (OpenURI.openFileOptions 42))-        body-          `shouldBe` [ toVariantText "",-                       toVariant (42 :: Word32),-                       toVariantMap []-                     ]+        withTempFd $ \fd -> do+          body <- savingRequestArguments handle openURIInterface "OpenFile" $ do+            void (OpenURI.openFile (client handle) (OpenURI.openFileOptions (FileSpecFd fd)))+          body+            `shouldSatisfyList` [ (== toVariantText ""),+                                  isDifferentUnixFd fd,+                                  (== toVariantMap [])+                                ]       it "should encode request with all Justs" $ \handle -> do-        body <- savingRequestArguments handle openURIInterface "OpenFile" $ do-          void-            ( OpenURI.openFile-                (client handle)-                ( OpenFileOptions-                    { fd = 43,-                      parentWindow = Just "_window",-                      writable = Just True,-                      ask = Just True,-                      activationToken = Just "_token"-                    }-                )-            )-        body-          `shouldBe` [ toVariantText "_window",-                       toVariant (43 :: Word32),-                       toVariantMap-                         [ ("writable", toVariant True),-                           ("ask", toVariant True),-                           ("activation_token", toVariantText "_token")-                         ]-                     ]+        withTempFd $ \fd -> do+          body <- savingRequestArguments handle openURIInterface "OpenFile" $ do+            void+              ( OpenURI.openFile+                  (client handle)+                  ( OpenFileOptions+                      { fileSpec = FileSpecFd fd,+                        parentWindow = Just "_window",+                        writable = Just True,+                        ask = Just True,+                        activationToken = Just "_token"+                      }+                  )+              )+          body+            `shouldSatisfyList` [ (== toVariantText "_window"),+                                  isDifferentUnixFd fd,+                                  ( ==+                                      toVariantMap+                                        [ ("writable", toVariant True),+                                          ("ask", toVariant True),+                                          ("activation_token", toVariantText "_token")+                                        ]+                                  )+                                ] +      it "should encode request with file path" $ \handle -> do+        withTempFilePath $ \path -> do+          body <- savingRequestArguments handle openURIInterface "OpenFile" $ do+            void (OpenURI.openFile (client handle) (OpenURI.openFileOptions (FileSpecPath path)))+          body+            `shouldSatisfyList` [ (== toVariantText ""),+                                  isUnixFd,+                                  (== toVariantMap [])+                                ]+       it "should decode response" $ \handle -> do-        withRequestResponse handle openURIInterface "OpenFile" (successResponse []) $ do-          (OpenURI.openFile (client handle) (OpenURI.openFileOptions 44) >>= Portal.await)-            `shouldReturn` Just ()+        withTempFd $ \fd -> do+          withRequestResponse handle openURIInterface "OpenFile" (successResponse []) $ do+            (OpenURI.openFile (client handle) (OpenURI.openFileOptions (FileSpecFd fd)) >>= Portal.await)+              `shouldReturn` Just ()      describe "openDirectory" $ do       it "should encode request with all Nothings" $ \handle -> do-        body <- savingRequestArguments handle openURIInterface "OpenDirectory" $ do-          void (Portal.openDirectory (client handle) (Portal.openDirectoryOptions 42))-        body-          `shouldBe` [ toVariantText "",-                       toVariant (42 :: Word32),-                       toVariantMap []-                     ]+        withTempDirectoryFd $ \fd -> do+          body <- savingRequestArguments handle openURIInterface "OpenDirectory" $ do+            void (Portal.openDirectory (client handle) (Portal.openDirectoryOptions (FileSpecFd fd)))+          body+            `shouldSatisfyList` [ (== toVariantText ""),+                                  isDifferentUnixFd fd,+                                  (== toVariantMap [])+                                ]       it "should encode request with all Justs" $ \handle -> do-        body <- savingRequestArguments handle openURIInterface "OpenDirectory" $ do-          void-            ( Portal.openDirectory-                (client handle)-                ( OpenDirectoryOptions-                    { fd = 43,-                      parentWindow = Just "_window",-                      activationToken = Just "_token"-                    }-                )-            )-        body-          `shouldBe` [ toVariantText "_window",-                       toVariant (43 :: Word32),-                       toVariantMap [("activation_token", toVariantText "_token")]-                     ]+        withTempDirectoryFd $ \fd -> do+          body <- savingRequestArguments handle openURIInterface "OpenDirectory" $ do+            void+              ( Portal.openDirectory+                  (client handle)+                  ( OpenDirectoryOptions+                      { fileSpec = FileSpecFd fd,+                        parentWindow = Just "_window",+                        activationToken = Just "_token"+                      }+                  )+              )+          body+            `shouldSatisfyList` [ (== toVariantText "_window"),+                                  isDifferentUnixFd fd,+                                  (== toVariantMap [("activation_token", toVariantText "_token")])+                                ] +      it "should encode request with file path" $ \handle -> do+        withTempFilePath $ \path -> do+          body <- savingRequestArguments handle openURIInterface "OpenDirectory" $ do+            void (OpenURI.openDirectory (client handle) (OpenURI.openDirectoryOptions (FileSpecPath path)))+          body+            `shouldSatisfyList` [ (== toVariantText ""),+                                  isUnixFd,+                                  (== toVariantMap [])+                                ]+       it "should decode response" $ \handle -> do-        withRequestResponse handle openURIInterface "OpenDirectory" (successResponse []) $ do-          (Portal.openDirectory (client handle) (Portal.openDirectoryOptions 44) >>= Portal.await)-            `shouldReturn` Just ()+        withTempFd $ \fd -> do+          withRequestResponse handle openURIInterface "OpenDirectory" (successResponse []) $ do+            (Portal.openDirectory (client handle) (Portal.openDirectoryOptions (FileSpecFd fd)) >>= Portal.await)+              `shouldReturn` Just ()

@@ -20,6 +20,11 @@     withTempFds,     withTempDirectoryFd,     withTempDirectoryFilePath,+    shouldSatisfyList,+    isDifferentUnixFd,+    isDifferentUnixFds,+    isUnixFd,+    isUnixFds,   ) where @@ -27,7 +32,7 @@ import Control.Exception (bracket, finally, throwIO) import Control.Monad (unless, void) import Control.Monad.IO.Class (MonadIO (..))-import DBus (BusName, InterfaceName, IsVariant (fromVariant), MemberName, MethodCall (..), ObjectPath, Variant, formatBusName, getSessionAddress, objectPath_, toVariant)+import DBus (BusName, InterfaceName, IsVariant (fromVariant), MemberName, MethodCall (..), ObjectPath, Type (..), Variant, formatBusName, getSessionAddress, objectPath_, toVariant, variantType) import DBus.Client (Client, ClientError, ClientOptions (..), Interface (..), Reply (..), RequestNameReply (..), clientError, connectWith, defaultClientOptions, defaultInterface, disconnect, emit, export, makeMethod, nameDoNotQueue, requestName, unexport) import DBus.Internal.Message (Signal (..)) import DBus.Internal.Types (Atom (AtomText), Signature (..), Value (ValueMap), Variant (Variant))@@ -42,7 +47,7 @@ import System.IO.Temp (withSystemTempDirectory, withSystemTempFile) import System.Posix (Fd, OpenMode (..), closeFd, defaultFileFlags, handleToFd, openFd) import System.Process (StdStream (..), createProcess, proc, std_out, terminateProcess)-import Test.Hspec.Expectations (Selector)+import Test.Hspec.Expectations (Expectation, HasCallStack, Selector, shouldSatisfy)  data TestHandle = TestHandle   { serverClient :: Client,@@ -280,3 +285,32 @@ withTempDirectoryFilePath :: (FilePath -> IO ()) -> IO () withTempDirectoryFilePath =   withSystemTempDirectory "haskell-desktop-portal"++shouldSatisfyList :: (HasCallStack, Show a) => [a] -> [a -> Bool] -> Expectation+shouldSatisfyList xs predicates = shouldSatisfy xs predicate+  where+    predicate xs' =+      length predicates == length xs'+        && and (zipWith ($) predicates xs')++-- We send a Fd to DBUS and check that the receiving test portal server end gets it,+-- but the Fd actually received will be a different value, since it gets duplicated+-- as it traverses the Unix sockets: test portal client -> DBUS -> test portal server+isDifferentUnixFd :: Fd -> Variant -> Bool+isDifferentUnixFd fd = \case+  (fromVariant -> Just fd') -> fd' /= fd+  _ -> False++isDifferentUnixFds :: [Fd] -> Variant -> Bool+isDifferentUnixFds fds = \case+  (fromVariant -> Just fds') ->+    length fds' == length fds && and (zipWith (/=) fds' fds)+  _ -> False++isUnixFd :: Variant -> Bool+isUnixFd v = variantType v == TypeUnixFd++isUnixFds :: Int -> Variant -> Bool+isUnixFds n v+  | Just (fds :: [Fd]) <- fromVariant v, length fds == n = True+  | otherwise = False