module System.Taffybar.Test.DBusSpec
  ( spec
  -- * Start private D-Busses for testing
  , withTestDBus
  , withTestDBusInDir
  , Bus(..)
  , withDBusDaemon_
  , withConnectDBusDaemon
  , withConnectDBusDaemon'
  -- ** Using the private D-Bus
  , setDBusEnv
  , withBusEnv
  -- ** @python-dbusmock@ Services
  , withPythonDBusMock
  , withTaffyMocks
  -- * Utils
  , withMatch
  , withClient
  ) where

import Control.Monad (forM_, void, when)
import Control.Monad.IO.Unlift (MonadUnliftIO (..))
import Data.ByteString.Char8 qualified as B8
import Data.Function ((&))
import Data.List (sort)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Int (Int64)
import DBus
import DBus.Client
import Test.Hspec
import System.FilePath ((</>), (<.>), takeFileName)
import System.IO (hGetLine, hClose)
import System.Process.Typed
import System.Taffybar.Test.UtilSpec (withSetEnv, logSetup, specLog, withService, getSpecLogPriority, setServiceDefaults, laxTimeout')
import UnliftIO.Directory (makeAbsolute, createDirectoryIfMissing, createFileLink)
import UnliftIO.Temporary (withSystemTempDirectory)
import UnliftIO.Exception (bracket, throwString, finally, throwIO)
import UnliftIO.MVar qualified as MV

-- | Uses 'withDBusDaemon_' to provide both a private session bus and
-- a private system bus while the given action is running.
--
-- The @DBUS_SESSION_BUS_ADDRESS@ and @DBUS_SYSTEM_BUS_ADDRESS@
-- environment variables will be set to point to socket files within
-- the given directory.
--
-- Files in the directory will be left behind after this function
-- returns.
--
-- __Note__: Environment variables are global to the process, so be
-- careful using this with 'parallel' unit tests.
withTestDBusInDir
  :: FilePath -- ^ Directory for config files and sockets.
  -> IO a -> IO a
withTestDBusInDir :: forall a. [Char] -> IO a -> IO a
withTestDBusInDir [Char]
socketDir
  = Bus -> [Char] -> IO a -> IO a
forall a. Bus -> [Char] -> IO a -> IO a
withDBusDaemon_ Bus
System [Char]
socketDir
  (IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bus -> [Char] -> IO a -> IO a
forall a. Bus -> [Char] -> IO a -> IO a
withDBusDaemon_ Bus
Session [Char]
socketDir

-- | Same as 'withTestDBusInDir', except that it creates and removes the
-- temporary directory for you.
withTestDBus :: IO a -> IO a
withTestDBus :: forall a. IO a -> IO a
withTestDBus = [Char] -> ([Char] -> IO a) -> IO a
forall (m :: * -> *) a.
MonadUnliftIO m =>
[Char] -> ([Char] -> m a) -> m a
withSystemTempDirectory [Char]
"dbus-spec" (([Char] -> IO a) -> IO a)
-> (IO a -> [Char] -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> IO a -> IO a) -> IO a -> [Char] -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> IO a -> IO a
forall a. [Char] -> IO a -> IO a
withTestDBusInDir

data Bus = Session | System deriving (Int -> Bus -> ShowS
[Bus] -> ShowS
Bus -> [Char]
(Int -> Bus -> ShowS)
-> (Bus -> [Char]) -> ([Bus] -> ShowS) -> Show Bus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bus -> ShowS
showsPrec :: Int -> Bus -> ShowS
$cshow :: Bus -> [Char]
show :: Bus -> [Char]
$cshowList :: [Bus] -> ShowS
showList :: [Bus] -> ShowS
Show, ReadPrec [Bus]
ReadPrec Bus
Int -> ReadS Bus
ReadS [Bus]
(Int -> ReadS Bus)
-> ReadS [Bus] -> ReadPrec Bus -> ReadPrec [Bus] -> Read Bus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Bus
readsPrec :: Int -> ReadS Bus
$creadList :: ReadS [Bus]
readList :: ReadS [Bus]
$creadPrec :: ReadPrec Bus
readPrec :: ReadPrec Bus
$creadListPrec :: ReadPrec [Bus]
readListPrec :: ReadPrec [Bus]
Read, Bus -> Bus -> Bool
(Bus -> Bus -> Bool) -> (Bus -> Bus -> Bool) -> Eq Bus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bus -> Bus -> Bool
== :: Bus -> Bus -> Bool
$c/= :: Bus -> Bus -> Bool
/= :: Bus -> Bus -> Bool
Eq, Int -> Bus
Bus -> Int
Bus -> [Bus]
Bus -> Bus
Bus -> Bus -> [Bus]
Bus -> Bus -> Bus -> [Bus]
(Bus -> Bus)
-> (Bus -> Bus)
-> (Int -> Bus)
-> (Bus -> Int)
-> (Bus -> [Bus])
-> (Bus -> Bus -> [Bus])
-> (Bus -> Bus -> [Bus])
-> (Bus -> Bus -> Bus -> [Bus])
-> Enum Bus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Bus -> Bus
succ :: Bus -> Bus
$cpred :: Bus -> Bus
pred :: Bus -> Bus
$ctoEnum :: Int -> Bus
toEnum :: Int -> Bus
$cfromEnum :: Bus -> Int
fromEnum :: Bus -> Int
$cenumFrom :: Bus -> [Bus]
enumFrom :: Bus -> [Bus]
$cenumFromThen :: Bus -> Bus -> [Bus]
enumFromThen :: Bus -> Bus -> [Bus]
$cenumFromTo :: Bus -> Bus -> [Bus]
enumFromTo :: Bus -> Bus -> [Bus]
$cenumFromThenTo :: Bus -> Bus -> Bus -> [Bus]
enumFromThenTo :: Bus -> Bus -> Bus -> [Bus]
Enum)

busName :: Bus -> String
busName :: Bus -> [Char]
busName Bus
Session = [Char]
"session"
busName Bus
System = [Char]
"system"

busArg :: Bus -> String
busArg :: Bus -> [Char]
busArg = ([Char]
"--" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Bus -> [Char]) -> Bus -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bus -> [Char]
busName

envName :: Bus -> String
envName :: Bus -> [Char]
envName Bus
Session = [Char]
"DBUS_SESSION_BUS_ADDRESS"
envName Bus
System = [Char]
"DBUS_SYSTEM_BUS_ADDRESS"

busEnv :: Bus -> Address -> (String, String)
busEnv :: Bus -> Address -> ([Char], [Char])
busEnv Bus
bus Address
addr = (Bus -> [Char]
envName Bus
bus, Address -> [Char]
formatAddress Address
addr)

-- | Adjust a 'ProcessConfig' so that the child process will use the
-- given D-Bus address.
setDBusEnv :: Bus -> Address -> ProcessConfig i o e -> ProcessConfig i o e
setDBusEnv :: forall i o e.
Bus -> Address -> ProcessConfig i o e -> ProcessConfig i o e
setDBusEnv Bus
bus Address
addr = [([Char], [Char])] -> ProcessConfig i o e -> ProcessConfig i o e
forall stdin stdout stderr.
[([Char], [Char])]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [Bus -> Address -> ([Char], [Char])
busEnv Bus
bus Address
addr]

withDBusDaemon :: Bus -> FilePath -> (Address -> IO a) -> IO a
withDBusDaemon :: forall a. Bus -> [Char] -> (Address -> IO a) -> IO a
withDBusDaemon Bus
bus [Char]
socketDir Address -> IO a
action = do
  cfg <- [Char] -> Priority -> ProcessConfig () Handle ()
makeDBusDaemon ([Char] -> Priority -> ProcessConfig () Handle ())
-> IO [Char] -> IO (Priority -> ProcessConfig () Handle ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bus -> [Char] -> IO [Char]
setupBusDir Bus
bus [Char]
socketDir IO (Priority -> ProcessConfig () Handle ())
-> IO Priority -> IO (ProcessConfig () Handle ())
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Priority
forall (m :: * -> *). MonadIO m => m Priority
getSpecLogPriority
  specLog $ "withDBusDaemon " ++ show bus ++ " running: " ++ show cfg
  withService cfg $ \Process () Handle ()
p -> Handle -> IO Address
consumeAddress (Process () Handle () -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process () Handle ()
p) IO Address -> (Address -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Address -> IO a
action
  where
    consumeAddress :: Handle -> IO Address
consumeAddress Handle
h = (Maybe Address -> IO Address
forall {a}. Maybe a -> IO a
just (Maybe Address -> IO Address)
-> ([Char] -> Maybe Address) -> [Char] -> IO Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe Address
parseAddress ([Char] -> IO Address) -> IO [Char] -> IO Address
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO [Char]
hGetLine Handle
h) IO Address -> Expectation -> IO Address
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`finally` Handle -> Expectation
hClose Handle
h
    just :: Maybe a -> IO a
just = IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> IO a
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString [Char]
"Could not parse address from dbus-daemon") a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    makeDBusDaemon :: [Char] -> Priority -> ProcessConfig () Handle ()
makeDBusDaemon [Char]
configFile Priority
logLevel =
      [Char] -> [[Char]] -> ProcessConfig () () ()
proc [Char]
"dbus-daemon" [[Char]
"--print-address", [Char]
"--config-file", [Char]
configFile]
        ProcessConfig () () ()
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
forall a b. a -> (a -> b) -> b
& Priority -> ProcessConfig () () () -> ProcessConfig () () ()
forall i o e.
Priority -> ProcessConfig i o e -> ProcessConfig () () ()
setServiceDefaults Priority
logLevel ProcessConfig () () ()
-> (ProcessConfig () () () -> ProcessConfig () Handle ())
-> ProcessConfig () Handle ()
forall a b. a -> (a -> b) -> b
& StreamSpec 'STOutput Handle
-> ProcessConfig () () () -> ProcessConfig () Handle ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput Handle
forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe

-- | Start a D-Bus daemon of the given 'Bus' type, and set the
-- corresponding environment variable while running the given action.
--
-- __Note__: Environment variables are global to the process, so be
-- careful using this with 'parallel' unit tests. A safer option could
-- be 'withConnectDBusDaemon'' and 'setBusEnv'.
withDBusDaemon_ :: Bus -> FilePath -> IO a -> IO a
withDBusDaemon_ :: forall a. Bus -> [Char] -> IO a -> IO a
withDBusDaemon_ Bus
bus [Char]
socketDir IO a
action = Bus -> [Char] -> (Address -> IO a) -> IO a
forall a. Bus -> [Char] -> (Address -> IO a) -> IO a
withDBusDaemon Bus
bus [Char]
socketDir ((Address -> IO a) -> IO a) -> (Address -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Address
addr -> Bus -> Address -> IO a -> IO a
forall a. Bus -> Address -> IO a -> IO a
withBusEnv Bus
bus Address
addr IO a
action

-- | Same as 'withDBusDaemon', but it also provides a 'Client'
-- connection.
withConnectDBusDaemon' :: Bus -> FilePath -> (Address -> Client -> IO a) -> IO a
withConnectDBusDaemon' :: forall a. Bus -> [Char] -> (Address -> Client -> IO a) -> IO a
withConnectDBusDaemon' Bus
bus [Char]
socketDir Address -> Client -> IO a
action =
  Bus -> [Char] -> (Address -> IO a) -> IO a
forall a. Bus -> [Char] -> (Address -> IO a) -> IO a
withDBusDaemon Bus
bus [Char]
socketDir ((Address -> IO a) -> IO a) -> (Address -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Address
addr ->
  Address -> (Client -> IO a) -> IO a
forall a. Address -> (Client -> IO a) -> IO a
withClient Address
addr ((Client -> IO a) -> IO a) -> (Client -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Client
c -> Address -> Client -> IO a
action Address
addr Client
c

withConnectDBusDaemon :: Bus -> FilePath -> (Client -> IO a) -> IO a
withConnectDBusDaemon :: forall a. Bus -> [Char] -> (Client -> IO a) -> IO a
withConnectDBusDaemon Bus
bus [Char]
socketDir = Bus -> [Char] -> (Address -> Client -> IO a) -> IO a
forall a. Bus -> [Char] -> (Address -> Client -> IO a) -> IO a
withConnectDBusDaemon' Bus
bus [Char]
socketDir((Address -> Client -> IO a) -> IO a)
-> ((Client -> IO a) -> Address -> Client -> IO a)
-> (Client -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Client -> IO a) -> Address -> Client -> IO a
forall a b. a -> b -> a
const

setupBusDir :: Bus -> FilePath -> IO FilePath
setupBusDir :: Bus -> [Char] -> IO [Char]
setupBusDir Bus
bus [Char]
socketDir = do
  let busDir :: [Char]
busDir = [Char]
socketDir [Char] -> ShowS
</> Bus -> [Char]
busName Bus
bus
      serviceDir :: [Char]
serviceDir = [Char]
busDir [Char] -> ShowS
</> [Char]
"service.d"
      configFile :: [Char]
configFile = [Char]
busDir [Char] -> ShowS
</> [Char]
"config.xml"
  Bool -> [Char] -> Expectation
forall (m :: * -> *). MonadIO m => Bool -> [Char] -> m ()
createDirectoryIfMissing Bool
True [Char]
serviceDir
  [[Char]] -> ([Char] -> Expectation) -> Expectation
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [] (([Char] -> Expectation) -> Expectation)
-> ([Char] -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \[Char]
service ->
    [Char] -> [Char] -> Expectation
forall (m :: * -> *). MonadIO m => [Char] -> [Char] -> m ()
createFileLink [Char]
service ([Char]
serviceDir [Char] -> ShowS
</> ShowS
takeFileName [Char]
service)
  -- createFileLink "/nix/store/ygd600kkc1h3p5dgw9vjm5xnfci43v0k-upower-1.90.4/share/dbus-1/system-services/org.freedesktop.UPower.service" (serviceDir </> "org.freedesktop.UPower.service")

  addr <- [Char] -> IO [Char]
mkAddress ([Char]
socketDir [Char] -> ShowS
</> Bus -> [Char]
busName Bus
bus [Char] -> ShowS
<.> [Char]
"socket")
  writeFile configFile $ unlines
    [ "<!DOCTYPE busconfig PUBLIC \"-//freedesktop//DTD D-Bus Bus Configuration 1.0//EN\" \"http://www.freedesktop.org/standards/dbus/1.0/busconfig.dtd\">"
    , "<busconfig>"
    , "  <type>" ++ busName bus ++ "</type>"
    , "  <keep_umask/>"
    , "  <listen>" ++ addr ++ "</listen>"
    , "  <servicedir>" ++ serviceDir ++ "</servicedir>"
    , "  <policy context=\"default\">"
    , "    <allow send_destination=\"*\" eavesdrop=\"true\"/>"
    , "    <allow eavesdrop=\"true\"/>"
    , "    <allow own=\"*\"/>"
    , "  </policy>"
    , "</busconfig>"
    ]
  pure configFile

mkAddress :: FilePath -> IO String
mkAddress :: [Char] -> IO [Char]
mkAddress = ShowS -> IO [Char] -> IO [Char]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char]
"unix:path=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) (IO [Char] -> IO [Char])
-> ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO [Char]
forall (m :: * -> *). MonadIO m => [Char] -> m [Char]
makeAbsolute

-- | Set the @DBUS_SESSION_BUS_ADDRESS@ or @DBUS_SYSTEM_BUS_ADDRESS@
-- environment variable according to the given bus and address.
--
-- __Note 1__: Environment variables are global to the process, so
-- be careful using this with 'parallel' unit tests.
--
-- __Note 2__. Using a @DBUS_SYSTEM_BUS_ADDRESS@ environment variable to set a
-- custom system bus address is supported by libdbus (therefore
-- python-dbus) and haskell-dbus, but not necessarily other libraries
-- or programs. Notably, systemd hardcodes the system bus address.
withBusEnv :: Bus -> Address -> IO a -> IO a
withBusEnv :: forall a. Bus -> Address -> IO a -> IO a
withBusEnv Bus
bus Address
addr = [([Char], [Char])] -> IO a -> IO a
forall a. [([Char], [Char])] -> IO a -> IO a
withSetEnv [Bus -> Address -> ([Char], [Char])
busEnv Bus
bus Address
addr]

withClient :: Address -> (Client -> IO a) -> IO a
withClient :: forall a. Address -> (Client -> IO a) -> IO a
withClient Address
addr = IO Client -> (Client -> Expectation) -> (Client -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Address -> IO Client
connect Address
addr) Client -> Expectation
disconnect

withMatch :: MonadUnliftIO m => Client -> MatchRule -> (Signal -> m ()) -> m a -> m a
withMatch :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Client -> MatchRule -> (Signal -> m ()) -> m a -> m a
withMatch Client
client MatchRule
rule Signal -> m ()
cb m a
action = ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO SignalHandler
-> (SignalHandler -> Expectation)
-> (SignalHandler -> IO a)
-> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
  (Client -> MatchRule -> (Signal -> Expectation) -> IO SignalHandler
addMatch Client
client MatchRule
rule (m () -> Expectation
forall a. m a -> IO a
run (m () -> Expectation) -> (Signal -> m ()) -> Signal -> Expectation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal -> m ()
cb))
  (Client -> SignalHandler -> Expectation
removeMatch Client
client)
  (IO a -> SignalHandler -> IO a
forall a b. a -> b -> a
const (IO a -> SignalHandler -> IO a) -> IO a -> SignalHandler -> IO a
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run m a
action)

makeBusNameWaiter :: Client -> (BusName -> Bool) -> IO (IO ())
makeBusNameWaiter :: Client -> (BusName -> Bool) -> IO Expectation
makeBusNameWaiter Client
client BusName -> Bool
p = do
  v <- IO (MVar ())
forall (m :: * -> *) a. MonadIO m => m (MVar a)
MV.newEmptyMVar
  h <- MV.newEmptyMVar
  let cb Signal
sig = Signal -> Expectation -> Expectation
forall {f :: * -> *}. Applicative f => Signal -> f () -> f ()
onNameOwnerChanged Signal
sig (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$ do
        hh <- MVar SignalHandler -> IO SignalHandler
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
MV.takeMVar MVar SignalHandler
h
        removeMatch client hh
        MV.putMVar v ()
  MV.putMVar h =<< addMatch client rule cb
  pure (MV.takeMVar v)
  where
    rule :: MatchRule
rule = MatchRule
matchAny { matchMember = Just "NameOwnerChanged"
                    , matchInterface = Just "org.freedesktop.DBus"
                    , matchSender = Just "org.freedesktop.DBus"
                    }
    isMatch :: Variant -> Bool
isMatch = Bool -> (BusName -> Bool) -> Maybe BusName -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False BusName -> Bool
p (Maybe BusName -> Bool)
-> (Variant -> Maybe BusName) -> Variant -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> Maybe BusName
forall a. IsVariant a => Variant -> Maybe a
fromVariant
    isOwned :: Variant -> Bool
isOwned = Bool -> Bool
not (Bool -> Bool) -> (Variant -> Bool) -> Variant -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool) -> (Variant -> [Char]) -> Variant -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe ([Char]
"" :: String) (Maybe [Char] -> [Char])
-> (Variant -> Maybe [Char]) -> Variant -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> Maybe [Char]
forall a. IsVariant a => Variant -> Maybe a
fromVariant

    onNameOwnerChanged :: Signal -> f () -> f ()
onNameOwnerChanged Signal
sig f ()
next = case Signal -> [Variant]
signalBody Signal
sig of
      [Variant
name, Variant
_, Variant
owner] -> Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Variant -> Bool
isMatch Variant
name Bool -> Bool -> Bool
&& Variant -> Bool
isOwned Variant
owner) f ()
next
      [Variant]
_ -> () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Starts up [@python-dbusmock@](https://martinpitt.github.io/python-dbusmock/).
-- The given action will be run once the mock is ready.
withPythonDBusMock
  :: Bus -- ^ @python-dbusmock@ wants to know which bus.
  -> (Address, Client) -- ^ Connection to the 'Bus'
  -> BusName -- ^ Name of mock service.
  -> ObjectPath -- ^ Path of mock service.
  -> InterfaceName -- ^ Interface of mock service.
  -> IO a -> IO a
withPythonDBusMock :: forall a.
Bus
-> (Address, Client)
-> BusName
-> ObjectPath
-> InterfaceName
-> IO a
-> IO a
withPythonDBusMock Bus
bus (Address
addr, Client
client) BusName
name ObjectPath
path InterfaceName
interface IO a
action = do
  waiter <- Client -> (BusName -> Bool) -> IO Expectation
makeBusNameWaiter Client
client (BusName -> BusName -> Bool
forall a. Eq a => a -> a -> Bool
== BusName
name)
  logLevel <- getSpecLogPriority
  withService (cfg & setServiceDefaults logLevel) $ const $
    waiter *> action
  where
    cfg :: ProcessConfig () () ()
cfg = [Char] -> [[Char]] -> ProcessConfig () () ()
proc [Char]
"python3" [[Char]]
args ProcessConfig () () ()
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
forall a b. a -> (a -> b) -> b
& Bus -> Address -> ProcessConfig () () () -> ProcessConfig () () ()
forall i o e.
Bus -> Address -> ProcessConfig i o e -> ProcessConfig i o e
setDBusEnv Bus
bus Address
addr
    args :: [[Char]]
args = [[Char]
"-m", [Char]
"dbusmock", Bus -> [Char]
busArg Bus
bus
           , BusName -> [Char]
formatBusName BusName
name
           , ObjectPath -> [Char]
formatObjectPath ObjectPath
path
           , InterfaceName -> [Char]
formatInterfaceName InterfaceName
interface]

mockAddTemplate :: Client -> BusName -> ObjectPath -> String -> [(String, Variant)] -> IO ()
mockAddTemplate :: Client
-> BusName
-> ObjectPath
-> [Char]
-> [([Char], Variant)]
-> Expectation
mockAddTemplate Client
client BusName
dest ObjectPath
path [Char]
templ [([Char], Variant)]
params = do
  IO MethodReturn -> Expectation
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO MethodReturn -> Expectation) -> IO MethodReturn -> Expectation
forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> IO MethodReturn
call_ Client
client ([Char] -> [([Char], Variant)] -> MethodCall
forall {k} {a} {a}.
(Ord k, IsAtom k, IsValue a, IsVariant a) =>
a -> [(k, a)] -> MethodCall
addTemplate [Char]
templ [([Char], Variant)]
params) { methodCallDestination = Just dest }
  where
    addTemplate :: a -> [(k, a)] -> MethodCall
addTemplate a
t [(k, a)]
p = (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
path InterfaceName
"org.freedesktop.DBus.Mock" MemberName
"AddTemplate")
      { methodCallBody = [toVariant t, toVariant (Map.fromList p)] }

------------------------------------------------------------------------

upName :: BusName
upName :: BusName
upName = BusName
"org.freedesktop.UPower"
upPath, upDisplayDevicePath :: ObjectPath
upPath :: ObjectPath
upPath = ObjectPath
"/org/freedesktop/UPower"
upDisplayDevicePath :: ObjectPath
upDisplayDevicePath = [Char] -> ObjectPath
objectPath_ (ObjectPath -> [Char]
formatObjectPath ObjectPath
upPath [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/devices/DisplayDevice")
upIface, upDeviceIface :: InterfaceName
upIface :: InterfaceName
upIface = InterfaceName
"org.freedesktop.UPower"
upDeviceIface :: InterfaceName
upDeviceIface = [Char] -> InterfaceName
interfaceName_ (InterfaceName -> [Char]
formatInterfaceName InterfaceName
upIface [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".Device")

mockIconName :: String
mockIconName :: [Char]
mockIconName = [Char]
"face-cool-symbolic"

mockUPower :: Client -> IO ()
mockUPower :: Client -> Expectation
mockUPower Client
client = do
  -- oh dbus, so ugly.
  Client
-> BusName
-> ObjectPath
-> [Char]
-> [([Char], Variant)]
-> Expectation
mockAddTemplate Client
client BusName
upName ObjectPath
upPath [Char]
"upower" [([Char]
"OnBattery", Bool -> Variant
forall a. IsVariant a => a -> Variant
toVariant Bool
True)]
  IO MethodReturn -> Expectation
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO MethodReturn -> Expectation) -> IO MethodReturn -> Expectation
forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> IO MethodReturn
call_ Client
client (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
upPath InterfaceName
"org.freedesktop.DBus.Mock" MemberName
"AddAC") { methodCallBody = map toVariant ["mock_AC" :: String, "Mock AC"], methodCallDestination = Just upName }
  IO MethodReturn -> Expectation
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO MethodReturn -> Expectation) -> IO MethodReturn -> Expectation
forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> IO MethodReturn
call_ Client
client (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
upPath InterfaceName
"org.freedesktop.DBus.Mock" MemberName
"AddChargingBattery") { methodCallBody = map toVariant ["mock_BAT" :: String, "Mock Battery"] ++ [toVariant (30.0 :: Double), toVariant (1200 :: Int64)] , methodCallDestination = Just upName }
  IO (Maybe MethodError) -> Expectation
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe MethodError) -> Expectation)
-> IO (Maybe MethodError) -> Expectation
forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> [Char] -> IO (Maybe MethodError)
forall a.
IsValue a =>
Client -> MethodCall -> a -> IO (Maybe MethodError)
setPropertyValue Client
client (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
upDisplayDevicePath InterfaceName
upDeviceIface MemberName
"IconName") { methodCallDestination = Just upName } [Char]
mockIconName

withTaffyMocks :: IO a -> IO a
withTaffyMocks :: forall a. IO a -> IO a
withTaffyMocks IO a
action = do
  maddr <- IO (Maybe Address)
getSystemAddress
  addr <- maybe (throwIO (clientError "getSystemAddress")) pure maddr
  withClient addr $ \Client
client -> do
    Bus
-> (Address, Client)
-> BusName
-> ObjectPath
-> InterfaceName
-> IO a
-> IO a
forall a.
Bus
-> (Address, Client)
-> BusName
-> ObjectPath
-> InterfaceName
-> IO a
-> IO a
withPythonDBusMock Bus
System (Address
addr, Client
client) BusName
upName ObjectPath
upPath InterfaceName
upIface (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
      Client -> Expectation
mockUPower Client
client
      IO a
action

------------------------------------------------------------------------

spec :: Spec
spec :: Spec
spec = Spec -> Spec
forall a. HasCallStack => SpecWith a -> SpecWith a
logSetup (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ (Expectation -> Expectation) -> Spec -> Spec
forall a. (Expectation -> Expectation) -> SpecWith a -> SpecWith a
around_ (Int -> Expectation -> Expectation
forall (m :: * -> *) a.
(HasCallStack, MonadUnliftIO m) =>
Int -> m a -> m a
laxTimeout' Int
1_000_000) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ (([Char] -> Expectation) -> Expectation) -> SpecWith [Char] -> Spec
forall a. (ActionWith a -> Expectation) -> SpecWith a -> Spec
around ([Char] -> ([Char] -> Expectation) -> Expectation
forall (m :: * -> *) a.
MonadUnliftIO m =>
[Char] -> ([Char] -> m a) -> m a
withSystemTempDirectory [Char]
"dbus-spec") (SpecWith [Char] -> Spec) -> SpecWith [Char] -> Spec
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> SpecWith [Char] -> SpecWith [Char]
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"withDBusDaemon org.freedesktop.DBus.Peer.Ping" (SpecWith [Char] -> SpecWith [Char])
-> SpecWith [Char] -> SpecWith [Char]
forall a b. (a -> b) -> a -> b
$ do
    [Bus] -> (Bus -> SpecWith [Char]) -> SpecWith [Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Bus
System, Bus
Session] ((Bus -> SpecWith [Char]) -> SpecWith [Char])
-> (Bus -> SpecWith [Char]) -> SpecWith [Char]
forall a b. (a -> b) -> a -> b
$ \Bus
bus ->
      (((Address, Client) -> Expectation) -> [Char] -> Expectation)
-> SpecWith (Address, Client) -> SpecWith [Char]
forall a b.
(ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
aroundWith (([Char] -> (Address -> Client -> Expectation) -> Expectation)
-> (Address -> Client -> Expectation) -> [Char] -> Expectation
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bus -> [Char] -> (Address -> Client -> Expectation) -> Expectation
forall a. Bus -> [Char] -> (Address -> Client -> IO a) -> IO a
withConnectDBusDaemon' Bus
bus) ((Address -> Client -> Expectation) -> [Char] -> Expectation)
-> (((Address, Client) -> Expectation)
    -> Address -> Client -> Expectation)
-> ((Address, Client) -> Expectation)
-> [Char]
-> Expectation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Address, Client) -> Expectation)
-> Address -> Client -> Expectation
forall a b c. ((a, b) -> c) -> a -> b -> c
curry) (SpecWith (Address, Client) -> SpecWith [Char])
-> SpecWith (Address, Client) -> SpecWith [Char]
forall a b. (a -> b) -> a -> b
$ do
        [Char]
-> ((Address, Client) -> Expectation)
-> SpecWith (Arg ((Address, Client) -> Expectation))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it ([Char]
"can ping private test " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bus -> [Char]
forall a. Show a => a -> [Char]
show Bus
bus [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" bus") (((Address, Client) -> Expectation)
 -> SpecWith (Arg ((Address, Client) -> Expectation)))
-> ((Address, Client) -> Expectation)
-> SpecWith (Arg ((Address, Client) -> Expectation))
forall a b. (a -> b) -> a -> b
$ \(Address
_, Client
client) -> do
          ((MethodReturn -> [Variant])
-> Either MethodError MethodReturn -> Either MethodError [Variant]
forall a b.
(a -> b) -> Either MethodError a -> Either MethodError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MethodReturn -> [Variant]
methodReturnBody (Either MethodError MethodReturn -> Either MethodError [Variant])
-> IO (Either MethodError MethodReturn)
-> IO (Either MethodError [Variant])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Client -> MethodCall -> IO (Either MethodError MethodReturn)
call Client
client MethodCall
ping)
            IO (Either MethodError [Variant])
-> Either MethodError [Variant] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` [Variant] -> Either MethodError [Variant]
forall a b. b -> Either a b
Right []

        [Char]
-> ((Address, Client) -> Expectation)
-> SpecWith (Arg ((Address, Client) -> Expectation))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it ([Char]
"gdbus can ping private test " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bus -> [Char]
forall a. Show a => a -> [Char]
show Bus
bus [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" bus") (((Address, Client) -> Expectation)
 -> SpecWith (Arg ((Address, Client) -> Expectation)))
-> ((Address, Client) -> Expectation)
-> SpecWith (Arg ((Address, Client) -> Expectation))
forall a b. (a -> b) -> a -> b
$ \(Address
addr, Client
_) ->
          ProcessConfig () () () -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ (Bus -> ProcessConfig () () ()
gdbusPing Bus
bus ProcessConfig () () ()
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
forall a b. a -> (a -> b) -> b
& Bus -> Address -> ProcessConfig () () () -> ProcessConfig () () ()
forall i o e.
Bus -> Address -> ProcessConfig i o e -> ProcessConfig i o e
setDBusEnv Bus
bus Address
addr)
            IO ByteString -> ByteString -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` ByteString
"()\n"

  [Bus] -> (Bus -> SpecWith [Char]) -> SpecWith [Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Bus
System] ((Bus -> SpecWith [Char]) -> SpecWith [Char])
-> (Bus -> SpecWith [Char]) -> SpecWith [Char]
forall a b. (a -> b) -> a -> b
$ \Bus
bus ->
    (((Address, Client) -> Expectation) -> [Char] -> Expectation)
-> SpecWith (Address, Client) -> SpecWith [Char]
forall a b.
(ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
aroundWith (([Char] -> (Address -> Client -> Expectation) -> Expectation)
-> (Address -> Client -> Expectation) -> [Char] -> Expectation
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bus -> [Char] -> (Address -> Client -> Expectation) -> Expectation
forall a. Bus -> [Char] -> (Address -> Client -> IO a) -> IO a
withConnectDBusDaemon' Bus
bus) ((Address -> Client -> Expectation) -> [Char] -> Expectation)
-> (((Address, Client) -> Expectation)
    -> Address -> Client -> Expectation)
-> ((Address, Client) -> Expectation)
-> [Char]
-> Expectation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Address, Client) -> Expectation)
-> Address -> Client -> Expectation
forall a b c. ((a, b) -> c) -> a -> b -> c
curry) (SpecWith (Address, Client) -> SpecWith [Char])
-> SpecWith (Address, Client) -> SpecWith [Char]
forall a b. (a -> b) -> a -> b
$
    [Char] -> SpecWith (Address, Client) -> SpecWith (Address, Client)
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char]
"python-dbusmock " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bus -> [Char]
forall a. Show a => a -> [Char]
show Bus
bus [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" services") (SpecWith (Address, Client) -> SpecWith (Address, Client))
-> SpecWith (Address, Client) -> SpecWith (Address, Client)
forall a b. (a -> b) -> a -> b
$ do
      [Char]
-> ((Address, Client) -> Expectation)
-> SpecWith (Arg ((Address, Client) -> Expectation))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"simple" (((Address, Client) -> Expectation)
 -> SpecWith (Arg ((Address, Client) -> Expectation)))
-> ((Address, Client) -> Expectation)
-> SpecWith (Arg ((Address, Client) -> Expectation))
forall a b. (a -> b) -> a -> b
$ \(Address
addr, Client
client) -> Expectation -> Expectation
example (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$
        Bus
-> (Address, Client)
-> BusName
-> ObjectPath
-> InterfaceName
-> Expectation
-> Expectation
forall a.
Bus
-> (Address, Client)
-> BusName
-> ObjectPath
-> InterfaceName
-> IO a
-> IO a
withPythonDBusMock Bus
bus (Address
addr, Client
client) BusName
"com.example.Foo" ObjectPath
"/" InterfaceName
"com.example.Foo.Manager" (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$ () -> Expectation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      [Char]
-> ((Address, Client) -> Expectation)
-> SpecWith (Arg ((Address, Client) -> Expectation))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"UPower" (((Address, Client) -> Expectation)
 -> SpecWith (Arg ((Address, Client) -> Expectation)))
-> ((Address, Client) -> Expectation)
-> SpecWith (Arg ((Address, Client) -> Expectation))
forall a b. (a -> b) -> a -> b
$ \(Address
addr, Client
client) -> Expectation -> Expectation
example (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$ do
        Bus
-> (Address, Client)
-> BusName
-> ObjectPath
-> InterfaceName
-> Expectation
-> Expectation
forall a.
Bus
-> (Address, Client)
-> BusName
-> ObjectPath
-> InterfaceName
-> IO a
-> IO a
withPythonDBusMock Bus
bus (Address
addr, Client
client) BusName
upName ObjectPath
upPath InterfaceName
upIface (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$ do
          Client -> Expectation
mockUPower Client
client
          models <- Address -> IO [[Char]]
upowerDumpModels Address
addr
          sort models `shouldBe` ["Mock AC", "Mock Battery"]

upowerDumpModels :: Address -> IO [String]
upowerDumpModels :: Address -> IO [[Char]]
upowerDumpModels Address
addr = ByteString -> [[Char]]
parse (ByteString -> [[Char]]) -> IO ByteString -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessConfig () () () -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ ProcessConfig () () ()
cfg
  where
    cfg :: ProcessConfig () () ()
cfg = [Char] -> [[Char]] -> ProcessConfig () () ()
proc [Char]
"upower" [[Char]
"--dump"] ProcessConfig () () ()
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
forall a b. a -> (a -> b) -> b
& Bus -> Address -> ProcessConfig () () () -> ProcessConfig () () ()
forall i o e.
Bus -> Address -> ProcessConfig i o e -> ProcessConfig i o e
setDBusEnv Bus
System Address
addr
    parse :: ByteString -> [[Char]]
parse = ((ByteString, ByteString) -> [Char])
-> [(ByteString, ByteString)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> [Char]
B8.unpack (ByteString -> [Char])
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B8.dropSpace (ByteString -> ByteString)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B8.drop Int
1 (ByteString -> ByteString)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd)
      ([(ByteString, ByteString)] -> [[Char]])
-> (ByteString -> [(ByteString, ByteString)])
-> ByteString
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"model") (ByteString -> Bool)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst)
      ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> (ByteString -> [(ByteString, ByteString)])
-> ByteString
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> ByteString -> (ByteString, ByteString)
B8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B8.dropSpace)
      ([ByteString] -> [(ByteString, ByteString)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B8.lines
      (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B8.toStrict

gdbusPing :: Bus -> ProcessConfig () () ()
gdbusPing :: Bus -> ProcessConfig () () ()
gdbusPing Bus
bus = [Char] -> [[Char]] -> ProcessConfig () () ()
proc [Char]
"gdbus" [[Char]
"call", [Char]
"--" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bus -> [Char]
busName Bus
bus, [Char]
"--dest", [Char]
"org.freedesktop.DBus", [Char]
"--object-path", [Char]
"/org/freedesktop/DBus", [Char]
"--method", [Char]
"org.freedesktop.DBus.Peer.Ping"]

ping :: MethodCall
ping :: MethodCall
ping = (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
"/org/freedesktop/DBus" InterfaceName
"org.freedesktop.DBus.Peer" MemberName
"Ping")
  { methodCallDestination = Just "org.freedesktop.DBus" }