{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Objects.DBusServer.DBusServer' is a helper for listening to and accepting D-Bus
-- connections. This can be used to create a new D-Bus server, allowing two
-- peers to use the D-Bus protocol for their own specialized communication.
-- A server instance provided in this way will not perform message routing or
-- implement the org.freedesktop.DBus interface.
-- 
-- To just export an object on a well-known name on a message bus, such as the
-- session or system bus, you should instead use @/g_bus_own_name()/@.
-- 
-- An example of peer-to-peer communication with GDBus can be found
-- in <https://gitlab.gnome.org/GNOME/glib/-/blob/HEAD/gio/tests/gdbus-example-peer.c gdbus-example-peer.c>.
-- 
-- Note that a minimal t'GI.Gio.Objects.DBusServer.DBusServer' will accept connections from any
-- peer. In many use-cases it will be necessary to add a t'GI.Gio.Objects.DBusAuthObserver.DBusAuthObserver'
-- that only accepts connections that have successfully authenticated
-- as the same user that is running the t'GI.Gio.Objects.DBusServer.DBusServer'. Since GLib 2.68 this can
-- be achieved more simply by passing the
-- 'GI.Gio.Flags.DBusServerFlagsAuthenticationRequireSameUser' flag to the server.
-- 
-- /Since: 2.26/

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gio.Objects.DBusServer
    ( 

-- * Exported types
    DBusServer(..)                          ,
    IsDBusServer                            ,
    toDBusServer                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [init]("GI.Gio.Interfaces.Initable#g:method:init"), [isActive]("GI.Gio.Objects.DBusServer#g:method:isActive"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [start]("GI.Gio.Objects.DBusServer#g:method:start"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [stop]("GI.Gio.Objects.DBusServer#g:method:stop"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getClientAddress]("GI.Gio.Objects.DBusServer#g:method:getClientAddress"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFlags]("GI.Gio.Objects.DBusServer#g:method:getFlags"), [getGuid]("GI.Gio.Objects.DBusServer#g:method:getGuid"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDBusServerMethod                 ,
#endif

-- ** getClientAddress #method:getClientAddress#

#if defined(ENABLE_OVERLOADING)
    DBusServerGetClientAddressMethodInfo    ,
#endif
    dBusServerGetClientAddress              ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    DBusServerGetFlagsMethodInfo            ,
#endif
    dBusServerGetFlags                      ,


-- ** getGuid #method:getGuid#

#if defined(ENABLE_OVERLOADING)
    DBusServerGetGuidMethodInfo             ,
#endif
    dBusServerGetGuid                       ,


-- ** isActive #method:isActive#

#if defined(ENABLE_OVERLOADING)
    DBusServerIsActiveMethodInfo            ,
#endif
    dBusServerIsActive                      ,


-- ** newSync #method:newSync#

    dBusServerNewSync                       ,


-- ** start #method:start#

#if defined(ENABLE_OVERLOADING)
    DBusServerStartMethodInfo               ,
#endif
    dBusServerStart                         ,


-- ** stop #method:stop#

#if defined(ENABLE_OVERLOADING)
    DBusServerStopMethodInfo                ,
#endif
    dBusServerStop                          ,




 -- * Properties


-- ** active #attr:active#
-- | Whether the server is currently active.
-- 
-- /Since: 2.26/

#if defined(ENABLE_OVERLOADING)
    DBusServerActivePropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    dBusServerActive                        ,
#endif
    getDBusServerActive                     ,


-- ** address #attr:address#
-- | The D-Bus address to listen on.
-- 
-- /Since: 2.26/

#if defined(ENABLE_OVERLOADING)
    DBusServerAddressPropertyInfo           ,
#endif
    constructDBusServerAddress              ,
#if defined(ENABLE_OVERLOADING)
    dBusServerAddress                       ,
#endif
    getDBusServerAddress                    ,


-- ** authenticationObserver #attr:authenticationObserver#
-- | A t'GI.Gio.Objects.DBusAuthObserver.DBusAuthObserver' object to assist in the authentication process or 'P.Nothing'.
-- 
-- /Since: 2.26/

#if defined(ENABLE_OVERLOADING)
    DBusServerAuthenticationObserverPropertyInfo,
#endif
    constructDBusServerAuthenticationObserver,
#if defined(ENABLE_OVERLOADING)
    dBusServerAuthenticationObserver        ,
#endif
    getDBusServerAuthenticationObserver     ,


-- ** clientAddress #attr:clientAddress#
-- | The D-Bus address that clients can use.
-- 
-- /Since: 2.26/

#if defined(ENABLE_OVERLOADING)
    DBusServerClientAddressPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    dBusServerClientAddress                 ,
#endif
    getDBusServerClientAddress              ,


-- ** flags #attr:flags#
-- | Flags from the t'GI.Gio.Flags.DBusServerFlags' enumeration.
-- 
-- /Since: 2.26/

#if defined(ENABLE_OVERLOADING)
    DBusServerFlagsPropertyInfo             ,
#endif
    constructDBusServerFlags                ,
#if defined(ENABLE_OVERLOADING)
    dBusServerFlags                         ,
#endif
    getDBusServerFlags                      ,


-- ** guid #attr:guid#
-- | The GUID of the server.
-- 
-- See [DBusConnection:guid]("GI.Gio.Objects.DBusConnection#g:attr:guid") for more details.
-- 
-- /Since: 2.26/

#if defined(ENABLE_OVERLOADING)
    DBusServerGuidPropertyInfo              ,
#endif
    constructDBusServerGuid                 ,
#if defined(ENABLE_OVERLOADING)
    dBusServerGuid                          ,
#endif
    getDBusServerGuid                       ,




 -- * Signals


-- ** newConnection #signal:newConnection#

    DBusServerNewConnectionCallback         ,
#if defined(ENABLE_OVERLOADING)
    DBusServerNewConnectionSignalInfo       ,
#endif
    afterDBusServerNewConnection            ,
    onDBusServerNewConnection               ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Initable as Gio.Initable
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusAuthObserver as Gio.DBusAuthObserver
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection

-- | Memory-managed wrapper type.
newtype DBusServer = DBusServer (SP.ManagedPtr DBusServer)
    deriving (DBusServer -> DBusServer -> Bool
(DBusServer -> DBusServer -> Bool)
-> (DBusServer -> DBusServer -> Bool) -> Eq DBusServer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DBusServer -> DBusServer -> Bool
$c/= :: DBusServer -> DBusServer -> Bool
== :: DBusServer -> DBusServer -> Bool
$c== :: DBusServer -> DBusServer -> Bool
Eq)

instance SP.ManagedPtrNewtype DBusServer where
    toManagedPtr :: DBusServer -> ManagedPtr DBusServer
toManagedPtr (DBusServer ManagedPtr DBusServer
p) = ManagedPtr DBusServer
p

foreign import ccall "g_dbus_server_get_type"
    c_g_dbus_server_get_type :: IO B.Types.GType

instance B.Types.TypedObject DBusServer where
    glibType :: IO GType
glibType = IO GType
c_g_dbus_server_get_type

instance B.Types.GObject DBusServer

-- | Type class for types which can be safely cast to `DBusServer`, for instance with `toDBusServer`.
class (SP.GObject o, O.IsDescendantOf DBusServer o) => IsDBusServer o
instance (SP.GObject o, O.IsDescendantOf DBusServer o) => IsDBusServer o

instance O.HasParentTypes DBusServer
type instance O.ParentTypes DBusServer = '[GObject.Object.Object, Gio.Initable.Initable]

-- | Cast to `DBusServer`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toDBusServer :: (MIO.MonadIO m, IsDBusServer o) => o -> m DBusServer
toDBusServer :: forall (m :: * -> *) o.
(MonadIO m, IsDBusServer o) =>
o -> m DBusServer
toDBusServer = IO DBusServer -> m DBusServer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO DBusServer -> m DBusServer)
-> (o -> IO DBusServer) -> o -> m DBusServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr DBusServer -> DBusServer) -> o -> IO DBusServer
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr DBusServer -> DBusServer
DBusServer

-- | Convert 'DBusServer' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe DBusServer) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_dbus_server_get_type
    gvalueSet_ :: Ptr GValue -> Maybe DBusServer -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DBusServer
P.Nothing = Ptr GValue -> Ptr DBusServer -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr DBusServer
forall a. Ptr a
FP.nullPtr :: FP.Ptr DBusServer)
    gvalueSet_ Ptr GValue
gv (P.Just DBusServer
obj) = DBusServer -> (Ptr DBusServer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DBusServer
obj (Ptr GValue -> Ptr DBusServer -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe DBusServer)
gvalueGet_ Ptr GValue
gv = do
        Ptr DBusServer
ptr <- Ptr GValue -> IO (Ptr DBusServer)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr DBusServer)
        if Ptr DBusServer
ptr Ptr DBusServer -> Ptr DBusServer -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DBusServer
forall a. Ptr a
FP.nullPtr
        then DBusServer -> Maybe DBusServer
forall a. a -> Maybe a
P.Just (DBusServer -> Maybe DBusServer)
-> IO DBusServer -> IO (Maybe DBusServer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DBusServer -> DBusServer)
-> Ptr DBusServer -> IO DBusServer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DBusServer -> DBusServer
DBusServer Ptr DBusServer
ptr
        else Maybe DBusServer -> IO (Maybe DBusServer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DBusServer
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveDBusServerMethod (t :: Symbol) (o :: *) :: * where
    ResolveDBusServerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDBusServerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDBusServerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDBusServerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDBusServerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDBusServerMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveDBusServerMethod "isActive" o = DBusServerIsActiveMethodInfo
    ResolveDBusServerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDBusServerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDBusServerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDBusServerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDBusServerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDBusServerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDBusServerMethod "start" o = DBusServerStartMethodInfo
    ResolveDBusServerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDBusServerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDBusServerMethod "stop" o = DBusServerStopMethodInfo
    ResolveDBusServerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDBusServerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDBusServerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDBusServerMethod "getClientAddress" o = DBusServerGetClientAddressMethodInfo
    ResolveDBusServerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDBusServerMethod "getFlags" o = DBusServerGetFlagsMethodInfo
    ResolveDBusServerMethod "getGuid" o = DBusServerGetGuidMethodInfo
    ResolveDBusServerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDBusServerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDBusServerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDBusServerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDBusServerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDBusServerMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDBusServerMethod t DBusServer, O.OverloadedMethod info DBusServer p) => OL.IsLabel t (DBusServer -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveDBusServerMethod t DBusServer, O.OverloadedMethod info DBusServer p, R.HasField t DBusServer p) => R.HasField t DBusServer p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveDBusServerMethod t DBusServer, O.OverloadedMethodInfo info DBusServer) => OL.IsLabel t (O.MethodProxy info DBusServer) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal DBusServer::new-connection
-- | Emitted when a new authenticated connection has been made. Use
-- 'GI.Gio.Objects.DBusConnection.dBusConnectionGetPeerCredentials' to figure out what
-- identity (if any), was authenticated.
-- 
-- If you want to accept the connection, take a reference to the
-- /@connection@/ object and return 'P.True'. When you are done with the
-- connection call 'GI.Gio.Objects.DBusConnection.dBusConnectionClose' and give up your
-- reference. Note that the other peer may disconnect at any time -
-- a typical thing to do when accepting a connection is to listen to
-- the [DBusConnection::closed]("GI.Gio.Objects.DBusConnection#g:signal:closed") signal.
-- 
-- If [DBusServer:flags]("GI.Gio.Objects.DBusServer#g:attr:flags") contains 'GI.Gio.Flags.DBusServerFlagsRunInThread'
-- then the signal is emitted in a new thread dedicated to the
-- connection. Otherwise the signal is emitted in the
-- [thread-default main context][g-main-context-push-thread-default]
-- of the thread that /@server@/ was constructed in.
-- 
-- You are guaranteed that signal handlers for this signal runs
-- before incoming messages on /@connection@/ are processed. This means
-- that it\'s suitable to call @/g_dbus_connection_register_object()/@ or
-- similar from the signal handler.
-- 
-- /Since: 2.26/
type DBusServerNewConnectionCallback =
    Gio.DBusConnection.DBusConnection
    -- ^ /@connection@/: A t'GI.Gio.Objects.DBusConnection.DBusConnection' for the new connection.
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to claim /@connection@/, 'P.False' to let other handlers
    -- run.

type C_DBusServerNewConnectionCallback =
    Ptr DBusServer ->                       -- object
    Ptr Gio.DBusConnection.DBusConnection ->
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_DBusServerNewConnectionCallback`.
foreign import ccall "wrapper"
    mk_DBusServerNewConnectionCallback :: C_DBusServerNewConnectionCallback -> IO (FunPtr C_DBusServerNewConnectionCallback)

wrap_DBusServerNewConnectionCallback :: 
    GObject a => (a -> DBusServerNewConnectionCallback) ->
    C_DBusServerNewConnectionCallback
wrap_DBusServerNewConnectionCallback :: forall a.
GObject a =>
(a -> DBusServerNewConnectionCallback)
-> C_DBusServerNewConnectionCallback
wrap_DBusServerNewConnectionCallback a -> DBusServerNewConnectionCallback
gi'cb Ptr DBusServer
gi'selfPtr Ptr DBusConnection
connection Ptr ()
_ = do
    DBusConnection
connection' <- ((ManagedPtr DBusConnection -> DBusConnection)
-> Ptr DBusConnection -> IO DBusConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusConnection -> DBusConnection
Gio.DBusConnection.DBusConnection) Ptr DBusConnection
connection
    Bool
result <- Ptr DBusServer -> (DBusServer -> IO Bool) -> IO Bool
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DBusServer
gi'selfPtr ((DBusServer -> IO Bool) -> IO Bool)
-> (DBusServer -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \DBusServer
gi'self -> a -> DBusServerNewConnectionCallback
gi'cb (DBusServer -> a
Coerce.coerce DBusServer
gi'self)  DBusConnection
connection'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [newConnection](#signal:newConnection) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' dBusServer #newConnection callback
-- @
-- 
-- 
onDBusServerNewConnection :: (IsDBusServer a, MonadIO m) => a -> ((?self :: a) => DBusServerNewConnectionCallback) -> m SignalHandlerId
onDBusServerNewConnection :: forall a (m :: * -> *).
(IsDBusServer a, MonadIO m) =>
a
-> ((?self::a) => DBusServerNewConnectionCallback)
-> m SignalHandlerId
onDBusServerNewConnection a
obj (?self::a) => DBusServerNewConnectionCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DBusServerNewConnectionCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusServerNewConnectionCallback
DBusServerNewConnectionCallback
cb
    let wrapped' :: C_DBusServerNewConnectionCallback
wrapped' = (a -> DBusServerNewConnectionCallback)
-> C_DBusServerNewConnectionCallback
forall a.
GObject a =>
(a -> DBusServerNewConnectionCallback)
-> C_DBusServerNewConnectionCallback
wrap_DBusServerNewConnectionCallback a -> DBusServerNewConnectionCallback
wrapped
    FunPtr C_DBusServerNewConnectionCallback
wrapped'' <- C_DBusServerNewConnectionCallback
-> IO (FunPtr C_DBusServerNewConnectionCallback)
mk_DBusServerNewConnectionCallback C_DBusServerNewConnectionCallback
wrapped'
    a
-> Text
-> FunPtr C_DBusServerNewConnectionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"new-connection" FunPtr C_DBusServerNewConnectionCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [newConnection](#signal:newConnection) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' dBusServer #newConnection callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterDBusServerNewConnection :: (IsDBusServer a, MonadIO m) => a -> ((?self :: a) => DBusServerNewConnectionCallback) -> m SignalHandlerId
afterDBusServerNewConnection :: forall a (m :: * -> *).
(IsDBusServer a, MonadIO m) =>
a
-> ((?self::a) => DBusServerNewConnectionCallback)
-> m SignalHandlerId
afterDBusServerNewConnection a
obj (?self::a) => DBusServerNewConnectionCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DBusServerNewConnectionCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusServerNewConnectionCallback
DBusServerNewConnectionCallback
cb
    let wrapped' :: C_DBusServerNewConnectionCallback
wrapped' = (a -> DBusServerNewConnectionCallback)
-> C_DBusServerNewConnectionCallback
forall a.
GObject a =>
(a -> DBusServerNewConnectionCallback)
-> C_DBusServerNewConnectionCallback
wrap_DBusServerNewConnectionCallback a -> DBusServerNewConnectionCallback
wrapped
    FunPtr C_DBusServerNewConnectionCallback
wrapped'' <- C_DBusServerNewConnectionCallback
-> IO (FunPtr C_DBusServerNewConnectionCallback)
mk_DBusServerNewConnectionCallback C_DBusServerNewConnectionCallback
wrapped'
    a
-> Text
-> FunPtr C_DBusServerNewConnectionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"new-connection" FunPtr C_DBusServerNewConnectionCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DBusServerNewConnectionSignalInfo
instance SignalInfo DBusServerNewConnectionSignalInfo where
    type HaskellCallbackType DBusServerNewConnectionSignalInfo = DBusServerNewConnectionCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DBusServerNewConnectionCallback cb
        cb'' <- mk_DBusServerNewConnectionCallback cb'
        connectSignalFunPtr obj "new-connection" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer::new-connection"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#g:signal:newConnection"})

#endif

-- VVV Prop "active"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@active@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusServer #active
-- @
getDBusServerActive :: (MonadIO m, IsDBusServer o) => o -> m Bool
getDBusServerActive :: forall (m :: * -> *) o. (MonadIO m, IsDBusServer o) => o -> m Bool
getDBusServerActive o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"active"

#if defined(ENABLE_OVERLOADING)
data DBusServerActivePropertyInfo
instance AttrInfo DBusServerActivePropertyInfo where
    type AttrAllowedOps DBusServerActivePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DBusServerActivePropertyInfo = IsDBusServer
    type AttrSetTypeConstraint DBusServerActivePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DBusServerActivePropertyInfo = (~) ()
    type AttrTransferType DBusServerActivePropertyInfo = ()
    type AttrGetType DBusServerActivePropertyInfo = Bool
    type AttrLabel DBusServerActivePropertyInfo = "active"
    type AttrOrigin DBusServerActivePropertyInfo = DBusServer
    attrGet = getDBusServerActive
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.active"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#g:attr:active"
        })
#endif

-- VVV Prop "address"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@address@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusServer #address
-- @
getDBusServerAddress :: (MonadIO m, IsDBusServer o) => o -> m (Maybe T.Text)
getDBusServerAddress :: forall (m :: * -> *) o.
(MonadIO m, IsDBusServer o) =>
o -> m (Maybe Text)
getDBusServerAddress o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"address"

-- | Construct a `GValueConstruct` with valid value for the “@address@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusServerAddress :: (IsDBusServer o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDBusServerAddress :: forall o (m :: * -> *).
(IsDBusServer o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDBusServerAddress Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"address" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DBusServerAddressPropertyInfo
instance AttrInfo DBusServerAddressPropertyInfo where
    type AttrAllowedOps DBusServerAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DBusServerAddressPropertyInfo = IsDBusServer
    type AttrSetTypeConstraint DBusServerAddressPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DBusServerAddressPropertyInfo = (~) T.Text
    type AttrTransferType DBusServerAddressPropertyInfo = T.Text
    type AttrGetType DBusServerAddressPropertyInfo = (Maybe T.Text)
    type AttrLabel DBusServerAddressPropertyInfo = "address"
    type AttrOrigin DBusServerAddressPropertyInfo = DBusServer
    attrGet = getDBusServerAddress
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusServerAddress
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.address"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#g:attr:address"
        })
#endif

-- VVV Prop "authentication-observer"
   -- Type: TInterface (Name {namespace = "Gio", name = "DBusAuthObserver"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@authentication-observer@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusServer #authenticationObserver
-- @
getDBusServerAuthenticationObserver :: (MonadIO m, IsDBusServer o) => o -> m (Maybe Gio.DBusAuthObserver.DBusAuthObserver)
getDBusServerAuthenticationObserver :: forall (m :: * -> *) o.
(MonadIO m, IsDBusServer o) =>
o -> m (Maybe DBusAuthObserver)
getDBusServerAuthenticationObserver o
obj = IO (Maybe DBusAuthObserver) -> m (Maybe DBusAuthObserver)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe DBusAuthObserver) -> m (Maybe DBusAuthObserver))
-> IO (Maybe DBusAuthObserver) -> m (Maybe DBusAuthObserver)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr DBusAuthObserver -> DBusAuthObserver)
-> IO (Maybe DBusAuthObserver)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"authentication-observer" ManagedPtr DBusAuthObserver -> DBusAuthObserver
Gio.DBusAuthObserver.DBusAuthObserver

-- | Construct a `GValueConstruct` with valid value for the “@authentication-observer@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusServerAuthenticationObserver :: (IsDBusServer o, MIO.MonadIO m, Gio.DBusAuthObserver.IsDBusAuthObserver a) => a -> m (GValueConstruct o)
constructDBusServerAuthenticationObserver :: forall o (m :: * -> *) a.
(IsDBusServer o, MonadIO m, IsDBusAuthObserver a) =>
a -> m (GValueConstruct o)
constructDBusServerAuthenticationObserver a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"authentication-observer" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data DBusServerAuthenticationObserverPropertyInfo
instance AttrInfo DBusServerAuthenticationObserverPropertyInfo where
    type AttrAllowedOps DBusServerAuthenticationObserverPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DBusServerAuthenticationObserverPropertyInfo = IsDBusServer
    type AttrSetTypeConstraint DBusServerAuthenticationObserverPropertyInfo = Gio.DBusAuthObserver.IsDBusAuthObserver
    type AttrTransferTypeConstraint DBusServerAuthenticationObserverPropertyInfo = Gio.DBusAuthObserver.IsDBusAuthObserver
    type AttrTransferType DBusServerAuthenticationObserverPropertyInfo = Gio.DBusAuthObserver.DBusAuthObserver
    type AttrGetType DBusServerAuthenticationObserverPropertyInfo = (Maybe Gio.DBusAuthObserver.DBusAuthObserver)
    type AttrLabel DBusServerAuthenticationObserverPropertyInfo = "authentication-observer"
    type AttrOrigin DBusServerAuthenticationObserverPropertyInfo = DBusServer
    attrGet = getDBusServerAuthenticationObserver
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.DBusAuthObserver.DBusAuthObserver v
    attrConstruct = constructDBusServerAuthenticationObserver
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.authenticationObserver"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#g:attr:authenticationObserver"
        })
#endif

-- VVV Prop "client-address"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@client-address@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusServer #clientAddress
-- @
getDBusServerClientAddress :: (MonadIO m, IsDBusServer o) => o -> m T.Text
getDBusServerClientAddress :: forall (m :: * -> *) o. (MonadIO m, IsDBusServer o) => o -> m Text
getDBusServerClientAddress o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getDBusServerClientAddress" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"client-address"

#if defined(ENABLE_OVERLOADING)
data DBusServerClientAddressPropertyInfo
instance AttrInfo DBusServerClientAddressPropertyInfo where
    type AttrAllowedOps DBusServerClientAddressPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DBusServerClientAddressPropertyInfo = IsDBusServer
    type AttrSetTypeConstraint DBusServerClientAddressPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DBusServerClientAddressPropertyInfo = (~) ()
    type AttrTransferType DBusServerClientAddressPropertyInfo = ()
    type AttrGetType DBusServerClientAddressPropertyInfo = T.Text
    type AttrLabel DBusServerClientAddressPropertyInfo = "client-address"
    type AttrOrigin DBusServerClientAddressPropertyInfo = DBusServer
    attrGet = getDBusServerClientAddress
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.clientAddress"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#g:attr:clientAddress"
        })
#endif

-- VVV Prop "flags"
   -- Type: TInterface (Name {namespace = "Gio", name = "DBusServerFlags"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusServer #flags
-- @
getDBusServerFlags :: (MonadIO m, IsDBusServer o) => o -> m [Gio.Flags.DBusServerFlags]
getDBusServerFlags :: forall (m :: * -> *) o.
(MonadIO m, IsDBusServer o) =>
o -> m [DBusServerFlags]
getDBusServerFlags o
obj = IO [DBusServerFlags] -> m [DBusServerFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [DBusServerFlags] -> m [DBusServerFlags])
-> IO [DBusServerFlags] -> m [DBusServerFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [DBusServerFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"flags"

-- | Construct a `GValueConstruct` with valid value for the “@flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusServerFlags :: (IsDBusServer o, MIO.MonadIO m) => [Gio.Flags.DBusServerFlags] -> m (GValueConstruct o)
constructDBusServerFlags :: forall o (m :: * -> *).
(IsDBusServer o, MonadIO m) =>
[DBusServerFlags] -> m (GValueConstruct o)
constructDBusServerFlags [DBusServerFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [DBusServerFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [DBusServerFlags]
val

#if defined(ENABLE_OVERLOADING)
data DBusServerFlagsPropertyInfo
instance AttrInfo DBusServerFlagsPropertyInfo where
    type AttrAllowedOps DBusServerFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DBusServerFlagsPropertyInfo = IsDBusServer
    type AttrSetTypeConstraint DBusServerFlagsPropertyInfo = (~) [Gio.Flags.DBusServerFlags]
    type AttrTransferTypeConstraint DBusServerFlagsPropertyInfo = (~) [Gio.Flags.DBusServerFlags]
    type AttrTransferType DBusServerFlagsPropertyInfo = [Gio.Flags.DBusServerFlags]
    type AttrGetType DBusServerFlagsPropertyInfo = [Gio.Flags.DBusServerFlags]
    type AttrLabel DBusServerFlagsPropertyInfo = "flags"
    type AttrOrigin DBusServerFlagsPropertyInfo = DBusServer
    attrGet = getDBusServerFlags
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusServerFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#g:attr:flags"
        })
#endif

-- VVV Prop "guid"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@guid@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusServer #guid
-- @
getDBusServerGuid :: (MonadIO m, IsDBusServer o) => o -> m T.Text
getDBusServerGuid :: forall (m :: * -> *) o. (MonadIO m, IsDBusServer o) => o -> m Text
getDBusServerGuid o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getDBusServerGuid" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"guid"

-- | Construct a `GValueConstruct` with valid value for the “@guid@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusServerGuid :: (IsDBusServer o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDBusServerGuid :: forall o (m :: * -> *).
(IsDBusServer o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDBusServerGuid Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"guid" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DBusServerGuidPropertyInfo
instance AttrInfo DBusServerGuidPropertyInfo where
    type AttrAllowedOps DBusServerGuidPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DBusServerGuidPropertyInfo = IsDBusServer
    type AttrSetTypeConstraint DBusServerGuidPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DBusServerGuidPropertyInfo = (~) T.Text
    type AttrTransferType DBusServerGuidPropertyInfo = T.Text
    type AttrGetType DBusServerGuidPropertyInfo = T.Text
    type AttrLabel DBusServerGuidPropertyInfo = "guid"
    type AttrOrigin DBusServerGuidPropertyInfo = DBusServer
    attrGet = getDBusServerGuid
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusServerGuid
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.guid"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#g:attr:guid"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DBusServer
type instance O.AttributeList DBusServer = DBusServerAttributeList
type DBusServerAttributeList = ('[ '("active", DBusServerActivePropertyInfo), '("address", DBusServerAddressPropertyInfo), '("authenticationObserver", DBusServerAuthenticationObserverPropertyInfo), '("clientAddress", DBusServerClientAddressPropertyInfo), '("flags", DBusServerFlagsPropertyInfo), '("guid", DBusServerGuidPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dBusServerActive :: AttrLabelProxy "active"
dBusServerActive = AttrLabelProxy

dBusServerAddress :: AttrLabelProxy "address"
dBusServerAddress = AttrLabelProxy

dBusServerAuthenticationObserver :: AttrLabelProxy "authenticationObserver"
dBusServerAuthenticationObserver = AttrLabelProxy

dBusServerClientAddress :: AttrLabelProxy "clientAddress"
dBusServerClientAddress = AttrLabelProxy

dBusServerFlags :: AttrLabelProxy "flags"
dBusServerFlags = AttrLabelProxy

dBusServerGuid :: AttrLabelProxy "guid"
dBusServerGuid = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DBusServer = DBusServerSignalList
type DBusServerSignalList = ('[ '("newConnection", DBusServerNewConnectionSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method DBusServer::new_sync
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "address"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A D-Bus address." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusServerFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags from the #GDBusServerFlags enumeration."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "guid"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A D-Bus GUID." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "observer"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusAuthObserver" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusAuthObserver or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "DBusServer" })
-- throws : True
-- Skip return : False

foreign import ccall "g_dbus_server_new_sync" g_dbus_server_new_sync :: 
    CString ->                              -- address : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "DBusServerFlags"})
    CString ->                              -- guid : TBasicType TUTF8
    Ptr Gio.DBusAuthObserver.DBusAuthObserver -> -- observer : TInterface (Name {namespace = "Gio", name = "DBusAuthObserver"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr DBusServer)

-- | Creates a new D-Bus server that listens on the first address in
-- /@address@/ that works.
-- 
-- Once constructed, you can use 'GI.Gio.Objects.DBusServer.dBusServerGetClientAddress' to
-- get a D-Bus address string that clients can use to connect.
-- 
-- To have control over the available authentication mechanisms and
-- the users that are authorized to connect, it is strongly recommended
-- to provide a non-'P.Nothing' t'GI.Gio.Objects.DBusAuthObserver.DBusAuthObserver'.
-- 
-- Connect to the [DBusServer::newConnection]("GI.Gio.Objects.DBusServer#g:signal:newConnection") signal to handle
-- incoming connections.
-- 
-- The returned t'GI.Gio.Objects.DBusServer.DBusServer' isn\'t active - you have to start it with
-- 'GI.Gio.Objects.DBusServer.dBusServerStart'.
-- 
-- t'GI.Gio.Objects.DBusServer.DBusServer' is used in this [example][gdbus-peer-to-peer].
-- 
-- This is a synchronous failable constructor. There is currently no
-- asynchronous version.
-- 
-- /Since: 2.26/
dBusServerNewSync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.DBusAuthObserver.IsDBusAuthObserver a, Gio.Cancellable.IsCancellable b) =>
    T.Text
    -- ^ /@address@/: A D-Bus address.
    -> [Gio.Flags.DBusServerFlags]
    -- ^ /@flags@/: Flags from the t'GI.Gio.Flags.DBusServerFlags' enumeration.
    -> T.Text
    -- ^ /@guid@/: A D-Bus GUID.
    -> Maybe (a)
    -- ^ /@observer@/: A t'GI.Gio.Objects.DBusAuthObserver.DBusAuthObserver' or 'P.Nothing'.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> m DBusServer
    -- ^ __Returns:__ A t'GI.Gio.Objects.DBusServer.DBusServer' or 'P.Nothing' if /@error@/ is set. Free with
    -- 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
dBusServerNewSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDBusAuthObserver a, IsCancellable b) =>
Text
-> [DBusServerFlags] -> Text -> Maybe a -> Maybe b -> m DBusServer
dBusServerNewSync Text
address [DBusServerFlags]
flags Text
guid Maybe a
observer Maybe b
cancellable = IO DBusServer -> m DBusServer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusServer -> m DBusServer) -> IO DBusServer -> m DBusServer
forall a b. (a -> b) -> a -> b
$ do
    CString
address' <- Text -> IO CString
textToCString Text
address
    let flags' :: CUInt
flags' = [DBusServerFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DBusServerFlags]
flags
    CString
guid' <- Text -> IO CString
textToCString Text
guid
    Ptr DBusAuthObserver
maybeObserver <- case Maybe a
observer of
        Maybe a
Nothing -> Ptr DBusAuthObserver -> IO (Ptr DBusAuthObserver)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DBusAuthObserver
forall a. Ptr a
nullPtr
        Just a
jObserver -> do
            Ptr DBusAuthObserver
jObserver' <- a -> IO (Ptr DBusAuthObserver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jObserver
            Ptr DBusAuthObserver -> IO (Ptr DBusAuthObserver)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DBusAuthObserver
jObserver'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO DBusServer -> IO () -> IO DBusServer
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr DBusServer
result <- (Ptr (Ptr GError) -> IO (Ptr DBusServer)) -> IO (Ptr DBusServer)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr DBusServer)) -> IO (Ptr DBusServer))
-> (Ptr (Ptr GError) -> IO (Ptr DBusServer)) -> IO (Ptr DBusServer)
forall a b. (a -> b) -> a -> b
$ CString
-> CUInt
-> CString
-> Ptr DBusAuthObserver
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr DBusServer)
g_dbus_server_new_sync CString
address' CUInt
flags' CString
guid' Ptr DBusAuthObserver
maybeObserver Ptr Cancellable
maybeCancellable
        Text -> Ptr DBusServer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dBusServerNewSync" Ptr DBusServer
result
        DBusServer
result' <- ((ManagedPtr DBusServer -> DBusServer)
-> Ptr DBusServer -> IO DBusServer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusServer -> DBusServer
DBusServer) Ptr DBusServer
result
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
observer a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
address'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
guid'
        DBusServer -> IO DBusServer
forall (m :: * -> *) a. Monad m => a -> m a
return DBusServer
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
address'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
guid'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method DBusServer::get_client_address
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusServer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusServer." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_server_get_client_address" g_dbus_server_get_client_address :: 
    Ptr DBusServer ->                       -- server : TInterface (Name {namespace = "Gio", name = "DBusServer"})
    IO CString

-- | Gets a
-- <https://dbus.freedesktop.org/doc/dbus-specification.html#addresses D-Bus address>
-- string that can be used by clients to connect to /@server@/.
-- 
-- This is valid and non-empty if initializing the t'GI.Gio.Objects.DBusServer.DBusServer' succeeded.
-- 
-- /Since: 2.26/
dBusServerGetClientAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusServer a) =>
    a
    -- ^ /@server@/: A t'GI.Gio.Objects.DBusServer.DBusServer'.
    -> m T.Text
    -- ^ __Returns:__ A D-Bus address string. Do not free, the string is owned
    -- by /@server@/.
dBusServerGetClientAddress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusServer a) =>
a -> m Text
dBusServerGetClientAddress a
server = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusServer
server' <- a -> IO (Ptr DBusServer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    CString
result <- Ptr DBusServer -> IO CString
g_dbus_server_get_client_address Ptr DBusServer
server'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dBusServerGetClientAddress" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DBusServerGetClientAddressMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDBusServer a) => O.OverloadedMethod DBusServerGetClientAddressMethodInfo a signature where
    overloadedMethod = dBusServerGetClientAddress

instance O.OverloadedMethodInfo DBusServerGetClientAddressMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.dBusServerGetClientAddress",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#v:dBusServerGetClientAddress"
        })


#endif

-- method DBusServer::get_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusServer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusServer." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "DBusServerFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_server_get_flags" g_dbus_server_get_flags :: 
    Ptr DBusServer ->                       -- server : TInterface (Name {namespace = "Gio", name = "DBusServer"})
    IO CUInt

-- | Gets the flags for /@server@/.
-- 
-- /Since: 2.26/
dBusServerGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusServer a) =>
    a
    -- ^ /@server@/: A t'GI.Gio.Objects.DBusServer.DBusServer'.
    -> m [Gio.Flags.DBusServerFlags]
    -- ^ __Returns:__ A set of flags from the t'GI.Gio.Flags.DBusServerFlags' enumeration.
dBusServerGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusServer a) =>
a -> m [DBusServerFlags]
dBusServerGetFlags a
server = IO [DBusServerFlags] -> m [DBusServerFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DBusServerFlags] -> m [DBusServerFlags])
-> IO [DBusServerFlags] -> m [DBusServerFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusServer
server' <- a -> IO (Ptr DBusServer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    CUInt
result <- Ptr DBusServer -> IO CUInt
g_dbus_server_get_flags Ptr DBusServer
server'
    let result' :: [DBusServerFlags]
result' = CUInt -> [DBusServerFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    [DBusServerFlags] -> IO [DBusServerFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [DBusServerFlags]
result'

#if defined(ENABLE_OVERLOADING)
data DBusServerGetFlagsMethodInfo
instance (signature ~ (m [Gio.Flags.DBusServerFlags]), MonadIO m, IsDBusServer a) => O.OverloadedMethod DBusServerGetFlagsMethodInfo a signature where
    overloadedMethod = dBusServerGetFlags

instance O.OverloadedMethodInfo DBusServerGetFlagsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.dBusServerGetFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#v:dBusServerGetFlags"
        })


#endif

-- method DBusServer::get_guid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusServer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusServer." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_server_get_guid" g_dbus_server_get_guid :: 
    Ptr DBusServer ->                       -- server : TInterface (Name {namespace = "Gio", name = "DBusServer"})
    IO CString

-- | Gets the GUID for /@server@/, as provided to 'GI.Gio.Objects.DBusServer.dBusServerNewSync'.
-- 
-- /Since: 2.26/
dBusServerGetGuid ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusServer a) =>
    a
    -- ^ /@server@/: A t'GI.Gio.Objects.DBusServer.DBusServer'.
    -> m T.Text
    -- ^ __Returns:__ A D-Bus GUID. Do not free this string, it is owned by /@server@/.
dBusServerGetGuid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusServer a) =>
a -> m Text
dBusServerGetGuid a
server = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusServer
server' <- a -> IO (Ptr DBusServer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    CString
result <- Ptr DBusServer -> IO CString
g_dbus_server_get_guid Ptr DBusServer
server'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dBusServerGetGuid" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DBusServerGetGuidMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDBusServer a) => O.OverloadedMethod DBusServerGetGuidMethodInfo a signature where
    overloadedMethod = dBusServerGetGuid

instance O.OverloadedMethodInfo DBusServerGetGuidMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.dBusServerGetGuid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#v:dBusServerGetGuid"
        })


#endif

-- method DBusServer::is_active
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusServer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusServer." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_server_is_active" g_dbus_server_is_active :: 
    Ptr DBusServer ->                       -- server : TInterface (Name {namespace = "Gio", name = "DBusServer"})
    IO CInt

-- | Gets whether /@server@/ is active.
-- 
-- /Since: 2.26/
dBusServerIsActive ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusServer a) =>
    a
    -- ^ /@server@/: A t'GI.Gio.Objects.DBusServer.DBusServer'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if server is active, 'P.False' otherwise.
dBusServerIsActive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusServer a) =>
a -> m Bool
dBusServerIsActive a
server = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusServer
server' <- a -> IO (Ptr DBusServer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    CInt
result <- Ptr DBusServer -> IO CInt
g_dbus_server_is_active Ptr DBusServer
server'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DBusServerIsActiveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDBusServer a) => O.OverloadedMethod DBusServerIsActiveMethodInfo a signature where
    overloadedMethod = dBusServerIsActive

instance O.OverloadedMethodInfo DBusServerIsActiveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.dBusServerIsActive",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#v:dBusServerIsActive"
        })


#endif

-- method DBusServer::start
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusServer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusServer." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_server_start" g_dbus_server_start :: 
    Ptr DBusServer ->                       -- server : TInterface (Name {namespace = "Gio", name = "DBusServer"})
    IO ()

-- | Starts /@server@/.
-- 
-- /Since: 2.26/
dBusServerStart ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusServer a) =>
    a
    -- ^ /@server@/: A t'GI.Gio.Objects.DBusServer.DBusServer'.
    -> m ()
dBusServerStart :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusServer a) =>
a -> m ()
dBusServerStart a
server = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusServer
server' <- a -> IO (Ptr DBusServer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr DBusServer -> IO ()
g_dbus_server_start Ptr DBusServer
server'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusServerStartMethodInfo
instance (signature ~ (m ()), MonadIO m, IsDBusServer a) => O.OverloadedMethod DBusServerStartMethodInfo a signature where
    overloadedMethod = dBusServerStart

instance O.OverloadedMethodInfo DBusServerStartMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.dBusServerStart",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#v:dBusServerStart"
        })


#endif

-- method DBusServer::stop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusServer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusServer." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_server_stop" g_dbus_server_stop :: 
    Ptr DBusServer ->                       -- server : TInterface (Name {namespace = "Gio", name = "DBusServer"})
    IO ()

-- | Stops /@server@/.
-- 
-- /Since: 2.26/
dBusServerStop ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusServer a) =>
    a
    -- ^ /@server@/: A t'GI.Gio.Objects.DBusServer.DBusServer'.
    -> m ()
dBusServerStop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusServer a) =>
a -> m ()
dBusServerStop a
server = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusServer
server' <- a -> IO (Ptr DBusServer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr DBusServer -> IO ()
g_dbus_server_stop Ptr DBusServer
server'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusServerStopMethodInfo
instance (signature ~ (m ()), MonadIO m, IsDBusServer a) => O.OverloadedMethod DBusServerStopMethodInfo a signature where
    overloadedMethod = dBusServerStop

instance O.OverloadedMethodInfo DBusServerStopMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusServer.dBusServerStop",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-DBusServer.html#v:dBusServerStop"
        })


#endif