{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A proxy object representing the Secret Service.
-- 
-- A t'GI.Secret.Objects.Service.Service' object represents the Secret Service implementation which
-- runs as a D-Bus service.
-- 
-- Normally a single t'GI.Secret.Objects.Service.Service' object can be shared between multiple
-- callers. The @/Service.get/@ method is used to access this t'GI.Secret.Objects.Service.Service'
-- object. If a new independent t'GI.Secret.Objects.Service.Service' object is required, use
-- @/Service.open/@.
-- 
-- In order to securely transfer secrets to the Sercret Service, a session
-- is established. This session can be established while initializing a
-- t'GI.Secret.Objects.Service.Service' object by passing the 'GI.Secret.Flags.ServiceFlagsOpenSession' flag
-- to the @/Service.get/@ or @/Service.open/@ functions. In order to
-- establish a session on an already existing t'GI.Secret.Objects.Service.Service', use the
-- [method/@service@/.ensure_session] function.
-- 
-- To search for items, use the [method/@service@/.search] method.
-- 
-- Multiple collections can exist in the Secret Service, each of which contains
-- secret items. In order to instantiate [class/@collection@/] objects which
-- represent those collections while initializing a t'GI.Secret.Objects.Service.Service' then pass
-- the 'GI.Secret.Flags.ServiceFlagsLoadCollections' flag to the @/Service.get/@ or
-- @/Service.open/@ functions. In order to establish a session on an already
-- existing t'GI.Secret.Objects.Service.Service', use the [method/@service@/.load_collections] function.
-- To access the list of collections use [method/@service@/.get_collections].
-- 
-- Certain actions on the Secret Service require user prompting to complete,
-- such as creating a collection, or unlocking a collection. When such a prompt
-- is necessary, then a [class/@prompt@/] object is created by this library, and
-- passed to the [method/@service@/.prompt] method. In this way it is handled
-- automatically.
-- 
-- In order to customize prompt handling, override the
-- [vfunc/@service@/.prompt_async] and [vfunc/@service@/.prompt_finish] virtual
-- methods of the t'GI.Secret.Objects.Service.Service' class.

#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                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [call]("GI.Gio.Objects.DBusProxy#g:method:call"), [callFinish]("GI.Gio.Objects.DBusProxy#g:method:callFinish"), [callSync]("GI.Gio.Objects.DBusProxy#g:method:callSync"), [callWithUnixFdList]("GI.Gio.Objects.DBusProxy#g:method:callWithUnixFdList"), [callWithUnixFdListFinish]("GI.Gio.Objects.DBusProxy#g:method:callWithUnixFdListFinish"), [callWithUnixFdListSync]("GI.Gio.Objects.DBusProxy#g:method:callWithUnixFdListSync"), [clear]("GI.Secret.Objects.Service#g:method:clear"), [clearFinish]("GI.Secret.Objects.Service#g:method:clearFinish"), [clearSync]("GI.Secret.Objects.Service#g:method:clearSync"), [createItemDbusPathSync]("GI.Secret.Objects.Service#g:method:createItemDbusPathSync"), [decodeDbusSecret]("GI.Secret.Objects.Service#g:method:decodeDbusSecret"), [encodeDbusSecret]("GI.Secret.Objects.Service#g:method:encodeDbusSecret"), [ensureSession]("GI.Secret.Objects.Service#g:method:ensureSession"), [ensureSessionFinish]("GI.Secret.Objects.Service#g:method:ensureSessionFinish"), [ensureSessionSync]("GI.Secret.Objects.Service#g:method:ensureSessionSync"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [init]("GI.Gio.Interfaces.Initable#g:method:init"), [initAsync]("GI.Gio.Interfaces.AsyncInitable#g:method:initAsync"), [initFinish]("GI.Gio.Interfaces.AsyncInitable#g:method:initFinish"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [loadCollections]("GI.Secret.Objects.Service#g:method:loadCollections"), [loadCollectionsFinish]("GI.Secret.Objects.Service#g:method:loadCollectionsFinish"), [loadCollectionsSync]("GI.Secret.Objects.Service#g:method:loadCollectionsSync"), [lock]("GI.Secret.Objects.Service#g:method:lock"), [lockFinish]("GI.Secret.Objects.Service#g:method:lockFinish"), [lockSync]("GI.Secret.Objects.Service#g:method:lockSync"), [lookup]("GI.Secret.Objects.Service#g:method:lookup"), [lookupFinish]("GI.Secret.Objects.Service#g:method:lookupFinish"), [lookupSync]("GI.Secret.Objects.Service#g:method:lookupSync"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [prompt]("GI.Secret.Objects.Service#g:method:prompt"), [promptFinish]("GI.Secret.Objects.Service#g:method:promptFinish"), [promptSync]("GI.Secret.Objects.Service#g:method:promptSync"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [search]("GI.Secret.Objects.Service#g:method:search"), [searchFinish]("GI.Secret.Objects.Service#g:method:searchFinish"), [searchSync]("GI.Secret.Objects.Service#g:method:searchSync"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [store]("GI.Secret.Objects.Service#g:method:store"), [storeFinish]("GI.Secret.Objects.Service#g:method:storeFinish"), [storeSync]("GI.Secret.Objects.Service#g:method:storeSync"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unlock]("GI.Secret.Objects.Service#g:method:unlock"), [unlockFinish]("GI.Secret.Objects.Service#g:method:unlockFinish"), [unlockSync]("GI.Secret.Objects.Service#g:method:unlockSync"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCachedProperty]("GI.Gio.Objects.DBusProxy#g:method:getCachedProperty"), [getCachedPropertyNames]("GI.Gio.Objects.DBusProxy#g:method:getCachedPropertyNames"), [getCollectionGtype]("GI.Secret.Objects.Service#g:method:getCollectionGtype"), [getCollections]("GI.Secret.Objects.Service#g:method:getCollections"), [getConnection]("GI.Gio.Objects.DBusProxy#g:method:getConnection"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDefaultTimeout]("GI.Gio.Objects.DBusProxy#g:method:getDefaultTimeout"), [getFlags]("GI.Secret.Objects.Service#g:method:getFlags"), [getInfo]("GI.Gio.Interfaces.DBusInterface#g:method:getInfo"), [getInterfaceInfo]("GI.Gio.Objects.DBusProxy#g:method:getInterfaceInfo"), [getInterfaceName]("GI.Gio.Objects.DBusProxy#g:method:getInterfaceName"), [getItemGtype]("GI.Secret.Objects.Service#g:method:getItemGtype"), [getName]("GI.Gio.Objects.DBusProxy#g:method:getName"), [getNameOwner]("GI.Gio.Objects.DBusProxy#g:method:getNameOwner"), [getObject]("GI.Gio.Interfaces.DBusInterface#g:method:getObject"), [getObjectPath]("GI.Gio.Objects.DBusProxy#g:method:getObjectPath"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSessionAlgorithms]("GI.Secret.Objects.Service#g:method:getSessionAlgorithms"), [getSessionDbusPath]("GI.Secret.Objects.Service#g:method:getSessionDbusPath").
-- 
-- ==== Setters
-- [setAlias]("GI.Secret.Objects.Service#g:method:setAlias"), [setAliasFinish]("GI.Secret.Objects.Service#g:method:setAliasFinish"), [setAliasSync]("GI.Secret.Objects.Service#g:method:setAliasSync"), [setCachedProperty]("GI.Gio.Objects.DBusProxy#g:method:setCachedProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDefaultTimeout]("GI.Gio.Objects.DBusProxy#g:method:setDefaultTimeout"), [setInterfaceInfo]("GI.Gio.Objects.DBusProxy#g:method:setInterfaceInfo"), [setObject]("GI.Gio.Interfaces.DBusInterface#g:method:setObject"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks
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.Enums as Secret.Enums
import {-# SOURCE #-} qualified GI.Secret.Flags as Secret.Flags
import {-# SOURCE #-} qualified GI.Secret.Interfaces.Backend as Secret.Backend
import {-# SOURCE #-} qualified GI.Secret.Interfaces.Retrievable as Secret.Retrievable
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

#else
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.Interfaces.Backend as Secret.Backend
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

#endif

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

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

foreign import ccall "secret_service_get_type"
    c_secret_service_get_type :: IO B.Types.GType

instance B.Types.TypedObject Service where
    glibType :: IO GType
glibType = IO GType
c_secret_service_get_type

instance B.Types.GObject Service

-- | Type class for types which can be safely cast to t'Service', for instance with `toService`.
class (SP.GObject o, O.IsDescendantOf Service o) => IsService o
instance (SP.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, Secret.Backend.Backend]

-- | Cast to t'Service', for types for which this is known to be safe. For general casts, use 'Data.GI.Base.ManagedPtr.castTo'.
toService :: (MIO.MonadIO m, IsService o) => o -> m Service
toService :: forall (m :: * -> *) o. (MonadIO m, IsService o) => o -> m Service
toService = IO Service -> m Service
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Service -> Service
Service

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

#if defined(ENABLE_OVERLOADING)
type family ResolveServiceMethod (t :: Symbol) (o :: DK.Type) :: DK.Type 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.OverloadedMethod info Service p) => OL.IsLabel t (Service -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel :: Service -> p
fromLabel = forall {k} (i :: k) o s. OverloadedMethod i o s => o -> s
forall i o s. OverloadedMethod i o s => o -> s
O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveServiceMethod t Service, O.OverloadedMethod info Service p, R.HasField t Service p) => R.HasField t Service p where
    getField :: Service -> p
getField = forall {k} (i :: k) o s. OverloadedMethod i o s => o -> s
forall i o s. OverloadedMethod i o s => o -> s
O.overloadedMethod @info

#endif

instance (info ~ ResolveServiceMethod t Service, O.OverloadedMethodInfo info Service) => OL.IsLabel t (O.MethodProxy info Service) where
#if MIN_VERSION_base(4,10,0)
    fromLabel :: MethodProxy info Service
fromLabel = MethodProxy info Service
forall info obj. MethodProxy info obj
O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Service
type instance O.AttributeList Service = ServiceAttributeList
type ServiceAttributeList = ('[ '("flags", Secret.Backend.BackendFlagsPropertyInfo), '("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, DK.Type)])
#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, DK.Type)])

#endif

-- method Service::clear
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get/@ will be called to get
-- the default [class/@service@/] proxy.
-- 
-- This method will return immediately and complete asynchronously.
serviceClear ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    Maybe (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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceClear Maybe a
service Maybe Schema
schema Map Text Text
attributes Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    maybeSchema <- case schema of
        Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
FP.nullPtr
        Just Schema
jSchema -> do
            jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            return jSchema'
    let attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    attributes'' <- mapFirstA textToCString attributes'
    attributes''' <- mapSecondA textToCString attributes''
    let attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
attributes'''
    let 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
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    attributes'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) attributes'''''
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_clear maybeService maybeSchema attributes'''''' maybeCancellable maybeCallback userData
    whenJust service touchManagedPtr
    whenJust schema touchManagedPtr
    whenJust cancellable touchManagedPtr
    unrefGHashTable attributes''''''
    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.OverloadedMethod ServiceClearMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceClear (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceClearMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceClear",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceClear"
        })


#endif

-- method Service::clear_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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) =>
    Maybe (a)
    -- ^ /@service@/: the secret service
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceClearFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m ()
serviceClearFinish Maybe a
service b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        _ <- propagateGError $ secret_service_clear_finish maybeService result_'
        whenJust service touchManagedPtr
        touchManagedPtr result_
        return ()
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceClearFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ServiceClearFinishMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m ()
serviceClearFinish (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceClearFinishMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceClearFinish",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceClearFinish"
        })


#endif

-- method Service::clear_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get_sync/@ will be called to get
-- the default [class/@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) =>
    Maybe (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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a -> Maybe Schema -> Map Text Text -> Maybe b -> m ()
serviceClearSync Maybe a
service Maybe Schema
schema Map Text Text
attributes Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    maybeSchema <- case schema of
        Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
FP.nullPtr
        Just Schema
jSchema -> do
            jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            return jSchema'
    let attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    attributes'' <- mapFirstA textToCString attributes'
    attributes''' <- mapSecondA textToCString attributes''
    let attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
attributes'''
    let 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
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    attributes'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) attributes'''''
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        _ <- propagateGError $ secret_service_clear_sync maybeService maybeSchema attributes'''''' maybeCancellable
        whenJust service touchManagedPtr
        whenJust schema touchManagedPtr
        whenJust cancellable touchManagedPtr
        unrefGHashTable attributes''''''
        return ()
     ) (do
        unrefGHashTable 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.OverloadedMethod ServiceClearSyncMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> Maybe Schema -> Map Text Text -> Maybe b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a -> Maybe Schema -> Map Text Text -> Maybe b -> m ()
serviceClearSync (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceClearSyncMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceClearSync",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceClearSync"
        })


#endif

-- XXX Could not generate method Service::create_item_dbus_path_sync
-- 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.OverloadedMethod ServiceCreateItemDbusPathSyncMethodInfo o p where
    overloadedMethod :: o -> p
overloadedMethod = o -> p
forall a. HasCallStack => a
undefined

instance (o ~ O.UnsupportedMethodError "createItemDbusPathSync" Service) => O.OverloadedMethodInfo ServiceCreateItemDbusPathSyncMethodInfo o where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = Maybe ResolvedSymbolInfo
forall a. HasCallStack => a
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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 [struct/@value@/] into t'GVariant' received with the Secret Service
-- DBus API.
-- 
-- The t'GVariant' should have a @(oayays)@ signature.
-- 
-- A session must have already been established by the [class/@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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> GVariant -> m Value
serviceDecodeDbusSecret a
service GVariant
value = IO Value -> m Value
forall a. IO a -> m a
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
    service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    value' <- unsafeManagedPtrGetPtr value
    result <- secret_service_decode_dbus_secret service' value'
    checkUnexpectedReturnNULL "serviceDecodeDbusSecret" result
    result' <- (wrapBoxed Secret.Value.Value) result
    touchManagedPtr service
    touchManagedPtr value
    return result'

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

instance O.OverloadedMethodInfo ServiceDecodeDbusSecretMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceDecodeDbusSecret",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 [struct/@value@/] into t'GVariant' for use with the Secret
-- Service DBus API.
-- 
-- The resulting t'GVariant' will have a @(oayays)@ signature.
-- 
-- A session must have already been established by the [class/@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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> Value -> m GVariant
serviceEncodeDbusSecret a
service Value
value = IO GVariant -> m GVariant
forall a. IO a -> m a
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
    service' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
service
    value' <- unsafeManagedPtrGetPtr value
    result <- secret_service_encode_dbus_secret service' value'
    checkUnexpectedReturnNULL "serviceEncodeDbusSecret" result
    result' <- B.GVariant.newGVariantFromPtr result
    touchManagedPtr service
    touchManagedPtr value
    return result'

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

instance O.OverloadedMethodInfo ServiceEncodeDbusSecretMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceEncodeDbusSecret",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 @/Service.get/@ 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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
serviceEnsureSession a
self Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_ensure_session self' maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust cancellable touchManagedPtr
    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.OverloadedMethod ServiceEnsureSessionMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
serviceEnsureSession

instance O.OverloadedMethodInfo ServiceEnsureSessionMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceEnsureSession",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
a -> b -> m ()
serviceEnsureSessionFinish a
self b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        _ <- propagateGError $ secret_service_ensure_session_finish self' result_'
        touchManagedPtr self
        touchManagedPtr result_
        return ()
     ) (do
        return ()
     )

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

instance O.OverloadedMethodInfo ServiceEnsureSessionFinishMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceEnsureSessionFinish",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 @/Service.get_sync/@ 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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
a -> Maybe b -> m ()
serviceEnsureSessionSync a
self Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        _ <- propagateGError $ secret_service_ensure_session_sync self' maybeCancellable
        touchManagedPtr self
        whenJust cancellable touchManagedPtr
        return ()
     ) (do
        return ()
     )

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

instance O.OverloadedMethodInfo ServiceEnsureSessionSyncMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceEnsureSessionSync",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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 [class/@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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m GType
serviceGetCollectionGtype a
self = IO GType -> m GType
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- secret_service_get_collection_gtype self'
    let result' = CGType -> GType
GType CGType
result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data ServiceGetCollectionGtypeMethodInfo
instance (signature ~ (m GType), MonadIO m, IsService a) => O.OverloadedMethod ServiceGetCollectionGtypeMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m GType
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m GType
serviceGetCollectionGtype

instance O.OverloadedMethodInfo ServiceGetCollectionGtypeMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceGetCollectionGtype",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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 [class/@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 [method/@service@/.load_collections] 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m [Collection]
serviceGetCollections a
self = IO [Collection] -> m [Collection]
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- secret_service_get_collections self'
    result' <- unpackGList result
    result'' <- mapM (wrapObject Secret.Collection.Collection) result'
    g_list_free result
    touchManagedPtr self
    return result''

#if defined(ENABLE_OVERLOADING)
data ServiceGetCollectionsMethodInfo
instance (signature ~ (m [Secret.Collection.Collection]), MonadIO m, IsService a) => O.OverloadedMethod ServiceGetCollectionsMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m [Collection]
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m [Collection]
serviceGetCollections

instance O.OverloadedMethodInfo ServiceGetCollectionsMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceGetCollections",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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 [method/@service@/.ensure_session] or [method/@service@/.load_collections]
-- 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m [ServiceFlags]
serviceGetFlags a
self = IO [ServiceFlags] -> m [ServiceFlags]
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- secret_service_get_flags self'
    let result' = CUInt -> [ServiceFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    touchManagedPtr self
    return result'

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

instance O.OverloadedMethodInfo ServiceGetFlagsMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceGetFlags",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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 [class/@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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m GType
serviceGetItemGtype a
self = IO GType -> m GType
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- secret_service_get_item_gtype self'
    let result' = CGType -> GType
GType CGType
result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data ServiceGetItemGtypeMethodInfo
instance (signature ~ (m GType), MonadIO m, IsService a) => O.OverloadedMethod ServiceGetItemGtypeMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m GType
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m GType
serviceGetItemGtype

instance O.OverloadedMethodInfo ServiceGetItemGtypeMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceGetItemGtype",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
-- [method/@service@/.ensure_session] 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m (Maybe Text)
serviceGetSessionAlgorithms a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- secret_service_get_session_algorithms self'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data ServiceGetSessionAlgorithmsMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsService a) => O.OverloadedMethod ServiceGetSessionAlgorithmsMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m (Maybe Text)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m (Maybe Text)
serviceGetSessionAlgorithms

instance O.OverloadedMethodInfo ServiceGetSessionAlgorithmsMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceGetSessionAlgorithms",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
-- [method/@service@/.ensure_session] 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m (Maybe Text)
serviceGetSessionDbusPath a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- secret_service_get_session_dbus_path self'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data ServiceGetSessionDbusPathMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsService a) => O.OverloadedMethod ServiceGetSessionDbusPathMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m (Maybe Text)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsService a) =>
a -> m (Maybe Text)
serviceGetSessionDbusPath

instance O.OverloadedMethodInfo ServiceGetSessionDbusPathMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceGetSessionDbusPath",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 [method/@service@/.get_collections].
-- 
-- You can also pass the 'GI.Secret.Flags.ServiceFlagsLoadCollections' to
-- @/Service.get_sync/@ 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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
serviceLoadCollections a
self Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_load_collections self' maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust cancellable touchManagedPtr
    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.OverloadedMethod ServiceLoadCollectionsMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
serviceLoadCollections

instance O.OverloadedMethodInfo ServiceLoadCollectionsMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceLoadCollections",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
a -> b -> m ()
serviceLoadCollectionsFinish a
self b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        _ <- propagateGError $ secret_service_load_collections_finish self' result_'
        touchManagedPtr self
        touchManagedPtr result_
        return ()
     ) (do
        return ()
     )

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

instance O.OverloadedMethodInfo ServiceLoadCollectionsFinishMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceLoadCollectionsFinish",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 [method/@service@/.get_collections].
-- 
-- You can also pass the 'GI.Secret.Flags.ServiceFlagsLoadCollections' to
-- @/Service.get_sync/@ 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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
a -> Maybe b -> m ()
serviceLoadCollectionsSync a
self Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        _ <- propagateGError $ secret_service_load_collections_sync self' maybeCancellable
        touchManagedPtr self
        whenJust cancellable touchManagedPtr
        return ()
     ) (do
        return ()
     )

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

instance O.OverloadedMethodInfo ServiceLoadCollectionsSyncMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceLoadCollectionsSync",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceLoadCollectionsSync"
        })


#endif

-- method Service::lock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get/@ will be called to get
-- the default [class/@service@/] proxy.
-- 
-- This method returns immediately and completes asynchronously. The secret
-- service may prompt the user. [method/@service@/.prompt] 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) =>
    Maybe (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 :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsDBusProxy b,
 IsCancellable c) =>
Maybe a -> [b] -> Maybe c -> Maybe AsyncReadyCallback -> m ()
serviceLock Maybe a
service [b]
objects Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    objects' <- mapM unsafeManagedPtrCastPtr objects
    objects'' <- packGList objects'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_lock maybeService objects'' maybeCancellable maybeCallback userData
    whenJust service touchManagedPtr
    mapM_ touchManagedPtr objects
    whenJust cancellable touchManagedPtr
    g_list_free objects''
    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.OverloadedMethod ServiceLockMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> [b] -> Maybe c -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsDBusProxy b,
 IsCancellable c) =>
Maybe a -> [b] -> Maybe c -> Maybe AsyncReadyCallback -> m ()
serviceLock (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceLockMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceLock",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceLock"
        })


#endif

-- method Service::lock_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "locked"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionOut
--           , mayBeNull = True
--           , 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
--           , argCallbackUserData = 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) =>
    Maybe (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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m (Int32, [DBusProxy])
serviceLockFinish Maybe a
service b
result_ = IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall a. IO a -> m a
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
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    result_' <- unsafeManagedPtrCastPtr result_
    locked <- callocMem :: IO (Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))))
    onException (do
        result <- propagateGError $ secret_service_lock_finish maybeService result_' locked
        locked' <- peek locked
        locked'' <- unpackGList locked'
        locked''' <- mapM (wrapObject Gio.DBusProxy.DBusProxy) locked''
        g_list_free locked'
        whenJust service touchManagedPtr
        touchManagedPtr result_
        freeMem locked
        return (result, locked''')
     ) (do
        freeMem locked
     )

#if defined(ENABLE_OVERLOADING)
data ServiceLockFinishMethodInfo
instance (signature ~ (b -> m ((Int32, [Gio.DBusProxy.DBusProxy]))), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ServiceLockFinishMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> b -> m (Int32, [DBusProxy])
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m (Int32, [DBusProxy])
serviceLockFinish (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceLockFinishMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceLockFinish",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceLockFinish"
        })


#endif

-- method Service::lock_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "locked"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionOut
--           , mayBeNull = True
--           , 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get_sync/@ will be called to get
-- the default [class/@service@/] proxy.
-- 
-- This method may block indefinitely and should not be used in user
-- interface threads. The secret service may prompt the user.
-- [method/@service@/.prompt] 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) =>
    Maybe (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 :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsDBusProxy b,
 IsCancellable c) =>
Maybe a -> [b] -> Maybe c -> m (Int32, [DBusProxy])
serviceLockSync Maybe a
service [b]
objects Maybe c
cancellable = IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall a. IO a -> m a
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
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    objects' <- mapM unsafeManagedPtrCastPtr objects
    objects'' <- packGList objects'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    locked <- callocMem :: IO (Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))))
    onException (do
        result <- propagateGError $ secret_service_lock_sync maybeService objects'' maybeCancellable locked
        locked' <- peek locked
        locked'' <- unpackGList locked'
        locked''' <- mapM (wrapObject Gio.DBusProxy.DBusProxy) locked''
        g_list_free locked'
        whenJust service touchManagedPtr
        mapM_ touchManagedPtr objects
        whenJust cancellable touchManagedPtr
        g_list_free objects''
        freeMem locked
        return (result, locked''')
     ) (do
        g_list_free objects''
        freeMem 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.OverloadedMethod ServiceLockSyncMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> [b] -> Maybe c -> m (Int32, [DBusProxy])
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsDBusProxy b,
 IsCancellable c) =>
Maybe a -> [b] -> Maybe c -> m (Int32, [DBusProxy])
serviceLockSync (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceLockSyncMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceLockSync",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceLockSync"
        })


#endif

-- method Service::lookup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get/@ will be called to get
-- the default [class/@service@/] proxy.
-- 
-- This method will return immediately and complete asynchronously.
serviceLookup ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    Maybe (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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceLookup Maybe a
service Maybe Schema
schema Map Text Text
attributes Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    maybeSchema <- case schema of
        Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
FP.nullPtr
        Just Schema
jSchema -> do
            jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            return jSchema'
    let attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    attributes'' <- mapFirstA textToCString attributes'
    attributes''' <- mapSecondA textToCString attributes''
    let attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
attributes'''
    let 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
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    attributes'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) attributes'''''
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_lookup maybeService maybeSchema attributes'''''' maybeCancellable maybeCallback userData
    whenJust service touchManagedPtr
    whenJust schema touchManagedPtr
    whenJust cancellable touchManagedPtr
    unrefGHashTable attributes''''''
    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.OverloadedMethod ServiceLookupMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceLookup (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceLookupMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceLookup",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceLookup"
        })


#endif

-- method Service::lookup_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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) =>
    Maybe (a)
    -- ^ /@service@/: the secret service
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m (Maybe Secret.Value.Value)
    -- ^ __Returns:__ a newly allocated [struct/@value@/], which should be
    --   released with [method/@value@/.unref], or 'P.Nothing' if no secret found /(Can throw 'Data.GI.Base.GError.GError')/
serviceLookupFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m (Maybe Value)
serviceLookupFinish Maybe a
service b
result_ = IO (Maybe Value) -> m (Maybe Value)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Value) -> m (Maybe Value))
-> IO (Maybe Value) -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ secret_service_lookup_finish maybeService result_'
        maybeResult <- convertIfNonNull result $ \Ptr Value
result' -> do
            result'' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Value -> Value
Secret.Value.Value) Ptr Value
result'
            return result''
        whenJust service touchManagedPtr
        touchManagedPtr result_
        return maybeResult
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceLookupFinishMethodInfo
instance (signature ~ (b -> m (Maybe Secret.Value.Value)), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ServiceLookupFinishMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> b -> m (Maybe Value)
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m (Maybe Value)
serviceLookupFinish (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceLookupFinishMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceLookupFinish",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceLookupFinish"
        })


#endif

-- method Service::lookup_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get_sync/@ will be called to get
-- the default [class/@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) =>
    Maybe (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 [struct/@value@/], which should be
    --   released with [method/@value@/.unref], or 'P.Nothing' if no secret found /(Can throw 'Data.GI.Base.GError.GError')/
serviceLookupSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a -> Maybe Schema -> Map Text Text -> Maybe b -> m Value
serviceLookupSync Maybe a
service Maybe Schema
schema Map Text Text
attributes Maybe b
cancellable = IO Value -> m Value
forall a. IO a -> m a
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
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    maybeSchema <- case schema of
        Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
FP.nullPtr
        Just Schema
jSchema -> do
            jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            return jSchema'
    let attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    attributes'' <- mapFirstA textToCString attributes'
    attributes''' <- mapSecondA textToCString attributes''
    let attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
attributes'''
    let 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
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    attributes'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) attributes'''''
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ secret_service_lookup_sync maybeService maybeSchema attributes'''''' maybeCancellable
        checkUnexpectedReturnNULL "serviceLookupSync" result
        result' <- (wrapBoxed Secret.Value.Value) result
        whenJust service touchManagedPtr
        whenJust schema touchManagedPtr
        whenJust cancellable touchManagedPtr
        unrefGHashTable attributes''''''
        return result'
     ) (do
        unrefGHashTable 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.OverloadedMethod ServiceLookupSyncMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> Maybe Schema -> Map Text Text -> Maybe b -> m Value
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a -> Maybe Schema -> Map Text Text -> Maybe b -> m Value
serviceLookupSync (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceLookupSyncMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceLookupSync",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 [class/@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' [vfunc/@service@/.prompt_async] virtual method
-- to change the behavior of the prompting. The default behavior is to simply
-- run [method/@prompt@/.perform] 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 :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsPrompt b,
 IsCancellable c) =>
a
-> b
-> Maybe VariantType
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
servicePrompt a
self b
prompt Maybe VariantType
returnType Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    prompt' <- unsafeManagedPtrCastPtr prompt
    maybeReturnType <- case returnType of
        Maybe VariantType
Nothing -> Ptr VariantType -> IO (Ptr VariantType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VariantType
forall a. Ptr a
FP.nullPtr
        Just VariantType
jReturnType -> do
            jReturnType' <- VariantType -> IO (Ptr VariantType)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VariantType
jReturnType
            return jReturnType'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_prompt self' prompt' maybeReturnType maybeCancellable maybeCallback userData
    touchManagedPtr self
    touchManagedPtr prompt
    whenJust returnType touchManagedPtr
    whenJust cancellable touchManagedPtr
    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.OverloadedMethod ServicePromptMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a
-> b
-> Maybe VariantType
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsPrompt b,
 IsCancellable c) =>
a
-> b
-> Maybe VariantType
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
servicePrompt

instance O.OverloadedMethodInfo ServicePromptMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.servicePrompt",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 [class/@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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
a -> b -> m GVariant
servicePromptFinish a
self b
result_ = IO GVariant -> m GVariant
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ secret_service_prompt_finish self' result_'
        checkUnexpectedReturnNULL "servicePromptFinish" result
        result' <- B.GVariant.wrapGVariantPtr result
        touchManagedPtr self
        touchManagedPtr result_
        return result'
     ) (do
        return ()
     )

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

instance O.OverloadedMethodInfo ServicePromptFinishMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.servicePromptFinish",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 [class/@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' [vfunc/@service@/.prompt_sync] virtual method
-- to change the behavior of the prompting. The default behavior is to simply
-- run [method/@prompt@/.perform_sync] on the prompt with a 'P.Nothing' @window_id@.
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 :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsPrompt b,
 IsCancellable c) =>
a -> b -> Maybe c -> VariantType -> m GVariant
servicePromptSync a
self b
prompt Maybe c
cancellable VariantType
returnType = IO GVariant -> m GVariant
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    prompt' <- unsafeManagedPtrCastPtr prompt
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    returnType' <- unsafeManagedPtrGetPtr returnType
    onException (do
        result <- propagateGError $ secret_service_prompt_sync self' prompt' maybeCancellable returnType'
        checkUnexpectedReturnNULL "servicePromptSync" result
        result' <- B.GVariant.wrapGVariantPtr result
        touchManagedPtr self
        touchManagedPtr prompt
        whenJust cancellable touchManagedPtr
        touchManagedPtr returnType
        return result'
     ) (do
        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.OverloadedMethod ServicePromptSyncMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> Maybe c -> VariantType -> m GVariant
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsPrompt b,
 IsCancellable c) =>
a -> b -> Maybe c -> VariantType -> m GVariant
servicePromptSync

instance O.OverloadedMethodInfo ServicePromptSyncMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.servicePromptSync",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:servicePromptSync"
        })


#endif

-- method Service::search
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get/@ will be called to get
-- the default [class/@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 [method/@item@/.get_secret].
-- 
-- This function returns immediately and completes asynchronously.
serviceSearch ::
    (B.CallStack.HasCallStack, MonadIO m, IsService a, Gio.Cancellable.IsCancellable b) =>
    Maybe (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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceSearch Maybe a
service Maybe Schema
schema Map Text Text
attributes [SearchFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    maybeSchema <- case schema of
        Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
FP.nullPtr
        Just Schema
jSchema -> do
            jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            return jSchema'
    let attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    attributes'' <- mapFirstA textToCString attributes'
    attributes''' <- mapSecondA textToCString attributes''
    let attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
attributes'''
    let 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
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    attributes'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) attributes'''''
    let flags' = [SearchFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SearchFlags]
flags
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_search maybeService maybeSchema attributes'''''' flags' maybeCancellable maybeCallback userData
    whenJust service touchManagedPtr
    whenJust schema touchManagedPtr
    whenJust cancellable touchManagedPtr
    unrefGHashTable attributes''''''
    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.OverloadedMethod ServiceSearchMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceSearch (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceSearchMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceSearch",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceSearch"
        })


#endif

-- method Service::search_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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) =>
    Maybe (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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m [Item]
serviceSearchFinish Maybe a
service b
result_ = IO [Item] -> m [Item]
forall a. IO a -> m a
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
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ secret_service_search_finish maybeService result_'
        result' <- unpackGList result
        result'' <- mapM (wrapObject Secret.Item.Item) result'
        g_list_free result
        whenJust service touchManagedPtr
        touchManagedPtr result_
        return result''
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceSearchFinishMethodInfo
instance (signature ~ (b -> m [Secret.Item.Item]), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ServiceSearchFinishMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> b -> m [Item]
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m [Item]
serviceSearchFinish (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceSearchFinishMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceSearchFinish",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceSearchFinish"
        })


#endif

-- method Service::search_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get_sync/@ will be called to get
-- the default [class/@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 [method/@item@/.get_secret]. 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) =>
    Maybe (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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> m [Item]
serviceSearchSync Maybe a
service Maybe Schema
schema Map Text Text
attributes [SearchFlags]
flags Maybe b
cancellable = IO [Item] -> m [Item]
forall a. IO a -> m a
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
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    maybeSchema <- case schema of
        Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
FP.nullPtr
        Just Schema
jSchema -> do
            jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            return jSchema'
    let attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    attributes'' <- mapFirstA textToCString attributes'
    attributes''' <- mapSecondA textToCString attributes''
    let attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
attributes'''
    let 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
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    attributes'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) attributes'''''
    let flags' = [SearchFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SearchFlags]
flags
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ secret_service_search_sync maybeService maybeSchema attributes'''''' flags' maybeCancellable
        result' <- unpackGList result
        result'' <- mapM (wrapObject Secret.Item.Item) result'
        g_list_free result
        whenJust service touchManagedPtr
        whenJust schema touchManagedPtr
        whenJust cancellable touchManagedPtr
        unrefGHashTable attributes''''''
        return result''
     ) (do
        unrefGHashTable 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.OverloadedMethod ServiceSearchSyncMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> m [Item]
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> m [Item]
serviceSearchSync (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceSearchSyncMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceSearchSync",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceSearchSync"
        })


#endif

-- method Service::set_alias
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret service object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get/@ will be called to get
-- the default [class/@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) =>
    Maybe (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 :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsCollection b,
 IsCancellable c) =>
Maybe a
-> Text -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
serviceSetAlias Maybe a
service Text
alias Maybe b
collection Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    alias' <- textToCString alias
    maybeCollection <- case collection of
        Maybe b
Nothing -> Ptr Collection -> IO (Ptr Collection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Collection
forall a. Ptr a
FP.nullPtr
        Just b
jCollection -> do
            jCollection' <- b -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCollection
            return jCollection'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_set_alias maybeService alias' maybeCollection maybeCancellable maybeCallback userData
    whenJust service touchManagedPtr
    whenJust collection touchManagedPtr
    whenJust cancellable touchManagedPtr
    freeMem alias'
    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.OverloadedMethod ServiceSetAliasMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a
-> Text -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsCollection b,
 IsCancellable c) =>
Maybe a
-> Text -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
serviceSetAlias (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceSetAliasMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceSetAlias",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceSetAlias"
        })


#endif

-- method Service::set_alias_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret service object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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) =>
    Maybe (a)
    -- ^ /@service@/: a secret service object
    -> b
    -- ^ /@result@/: asynchronous result passed to callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceSetAliasFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m ()
serviceSetAliasFinish Maybe a
service b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        _ <- propagateGError $ secret_service_set_alias_finish maybeService result_'
        whenJust service touchManagedPtr
        touchManagedPtr result_
        return ()
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceSetAliasFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ServiceSetAliasFinishMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m ()
serviceSetAliasFinish (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceSetAliasFinishMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceSetAliasFinish",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceSetAliasFinish"
        })


#endif

-- method Service::set_alias_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret service object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get_sync/@ will be called to get
-- the default [class/@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) =>
    Maybe (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 :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsCollection b,
 IsCancellable c) =>
Maybe a -> Text -> Maybe b -> Maybe c -> m ()
serviceSetAliasSync Maybe a
service Text
alias Maybe b
collection Maybe c
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    alias' <- textToCString alias
    maybeCollection <- case collection of
        Maybe b
Nothing -> Ptr Collection -> IO (Ptr Collection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Collection
forall a. Ptr a
FP.nullPtr
        Just b
jCollection -> do
            jCollection' <- b -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCollection
            return jCollection'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    onException (do
        _ <- propagateGError $ secret_service_set_alias_sync maybeService alias' maybeCollection maybeCancellable
        whenJust service touchManagedPtr
        whenJust collection touchManagedPtr
        whenJust cancellable touchManagedPtr
        freeMem alias'
        return ()
     ) (do
        freeMem 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.OverloadedMethod ServiceSetAliasSyncMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> Text -> Maybe b -> Maybe c -> m ()
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsCollection b,
 IsCancellable c) =>
Maybe a -> Text -> Maybe b -> Maybe c -> m ()
serviceSetAliasSync (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceSetAliasSyncMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceSetAliasSync",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceSetAliasSync"
        })


#endif

-- method Service::store
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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\n  collection where to store the secret"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get/@ will be called to get
-- the default [class/@service@/] proxy.
-- 
-- If /@collection@/ is not specified, then the default collection will be
-- used. Use [const/@cOLLECTIONSESSION@/] 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) =>
    Maybe (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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe Text
-> Text
-> Value
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceStore Maybe a
service Maybe Schema
schema Map Text Text
attributes Maybe Text
collection Text
label Value
value Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    maybeSchema <- case schema of
        Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
FP.nullPtr
        Just Schema
jSchema -> do
            jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            return jSchema'
    let attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    attributes'' <- mapFirstA textToCString attributes'
    attributes''' <- mapSecondA textToCString attributes''
    let attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
attributes'''
    let 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
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    attributes'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) attributes'''''
    maybeCollection <- case collection of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jCollection -> do
            jCollection' <- Text -> IO CString
textToCString Text
jCollection
            return jCollection'
    label' <- textToCString label
    value' <- unsafeManagedPtrGetPtr value
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_store maybeService maybeSchema attributes'''''' maybeCollection label' value' maybeCancellable maybeCallback userData
    whenJust service touchManagedPtr
    whenJust schema touchManagedPtr
    touchManagedPtr value
    whenJust cancellable touchManagedPtr
    unrefGHashTable attributes''''''
    freeMem maybeCollection
    freeMem label'
    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.OverloadedMethod ServiceStoreMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe Text
-> Text
-> Value
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe Text
-> Text
-> Value
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
serviceStore (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceStoreMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceStore",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceStore"
        })


#endif

-- method Service::store_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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) =>
    Maybe (a)
    -- ^ /@service@/: the secret service
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serviceStoreFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m ()
serviceStoreFinish Maybe a
service b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        _ <- propagateGError $ secret_service_store_finish maybeService result_'
        whenJust service touchManagedPtr
        touchManagedPtr result_
        return ()
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServiceStoreFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ServiceStoreFinishMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m ()
serviceStoreFinish (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceStoreFinishMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceStoreFinish",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceStoreFinish"
        })


#endif

-- method Service::store_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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\n  collection where to store the secret"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 [const/@cOLLECTIONSESSION@/] to store the password in the session
-- collection, which doesn\'t get stored across login sessions.
-- 
-- If /@service@/ is 'P.Nothing', then @/Service.get_sync/@ will be called to get
-- the default [class/@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) =>
    Maybe (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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe Text
-> Text
-> Value
-> Maybe b
-> m ()
serviceStoreSync Maybe a
service Maybe Schema
schema Map Text Text
attributes Maybe Text
collection Text
label Value
value Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    maybeSchema <- case schema of
        Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
FP.nullPtr
        Just Schema
jSchema -> do
            jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            return jSchema'
    let attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    attributes'' <- mapFirstA textToCString attributes'
    attributes''' <- mapSecondA textToCString attributes''
    let attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
attributes'''
    let 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
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    attributes'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) attributes'''''
    maybeCollection <- case collection of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jCollection -> do
            jCollection' <- Text -> IO CString
textToCString Text
jCollection
            return jCollection'
    label' <- textToCString label
    value' <- unsafeManagedPtrGetPtr value
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        _ <- propagateGError $ secret_service_store_sync maybeService maybeSchema attributes'''''' maybeCollection label' value' maybeCancellable
        whenJust service touchManagedPtr
        whenJust schema touchManagedPtr
        touchManagedPtr value
        whenJust cancellable touchManagedPtr
        unrefGHashTable attributes''''''
        freeMem maybeCollection
        freeMem label'
        return ()
     ) (do
        unrefGHashTable attributes''''''
        freeMem maybeCollection
        freeMem 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.OverloadedMethod ServiceStoreSyncMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe Text
-> Text
-> Value
-> Maybe b
-> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Maybe Schema
-> Map Text Text
-> Maybe Text
-> Text
-> Value
-> Maybe b
-> m ()
serviceStoreSync (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceStoreSyncMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceStoreSync",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceStoreSync"
        })


#endif

-- method Service::unlock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get/@ will be called to get
-- the default [class/@service@/] proxy.
-- 
-- This method may block indefinitely and should not be used in user
-- interface threads. The secret service may prompt the user.
-- [method/@service@/.prompt] 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) =>
    Maybe (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 :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsDBusProxy b,
 IsCancellable c) =>
Maybe a -> [b] -> Maybe c -> Maybe AsyncReadyCallback -> m ()
serviceUnlock Maybe a
service [b]
objects Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    objects' <- mapM unsafeManagedPtrCastPtr objects
    objects'' <- packGList objects'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_unlock maybeService objects'' maybeCancellable maybeCallback userData
    whenJust service touchManagedPtr
    mapM_ touchManagedPtr objects
    whenJust cancellable touchManagedPtr
    g_list_free objects''
    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.OverloadedMethod ServiceUnlockMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> [b] -> Maybe c -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsDBusProxy b,
 IsCancellable c) =>
Maybe a -> [b] -> Maybe c -> Maybe AsyncReadyCallback -> m ()
serviceUnlock (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceUnlockMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceUnlock",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceUnlock"
        })


#endif

-- method Service::unlock_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "unlocked"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionOut
--           , mayBeNull = True
--           , 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
--           , argCallbackUserData = 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) =>
    Maybe (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 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m (Int32, [DBusProxy])
serviceUnlockFinish Maybe a
service b
result_ = IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall a. IO a -> m a
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
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    result_' <- unsafeManagedPtrCastPtr result_
    unlocked <- callocMem :: IO (Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))))
    onException (do
        result <- propagateGError $ secret_service_unlock_finish maybeService result_' unlocked
        unlocked' <- peek unlocked
        unlocked'' <- unpackGList unlocked'
        unlocked''' <- mapM (wrapObject Gio.DBusProxy.DBusProxy) unlocked''
        g_list_free unlocked'
        whenJust service touchManagedPtr
        touchManagedPtr result_
        freeMem unlocked
        return (result, unlocked''')
     ) (do
        freeMem unlocked
     )

#if defined(ENABLE_OVERLOADING)
data ServiceUnlockFinishMethodInfo
instance (signature ~ (b -> m ((Int32, [Gio.DBusProxy.DBusProxy]))), MonadIO m, IsService a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ServiceUnlockFinishMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> b -> m (Int32, [DBusProxy])
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsAsyncResult b) =>
Maybe a -> b -> m (Int32, [DBusProxy])
serviceUnlockFinish (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceUnlockFinishMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceUnlockFinish",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v:serviceUnlockFinish"
        })


#endif

-- method Service::unlock_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret service" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "unlocked"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "DBusProxy" })
--           , direction = DirectionOut
--           , mayBeNull = True
--           , 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
--           , argCallbackUserData = 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 'P.Nothing', then @/Service.get_sync/@ will be called to get
-- the default [class/@service@/] proxy.
-- 
-- This method may block indefinitely and should not be used in user
-- interface threads. The secret service may prompt the user.
-- [method/@service@/.prompt] 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) =>
    Maybe (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 :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsDBusProxy b,
 IsCancellable c) =>
Maybe a -> [b] -> Maybe c -> m (Int32, [DBusProxy])
serviceUnlockSync Maybe a
service [b]
objects Maybe c
cancellable = IO (Int32, [DBusProxy]) -> m (Int32, [DBusProxy])
forall a. IO a -> m a
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
    maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
        Just a
jService -> do
            jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            return jService'
    objects' <- mapM unsafeManagedPtrCastPtr objects
    objects'' <- packGList objects'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    unlocked <- callocMem :: IO (Ptr (Ptr (GList (Ptr Gio.DBusProxy.DBusProxy))))
    onException (do
        result <- propagateGError $ secret_service_unlock_sync maybeService objects'' maybeCancellable unlocked
        unlocked' <- peek unlocked
        unlocked'' <- unpackGList unlocked'
        unlocked''' <- mapM (wrapObject Gio.DBusProxy.DBusProxy) unlocked''
        g_list_free unlocked'
        whenJust service touchManagedPtr
        mapM_ touchManagedPtr objects
        whenJust cancellable touchManagedPtr
        g_list_free objects''
        freeMem unlocked
        return (result, unlocked''')
     ) (do
        g_list_free objects''
        freeMem 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.OverloadedMethod ServiceUnlockSyncMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod a
i = Maybe a -> [b] -> Maybe c -> m (Int32, [DBusProxy])
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsService a, IsDBusProxy b,
 IsCancellable c) =>
Maybe a -> [b] -> Maybe c -> m (Int32, [DBusProxy])
serviceUnlockSync (a -> Maybe a
forall a. a -> Maybe a
Just a
i)

instance O.OverloadedMethodInfo ServiceUnlockSyncMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Service.serviceUnlockSync",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Service.html#v: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 @/Service.get/@
-- and @/Service.get_sync/@.
-- 
-- 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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
serviceDisconnect  = IO () -> m ()
forall a. IO a -> m a
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 a. a -> IO a
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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
[ServiceFlags] -> Maybe a -> Maybe AsyncReadyCallback -> m ()
serviceGet [ServiceFlags]
flags Maybe a
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
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
    maybeCancellable <- case Maybe a
cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just a
jCancellable -> do
            jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_get flags' maybeCancellable maybeCallback userData
    whenJust cancellable touchManagedPtr
    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
--           , argCallbackUserData = 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m Service
serviceGetFinish a
result_ = IO Service -> m Service
forall a. IO a -> m a
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
    result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    onException (do
        result <- propagateGError $ secret_service_get_finish result_'
        checkUnexpectedReturnNULL "serviceGetFinish" result
        result' <- (wrapObject Service) result
        touchManagedPtr result_
        return result'
     ) (do
        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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
[ServiceFlags] -> Maybe a -> m Service
serviceGetSync [ServiceFlags]
flags Maybe a
cancellable = IO Service -> m Service
forall a. IO a -> m a
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
    maybeCancellable <- case Maybe a
cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just a
jCancellable -> do
            jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ secret_service_get_sync flags' maybeCancellable
        checkUnexpectedReturnNULL "serviceGetSync" result
        result' <- (wrapObject Service) result
        whenJust cancellable touchManagedPtr
        return result'
     ) (do
        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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 @/Service.get/@ 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
GType
-> Maybe Text
-> [ServiceFlags]
-> Maybe a
-> Maybe AsyncReadyCallback
-> m ()
serviceOpen GType
serviceGtype Maybe Text
serviceBusName [ServiceFlags]
flags Maybe a
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
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
    maybeServiceBusName <- case Maybe Text
serviceBusName of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jServiceBusName -> do
            jServiceBusName' <- Text -> IO CString
textToCString Text
jServiceBusName
            return jServiceBusName'
    let flags' = [ServiceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ServiceFlags]
flags
    maybeCancellable <- case cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just a
jCancellable -> do
            jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    secret_service_open serviceGtype' maybeServiceBusName flags' maybeCancellable maybeCallback userData
    whenJust cancellable touchManagedPtr
    freeMem maybeServiceBusName
    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
--           , argCallbackUserData = 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m Service
serviceOpenFinish a
result_ = IO Service -> m Service
forall a. IO a -> m a
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
    result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    onException (do
        result <- propagateGError $ secret_service_open_finish result_'
        checkUnexpectedReturnNULL "serviceOpenFinish" result
        result' <- (wrapObject Service) result
        touchManagedPtr result_
        return result'
     ) (do
        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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 @/Service.get_sync/@ 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
GType -> Maybe Text -> [ServiceFlags] -> Maybe a -> m Service
serviceOpenSync GType
serviceGtype Maybe Text
serviceBusName [ServiceFlags]
flags Maybe a
cancellable = IO Service -> m Service
forall a. IO a -> m a
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
    maybeServiceBusName <- case Maybe Text
serviceBusName of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jServiceBusName -> do
            jServiceBusName' <- Text -> IO CString
textToCString Text
jServiceBusName
            return jServiceBusName'
    let flags' = [ServiceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ServiceFlags]
flags
    maybeCancellable <- case cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just a
jCancellable -> do
            jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ secret_service_open_sync serviceGtype' maybeServiceBusName flags' maybeCancellable
        checkUnexpectedReturnNULL "serviceOpenSync" result
        result' <- (wrapObject Service) result
        whenJust cancellable touchManagedPtr
        freeMem maybeServiceBusName
        return result'
     ) (do
        freeMem maybeServiceBusName
     )

#if defined(ENABLE_OVERLOADING)
#endif