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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Soup session state object.
-- 
-- t'GI.Soup.Objects.Session.Session' is the object that controls client-side HTTP. A
-- t'GI.Soup.Objects.Session.Session' encapsulates all of the state that libsoup is keeping
-- on behalf of your program; cached HTTP connections, authentication
-- information, etc. It also keeps track of various global options
-- and features that you are using.
-- 
-- Most applications will only need a single t'GI.Soup.Objects.Session.Session'; the primary
-- reason you might need multiple sessions is if you need to have
-- multiple independent authentication contexts. (Eg, you are
-- connecting to a server and authenticating as two different users at
-- different times; the easiest way to ensure that each [class/@message@/]
-- is sent with the authentication information you intended is to use
-- one session for the first user, and a second session for the other
-- user.)
-- 
-- Additional t'GI.Soup.Objects.Session.Session' functionality is provided by
-- [iface/@sessionFeature@/] objects, which can be added to a session with
-- [method/@session@/.add_feature] or [method/@session@/.add_feature_by_type]
-- For example, [class/@logger@/] provides support for
-- logging HTTP traffic, [class/@contentDecoder@/] provides support for
-- compressed response handling, and [class/@contentSniffer@/] provides
-- support for HTML5-style response body content sniffing.
-- Additionally, subtypes of [class/@auth@/] can be added
-- as features, to add support for additional authentication types.
-- 
-- All @SoupSession@s are created with a [class/@authManager@/], and support
-- for @/SOUP_TYPE_AUTH_BASIC/@ and @/SOUP_TYPE_AUTH_DIGEST/@. Additionally,
-- sessions using the plain t'GI.Soup.Objects.Session.Session' class (rather than one of its deprecated
-- subtypes) have a [class/@contentDecoder@/] by default.
-- 
-- Note that all async methods will invoke their callbacks on the thread-default
-- context at the time of the function call.

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

module GI.Soup.Objects.Session
    ( 

-- * Exported types
    Session(..)                             ,
    IsSession                               ,
    toSession                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [abort]("GI.Soup.Objects.Session#g:method:abort"), [addFeature]("GI.Soup.Objects.Session#g:method:addFeature"), [addFeatureByType]("GI.Soup.Objects.Session#g:method:addFeatureByType"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasFeature]("GI.Soup.Objects.Session#g:method:hasFeature"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [preconnectAsync]("GI.Soup.Objects.Session#g:method:preconnectAsync"), [preconnectFinish]("GI.Soup.Objects.Session#g:method:preconnectFinish"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeFeature]("GI.Soup.Objects.Session#g:method:removeFeature"), [removeFeatureByType]("GI.Soup.Objects.Session#g:method:removeFeatureByType"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [send]("GI.Soup.Objects.Session#g:method:send"), [sendAndRead]("GI.Soup.Objects.Session#g:method:sendAndRead"), [sendAndReadAsync]("GI.Soup.Objects.Session#g:method:sendAndReadAsync"), [sendAndReadFinish]("GI.Soup.Objects.Session#g:method:sendAndReadFinish"), [sendAndSplice]("GI.Soup.Objects.Session#g:method:sendAndSplice"), [sendAndSpliceAsync]("GI.Soup.Objects.Session#g:method:sendAndSpliceAsync"), [sendAndSpliceFinish]("GI.Soup.Objects.Session#g:method:sendAndSpliceFinish"), [sendAsync]("GI.Soup.Objects.Session#g:method:sendAsync"), [sendFinish]("GI.Soup.Objects.Session#g:method:sendFinish"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure"), [websocketConnectAsync]("GI.Soup.Objects.Session#g:method:websocketConnectAsync"), [websocketConnectFinish]("GI.Soup.Objects.Session#g:method:websocketConnectFinish").
-- 
-- ==== Getters
-- [getAcceptLanguage]("GI.Soup.Objects.Session#g:method:getAcceptLanguage"), [getAcceptLanguageAuto]("GI.Soup.Objects.Session#g:method:getAcceptLanguageAuto"), [getAsyncResultMessage]("GI.Soup.Objects.Session#g:method:getAsyncResultMessage"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFeature]("GI.Soup.Objects.Session#g:method:getFeature"), [getFeatureForMessage]("GI.Soup.Objects.Session#g:method:getFeatureForMessage"), [getIdleTimeout]("GI.Soup.Objects.Session#g:method:getIdleTimeout"), [getLocalAddress]("GI.Soup.Objects.Session#g:method:getLocalAddress"), [getMaxConns]("GI.Soup.Objects.Session#g:method:getMaxConns"), [getMaxConnsPerHost]("GI.Soup.Objects.Session#g:method:getMaxConnsPerHost"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getProxyResolver]("GI.Soup.Objects.Session#g:method:getProxyResolver"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRemoteConnectable]("GI.Soup.Objects.Session#g:method:getRemoteConnectable"), [getTimeout]("GI.Soup.Objects.Session#g:method:getTimeout"), [getTlsDatabase]("GI.Soup.Objects.Session#g:method:getTlsDatabase"), [getTlsInteraction]("GI.Soup.Objects.Session#g:method:getTlsInteraction"), [getUserAgent]("GI.Soup.Objects.Session#g:method:getUserAgent").
-- 
-- ==== Setters
-- [setAcceptLanguage]("GI.Soup.Objects.Session#g:method:setAcceptLanguage"), [setAcceptLanguageAuto]("GI.Soup.Objects.Session#g:method:setAcceptLanguageAuto"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIdleTimeout]("GI.Soup.Objects.Session#g:method:setIdleTimeout"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setProxyResolver]("GI.Soup.Objects.Session#g:method:setProxyResolver"), [setTimeout]("GI.Soup.Objects.Session#g:method:setTimeout"), [setTlsDatabase]("GI.Soup.Objects.Session#g:method:setTlsDatabase"), [setTlsInteraction]("GI.Soup.Objects.Session#g:method:setTlsInteraction"), [setUserAgent]("GI.Soup.Objects.Session#g:method:setUserAgent").

#if defined(ENABLE_OVERLOADING)
    ResolveSessionMethod                    ,
#endif

-- ** abort #method:abort#

#if defined(ENABLE_OVERLOADING)
    SessionAbortMethodInfo                  ,
#endif
    sessionAbort                            ,


-- ** addFeature #method:addFeature#

#if defined(ENABLE_OVERLOADING)
    SessionAddFeatureMethodInfo             ,
#endif
    sessionAddFeature                       ,


-- ** addFeatureByType #method:addFeatureByType#

#if defined(ENABLE_OVERLOADING)
    SessionAddFeatureByTypeMethodInfo       ,
#endif
    sessionAddFeatureByType                 ,


-- ** getAcceptLanguage #method:getAcceptLanguage#

#if defined(ENABLE_OVERLOADING)
    SessionGetAcceptLanguageMethodInfo      ,
#endif
    sessionGetAcceptLanguage                ,


-- ** getAcceptLanguageAuto #method:getAcceptLanguageAuto#

#if defined(ENABLE_OVERLOADING)
    SessionGetAcceptLanguageAutoMethodInfo  ,
#endif
    sessionGetAcceptLanguageAuto            ,


-- ** getAsyncResultMessage #method:getAsyncResultMessage#

#if defined(ENABLE_OVERLOADING)
    SessionGetAsyncResultMessageMethodInfo  ,
#endif
    sessionGetAsyncResultMessage            ,


-- ** getFeature #method:getFeature#

#if defined(ENABLE_OVERLOADING)
    SessionGetFeatureMethodInfo             ,
#endif
    sessionGetFeature                       ,


-- ** getFeatureForMessage #method:getFeatureForMessage#

#if defined(ENABLE_OVERLOADING)
    SessionGetFeatureForMessageMethodInfo   ,
#endif
    sessionGetFeatureForMessage             ,


-- ** getIdleTimeout #method:getIdleTimeout#

#if defined(ENABLE_OVERLOADING)
    SessionGetIdleTimeoutMethodInfo         ,
#endif
    sessionGetIdleTimeout                   ,


-- ** getLocalAddress #method:getLocalAddress#

#if defined(ENABLE_OVERLOADING)
    SessionGetLocalAddressMethodInfo        ,
#endif
    sessionGetLocalAddress                  ,


-- ** getMaxConns #method:getMaxConns#

#if defined(ENABLE_OVERLOADING)
    SessionGetMaxConnsMethodInfo            ,
#endif
    sessionGetMaxConns                      ,


-- ** getMaxConnsPerHost #method:getMaxConnsPerHost#

#if defined(ENABLE_OVERLOADING)
    SessionGetMaxConnsPerHostMethodInfo     ,
#endif
    sessionGetMaxConnsPerHost               ,


-- ** getProxyResolver #method:getProxyResolver#

#if defined(ENABLE_OVERLOADING)
    SessionGetProxyResolverMethodInfo       ,
#endif
    sessionGetProxyResolver                 ,


-- ** getRemoteConnectable #method:getRemoteConnectable#

#if defined(ENABLE_OVERLOADING)
    SessionGetRemoteConnectableMethodInfo   ,
#endif
    sessionGetRemoteConnectable             ,


-- ** getTimeout #method:getTimeout#

#if defined(ENABLE_OVERLOADING)
    SessionGetTimeoutMethodInfo             ,
#endif
    sessionGetTimeout                       ,


-- ** getTlsDatabase #method:getTlsDatabase#

#if defined(ENABLE_OVERLOADING)
    SessionGetTlsDatabaseMethodInfo         ,
#endif
    sessionGetTlsDatabase                   ,


-- ** getTlsInteraction #method:getTlsInteraction#

#if defined(ENABLE_OVERLOADING)
    SessionGetTlsInteractionMethodInfo      ,
#endif
    sessionGetTlsInteraction                ,


-- ** getUserAgent #method:getUserAgent#

#if defined(ENABLE_OVERLOADING)
    SessionGetUserAgentMethodInfo           ,
#endif
    sessionGetUserAgent                     ,


-- ** hasFeature #method:hasFeature#

#if defined(ENABLE_OVERLOADING)
    SessionHasFeatureMethodInfo             ,
#endif
    sessionHasFeature                       ,


-- ** new #method:new#

    sessionNew                              ,


-- ** preconnectAsync #method:preconnectAsync#

#if defined(ENABLE_OVERLOADING)
    SessionPreconnectAsyncMethodInfo        ,
#endif
    sessionPreconnectAsync                  ,


-- ** preconnectFinish #method:preconnectFinish#

#if defined(ENABLE_OVERLOADING)
    SessionPreconnectFinishMethodInfo       ,
#endif
    sessionPreconnectFinish                 ,


-- ** removeFeature #method:removeFeature#

#if defined(ENABLE_OVERLOADING)
    SessionRemoveFeatureMethodInfo          ,
#endif
    sessionRemoveFeature                    ,


-- ** removeFeatureByType #method:removeFeatureByType#

#if defined(ENABLE_OVERLOADING)
    SessionRemoveFeatureByTypeMethodInfo    ,
#endif
    sessionRemoveFeatureByType              ,


-- ** send #method:send#

#if defined(ENABLE_OVERLOADING)
    SessionSendMethodInfo                   ,
#endif
    sessionSend                             ,


-- ** sendAndRead #method:sendAndRead#

#if defined(ENABLE_OVERLOADING)
    SessionSendAndReadMethodInfo            ,
#endif
    sessionSendAndRead                      ,


-- ** sendAndReadAsync #method:sendAndReadAsync#

#if defined(ENABLE_OVERLOADING)
    SessionSendAndReadAsyncMethodInfo       ,
#endif
    sessionSendAndReadAsync                 ,


-- ** sendAndReadFinish #method:sendAndReadFinish#

#if defined(ENABLE_OVERLOADING)
    SessionSendAndReadFinishMethodInfo      ,
#endif
    sessionSendAndReadFinish                ,


-- ** sendAndSplice #method:sendAndSplice#

#if defined(ENABLE_OVERLOADING)
    SessionSendAndSpliceMethodInfo          ,
#endif
    sessionSendAndSplice                    ,


-- ** sendAndSpliceAsync #method:sendAndSpliceAsync#

#if defined(ENABLE_OVERLOADING)
    SessionSendAndSpliceAsyncMethodInfo     ,
#endif
    sessionSendAndSpliceAsync               ,


-- ** sendAndSpliceFinish #method:sendAndSpliceFinish#

#if defined(ENABLE_OVERLOADING)
    SessionSendAndSpliceFinishMethodInfo    ,
#endif
    sessionSendAndSpliceFinish              ,


-- ** sendAsync #method:sendAsync#

#if defined(ENABLE_OVERLOADING)
    SessionSendAsyncMethodInfo              ,
#endif
    sessionSendAsync                        ,


-- ** sendFinish #method:sendFinish#

#if defined(ENABLE_OVERLOADING)
    SessionSendFinishMethodInfo             ,
#endif
    sessionSendFinish                       ,


-- ** setAcceptLanguage #method:setAcceptLanguage#

#if defined(ENABLE_OVERLOADING)
    SessionSetAcceptLanguageMethodInfo      ,
#endif
    sessionSetAcceptLanguage                ,


-- ** setAcceptLanguageAuto #method:setAcceptLanguageAuto#

#if defined(ENABLE_OVERLOADING)
    SessionSetAcceptLanguageAutoMethodInfo  ,
#endif
    sessionSetAcceptLanguageAuto            ,


-- ** setIdleTimeout #method:setIdleTimeout#

#if defined(ENABLE_OVERLOADING)
    SessionSetIdleTimeoutMethodInfo         ,
#endif
    sessionSetIdleTimeout                   ,


-- ** setProxyResolver #method:setProxyResolver#

#if defined(ENABLE_OVERLOADING)
    SessionSetProxyResolverMethodInfo       ,
#endif
    sessionSetProxyResolver                 ,


-- ** setTimeout #method:setTimeout#

#if defined(ENABLE_OVERLOADING)
    SessionSetTimeoutMethodInfo             ,
#endif
    sessionSetTimeout                       ,


-- ** setTlsDatabase #method:setTlsDatabase#

#if defined(ENABLE_OVERLOADING)
    SessionSetTlsDatabaseMethodInfo         ,
#endif
    sessionSetTlsDatabase                   ,


-- ** setTlsInteraction #method:setTlsInteraction#

#if defined(ENABLE_OVERLOADING)
    SessionSetTlsInteractionMethodInfo      ,
#endif
    sessionSetTlsInteraction                ,


-- ** setUserAgent #method:setUserAgent#

#if defined(ENABLE_OVERLOADING)
    SessionSetUserAgentMethodInfo           ,
#endif
    sessionSetUserAgent                     ,


-- ** websocketConnectAsync #method:websocketConnectAsync#

#if defined(ENABLE_OVERLOADING)
    SessionWebsocketConnectAsyncMethodInfo  ,
#endif
    sessionWebsocketConnectAsync            ,


-- ** websocketConnectFinish #method:websocketConnectFinish#

#if defined(ENABLE_OVERLOADING)
    SessionWebsocketConnectFinishMethodInfo ,
#endif
    sessionWebsocketConnectFinish           ,




 -- * Properties


-- ** acceptLanguage #attr:acceptLanguage#
-- | If non-'P.Nothing', the value to use for the \"Accept-Language\" header
-- on [class/@message@/]s sent from this session.
-- 
-- Setting this will disable [property/@session@/:accept-language-auto].

#if defined(ENABLE_OVERLOADING)
    SessionAcceptLanguagePropertyInfo       ,
#endif
    constructSessionAcceptLanguage          ,
    getSessionAcceptLanguage                ,
#if defined(ENABLE_OVERLOADING)
    sessionAcceptLanguage                   ,
#endif
    setSessionAcceptLanguage                ,


-- ** acceptLanguageAuto #attr:acceptLanguageAuto#
-- | If 'P.True', t'GI.Soup.Objects.Session.Session' will automatically set the string
-- for the \"Accept-Language\" header on every [class/@message@/]
-- sent, based on the return value of 'GI.GLib.Functions.getLanguageNames'.
-- 
-- Setting this will override any previous value of
-- [property/@session@/:accept-language].

#if defined(ENABLE_OVERLOADING)
    SessionAcceptLanguageAutoPropertyInfo   ,
#endif
    constructSessionAcceptLanguageAuto      ,
    getSessionAcceptLanguageAuto            ,
#if defined(ENABLE_OVERLOADING)
    sessionAcceptLanguageAuto               ,
#endif
    setSessionAcceptLanguageAuto            ,


-- ** idleTimeout #attr:idleTimeout#
-- | Connection lifetime (in seconds) when idle. Any connection
-- left idle longer than this will be closed.
-- 
-- Although you can change this property at any time, it will
-- only affect newly-created connections, not currently-open
-- ones. You can call [method/@session@/.abort] after setting this
-- if you want to ensure that all future connections will have
-- this timeout value.

#if defined(ENABLE_OVERLOADING)
    SessionIdleTimeoutPropertyInfo          ,
#endif
    constructSessionIdleTimeout             ,
    getSessionIdleTimeout                   ,
#if defined(ENABLE_OVERLOADING)
    sessionIdleTimeout                      ,
#endif
    setSessionIdleTimeout                   ,


-- ** localAddress #attr:localAddress#
-- | Sets the t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress' to use for the client side of
-- the connection.
-- 
-- Use this property if you want for instance to bind the
-- local socket to a specific IP address.

#if defined(ENABLE_OVERLOADING)
    SessionLocalAddressPropertyInfo         ,
#endif
    constructSessionLocalAddress            ,
    getSessionLocalAddress                  ,
#if defined(ENABLE_OVERLOADING)
    sessionLocalAddress                     ,
#endif


-- ** maxConns #attr:maxConns#
-- | The maximum number of connections that the session can open at once.

#if defined(ENABLE_OVERLOADING)
    SessionMaxConnsPropertyInfo             ,
#endif
    constructSessionMaxConns                ,
    getSessionMaxConns                      ,
#if defined(ENABLE_OVERLOADING)
    sessionMaxConns                         ,
#endif


-- ** maxConnsPerHost #attr:maxConnsPerHost#
-- | The maximum number of connections that the session can open at once
-- to a given host.

#if defined(ENABLE_OVERLOADING)
    SessionMaxConnsPerHostPropertyInfo      ,
#endif
    constructSessionMaxConnsPerHost         ,
    getSessionMaxConnsPerHost               ,
#if defined(ENABLE_OVERLOADING)
    sessionMaxConnsPerHost                  ,
#endif


-- ** proxyResolver #attr:proxyResolver#
-- | A t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver' to use with this session.
-- 
-- If no proxy resolver is set, then the default proxy resolver
-- will be used. See [func/@gio@/.ProxyResolver.get_default].
-- You can set it to 'P.Nothing' if you don\'t want to use proxies, or
-- set it to your own t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver' if you want to control
-- what proxies get used.

#if defined(ENABLE_OVERLOADING)
    SessionProxyResolverPropertyInfo        ,
#endif
    clearSessionProxyResolver               ,
    constructSessionProxyResolver           ,
    getSessionProxyResolver                 ,
#if defined(ENABLE_OVERLOADING)
    sessionProxyResolver                    ,
#endif
    setSessionProxyResolver                 ,


-- ** remoteConnectable #attr:remoteConnectable#
-- | Sets a socket to make outgoing connections on. This will override the default
-- behaviour of opening TCP\/IP sockets to the hosts specified in the URIs.
-- 
-- This function is not required for common HTTP usage, but only when connecting
-- to a HTTP service that is not using standard TCP\/IP sockets. An example of
-- this is a local service that uses HTTP over UNIX-domain sockets, in that case
-- a t'GI.Gio.Objects.UnixSocketAddress.UnixSocketAddress' can be passed to this function.

#if defined(ENABLE_OVERLOADING)
    SessionRemoteConnectablePropertyInfo    ,
#endif
    constructSessionRemoteConnectable       ,
    getSessionRemoteConnectable             ,
#if defined(ENABLE_OVERLOADING)
    sessionRemoteConnectable                ,
#endif


-- ** timeout #attr:timeout#
-- | The timeout (in seconds) for socket I\/O operations
-- (including connecting to a server, and waiting for a reply
-- to an HTTP request).
-- 
-- Although you can change this property at any time, it will
-- only affect newly-created connections, not currently-open
-- ones. You can call [method/@session@/.abort] after setting this
-- if you want to ensure that all future connections will have
-- this timeout value.
-- 
-- Not to be confused with [property/@session@/:idle-timeout] (which is
-- the length of time that idle persistent connections will be
-- kept open).

#if defined(ENABLE_OVERLOADING)
    SessionTimeoutPropertyInfo              ,
#endif
    constructSessionTimeout                 ,
    getSessionTimeout                       ,
#if defined(ENABLE_OVERLOADING)
    sessionTimeout                          ,
#endif
    setSessionTimeout                       ,


-- ** tlsDatabase #attr:tlsDatabase#
-- | Sets the t'GI.Gio.Objects.TlsDatabase.TlsDatabase' to use for validating SSL\/TLS
-- certificates.
-- 
-- If no certificate database is set, then the default database will be
-- used. See 'GI.Gio.Interfaces.TlsBackend.tlsBackendGetDefaultDatabase'.

#if defined(ENABLE_OVERLOADING)
    SessionTlsDatabasePropertyInfo          ,
#endif
    clearSessionTlsDatabase                 ,
    constructSessionTlsDatabase             ,
    getSessionTlsDatabase                   ,
#if defined(ENABLE_OVERLOADING)
    sessionTlsDatabase                      ,
#endif
    setSessionTlsDatabase                   ,


-- ** tlsInteraction #attr:tlsInteraction#
-- | A t'GI.Gio.Objects.TlsInteraction.TlsInteraction' object that will be passed on to any
-- t'GI.Gio.Objects.TlsConnection.TlsConnection's created by the session.
-- 
-- This can be used to provide client-side certificates, for example.

#if defined(ENABLE_OVERLOADING)
    SessionTlsInteractionPropertyInfo       ,
#endif
    clearSessionTlsInteraction              ,
    constructSessionTlsInteraction          ,
    getSessionTlsInteraction                ,
#if defined(ENABLE_OVERLOADING)
    sessionTlsInteraction                   ,
#endif
    setSessionTlsInteraction                ,


-- ** userAgent #attr:userAgent#
-- | User-Agent string.
-- 
-- If non-'P.Nothing', the value to use for the \"User-Agent\" header
-- on [class/@message@/]s sent from this session.
-- 
-- RFC 2616 says: \"The User-Agent request-header field
-- contains information about the user agent originating the
-- request. This is for statistical purposes, the tracing of
-- protocol violations, and automated recognition of user
-- agents for the sake of tailoring responses to avoid
-- particular user agent limitations. User agents SHOULD
-- include this field with requests.\"
-- 
-- The User-Agent header contains a list of one or more
-- product tokens, separated by whitespace, with the most
-- significant product token coming first. The tokens must be
-- brief, ASCII, and mostly alphanumeric (although \"-\", \"_\",
-- and \".\" are also allowed), and may optionally include a \"\/\"
-- followed by a version string. You may also put comments,
-- enclosed in parentheses, between or after the tokens.
-- 
-- If you set a [property/@session@/:user-agent] property that has trailing
-- whitespace, t'GI.Soup.Objects.Session.Session' will append its own product token
-- (eg, @libsoup\/2.3.2@) to the end of the
-- header for you.

#if defined(ENABLE_OVERLOADING)
    SessionUserAgentPropertyInfo            ,
#endif
    constructSessionUserAgent               ,
    getSessionUserAgent                     ,
#if defined(ENABLE_OVERLOADING)
    sessionUserAgent                        ,
#endif
    setSessionUserAgent                     ,




 -- * Signals


-- ** requestQueued #signal:requestQueued#

    SessionRequestQueuedCallback            ,
#if defined(ENABLE_OVERLOADING)
    SessionRequestQueuedSignalInfo          ,
#endif
    afterSessionRequestQueued               ,
    onSessionRequestQueued                  ,


-- ** requestUnqueued #signal:requestUnqueued#

    SessionRequestUnqueuedCallback          ,
#if defined(ENABLE_OVERLOADING)
    SessionRequestUnqueuedSignalInfo        ,
#endif
    afterSessionRequestUnqueued             ,
    onSessionRequestUnqueued                ,




    ) 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 GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.ProxyResolver as Gio.ProxyResolver
import qualified GI.Gio.Interfaces.SocketConnectable as Gio.SocketConnectable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InetSocketAddress as Gio.InetSocketAddress
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import qualified GI.Gio.Objects.TlsDatabase as Gio.TlsDatabase
import qualified GI.Gio.Objects.TlsInteraction as Gio.TlsInteraction
import {-# SOURCE #-} qualified GI.Soup.Interfaces.SessionFeature as Soup.SessionFeature
import {-# SOURCE #-} qualified GI.Soup.Objects.Message as Soup.Message
import {-# SOURCE #-} qualified GI.Soup.Objects.WebsocketConnection as Soup.WebsocketConnection

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

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

foreign import ccall "soup_session_get_type"
    c_soup_session_get_type :: IO B.Types.GType

instance B.Types.TypedObject Session where
    glibType :: IO GType
glibType = IO GType
c_soup_session_get_type

instance B.Types.GObject Session

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

instance O.HasParentTypes Session
type instance O.ParentTypes Session = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSessionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSessionMethod "abort" o = SessionAbortMethodInfo
    ResolveSessionMethod "addFeature" o = SessionAddFeatureMethodInfo
    ResolveSessionMethod "addFeatureByType" o = SessionAddFeatureByTypeMethodInfo
    ResolveSessionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSessionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSessionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSessionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSessionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSessionMethod "hasFeature" o = SessionHasFeatureMethodInfo
    ResolveSessionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSessionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSessionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSessionMethod "preconnectAsync" o = SessionPreconnectAsyncMethodInfo
    ResolveSessionMethod "preconnectFinish" o = SessionPreconnectFinishMethodInfo
    ResolveSessionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSessionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSessionMethod "removeFeature" o = SessionRemoveFeatureMethodInfo
    ResolveSessionMethod "removeFeatureByType" o = SessionRemoveFeatureByTypeMethodInfo
    ResolveSessionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSessionMethod "send" o = SessionSendMethodInfo
    ResolveSessionMethod "sendAndRead" o = SessionSendAndReadMethodInfo
    ResolveSessionMethod "sendAndReadAsync" o = SessionSendAndReadAsyncMethodInfo
    ResolveSessionMethod "sendAndReadFinish" o = SessionSendAndReadFinishMethodInfo
    ResolveSessionMethod "sendAndSplice" o = SessionSendAndSpliceMethodInfo
    ResolveSessionMethod "sendAndSpliceAsync" o = SessionSendAndSpliceAsyncMethodInfo
    ResolveSessionMethod "sendAndSpliceFinish" o = SessionSendAndSpliceFinishMethodInfo
    ResolveSessionMethod "sendAsync" o = SessionSendAsyncMethodInfo
    ResolveSessionMethod "sendFinish" o = SessionSendFinishMethodInfo
    ResolveSessionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSessionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSessionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSessionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSessionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSessionMethod "websocketConnectAsync" o = SessionWebsocketConnectAsyncMethodInfo
    ResolveSessionMethod "websocketConnectFinish" o = SessionWebsocketConnectFinishMethodInfo
    ResolveSessionMethod "getAcceptLanguage" o = SessionGetAcceptLanguageMethodInfo
    ResolveSessionMethod "getAcceptLanguageAuto" o = SessionGetAcceptLanguageAutoMethodInfo
    ResolveSessionMethod "getAsyncResultMessage" o = SessionGetAsyncResultMessageMethodInfo
    ResolveSessionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSessionMethod "getFeature" o = SessionGetFeatureMethodInfo
    ResolveSessionMethod "getFeatureForMessage" o = SessionGetFeatureForMessageMethodInfo
    ResolveSessionMethod "getIdleTimeout" o = SessionGetIdleTimeoutMethodInfo
    ResolveSessionMethod "getLocalAddress" o = SessionGetLocalAddressMethodInfo
    ResolveSessionMethod "getMaxConns" o = SessionGetMaxConnsMethodInfo
    ResolveSessionMethod "getMaxConnsPerHost" o = SessionGetMaxConnsPerHostMethodInfo
    ResolveSessionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSessionMethod "getProxyResolver" o = SessionGetProxyResolverMethodInfo
    ResolveSessionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSessionMethod "getRemoteConnectable" o = SessionGetRemoteConnectableMethodInfo
    ResolveSessionMethod "getTimeout" o = SessionGetTimeoutMethodInfo
    ResolveSessionMethod "getTlsDatabase" o = SessionGetTlsDatabaseMethodInfo
    ResolveSessionMethod "getTlsInteraction" o = SessionGetTlsInteractionMethodInfo
    ResolveSessionMethod "getUserAgent" o = SessionGetUserAgentMethodInfo
    ResolveSessionMethod "setAcceptLanguage" o = SessionSetAcceptLanguageMethodInfo
    ResolveSessionMethod "setAcceptLanguageAuto" o = SessionSetAcceptLanguageAutoMethodInfo
    ResolveSessionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSessionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSessionMethod "setIdleTimeout" o = SessionSetIdleTimeoutMethodInfo
    ResolveSessionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSessionMethod "setProxyResolver" o = SessionSetProxyResolverMethodInfo
    ResolveSessionMethod "setTimeout" o = SessionSetTimeoutMethodInfo
    ResolveSessionMethod "setTlsDatabase" o = SessionSetTlsDatabaseMethodInfo
    ResolveSessionMethod "setTlsInteraction" o = SessionSetTlsInteractionMethodInfo
    ResolveSessionMethod "setUserAgent" o = SessionSetUserAgentMethodInfo
    ResolveSessionMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif

-- signal Session::request-queued
-- | Emitted when a request is queued on /@session@/.
-- 
-- When sending a request, first [signal/@session@/[requestQueued](#g:signal:requestQueued)]
-- is emitted, indicating that the session has become aware of
-- the request.
-- 
-- After a connection is available to send the request various
-- [class/@message@/] signals are emitted as the message is
-- processed. If the message is requeued, it will emit
-- [signal/@message@/[restarted](#g:signal:restarted)], which will then be followed by other
-- [class/@message@/] signals when the message is re-sent.
-- 
-- Eventually, the message will emit [signal/@message@/[finished](#g:signal:finished)].
-- Normally, this signals the completion of message
-- processing. However, it is possible that the application
-- will requeue the message from the \"finished\" handler.
-- In that case the process will loop back.
-- 
-- Eventually, a message will reach \"finished\" and not be
-- requeued. At that point, the session will emit
-- [signal/@session@/[requestUnqueued](#g:signal:requestUnqueued)] to indicate that it is done
-- with the message.
-- 
-- To sum up: [signal/@session@/[requestQueued](#g:signal:requestQueued)] and
-- [signal/@session@/[requestUnqueued](#g:signal:requestUnqueued)] are guaranteed to be emitted
-- exactly once, but [signal/@message@/[finished](#g:signal:finished)] (and all of the other
-- [class/@message@/] signals) may be invoked multiple times for a given
-- message.
type SessionRequestQueuedCallback =
    Soup.Message.Message
    -- ^ /@msg@/: the request that was queued
    -> IO ()

type C_SessionRequestQueuedCallback =
    Ptr Session ->                          -- object
    Ptr Soup.Message.Message ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_SessionRequestQueuedCallback :: 
    GObject a => (a -> SessionRequestQueuedCallback) ->
    C_SessionRequestQueuedCallback
wrap_SessionRequestQueuedCallback :: forall a.
GObject a =>
(a -> SessionRequestQueuedCallback)
-> C_SessionRequestQueuedCallback
wrap_SessionRequestQueuedCallback a -> SessionRequestQueuedCallback
gi'cb Ptr Session
gi'selfPtr Ptr Message
msg Ptr ()
_ = do
    Message
msg' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Message -> Message
Soup.Message.Message) Ptr Message
msg
    Ptr Session -> (Session -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Session
gi'selfPtr ((Session -> IO ()) -> IO ()) -> (Session -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Session
gi'self -> a -> SessionRequestQueuedCallback
gi'cb (Session -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Session
gi'self)  Message
msg'


-- | Connect a signal handler for the [requestQueued](#signal:requestQueued) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' session #requestQueued callback
-- @
-- 
-- 
onSessionRequestQueued :: (IsSession a, MonadIO m) => a -> ((?self :: a) => SessionRequestQueuedCallback) -> m SignalHandlerId
onSessionRequestQueued :: forall a (m :: * -> *).
(IsSession a, MonadIO m) =>
a
-> ((?self::a) => SessionRequestQueuedCallback)
-> m SignalHandlerId
onSessionRequestQueued a
obj (?self::a) => SessionRequestQueuedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SessionRequestQueuedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SessionRequestQueuedCallback
SessionRequestQueuedCallback
cb
    let wrapped' :: C_SessionRequestQueuedCallback
wrapped' = (a -> SessionRequestQueuedCallback)
-> C_SessionRequestQueuedCallback
forall a.
GObject a =>
(a -> SessionRequestQueuedCallback)
-> C_SessionRequestQueuedCallback
wrap_SessionRequestQueuedCallback a -> SessionRequestQueuedCallback
wrapped
    FunPtr C_SessionRequestQueuedCallback
wrapped'' <- C_SessionRequestQueuedCallback
-> IO (FunPtr C_SessionRequestQueuedCallback)
mk_SessionRequestQueuedCallback C_SessionRequestQueuedCallback
wrapped'
    a
-> Text
-> FunPtr C_SessionRequestQueuedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"request-queued" FunPtr C_SessionRequestQueuedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data SessionRequestQueuedSignalInfo
instance SignalInfo SessionRequestQueuedSignalInfo where
    type HaskellCallbackType SessionRequestQueuedSignalInfo = SessionRequestQueuedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SessionRequestQueuedCallback cb
        cb'' <- mk_SessionRequestQueuedCallback cb'
        connectSignalFunPtr obj "request-queued" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session::request-queued"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:signal:requestQueued"})

#endif

-- signal Session::request-unqueued
-- | Emitted when a request is removed from /@session@/\'s queue,
-- indicating that /@session@/ is done with it.
-- 
-- See [signal/@session@/[requestQueued](#g:signal:requestQueued)] for a detailed description of
-- the message lifecycle within a session.
type SessionRequestUnqueuedCallback =
    Soup.Message.Message
    -- ^ /@msg@/: the request that was unqueued
    -> IO ()

type C_SessionRequestUnqueuedCallback =
    Ptr Session ->                          -- object
    Ptr Soup.Message.Message ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_SessionRequestUnqueuedCallback :: 
    GObject a => (a -> SessionRequestUnqueuedCallback) ->
    C_SessionRequestUnqueuedCallback
wrap_SessionRequestUnqueuedCallback :: forall a.
GObject a =>
(a -> SessionRequestQueuedCallback)
-> C_SessionRequestQueuedCallback
wrap_SessionRequestUnqueuedCallback a -> SessionRequestQueuedCallback
gi'cb Ptr Session
gi'selfPtr Ptr Message
msg Ptr ()
_ = do
    Message
msg' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Message -> Message
Soup.Message.Message) Ptr Message
msg
    Ptr Session -> (Session -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Session
gi'selfPtr ((Session -> IO ()) -> IO ()) -> (Session -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Session
gi'self -> a -> SessionRequestQueuedCallback
gi'cb (Session -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Session
gi'self)  Message
msg'


-- | Connect a signal handler for the [requestUnqueued](#signal:requestUnqueued) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' session #requestUnqueued callback
-- @
-- 
-- 
onSessionRequestUnqueued :: (IsSession a, MonadIO m) => a -> ((?self :: a) => SessionRequestUnqueuedCallback) -> m SignalHandlerId
onSessionRequestUnqueued :: forall a (m :: * -> *).
(IsSession a, MonadIO m) =>
a
-> ((?self::a) => SessionRequestQueuedCallback)
-> m SignalHandlerId
onSessionRequestUnqueued a
obj (?self::a) => SessionRequestQueuedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SessionRequestQueuedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SessionRequestQueuedCallback
SessionRequestQueuedCallback
cb
    let wrapped' :: C_SessionRequestQueuedCallback
wrapped' = (a -> SessionRequestQueuedCallback)
-> C_SessionRequestQueuedCallback
forall a.
GObject a =>
(a -> SessionRequestQueuedCallback)
-> C_SessionRequestQueuedCallback
wrap_SessionRequestUnqueuedCallback a -> SessionRequestQueuedCallback
wrapped
    FunPtr C_SessionRequestQueuedCallback
wrapped'' <- C_SessionRequestQueuedCallback
-> IO (FunPtr C_SessionRequestQueuedCallback)
mk_SessionRequestUnqueuedCallback C_SessionRequestQueuedCallback
wrapped'
    a
-> Text
-> FunPtr C_SessionRequestQueuedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"request-unqueued" FunPtr C_SessionRequestQueuedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data SessionRequestUnqueuedSignalInfo
instance SignalInfo SessionRequestUnqueuedSignalInfo where
    type HaskellCallbackType SessionRequestUnqueuedSignalInfo = SessionRequestUnqueuedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SessionRequestUnqueuedCallback cb
        cb'' <- mk_SessionRequestUnqueuedCallback cb'
        connectSignalFunPtr obj "request-unqueued" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session::request-unqueued"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:signal:requestUnqueued"})

#endif

-- VVV Prop "accept-language"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just False)

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

-- | Set the value of the “@accept-language@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' session [ #acceptLanguage 'Data.GI.Base.Attributes.:=' value ]
-- @
setSessionAcceptLanguage :: (MonadIO m, IsSession o) => o -> T.Text -> m ()
setSessionAcceptLanguage :: forall (m :: * -> *) o.
(MonadIO m, IsSession o) =>
o -> Text -> m ()
setSessionAcceptLanguage o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"accept-language" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data SessionAcceptLanguagePropertyInfo
instance AttrInfo SessionAcceptLanguagePropertyInfo where
    type AttrAllowedOps SessionAcceptLanguagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SessionAcceptLanguagePropertyInfo = IsSession
    type AttrSetTypeConstraint SessionAcceptLanguagePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SessionAcceptLanguagePropertyInfo = (~) T.Text
    type AttrTransferType SessionAcceptLanguagePropertyInfo = T.Text
    type AttrGetType SessionAcceptLanguagePropertyInfo = (Maybe T.Text)
    type AttrLabel SessionAcceptLanguagePropertyInfo = "accept-language"
    type AttrOrigin SessionAcceptLanguagePropertyInfo = Session
    attrGet = getSessionAcceptLanguage
    attrSet = setSessionAcceptLanguage
    attrTransfer _ v = do
        return v
    attrConstruct = constructSessionAcceptLanguage
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.acceptLanguage"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:acceptLanguage"
        })
#endif

-- VVV Prop "accept-language-auto"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@accept-language-auto@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' session [ #acceptLanguageAuto 'Data.GI.Base.Attributes.:=' value ]
-- @
setSessionAcceptLanguageAuto :: (MonadIO m, IsSession o) => o -> Bool -> m ()
setSessionAcceptLanguageAuto :: forall (m :: * -> *) o.
(MonadIO m, IsSession o) =>
o -> Bool -> m ()
setSessionAcceptLanguageAuto o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"accept-language-auto" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@accept-language-auto@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSessionAcceptLanguageAuto :: (IsSession o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSessionAcceptLanguageAuto :: forall o (m :: * -> *).
(IsSession o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructSessionAcceptLanguageAuto Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"accept-language-auto" Bool
val

#if defined(ENABLE_OVERLOADING)
data SessionAcceptLanguageAutoPropertyInfo
instance AttrInfo SessionAcceptLanguageAutoPropertyInfo where
    type AttrAllowedOps SessionAcceptLanguageAutoPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SessionAcceptLanguageAutoPropertyInfo = IsSession
    type AttrSetTypeConstraint SessionAcceptLanguageAutoPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SessionAcceptLanguageAutoPropertyInfo = (~) Bool
    type AttrTransferType SessionAcceptLanguageAutoPropertyInfo = Bool
    type AttrGetType SessionAcceptLanguageAutoPropertyInfo = Bool
    type AttrLabel SessionAcceptLanguageAutoPropertyInfo = "accept-language-auto"
    type AttrOrigin SessionAcceptLanguageAutoPropertyInfo = Session
    attrGet = getSessionAcceptLanguageAuto
    attrSet = setSessionAcceptLanguageAuto
    attrTransfer _ v = do
        return v
    attrConstruct = constructSessionAcceptLanguageAuto
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.acceptLanguageAuto"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:acceptLanguageAuto"
        })
#endif

-- VVV Prop "idle-timeout"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@idle-timeout@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' session [ #idleTimeout 'Data.GI.Base.Attributes.:=' value ]
-- @
setSessionIdleTimeout :: (MonadIO m, IsSession o) => o -> Word32 -> m ()
setSessionIdleTimeout :: forall (m :: * -> *) o.
(MonadIO m, IsSession o) =>
o -> Word32 -> m ()
setSessionIdleTimeout o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"idle-timeout" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@idle-timeout@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSessionIdleTimeout :: (IsSession o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructSessionIdleTimeout :: forall o (m :: * -> *).
(IsSession o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructSessionIdleTimeout Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"idle-timeout" Word32
val

#if defined(ENABLE_OVERLOADING)
data SessionIdleTimeoutPropertyInfo
instance AttrInfo SessionIdleTimeoutPropertyInfo where
    type AttrAllowedOps SessionIdleTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SessionIdleTimeoutPropertyInfo = IsSession
    type AttrSetTypeConstraint SessionIdleTimeoutPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint SessionIdleTimeoutPropertyInfo = (~) Word32
    type AttrTransferType SessionIdleTimeoutPropertyInfo = Word32
    type AttrGetType SessionIdleTimeoutPropertyInfo = Word32
    type AttrLabel SessionIdleTimeoutPropertyInfo = "idle-timeout"
    type AttrOrigin SessionIdleTimeoutPropertyInfo = Session
    attrGet = getSessionIdleTimeout
    attrSet = setSessionIdleTimeout
    attrTransfer _ v = do
        return v
    attrConstruct = constructSessionIdleTimeout
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.idleTimeout"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:idleTimeout"
        })
#endif

-- VVV Prop "local-address"
   -- Type: TInterface (Name {namespace = "Gio", name = "InetSocketAddress"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
data SessionLocalAddressPropertyInfo
instance AttrInfo SessionLocalAddressPropertyInfo where
    type AttrAllowedOps SessionLocalAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SessionLocalAddressPropertyInfo = IsSession
    type AttrSetTypeConstraint SessionLocalAddressPropertyInfo = Gio.InetSocketAddress.IsInetSocketAddress
    type AttrTransferTypeConstraint SessionLocalAddressPropertyInfo = Gio.InetSocketAddress.IsInetSocketAddress
    type AttrTransferType SessionLocalAddressPropertyInfo = Gio.InetSocketAddress.InetSocketAddress
    type AttrGetType SessionLocalAddressPropertyInfo = (Maybe Gio.InetSocketAddress.InetSocketAddress)
    type AttrLabel SessionLocalAddressPropertyInfo = "local-address"
    type AttrOrigin SessionLocalAddressPropertyInfo = Session
    attrGet = getSessionLocalAddress
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.InetSocketAddress.InetSocketAddress v
    attrConstruct = constructSessionLocalAddress
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.localAddress"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:localAddress"
        })
#endif

-- VVV Prop "max-conns"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@max-conns@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSessionMaxConns :: (IsSession o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructSessionMaxConns :: forall o (m :: * -> *).
(IsSession o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructSessionMaxConns Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"max-conns" Int32
val

#if defined(ENABLE_OVERLOADING)
data SessionMaxConnsPropertyInfo
instance AttrInfo SessionMaxConnsPropertyInfo where
    type AttrAllowedOps SessionMaxConnsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SessionMaxConnsPropertyInfo = IsSession
    type AttrSetTypeConstraint SessionMaxConnsPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint SessionMaxConnsPropertyInfo = (~) Int32
    type AttrTransferType SessionMaxConnsPropertyInfo = Int32
    type AttrGetType SessionMaxConnsPropertyInfo = Int32
    type AttrLabel SessionMaxConnsPropertyInfo = "max-conns"
    type AttrOrigin SessionMaxConnsPropertyInfo = Session
    attrGet = getSessionMaxConns
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructSessionMaxConns
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.maxConns"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:maxConns"
        })
#endif

-- VVV Prop "max-conns-per-host"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@max-conns-per-host@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' session #maxConnsPerHost
-- @
getSessionMaxConnsPerHost :: (MonadIO m, IsSession o) => o -> m Int32
getSessionMaxConnsPerHost :: forall (m :: * -> *) o. (MonadIO m, IsSession o) => o -> m Int32
getSessionMaxConnsPerHost o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"max-conns-per-host"

-- | Construct a `GValueConstruct` with valid value for the “@max-conns-per-host@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSessionMaxConnsPerHost :: (IsSession o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructSessionMaxConnsPerHost :: forall o (m :: * -> *).
(IsSession o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructSessionMaxConnsPerHost Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"max-conns-per-host" Int32
val

#if defined(ENABLE_OVERLOADING)
data SessionMaxConnsPerHostPropertyInfo
instance AttrInfo SessionMaxConnsPerHostPropertyInfo where
    type AttrAllowedOps SessionMaxConnsPerHostPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SessionMaxConnsPerHostPropertyInfo = IsSession
    type AttrSetTypeConstraint SessionMaxConnsPerHostPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint SessionMaxConnsPerHostPropertyInfo = (~) Int32
    type AttrTransferType SessionMaxConnsPerHostPropertyInfo = Int32
    type AttrGetType SessionMaxConnsPerHostPropertyInfo = Int32
    type AttrLabel SessionMaxConnsPerHostPropertyInfo = "max-conns-per-host"
    type AttrOrigin SessionMaxConnsPerHostPropertyInfo = Session
    attrGet = getSessionMaxConnsPerHost
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructSessionMaxConnsPerHost
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.maxConnsPerHost"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:maxConnsPerHost"
        })
#endif

-- VVV Prop "proxy-resolver"
   -- Type: TInterface (Name {namespace = "Gio", name = "ProxyResolver"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@proxy-resolver@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' session [ #proxyResolver 'Data.GI.Base.Attributes.:=' value ]
-- @
setSessionProxyResolver :: (MonadIO m, IsSession o, Gio.ProxyResolver.IsProxyResolver a) => o -> a -> m ()
setSessionProxyResolver :: forall (m :: * -> *) o a.
(MonadIO m, IsSession o, IsProxyResolver a) =>
o -> a -> m ()
setSessionProxyResolver o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"proxy-resolver" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@proxy-resolver@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #proxyResolver
-- @
clearSessionProxyResolver :: (MonadIO m, IsSession o) => o -> m ()
clearSessionProxyResolver :: forall (m :: * -> *) o. (MonadIO m, IsSession o) => o -> m ()
clearSessionProxyResolver o
obj = 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
$ o -> String -> Maybe ProxyResolver -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"proxy-resolver" (Maybe ProxyResolver
forall a. Maybe a
Nothing :: Maybe Gio.ProxyResolver.ProxyResolver)

#if defined(ENABLE_OVERLOADING)
data SessionProxyResolverPropertyInfo
instance AttrInfo SessionProxyResolverPropertyInfo where
    type AttrAllowedOps SessionProxyResolverPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SessionProxyResolverPropertyInfo = IsSession
    type AttrSetTypeConstraint SessionProxyResolverPropertyInfo = Gio.ProxyResolver.IsProxyResolver
    type AttrTransferTypeConstraint SessionProxyResolverPropertyInfo = Gio.ProxyResolver.IsProxyResolver
    type AttrTransferType SessionProxyResolverPropertyInfo = Gio.ProxyResolver.ProxyResolver
    type AttrGetType SessionProxyResolverPropertyInfo = (Maybe Gio.ProxyResolver.ProxyResolver)
    type AttrLabel SessionProxyResolverPropertyInfo = "proxy-resolver"
    type AttrOrigin SessionProxyResolverPropertyInfo = Session
    attrGet = getSessionProxyResolver
    attrSet = setSessionProxyResolver
    attrTransfer _ v = do
        unsafeCastTo Gio.ProxyResolver.ProxyResolver v
    attrConstruct = constructSessionProxyResolver
    attrClear = clearSessionProxyResolver
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.proxyResolver"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:proxyResolver"
        })
#endif

-- VVV Prop "remote-connectable"
   -- Type: TInterface (Name {namespace = "Gio", name = "SocketConnectable"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
data SessionRemoteConnectablePropertyInfo
instance AttrInfo SessionRemoteConnectablePropertyInfo where
    type AttrAllowedOps SessionRemoteConnectablePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SessionRemoteConnectablePropertyInfo = IsSession
    type AttrSetTypeConstraint SessionRemoteConnectablePropertyInfo = Gio.SocketConnectable.IsSocketConnectable
    type AttrTransferTypeConstraint SessionRemoteConnectablePropertyInfo = Gio.SocketConnectable.IsSocketConnectable
    type AttrTransferType SessionRemoteConnectablePropertyInfo = Gio.SocketConnectable.SocketConnectable
    type AttrGetType SessionRemoteConnectablePropertyInfo = (Maybe Gio.SocketConnectable.SocketConnectable)
    type AttrLabel SessionRemoteConnectablePropertyInfo = "remote-connectable"
    type AttrOrigin SessionRemoteConnectablePropertyInfo = Session
    attrGet = getSessionRemoteConnectable
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.SocketConnectable.SocketConnectable v
    attrConstruct = constructSessionRemoteConnectable
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.remoteConnectable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:remoteConnectable"
        })
#endif

-- VVV Prop "timeout"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@timeout@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' session [ #timeout 'Data.GI.Base.Attributes.:=' value ]
-- @
setSessionTimeout :: (MonadIO m, IsSession o) => o -> Word32 -> m ()
setSessionTimeout :: forall (m :: * -> *) o.
(MonadIO m, IsSession o) =>
o -> Word32 -> m ()
setSessionTimeout o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"timeout" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@timeout@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSessionTimeout :: (IsSession o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructSessionTimeout :: forall o (m :: * -> *).
(IsSession o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructSessionTimeout Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"timeout" Word32
val

#if defined(ENABLE_OVERLOADING)
data SessionTimeoutPropertyInfo
instance AttrInfo SessionTimeoutPropertyInfo where
    type AttrAllowedOps SessionTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SessionTimeoutPropertyInfo = IsSession
    type AttrSetTypeConstraint SessionTimeoutPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint SessionTimeoutPropertyInfo = (~) Word32
    type AttrTransferType SessionTimeoutPropertyInfo = Word32
    type AttrGetType SessionTimeoutPropertyInfo = Word32
    type AttrLabel SessionTimeoutPropertyInfo = "timeout"
    type AttrOrigin SessionTimeoutPropertyInfo = Session
    attrGet = getSessionTimeout
    attrSet = setSessionTimeout
    attrTransfer _ v = do
        return v
    attrConstruct = constructSessionTimeout
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.timeout"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:timeout"
        })
#endif

-- VVV Prop "tls-database"
   -- Type: TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@tls-database@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' session [ #tlsDatabase 'Data.GI.Base.Attributes.:=' value ]
-- @
setSessionTlsDatabase :: (MonadIO m, IsSession o, Gio.TlsDatabase.IsTlsDatabase a) => o -> a -> m ()
setSessionTlsDatabase :: forall (m :: * -> *) o a.
(MonadIO m, IsSession o, IsTlsDatabase a) =>
o -> a -> m ()
setSessionTlsDatabase o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"tls-database" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@tls-database@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #tlsDatabase
-- @
clearSessionTlsDatabase :: (MonadIO m, IsSession o) => o -> m ()
clearSessionTlsDatabase :: forall (m :: * -> *) o. (MonadIO m, IsSession o) => o -> m ()
clearSessionTlsDatabase o
obj = 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
$ o -> String -> Maybe TlsDatabase -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"tls-database" (Maybe TlsDatabase
forall a. Maybe a
Nothing :: Maybe Gio.TlsDatabase.TlsDatabase)

#if defined(ENABLE_OVERLOADING)
data SessionTlsDatabasePropertyInfo
instance AttrInfo SessionTlsDatabasePropertyInfo where
    type AttrAllowedOps SessionTlsDatabasePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SessionTlsDatabasePropertyInfo = IsSession
    type AttrSetTypeConstraint SessionTlsDatabasePropertyInfo = Gio.TlsDatabase.IsTlsDatabase
    type AttrTransferTypeConstraint SessionTlsDatabasePropertyInfo = Gio.TlsDatabase.IsTlsDatabase
    type AttrTransferType SessionTlsDatabasePropertyInfo = Gio.TlsDatabase.TlsDatabase
    type AttrGetType SessionTlsDatabasePropertyInfo = (Maybe Gio.TlsDatabase.TlsDatabase)
    type AttrLabel SessionTlsDatabasePropertyInfo = "tls-database"
    type AttrOrigin SessionTlsDatabasePropertyInfo = Session
    attrGet = getSessionTlsDatabase
    attrSet = setSessionTlsDatabase
    attrTransfer _ v = do
        unsafeCastTo Gio.TlsDatabase.TlsDatabase v
    attrConstruct = constructSessionTlsDatabase
    attrClear = clearSessionTlsDatabase
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.tlsDatabase"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:tlsDatabase"
        })
#endif

-- VVV Prop "tls-interaction"
   -- Type: TInterface (Name {namespace = "Gio", name = "TlsInteraction"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@tls-interaction@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' session [ #tlsInteraction 'Data.GI.Base.Attributes.:=' value ]
-- @
setSessionTlsInteraction :: (MonadIO m, IsSession o, Gio.TlsInteraction.IsTlsInteraction a) => o -> a -> m ()
setSessionTlsInteraction :: forall (m :: * -> *) o a.
(MonadIO m, IsSession o, IsTlsInteraction a) =>
o -> a -> m ()
setSessionTlsInteraction o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"tls-interaction" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@tls-interaction@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #tlsInteraction
-- @
clearSessionTlsInteraction :: (MonadIO m, IsSession o) => o -> m ()
clearSessionTlsInteraction :: forall (m :: * -> *) o. (MonadIO m, IsSession o) => o -> m ()
clearSessionTlsInteraction o
obj = 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
$ o -> String -> Maybe TlsInteraction -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"tls-interaction" (Maybe TlsInteraction
forall a. Maybe a
Nothing :: Maybe Gio.TlsInteraction.TlsInteraction)

#if defined(ENABLE_OVERLOADING)
data SessionTlsInteractionPropertyInfo
instance AttrInfo SessionTlsInteractionPropertyInfo where
    type AttrAllowedOps SessionTlsInteractionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SessionTlsInteractionPropertyInfo = IsSession
    type AttrSetTypeConstraint SessionTlsInteractionPropertyInfo = Gio.TlsInteraction.IsTlsInteraction
    type AttrTransferTypeConstraint SessionTlsInteractionPropertyInfo = Gio.TlsInteraction.IsTlsInteraction
    type AttrTransferType SessionTlsInteractionPropertyInfo = Gio.TlsInteraction.TlsInteraction
    type AttrGetType SessionTlsInteractionPropertyInfo = (Maybe Gio.TlsInteraction.TlsInteraction)
    type AttrLabel SessionTlsInteractionPropertyInfo = "tls-interaction"
    type AttrOrigin SessionTlsInteractionPropertyInfo = Session
    attrGet = getSessionTlsInteraction
    attrSet = setSessionTlsInteraction
    attrTransfer _ v = do
        unsafeCastTo Gio.TlsInteraction.TlsInteraction v
    attrConstruct = constructSessionTlsInteraction
    attrClear = clearSessionTlsInteraction
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.tlsInteraction"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:tlsInteraction"
        })
#endif

-- VVV Prop "user-agent"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just False)

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

-- | Set the value of the “@user-agent@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' session [ #userAgent 'Data.GI.Base.Attributes.:=' value ]
-- @
setSessionUserAgent :: (MonadIO m, IsSession o) => o -> T.Text -> m ()
setSessionUserAgent :: forall (m :: * -> *) o.
(MonadIO m, IsSession o) =>
o -> Text -> m ()
setSessionUserAgent o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"user-agent" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data SessionUserAgentPropertyInfo
instance AttrInfo SessionUserAgentPropertyInfo where
    type AttrAllowedOps SessionUserAgentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SessionUserAgentPropertyInfo = IsSession
    type AttrSetTypeConstraint SessionUserAgentPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SessionUserAgentPropertyInfo = (~) T.Text
    type AttrTransferType SessionUserAgentPropertyInfo = T.Text
    type AttrGetType SessionUserAgentPropertyInfo = (Maybe T.Text)
    type AttrLabel SessionUserAgentPropertyInfo = "user-agent"
    type AttrOrigin SessionUserAgentPropertyInfo = Session
    attrGet = getSessionUserAgent
    attrSet = setSessionUserAgent
    attrTransfer _ v = do
        return v
    attrConstruct = constructSessionUserAgent
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.userAgent"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#g:attr:userAgent"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Session
type instance O.AttributeList Session = SessionAttributeList
type SessionAttributeList = ('[ '("acceptLanguage", SessionAcceptLanguagePropertyInfo), '("acceptLanguageAuto", SessionAcceptLanguageAutoPropertyInfo), '("idleTimeout", SessionIdleTimeoutPropertyInfo), '("localAddress", SessionLocalAddressPropertyInfo), '("maxConns", SessionMaxConnsPropertyInfo), '("maxConnsPerHost", SessionMaxConnsPerHostPropertyInfo), '("proxyResolver", SessionProxyResolverPropertyInfo), '("remoteConnectable", SessionRemoteConnectablePropertyInfo), '("timeout", SessionTimeoutPropertyInfo), '("tlsDatabase", SessionTlsDatabasePropertyInfo), '("tlsInteraction", SessionTlsInteractionPropertyInfo), '("userAgent", SessionUserAgentPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
sessionAcceptLanguage :: AttrLabelProxy "acceptLanguage"
sessionAcceptLanguage = AttrLabelProxy

sessionAcceptLanguageAuto :: AttrLabelProxy "acceptLanguageAuto"
sessionAcceptLanguageAuto = AttrLabelProxy

sessionIdleTimeout :: AttrLabelProxy "idleTimeout"
sessionIdleTimeout = AttrLabelProxy

sessionLocalAddress :: AttrLabelProxy "localAddress"
sessionLocalAddress = AttrLabelProxy

sessionMaxConns :: AttrLabelProxy "maxConns"
sessionMaxConns = AttrLabelProxy

sessionMaxConnsPerHost :: AttrLabelProxy "maxConnsPerHost"
sessionMaxConnsPerHost = AttrLabelProxy

sessionProxyResolver :: AttrLabelProxy "proxyResolver"
sessionProxyResolver = AttrLabelProxy

sessionRemoteConnectable :: AttrLabelProxy "remoteConnectable"
sessionRemoteConnectable = AttrLabelProxy

sessionTimeout :: AttrLabelProxy "timeout"
sessionTimeout = AttrLabelProxy

sessionTlsDatabase :: AttrLabelProxy "tlsDatabase"
sessionTlsDatabase = AttrLabelProxy

sessionTlsInteraction :: AttrLabelProxy "tlsInteraction"
sessionTlsInteraction = AttrLabelProxy

sessionUserAgent :: AttrLabelProxy "userAgent"
sessionUserAgent = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Session = SessionSignalList
type SessionSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("requestQueued", SessionRequestQueuedSignalInfo), '("requestUnqueued", SessionRequestUnqueuedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Session::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Session" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_new" soup_session_new :: 
    IO (Ptr Session)

-- | Creates a t'GI.Soup.Objects.Session.Session' with the default options.
sessionNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Session
    -- ^ __Returns:__ the new session.
sessionNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Session
sessionNew  = IO Session -> m Session
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Session -> m Session) -> IO Session -> m Session
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
result <- IO (Ptr Session)
soup_session_new
    Text -> Ptr Session -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sessionNew" Ptr Session
result
    Session
result' <- ((ManagedPtr Session -> Session) -> Ptr Session -> IO Session
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Session -> Session
Session) Ptr Session
result
    Session -> IO Session
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Session
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Session::abort
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the session" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_abort" soup_session_abort :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO ()

-- | Cancels all pending requests in /@session@/ and closes all idle
-- persistent connections.
sessionAbort ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: the session
    -> m ()
sessionAbort :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m ()
sessionAbort a
session = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Session -> IO ()
soup_session_abort Ptr Session
session'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionAbortMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSession a) => O.OverloadedMethod SessionAbortMethodInfo a signature where
    overloadedMethod = sessionAbort

instance O.OverloadedMethodInfo SessionAbortMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionAbort",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionAbort"
        })


#endif

-- method Session::add_feature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "SessionFeature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an object that implements #SoupSessionFeature"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_add_feature" soup_session_add_feature :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Soup.SessionFeature.SessionFeature -> -- feature : TInterface (Name {namespace = "Soup", name = "SessionFeature"})
    IO ()

-- | Adds /@feature@/\'s functionality to /@session@/. You cannot add multiple
-- features of the same [alias/@gLib@/.Type] to a session.
-- 
-- See the main t'GI.Soup.Objects.Session.Session' documentation for information on what
-- features are present in sessions by default.
sessionAddFeature ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.SessionFeature.IsSessionFeature b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@feature@/: an object that implements t'GI.Soup.Interfaces.SessionFeature.SessionFeature'
    -> m ()
sessionAddFeature :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsSessionFeature b) =>
a -> b -> m ()
sessionAddFeature a
session b
feature = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr SessionFeature
feature' <- b -> IO (Ptr SessionFeature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
feature
    Ptr Session -> Ptr SessionFeature -> IO ()
soup_session_add_feature Ptr Session
session' Ptr SessionFeature
feature'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
feature
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionAddFeatureMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSession a, Soup.SessionFeature.IsSessionFeature b) => O.OverloadedMethod SessionAddFeatureMethodInfo a signature where
    overloadedMethod = sessionAddFeature

instance O.OverloadedMethodInfo SessionAddFeatureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionAddFeature",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionAddFeature"
        })


#endif

-- method Session::add_feature_by_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_add_feature_by_type" soup_session_add_feature_by_type :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    CGType ->                               -- feature_type : TBasicType TGType
    IO ()

-- | If /@featureType@/ is the type of a class that implements
-- [iface/@sessionFeature@/], this creates a new feature of that type and
-- adds it to /@session@/ as with [method/@session@/.add_feature]. You can use
-- this when you don\'t need to customize the new feature in any way.
-- Adding multiple features of the same /@featureType@/ is not allowed.
-- 
-- If /@featureType@/ is not a [iface/@sessionFeature@/] type, this gives each
-- existing feature on /@session@/ the chance to accept /@featureType@/ as
-- a \"subfeature\". This can be used to add new [class/@auth@/] types, for instance.
-- 
-- See the main t'GI.Soup.Objects.Session.Session' documentation for information on what
-- features are present in sessions by default.
sessionAddFeatureByType ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> GType
    -- ^ /@featureType@/: a t'GType'
    -> m ()
sessionAddFeatureByType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> GType -> m ()
sessionAddFeatureByType a
session GType
featureType = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    let featureType' :: CGType
featureType' = GType -> CGType
gtypeToCGType GType
featureType
    Ptr Session -> CGType -> IO ()
soup_session_add_feature_by_type Ptr Session
session' CGType
featureType'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionAddFeatureByTypeMethodInfo
instance (signature ~ (GType -> m ()), MonadIO m, IsSession a) => O.OverloadedMethod SessionAddFeatureByTypeMethodInfo a signature where
    overloadedMethod = sessionAddFeatureByType

instance O.OverloadedMethodInfo SessionAddFeatureByTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionAddFeatureByType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionAddFeatureByType"
        })


#endif

-- method Session::get_accept_language
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_accept_language" soup_session_get_accept_language :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO CString

-- | Get the value used by /@session@/ for the \"Accept-Language\" header on new
-- requests.
sessionGetAcceptLanguage ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the accept language string
sessionGetAcceptLanguage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m (Maybe Text)
sessionGetAcceptLanguage a
session = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    CString
result <- Ptr Session -> IO CString
soup_session_get_accept_language Ptr Session
session'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SessionGetAcceptLanguageMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetAcceptLanguageMethodInfo a signature where
    overloadedMethod = sessionGetAcceptLanguage

instance O.OverloadedMethodInfo SessionGetAcceptLanguageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetAcceptLanguage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetAcceptLanguage"
        })


#endif

-- method Session::get_accept_language_auto
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_accept_language_auto" soup_session_get_accept_language_auto :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO CInt

-- | Gets whether /@session@/ automatically sets the \"Accept-Language\" header on new
-- requests.
sessionGetAcceptLanguageAuto ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@session@/ sets \"Accept-Language\" header automatically, or
    --   'P.False' otherwise.
sessionGetAcceptLanguageAuto :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m Bool
sessionGetAcceptLanguageAuto a
session = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    CInt
result <- Ptr Session -> IO CInt
soup_session_get_accept_language_auto Ptr Session
session'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SessionGetAcceptLanguageAutoMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetAcceptLanguageAutoMethodInfo a signature where
    overloadedMethod = sessionGetAcceptLanguageAuto

instance O.OverloadedMethodInfo SessionGetAcceptLanguageAutoMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetAcceptLanguageAuto",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetAcceptLanguageAuto"
        })


#endif

-- method Session::get_async_result_message
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncResult passed to your callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_async_result_message" soup_session_get_async_result_message :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    IO (Ptr Soup.Message.Message)

-- | Gets the [class/@message@/] of the /@result@/ asynchronous operation This is useful
-- to get the [class/@message@/] of an asynchronous operation started by /@session@/
-- from its [callback/@gio@/.AsyncReadyCallback].
sessionGetAsyncResultMessage ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' passed to your callback
    -> m (Maybe Soup.Message.Message)
    -- ^ __Returns:__ a t'GI.Soup.Objects.Message.Message' or
    --   'P.Nothing' if /@result@/ is not a valid /@session@/ async operation result.
sessionGetAsyncResultMessage :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsAsyncResult b) =>
a -> b -> m (Maybe Message)
sessionGetAsyncResultMessage a
session b
result_ = IO (Maybe Message) -> m (Maybe Message)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Message) -> m (Maybe Message))
-> IO (Maybe Message) -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Message
result <- Ptr Session -> Ptr AsyncResult -> IO (Ptr Message)
soup_session_get_async_result_message Ptr Session
session' Ptr AsyncResult
result_'
    Maybe Message
maybeResult <- Ptr Message -> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Message
result ((Ptr Message -> IO Message) -> IO (Maybe Message))
-> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. (a -> b) -> a -> b
$ \Ptr Message
result' -> do
        Message
result'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Message -> Message
Soup.Message.Message) Ptr Message
result'
        Message -> IO Message
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
    Maybe Message -> IO (Maybe Message)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
maybeResult

#if defined(ENABLE_OVERLOADING)
data SessionGetAsyncResultMessageMethodInfo
instance (signature ~ (b -> m (Maybe Soup.Message.Message)), MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SessionGetAsyncResultMessageMethodInfo a signature where
    overloadedMethod = sessionGetAsyncResultMessage

instance O.OverloadedMethodInfo SessionGetAsyncResultMessageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetAsyncResultMessage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetAsyncResultMessage"
        })


#endif

-- method Session::get_feature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of the feature to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Soup" , name = "SessionFeature" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_feature" soup_session_get_feature :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    CGType ->                               -- feature_type : TBasicType TGType
    IO (Ptr Soup.SessionFeature.SessionFeature)

-- | Gets the feature in /@session@/ of type /@featureType@/.
sessionGetFeature ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> GType
    -- ^ /@featureType@/: the t'GType' of the feature to get
    -> m (Maybe Soup.SessionFeature.SessionFeature)
    -- ^ __Returns:__ a t'GI.Soup.Interfaces.SessionFeature.SessionFeature', or 'P.Nothing'. The
    --   feature is owned by /@session@/.
sessionGetFeature :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> GType -> m (Maybe SessionFeature)
sessionGetFeature a
session GType
featureType = IO (Maybe SessionFeature) -> m (Maybe SessionFeature)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SessionFeature) -> m (Maybe SessionFeature))
-> IO (Maybe SessionFeature) -> m (Maybe SessionFeature)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    let featureType' :: CGType
featureType' = GType -> CGType
gtypeToCGType GType
featureType
    Ptr SessionFeature
result <- Ptr Session -> CGType -> IO (Ptr SessionFeature)
soup_session_get_feature Ptr Session
session' CGType
featureType'
    Maybe SessionFeature
maybeResult <- Ptr SessionFeature
-> (Ptr SessionFeature -> IO SessionFeature)
-> IO (Maybe SessionFeature)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr SessionFeature
result ((Ptr SessionFeature -> IO SessionFeature)
 -> IO (Maybe SessionFeature))
-> (Ptr SessionFeature -> IO SessionFeature)
-> IO (Maybe SessionFeature)
forall a b. (a -> b) -> a -> b
$ \Ptr SessionFeature
result' -> do
        SessionFeature
result'' <- ((ManagedPtr SessionFeature -> SessionFeature)
-> Ptr SessionFeature -> IO SessionFeature
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SessionFeature -> SessionFeature
Soup.SessionFeature.SessionFeature) Ptr SessionFeature
result'
        SessionFeature -> IO SessionFeature
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SessionFeature
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe SessionFeature -> IO (Maybe SessionFeature)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionFeature
maybeResult

#if defined(ENABLE_OVERLOADING)
data SessionGetFeatureMethodInfo
instance (signature ~ (GType -> m (Maybe Soup.SessionFeature.SessionFeature)), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetFeatureMethodInfo a signature where
    overloadedMethod = sessionGetFeature

instance O.OverloadedMethodInfo SessionGetFeatureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetFeature",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetFeature"
        })


#endif

-- method Session::get_feature_for_message
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of the feature to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Soup" , name = "SessionFeature" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_feature_for_message" soup_session_get_feature_for_message :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    CGType ->                               -- feature_type : TBasicType TGType
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO (Ptr Soup.SessionFeature.SessionFeature)

-- | Gets the feature in /@session@/ of type /@featureType@/, provided
-- that it is not disabled for /@msg@/.
sessionGetFeatureForMessage ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.Message.IsMessage b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> GType
    -- ^ /@featureType@/: the t'GType' of the feature to get
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m (Maybe Soup.SessionFeature.SessionFeature)
    -- ^ __Returns:__ a t'GI.Soup.Interfaces.SessionFeature.SessionFeature'. The feature is
    --   owned by /@session@/.
sessionGetFeatureForMessage :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsMessage b) =>
a -> GType -> b -> m (Maybe SessionFeature)
sessionGetFeatureForMessage a
session GType
featureType b
msg = IO (Maybe SessionFeature) -> m (Maybe SessionFeature)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SessionFeature) -> m (Maybe SessionFeature))
-> IO (Maybe SessionFeature) -> m (Maybe SessionFeature)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    let featureType' :: CGType
featureType' = GType -> CGType
gtypeToCGType GType
featureType
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    Ptr SessionFeature
result <- Ptr Session -> CGType -> Ptr Message -> IO (Ptr SessionFeature)
soup_session_get_feature_for_message Ptr Session
session' CGType
featureType' Ptr Message
msg'
    Maybe SessionFeature
maybeResult <- Ptr SessionFeature
-> (Ptr SessionFeature -> IO SessionFeature)
-> IO (Maybe SessionFeature)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr SessionFeature
result ((Ptr SessionFeature -> IO SessionFeature)
 -> IO (Maybe SessionFeature))
-> (Ptr SessionFeature -> IO SessionFeature)
-> IO (Maybe SessionFeature)
forall a b. (a -> b) -> a -> b
$ \Ptr SessionFeature
result' -> do
        SessionFeature
result'' <- ((ManagedPtr SessionFeature -> SessionFeature)
-> Ptr SessionFeature -> IO SessionFeature
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SessionFeature -> SessionFeature
Soup.SessionFeature.SessionFeature) Ptr SessionFeature
result'
        SessionFeature -> IO SessionFeature
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SessionFeature
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    Maybe SessionFeature -> IO (Maybe SessionFeature)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionFeature
maybeResult

#if defined(ENABLE_OVERLOADING)
data SessionGetFeatureForMessageMethodInfo
instance (signature ~ (GType -> b -> m (Maybe Soup.SessionFeature.SessionFeature)), MonadIO m, IsSession a, Soup.Message.IsMessage b) => O.OverloadedMethod SessionGetFeatureForMessageMethodInfo a signature where
    overloadedMethod = sessionGetFeatureForMessage

instance O.OverloadedMethodInfo SessionGetFeatureForMessageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetFeatureForMessage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetFeatureForMessage"
        })


#endif

-- method Session::get_idle_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_idle_timeout" soup_session_get_idle_timeout :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO Word32

-- | Get the timeout in seconds for idle connection lifetime currently used by
-- /@session@/.
sessionGetIdleTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m Word32
    -- ^ __Returns:__ the timeout in seconds
sessionGetIdleTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m Word32
sessionGetIdleTimeout a
session = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Word32
result <- Ptr Session -> IO Word32
soup_session_get_idle_timeout Ptr Session
session'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SessionGetIdleTimeoutMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetIdleTimeoutMethodInfo a signature where
    overloadedMethod = sessionGetIdleTimeout

instance O.OverloadedMethodInfo SessionGetIdleTimeoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetIdleTimeout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetIdleTimeout"
        })


#endif

-- method Session::get_local_address
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "InetSocketAddress" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_local_address" soup_session_get_local_address :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO (Ptr Gio.InetSocketAddress.InetSocketAddress)

-- | Get the t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress' to use for the client side of
-- connections in /@session@/.
sessionGetLocalAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m (Maybe Gio.InetSocketAddress.InetSocketAddress)
    -- ^ __Returns:__ a t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
sessionGetLocalAddress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m (Maybe InetSocketAddress)
sessionGetLocalAddress a
session = IO (Maybe InetSocketAddress) -> m (Maybe InetSocketAddress)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InetSocketAddress) -> m (Maybe InetSocketAddress))
-> IO (Maybe InetSocketAddress) -> m (Maybe InetSocketAddress)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr InetSocketAddress
result <- Ptr Session -> IO (Ptr InetSocketAddress)
soup_session_get_local_address Ptr Session
session'
    Maybe InetSocketAddress
maybeResult <- Ptr InetSocketAddress
-> (Ptr InetSocketAddress -> IO InetSocketAddress)
-> IO (Maybe InetSocketAddress)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr InetSocketAddress
result ((Ptr InetSocketAddress -> IO InetSocketAddress)
 -> IO (Maybe InetSocketAddress))
-> (Ptr InetSocketAddress -> IO InetSocketAddress)
-> IO (Maybe InetSocketAddress)
forall a b. (a -> b) -> a -> b
$ \Ptr InetSocketAddress
result' -> do
        InetSocketAddress
result'' <- ((ManagedPtr InetSocketAddress -> InetSocketAddress)
-> Ptr InetSocketAddress -> IO InetSocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr InetSocketAddress -> InetSocketAddress
Gio.InetSocketAddress.InetSocketAddress) Ptr InetSocketAddress
result'
        InetSocketAddress -> IO InetSocketAddress
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InetSocketAddress
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe InetSocketAddress -> IO (Maybe InetSocketAddress)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InetSocketAddress
maybeResult

#if defined(ENABLE_OVERLOADING)
data SessionGetLocalAddressMethodInfo
instance (signature ~ (m (Maybe Gio.InetSocketAddress.InetSocketAddress)), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetLocalAddressMethodInfo a signature where
    overloadedMethod = sessionGetLocalAddress

instance O.OverloadedMethodInfo SessionGetLocalAddressMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetLocalAddress",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetLocalAddress"
        })


#endif

-- method Session::get_max_conns
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_max_conns" soup_session_get_max_conns :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO Word32

-- | Get the maximum number of connections that /@session@/ can open at once.
sessionGetMaxConns ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m Word32
    -- ^ __Returns:__ the maximum number of connections
sessionGetMaxConns :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m Word32
sessionGetMaxConns a
session = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Word32
result <- Ptr Session -> IO Word32
soup_session_get_max_conns Ptr Session
session'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SessionGetMaxConnsMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetMaxConnsMethodInfo a signature where
    overloadedMethod = sessionGetMaxConns

instance O.OverloadedMethodInfo SessionGetMaxConnsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetMaxConns",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetMaxConns"
        })


#endif

-- method Session::get_max_conns_per_host
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_max_conns_per_host" soup_session_get_max_conns_per_host :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO Word32

-- | Get the maximum number of connections that /@session@/ can open at once to a
-- given host.
sessionGetMaxConnsPerHost ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m Word32
    -- ^ __Returns:__ the maximum number of connections per host
sessionGetMaxConnsPerHost :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m Word32
sessionGetMaxConnsPerHost a
session = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Word32
result <- Ptr Session -> IO Word32
soup_session_get_max_conns_per_host Ptr Session
session'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SessionGetMaxConnsPerHostMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetMaxConnsPerHostMethodInfo a signature where
    overloadedMethod = sessionGetMaxConnsPerHost

instance O.OverloadedMethodInfo SessionGetMaxConnsPerHostMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetMaxConnsPerHost",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetMaxConnsPerHost"
        })


#endif

-- method Session::get_proxy_resolver
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "ProxyResolver" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_proxy_resolver" soup_session_get_proxy_resolver :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO (Ptr Gio.ProxyResolver.ProxyResolver)

-- | Get the t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver' currently used by /@session@/.
sessionGetProxyResolver ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m (Maybe Gio.ProxyResolver.ProxyResolver)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver' or 'P.Nothing' if proxies
    --   are disabled in /@session@/
sessionGetProxyResolver :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m (Maybe ProxyResolver)
sessionGetProxyResolver a
session = IO (Maybe ProxyResolver) -> m (Maybe ProxyResolver)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ProxyResolver) -> m (Maybe ProxyResolver))
-> IO (Maybe ProxyResolver) -> m (Maybe ProxyResolver)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr ProxyResolver
result <- Ptr Session -> IO (Ptr ProxyResolver)
soup_session_get_proxy_resolver Ptr Session
session'
    Maybe ProxyResolver
maybeResult <- Ptr ProxyResolver
-> (Ptr ProxyResolver -> IO ProxyResolver)
-> IO (Maybe ProxyResolver)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ProxyResolver
result ((Ptr ProxyResolver -> IO ProxyResolver)
 -> IO (Maybe ProxyResolver))
-> (Ptr ProxyResolver -> IO ProxyResolver)
-> IO (Maybe ProxyResolver)
forall a b. (a -> b) -> a -> b
$ \Ptr ProxyResolver
result' -> do
        ProxyResolver
result'' <- ((ManagedPtr ProxyResolver -> ProxyResolver)
-> Ptr ProxyResolver -> IO ProxyResolver
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ProxyResolver -> ProxyResolver
Gio.ProxyResolver.ProxyResolver) Ptr ProxyResolver
result'
        ProxyResolver -> IO ProxyResolver
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyResolver
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe ProxyResolver -> IO (Maybe ProxyResolver)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProxyResolver
maybeResult

#if defined(ENABLE_OVERLOADING)
data SessionGetProxyResolverMethodInfo
instance (signature ~ (m (Maybe Gio.ProxyResolver.ProxyResolver)), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetProxyResolverMethodInfo a signature where
    overloadedMethod = sessionGetProxyResolver

instance O.OverloadedMethodInfo SessionGetProxyResolverMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetProxyResolver",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetProxyResolver"
        })


#endif

-- method Session::get_remote_connectable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "SocketConnectable" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_remote_connectable" soup_session_get_remote_connectable :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO (Ptr Gio.SocketConnectable.SocketConnectable)

-- | Gets the remote connectable if one set.
sessionGetRemoteConnectable ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m (Maybe Gio.SocketConnectable.SocketConnectable)
    -- ^ __Returns:__ the t'GI.Gio.Interfaces.SocketConnectable.SocketConnectable'
sessionGetRemoteConnectable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m (Maybe SocketConnectable)
sessionGetRemoteConnectable a
session = IO (Maybe SocketConnectable) -> m (Maybe SocketConnectable)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SocketConnectable) -> m (Maybe SocketConnectable))
-> IO (Maybe SocketConnectable) -> m (Maybe SocketConnectable)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr SocketConnectable
result <- Ptr Session -> IO (Ptr SocketConnectable)
soup_session_get_remote_connectable Ptr Session
session'
    Maybe SocketConnectable
maybeResult <- Ptr SocketConnectable
-> (Ptr SocketConnectable -> IO SocketConnectable)
-> IO (Maybe SocketConnectable)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr SocketConnectable
result ((Ptr SocketConnectable -> IO SocketConnectable)
 -> IO (Maybe SocketConnectable))
-> (Ptr SocketConnectable -> IO SocketConnectable)
-> IO (Maybe SocketConnectable)
forall a b. (a -> b) -> a -> b
$ \Ptr SocketConnectable
result' -> do
        SocketConnectable
result'' <- ((ManagedPtr SocketConnectable -> SocketConnectable)
-> Ptr SocketConnectable -> IO SocketConnectable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SocketConnectable -> SocketConnectable
Gio.SocketConnectable.SocketConnectable) Ptr SocketConnectable
result'
        SocketConnectable -> IO SocketConnectable
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SocketConnectable
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe SocketConnectable -> IO (Maybe SocketConnectable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SocketConnectable
maybeResult

#if defined(ENABLE_OVERLOADING)
data SessionGetRemoteConnectableMethodInfo
instance (signature ~ (m (Maybe Gio.SocketConnectable.SocketConnectable)), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetRemoteConnectableMethodInfo a signature where
    overloadedMethod = sessionGetRemoteConnectable

instance O.OverloadedMethodInfo SessionGetRemoteConnectableMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetRemoteConnectable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetRemoteConnectable"
        })


#endif

-- method Session::get_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_timeout" soup_session_get_timeout :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO Word32

-- | Get the timeout in seconds for socket I\/O operations currently used by
-- /@session@/.
sessionGetTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m Word32
    -- ^ __Returns:__ the timeout in seconds
sessionGetTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m Word32
sessionGetTimeout a
session = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Word32
result <- Ptr Session -> IO Word32
soup_session_get_timeout Ptr Session
session'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SessionGetTimeoutMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetTimeoutMethodInfo a signature where
    overloadedMethod = sessionGetTimeout

instance O.OverloadedMethodInfo SessionGetTimeoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetTimeout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetTimeout"
        })


#endif

-- method Session::get_tls_database
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "TlsDatabase" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_tls_database" soup_session_get_tls_database :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO (Ptr Gio.TlsDatabase.TlsDatabase)

-- | Get the t'GI.Gio.Objects.TlsDatabase.TlsDatabase' currently used by /@session@/.
sessionGetTlsDatabase ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m (Maybe Gio.TlsDatabase.TlsDatabase)
    -- ^ __Returns:__ a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
sessionGetTlsDatabase :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m (Maybe TlsDatabase)
sessionGetTlsDatabase a
session = IO (Maybe TlsDatabase) -> m (Maybe TlsDatabase)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TlsDatabase) -> m (Maybe TlsDatabase))
-> IO (Maybe TlsDatabase) -> m (Maybe TlsDatabase)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr TlsDatabase
result <- Ptr Session -> IO (Ptr TlsDatabase)
soup_session_get_tls_database Ptr Session
session'
    Maybe TlsDatabase
maybeResult <- Ptr TlsDatabase
-> (Ptr TlsDatabase -> IO TlsDatabase) -> IO (Maybe TlsDatabase)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TlsDatabase
result ((Ptr TlsDatabase -> IO TlsDatabase) -> IO (Maybe TlsDatabase))
-> (Ptr TlsDatabase -> IO TlsDatabase) -> IO (Maybe TlsDatabase)
forall a b. (a -> b) -> a -> b
$ \Ptr TlsDatabase
result' -> do
        TlsDatabase
result'' <- ((ManagedPtr TlsDatabase -> TlsDatabase)
-> Ptr TlsDatabase -> IO TlsDatabase
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TlsDatabase -> TlsDatabase
Gio.TlsDatabase.TlsDatabase) Ptr TlsDatabase
result'
        TlsDatabase -> IO TlsDatabase
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TlsDatabase
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe TlsDatabase -> IO (Maybe TlsDatabase)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TlsDatabase
maybeResult

#if defined(ENABLE_OVERLOADING)
data SessionGetTlsDatabaseMethodInfo
instance (signature ~ (m (Maybe Gio.TlsDatabase.TlsDatabase)), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetTlsDatabaseMethodInfo a signature where
    overloadedMethod = sessionGetTlsDatabase

instance O.OverloadedMethodInfo SessionGetTlsDatabaseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetTlsDatabase",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetTlsDatabase"
        })


#endif

-- method Session::get_tls_interaction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "TlsInteraction" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_tls_interaction" soup_session_get_tls_interaction :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO (Ptr Gio.TlsInteraction.TlsInteraction)

-- | Get the t'GI.Gio.Objects.TlsInteraction.TlsInteraction' currently used by /@session@/.
sessionGetTlsInteraction ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m (Maybe Gio.TlsInteraction.TlsInteraction)
    -- ^ __Returns:__ a t'GI.Gio.Objects.TlsInteraction.TlsInteraction'
sessionGetTlsInteraction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m (Maybe TlsInteraction)
sessionGetTlsInteraction a
session = IO (Maybe TlsInteraction) -> m (Maybe TlsInteraction)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TlsInteraction) -> m (Maybe TlsInteraction))
-> IO (Maybe TlsInteraction) -> m (Maybe TlsInteraction)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr TlsInteraction
result <- Ptr Session -> IO (Ptr TlsInteraction)
soup_session_get_tls_interaction Ptr Session
session'
    Maybe TlsInteraction
maybeResult <- Ptr TlsInteraction
-> (Ptr TlsInteraction -> IO TlsInteraction)
-> IO (Maybe TlsInteraction)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TlsInteraction
result ((Ptr TlsInteraction -> IO TlsInteraction)
 -> IO (Maybe TlsInteraction))
-> (Ptr TlsInteraction -> IO TlsInteraction)
-> IO (Maybe TlsInteraction)
forall a b. (a -> b) -> a -> b
$ \Ptr TlsInteraction
result' -> do
        TlsInteraction
result'' <- ((ManagedPtr TlsInteraction -> TlsInteraction)
-> Ptr TlsInteraction -> IO TlsInteraction
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TlsInteraction -> TlsInteraction
Gio.TlsInteraction.TlsInteraction) Ptr TlsInteraction
result'
        TlsInteraction -> IO TlsInteraction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TlsInteraction
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe TlsInteraction -> IO (Maybe TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TlsInteraction
maybeResult

#if defined(ENABLE_OVERLOADING)
data SessionGetTlsInteractionMethodInfo
instance (signature ~ (m (Maybe Gio.TlsInteraction.TlsInteraction)), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetTlsInteractionMethodInfo a signature where
    overloadedMethod = sessionGetTlsInteraction

instance O.OverloadedMethodInfo SessionGetTlsInteractionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetTlsInteraction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetTlsInteraction"
        })


#endif

-- method Session::get_user_agent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_user_agent" soup_session_get_user_agent :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO CString

-- | Get the value used by /@session@/ for the \"User-Agent\" header on new requests.
sessionGetUserAgent ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the user agent string
sessionGetUserAgent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> m (Maybe Text)
sessionGetUserAgent a
session = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    CString
result <- Ptr Session -> IO CString
soup_session_get_user_agent Ptr Session
session'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SessionGetUserAgentMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsSession a) => O.OverloadedMethod SessionGetUserAgentMethodInfo a signature where
    overloadedMethod = sessionGetUserAgent

instance O.OverloadedMethodInfo SessionGetUserAgentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionGetUserAgent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionGetUserAgent"
        })


#endif

-- method Session::has_feature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GType of the class of features to check for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_has_feature" soup_session_has_feature :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    CGType ->                               -- feature_type : TBasicType TGType
    IO CInt

-- | Tests if /@session@/ has at a feature of type /@featureType@/ (which can
-- be the type of either a [iface/@sessionFeature@/], or else a subtype of
-- some class managed by another feature, such as [class/@auth@/]).
sessionHasFeature ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> GType
    -- ^ /@featureType@/: the t'GType' of the class of features to check for
    -> m Bool
    -- ^ __Returns:__ 'P.True' or 'P.False'
sessionHasFeature :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> GType -> m Bool
sessionHasFeature a
session GType
featureType = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    let featureType' :: CGType
featureType' = GType -> CGType
gtypeToCGType GType
featureType
    CInt
result <- Ptr Session -> CGType -> IO CInt
soup_session_has_feature Ptr Session
session' CGType
featureType'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SessionHasFeatureMethodInfo
instance (signature ~ (GType -> m Bool), MonadIO m, IsSession a) => O.OverloadedMethod SessionHasFeatureMethodInfo a signature where
    overloadedMethod = sessionHasFeature

instance O.OverloadedMethodInfo SessionHasFeatureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionHasFeature",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionHasFeature"
        })


#endif

-- method Session::preconnect_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the I/O priority of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the callback to invoke when the operation finishes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data for @progress_callback and @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_preconnect_async" soup_session_preconnect_async :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Start a preconnection to /@msg@/.
-- 
-- Once the connection is done, it will remain in idle state so that it can be
-- reused by future requests. If there\'s already an idle connection for the
-- given /@msg@/ host, the operation finishes successfully without creating a new
-- connection. If a new request for the given /@msg@/ host is made while the
-- preconnect is still ongoing, the request will take the ownership of the
-- connection and the preconnect operation will finish successfully (if there\'s
-- a connection error it will be handled by the request).
-- 
-- The operation finishes when the connection is done or an error occurred.
sessionPreconnectAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: the callback to invoke when the operation finishes
    -> m ()
sessionPreconnectAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSession a, IsMessage b,
 IsCancellable c) =>
a -> b -> Int32 -> Maybe c -> Maybe AsyncReadyCallback -> m ()
sessionPreconnectAsync a
session b
msg Int32
ioPriority 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Session
-> Ptr Message
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
soup_session_preconnect_async Ptr Session
session' Ptr Message
msg' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionPreconnectAsyncMethodInfo
instance (signature ~ (b -> Int32 -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SessionPreconnectAsyncMethodInfo a signature where
    overloadedMethod = sessionPreconnectAsync

instance O.OverloadedMethodInfo SessionPreconnectAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionPreconnectAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionPreconnectAsync"
        })


#endif

-- method Session::preconnect_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncResult passed to your callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_preconnect_finish" soup_session_preconnect_finish :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Complete a preconnect async operation started with [method/@session@/.preconnect_async].
sessionPreconnectFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' passed to your callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sessionPreconnectFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsAsyncResult b) =>
a -> b -> m ()
sessionPreconnectFinish a
session 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Session -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
soup_session_preconnect_finish Ptr Session
session' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SessionPreconnectFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SessionPreconnectFinishMethodInfo a signature where
    overloadedMethod = sessionPreconnectFinish

instance O.OverloadedMethodInfo SessionPreconnectFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionPreconnectFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionPreconnectFinish"
        })


#endif

-- method Session::remove_feature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "SessionFeature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a feature that has previously been added to @session"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_remove_feature" soup_session_remove_feature :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Soup.SessionFeature.SessionFeature -> -- feature : TInterface (Name {namespace = "Soup", name = "SessionFeature"})
    IO ()

-- | Removes /@feature@/\'s functionality from /@session@/.
sessionRemoveFeature ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.SessionFeature.IsSessionFeature b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@feature@/: a feature that has previously been added to /@session@/
    -> m ()
sessionRemoveFeature :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsSessionFeature b) =>
a -> b -> m ()
sessionRemoveFeature a
session b
feature = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr SessionFeature
feature' <- b -> IO (Ptr SessionFeature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
feature
    Ptr Session -> Ptr SessionFeature -> IO ()
soup_session_remove_feature Ptr Session
session' Ptr SessionFeature
feature'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
feature
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionRemoveFeatureMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSession a, Soup.SessionFeature.IsSessionFeature b) => O.OverloadedMethod SessionRemoveFeatureMethodInfo a signature where
    overloadedMethod = sessionRemoveFeature

instance O.OverloadedMethodInfo SessionRemoveFeatureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionRemoveFeature",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionRemoveFeature"
        })


#endif

-- method Session::remove_feature_by_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_remove_feature_by_type" soup_session_remove_feature_by_type :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    CGType ->                               -- feature_type : TBasicType TGType
    IO ()

-- | Removes all features of type /@featureType@/ (or any subclass of
-- /@featureType@/) from /@session@/.
sessionRemoveFeatureByType ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> GType
    -- ^ /@featureType@/: a t'GType'
    -> m ()
sessionRemoveFeatureByType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> GType -> m ()
sessionRemoveFeatureByType a
session GType
featureType = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    let featureType' :: CGType
featureType' = GType -> CGType
gtypeToCGType GType
featureType
    Ptr Session -> CGType -> IO ()
soup_session_remove_feature_by_type Ptr Session
session' CGType
featureType'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionRemoveFeatureByTypeMethodInfo
instance (signature ~ (GType -> m ()), MonadIO m, IsSession a) => O.OverloadedMethod SessionRemoveFeatureByTypeMethodInfo a signature where
    overloadedMethod = sessionRemoveFeatureByType

instance O.OverloadedMethodInfo SessionRemoveFeatureByTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionRemoveFeatureByType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionRemoveFeatureByType"
        })


#endif

-- method Session::send
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "InputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_send" soup_session_send :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.InputStream.InputStream)

-- | Synchronously sends /@msg@/ and waits for the beginning of a response.
-- 
-- On success, a t'GI.Gio.Objects.InputStream.InputStream' will be returned which you can use to
-- read the response body. (\"Success\" here means only that an HTTP
-- response was received and understood; it does not necessarily mean
-- that a 2xx class status code was received.)
-- 
-- If non-'P.Nothing', /@cancellable@/ can be used to cancel the request;
-- [method/@session@/.send] will return a 'GI.Gio.Enums.IOErrorEnumCancelled' error. Note that
-- with requests that have side effects (eg, @POST@, @PUT@, @DELETE@) it is
-- possible that you might cancel the request after the server acts on it, but
-- before it returns a response, leaving the remote resource in an unknown
-- state.
-- 
-- If /@msg@/ is requeued due to a redirect or authentication, the
-- initial (@3xx\/401\/407@) response body will be suppressed, and
-- [method/@session@/.send] will only return once a final response has been
-- received.
sessionSend ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m Gio.InputStream.InputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.InputStream.InputStream' for reading the
    --   response body, or 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
sessionSend :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSession a, IsMessage b,
 IsCancellable c) =>
a -> b -> Maybe c -> m InputStream
sessionSend a
session b
msg Maybe c
cancellable = IO InputStream -> m InputStream
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputStream -> m InputStream)
-> IO InputStream -> m InputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO InputStream -> IO () -> IO InputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr InputStream
result <- (Ptr (Ptr GError) -> IO (Ptr InputStream)) -> IO (Ptr InputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr InputStream))
 -> IO (Ptr InputStream))
-> (Ptr (Ptr GError) -> IO (Ptr InputStream))
-> IO (Ptr InputStream)
forall a b. (a -> b) -> a -> b
$ Ptr Session
-> Ptr Message
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr InputStream)
soup_session_send Ptr Session
session' Ptr Message
msg' Ptr Cancellable
maybeCancellable
        Text -> Ptr InputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sessionSend" Ptr InputStream
result
        InputStream
result' <- ((ManagedPtr InputStream -> InputStream)
-> Ptr InputStream -> IO InputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream) Ptr InputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        InputStream -> IO InputStream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SessionSendMethodInfo
instance (signature ~ (b -> Maybe (c) -> m Gio.InputStream.InputStream), MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SessionSendMethodInfo a signature where
    overloadedMethod = sessionSend

instance O.OverloadedMethodInfo SessionSendMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSend"
        })


#endif

-- method Session::send_and_read
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_send_and_read" soup_session_send_and_read :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GLib.Bytes.Bytes)

-- | Synchronously sends /@msg@/ and reads the response body.
-- 
-- On success, a [struct/@gLib@/.Bytes] will be returned with the response body.
-- This function should only be used when the resource to be retrieved
-- is not too long and can be stored in memory.
-- 
-- See [method/@session@/.send] for more details on the general semantics.
sessionSendAndRead ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m GLib.Bytes.Bytes
    -- ^ __Returns:__ a t'GI.GLib.Structs.Bytes.Bytes', or 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
sessionSendAndRead :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSession a, IsMessage b,
 IsCancellable c) =>
a -> b -> Maybe c -> m Bytes
sessionSendAndRead a
session b
msg Maybe c
cancellable = IO Bytes -> m Bytes
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bytes -> m Bytes) -> IO Bytes -> m Bytes
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Bytes -> IO () -> IO Bytes
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Bytes
result <- (Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes))
-> (Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes)
forall a b. (a -> b) -> a -> b
$ Ptr Session
-> Ptr Message
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Bytes)
soup_session_send_and_read Ptr Session
session' Ptr Message
msg' Ptr Cancellable
maybeCancellable
        Text -> Ptr Bytes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sessionSendAndRead" Ptr Bytes
result
        Bytes
result' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Bytes -> IO Bytes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SessionSendAndReadMethodInfo
instance (signature ~ (b -> Maybe (c) -> m GLib.Bytes.Bytes), MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SessionSendAndReadMethodInfo a signature where
    overloadedMethod = sessionSendAndRead

instance O.OverloadedMethodInfo SessionSendAndReadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSendAndRead",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSendAndRead"
        })


#endif

-- method Session::send_and_read_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the I/O priority of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback to invoke"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data for @callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_send_and_read_async" soup_session_send_and_read_async :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously sends /@msg@/ and reads the response body.
-- 
-- When /@callback@/ is called, then either /@msg@/ has been sent, and its response
-- body read, or else an error has occurred. This function should only be used
-- when the resource to be retrieved is not too long and can be stored in
-- memory. Call [method/@session@/.send_and_read_finish] to get a
-- [struct/@gLib@/.Bytes] with the response body.
-- 
-- See [method/@session@/.send] for more details on the general semantics.
sessionSendAndReadAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: the callback to invoke
    -> m ()
sessionSendAndReadAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSession a, IsMessage b,
 IsCancellable c) =>
a -> b -> Int32 -> Maybe c -> Maybe AsyncReadyCallback -> m ()
sessionSendAndReadAsync a
session b
msg Int32
ioPriority 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Session
-> Ptr Message
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
soup_session_send_and_read_async Ptr Session
session' Ptr Message
msg' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSendAndReadAsyncMethodInfo
instance (signature ~ (b -> Int32 -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SessionSendAndReadAsyncMethodInfo a signature where
    overloadedMethod = sessionSendAndReadAsync

instance O.OverloadedMethodInfo SessionSendAndReadAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSendAndReadAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSendAndReadAsync"
        })


#endif

-- method Session::send_and_read_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncResult passed to your callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_send_and_read_finish" soup_session_send_and_read_finish :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GLib.Bytes.Bytes)

-- | Gets the response to a [method/@session@/.send_and_read_async].
-- 
-- If successful, returns a [struct/@gLib@/.Bytes] with the response body.
sessionSendAndReadFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' passed to your callback
    -> m GLib.Bytes.Bytes
    -- ^ __Returns:__ a t'GI.GLib.Structs.Bytes.Bytes', or 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
sessionSendAndReadFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsAsyncResult b) =>
a -> b -> m Bytes
sessionSendAndReadFinish a
session b
result_ = IO Bytes -> m Bytes
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bytes -> m Bytes) -> IO Bytes -> m Bytes
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO Bytes -> IO () -> IO Bytes
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Bytes
result <- (Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes))
-> (Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes)
forall a b. (a -> b) -> a -> b
$ Ptr Session
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Bytes)
soup_session_send_and_read_finish Ptr Session
session' Ptr AsyncResult
result_'
        Text -> Ptr Bytes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sessionSendAndReadFinish" Ptr Bytes
result
        Bytes
result' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Bytes -> IO Bytes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SessionSendAndReadFinishMethodInfo
instance (signature ~ (b -> m GLib.Bytes.Bytes), MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SessionSendAndReadFinishMethodInfo a signature where
    overloadedMethod = sessionSendAndReadFinish

instance O.OverloadedMethodInfo SessionSendAndReadFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSendAndReadFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSendAndReadFinish"
        })


#endif

-- method Session::send_and_splice
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "OutputStreamSpliceFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GOutputStreamSpliceFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_send_and_splice" soup_session_send_and_splice :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Ptr Gio.OutputStream.OutputStream ->    -- out_stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "OutputStreamSpliceFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO Int64

-- | Synchronously sends /@msg@/ and splices the response body stream into /@outStream@/.
-- 
-- See [method/@session@/.send] for more details on the general semantics.
-- 
-- /Since: 3.4/
sessionSendAndSplice ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.OutputStream.IsOutputStream c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> c
    -- ^ /@outStream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'
    -> [Gio.Flags.OutputStreamSpliceFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.OutputStreamSpliceFlags'
    -> Maybe (d)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m Int64
    -- ^ __Returns:__ a @/gssize/@ containing the size of the data spliced, or -1 if an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
sessionSendAndSplice :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsSession a, IsMessage b,
 IsOutputStream c, IsCancellable d) =>
a -> b -> c -> [OutputStreamSpliceFlags] -> Maybe d -> m Int64
sessionSendAndSplice a
session b
msg c
outStream [OutputStreamSpliceFlags]
flags Maybe d
cancellable = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    Ptr OutputStream
outStream' <- c -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
outStream
    let flags' :: CUInt
flags' = [OutputStreamSpliceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [OutputStreamSpliceFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Maybe d
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
nullPtr
        Just d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Int64 -> IO () -> IO Int64
forall a b. IO a -> IO b -> IO a
onException (do
        Int64
result <- (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int64) -> IO Int64)
-> (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ Ptr Session
-> Ptr Message
-> Ptr OutputStream
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO Int64
soup_session_send_and_splice Ptr Session
session' Ptr Message
msg' Ptr OutputStream
outStream' CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
        c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
outStream
        Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SessionSendAndSpliceMethodInfo
instance (signature ~ (b -> c -> [Gio.Flags.OutputStreamSpliceFlags] -> Maybe (d) -> m Int64), MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.OutputStream.IsOutputStream c, Gio.Cancellable.IsCancellable d) => O.OverloadedMethod SessionSendAndSpliceMethodInfo a signature where
    overloadedMethod = sessionSendAndSplice

instance O.OverloadedMethodInfo SessionSendAndSpliceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSendAndSplice",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSendAndSplice"
        })


#endif

-- method Session::send_and_splice_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GOutputStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "OutputStreamSpliceFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GOutputStreamSpliceFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the I/O priority of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback to invoke"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 7
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data for @callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_send_and_splice_async" soup_session_send_and_splice_async :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Ptr Gio.OutputStream.OutputStream ->    -- out_stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "OutputStreamSpliceFlags"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously sends /@msg@/ and splices the response body stream into /@outStream@/.
-- When /@callback@/ is called, then either /@msg@/ has been sent and its response body
-- spliced, or else an error has occurred.
-- 
-- See [method/@session@/.send] for more details on the general semantics.
-- 
-- /Since: 3.4/
sessionSendAndSpliceAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.OutputStream.IsOutputStream c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> c
    -- ^ /@outStream@/: a t'GI.Gio.Objects.OutputStream.OutputStream'
    -> [Gio.Flags.OutputStreamSpliceFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.OutputStreamSpliceFlags'
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request
    -> Maybe (d)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: the callback to invoke
    -> m ()
sessionSendAndSpliceAsync :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsSession a, IsMessage b,
 IsOutputStream c, IsCancellable d) =>
a
-> b
-> c
-> [OutputStreamSpliceFlags]
-> Int32
-> Maybe d
-> Maybe AsyncReadyCallback
-> m ()
sessionSendAndSpliceAsync a
session b
msg c
outStream [OutputStreamSpliceFlags]
flags Int32
ioPriority Maybe d
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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    Ptr OutputStream
outStream' <- c -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
outStream
    let flags' :: CUInt
flags' = [OutputStreamSpliceFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [OutputStreamSpliceFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Maybe d
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
nullPtr
        Just d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Session
-> Ptr Message
-> Ptr OutputStream
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
soup_session_send_and_splice_async Ptr Session
session' Ptr Message
msg' Ptr OutputStream
outStream' CUInt
flags' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
outStream
    Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSendAndSpliceAsyncMethodInfo
instance (signature ~ (b -> c -> [Gio.Flags.OutputStreamSpliceFlags] -> Int32 -> Maybe (d) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.OutputStream.IsOutputStream c, Gio.Cancellable.IsCancellable d) => O.OverloadedMethod SessionSendAndSpliceAsyncMethodInfo a signature where
    overloadedMethod = sessionSendAndSpliceAsync

instance O.OverloadedMethodInfo SessionSendAndSpliceAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSendAndSpliceAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSendAndSpliceAsync"
        })


#endif

-- method Session::send_and_splice_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncResult passed to your callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_send_and_splice_finish" soup_session_send_and_splice_finish :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO Int64

-- | Gets the response to a [method/@session@/.send_and_splice_async].
-- 
-- /Since: 3.4/
sessionSendAndSpliceFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' passed to your callback
    -> m Int64
    -- ^ __Returns:__ a @/gssize/@ containing the size of the data spliced, or -1 if an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
sessionSendAndSpliceFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsAsyncResult b) =>
a -> b -> m Int64
sessionSendAndSpliceFinish a
session b
result_ = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO Int64 -> IO () -> IO Int64
forall a b. IO a -> IO b -> IO a
onException (do
        Int64
result <- (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int64) -> IO Int64)
-> (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ Ptr Session -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO Int64
soup_session_send_and_splice_finish Ptr Session
session' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SessionSendAndSpliceFinishMethodInfo
instance (signature ~ (b -> m Int64), MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SessionSendAndSpliceFinishMethodInfo a signature where
    overloadedMethod = sessionSendAndSpliceFinish

instance O.OverloadedMethodInfo SessionSendAndSpliceFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSendAndSpliceFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSendAndSpliceFinish"
        })


#endif

-- method Session::send_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the I/O priority of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback to invoke"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data for @callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_send_async" soup_session_send_async :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously sends /@msg@/ and waits for the beginning of a response.
-- 
-- When /@callback@/ is called, then either /@msg@/ has been sent, and its response
-- headers received, or else an error has occurred. Call
-- [method/@session@/.send_finish] to get a t'GI.Gio.Objects.InputStream.InputStream' for reading the
-- response body.
-- 
-- See [method/@session@/.send] for more details on the general semantics.
sessionSendAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: the callback to invoke
    -> m ()
sessionSendAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSession a, IsMessage b,
 IsCancellable c) =>
a -> b -> Int32 -> Maybe c -> Maybe AsyncReadyCallback -> m ()
sessionSendAsync a
session b
msg Int32
ioPriority 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Session
-> Ptr Message
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
soup_session_send_async Ptr Session
session' Ptr Message
msg' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSendAsyncMethodInfo
instance (signature ~ (b -> Int32 -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SessionSendAsyncMethodInfo a signature where
    overloadedMethod = sessionSendAsync

instance O.OverloadedMethodInfo SessionSendAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSendAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSendAsync"
        })


#endif

-- method Session::send_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncResult passed to your callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "InputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_send_finish" soup_session_send_finish :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.InputStream.InputStream)

-- | Gets the response to a [method/@session@/.send_async] call.
-- 
-- If successful returns a t'GI.Gio.Objects.InputStream.InputStream' that can be used to read the
-- response body.
sessionSendFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' passed to your callback
    -> m Gio.InputStream.InputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.InputStream.InputStream' for reading the
    --   response body, or 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
sessionSendFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsAsyncResult b) =>
a -> b -> m InputStream
sessionSendFinish a
session b
result_ = IO InputStream -> m InputStream
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputStream -> m InputStream)
-> IO InputStream -> m InputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO InputStream -> IO () -> IO InputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr InputStream
result <- (Ptr (Ptr GError) -> IO (Ptr InputStream)) -> IO (Ptr InputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr InputStream))
 -> IO (Ptr InputStream))
-> (Ptr (Ptr GError) -> IO (Ptr InputStream))
-> IO (Ptr InputStream)
forall a b. (a -> b) -> a -> b
$ Ptr Session
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr InputStream)
soup_session_send_finish Ptr Session
session' Ptr AsyncResult
result_'
        Text -> Ptr InputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sessionSendFinish" Ptr InputStream
result
        InputStream
result' <- ((ManagedPtr InputStream -> InputStream)
-> Ptr InputStream -> IO InputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream) Ptr InputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        InputStream -> IO InputStream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SessionSendFinishMethodInfo
instance (signature ~ (b -> m Gio.InputStream.InputStream), MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SessionSendFinishMethodInfo a signature where
    overloadedMethod = sessionSendFinish

instance O.OverloadedMethodInfo SessionSendFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSendFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSendFinish"
        })


#endif

-- method Session::set_accept_language
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accept_language"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the languages string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_set_accept_language" soup_session_set_accept_language :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    CString ->                              -- accept_language : TBasicType TUTF8
    IO ()

-- | Set the value to use for the \"Accept-Language\" header on [class/@message@/]s
-- sent from /@session@/.
-- 
-- If /@acceptLanguage@/ is 'P.Nothing' then no \"Accept-Language\" will be included in
-- requests. See [property/@session@/:accept-language] for more information.
sessionSetAcceptLanguage ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> T.Text
    -- ^ /@acceptLanguage@/: the languages string
    -> m ()
sessionSetAcceptLanguage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> Text -> m ()
sessionSetAcceptLanguage a
session Text
acceptLanguage = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    CString
acceptLanguage' <- Text -> IO CString
textToCString Text
acceptLanguage
    Ptr Session -> CString -> IO ()
soup_session_set_accept_language Ptr Session
session' CString
acceptLanguage'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
acceptLanguage'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSetAcceptLanguageMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsSession a) => O.OverloadedMethod SessionSetAcceptLanguageMethodInfo a signature where
    overloadedMethod = sessionSetAcceptLanguage

instance O.OverloadedMethodInfo SessionSetAcceptLanguageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSetAcceptLanguage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSetAcceptLanguage"
        })


#endif

-- method Session::set_accept_language_auto
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accept_language_auto"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_set_accept_language_auto" soup_session_set_accept_language_auto :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    CInt ->                                 -- accept_language_auto : TBasicType TBoolean
    IO ()

-- | Set whether /@session@/ will automatically set the \"Accept-Language\" header on
-- requests using a value generated from system languages based on
-- 'GI.GLib.Functions.getLanguageNames'.
-- 
-- See [property/@session@/:accept-language-auto] for more information.
sessionSetAcceptLanguageAuto ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> Bool
    -- ^ /@acceptLanguageAuto@/: the value to set
    -> m ()
sessionSetAcceptLanguageAuto :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> Bool -> m ()
sessionSetAcceptLanguageAuto a
session Bool
acceptLanguageAuto = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    let acceptLanguageAuto' :: CInt
acceptLanguageAuto' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
acceptLanguageAuto
    Ptr Session -> CInt -> IO ()
soup_session_set_accept_language_auto Ptr Session
session' CInt
acceptLanguageAuto'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSetAcceptLanguageAutoMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSession a) => O.OverloadedMethod SessionSetAcceptLanguageAutoMethodInfo a signature where
    overloadedMethod = sessionSetAcceptLanguageAuto

instance O.OverloadedMethodInfo SessionSetAcceptLanguageAutoMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSetAcceptLanguageAuto",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSetAcceptLanguageAuto"
        })


#endif

-- method Session::set_idle_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timeout in seconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_set_idle_timeout" soup_session_set_idle_timeout :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Word32 ->                               -- timeout : TBasicType TUInt
    IO ()

-- | Set a timeout in seconds for idle connection lifetime to be used by /@session@/
-- on new connections.
-- 
-- See [property/@session@/:idle-timeout] for more information.
sessionSetIdleTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> Word32
    -- ^ /@timeout@/: a timeout in seconds
    -> m ()
sessionSetIdleTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> Word32 -> m ()
sessionSetIdleTimeout a
session Word32
timeout = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Session -> Word32 -> IO ()
soup_session_set_idle_timeout Ptr Session
session' Word32
timeout
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSetIdleTimeoutMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsSession a) => O.OverloadedMethod SessionSetIdleTimeoutMethodInfo a signature where
    overloadedMethod = sessionSetIdleTimeout

instance O.OverloadedMethodInfo SessionSetIdleTimeoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSetIdleTimeout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSetIdleTimeout"
        })


#endif

-- method Session::set_proxy_resolver
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proxy_resolver"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ProxyResolver" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GProxyResolver or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_set_proxy_resolver" soup_session_set_proxy_resolver :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Gio.ProxyResolver.ProxyResolver ->  -- proxy_resolver : TInterface (Name {namespace = "Gio", name = "ProxyResolver"})
    IO ()

-- | Set a t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver' to be used by /@session@/ on new connections.
-- 
-- If /@proxyResolver@/ is 'P.Nothing' then no proxies will be used. See
-- [property/@session@/:proxy-resolver] for more information.
sessionSetProxyResolver ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Gio.ProxyResolver.IsProxyResolver b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> Maybe (b)
    -- ^ /@proxyResolver@/: a t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver' or 'P.Nothing'
    -> m ()
sessionSetProxyResolver :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsProxyResolver b) =>
a -> Maybe b -> m ()
sessionSetProxyResolver a
session Maybe b
proxyResolver = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr ProxyResolver
maybeProxyResolver <- case Maybe b
proxyResolver of
        Maybe b
Nothing -> Ptr ProxyResolver -> IO (Ptr ProxyResolver)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ProxyResolver
forall a. Ptr a
nullPtr
        Just b
jProxyResolver -> do
            Ptr ProxyResolver
jProxyResolver' <- b -> IO (Ptr ProxyResolver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProxyResolver
            Ptr ProxyResolver -> IO (Ptr ProxyResolver)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ProxyResolver
jProxyResolver'
    Ptr Session -> Ptr ProxyResolver -> IO ()
soup_session_set_proxy_resolver Ptr Session
session' Ptr ProxyResolver
maybeProxyResolver
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
proxyResolver b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSetProxyResolverMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSession a, Gio.ProxyResolver.IsProxyResolver b) => O.OverloadedMethod SessionSetProxyResolverMethodInfo a signature where
    overloadedMethod = sessionSetProxyResolver

instance O.OverloadedMethodInfo SessionSetProxyResolverMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSetProxyResolver",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSetProxyResolver"
        })


#endif

-- method Session::set_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timeout in seconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_set_timeout" soup_session_set_timeout :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Word32 ->                               -- timeout : TBasicType TUInt
    IO ()

-- | Set a timeout in seconds for socket I\/O operations to be used by /@session@/
-- on new connections.
-- 
-- See [property/@session@/:timeout] for more information.
sessionSetTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> Word32
    -- ^ /@timeout@/: a timeout in seconds
    -> m ()
sessionSetTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> Word32 -> m ()
sessionSetTimeout a
session Word32
timeout = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Session -> Word32 -> IO ()
soup_session_set_timeout Ptr Session
session' Word32
timeout
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSetTimeoutMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsSession a) => O.OverloadedMethod SessionSetTimeoutMethodInfo a signature where
    overloadedMethod = sessionSetTimeout

instance O.OverloadedMethodInfo SessionSetTimeoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSetTimeout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSetTimeout"
        })


#endif

-- method Session::set_tls_database
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tls_database"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_set_tls_database" soup_session_set_tls_database :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Gio.TlsDatabase.TlsDatabase ->      -- tls_database : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    IO ()

-- | Set a @/GIo.TlsDatabase/@ to be used by /@session@/ on new connections.
-- 
-- If /@tlsDatabase@/ is 'P.Nothing' then certificate validation will always fail. See
-- [property/@session@/:tls-database] for more information.
sessionSetTlsDatabase ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Gio.TlsDatabase.IsTlsDatabase b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> Maybe (b)
    -- ^ /@tlsDatabase@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> m ()
sessionSetTlsDatabase :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsTlsDatabase b) =>
a -> Maybe b -> m ()
sessionSetTlsDatabase a
session Maybe b
tlsDatabase = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr TlsDatabase
maybeTlsDatabase <- case Maybe b
tlsDatabase of
        Maybe b
Nothing -> Ptr TlsDatabase -> IO (Ptr TlsDatabase)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsDatabase
forall a. Ptr a
nullPtr
        Just b
jTlsDatabase -> do
            Ptr TlsDatabase
jTlsDatabase' <- b -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jTlsDatabase
            Ptr TlsDatabase -> IO (Ptr TlsDatabase)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsDatabase
jTlsDatabase'
    Ptr Session -> Ptr TlsDatabase -> IO ()
soup_session_set_tls_database Ptr Session
session' Ptr TlsDatabase
maybeTlsDatabase
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
tlsDatabase b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSetTlsDatabaseMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSession a, Gio.TlsDatabase.IsTlsDatabase b) => O.OverloadedMethod SessionSetTlsDatabaseMethodInfo a signature where
    overloadedMethod = sessionSetTlsDatabase

instance O.OverloadedMethodInfo SessionSetTlsDatabaseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSetTlsDatabase",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSetTlsDatabase"
        })


#endif

-- method Session::set_tls_interaction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tls_interaction"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsInteraction" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsInteraction" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_set_tls_interaction" soup_session_set_tls_interaction :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Gio.TlsInteraction.TlsInteraction -> -- tls_interaction : TInterface (Name {namespace = "Gio", name = "TlsInteraction"})
    IO ()

-- | Set a t'GI.Gio.Objects.TlsInteraction.TlsInteraction' to be used by /@session@/ on new connections.
-- 
-- If /@tlsInteraction@/ is 'P.Nothing' then client certificate validation will always
-- fail.
-- 
-- See [property/@session@/:tls-interaction] for more information.
sessionSetTlsInteraction ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Gio.TlsInteraction.IsTlsInteraction b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> Maybe (b)
    -- ^ /@tlsInteraction@/: a t'GI.Gio.Objects.TlsInteraction.TlsInteraction'
    -> m ()
sessionSetTlsInteraction :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsTlsInteraction b) =>
a -> Maybe b -> m ()
sessionSetTlsInteraction a
session Maybe b
tlsInteraction = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr TlsInteraction
maybeTlsInteraction <- case Maybe b
tlsInteraction of
        Maybe b
Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
nullPtr
        Just b
jTlsInteraction -> do
            Ptr TlsInteraction
jTlsInteraction' <- b -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jTlsInteraction
            Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
jTlsInteraction'
    Ptr Session -> Ptr TlsInteraction -> IO ()
soup_session_set_tls_interaction Ptr Session
session' Ptr TlsInteraction
maybeTlsInteraction
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
tlsInteraction b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSetTlsInteractionMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSession a, Gio.TlsInteraction.IsTlsInteraction b) => O.OverloadedMethod SessionSetTlsInteractionMethodInfo a signature where
    overloadedMethod = sessionSetTlsInteraction

instance O.OverloadedMethodInfo SessionSetTlsInteractionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSetTlsInteraction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSetTlsInteraction"
        })


#endif

-- method Session::set_user_agent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_agent"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the user agent string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_set_user_agent" soup_session_set_user_agent :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    CString ->                              -- user_agent : TBasicType TUTF8
    IO ()

-- | Set the value to use for the \"User-Agent\" header on [class/@message@/]s sent
-- from /@session@/.
-- 
-- If /@userAgent@/ has trailing whitespace, /@session@/ will append its own product
-- token (eg, @libsoup\/3.0.0@) to the end of the header for you. If /@userAgent@/
-- is 'P.Nothing' then no \"User-Agent\" will be included in requests. See
-- [property/@session@/:user-agent] for more information.
sessionSetUserAgent ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> T.Text
    -- ^ /@userAgent@/: the user agent string
    -> m ()
sessionSetUserAgent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSession a) =>
a -> Text -> m ()
sessionSetUserAgent a
session Text
userAgent = 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    CString
userAgent' <- Text -> IO CString
textToCString Text
userAgent
    Ptr Session -> CString -> IO ()
soup_session_set_user_agent Ptr Session
session' CString
userAgent'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
userAgent'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionSetUserAgentMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsSession a) => O.OverloadedMethod SessionSetUserAgentMethodInfo a signature where
    overloadedMethod = sessionSetUserAgent

instance O.OverloadedMethodInfo SessionSetUserAgentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionSetUserAgent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionSetUserAgent"
        })


#endif

-- method Session::websocket_connect_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#SoupMessage indicating the WebSocket server to connect to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "origin"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "origin of the connection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocols"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a\n  %NULL-terminated array of protocols supported"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the I/O priority of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback to invoke"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 7
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data for @callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_websocket_connect_async" soup_session_websocket_connect_async :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    CString ->                              -- origin : TBasicType TUTF8
    Ptr CString ->                          -- protocols : TCArray True (-1) (-1) (TBasicType TUTF8)
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously creates a [class/@websocketConnection@/] to communicate with a
-- remote server.
-- 
-- All necessary WebSocket-related headers will be added to /@msg@/, and
-- it will then be sent and asynchronously processed normally
-- (including handling of redirection and HTTP authentication).
-- 
-- If the server returns \"101 Switching Protocols\", then /@msg@/\'s status
-- code and response headers will be updated, and then the WebSocket
-- handshake will be completed. On success,
-- [method/@session@/.websocket_connect_finish] will return a new
-- [class/@websocketConnection@/]. On failure it will return a t'GError'.
-- 
-- If the server returns a status other than \"101 Switching Protocols\", then
-- /@msg@/ will contain the complete response headers and body from the server\'s
-- response, and [method/@session@/.websocket_connect_finish] will return
-- 'GI.Soup.Enums.WebsocketErrorNotWebsocket'.
sessionWebsocketConnectAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@msg@/: t'GI.Soup.Objects.Message.Message' indicating the WebSocket server to connect to
    -> Maybe (T.Text)
    -- ^ /@origin@/: origin of the connection
    -> Maybe ([T.Text])
    -- ^ /@protocols@/: a
    --   'P.Nothing'-terminated array of protocols supported
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: the callback to invoke
    -> m ()
sessionWebsocketConnectAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSession a, IsMessage b,
 IsCancellable c) =>
a
-> b
-> Maybe Text
-> Maybe [Text]
-> Int32
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
sessionWebsocketConnectAsync a
session b
msg Maybe Text
origin Maybe [Text]
protocols Int32
ioPriority 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
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CString
maybeOrigin <- case Maybe Text
origin 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
nullPtr
        Just Text
jOrigin -> do
            CString
jOrigin' <- Text -> IO CString
textToCString Text
jOrigin
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jOrigin'
    Ptr CString
maybeProtocols <- case Maybe [Text]
protocols of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jProtocols -> do
            Ptr CString
jProtocols' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jProtocols
            Ptr CString -> IO (Ptr CString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jProtocols'
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Session
-> Ptr Message
-> CString
-> Ptr CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
soup_session_websocket_connect_async Ptr Session
session' Ptr Message
msg' CString
maybeOrigin Ptr CString
maybeProtocols Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOrigin
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeProtocols
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeProtocols
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionWebsocketConnectAsyncMethodInfo
instance (signature ~ (b -> Maybe (T.Text) -> Maybe ([T.Text]) -> Int32 -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSession a, Soup.Message.IsMessage b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SessionWebsocketConnectAsyncMethodInfo a signature where
    overloadedMethod = sessionWebsocketConnectAsync

instance O.OverloadedMethodInfo SessionWebsocketConnectAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionWebsocketConnectAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionWebsocketConnectAsync"
        })


#endif

-- method Session::websocket_connect_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSession" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncResult passed to your callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Soup" , name = "WebsocketConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_websocket_connect_finish" soup_session_websocket_connect_finish :: 
    Ptr Session ->                          -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Soup.WebsocketConnection.WebsocketConnection)

-- | Gets the [class/@websocketConnection@/] response to a
-- [method/@session@/.websocket_connect_async] call.
-- 
-- If successful, returns a [class/@websocketConnection@/] that can be used to
-- communicate with the server.
sessionWebsocketConnectFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@session@/: a t'GI.Soup.Objects.Session.Session'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' passed to your callback
    -> m Soup.WebsocketConnection.WebsocketConnection
    -- ^ __Returns:__ a new t'GI.Soup.Objects.WebsocketConnection.WebsocketConnection', or
    --   'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
sessionWebsocketConnectFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSession a, IsAsyncResult b) =>
a -> b -> m WebsocketConnection
sessionWebsocketConnectFinish a
session b
result_ = IO WebsocketConnection -> m WebsocketConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebsocketConnection -> m WebsocketConnection)
-> IO WebsocketConnection -> m WebsocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Session
session' <- a -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO WebsocketConnection -> IO () -> IO WebsocketConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr WebsocketConnection
result <- (Ptr (Ptr GError) -> IO (Ptr WebsocketConnection))
-> IO (Ptr WebsocketConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr WebsocketConnection))
 -> IO (Ptr WebsocketConnection))
-> (Ptr (Ptr GError) -> IO (Ptr WebsocketConnection))
-> IO (Ptr WebsocketConnection)
forall a b. (a -> b) -> a -> b
$ Ptr Session
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr WebsocketConnection)
soup_session_websocket_connect_finish Ptr Session
session' Ptr AsyncResult
result_'
        Text -> Ptr WebsocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sessionWebsocketConnectFinish" Ptr WebsocketConnection
result
        WebsocketConnection
result' <- ((ManagedPtr WebsocketConnection -> WebsocketConnection)
-> Ptr WebsocketConnection -> IO WebsocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr WebsocketConnection -> WebsocketConnection
Soup.WebsocketConnection.WebsocketConnection) Ptr WebsocketConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        WebsocketConnection -> IO WebsocketConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketConnection
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SessionWebsocketConnectFinishMethodInfo
instance (signature ~ (b -> m Soup.WebsocketConnection.WebsocketConnection), MonadIO m, IsSession a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SessionWebsocketConnectFinishMethodInfo a signature where
    overloadedMethod = sessionWebsocketConnectFinish

instance O.OverloadedMethodInfo SessionWebsocketConnectFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Session.sessionWebsocketConnectFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Session.html#v:sessionWebsocketConnectFinish"
        })


#endif