{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A proxy object representing the Secret Service.

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

module GI.Secret.Objects.Service
    ( 
#if defined(ENABLE_OVERLOADING)
    ServiceCreateItemDbusPathSyncMethodInfo ,
#endif

-- * Exported types
    Service(..)                             ,
    IsService                               ,
    toService                               ,
    noService                               ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveServiceMethod                    ,
#endif


-- ** clear #method:clear#

#if defined(ENABLE_OVERLOADING)
    ServiceClearMethodInfo                  ,
#endif
    serviceClear                            ,


-- ** clearFinish #method:clearFinish#

#if defined(ENABLE_OVERLOADING)
    ServiceClearFinishMethodInfo            ,
#endif
    serviceClearFinish                      ,


-- ** clearSync #method:clearSync#

#if defined(ENABLE_OVERLOADING)
    ServiceClearSyncMethodInfo              ,
#endif
    serviceClearSync                        ,


-- ** decodeDbusSecret #method:decodeDbusSecret#

#if defined(ENABLE_OVERLOADING)
    ServiceDecodeDbusSecretMethodInfo       ,
#endif
    serviceDecodeDbusSecret                 ,


-- ** disconnect #method:disconnect#

    serviceDisconnect                       ,


-- ** encodeDbusSecret #method:encodeDbusSecret#

#if defined(ENABLE_OVERLOADING)
    ServiceEncodeDbusSecretMethodInfo       ,
#endif
    serviceEncodeDbusSecret                 ,


-- ** ensureSession #method:ensureSession#

#if defined(ENABLE_OVERLOADING)
    ServiceEnsureSessionMethodInfo          ,
#endif
    serviceEnsureSession                    ,


-- ** ensureSessionFinish #method:ensureSessionFinish#

#if defined(ENABLE_OVERLOADING)
    ServiceEnsureSessionFinishMethodInfo    ,
#endif
    serviceEnsureSessionFinish              ,


-- ** ensureSessionSync #method:ensureSessionSync#

#if defined(ENABLE_OVERLOADING)
    ServiceEnsureSessionSyncMethodInfo      ,
#endif
    serviceEnsureSessionSync                ,


-- ** get #method:get#

    serviceGet                              ,


-- ** getCollectionGtype #method:getCollectionGtype#

#if defined(ENABLE_OVERLOADING)
    ServiceGetCollectionGtypeMethodInfo     ,
#endif
    serviceGetCollectionGtype               ,


-- ** getCollections #method:getCollections#

#if defined(ENABLE_OVERLOADING)
    ServiceGetCollectionsMethodInfo         ,
#endif
    serviceGetCollections                   ,


-- ** getFinish #method:getFinish#

    serviceGetFinish                        ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    ServiceGetFlagsMethodInfo               ,
#endif
    serviceGetFlags                         ,


-- ** getItemGtype #method:getItemGtype#

#if defined(ENABLE_OVERLOADING)
    ServiceGetItemGtypeMethodInfo           ,
#endif
    serviceGetItemGtype                     ,


-- ** getSessionAlgorithms #method:getSessionAlgorithms#

#if defined(ENABLE_OVERLOADING)
    ServiceGetSessionAlgorithmsMethodInfo   ,
#endif
    serviceGetSessionAlgorithms             ,


-- ** getSessionDbusPath #method:getSessionDbusPath#

#if defined(ENABLE_OVERLOADING)
    ServiceGetSessionDbusPathMethodInfo     ,
#endif
    serviceGetSessionDbusPath               ,


-- ** getSync #method:getSync#

    serviceGetSync                          ,


-- ** loadCollections #method:loadCollections#

#if defined(ENABLE_OVERLOADING)
    ServiceLoadCollectionsMethodInfo        ,
#endif
    serviceLoadCollections                  ,


-- ** loadCollectionsFinish #method:loadCollectionsFinish#

#if defined(ENABLE_OVERLOADING)
    ServiceLoadCollectionsFinishMethodInfo  ,
#endif
    serviceLoadCollectionsFinish            ,


-- ** loadCollectionsSync #method:loadCollectionsSync#

#if defined(ENABLE_OVERLOADING)
    ServiceLoadCollectionsSyncMethodInfo    ,
#endif
    serviceLoadCollectionsSync              ,


-- ** lock #method:lock#

#if defined(ENABLE_OVERLOADING)
    ServiceLockMethodInfo                   ,
#endif
    serviceLock                             ,


-- ** lockFinish #method:lockFinish#

#if defined(ENABLE_OVERLOADING)
    ServiceLockFinishMethodInfo             ,
#endif
    serviceLockFinish                       ,


-- ** lockSync #method:lockSync#

#if defined(ENABLE_OVERLOADING)
    ServiceLockSyncMethodInfo               ,
#endif
    serviceLockSync                         ,


-- ** lookup #method:lookup#

#if defined(ENABLE_OVERLOADING)
    ServiceLookupMethodInfo                 ,
#endif
    serviceLookup                           ,


-- ** lookupFinish #method:lookupFinish#

#if defined(ENABLE_OVERLOADING)
    ServiceLookupFinishMethodInfo           ,
#endif
    serviceLookupFinish                     ,


-- ** lookupSync #method:lookupSync#

#if defined(ENABLE_OVERLOADING)
    ServiceLookupSyncMethodInfo             ,
#endif
    serviceLookupSync                       ,


-- ** open #method:open#

    serviceOpen                             ,


-- ** openFinish #method:openFinish#

    serviceOpenFinish                       ,


-- ** openSync #method:openSync#

    serviceOpenSync                         ,


-- ** prompt #method:prompt#

#if defined(ENABLE_OVERLOADING)
    ServicePromptMethodInfo                 ,
#endif
    servicePrompt                           ,


-- ** promptFinish #method:promptFinish#

#if defined(ENABLE_OVERLOADING)
    ServicePromptFinishMethodInfo           ,
#endif
    servicePromptFinish                     ,


-- ** promptSync #method:promptSync#

#if defined(ENABLE_OVERLOADING)
    ServicePromptSyncMethodInfo             ,
#endif
    servicePromptSync                       ,


-- ** search #method:search#

#if defined(ENABLE_OVERLOADING)
    ServiceSearchMethodInfo                 ,
#endif
    serviceSearch                           ,


-- ** searchFinish #method:searchFinish#

#if defined(ENABLE_OVERLOADING)
    ServiceSearchFinishMethodInfo           ,
#endif
    serviceSearchFinish                     ,


-- ** searchSync #method:searchSync#

#if defined(ENABLE_OVERLOADING)
    ServiceSearchSyncMethodInfo             ,
#endif
    serviceSearchSync                       ,


-- ** setAlias #method:setAlias#

#if defined(ENABLE_OVERLOADING)
    ServiceSetAliasMethodInfo               ,
#endif
    serviceSetAlias                         ,


-- ** setAliasFinish #method:setAliasFinish#

#if defined(ENABLE_OVERLOADING)
    ServiceSetAliasFinishMethodInfo         ,
#endif
    serviceSetAliasFinish                   ,


-- ** setAliasSync #method:setAliasSync#

#if defined(ENABLE_OVERLOADING)
    ServiceSetAliasSyncMethodInfo           ,
#endif
    serviceSetAliasSync                     ,


-- ** store #method:store#

#if defined(ENABLE_OVERLOADING)
    ServiceStoreMethodInfo                  ,
#endif
    serviceStore                            ,


-- ** storeFinish #method:storeFinish#

#if defined(ENABLE_OVERLOADING)
    ServiceStoreFinishMethodInfo            ,
#endif
    serviceStoreFinish                      ,


-- ** storeSync #method:storeSync#

#if defined(ENABLE_OVERLOADING)
    ServiceStoreSyncMethodInfo              ,
#endif
    serviceStoreSync                        ,


-- ** unlock #method:unlock#

#if defined(ENABLE_OVERLOADING)
    ServiceUnlockMethodInfo                 ,
#endif
    serviceUnlock                           ,


-- ** unlockFinish #method:unlockFinish#

#if defined(ENABLE_OVERLOADING)
    ServiceUnlockFinishMethodInfo           ,
#endif
    serviceUnlockFinish                     ,


-- ** unlockSync #method:unlockSync#

#if defined(ENABLE_OVERLOADING)
    ServiceUnlockSyncMethodInfo             ,
#endif
    serviceUnlockSync                       ,




    ) 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.ManagedPtr as B.ManagedPtr
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 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 GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.DBusInterface as Gio.DBusInterface
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.DBusProxy as Gio.DBusProxy
import {-# SOURCE #-} qualified GI.Secret.Flags as Secret.Flags
import {-# SOURCE #-} qualified GI.Secret.Objects.Collection as Secret.Collection
import {-# SOURCE #-} qualified GI.Secret.Objects.Item as Secret.Item
import {-# SOURCE #-} qualified GI.Secret.Objects.Prompt as Secret.Prompt
import {-# SOURCE #-} qualified GI.Secret.Structs.Schema as Secret.Schema
import {-# SOURCE #-} qualified GI.Secret.Structs.Value as Secret.Value

-- | Memory-managed wrapper type.
newtype Service = Service (ManagedPtr Service)
    deriving (Service -> Service -> Bool
(Service -> Service -> Bool)
-> (Service -> Service -> Bool) -> Eq Service
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Service -> Service -> Bool
$c/= :: Service -> Service -> Bool
== :: Service -> Service -> Bool
$c== :: Service -> Service -> Bool
Eq)
foreign import ccall "secret_service_get_type"
    c_secret_service_get_type :: IO GType

instance GObject Service where
    gobjectType :: IO GType
gobjectType = IO GType
c_secret_service_get_type
    

-- | Convert 'Service' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Service where
    toGValue :: Service -> IO GValue
toGValue o :: Service
o = do
        GType
gtype <- IO GType
c_secret_service_get_type
        Service -> (Ptr Service -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Service
o (GType
-> (GValue -> Ptr Service -> IO ()) -> Ptr Service -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Service -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Service
fromGValue gv :: GValue
gv = do
        Ptr Service
ptr <- GValue -> IO (Ptr Service)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Service)
        (ManagedPtr Service -> Service) -> Ptr Service -> IO Service
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Service -> Service
Service Ptr Service
ptr
        
    

-- | Type class for types which can be safely cast to `Service`, for instance with `toService`.
class (GObject o, O.IsDescendantOf Service o) => IsService o
instance (GObject o, O.IsDescendantOf Service o) => IsService o

instance O.HasParentTypes Service
type instance O.ParentTypes Service = '[Gio.DBusProxy.DBusProxy, GObject.Object.Object, Gio.AsyncInitable.AsyncInitable, Gio.DBusInterface.DBusInterface, Gio.Initable.Initable]

-- | Cast to `Service`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toService :: (MonadIO m, IsService o) => o -> m Service
toService :: o -> m Service
toService = IO Service -> m Service
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Service -> m Service) -> (o -> IO Service) -> o -> m Service
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Service -> Service) -> o -> IO Service
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Service -> Service
Service

-- | A convenience alias for `Nothing` :: `Maybe` `Service`.
noService :: Maybe Service
noService :: Maybe Service
noService = Maybe Service
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveServiceMethod (t :: Symbol) (o :: *) :: * where
    ResolveServiceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveServiceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveServiceMethod "call" o = Gio.DBusProxy.DBusProxyCallMethodInfo
    ResolveServiceMethod "callFinish" o = Gio.DBusProxy.DBusProxyCallFinishMethodInfo
    ResolveServiceMethod "callSync" o = Gio.DBusProxy.DBusProxyCallSyncMethodInfo
    ResolveServiceMethod "callWithUnixFdList" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListMethodInfo
    ResolveServiceMethod "callWithUnixFdListFinish" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListFinishMethodInfo
    ResolveServiceMethod "callWithUnixFdListSync" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListSyncMethodInfo
    ResolveServiceMethod "clear" o = ServiceClearMethodInfo
    ResolveServiceMethod "clearFinish" o = ServiceClearFinishMethodInfo
    ResolveServiceMethod "clearSync" o = ServiceClearSyncMethodInfo
    ResolveServiceMethod "createItemDbusPathSync" o = ServiceCreateItemDbusPathSyncMethodInfo
    ResolveServiceMethod "decodeDbusSecret" o = ServiceDecodeDbusSecretMethodInfo
    ResolveServiceMethod "encodeDbusSecret" o = ServiceEncodeDbusSecretMethodInfo
    ResolveServiceMethod "ensureSession" o = ServiceEnsureSessionMethodInfo
    ResolveServiceMethod "ensureSessionFinish" o = ServiceEnsureSessionFinishMethodInfo
    ResolveServiceMethod "ensureSessionSync" o = ServiceEnsureSessionSyncMethodInfo
    ResolveServiceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveServiceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveServiceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveServiceMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveServiceMethod "initAsync" o = Gio.AsyncInitable.AsyncInitableInitAsyncMethodInfo
    ResolveServiceMethod "initFinish" o = Gio.AsyncInitable.AsyncInitableInitFinishMethodInfo
    ResolveServiceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveServiceMethod "loadCollections" o = ServiceLoadCollectionsMethodInfo
    ResolveServiceMethod "loadCollectionsFinish" o = ServiceLoadCollectionsFinishMethodInfo
    ResolveServiceMethod "loadCollectionsSync" o = ServiceLoadCollectionsSyncMethodInfo
    ResolveServiceMethod "lock" o = ServiceLockMethodInfo
    ResolveServiceMethod "lockFinish" o = ServiceLockFinishMethodInfo
    ResolveServiceMethod "lockSync" o = ServiceLockSyncMethodInfo
    ResolveServiceMethod "lookup" o = ServiceLookupMethodInfo
    ResolveServiceMethod "lookupFinish" o = ServiceLookupFinishMethodInfo
    ResolveServiceMethod "lookupSync" o = ServiceLookupSyncMethodInfo
    ResolveServiceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveServiceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveServiceMethod "prompt" o = ServicePromptMethodInfo
    ResolveServiceMethod "promptFinish" o = ServicePromptFinishMethodInfo
    ResolveServiceMethod "promptSync" o = ServicePromptSyncMethodInfo
    ResolveServiceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveServiceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveServiceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveServiceMethod "search" o = ServiceSearchMethodInfo
    ResolveServiceMethod "searchFinish" o = ServiceSearchFinishMethodInfo
    ResolveServiceMethod "searchSync" o = ServiceSearchSyncMethodInfo
    ResolveServiceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveServiceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveServiceMethod "store" o = ServiceStoreMethodInfo
    ResolveServiceMethod "storeFinish" o = ServiceStoreFinishMethodInfo
    ResolveServiceMethod "storeSync" o = ServiceStoreSyncMethodInfo
    ResolveServiceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveServiceMethod "unlock" o = ServiceUnlockMethodInfo
    ResolveServiceMethod "unlockFinish" o = ServiceUnlockFinishMethodInfo
    ResolveServiceMethod "unlockSync" o = ServiceUnlockSyncMethodInfo
    ResolveServiceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveServiceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveServiceMethod "getCachedProperty" o = Gio.DBusProxy.DBusProxyGetCachedPropertyMethodInfo
    ResolveServiceMethod "getCachedPropertyNames" o = Gio.DBusProxy.DBusProxyGetCachedPropertyNamesMethodInfo
    ResolveServiceMethod "getCollectionGtype" o = ServiceGetCollectionGtypeMethodInfo
    ResolveServiceMethod "getCollections" o = ServiceGetCollectionsMethodInfo
    ResolveServiceMethod "getConnection" o = Gio.DBusProxy.DBusProxyGetConnectionMethodInfo
    ResolveServiceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveServiceMethod "getDefaultTimeout" o = Gio.DBusProxy.DBusProxyGetDefaultTimeoutMethodInfo
    ResolveServiceMethod "getFlags" o = ServiceGetFlagsMethodInfo
    ResolveServiceMethod "getInfo" o = Gio.DBusInterface.DBusInterfaceGetInfoMethodInfo
    ResolveServiceMethod "getInterfaceInfo" o = Gio.DBusProxy.DBusProxyGetInterfaceInfoMethodInfo
    ResolveServiceMethod "getInterfaceName" o = Gio.DBusProxy.DBusProxyGetInterfaceNameMethodInfo
    ResolveServiceMethod "getItemGtype" o = ServiceGetItemGtypeMethodInfo
    ResolveServiceMethod "getName" o = Gio.DBusProxy.DBusProxyGetNameMethodInfo
    ResolveServiceMethod "getNameOwner" o = Gio.DBusProxy.DBusProxyGetNameOwnerMethodInfo
    ResolveServiceMethod "getObject" o = Gio.DBusInterface.DBusInterfaceGetObjectMethodInfo
    ResolveServiceMethod "getObjectPath" o = Gio.DBusProxy.DBusProxyGetObjectPathMethodInfo
    ResolveServiceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveServiceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveServiceMethod "getSessionAlgorithms" o = ServiceGetSessionAlgorithmsMethodInfo
    ResolveServiceMethod "getSessionDbusPath" o = ServiceGetSessionDbusPathMethodInfo
    ResolveServiceMethod "setAlias" o = ServiceSetAliasMethodInfo
    ResolveServiceMethod "setAliasFinish" o = ServiceSetAliasFinishMethodInfo
    ResolveServiceMethod "setAliasSync" o = ServiceSetAliasSyncMethodInfo
    ResolveServiceMethod "setCachedProperty" o = Gio.DBusProxy.DBusProxySetCachedPropertyMethodInfo
    ResolveServiceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveServiceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveServiceMethod "setDefaultTimeout" o = Gio.DBusProxy.DBusProxySetDefaultTimeoutMethodInfo
    ResolveServiceMethod "setInterfaceInfo" o = Gio.DBusProxy.DBusProxySetInterfaceInfoMethodInfo
    ResolveServiceMethod "setObject" o = Gio.DBusInterface.DBusInterfaceSetObjectMethodInfo
    ResolveServiceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveServiceMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Service
type instance O.AttributeList Service = ServiceAttributeList
type ServiceAttributeList = ('[ '("gBusType", Gio.DBusProxy.DBusProxyGBusTypePropertyInfo), '("gConnection", Gio.DBusProxy.DBusProxyGConnectionPropertyInfo), '("gDefaultTimeout", Gio.DBusProxy.DBusProxyGDefaultTimeoutPropertyInfo), '("gFlags", Gio.DBusProxy.DBusProxyGFlagsPropertyInfo), '("gInterfaceInfo", Gio.DBusProxy.DBusProxyGInterfaceInfoPropertyInfo), '("gInterfaceName", Gio.DBusProxy.DBusProxyGInterfaceNamePropertyInfo), '("gName", Gio.DBusProxy.DBusProxyGNamePropertyInfo), '("gNameOwner", Gio.DBusProxy.DBusProxyGNameOwnerPropertyInfo), '("gObjectPath", Gio.DBusProxy.DBusProxyGObjectPathPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Service = ServiceSignalList
type ServiceSignalList = ('[ '("gPropertiesChanged", Gio.DBusProxy.DBusProxyGPropertiesChangedSignalInfo), '("gSignal", Gio.DBusProxy.DBusProxyGSignalSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Service::clear
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema for the attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute keys and values"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_clear" secret_service_clear :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Schema.Schema ->             -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    Ptr (GHashTable CString CString) ->     -- attributes : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Remove unlocked items which match the attributes from the secret service.
-- 
-- The /@attributes@/ should be a set of key and value string pairs.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGet' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method will return immediately and complete asynchronously.
serviceClear ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@service@/: the secret service
    -> Maybe (Secret.Schema.Schema)
    -- ^ /@schema@/: the schema for the attributes
    -> Map.Map T.Text T.Text
    -- ^ /@attributes@/: the attribute keys and values
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceClear :: a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceClear service :: a
service schema :: Maybe Schema
schema attributes :: Map Text Text
attributes cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr Schema
maybeSchema <- case Maybe Schema
schema of
        Nothing -> Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
nullPtr
        Just jSchema :: Schema
jSchema -> do
            Ptr Schema
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
jSchema'
    let attributes' :: [(Text, Text)]
attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    [(CString, Text)]
attributes'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
attributes'
    [(CString, CString)]
attributes''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
attributes''
    let attributes'''' :: [(PtrWrapped CString, CString)]
attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
attributes'''
    let attributes''''' :: [(PtrWrapped CString, PtrWrapped CString)]
attributes''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    Ptr (GHashTable CString CString)
attributes'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
attributes'''''
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Service
-> Ptr Schema
-> Ptr (GHashTable CString CString)
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_clear Ptr Service
service' Ptr Schema
maybeSchema Ptr (GHashTable CString CString)
attributes'''''' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
    Maybe Schema -> (Schema -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Schema
schema Schema -> 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
    Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServiceClearMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceClearMethodInfo a signature where
    overloadedMethod = serviceClear

#endif

-- method Service::clear_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_clear_finish" secret_service_clear_finish :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finish asynchronous operation to remove items from the secret
-- service.
serviceClearFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@service@/: the secret service
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceClearFinish :: a -> b -> m ()
serviceClearFinish service :: a
service result_ :: b
result_ = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Service -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
secret_service_clear_finish Ptr Service
service' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceClearFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ServiceClearFinishMethodInfo a signature where
    overloadedMethod = serviceClearFinish

#endif

-- method Service::clear_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema for the attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute keys and values"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_clear_sync" secret_service_clear_sync :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Schema.Schema ->             -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    Ptr (GHashTable CString CString) ->     -- attributes : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Remove unlocked items which match the attributes from the secret service.
-- 
-- The /@attributes@/ should be a set of key and value string pairs.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGetSync' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method may block indefinitely and should not be used in user interface
-- threads.
serviceClearSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@service@/: the secret service
    -> Maybe (Secret.Schema.Schema)
    -- ^ /@schema@/: the schema for the attributes
    -> Map.Map T.Text T.Text
    -- ^ /@attributes@/: the attribute keys and values
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceClearSync :: a -> Maybe Schema -> Map Text Text -> Maybe b -> m ()
serviceClearSync service :: a
service schema :: Maybe Schema
schema attributes :: Map Text Text
attributes cancellable :: Maybe b
cancellable = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr Schema
maybeSchema <- case Maybe Schema
schema of
        Nothing -> Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
nullPtr
        Just jSchema :: Schema
jSchema -> do
            Ptr Schema
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
jSchema'
    let attributes' :: [(Text, Text)]
attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    [(CString, Text)]
attributes'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
attributes'
    [(CString, CString)]
attributes''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
attributes''
    let attributes'''' :: [(PtrWrapped CString, CString)]
attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
attributes'''
    let attributes''''' :: [(PtrWrapped CString, PtrWrapped CString)]
attributes''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    Ptr (GHashTable CString CString)
attributes'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
attributes'''''
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr Schema
-> Ptr (GHashTable CString CString)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
secret_service_clear_sync Ptr Service
service' Ptr Schema
maybeSchema Ptr (GHashTable CString CString)
attributes'''''' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        Maybe Schema -> (Schema -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Schema
schema Schema -> 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
        Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
     )

#if defined(ENABLE_OVERLOADING)
data ServiceClearSyncMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> Maybe (b) -> m ()), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceClearSyncMethodInfo a signature where
    overloadedMethod = serviceClearSync

#endif

-- XXX Could not generate method Service::create_item_dbus_path_sync
-- Error was : Not implemented: "GHashTable element of type TVariant unsupported."
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data ServiceCreateItemDbusPathSyncMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "createItemDbusPathSync" Service) => O.MethodInfo ServiceCreateItemDbusPathSyncMethodInfo o p where
    overloadedMethod = undefined
#endif

-- method Service::decode_dbus_secret
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the encoded secret" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_decode_dbus_secret" secret_service_decode_dbus_secret :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr GVariant ->                         -- value : TVariant
    IO (Ptr Secret.Value.Value)

-- | Decode a t'GI.Secret.Structs.Value.Value' into GVariant received with the Secret Service
-- DBus API.
-- 
-- The GVariant should have a \<literal>(oayays)\<\/literal> signature.
-- 
-- A session must have already been established by the t'GI.Secret.Objects.Service.Service', and
-- the encoded secret must be valid for that session.
serviceDecodeDbusSecret ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a) =>
    a
    -- ^ /@service@/: the service
    -> GVariant
    -- ^ /@value@/: the encoded secret
    -> m Secret.Value.Value
    -- ^ __Returns:__ the decoded secret value
serviceDecodeDbusSecret :: a -> GVariant -> m Value
serviceDecodeDbusSecret service :: a
service value :: GVariant
value = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr GVariant
value' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
value
    Ptr Value
result <- Ptr Service -> Ptr GVariant -> IO (Ptr Value)
secret_service_decode_dbus_secret Ptr Service
service' Ptr GVariant
value'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "serviceDecodeDbusSecret" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Value -> Value
Secret.Value.Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
value
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data ServiceDecodeDbusSecretMethodInfo
instance (signature ~ (GVariant -> m Secret.Value.Value), MonadIO m, IsService a) => O.MethodInfo ServiceDecodeDbusSecretMethodInfo a signature where
    overloadedMethod = serviceDecodeDbusSecret

#endif

-- method Service::encode_dbus_secret
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_encode_dbus_secret" secret_service_encode_dbus_secret :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Value.Value ->               -- value : TInterface (Name {namespace = "Secret", name = "Value"})
    IO (Ptr GVariant)

-- | Encodes a t'GI.Secret.Structs.Value.Value' into GVariant for use with the Secret Service
-- DBus API.
-- 
-- The resulting GVariant will have a \<literal>(oayays)\<\/literal> signature.
-- 
-- A session must have already been established by the t'GI.Secret.Objects.Service.Service'.
serviceEncodeDbusSecret ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a) =>
    a
    -- ^ /@service@/: the service
    -> Secret.Value.Value
    -- ^ /@value@/: the secret value
    -> m GVariant
    -- ^ __Returns:__ the encoded secret
serviceEncodeDbusSecret :: a -> Value -> m GVariant
serviceEncodeDbusSecret service :: a
service value :: Value
value = IO GVariant -> m GVariant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr Value
value' <- Value -> IO (Ptr Value)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Value
value
    Ptr GVariant
result <- Ptr Service -> Ptr Value -> IO (Ptr GVariant)
secret_service_encode_dbus_secret Ptr Service
service' Ptr Value
value'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "serviceEncodeDbusSecret" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
    Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Value
value
    GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data ServiceEncodeDbusSecretMethodInfo
instance (signature ~ (Secret.Value.Value -> m GVariant), MonadIO m, IsService a) => O.MethodInfo ServiceEncodeDbusSecretMethodInfo a signature where
    overloadedMethod = serviceEncodeDbusSecret

#endif

-- method Service::ensure_session
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_ensure_session" secret_service_ensure_session :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Ensure that the t'GI.Secret.Objects.Service.Service' proxy has established a session with the
-- Secret Service. This session is used to transfer secrets.
-- 
-- It is not normally necessary to call this method, as the session is
-- established as necessary. You can also pass the 'GI.Secret.Flags.ServiceFlagsOpenSession'
-- to 'GI.Secret.Objects.Service.serviceGet' in order to ensure that a session has been established
-- by the time you get the t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method will return immediately and complete asynchronously.
serviceEnsureSession ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: the secret service
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceEnsureSession :: a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
serviceEnsureSession self :: a
self cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Service
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_ensure_session Ptr Service
self' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    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
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServiceEnsureSessionMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceEnsureSessionMethodInfo a signature where
    overloadedMethod = serviceEnsureSession

#endif

-- method Service::ensure_session_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_ensure_session_finish" secret_service_ensure_session_finish :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finish an asynchronous operation to ensure that the t'GI.Secret.Objects.Service.Service' proxy
-- has established a session with the Secret Service.
serviceEnsureSessionFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: the secret service
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceEnsureSessionFinish :: a -> b -> m ()
serviceEnsureSessionFinish self :: a
self result_ :: b
result_ = 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 Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Service -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
secret_service_ensure_session_finish Ptr Service
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceEnsureSessionFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ServiceEnsureSessionFinishMethodInfo a signature where
    overloadedMethod = serviceEnsureSessionFinish

#endif

-- method Service::ensure_session_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_ensure_session_sync" secret_service_ensure_session_sync :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Ensure that the t'GI.Secret.Objects.Service.Service' proxy has established a session with the
-- Secret Service. This session is used to transfer secrets.
-- 
-- It is not normally necessary to call this method, as the session is
-- established as necessary. You can also pass the 'GI.Secret.Flags.ServiceFlagsOpenSession'
-- to 'GI.Secret.Objects.Service.serviceGetSync' in order to ensure that a session has been
-- established by the time you get the t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method may block indefinitely and should not be used in user interface
-- threads.
serviceEnsureSessionSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: the secret service
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceEnsureSessionSync :: a -> Maybe b -> m ()
serviceEnsureSessionSync self :: a
self cancellable :: Maybe b
cancellable = 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 Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Service -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
secret_service_ensure_session_sync Ptr Service
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        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
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceEnsureSessionSyncMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceEnsureSessionSyncMethodInfo a signature where
    overloadedMethod = serviceEnsureSessionSync

#endif

-- method Service::get_collection_gtype
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_get_collection_gtype" secret_service_get_collection_gtype :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    IO CGType

-- | Get the GObject type for collections instantiated by this service.
-- This will always be either t'GI.Secret.Objects.Collection.Collection' or derived from it.
serviceGetCollectionGtype ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a) =>
    a
    -- ^ /@self@/: the secret service
    -> m GType
    -- ^ __Returns:__ the gobject type for collections
serviceGetCollectionGtype :: a -> m GType
serviceGetCollectionGtype self :: a
self = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CGType
result <- Ptr Service -> IO CGType
secret_service_get_collection_gtype Ptr Service
self'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data ServiceGetCollectionGtypeMethodInfo
instance (signature ~ (m GType), MonadIO m, IsService a) => O.MethodInfo ServiceGetCollectionGtypeMethodInfo a signature where
    overloadedMethod = serviceGetCollectionGtype

#endif

-- method Service::get_collections
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service proxy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Secret" , name = "Collection" }))
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_get_collections" secret_service_get_collections :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    IO (Ptr (GList (Ptr Secret.Collection.Collection)))

-- | Get a list of t'GI.Secret.Objects.Collection.Collection' objects representing all the collections
-- in the secret service.
-- 
-- If the 'GI.Secret.Flags.ServiceFlagsLoadCollections' flag was not specified when
-- initializing t'GI.Secret.Objects.Service.Service' proxy object, then this method will return
-- 'P.Nothing'. Use 'GI.Secret.Objects.Service.serviceLoadCollections' to load the collections.
serviceGetCollections ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a) =>
    a
    -- ^ /@self@/: the secret service proxy
    -> m [Secret.Collection.Collection]
    -- ^ __Returns:__ a
    --          list of the collections in the secret service
serviceGetCollections :: a -> m [Collection]
serviceGetCollections self :: a
self = IO [Collection] -> m [Collection]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Collection] -> m [Collection])
-> IO [Collection] -> m [Collection]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr (GList (Ptr Collection))
result <- Ptr Service -> IO (Ptr (GList (Ptr Collection)))
secret_service_get_collections Ptr Service
self'
    [Ptr Collection]
result' <- Ptr (GList (Ptr Collection)) -> IO [Ptr Collection]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Collection))
result
    [Collection]
result'' <- (Ptr Collection -> IO Collection)
-> [Ptr Collection] -> IO [Collection]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Collection -> Collection)
-> Ptr Collection -> IO Collection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Collection -> Collection
Secret.Collection.Collection) [Ptr Collection]
result'
    Ptr (GList (Ptr Collection)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Collection))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [Collection] -> IO [Collection]
forall (m :: * -> *) a. Monad m => a -> m a
return [Collection]
result''

#if defined(ENABLE_OVERLOADING)
data ServiceGetCollectionsMethodInfo
instance (signature ~ (m [Secret.Collection.Collection]), MonadIO m, IsService a) => O.MethodInfo ServiceGetCollectionsMethodInfo a signature where
    overloadedMethod = serviceGetCollections

#endif

-- method Service::get_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service proxy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Secret" , name = "ServiceFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_get_flags" secret_service_get_flags :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    IO CUInt

-- | Get the flags representing what features of the t'GI.Secret.Objects.Service.Service' proxy
-- have been initialized.
-- 
-- Use 'GI.Secret.Objects.Service.serviceEnsureSession' or 'GI.Secret.Objects.Service.serviceLoadCollections'
-- to initialize further features and change the flags.
serviceGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a) =>
    a
    -- ^ /@self@/: the secret service proxy
    -> m [Secret.Flags.ServiceFlags]
    -- ^ __Returns:__ the flags for features initialized
serviceGetFlags :: a -> m [ServiceFlags]
serviceGetFlags self :: a
self = IO [ServiceFlags] -> m [ServiceFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ServiceFlags] -> m [ServiceFlags])
-> IO [ServiceFlags] -> m [ServiceFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Service -> IO CUInt
secret_service_get_flags Ptr Service
self'
    let result' :: [ServiceFlags]
result' = CUInt -> [ServiceFlags]
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
self
    [ServiceFlags] -> IO [ServiceFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [ServiceFlags]
result'

#if defined(ENABLE_OVERLOADING)
data ServiceGetFlagsMethodInfo
instance (signature ~ (m [Secret.Flags.ServiceFlags]), MonadIO m, IsService a) => O.MethodInfo ServiceGetFlagsMethodInfo a signature where
    overloadedMethod = serviceGetFlags

#endif

-- method Service::get_item_gtype
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_get_item_gtype" secret_service_get_item_gtype :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    IO CGType

-- | Get the GObject type for items instantiated by this service.
-- This will always be either t'GI.Secret.Objects.Item.Item' or derived from it.
serviceGetItemGtype ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a) =>
    a
    -- ^ /@self@/: the service
    -> m GType
    -- ^ __Returns:__ the gobject type for items
serviceGetItemGtype :: a -> m GType
serviceGetItemGtype self :: a
self = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CGType
result <- Ptr Service -> IO CGType
secret_service_get_item_gtype Ptr Service
self'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data ServiceGetItemGtypeMethodInfo
instance (signature ~ (m GType), MonadIO m, IsService a) => O.MethodInfo ServiceGetItemGtypeMethodInfo a signature where
    overloadedMethod = serviceGetItemGtype

#endif

-- method Service::get_session_algorithms
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service proxy"
--                 , 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 "secret_service_get_session_algorithms" secret_service_get_session_algorithms :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    IO CString

-- | Get the set of algorithms being used to transfer secrets between this
-- secret service proxy and the Secret Service itself.
-- 
-- This will be 'P.Nothing' if no session has been established. Use
-- 'GI.Secret.Objects.Service.serviceEnsureSession' to establish a session.
serviceGetSessionAlgorithms ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a) =>
    a
    -- ^ /@self@/: the secret service proxy
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string representing the algorithms for transferring
    --          secrets
serviceGetSessionAlgorithms :: a -> m (Maybe Text)
serviceGetSessionAlgorithms self :: a
self = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Service -> IO CString
secret_service_get_session_algorithms Ptr Service
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ServiceGetSessionAlgorithmsMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsService a) => O.MethodInfo ServiceGetSessionAlgorithmsMethodInfo a signature where
    overloadedMethod = serviceGetSessionAlgorithms

#endif

-- method Service::get_session_dbus_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service proxy"
--                 , 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 "secret_service_get_session_dbus_path" secret_service_get_session_dbus_path :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    IO CString

-- | Get the D-Bus object path of the session object being used to transfer
-- secrets between this secret service proxy and the Secret Service itself.
-- 
-- This will be 'P.Nothing' if no session has been established. Use
-- 'GI.Secret.Objects.Service.serviceEnsureSession' to establish a session.
serviceGetSessionDbusPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a) =>
    a
    -- ^ /@self@/: the secret service proxy
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string representing the D-Bus object path of the
    --          session
serviceGetSessionDbusPath :: a -> m (Maybe Text)
serviceGetSessionDbusPath self :: a
self = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Service -> IO CString
secret_service_get_session_dbus_path Ptr Service
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ServiceGetSessionDbusPathMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsService a) => O.MethodInfo ServiceGetSessionDbusPathMethodInfo a signature where
    overloadedMethod = serviceGetSessionDbusPath

#endif

-- method Service::load_collections
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_load_collections" secret_service_load_collections :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Ensure that the t'GI.Secret.Objects.Service.Service' proxy has loaded all the collections present
-- in the Secret Service. This affects the result of
-- 'GI.Secret.Objects.Service.serviceGetCollections'.
-- 
-- You can also pass the 'GI.Secret.Flags.ServiceFlagsLoadCollections' to
-- 'GI.Secret.Objects.Service.serviceGetSync' in order to ensure that the collections have been
-- loaded by the time you get the t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method will return immediately and complete asynchronously.
serviceLoadCollections ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: the secret service
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceLoadCollections :: a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
serviceLoadCollections self :: a
self cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Service
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_load_collections Ptr Service
self' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    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
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServiceLoadCollectionsMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceLoadCollectionsMethodInfo a signature where
    overloadedMethod = serviceLoadCollections

#endif

-- method Service::load_collections_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_load_collections_finish" secret_service_load_collections_finish :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Complete an asynchronous operation to ensure that the t'GI.Secret.Objects.Service.Service' proxy
-- has loaded all the collections present in the Secret Service.
serviceLoadCollectionsFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: the secret service
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceLoadCollectionsFinish :: a -> b -> m ()
serviceLoadCollectionsFinish self :: a
self result_ :: b
result_ = 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 Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Service -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
secret_service_load_collections_finish Ptr Service
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceLoadCollectionsFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ServiceLoadCollectionsFinishMethodInfo a signature where
    overloadedMethod = serviceLoadCollectionsFinish

#endif

-- method Service::load_collections_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_load_collections_sync" secret_service_load_collections_sync :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Ensure that the t'GI.Secret.Objects.Service.Service' proxy has loaded all the collections present
-- in the Secret Service. This affects the result of
-- 'GI.Secret.Objects.Service.serviceGetCollections'.
-- 
-- You can also pass the 'GI.Secret.Flags.ServiceFlagsLoadCollections' to
-- 'GI.Secret.Objects.Service.serviceGetSync' in order to ensure that the collections have been
-- loaded by the time you get the t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method may block indefinitely and should not be used in user interface
-- threads.
serviceLoadCollectionsSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: the secret service
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceLoadCollectionsSync :: a -> Maybe b -> m ()
serviceLoadCollectionsSync self :: a
self cancellable :: Maybe b
cancellable = 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 Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Service -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
secret_service_load_collections_sync Ptr Service
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        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
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceLoadCollectionsSyncMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceLoadCollectionsSyncMethodInfo a signature where
    overloadedMethod = serviceLoadCollectionsSync

#endif

-- method Service::lock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objects"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the items or collections to lock"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_lock" secret_service_lock :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr (GList (Ptr Gio.DBusProxy.DBusProxy)) -> -- objects : TGList (TInterface (Name {namespace = "Gio", name = "DBusProxy"}))
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Lock items or collections in the secret service.
-- 
-- The secret service may not be able to lock items individually, and may
-- lock an entire collection instead.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGet' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method returns immediately and completes asynchronously. The secret
-- service may prompt the user. 'GI.Secret.Objects.Service.servicePrompt' will be used to handle
-- any prompts that show up.
serviceLock ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.DBusProxy.IsDBusProxy b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@service@/: the secret service
    -> [b]
    -- ^ /@objects@/: the items or collections to lock
    -> Maybe (c)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceLock :: a -> [b] -> Maybe c -> Maybe AsyncReadyCallback -> m ()
serviceLock service :: a
service objects :: [b]
objects cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    [Ptr DBusProxy]
objects' <- (b -> IO (Ptr DBusProxy)) -> [b] -> IO [Ptr DBusProxy]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM b -> IO (Ptr DBusProxy)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [b]
objects
    Ptr (GList (Ptr DBusProxy))
objects'' <- [Ptr DBusProxy] -> IO (Ptr (GList (Ptr DBusProxy)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr DBusProxy]
objects'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Service
-> Ptr (GList (Ptr DBusProxy))
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_lock Ptr Service
service' Ptr (GList (Ptr DBusProxy))
objects'' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
    (b -> IO ()) -> [b] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [b]
objects
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr (GList (Ptr DBusProxy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusProxy))
objects''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServiceLockMethodInfo
instance (signature ~ ([b] -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsService a, Gio.DBusProxy.IsDBusProxy b, Gio.Cancellable.IsCancellable c) => O.MethodInfo ServiceLockMethodInfo a signature where
    overloadedMethod = serviceLock

#endif

-- method Service::lock_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "locked"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "\n         location to place list of items or collections that were locked"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_lock_finish" secret_service_lock_finish :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))) -> -- locked : TGList (TInterface (Name {namespace = "Gio", name = "DBusProxy"}))
    Ptr (Ptr GError) ->                     -- error
    IO Int32

-- | Complete asynchronous operation to lock items or collections in the secret
-- service.
-- 
-- The secret service may not be able to lock items individually, and may
-- lock an entire collection instead.
serviceLockFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@service@/: the secret service
    -> b
    -- ^ /@result@/: asynchronous result passed to the callback
    -> m ((Int32, [Gio.DBusProxy.DBusProxy]))
    -- ^ __Returns:__ the number of items or collections that were locked /(Can throw 'Data.GI.Base.GError.GError')/
serviceLockFinish :: a -> b -> m (Int32, [DBusProxy])
serviceLockFinish service :: a
service result_ :: b
result_ = IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy]))
-> IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr (Ptr (GList (Ptr DBusProxy)))
locked <- IO (Ptr (Ptr (GList (Ptr DBusProxy))))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))))
    IO (Int32, [DBusProxy]) -> IO () -> IO (Int32, [DBusProxy])
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr AsyncResult
-> Ptr (Ptr (GList (Ptr DBusProxy)))
-> Ptr (Ptr GError)
-> IO Int32
secret_service_lock_finish Ptr Service
service' Ptr AsyncResult
result_' Ptr (Ptr (GList (Ptr DBusProxy)))
locked
        Ptr (GList (Ptr DBusProxy))
locked' <- Ptr (Ptr (GList (Ptr DBusProxy)))
-> IO (Ptr (GList (Ptr DBusProxy)))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (GList (Ptr DBusProxy)))
locked
        [Ptr DBusProxy]
locked'' <- Ptr (GList (Ptr DBusProxy)) -> IO [Ptr DBusProxy]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DBusProxy))
locked'
        [DBusProxy]
locked''' <- (Ptr DBusProxy -> IO DBusProxy)
-> [Ptr DBusProxy] -> IO [DBusProxy]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr DBusProxy -> DBusProxy)
-> Ptr DBusProxy -> IO DBusProxy
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusProxy -> DBusProxy
Gio.DBusProxy.DBusProxy) [Ptr DBusProxy]
locked''
        Ptr (GList (Ptr DBusProxy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusProxy))
locked'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr (Ptr (GList (Ptr DBusProxy))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GList (Ptr DBusProxy)))
locked
        (Int32, [DBusProxy]) -> IO (Int32, [DBusProxy])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, [DBusProxy]
locked''')
     ) (do
        Ptr (Ptr (GList (Ptr DBusProxy))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GList (Ptr DBusProxy)))
locked
     )

#if defined(ENABLE_OVERLOADING)
data ServiceLockFinishMethodInfo
instance (signature ~ (b -> m ((Int32, [Gio.DBusProxy.DBusProxy]))), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ServiceLockFinishMethodInfo a signature where
    overloadedMethod = serviceLockFinish

#endif

-- method Service::lock_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objects"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the items or collections to lock"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "locked"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "\n         location to place list of items or collections that were locked"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_lock_sync" secret_service_lock_sync :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr (GList (Ptr Gio.DBusProxy.DBusProxy)) -> -- objects : TGList (TInterface (Name {namespace = "Gio", name = "DBusProxy"}))
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))) -> -- locked : TGList (TInterface (Name {namespace = "Gio", name = "DBusProxy"}))
    Ptr (Ptr GError) ->                     -- error
    IO Int32

-- | Lock items or collections in the secret service.
-- 
-- The secret service may not be able to lock items individually, and may
-- lock an entire collection instead.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGetSync' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method may block indefinitely and should not be used in user
-- interface threads. The secret service may prompt the user.
-- 'GI.Secret.Objects.Service.servicePrompt' will be used to handle any prompts that show up.
serviceLockSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.DBusProxy.IsDBusProxy b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@service@/: the secret service
    -> [b]
    -- ^ /@objects@/: the items or collections to lock
    -> Maybe (c)
    -- ^ /@cancellable@/: optional cancellation object
    -> m ((Int32, [Gio.DBusProxy.DBusProxy]))
    -- ^ __Returns:__ the number of items or collections that were locked /(Can throw 'Data.GI.Base.GError.GError')/
serviceLockSync :: a -> [b] -> Maybe c -> m (Int32, [DBusProxy])
serviceLockSync service :: a
service objects :: [b]
objects cancellable :: Maybe c
cancellable = IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy]))
-> IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    [Ptr DBusProxy]
objects' <- (b -> IO (Ptr DBusProxy)) -> [b] -> IO [Ptr DBusProxy]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM b -> IO (Ptr DBusProxy)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [b]
objects
    Ptr (GList (Ptr DBusProxy))
objects'' <- [Ptr DBusProxy] -> IO (Ptr (GList (Ptr DBusProxy)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr DBusProxy]
objects'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    Ptr (Ptr (GList (Ptr DBusProxy)))
locked <- IO (Ptr (Ptr (GList (Ptr DBusProxy))))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))))
    IO (Int32, [DBusProxy]) -> IO () -> IO (Int32, [DBusProxy])
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr (GList (Ptr DBusProxy))
-> Ptr Cancellable
-> Ptr (Ptr (GList (Ptr DBusProxy)))
-> Ptr (Ptr GError)
-> IO Int32
secret_service_lock_sync Ptr Service
service' Ptr (GList (Ptr DBusProxy))
objects'' Ptr Cancellable
maybeCancellable Ptr (Ptr (GList (Ptr DBusProxy)))
locked
        Ptr (GList (Ptr DBusProxy))
locked' <- Ptr (Ptr (GList (Ptr DBusProxy)))
-> IO (Ptr (GList (Ptr DBusProxy)))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (GList (Ptr DBusProxy)))
locked
        [Ptr DBusProxy]
locked'' <- Ptr (GList (Ptr DBusProxy)) -> IO [Ptr DBusProxy]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DBusProxy))
locked'
        [DBusProxy]
locked''' <- (Ptr DBusProxy -> IO DBusProxy)
-> [Ptr DBusProxy] -> IO [DBusProxy]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr DBusProxy -> DBusProxy)
-> Ptr DBusProxy -> IO DBusProxy
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusProxy -> DBusProxy
Gio.DBusProxy.DBusProxy) [Ptr DBusProxy]
locked''
        Ptr (GList (Ptr DBusProxy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusProxy))
locked'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        (b -> IO ()) -> [b] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [b]
objects
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (GList (Ptr DBusProxy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusProxy))
objects''
        Ptr (Ptr (GList (Ptr DBusProxy))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GList (Ptr DBusProxy)))
locked
        (Int32, [DBusProxy]) -> IO (Int32, [DBusProxy])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, [DBusProxy]
locked''')
     ) (do
        Ptr (GList (Ptr DBusProxy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusProxy))
objects''
        Ptr (Ptr (GList (Ptr DBusProxy))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GList (Ptr DBusProxy)))
locked
     )

#if defined(ENABLE_OVERLOADING)
data ServiceLockSyncMethodInfo
instance (signature ~ ([b] -> Maybe (c) -> m ((Int32, [Gio.DBusProxy.DBusProxy]))), MonadIO m, IsService a, Gio.DBusProxy.IsDBusProxy b, Gio.Cancellable.IsCancellable c) => O.MethodInfo ServiceLockSyncMethodInfo a signature where
    overloadedMethod = serviceLockSync

#endif

-- method Service::lookup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema for the attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute keys and values"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_lookup" secret_service_lookup :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Schema.Schema ->             -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    Ptr (GHashTable CString CString) ->     -- attributes : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Lookup a secret value in the secret service.
-- 
-- The /@attributes@/ should be a set of key and value string pairs.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGet' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method will return immediately and complete asynchronously.
serviceLookup ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@service@/: the secret service
    -> Maybe (Secret.Schema.Schema)
    -- ^ /@schema@/: the schema for the attributes
    -> Map.Map T.Text T.Text
    -- ^ /@attributes@/: the attribute keys and values
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceLookup :: a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceLookup service :: a
service schema :: Maybe Schema
schema attributes :: Map Text Text
attributes cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr Schema
maybeSchema <- case Maybe Schema
schema of
        Nothing -> Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
nullPtr
        Just jSchema :: Schema
jSchema -> do
            Ptr Schema
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
jSchema'
    let attributes' :: [(Text, Text)]
attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    [(CString, Text)]
attributes'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
attributes'
    [(CString, CString)]
attributes''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
attributes''
    let attributes'''' :: [(PtrWrapped CString, CString)]
attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
attributes'''
    let attributes''''' :: [(PtrWrapped CString, PtrWrapped CString)]
attributes''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    Ptr (GHashTable CString CString)
attributes'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
attributes'''''
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Service
-> Ptr Schema
-> Ptr (GHashTable CString CString)
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_lookup Ptr Service
service' Ptr Schema
maybeSchema Ptr (GHashTable CString CString)
attributes'''''' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
    Maybe Schema -> (Schema -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Schema
schema Schema -> 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
    Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServiceLookupMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceLookupMethodInfo a signature where
    overloadedMethod = serviceLookup

#endif

-- method Service::lookup_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Value" })
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_lookup_finish" secret_service_lookup_finish :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Secret.Value.Value)

-- | Finish asynchronous operation to lookup a secret value in the secret service.
-- 
-- If no secret is found then 'P.Nothing' is returned.
serviceLookupFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@service@/: the secret service
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m Secret.Value.Value
    -- ^ __Returns:__ a newly allocated t'GI.Secret.Structs.Value.Value', which should be
    --          released with 'GI.Secret.Structs.Value.valueUnref', or 'P.Nothing' if no secret found /(Can throw 'Data.GI.Base.GError.GError')/
serviceLookupFinish :: a -> b -> m Value
serviceLookupFinish service :: a
service result_ :: b
result_ = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO Value -> IO () -> IO Value
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Value
result <- (Ptr (Ptr GError) -> IO (Ptr Value)) -> IO (Ptr Value)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Value)) -> IO (Ptr Value))
-> (Ptr (Ptr GError) -> IO (Ptr Value)) -> IO (Ptr Value)
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Value)
secret_service_lookup_finish Ptr Service
service' Ptr AsyncResult
result_'
        Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "serviceLookupFinish" Ptr Value
result
        Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Value -> Value
Secret.Value.Value) Ptr Value
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceLookupFinishMethodInfo
instance (signature ~ (b -> m Secret.Value.Value), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ServiceLookupFinishMethodInfo a signature where
    overloadedMethod = serviceLookupFinish

#endif

-- method Service::lookup_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema for the attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute keys and values"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Value" })
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_lookup_sync" secret_service_lookup_sync :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Schema.Schema ->             -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    Ptr (GHashTable CString CString) ->     -- attributes : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Secret.Value.Value)

-- | Lookup a secret value in the secret service.
-- 
-- The /@attributes@/ should be a set of key and value string pairs.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGetSync' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method may block indefinitely and should not be used in user interface
-- threads.
serviceLookupSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@service@/: the secret service
    -> Maybe (Secret.Schema.Schema)
    -- ^ /@schema@/: the schema for the attributes
    -> Map.Map T.Text T.Text
    -- ^ /@attributes@/: the attribute keys and values
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m Secret.Value.Value
    -- ^ __Returns:__ a newly allocated t'GI.Secret.Structs.Value.Value', which should be
    --          released with 'GI.Secret.Structs.Value.valueUnref', or 'P.Nothing' if no secret found /(Can throw 'Data.GI.Base.GError.GError')/
serviceLookupSync :: a -> Maybe Schema -> Map Text Text -> Maybe b -> m Value
serviceLookupSync service :: a
service schema :: Maybe Schema
schema attributes :: Map Text Text
attributes cancellable :: Maybe b
cancellable = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr Schema
maybeSchema <- case Maybe Schema
schema of
        Nothing -> Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
nullPtr
        Just jSchema :: Schema
jSchema -> do
            Ptr Schema
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
jSchema'
    let attributes' :: [(Text, Text)]
attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    [(CString, Text)]
attributes'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
attributes'
    [(CString, CString)]
attributes''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
attributes''
    let attributes'''' :: [(PtrWrapped CString, CString)]
attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
attributes'''
    let attributes''''' :: [(PtrWrapped CString, PtrWrapped CString)]
attributes''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    Ptr (GHashTable CString CString)
attributes'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
attributes'''''
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 Value -> IO () -> IO Value
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Value
result <- (Ptr (Ptr GError) -> IO (Ptr Value)) -> IO (Ptr Value)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Value)) -> IO (Ptr Value))
-> (Ptr (Ptr GError) -> IO (Ptr Value)) -> IO (Ptr Value)
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr Schema
-> Ptr (GHashTable CString CString)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Value)
secret_service_lookup_sync Ptr Service
service' Ptr Schema
maybeSchema Ptr (GHashTable CString CString)
attributes'''''' Ptr Cancellable
maybeCancellable
        Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "serviceLookupSync" Ptr Value
result
        Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Value -> Value
Secret.Value.Value) Ptr Value
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        Maybe Schema -> (Schema -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Schema
schema Schema -> 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
        Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
        Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'
     ) (do
        Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
     )

#if defined(ENABLE_OVERLOADING)
data ServiceLookupSyncMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> Maybe (b) -> m Secret.Value.Value), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceLookupSyncMethodInfo a signature where
    overloadedMethod = serviceLookupSync

#endif

-- method Service::prompt
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prompt"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Prompt" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the prompt" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "return_type"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "VariantType" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the variant type of the prompt result"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_prompt" secret_service_prompt :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Prompt.Prompt ->             -- prompt : TInterface (Name {namespace = "Secret", name = "Prompt"})
    Ptr GLib.VariantType.VariantType ->     -- return_type : TInterface (Name {namespace = "GLib", name = "VariantType"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Perform prompting for a t'GI.Secret.Objects.Prompt.Prompt'.
-- 
-- This function is called by other parts of this library to handle prompts
-- for the various actions that can require prompting.
-- 
-- Override the t'GI.Secret.Structs.ServiceClass.ServiceClass' \<literal>prompt_async\<\/literal> virtual method
-- to change the behavior of the prompting. The default behavior is to simply
-- run 'GI.Secret.Objects.Prompt.promptPerform' on the prompt.
servicePrompt ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Secret.Prompt.IsPrompt b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: the secret service
    -> b
    -- ^ /@prompt@/: the prompt
    -> Maybe (GLib.VariantType.VariantType)
    -- ^ /@returnType@/: the variant type of the prompt result
    -> Maybe (c)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
servicePrompt :: a
-> b
-> Maybe VariantType
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
servicePrompt self :: a
self prompt :: b
prompt returnType :: Maybe VariantType
returnType cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Prompt
prompt' <- b -> IO (Ptr Prompt)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
prompt
    Ptr VariantType
maybeReturnType <- case Maybe VariantType
returnType of
        Nothing -> Ptr VariantType -> IO (Ptr VariantType)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VariantType
forall a. Ptr a
nullPtr
        Just jReturnType :: VariantType
jReturnType -> do
            Ptr VariantType
jReturnType' <- VariantType -> IO (Ptr VariantType)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VariantType
jReturnType
            Ptr VariantType -> IO (Ptr VariantType)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VariantType
jReturnType'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Service
-> Ptr Prompt
-> Ptr VariantType
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_prompt Ptr Service
self' Ptr Prompt
prompt' Ptr VariantType
maybeReturnType Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
prompt
    Maybe VariantType -> (VariantType -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe VariantType
returnType VariantType -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServicePromptMethodInfo
instance (signature ~ (b -> Maybe (GLib.VariantType.VariantType) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsService a, Secret.Prompt.IsPrompt b, Gio.Cancellable.IsCancellable c) => O.MethodInfo ServicePromptMethodInfo a signature where
    overloadedMethod = servicePrompt

#endif

-- method Service::prompt_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_prompt_finish" secret_service_prompt_finish :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GVariant)

-- | Complete asynchronous operation to perform prompting for a t'GI.Secret.Objects.Prompt.Prompt'.
-- 
-- Returns a variant result if the prompt was completed and not dismissed. The
-- type of result depends on the action the prompt is completing, and is defined
-- in the Secret Service DBus API specification.
servicePromptFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: the secret service
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m GVariant
    -- ^ __Returns:__ 'P.Nothing' if the prompt was dismissed or an error occurred,
    --          a variant result if the prompt was successful /(Can throw 'Data.GI.Base.GError.GError')/
servicePromptFinish :: a -> b -> m GVariant
servicePromptFinish self :: a
self result_ :: b
result_ = IO GVariant -> m GVariant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr GVariant)
secret_service_prompt_finish Ptr Service
self' Ptr AsyncResult
result_'
        Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "servicePromptFinish" Ptr GVariant
result
        GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServicePromptFinishMethodInfo
instance (signature ~ (b -> m GVariant), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ServicePromptFinishMethodInfo a signature where
    overloadedMethod = servicePromptFinish

#endif

-- method Service::prompt_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prompt"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Prompt" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the prompt" , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "return_type"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "VariantType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the variant type of the prompt result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_prompt_sync" secret_service_prompt_sync :: 
    Ptr Service ->                          -- self : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Prompt.Prompt ->             -- prompt : TInterface (Name {namespace = "Secret", name = "Prompt"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr GLib.VariantType.VariantType ->     -- return_type : TInterface (Name {namespace = "GLib", name = "VariantType"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GVariant)

-- | Perform prompting for a t'GI.Secret.Objects.Prompt.Prompt'.
-- 
-- Runs a prompt and performs the prompting. Returns a variant result if the
-- prompt was completed and not dismissed. The type of result depends on the
-- action the prompt is completing, and is defined in the Secret Service DBus
-- API specification.
-- 
-- This function is called by other parts of this library to handle prompts
-- for the various actions that can require prompting.
-- 
-- Override the t'GI.Secret.Structs.ServiceClass.ServiceClass' \<literal>prompt_sync\<\/literal> virtual method
-- to change the behavior of the prompting. The default behavior is to simply
-- run 'GI.Secret.Objects.Prompt.promptPerformSync' on the prompt with a 'P.Nothing' \<literal>window_id\<\/literal>.
servicePromptSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Secret.Prompt.IsPrompt b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: the secret service
    -> b
    -- ^ /@prompt@/: the prompt
    -> Maybe (c)
    -- ^ /@cancellable@/: optional cancellation object
    -> GLib.VariantType.VariantType
    -- ^ /@returnType@/: the variant type of the prompt result
    -> m GVariant
    -- ^ __Returns:__ 'P.Nothing' if the prompt was dismissed or an error occurred,
    --          a variant result if the prompt was successful /(Can throw 'Data.GI.Base.GError.GError')/
servicePromptSync :: a -> b -> Maybe c -> VariantType -> m GVariant
servicePromptSync self :: a
self prompt :: b
prompt cancellable :: Maybe c
cancellable returnType :: VariantType
returnType = IO GVariant -> m GVariant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Prompt
prompt' <- b -> IO (Ptr Prompt)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
prompt
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    Ptr VariantType
returnType' <- VariantType -> IO (Ptr VariantType)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VariantType
returnType
    IO GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr Prompt
-> Ptr Cancellable
-> Ptr VariantType
-> Ptr (Ptr GError)
-> IO (Ptr GVariant)
secret_service_prompt_sync Ptr Service
self' Ptr Prompt
prompt' Ptr Cancellable
maybeCancellable Ptr VariantType
returnType'
        Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "servicePromptSync" Ptr GVariant
result
        GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
prompt
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        VariantType -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VariantType
returnType
        GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServicePromptSyncMethodInfo
instance (signature ~ (b -> Maybe (c) -> GLib.VariantType.VariantType -> m GVariant), MonadIO m, IsService a, Secret.Prompt.IsPrompt b, Gio.Cancellable.IsCancellable c) => O.MethodInfo ServicePromptSyncMethodInfo a signature where
    overloadedMethod = servicePromptSync

#endif

-- method Service::search
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema for the attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "search for items matching these attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "SearchFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "search option flags"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_search" secret_service_search :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Schema.Schema ->             -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    Ptr (GHashTable CString CString) ->     -- attributes : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "SearchFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Search for items matching the /@attributes@/. All collections are searched.
-- The /@attributes@/ should be a table of string keys and string values.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGet' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- If 'GI.Secret.Flags.SearchFlagsAll' is set in /@flags@/, then all the items matching the
-- search will be returned. Otherwise only the first item will be returned.
-- This is almost always the unlocked item that was most recently stored.
-- 
-- If 'GI.Secret.Flags.SearchFlagsUnlock' is set in /@flags@/, then items will be unlocked
-- if necessary. In either case, locked and unlocked items will match the
-- search and be returned. If the unlock fails, the search does not fail.
-- 
-- If 'GI.Secret.Flags.SearchFlagsLoadSecrets' is set in /@flags@/, then the items will have
-- their secret values loaded and available via 'GI.Secret.Objects.Item.itemGetSecret'.
-- 
-- This function returns immediately and completes asynchronously.
serviceSearch ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@service@/: the secret service
    -> Maybe (Secret.Schema.Schema)
    -- ^ /@schema@/: the schema for the attributes
    -> Map.Map T.Text T.Text
    -- ^ /@attributes@/: search for items matching these attributes
    -> [Secret.Flags.SearchFlags]
    -- ^ /@flags@/: search option flags
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceSearch :: a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceSearch service :: a
service schema :: Maybe Schema
schema attributes :: Map Text Text
attributes flags :: [SearchFlags]
flags cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr Schema
maybeSchema <- case Maybe Schema
schema of
        Nothing -> Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
nullPtr
        Just jSchema :: Schema
jSchema -> do
            Ptr Schema
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
jSchema'
    let attributes' :: [(Text, Text)]
attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    [(CString, Text)]
attributes'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
attributes'
    [(CString, CString)]
attributes''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
attributes''
    let attributes'''' :: [(PtrWrapped CString, CString)]
attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
attributes'''
    let attributes''''' :: [(PtrWrapped CString, PtrWrapped CString)]
attributes''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    Ptr (GHashTable CString CString)
attributes'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
attributes'''''
    let flags' :: CUInt
flags' = [SearchFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SearchFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Service
-> Ptr Schema
-> Ptr (GHashTable CString CString)
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_search Ptr Service
service' Ptr Schema
maybeSchema Ptr (GHashTable CString CString)
attributes'''''' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
    Maybe Schema -> (Schema -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Schema
schema Schema -> 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
    Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServiceSearchMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> [Secret.Flags.SearchFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceSearchMethodInfo a signature where
    overloadedMethod = serviceSearch

#endif

-- method Service::search_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "asynchronous result passed to callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Secret" , name = "Item" }))
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_search_finish" secret_service_search_finish :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr Secret.Item.Item)))

-- | Complete asynchronous operation to search for items.
serviceSearchFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@service@/: the secret service
    -> b
    -- ^ /@result@/: asynchronous result passed to callback
    -> m [Secret.Item.Item]
    -- ^ __Returns:__ 
    --          a list of items that matched the search /(Can throw 'Data.GI.Base.GError.GError')/
serviceSearchFinish :: a -> b -> m [Item]
serviceSearchFinish service :: a
service result_ :: b
result_ = IO [Item] -> m [Item]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Item] -> m [Item]) -> IO [Item] -> m [Item]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO [Item] -> IO () -> IO [Item]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (GList (Ptr Item))
result <- (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
-> IO (Ptr (GList (Ptr Item)))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
 -> IO (Ptr (GList (Ptr Item))))
-> (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
-> IO (Ptr (GList (Ptr Item)))
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr (GList (Ptr Item)))
secret_service_search_finish Ptr Service
service' Ptr AsyncResult
result_'
        [Ptr Item]
result' <- Ptr (GList (Ptr Item)) -> IO [Ptr Item]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Item))
result
        [Item]
result'' <- (Ptr Item -> IO Item) -> [Ptr Item] -> IO [Item]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Item -> Item) -> Ptr Item -> IO Item
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Item -> Item
Secret.Item.Item) [Ptr Item]
result'
        Ptr (GList (Ptr Item)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Item))
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        [Item] -> IO [Item]
forall (m :: * -> *) a. Monad m => a -> m a
return [Item]
result''
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceSearchFinishMethodInfo
instance (signature ~ (b -> m [Secret.Item.Item]), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ServiceSearchFinishMethodInfo a signature where
    overloadedMethod = serviceSearchFinish

#endif

-- method Service::search_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema for the attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "search for items matching these attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "SearchFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "search option flags"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Secret" , name = "Item" }))
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_search_sync" secret_service_search_sync :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Schema.Schema ->             -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    Ptr (GHashTable CString CString) ->     -- attributes : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "SearchFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr Secret.Item.Item)))

-- | Search for items matching the /@attributes@/. All collections are searched.
-- The /@attributes@/ should be a table of string keys and string values.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGetSync' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- If 'GI.Secret.Flags.SearchFlagsAll' is set in /@flags@/, then all the items matching the
-- search will be returned. Otherwise only the first item will be returned.
-- This is almost always the unlocked item that was most recently stored.
-- 
-- If 'GI.Secret.Flags.SearchFlagsUnlock' is set in /@flags@/, then items will be unlocked
-- if necessary. In either case, locked and unlocked items will match the
-- search and be returned. If the unlock fails, the search does not fail.
-- 
-- If 'GI.Secret.Flags.SearchFlagsLoadSecrets' is set in /@flags@/, then the items\' secret
-- values will be loaded for any unlocked items. Loaded item secret values
-- are available via 'GI.Secret.Objects.Item.itemGetSecret'. If the load of a secret values
-- fail, then the
-- 
-- This function may block indefinitely. Use the asynchronous version
-- in user interface threads.
serviceSearchSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@service@/: the secret service
    -> Maybe (Secret.Schema.Schema)
    -- ^ /@schema@/: the schema for the attributes
    -> Map.Map T.Text T.Text
    -- ^ /@attributes@/: search for items matching these attributes
    -> [Secret.Flags.SearchFlags]
    -- ^ /@flags@/: search option flags
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m [Secret.Item.Item]
    -- ^ __Returns:__ 
    --          a list of items that matched the search /(Can throw 'Data.GI.Base.GError.GError')/
serviceSearchSync :: a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> m [Item]
serviceSearchSync service :: a
service schema :: Maybe Schema
schema attributes :: Map Text Text
attributes flags :: [SearchFlags]
flags cancellable :: Maybe b
cancellable = IO [Item] -> m [Item]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Item] -> m [Item]) -> IO [Item] -> m [Item]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr Schema
maybeSchema <- case Maybe Schema
schema of
        Nothing -> Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
nullPtr
        Just jSchema :: Schema
jSchema -> do
            Ptr Schema
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
jSchema'
    let attributes' :: [(Text, Text)]
attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    [(CString, Text)]
attributes'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
attributes'
    [(CString, CString)]
attributes''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
attributes''
    let attributes'''' :: [(PtrWrapped CString, CString)]
attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
attributes'''
    let attributes''''' :: [(PtrWrapped CString, PtrWrapped CString)]
attributes''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    Ptr (GHashTable CString CString)
attributes'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
attributes'''''
    let flags' :: CUInt
flags' = [SearchFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SearchFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 [Item] -> IO () -> IO [Item]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (GList (Ptr Item))
result <- (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
-> IO (Ptr (GList (Ptr Item)))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
 -> IO (Ptr (GList (Ptr Item))))
-> (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
-> IO (Ptr (GList (Ptr Item)))
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr Schema
-> Ptr (GHashTable CString CString)
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr (GList (Ptr Item)))
secret_service_search_sync Ptr Service
service' Ptr Schema
maybeSchema Ptr (GHashTable CString CString)
attributes'''''' CUInt
flags' Ptr Cancellable
maybeCancellable
        [Ptr Item]
result' <- Ptr (GList (Ptr Item)) -> IO [Ptr Item]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Item))
result
        [Item]
result'' <- (Ptr Item -> IO Item) -> [Ptr Item] -> IO [Item]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Item -> Item) -> Ptr Item -> IO Item
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Item -> Item
Secret.Item.Item) [Ptr Item]
result'
        Ptr (GList (Ptr Item)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Item))
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        Maybe Schema -> (Schema -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Schema
schema Schema -> 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
        Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
        [Item] -> IO [Item]
forall (m :: * -> *) a. Monad m => a -> m a
return [Item]
result''
     ) (do
        Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
     )

#if defined(ENABLE_OVERLOADING)
data ServiceSearchSyncMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> [Secret.Flags.SearchFlags] -> Maybe (b) -> m [Secret.Item.Item]), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceSearchSyncMethodInfo a signature where
    overloadedMethod = serviceSearchSync

#endif

-- method Service::set_alias
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret service object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alias"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the alias to assign the collection to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "collection"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collection to assign to the alias"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_set_alias" secret_service_set_alias :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    CString ->                              -- alias : TBasicType TUTF8
    Ptr Secret.Collection.Collection ->     -- collection : TInterface (Name {namespace = "Secret", name = "Collection"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Assign a collection to this alias. Aliases help determine
-- well known collections, such as \'default\'.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGet' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method will return immediately and complete asynchronously.
serviceSetAlias ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Secret.Collection.IsCollection b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@service@/: a secret service object
    -> T.Text
    -- ^ /@alias@/: the alias to assign the collection to
    -> Maybe (b)
    -- ^ /@collection@/: the collection to assign to the alias
    -> Maybe (c)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceSetAlias :: a -> Text -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
serviceSetAlias service :: a
service alias :: Text
alias collection :: Maybe b
collection cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    CString
alias' <- Text -> IO CString
textToCString Text
alias
    Ptr Collection
maybeCollection <- case Maybe b
collection of
        Nothing -> Ptr Collection -> IO (Ptr Collection)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Collection
forall a. Ptr a
nullPtr
        Just jCollection :: b
jCollection -> do
            Ptr Collection
jCollection' <- b -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCollection
            Ptr Collection -> IO (Ptr Collection)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Collection
jCollection'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Service
-> CString
-> Ptr Collection
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_set_alias Ptr Service
service' CString
alias' Ptr Collection
maybeCollection Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
collection b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
alias'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServiceSetAliasMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsService a, Secret.Collection.IsCollection b, Gio.Cancellable.IsCancellable c) => O.MethodInfo ServiceSetAliasMethodInfo a signature where
    overloadedMethod = serviceSetAlias

#endif

-- method Service::set_alias_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret service object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "asynchronous result passed to callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_set_alias_finish" secret_service_set_alias_finish :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finish an asynchronous operation to assign a collection to an alias.
serviceSetAliasFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@service@/: a secret service object
    -> b
    -- ^ /@result@/: asynchronous result passed to callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceSetAliasFinish :: a -> b -> m ()
serviceSetAliasFinish service :: a
service result_ :: b
result_ = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Service -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
secret_service_set_alias_finish Ptr Service
service' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceSetAliasFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ServiceSetAliasFinishMethodInfo a signature where
    overloadedMethod = serviceSetAliasFinish

#endif

-- method Service::set_alias_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret service object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alias"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the alias to assign the collection to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "collection"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collection to assign to the alias"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_set_alias_sync" secret_service_set_alias_sync :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    CString ->                              -- alias : TBasicType TUTF8
    Ptr Secret.Collection.Collection ->     -- collection : TInterface (Name {namespace = "Secret", name = "Collection"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Assign a collection to this alias. Aliases help determine
-- well known collections, such as \'default\'.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGetSync' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method may block and should not be used in user interface threads.
serviceSetAliasSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Secret.Collection.IsCollection b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@service@/: a secret service object
    -> T.Text
    -- ^ /@alias@/: the alias to assign the collection to
    -> Maybe (b)
    -- ^ /@collection@/: the collection to assign to the alias
    -> Maybe (c)
    -- ^ /@cancellable@/: optional cancellation object
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceSetAliasSync :: a -> Text -> Maybe b -> Maybe c -> m ()
serviceSetAliasSync service :: a
service alias :: Text
alias collection :: Maybe b
collection cancellable :: Maybe c
cancellable = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    CString
alias' <- Text -> IO CString
textToCString Text
alias
    Ptr Collection
maybeCollection <- case Maybe b
collection of
        Nothing -> Ptr Collection -> IO (Ptr Collection)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Collection
forall a. Ptr a
nullPtr
        Just jCollection :: b
jCollection -> do
            Ptr Collection
jCollection' <- b -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCollection
            Ptr Collection -> IO (Ptr Collection)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Collection
jCollection'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> CString
-> Ptr Collection
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
secret_service_set_alias_sync Ptr Service
service' CString
alias' Ptr Collection
maybeCollection Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
collection b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
alias'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
alias'
     )

#if defined(ENABLE_OVERLOADING)
data ServiceSetAliasSyncMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (c) -> m ()), MonadIO m, IsService a, Secret.Collection.IsCollection b, Gio.Cancellable.IsCancellable c) => O.MethodInfo ServiceSetAliasSyncMethodInfo a signature where
    overloadedMethod = serviceSetAliasSync

#endif

-- method Service::store
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema to use to check attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute keys and values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "collection"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a collection alias, or D-Bus object path of the collection where to store the secret"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "label for the secret"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret value" , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 8
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_store" secret_service_store :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Schema.Schema ->             -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    Ptr (GHashTable CString CString) ->     -- attributes : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    CString ->                              -- collection : TBasicType TUTF8
    CString ->                              -- label : TBasicType TUTF8
    Ptr Secret.Value.Value ->               -- value : TInterface (Name {namespace = "Secret", name = "Value"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Store a secret value in the secret service.
-- 
-- The /@attributes@/ should be a set of key and value string pairs.
-- 
-- If the attributes match a secret item already stored in the collection, then
-- the item will be updated with these new values.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGet' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- If /@collection@/ is not specified, then the default collection will be
-- used. Use 'GI.Secret.Constants.COLLECTION_SESSION' to store the password in the session
-- collection, which doesn\'t get stored across login sessions.
-- 
-- This method will return immediately and complete asynchronously.
serviceStore ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@service@/: the secret service
    -> Maybe (Secret.Schema.Schema)
    -- ^ /@schema@/: the schema to use to check attributes
    -> Map.Map T.Text T.Text
    -- ^ /@attributes@/: the attribute keys and values
    -> Maybe (T.Text)
    -- ^ /@collection@/: a collection alias, or D-Bus object path of the collection where to store the secret
    -> T.Text
    -- ^ /@label@/: label for the secret
    -> Secret.Value.Value
    -- ^ /@value@/: the secret value
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceStore :: a
-> Maybe Schema
-> Map Text Text
-> Maybe Text
-> Text
-> Value
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceStore service :: a
service schema :: Maybe Schema
schema attributes :: Map Text Text
attributes collection :: Maybe Text
collection label :: Text
label value :: Value
value cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr Schema
maybeSchema <- case Maybe Schema
schema of
        Nothing -> Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
nullPtr
        Just jSchema :: Schema
jSchema -> do
            Ptr Schema
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
jSchema'
    let attributes' :: [(Text, Text)]
attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    [(CString, Text)]
attributes'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
attributes'
    [(CString, CString)]
attributes''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
attributes''
    let attributes'''' :: [(PtrWrapped CString, CString)]
attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
attributes'''
    let attributes''''' :: [(PtrWrapped CString, PtrWrapped CString)]
attributes''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    Ptr (GHashTable CString CString)
attributes'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
attributes'''''
    CString
maybeCollection <- case Maybe Text
collection of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jCollection :: Text
jCollection -> do
            CString
jCollection' <- Text -> IO CString
textToCString Text
jCollection
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCollection'
    CString
label' <- Text -> IO CString
textToCString Text
label
    Ptr Value
value' <- Value -> IO (Ptr Value)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Value
value
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Service
-> Ptr Schema
-> Ptr (GHashTable CString CString)
-> CString
-> CString
-> Ptr Value
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_store Ptr Service
service' Ptr Schema
maybeSchema Ptr (GHashTable CString CString)
attributes'''''' CString
maybeCollection CString
label' Ptr Value
value' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
    Maybe Schema -> (Schema -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Schema
schema Schema -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Value
value
    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
    Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCollection
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServiceStoreMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> Maybe (T.Text) -> T.Text -> Secret.Value.Value -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceStoreMethodInfo a signature where
    overloadedMethod = serviceStore

#endif

-- method Service::store_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_store_finish" secret_service_store_finish :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finish asynchronous operation to store a secret value in the secret service.
serviceStoreFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@service@/: the secret service
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceStoreFinish :: a -> b -> m ()
serviceStoreFinish service :: a
service result_ :: b
result_ = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Service -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
secret_service_store_finish Ptr Service
service' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceStoreFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ServiceStoreFinishMethodInfo a signature where
    overloadedMethod = serviceStoreFinish

#endif

-- method Service::store_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema for the attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute keys and values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "collection"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a collection alias, or D-Bus object path of the collection where to store the secret"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "label for the secret"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret value" , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_store_sync" secret_service_store_sync :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Secret.Schema.Schema ->             -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    Ptr (GHashTable CString CString) ->     -- attributes : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    CString ->                              -- collection : TBasicType TUTF8
    CString ->                              -- label : TBasicType TUTF8
    Ptr Secret.Value.Value ->               -- value : TInterface (Name {namespace = "Secret", name = "Value"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Store a secret value in the secret service.
-- 
-- The /@attributes@/ should be a set of key and value string pairs.
-- 
-- If the attributes match a secret item already stored in the collection, then
-- the item will be updated with these new values.
-- 
-- If /@collection@/ is 'P.Nothing', then the default collection will be
-- used. Use 'GI.Secret.Constants.COLLECTION_SESSION' to store the password in the session
-- collection, which doesn\'t get stored across login sessions.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGetSync' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method may block indefinitely and should not be used in user interface
-- threads.
serviceStoreSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@service@/: the secret service
    -> Maybe (Secret.Schema.Schema)
    -- ^ /@schema@/: the schema for the attributes
    -> Map.Map T.Text T.Text
    -- ^ /@attributes@/: the attribute keys and values
    -> Maybe (T.Text)
    -- ^ /@collection@/: a collection alias, or D-Bus object path of the collection where to store the secret
    -> T.Text
    -- ^ /@label@/: label for the secret
    -> Secret.Value.Value
    -- ^ /@value@/: the secret value
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceStoreSync :: a
-> Maybe Schema
-> Map Text Text
-> Maybe Text
-> Text
-> Value
-> Maybe b
-> m ()
serviceStoreSync service :: a
service schema :: Maybe Schema
schema attributes :: Map Text Text
attributes collection :: Maybe Text
collection label :: Text
label value :: Value
value cancellable :: Maybe b
cancellable = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr Schema
maybeSchema <- case Maybe Schema
schema of
        Nothing -> Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
nullPtr
        Just jSchema :: Schema
jSchema -> do
            Ptr Schema
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
jSchema'
    let attributes' :: [(Text, Text)]
attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    [(CString, Text)]
attributes'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
attributes'
    [(CString, CString)]
attributes''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
attributes''
    let attributes'''' :: [(PtrWrapped CString, CString)]
attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
attributes'''
    let attributes''''' :: [(PtrWrapped CString, PtrWrapped CString)]
attributes''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    Ptr (GHashTable CString CString)
attributes'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
attributes'''''
    CString
maybeCollection <- case Maybe Text
collection of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jCollection :: Text
jCollection -> do
            CString
jCollection' <- Text -> IO CString
textToCString Text
jCollection
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCollection'
    CString
label' <- Text -> IO CString
textToCString Text
label
    Ptr Value
value' <- Value -> IO (Ptr Value)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Value
value
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr Schema
-> Ptr (GHashTable CString CString)
-> CString
-> CString
-> Ptr Value
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
secret_service_store_sync Ptr Service
service' Ptr Schema
maybeSchema Ptr (GHashTable CString CString)
attributes'''''' CString
maybeCollection CString
label' Ptr Value
value' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        Maybe Schema -> (Schema -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Schema
schema Schema -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Value
value
        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
        Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCollection
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCollection
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
     )

#if defined(ENABLE_OVERLOADING)
data ServiceStoreSyncMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> Maybe (T.Text) -> T.Text -> Secret.Value.Value -> Maybe (b) -> m ()), MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) => O.MethodInfo ServiceStoreSyncMethodInfo a signature where
    overloadedMethod = serviceStoreSync

#endif

-- method Service::unlock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objects"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the items or collections to unlock"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_unlock" secret_service_unlock :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr (GList (Ptr Gio.DBusProxy.DBusProxy)) -> -- objects : TGList (TInterface (Name {namespace = "Gio", name = "DBusProxy"}))
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Unlock items or collections in the secret service.
-- 
-- The secret service may not be able to unlock items individually, and may
-- unlock an entire collection instead.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGet' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method may block indefinitely and should not be used in user
-- interface threads. The secret service may prompt the user.
-- 'GI.Secret.Objects.Service.servicePrompt' will be used to handle any prompts that show up.
serviceUnlock ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.DBusProxy.IsDBusProxy b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@service@/: the secret service
    -> [b]
    -- ^ /@objects@/: the items or collections to unlock
    -> Maybe (c)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceUnlock :: a -> [b] -> Maybe c -> Maybe AsyncReadyCallback -> m ()
serviceUnlock service :: a
service objects :: [b]
objects cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    [Ptr DBusProxy]
objects' <- (b -> IO (Ptr DBusProxy)) -> [b] -> IO [Ptr DBusProxy]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM b -> IO (Ptr DBusProxy)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [b]
objects
    Ptr (GList (Ptr DBusProxy))
objects'' <- [Ptr DBusProxy] -> IO (Ptr (GList (Ptr DBusProxy)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr DBusProxy]
objects'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Service
-> Ptr (GList (Ptr DBusProxy))
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_unlock Ptr Service
service' Ptr (GList (Ptr DBusProxy))
objects'' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
    (b -> IO ()) -> [b] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [b]
objects
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr (GList (Ptr DBusProxy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusProxy))
objects''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServiceUnlockMethodInfo
instance (signature ~ ([b] -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsService a, Gio.DBusProxy.IsDBusProxy b, Gio.Cancellable.IsCancellable c) => O.MethodInfo ServiceUnlockMethodInfo a signature where
    overloadedMethod = serviceUnlock

#endif

-- method Service::unlock_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "unlocked"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "\n           location to place list of items or collections that were unlocked"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_unlock_finish" secret_service_unlock_finish :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))) -> -- unlocked : TGList (TInterface (Name {namespace = "Gio", name = "DBusProxy"}))
    Ptr (Ptr GError) ->                     -- error
    IO Int32

-- | Complete asynchronous operation to unlock items or collections in the secret
-- service.
-- 
-- The secret service may not be able to unlock items individually, and may
-- unlock an entire collection instead.
serviceUnlockFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@service@/: the secret service
    -> b
    -- ^ /@result@/: asynchronous result passed to the callback
    -> m ((Int32, [Gio.DBusProxy.DBusProxy]))
    -- ^ __Returns:__ the number of items or collections that were unlocked /(Can throw 'Data.GI.Base.GError.GError')/
serviceUnlockFinish :: a -> b -> m (Int32, [DBusProxy])
serviceUnlockFinish service :: a
service result_ :: b
result_ = IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy]))
-> IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr (Ptr (GList (Ptr DBusProxy)))
unlocked <- IO (Ptr (Ptr (GList (Ptr DBusProxy))))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))))
    IO (Int32, [DBusProxy]) -> IO () -> IO (Int32, [DBusProxy])
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr AsyncResult
-> Ptr (Ptr (GList (Ptr DBusProxy)))
-> Ptr (Ptr GError)
-> IO Int32
secret_service_unlock_finish Ptr Service
service' Ptr AsyncResult
result_' Ptr (Ptr (GList (Ptr DBusProxy)))
unlocked
        Ptr (GList (Ptr DBusProxy))
unlocked' <- Ptr (Ptr (GList (Ptr DBusProxy)))
-> IO (Ptr (GList (Ptr DBusProxy)))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (GList (Ptr DBusProxy)))
unlocked
        [Ptr DBusProxy]
unlocked'' <- Ptr (GList (Ptr DBusProxy)) -> IO [Ptr DBusProxy]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DBusProxy))
unlocked'
        [DBusProxy]
unlocked''' <- (Ptr DBusProxy -> IO DBusProxy)
-> [Ptr DBusProxy] -> IO [DBusProxy]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr DBusProxy -> DBusProxy)
-> Ptr DBusProxy -> IO DBusProxy
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusProxy -> DBusProxy
Gio.DBusProxy.DBusProxy) [Ptr DBusProxy]
unlocked''
        Ptr (GList (Ptr DBusProxy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusProxy))
unlocked'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr (Ptr (GList (Ptr DBusProxy))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GList (Ptr DBusProxy)))
unlocked
        (Int32, [DBusProxy]) -> IO (Int32, [DBusProxy])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, [DBusProxy]
unlocked''')
     ) (do
        Ptr (Ptr (GList (Ptr DBusProxy))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GList (Ptr DBusProxy)))
unlocked
     )

#if defined(ENABLE_OVERLOADING)
data ServiceUnlockFinishMethodInfo
instance (signature ~ (b -> m ((Int32, [Gio.DBusProxy.DBusProxy]))), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo ServiceUnlockFinishMethodInfo a signature where
    overloadedMethod = serviceUnlockFinish

#endif

-- method Service::unlock_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objects"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the items or collections to unlock"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "unlocked"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "\n           location to place list of items or collections that were unlocked"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_unlock_sync" secret_service_unlock_sync :: 
    Ptr Service ->                          -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    Ptr (GList (Ptr Gio.DBusProxy.DBusProxy)) -> -- objects : TGList (TInterface (Name {namespace = "Gio", name = "DBusProxy"}))
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))) -> -- unlocked : TGList (TInterface (Name {namespace = "Gio", name = "DBusProxy"}))
    Ptr (Ptr GError) ->                     -- error
    IO Int32

-- | Unlock items or collections in the secret service.
-- 
-- The secret service may not be able to unlock items individually, and may
-- unlock an entire collection instead.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGetSync' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method may block indefinitely and should not be used in user
-- interface threads. The secret service may prompt the user.
-- 'GI.Secret.Objects.Service.servicePrompt' will be used to handle any prompts that show up.
serviceUnlockSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.DBusProxy.IsDBusProxy b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@service@/: the secret service
    -> [b]
    -- ^ /@objects@/: the items or collections to unlock
    -> Maybe (c)
    -- ^ /@cancellable@/: optional cancellation object
    -> m ((Int32, [Gio.DBusProxy.DBusProxy]))
    -- ^ __Returns:__ the number of items or collections that were unlocked /(Can throw 'Data.GI.Base.GError.GError')/
serviceUnlockSync :: a -> [b] -> Maybe c -> m (Int32, [DBusProxy])
serviceUnlockSync service :: a
service objects :: [b]
objects cancellable :: Maybe c
cancellable = IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy]))
-> IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    [Ptr DBusProxy]
objects' <- (b -> IO (Ptr DBusProxy)) -> [b] -> IO [Ptr DBusProxy]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM b -> IO (Ptr DBusProxy)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [b]
objects
    Ptr (GList (Ptr DBusProxy))
objects'' <- [Ptr DBusProxy] -> IO (Ptr (GList (Ptr DBusProxy)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr DBusProxy]
objects'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    Ptr (Ptr (GList (Ptr DBusProxy)))
unlocked <- IO (Ptr (Ptr (GList (Ptr DBusProxy))))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))))
    IO (Int32, [DBusProxy]) -> IO () -> IO (Int32, [DBusProxy])
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> Ptr (GList (Ptr DBusProxy))
-> Ptr Cancellable
-> Ptr (Ptr (GList (Ptr DBusProxy)))
-> Ptr (Ptr GError)
-> IO Int32
secret_service_unlock_sync Ptr Service
service' Ptr (GList (Ptr DBusProxy))
objects'' Ptr Cancellable
maybeCancellable Ptr (Ptr (GList (Ptr DBusProxy)))
unlocked
        Ptr (GList (Ptr DBusProxy))
unlocked' <- Ptr (Ptr (GList (Ptr DBusProxy)))
-> IO (Ptr (GList (Ptr DBusProxy)))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (GList (Ptr DBusProxy)))
unlocked
        [Ptr DBusProxy]
unlocked'' <- Ptr (GList (Ptr DBusProxy)) -> IO [Ptr DBusProxy]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DBusProxy))
unlocked'
        [DBusProxy]
unlocked''' <- (Ptr DBusProxy -> IO DBusProxy)
-> [Ptr DBusProxy] -> IO [DBusProxy]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr DBusProxy -> DBusProxy)
-> Ptr DBusProxy -> IO DBusProxy
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusProxy -> DBusProxy
Gio.DBusProxy.DBusProxy) [Ptr DBusProxy]
unlocked''
        Ptr (GList (Ptr DBusProxy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusProxy))
unlocked'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
service
        (b -> IO ()) -> [b] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [b]
objects
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (GList (Ptr DBusProxy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusProxy))
objects''
        Ptr (Ptr (GList (Ptr DBusProxy))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GList (Ptr DBusProxy)))
unlocked
        (Int32, [DBusProxy]) -> IO (Int32, [DBusProxy])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, [DBusProxy]
unlocked''')
     ) (do
        Ptr (GList (Ptr DBusProxy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusProxy))
objects''
        Ptr (Ptr (GList (Ptr DBusProxy))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GList (Ptr DBusProxy)))
unlocked
     )

#if defined(ENABLE_OVERLOADING)
data ServiceUnlockSyncMethodInfo
instance (signature ~ ([b] -> Maybe (c) -> m ((Int32, [Gio.DBusProxy.DBusProxy]))), MonadIO m, IsService a, Gio.DBusProxy.IsDBusProxy b, Gio.Cancellable.IsCancellable c) => O.MethodInfo ServiceUnlockSyncMethodInfo a signature where
    overloadedMethod = serviceUnlockSync

#endif

-- method Service::disconnect
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_disconnect" secret_service_disconnect :: 
    IO ()

-- | Disconnect the default t'GI.Secret.Objects.Service.Service' proxy returned by 'GI.Secret.Objects.Service.serviceGet'
-- and 'GI.Secret.Objects.Service.serviceGetSync'.
-- 
-- It is not necessary to call this function, but you may choose to do so at
-- program exit. It is useful for testing that memory is not leaked.
-- 
-- This function is safe to call at any time. But if other objects in this
-- library are still referenced, then this will not result in all memory
-- being freed.
serviceDisconnect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
serviceDisconnect :: m ()
serviceDisconnect  = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    IO ()
secret_service_disconnect
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Service::get
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "ServiceFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "flags for which service functionality to ensure is initialized"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_get" secret_service_get :: 
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "ServiceFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Get a t'GI.Secret.Objects.Service.Service' proxy for the Secret Service. If such a proxy object
-- already exists, then the same proxy is returned.
-- 
-- If /@flags@/ contains any flags of which parts of the secret service to
-- ensure are initialized, then those will be initialized before completing.
-- 
-- This method will return immediately and complete asynchronously.
serviceGet ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    [Secret.Flags.ServiceFlags]
    -- ^ /@flags@/: flags for which service functionality to ensure is initialized
    -> Maybe (a)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceGet :: [ServiceFlags] -> Maybe a -> Maybe AsyncReadyCallback -> m ()
serviceGet flags :: [ServiceFlags]
flags cancellable :: Maybe a
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let flags' :: CUInt
flags' = [ServiceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ServiceFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe a
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: a
jCancellable -> do
            Ptr Cancellable
jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_get CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
cancellable a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Service::get_finish
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Service" })
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_get_finish" secret_service_get_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Service)

-- | Complete an asynchronous operation to get a t'GI.Secret.Objects.Service.Service' proxy for the
-- Secret Service.
serviceGetFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m Service
    -- ^ __Returns:__ a new reference to a t'GI.Secret.Objects.Service.Service' proxy, which
    --          should be released with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
serviceGetFinish :: a -> m Service
serviceGetFinish result_ :: a
result_ = IO Service -> m Service
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Service -> m Service) -> IO Service -> m Service
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncResult
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    IO Service -> IO () -> IO Service
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Service
result <- (Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service))
-> (Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service)
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Service)
secret_service_get_finish Ptr AsyncResult
result_'
        Text -> Ptr Service -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "serviceGetFinish" Ptr Service
result
        Service
result' <- ((ManagedPtr Service -> Service) -> Ptr Service -> IO Service
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Service -> Service
Service) Ptr Service
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
        Service -> IO Service
forall (m :: * -> *) a. Monad m => a -> m a
return Service
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Service::get_sync
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "ServiceFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "flags for which service functionality to ensure is initialized"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Service" })
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_get_sync" secret_service_get_sync :: 
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "ServiceFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Service)

-- | Get a t'GI.Secret.Objects.Service.Service' proxy for the Secret Service. If such a proxy object
-- already exists, then the same proxy is returned.
-- 
-- If /@flags@/ contains any flags of which parts of the secret service to
-- ensure are initialized, then those will be initialized before returning.
-- 
-- This method may block indefinitely and should not be used in user interface
-- threads.
serviceGetSync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    [Secret.Flags.ServiceFlags]
    -- ^ /@flags@/: flags for which service functionality to ensure is initialized
    -> Maybe (a)
    -- ^ /@cancellable@/: optional cancellation object
    -> m Service
    -- ^ __Returns:__ a new reference to a t'GI.Secret.Objects.Service.Service' proxy, which
    --          should be released with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
serviceGetSync :: [ServiceFlags] -> Maybe a -> m Service
serviceGetSync flags :: [ServiceFlags]
flags cancellable :: Maybe a
cancellable = IO Service -> m Service
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Service -> m Service) -> IO Service -> m Service
forall a b. (a -> b) -> a -> b
$ do
    let flags' :: CUInt
flags' = [ServiceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ServiceFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe a
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: a
jCancellable -> do
            Ptr Cancellable
jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Service -> IO () -> IO Service
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Service
result <- (Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service))
-> (Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service)
forall a b. (a -> b) -> a -> b
$ CUInt -> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr Service)
secret_service_get_sync CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr Service -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "serviceGetSync" Ptr Service
result
        Service
result' <- ((ManagedPtr Service -> Service) -> Ptr Service -> IO Service
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Service -> Service
Service) Ptr Service
result
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
cancellable a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Service -> IO Service
forall (m :: * -> *) a. Monad m => a -> m a
return Service
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Service::open
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "service_gtype"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the GType of the new secret service"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "service_bus_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the D-Bus service name of the secret service"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "ServiceFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "flags for which service functionality to ensure is initialized"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_service_open" secret_service_open :: 
    CGType ->                               -- service_gtype : TBasicType TGType
    CString ->                              -- service_bus_name : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "ServiceFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Create a new t'GI.Secret.Objects.Service.Service' proxy for the Secret Service.
-- 
-- This function is rarely used, see 'GI.Secret.Objects.Service.serviceGet' instead.
-- 
-- The /@serviceGtype@/ argument should be set to @/SECRET_TYPE_SERVICE/@ or a the type
-- of a derived class.
-- 
-- If /@flags@/ contains any flags of which parts of the secret service to
-- ensure are initialized, then those will be initialized before returning.
-- 
-- If /@serviceBusName@/ is 'P.Nothing' then the default is used.
-- 
-- This method will return immediately and complete asynchronously.
serviceOpen ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    GType
    -- ^ /@serviceGtype@/: the GType of the new secret service
    -> Maybe (T.Text)
    -- ^ /@serviceBusName@/: the D-Bus service name of the secret service
    -> [Secret.Flags.ServiceFlags]
    -- ^ /@flags@/: flags for which service functionality to ensure is initialized
    -> Maybe (a)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
serviceOpen :: GType
-> Maybe Text
-> [ServiceFlags]
-> Maybe a
-> Maybe AsyncReadyCallback
-> m ()
serviceOpen serviceGtype :: GType
serviceGtype serviceBusName :: Maybe Text
serviceBusName flags :: [ServiceFlags]
flags cancellable :: Maybe a
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let serviceGtype' :: CGType
serviceGtype' = GType -> CGType
gtypeToCGType GType
serviceGtype
    CString
maybeServiceBusName <- case Maybe Text
serviceBusName of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jServiceBusName :: Text
jServiceBusName -> do
            CString
jServiceBusName' <- Text -> IO CString
textToCString Text
jServiceBusName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jServiceBusName'
    let flags' :: CUInt
flags' = [ServiceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ServiceFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe a
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: a
jCancellable -> do
            Ptr Cancellable
jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CGType
-> CString
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_service_open CGType
serviceGtype' CString
maybeServiceBusName CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
cancellable a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeServiceBusName
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Service::open_finish
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Service" })
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_open_finish" secret_service_open_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Service)

-- | Complete an asynchronous operation to create a new t'GI.Secret.Objects.Service.Service' proxy for
-- the Secret Service.
serviceOpenFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m Service
    -- ^ __Returns:__ a new reference to a t'GI.Secret.Objects.Service.Service' proxy, which
    --          should be released with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
serviceOpenFinish :: a -> m Service
serviceOpenFinish result_ :: a
result_ = IO Service -> m Service
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Service -> m Service) -> IO Service -> m Service
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncResult
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    IO Service -> IO () -> IO Service
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Service
result <- (Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service))
-> (Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service)
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Service)
secret_service_open_finish Ptr AsyncResult
result_'
        Text -> Ptr Service -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "serviceOpenFinish" Ptr Service
result
        Service
result' <- ((ManagedPtr Service -> Service) -> Ptr Service -> IO Service
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Service -> Service
Service) Ptr Service
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
        Service -> IO Service
forall (m :: * -> *) a. Monad m => a -> m a
return Service
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Service::open_sync
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "service_gtype"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the GType of the new secret service"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "service_bus_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the D-Bus service name of the secret service"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "ServiceFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "flags for which service functionality to ensure is initialized"
--                 , 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 "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Service" })
-- throws : True
-- Skip return : False

foreign import ccall "secret_service_open_sync" secret_service_open_sync :: 
    CGType ->                               -- service_gtype : TBasicType TGType
    CString ->                              -- service_bus_name : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "ServiceFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Service)

-- | Create a new t'GI.Secret.Objects.Service.Service' proxy for the Secret Service.
-- 
-- This function is rarely used, see 'GI.Secret.Objects.Service.serviceGetSync' instead.
-- 
-- The /@serviceGtype@/ argument should be set to @/SECRET_TYPE_SERVICE/@ or a the
-- type of a derived class.
-- 
-- If /@flags@/ contains any flags of which parts of the secret service to
-- ensure are initialized, then those will be initialized before returning.
-- 
-- If /@serviceBusName@/ is 'P.Nothing' then the default is used.
-- 
-- This method may block indefinitely and should not be used in user interface
-- threads.
serviceOpenSync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    GType
    -- ^ /@serviceGtype@/: the GType of the new secret service
    -> Maybe (T.Text)
    -- ^ /@serviceBusName@/: the D-Bus service name of the secret service
    -> [Secret.Flags.ServiceFlags]
    -- ^ /@flags@/: flags for which service functionality to ensure is initialized
    -> Maybe (a)
    -- ^ /@cancellable@/: optional cancellation object
    -> m Service
    -- ^ __Returns:__ a new reference to a t'GI.Secret.Objects.Service.Service' proxy, which
    --          should be released with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
serviceOpenSync :: GType -> Maybe Text -> [ServiceFlags] -> Maybe a -> m Service
serviceOpenSync serviceGtype :: GType
serviceGtype serviceBusName :: Maybe Text
serviceBusName flags :: [ServiceFlags]
flags cancellable :: Maybe a
cancellable = IO Service -> m Service
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Service -> m Service) -> IO Service -> m Service
forall a b. (a -> b) -> a -> b
$ do
    let serviceGtype' :: CGType
serviceGtype' = GType -> CGType
gtypeToCGType GType
serviceGtype
    CString
maybeServiceBusName <- case Maybe Text
serviceBusName of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jServiceBusName :: Text
jServiceBusName -> do
            CString
jServiceBusName' <- Text -> IO CString
textToCString Text
jServiceBusName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jServiceBusName'
    let flags' :: CUInt
flags' = [ServiceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ServiceFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe a
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: a
jCancellable -> do
            Ptr Cancellable
jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Service -> IO () -> IO Service
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Service
result <- (Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service))
-> (Ptr (Ptr GError) -> IO (Ptr Service)) -> IO (Ptr Service)
forall a b. (a -> b) -> a -> b
$ CGType
-> CString
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Service)
secret_service_open_sync CGType
serviceGtype' CString
maybeServiceBusName CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr Service -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "serviceOpenSync" Ptr Service
result
        Service
result' <- ((ManagedPtr Service -> Service) -> Ptr Service -> IO Service
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Service -> Service
Service) Ptr Service
result
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
cancellable a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeServiceBusName
        Service -> IO Service
forall (m :: * -> *) a. Monad m => a -> m a
return Service
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeServiceBusName
     )

#if defined(ENABLE_OVERLOADING)
#endif