{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Soup.Objects.Session
    ( 

-- * Exported types
    Session(..)                             ,
    SessionK                                ,
    toSession                               ,
    noSession                               ,


 -- * Methods
-- ** sessionAbort
    sessionAbort                            ,


-- ** sessionAddFeature
    sessionAddFeature                       ,


-- ** sessionAddFeatureByType
    sessionAddFeatureByType                 ,


-- ** sessionCancelMessage
    sessionCancelMessage                    ,


-- ** sessionGetAsyncContext
    sessionGetAsyncContext                  ,


-- ** sessionGetFeature
    sessionGetFeature                       ,


-- ** sessionGetFeatureForMessage
    sessionGetFeatureForMessage             ,


-- ** sessionGetFeatures
    sessionGetFeatures                      ,


-- ** sessionHasFeature
    sessionHasFeature                       ,


-- ** sessionNew
    sessionNew                              ,


-- ** sessionPauseMessage
    sessionPauseMessage                     ,


-- ** sessionPrefetchDns
    sessionPrefetchDns                      ,


-- ** sessionPrepareForUri
    sessionPrepareForUri                    ,


-- ** sessionQueueMessage
    sessionQueueMessage                     ,


-- ** sessionRedirectMessage
    sessionRedirectMessage                  ,


-- ** sessionRemoveFeature
    sessionRemoveFeature                    ,


-- ** sessionRemoveFeatureByType
    sessionRemoveFeatureByType              ,


-- ** sessionRequest
    sessionRequest                          ,


-- ** sessionRequestHttp
    sessionRequestHttp                      ,


-- ** sessionRequestHttpUri
    sessionRequestHttpUri                   ,


-- ** sessionRequestUri
    sessionRequestUri                       ,


-- ** sessionRequeueMessage
    sessionRequeueMessage                   ,


-- ** sessionSend
    sessionSend                             ,


-- ** sessionSendAsync
    sessionSendAsync                        ,


-- ** sessionSendFinish
    sessionSendFinish                       ,


-- ** sessionSendMessage
    sessionSendMessage                      ,


-- ** sessionStealConnection
    sessionStealConnection                  ,


-- ** sessionUnpauseMessage
    sessionUnpauseMessage                   ,


-- ** sessionWebsocketConnectAsync
    sessionWebsocketConnectAsync            ,


-- ** sessionWebsocketConnectFinish
    sessionWebsocketConnectFinish           ,


-- ** sessionWouldRedirect
    sessionWouldRedirect                    ,




 -- * Properties
-- ** AcceptLanguage
    SessionAcceptLanguagePropertyInfo       ,
    constructSessionAcceptLanguage          ,
    getSessionAcceptLanguage                ,
    setSessionAcceptLanguage                ,


-- ** AcceptLanguageAuto
    SessionAcceptLanguageAutoPropertyInfo   ,
    constructSessionAcceptLanguageAuto      ,
    getSessionAcceptLanguageAuto            ,
    setSessionAcceptLanguageAuto            ,


-- ** AsyncContext
    SessionAsyncContextPropertyInfo         ,
    constructSessionAsyncContext            ,
    getSessionAsyncContext                  ,


-- ** HttpAliases
    SessionHttpAliasesPropertyInfo          ,
    constructSessionHttpAliases             ,
    getSessionHttpAliases                   ,
    setSessionHttpAliases                   ,


-- ** HttpsAliases
    SessionHttpsAliasesPropertyInfo         ,
    constructSessionHttpsAliases            ,
    getSessionHttpsAliases                  ,
    setSessionHttpsAliases                  ,


-- ** IdleTimeout
    SessionIdleTimeoutPropertyInfo          ,
    constructSessionIdleTimeout             ,
    getSessionIdleTimeout                   ,
    setSessionIdleTimeout                   ,


-- ** LocalAddress
    SessionLocalAddressPropertyInfo         ,
    constructSessionLocalAddress            ,
    getSessionLocalAddress                  ,


-- ** MaxConns
    SessionMaxConnsPropertyInfo             ,
    constructSessionMaxConns                ,
    getSessionMaxConns                      ,
    setSessionMaxConns                      ,


-- ** MaxConnsPerHost
    SessionMaxConnsPerHostPropertyInfo      ,
    constructSessionMaxConnsPerHost         ,
    getSessionMaxConnsPerHost               ,
    setSessionMaxConnsPerHost               ,


-- ** ProxyResolver
    SessionProxyResolverPropertyInfo        ,
    constructSessionProxyResolver           ,
    getSessionProxyResolver                 ,
    setSessionProxyResolver                 ,


-- ** ProxyUri
    SessionProxyUriPropertyInfo             ,
    constructSessionProxyUri                ,
    getSessionProxyUri                      ,
    setSessionProxyUri                      ,


-- ** SslCaFile
    SessionSslCaFilePropertyInfo            ,
    constructSessionSslCaFile               ,
    getSessionSslCaFile                     ,
    setSessionSslCaFile                     ,


-- ** SslStrict
    SessionSslStrictPropertyInfo            ,
    constructSessionSslStrict               ,
    getSessionSslStrict                     ,
    setSessionSslStrict                     ,


-- ** SslUseSystemCaFile
    SessionSslUseSystemCaFilePropertyInfo   ,
    constructSessionSslUseSystemCaFile      ,
    getSessionSslUseSystemCaFile            ,
    setSessionSslUseSystemCaFile            ,


-- ** Timeout
    SessionTimeoutPropertyInfo              ,
    constructSessionTimeout                 ,
    getSessionTimeout                       ,
    setSessionTimeout                       ,


-- ** TlsDatabase
    SessionTlsDatabasePropertyInfo          ,
    constructSessionTlsDatabase             ,
    getSessionTlsDatabase                   ,
    setSessionTlsDatabase                   ,


-- ** TlsInteraction
    SessionTlsInteractionPropertyInfo       ,
    constructSessionTlsInteraction          ,
    getSessionTlsInteraction                ,
    setSessionTlsInteraction                ,


-- ** UseNtlm
    SessionUseNtlmPropertyInfo              ,
    constructSessionUseNtlm                 ,
    getSessionUseNtlm                       ,
    setSessionUseNtlm                       ,


-- ** UseThreadContext
    SessionUseThreadContextPropertyInfo     ,
    constructSessionUseThreadContext        ,
    getSessionUseThreadContext              ,
    setSessionUseThreadContext              ,


-- ** UserAgent
    SessionUserAgentPropertyInfo            ,
    constructSessionUserAgent               ,
    getSessionUserAgent                     ,
    setSessionUserAgent                     ,




 -- * Signals
-- ** Authenticate
    SessionAuthenticateCallback             ,
    SessionAuthenticateCallbackC            ,
    SessionAuthenticateSignalInfo           ,
    afterSessionAuthenticate                ,
    mkSessionAuthenticateCallback           ,
    noSessionAuthenticateCallback           ,
    onSessionAuthenticate                   ,
    sessionAuthenticateCallbackWrapper      ,
    sessionAuthenticateClosure              ,


-- ** ConnectionCreated
    SessionConnectionCreatedCallback        ,
    SessionConnectionCreatedCallbackC       ,
    SessionConnectionCreatedSignalInfo      ,
    afterSessionConnectionCreated           ,
    mkSessionConnectionCreatedCallback      ,
    noSessionConnectionCreatedCallback      ,
    onSessionConnectionCreated              ,
    sessionConnectionCreatedCallbackWrapper ,
    sessionConnectionCreatedClosure         ,


-- ** RequestQueued
    SessionRequestQueuedCallback            ,
    SessionRequestQueuedCallbackC           ,
    SessionRequestQueuedSignalInfo          ,
    afterSessionRequestQueued               ,
    mkSessionRequestQueuedCallback          ,
    noSessionRequestQueuedCallback          ,
    onSessionRequestQueued                  ,
    sessionRequestQueuedCallbackWrapper     ,
    sessionRequestQueuedClosure             ,


-- ** RequestStarted
    SessionRequestStartedCallback           ,
    SessionRequestStartedCallbackC          ,
    SessionRequestStartedSignalInfo         ,
    afterSessionRequestStarted              ,
    mkSessionRequestStartedCallback         ,
    noSessionRequestStartedCallback         ,
    onSessionRequestStarted                 ,
    sessionRequestStartedCallbackWrapper    ,
    sessionRequestStartedClosure            ,


-- ** RequestUnqueued
    SessionRequestUnqueuedCallback          ,
    SessionRequestUnqueuedCallbackC         ,
    SessionRequestUnqueuedSignalInfo        ,
    afterSessionRequestUnqueued             ,
    mkSessionRequestUnqueuedCallback        ,
    noSessionRequestUnqueuedCallback        ,
    onSessionRequestUnqueued                ,
    sessionRequestUnqueuedCallbackWrapper   ,
    sessionRequestUnqueuedClosure           ,


-- ** Tunneling
    SessionTunnelingCallback                ,
    SessionTunnelingCallbackC               ,
    SessionTunnelingSignalInfo              ,
    afterSessionTunneling                   ,
    mkSessionTunnelingCallback              ,
    noSessionTunnelingCallback              ,
    onSessionTunneling                      ,
    sessionTunnelingCallbackWrapper         ,
    sessionTunnelingClosure                 ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Soup.Types
import GI.Soup.Callbacks
import qualified GI.GLib as GLib
import qualified GI.GObject as GObject
import qualified GI.Gio as Gio

newtype Session = Session (ForeignPtr Session)
foreign import ccall "soup_session_get_type"
    c_soup_session_get_type :: IO GType

type instance ParentTypes Session = SessionParentTypes
type SessionParentTypes = '[GObject.Object]

instance GObject Session where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_soup_session_get_type
    

class GObject o => SessionK o
instance (GObject o, IsDescendantOf Session o) => SessionK o

toSession :: SessionK o => o -> IO Session
toSession = unsafeCastTo Session

noSession :: Maybe Session
noSession = Nothing

-- signal Session::authenticate
type SessionAuthenticateCallback =
    Message ->
    Auth ->
    Bool ->
    IO ()

noSessionAuthenticateCallback :: Maybe SessionAuthenticateCallback
noSessionAuthenticateCallback = Nothing

type SessionAuthenticateCallbackC =
    Ptr () ->                               -- object
    Ptr Message ->
    Ptr Auth ->
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkSessionAuthenticateCallback :: SessionAuthenticateCallbackC -> IO (FunPtr SessionAuthenticateCallbackC)

sessionAuthenticateClosure :: SessionAuthenticateCallback -> IO Closure
sessionAuthenticateClosure cb = newCClosure =<< mkSessionAuthenticateCallback wrapped
    where wrapped = sessionAuthenticateCallbackWrapper cb

sessionAuthenticateCallbackWrapper ::
    SessionAuthenticateCallback ->
    Ptr () ->
    Ptr Message ->
    Ptr Auth ->
    CInt ->
    Ptr () ->
    IO ()
sessionAuthenticateCallbackWrapper _cb _ msg auth retrying _ = do
    msg' <- (newObject Message) msg
    auth' <- (newObject Auth) auth
    let retrying' = (/= 0) retrying
    _cb  msg' auth' retrying'

onSessionAuthenticate :: (GObject a, MonadIO m) => a -> SessionAuthenticateCallback -> m SignalHandlerId
onSessionAuthenticate obj cb = liftIO $ connectSessionAuthenticate obj cb SignalConnectBefore
afterSessionAuthenticate :: (GObject a, MonadIO m) => a -> SessionAuthenticateCallback -> m SignalHandlerId
afterSessionAuthenticate obj cb = connectSessionAuthenticate obj cb SignalConnectAfter

connectSessionAuthenticate :: (GObject a, MonadIO m) =>
                              a -> SessionAuthenticateCallback -> SignalConnectMode -> m SignalHandlerId
connectSessionAuthenticate obj cb after = liftIO $ do
    cb' <- mkSessionAuthenticateCallback (sessionAuthenticateCallbackWrapper cb)
    connectSignalFunPtr obj "authenticate" cb' after

-- signal Session::connection-created
type SessionConnectionCreatedCallback =
    GObject.Object ->
    IO ()

noSessionConnectionCreatedCallback :: Maybe SessionConnectionCreatedCallback
noSessionConnectionCreatedCallback = Nothing

type SessionConnectionCreatedCallbackC =
    Ptr () ->                               -- object
    Ptr GObject.Object ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkSessionConnectionCreatedCallback :: SessionConnectionCreatedCallbackC -> IO (FunPtr SessionConnectionCreatedCallbackC)

sessionConnectionCreatedClosure :: SessionConnectionCreatedCallback -> IO Closure
sessionConnectionCreatedClosure cb = newCClosure =<< mkSessionConnectionCreatedCallback wrapped
    where wrapped = sessionConnectionCreatedCallbackWrapper cb

sessionConnectionCreatedCallbackWrapper ::
    SessionConnectionCreatedCallback ->
    Ptr () ->
    Ptr GObject.Object ->
    Ptr () ->
    IO ()
sessionConnectionCreatedCallbackWrapper _cb _ connection _ = do
    connection' <- (newObject GObject.Object) connection
    _cb  connection'

onSessionConnectionCreated :: (GObject a, MonadIO m) => a -> SessionConnectionCreatedCallback -> m SignalHandlerId
onSessionConnectionCreated obj cb = liftIO $ connectSessionConnectionCreated obj cb SignalConnectBefore
afterSessionConnectionCreated :: (GObject a, MonadIO m) => a -> SessionConnectionCreatedCallback -> m SignalHandlerId
afterSessionConnectionCreated obj cb = connectSessionConnectionCreated obj cb SignalConnectAfter

connectSessionConnectionCreated :: (GObject a, MonadIO m) =>
                                   a -> SessionConnectionCreatedCallback -> SignalConnectMode -> m SignalHandlerId
connectSessionConnectionCreated obj cb after = liftIO $ do
    cb' <- mkSessionConnectionCreatedCallback (sessionConnectionCreatedCallbackWrapper cb)
    connectSignalFunPtr obj "connection-created" cb' after

-- signal Session::request-queued
type SessionRequestQueuedCallback =
    Message ->
    IO ()

noSessionRequestQueuedCallback :: Maybe SessionRequestQueuedCallback
noSessionRequestQueuedCallback = Nothing

type SessionRequestQueuedCallbackC =
    Ptr () ->                               -- object
    Ptr Message ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkSessionRequestQueuedCallback :: SessionRequestQueuedCallbackC -> IO (FunPtr SessionRequestQueuedCallbackC)

sessionRequestQueuedClosure :: SessionRequestQueuedCallback -> IO Closure
sessionRequestQueuedClosure cb = newCClosure =<< mkSessionRequestQueuedCallback wrapped
    where wrapped = sessionRequestQueuedCallbackWrapper cb

sessionRequestQueuedCallbackWrapper ::
    SessionRequestQueuedCallback ->
    Ptr () ->
    Ptr Message ->
    Ptr () ->
    IO ()
sessionRequestQueuedCallbackWrapper _cb _ msg _ = do
    msg' <- (newObject Message) msg
    _cb  msg'

onSessionRequestQueued :: (GObject a, MonadIO m) => a -> SessionRequestQueuedCallback -> m SignalHandlerId
onSessionRequestQueued obj cb = liftIO $ connectSessionRequestQueued obj cb SignalConnectBefore
afterSessionRequestQueued :: (GObject a, MonadIO m) => a -> SessionRequestQueuedCallback -> m SignalHandlerId
afterSessionRequestQueued obj cb = connectSessionRequestQueued obj cb SignalConnectAfter

connectSessionRequestQueued :: (GObject a, MonadIO m) =>
                               a -> SessionRequestQueuedCallback -> SignalConnectMode -> m SignalHandlerId
connectSessionRequestQueued obj cb after = liftIO $ do
    cb' <- mkSessionRequestQueuedCallback (sessionRequestQueuedCallbackWrapper cb)
    connectSignalFunPtr obj "request-queued" cb' after

-- signal Session::request-started
type SessionRequestStartedCallback =
    Message ->
    Socket ->
    IO ()

noSessionRequestStartedCallback :: Maybe SessionRequestStartedCallback
noSessionRequestStartedCallback = Nothing

type SessionRequestStartedCallbackC =
    Ptr () ->                               -- object
    Ptr Message ->
    Ptr Socket ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkSessionRequestStartedCallback :: SessionRequestStartedCallbackC -> IO (FunPtr SessionRequestStartedCallbackC)

sessionRequestStartedClosure :: SessionRequestStartedCallback -> IO Closure
sessionRequestStartedClosure cb = newCClosure =<< mkSessionRequestStartedCallback wrapped
    where wrapped = sessionRequestStartedCallbackWrapper cb

sessionRequestStartedCallbackWrapper ::
    SessionRequestStartedCallback ->
    Ptr () ->
    Ptr Message ->
    Ptr Socket ->
    Ptr () ->
    IO ()
sessionRequestStartedCallbackWrapper _cb _ msg socket _ = do
    msg' <- (newObject Message) msg
    socket' <- (newObject Socket) socket
    _cb  msg' socket'

onSessionRequestStarted :: (GObject a, MonadIO m) => a -> SessionRequestStartedCallback -> m SignalHandlerId
onSessionRequestStarted obj cb = liftIO $ connectSessionRequestStarted obj cb SignalConnectBefore
afterSessionRequestStarted :: (GObject a, MonadIO m) => a -> SessionRequestStartedCallback -> m SignalHandlerId
afterSessionRequestStarted obj cb = connectSessionRequestStarted obj cb SignalConnectAfter

connectSessionRequestStarted :: (GObject a, MonadIO m) =>
                                a -> SessionRequestStartedCallback -> SignalConnectMode -> m SignalHandlerId
connectSessionRequestStarted obj cb after = liftIO $ do
    cb' <- mkSessionRequestStartedCallback (sessionRequestStartedCallbackWrapper cb)
    connectSignalFunPtr obj "request-started" cb' after

-- signal Session::request-unqueued
type SessionRequestUnqueuedCallback =
    Message ->
    IO ()

noSessionRequestUnqueuedCallback :: Maybe SessionRequestUnqueuedCallback
noSessionRequestUnqueuedCallback = Nothing

type SessionRequestUnqueuedCallbackC =
    Ptr () ->                               -- object
    Ptr Message ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkSessionRequestUnqueuedCallback :: SessionRequestUnqueuedCallbackC -> IO (FunPtr SessionRequestUnqueuedCallbackC)

sessionRequestUnqueuedClosure :: SessionRequestUnqueuedCallback -> IO Closure
sessionRequestUnqueuedClosure cb = newCClosure =<< mkSessionRequestUnqueuedCallback wrapped
    where wrapped = sessionRequestUnqueuedCallbackWrapper cb

sessionRequestUnqueuedCallbackWrapper ::
    SessionRequestUnqueuedCallback ->
    Ptr () ->
    Ptr Message ->
    Ptr () ->
    IO ()
sessionRequestUnqueuedCallbackWrapper _cb _ msg _ = do
    msg' <- (newObject Message) msg
    _cb  msg'

onSessionRequestUnqueued :: (GObject a, MonadIO m) => a -> SessionRequestUnqueuedCallback -> m SignalHandlerId
onSessionRequestUnqueued obj cb = liftIO $ connectSessionRequestUnqueued obj cb SignalConnectBefore
afterSessionRequestUnqueued :: (GObject a, MonadIO m) => a -> SessionRequestUnqueuedCallback -> m SignalHandlerId
afterSessionRequestUnqueued obj cb = connectSessionRequestUnqueued obj cb SignalConnectAfter

connectSessionRequestUnqueued :: (GObject a, MonadIO m) =>
                                 a -> SessionRequestUnqueuedCallback -> SignalConnectMode -> m SignalHandlerId
connectSessionRequestUnqueued obj cb after = liftIO $ do
    cb' <- mkSessionRequestUnqueuedCallback (sessionRequestUnqueuedCallbackWrapper cb)
    connectSignalFunPtr obj "request-unqueued" cb' after

-- signal Session::tunneling
type SessionTunnelingCallback =
    GObject.Object ->
    IO ()

noSessionTunnelingCallback :: Maybe SessionTunnelingCallback
noSessionTunnelingCallback = Nothing

type SessionTunnelingCallbackC =
    Ptr () ->                               -- object
    Ptr GObject.Object ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkSessionTunnelingCallback :: SessionTunnelingCallbackC -> IO (FunPtr SessionTunnelingCallbackC)

sessionTunnelingClosure :: SessionTunnelingCallback -> IO Closure
sessionTunnelingClosure cb = newCClosure =<< mkSessionTunnelingCallback wrapped
    where wrapped = sessionTunnelingCallbackWrapper cb

sessionTunnelingCallbackWrapper ::
    SessionTunnelingCallback ->
    Ptr () ->
    Ptr GObject.Object ->
    Ptr () ->
    IO ()
sessionTunnelingCallbackWrapper _cb _ connection _ = do
    connection' <- (newObject GObject.Object) connection
    _cb  connection'

onSessionTunneling :: (GObject a, MonadIO m) => a -> SessionTunnelingCallback -> m SignalHandlerId
onSessionTunneling obj cb = liftIO $ connectSessionTunneling obj cb SignalConnectBefore
afterSessionTunneling :: (GObject a, MonadIO m) => a -> SessionTunnelingCallback -> m SignalHandlerId
afterSessionTunneling obj cb = connectSessionTunneling obj cb SignalConnectAfter

connectSessionTunneling :: (GObject a, MonadIO m) =>
                           a -> SessionTunnelingCallback -> SignalConnectMode -> m SignalHandlerId
connectSessionTunneling obj cb after = liftIO $ do
    cb' <- mkSessionTunnelingCallback (sessionTunnelingCallbackWrapper cb)
    connectSignalFunPtr obj "tunneling" cb' after

-- VVV Prop "accept-language"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionAcceptLanguage :: (MonadIO m, SessionK o) => o -> m T.Text
getSessionAcceptLanguage obj = liftIO $ getObjectPropertyString obj "accept-language"

setSessionAcceptLanguage :: (MonadIO m, SessionK o) => o -> T.Text -> m ()
setSessionAcceptLanguage obj val = liftIO $ setObjectPropertyString obj "accept-language" val

constructSessionAcceptLanguage :: T.Text -> IO ([Char], GValue)
constructSessionAcceptLanguage val = constructObjectPropertyString "accept-language" val

data SessionAcceptLanguagePropertyInfo
instance AttrInfo SessionAcceptLanguagePropertyInfo where
    type AttrAllowedOps SessionAcceptLanguagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionAcceptLanguagePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint SessionAcceptLanguagePropertyInfo = SessionK
    type AttrGetType SessionAcceptLanguagePropertyInfo = T.Text
    type AttrLabel SessionAcceptLanguagePropertyInfo = "Session::accept-language"
    attrGet _ = getSessionAcceptLanguage
    attrSet _ = setSessionAcceptLanguage
    attrConstruct _ = constructSessionAcceptLanguage

-- VVV Prop "accept-language-auto"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionAcceptLanguageAuto :: (MonadIO m, SessionK o) => o -> m Bool
getSessionAcceptLanguageAuto obj = liftIO $ getObjectPropertyBool obj "accept-language-auto"

setSessionAcceptLanguageAuto :: (MonadIO m, SessionK o) => o -> Bool -> m ()
setSessionAcceptLanguageAuto obj val = liftIO $ setObjectPropertyBool obj "accept-language-auto" val

constructSessionAcceptLanguageAuto :: Bool -> IO ([Char], GValue)
constructSessionAcceptLanguageAuto val = constructObjectPropertyBool "accept-language-auto" val

data SessionAcceptLanguageAutoPropertyInfo
instance AttrInfo SessionAcceptLanguageAutoPropertyInfo where
    type AttrAllowedOps SessionAcceptLanguageAutoPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionAcceptLanguageAutoPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint SessionAcceptLanguageAutoPropertyInfo = SessionK
    type AttrGetType SessionAcceptLanguageAutoPropertyInfo = Bool
    type AttrLabel SessionAcceptLanguageAutoPropertyInfo = "Session::accept-language-auto"
    attrGet _ = getSessionAcceptLanguageAuto
    attrSet _ = setSessionAcceptLanguageAuto
    attrConstruct _ = constructSessionAcceptLanguageAuto

-- VVV Prop "async-context"
   -- Type: TBasicType TVoid
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getSessionAsyncContext :: (MonadIO m, SessionK o) => o -> m (Ptr ())
getSessionAsyncContext obj = liftIO $ getObjectPropertyPtr obj "async-context"

constructSessionAsyncContext :: (Ptr ()) -> IO ([Char], GValue)
constructSessionAsyncContext val = constructObjectPropertyPtr "async-context" val

data SessionAsyncContextPropertyInfo
instance AttrInfo SessionAsyncContextPropertyInfo where
    type AttrAllowedOps SessionAsyncContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionAsyncContextPropertyInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint SessionAsyncContextPropertyInfo = SessionK
    type AttrGetType SessionAsyncContextPropertyInfo = (Ptr ())
    type AttrLabel SessionAsyncContextPropertyInfo = "Session::async-context"
    attrGet _ = getSessionAsyncContext
    attrSet _ = undefined
    attrConstruct _ = constructSessionAsyncContext

-- VVV Prop "http-aliases"
   -- Type: TCArray True (-1) (-1) (TBasicType TUTF8)
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionHttpAliases :: (MonadIO m, SessionK o) => o -> m [T.Text]
getSessionHttpAliases obj = liftIO $ getObjectPropertyStringArray obj "http-aliases"

setSessionHttpAliases :: (MonadIO m, SessionK o) => o -> [T.Text] -> m ()
setSessionHttpAliases obj val = liftIO $ setObjectPropertyStringArray obj "http-aliases" val

constructSessionHttpAliases :: [T.Text] -> IO ([Char], GValue)
constructSessionHttpAliases val = constructObjectPropertyStringArray "http-aliases" val

data SessionHttpAliasesPropertyInfo
instance AttrInfo SessionHttpAliasesPropertyInfo where
    type AttrAllowedOps SessionHttpAliasesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionHttpAliasesPropertyInfo = (~) [T.Text]
    type AttrBaseTypeConstraint SessionHttpAliasesPropertyInfo = SessionK
    type AttrGetType SessionHttpAliasesPropertyInfo = [T.Text]
    type AttrLabel SessionHttpAliasesPropertyInfo = "Session::http-aliases"
    attrGet _ = getSessionHttpAliases
    attrSet _ = setSessionHttpAliases
    attrConstruct _ = constructSessionHttpAliases

-- VVV Prop "https-aliases"
   -- Type: TCArray True (-1) (-1) (TBasicType TUTF8)
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionHttpsAliases :: (MonadIO m, SessionK o) => o -> m [T.Text]
getSessionHttpsAliases obj = liftIO $ getObjectPropertyStringArray obj "https-aliases"

setSessionHttpsAliases :: (MonadIO m, SessionK o) => o -> [T.Text] -> m ()
setSessionHttpsAliases obj val = liftIO $ setObjectPropertyStringArray obj "https-aliases" val

constructSessionHttpsAliases :: [T.Text] -> IO ([Char], GValue)
constructSessionHttpsAliases val = constructObjectPropertyStringArray "https-aliases" val

data SessionHttpsAliasesPropertyInfo
instance AttrInfo SessionHttpsAliasesPropertyInfo where
    type AttrAllowedOps SessionHttpsAliasesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionHttpsAliasesPropertyInfo = (~) [T.Text]
    type AttrBaseTypeConstraint SessionHttpsAliasesPropertyInfo = SessionK
    type AttrGetType SessionHttpsAliasesPropertyInfo = [T.Text]
    type AttrLabel SessionHttpsAliasesPropertyInfo = "Session::https-aliases"
    attrGet _ = getSessionHttpsAliases
    attrSet _ = setSessionHttpsAliases
    attrConstruct _ = constructSessionHttpsAliases

-- VVV Prop "idle-timeout"
   -- Type: TBasicType TUInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionIdleTimeout :: (MonadIO m, SessionK o) => o -> m Word32
getSessionIdleTimeout obj = liftIO $ getObjectPropertyCUInt obj "idle-timeout"

setSessionIdleTimeout :: (MonadIO m, SessionK o) => o -> Word32 -> m ()
setSessionIdleTimeout obj val = liftIO $ setObjectPropertyCUInt obj "idle-timeout" val

constructSessionIdleTimeout :: Word32 -> IO ([Char], GValue)
constructSessionIdleTimeout val = constructObjectPropertyCUInt "idle-timeout" val

data SessionIdleTimeoutPropertyInfo
instance AttrInfo SessionIdleTimeoutPropertyInfo where
    type AttrAllowedOps SessionIdleTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionIdleTimeoutPropertyInfo = (~) Word32
    type AttrBaseTypeConstraint SessionIdleTimeoutPropertyInfo = SessionK
    type AttrGetType SessionIdleTimeoutPropertyInfo = Word32
    type AttrLabel SessionIdleTimeoutPropertyInfo = "Session::idle-timeout"
    attrGet _ = getSessionIdleTimeout
    attrSet _ = setSessionIdleTimeout
    attrConstruct _ = constructSessionIdleTimeout

-- VVV Prop "local-address"
   -- Type: TInterface "Soup" "Address"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getSessionLocalAddress :: (MonadIO m, SessionK o) => o -> m Address
getSessionLocalAddress obj = liftIO $ getObjectPropertyObject obj "local-address" Address

constructSessionLocalAddress :: (AddressK a) => a -> IO ([Char], GValue)
constructSessionLocalAddress val = constructObjectPropertyObject "local-address" val

data SessionLocalAddressPropertyInfo
instance AttrInfo SessionLocalAddressPropertyInfo where
    type AttrAllowedOps SessionLocalAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionLocalAddressPropertyInfo = AddressK
    type AttrBaseTypeConstraint SessionLocalAddressPropertyInfo = SessionK
    type AttrGetType SessionLocalAddressPropertyInfo = Address
    type AttrLabel SessionLocalAddressPropertyInfo = "Session::local-address"
    attrGet _ = getSessionLocalAddress
    attrSet _ = undefined
    attrConstruct _ = constructSessionLocalAddress

-- VVV Prop "max-conns"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionMaxConns :: (MonadIO m, SessionK o) => o -> m Int32
getSessionMaxConns obj = liftIO $ getObjectPropertyCInt obj "max-conns"

setSessionMaxConns :: (MonadIO m, SessionK o) => o -> Int32 -> m ()
setSessionMaxConns obj val = liftIO $ setObjectPropertyCInt obj "max-conns" val

constructSessionMaxConns :: Int32 -> IO ([Char], GValue)
constructSessionMaxConns val = constructObjectPropertyCInt "max-conns" val

data SessionMaxConnsPropertyInfo
instance AttrInfo SessionMaxConnsPropertyInfo where
    type AttrAllowedOps SessionMaxConnsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionMaxConnsPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint SessionMaxConnsPropertyInfo = SessionK
    type AttrGetType SessionMaxConnsPropertyInfo = Int32
    type AttrLabel SessionMaxConnsPropertyInfo = "Session::max-conns"
    attrGet _ = getSessionMaxConns
    attrSet _ = setSessionMaxConns
    attrConstruct _ = constructSessionMaxConns

-- VVV Prop "max-conns-per-host"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionMaxConnsPerHost :: (MonadIO m, SessionK o) => o -> m Int32
getSessionMaxConnsPerHost obj = liftIO $ getObjectPropertyCInt obj "max-conns-per-host"

setSessionMaxConnsPerHost :: (MonadIO m, SessionK o) => o -> Int32 -> m ()
setSessionMaxConnsPerHost obj val = liftIO $ setObjectPropertyCInt obj "max-conns-per-host" val

constructSessionMaxConnsPerHost :: Int32 -> IO ([Char], GValue)
constructSessionMaxConnsPerHost val = constructObjectPropertyCInt "max-conns-per-host" val

data SessionMaxConnsPerHostPropertyInfo
instance AttrInfo SessionMaxConnsPerHostPropertyInfo where
    type AttrAllowedOps SessionMaxConnsPerHostPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionMaxConnsPerHostPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint SessionMaxConnsPerHostPropertyInfo = SessionK
    type AttrGetType SessionMaxConnsPerHostPropertyInfo = Int32
    type AttrLabel SessionMaxConnsPerHostPropertyInfo = "Session::max-conns-per-host"
    attrGet _ = getSessionMaxConnsPerHost
    attrSet _ = setSessionMaxConnsPerHost
    attrConstruct _ = constructSessionMaxConnsPerHost

-- VVV Prop "proxy-resolver"
   -- Type: TInterface "Gio" "ProxyResolver"
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionProxyResolver :: (MonadIO m, SessionK o) => o -> m Gio.ProxyResolver
getSessionProxyResolver obj = liftIO $ getObjectPropertyObject obj "proxy-resolver" Gio.ProxyResolver

setSessionProxyResolver :: (MonadIO m, SessionK o, Gio.ProxyResolverK a) => o -> a -> m ()
setSessionProxyResolver obj val = liftIO $ setObjectPropertyObject obj "proxy-resolver" val

constructSessionProxyResolver :: (Gio.ProxyResolverK a) => a -> IO ([Char], GValue)
constructSessionProxyResolver val = constructObjectPropertyObject "proxy-resolver" val

data SessionProxyResolverPropertyInfo
instance AttrInfo SessionProxyResolverPropertyInfo where
    type AttrAllowedOps SessionProxyResolverPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionProxyResolverPropertyInfo = Gio.ProxyResolverK
    type AttrBaseTypeConstraint SessionProxyResolverPropertyInfo = SessionK
    type AttrGetType SessionProxyResolverPropertyInfo = Gio.ProxyResolver
    type AttrLabel SessionProxyResolverPropertyInfo = "Session::proxy-resolver"
    attrGet _ = getSessionProxyResolver
    attrSet _ = setSessionProxyResolver
    attrConstruct _ = constructSessionProxyResolver

-- VVV Prop "proxy-uri"
   -- Type: TInterface "Soup" "URI"
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionProxyUri :: (MonadIO m, SessionK o) => o -> m URI
getSessionProxyUri obj = liftIO $ getObjectPropertyBoxed obj "proxy-uri" URI

setSessionProxyUri :: (MonadIO m, SessionK o) => o -> URI -> m ()
setSessionProxyUri obj val = liftIO $ setObjectPropertyBoxed obj "proxy-uri" val

constructSessionProxyUri :: URI -> IO ([Char], GValue)
constructSessionProxyUri val = constructObjectPropertyBoxed "proxy-uri" val

data SessionProxyUriPropertyInfo
instance AttrInfo SessionProxyUriPropertyInfo where
    type AttrAllowedOps SessionProxyUriPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionProxyUriPropertyInfo = (~) URI
    type AttrBaseTypeConstraint SessionProxyUriPropertyInfo = SessionK
    type AttrGetType SessionProxyUriPropertyInfo = URI
    type AttrLabel SessionProxyUriPropertyInfo = "Session::proxy-uri"
    attrGet _ = getSessionProxyUri
    attrSet _ = setSessionProxyUri
    attrConstruct _ = constructSessionProxyUri

-- VVV Prop "ssl-ca-file"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionSslCaFile :: (MonadIO m, SessionK o) => o -> m T.Text
getSessionSslCaFile obj = liftIO $ getObjectPropertyString obj "ssl-ca-file"

setSessionSslCaFile :: (MonadIO m, SessionK o) => o -> T.Text -> m ()
setSessionSslCaFile obj val = liftIO $ setObjectPropertyString obj "ssl-ca-file" val

constructSessionSslCaFile :: T.Text -> IO ([Char], GValue)
constructSessionSslCaFile val = constructObjectPropertyString "ssl-ca-file" val

data SessionSslCaFilePropertyInfo
instance AttrInfo SessionSslCaFilePropertyInfo where
    type AttrAllowedOps SessionSslCaFilePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionSslCaFilePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint SessionSslCaFilePropertyInfo = SessionK
    type AttrGetType SessionSslCaFilePropertyInfo = T.Text
    type AttrLabel SessionSslCaFilePropertyInfo = "Session::ssl-ca-file"
    attrGet _ = getSessionSslCaFile
    attrSet _ = setSessionSslCaFile
    attrConstruct _ = constructSessionSslCaFile

-- VVV Prop "ssl-strict"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionSslStrict :: (MonadIO m, SessionK o) => o -> m Bool
getSessionSslStrict obj = liftIO $ getObjectPropertyBool obj "ssl-strict"

setSessionSslStrict :: (MonadIO m, SessionK o) => o -> Bool -> m ()
setSessionSslStrict obj val = liftIO $ setObjectPropertyBool obj "ssl-strict" val

constructSessionSslStrict :: Bool -> IO ([Char], GValue)
constructSessionSslStrict val = constructObjectPropertyBool "ssl-strict" val

data SessionSslStrictPropertyInfo
instance AttrInfo SessionSslStrictPropertyInfo where
    type AttrAllowedOps SessionSslStrictPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionSslStrictPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint SessionSslStrictPropertyInfo = SessionK
    type AttrGetType SessionSslStrictPropertyInfo = Bool
    type AttrLabel SessionSslStrictPropertyInfo = "Session::ssl-strict"
    attrGet _ = getSessionSslStrict
    attrSet _ = setSessionSslStrict
    attrConstruct _ = constructSessionSslStrict

-- VVV Prop "ssl-use-system-ca-file"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionSslUseSystemCaFile :: (MonadIO m, SessionK o) => o -> m Bool
getSessionSslUseSystemCaFile obj = liftIO $ getObjectPropertyBool obj "ssl-use-system-ca-file"

setSessionSslUseSystemCaFile :: (MonadIO m, SessionK o) => o -> Bool -> m ()
setSessionSslUseSystemCaFile obj val = liftIO $ setObjectPropertyBool obj "ssl-use-system-ca-file" val

constructSessionSslUseSystemCaFile :: Bool -> IO ([Char], GValue)
constructSessionSslUseSystemCaFile val = constructObjectPropertyBool "ssl-use-system-ca-file" val

data SessionSslUseSystemCaFilePropertyInfo
instance AttrInfo SessionSslUseSystemCaFilePropertyInfo where
    type AttrAllowedOps SessionSslUseSystemCaFilePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionSslUseSystemCaFilePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint SessionSslUseSystemCaFilePropertyInfo = SessionK
    type AttrGetType SessionSslUseSystemCaFilePropertyInfo = Bool
    type AttrLabel SessionSslUseSystemCaFilePropertyInfo = "Session::ssl-use-system-ca-file"
    attrGet _ = getSessionSslUseSystemCaFile
    attrSet _ = setSessionSslUseSystemCaFile
    attrConstruct _ = constructSessionSslUseSystemCaFile

-- VVV Prop "timeout"
   -- Type: TBasicType TUInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionTimeout :: (MonadIO m, SessionK o) => o -> m Word32
getSessionTimeout obj = liftIO $ getObjectPropertyCUInt obj "timeout"

setSessionTimeout :: (MonadIO m, SessionK o) => o -> Word32 -> m ()
setSessionTimeout obj val = liftIO $ setObjectPropertyCUInt obj "timeout" val

constructSessionTimeout :: Word32 -> IO ([Char], GValue)
constructSessionTimeout val = constructObjectPropertyCUInt "timeout" val

data SessionTimeoutPropertyInfo
instance AttrInfo SessionTimeoutPropertyInfo where
    type AttrAllowedOps SessionTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionTimeoutPropertyInfo = (~) Word32
    type AttrBaseTypeConstraint SessionTimeoutPropertyInfo = SessionK
    type AttrGetType SessionTimeoutPropertyInfo = Word32
    type AttrLabel SessionTimeoutPropertyInfo = "Session::timeout"
    attrGet _ = getSessionTimeout
    attrSet _ = setSessionTimeout
    attrConstruct _ = constructSessionTimeout

-- VVV Prop "tls-database"
   -- Type: TInterface "Gio" "TlsDatabase"
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionTlsDatabase :: (MonadIO m, SessionK o) => o -> m Gio.TlsDatabase
getSessionTlsDatabase obj = liftIO $ getObjectPropertyObject obj "tls-database" Gio.TlsDatabase

setSessionTlsDatabase :: (MonadIO m, SessionK o, Gio.TlsDatabaseK a) => o -> a -> m ()
setSessionTlsDatabase obj val = liftIO $ setObjectPropertyObject obj "tls-database" val

constructSessionTlsDatabase :: (Gio.TlsDatabaseK a) => a -> IO ([Char], GValue)
constructSessionTlsDatabase val = constructObjectPropertyObject "tls-database" val

data SessionTlsDatabasePropertyInfo
instance AttrInfo SessionTlsDatabasePropertyInfo where
    type AttrAllowedOps SessionTlsDatabasePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionTlsDatabasePropertyInfo = Gio.TlsDatabaseK
    type AttrBaseTypeConstraint SessionTlsDatabasePropertyInfo = SessionK
    type AttrGetType SessionTlsDatabasePropertyInfo = Gio.TlsDatabase
    type AttrLabel SessionTlsDatabasePropertyInfo = "Session::tls-database"
    attrGet _ = getSessionTlsDatabase
    attrSet _ = setSessionTlsDatabase
    attrConstruct _ = constructSessionTlsDatabase

-- VVV Prop "tls-interaction"
   -- Type: TInterface "Gio" "TlsInteraction"
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionTlsInteraction :: (MonadIO m, SessionK o) => o -> m Gio.TlsInteraction
getSessionTlsInteraction obj = liftIO $ getObjectPropertyObject obj "tls-interaction" Gio.TlsInteraction

setSessionTlsInteraction :: (MonadIO m, SessionK o, Gio.TlsInteractionK a) => o -> a -> m ()
setSessionTlsInteraction obj val = liftIO $ setObjectPropertyObject obj "tls-interaction" val

constructSessionTlsInteraction :: (Gio.TlsInteractionK a) => a -> IO ([Char], GValue)
constructSessionTlsInteraction val = constructObjectPropertyObject "tls-interaction" val

data SessionTlsInteractionPropertyInfo
instance AttrInfo SessionTlsInteractionPropertyInfo where
    type AttrAllowedOps SessionTlsInteractionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionTlsInteractionPropertyInfo = Gio.TlsInteractionK
    type AttrBaseTypeConstraint SessionTlsInteractionPropertyInfo = SessionK
    type AttrGetType SessionTlsInteractionPropertyInfo = Gio.TlsInteraction
    type AttrLabel SessionTlsInteractionPropertyInfo = "Session::tls-interaction"
    attrGet _ = getSessionTlsInteraction
    attrSet _ = setSessionTlsInteraction
    attrConstruct _ = constructSessionTlsInteraction

-- VVV Prop "use-ntlm"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionUseNtlm :: (MonadIO m, SessionK o) => o -> m Bool
getSessionUseNtlm obj = liftIO $ getObjectPropertyBool obj "use-ntlm"

setSessionUseNtlm :: (MonadIO m, SessionK o) => o -> Bool -> m ()
setSessionUseNtlm obj val = liftIO $ setObjectPropertyBool obj "use-ntlm" val

constructSessionUseNtlm :: Bool -> IO ([Char], GValue)
constructSessionUseNtlm val = constructObjectPropertyBool "use-ntlm" val

data SessionUseNtlmPropertyInfo
instance AttrInfo SessionUseNtlmPropertyInfo where
    type AttrAllowedOps SessionUseNtlmPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionUseNtlmPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint SessionUseNtlmPropertyInfo = SessionK
    type AttrGetType SessionUseNtlmPropertyInfo = Bool
    type AttrLabel SessionUseNtlmPropertyInfo = "Session::use-ntlm"
    attrGet _ = getSessionUseNtlm
    attrSet _ = setSessionUseNtlm
    attrConstruct _ = constructSessionUseNtlm

-- VVV Prop "use-thread-context"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionUseThreadContext :: (MonadIO m, SessionK o) => o -> m Bool
getSessionUseThreadContext obj = liftIO $ getObjectPropertyBool obj "use-thread-context"

setSessionUseThreadContext :: (MonadIO m, SessionK o) => o -> Bool -> m ()
setSessionUseThreadContext obj val = liftIO $ setObjectPropertyBool obj "use-thread-context" val

constructSessionUseThreadContext :: Bool -> IO ([Char], GValue)
constructSessionUseThreadContext val = constructObjectPropertyBool "use-thread-context" val

data SessionUseThreadContextPropertyInfo
instance AttrInfo SessionUseThreadContextPropertyInfo where
    type AttrAllowedOps SessionUseThreadContextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionUseThreadContextPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint SessionUseThreadContextPropertyInfo = SessionK
    type AttrGetType SessionUseThreadContextPropertyInfo = Bool
    type AttrLabel SessionUseThreadContextPropertyInfo = "Session::use-thread-context"
    attrGet _ = getSessionUseThreadContext
    attrSet _ = setSessionUseThreadContext
    attrConstruct _ = constructSessionUseThreadContext

-- VVV Prop "user-agent"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getSessionUserAgent :: (MonadIO m, SessionK o) => o -> m T.Text
getSessionUserAgent obj = liftIO $ getObjectPropertyString obj "user-agent"

setSessionUserAgent :: (MonadIO m, SessionK o) => o -> T.Text -> m ()
setSessionUserAgent obj val = liftIO $ setObjectPropertyString obj "user-agent" val

constructSessionUserAgent :: T.Text -> IO ([Char], GValue)
constructSessionUserAgent val = constructObjectPropertyString "user-agent" val

data SessionUserAgentPropertyInfo
instance AttrInfo SessionUserAgentPropertyInfo where
    type AttrAllowedOps SessionUserAgentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SessionUserAgentPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint SessionUserAgentPropertyInfo = SessionK
    type AttrGetType SessionUserAgentPropertyInfo = T.Text
    type AttrLabel SessionUserAgentPropertyInfo = "Session::user-agent"
    attrGet _ = getSessionUserAgent
    attrSet _ = setSessionUserAgent
    attrConstruct _ = constructSessionUserAgent

type instance AttributeList Session = SessionAttributeList
type SessionAttributeList = ('[ '("accept-language", SessionAcceptLanguagePropertyInfo), '("accept-language-auto", SessionAcceptLanguageAutoPropertyInfo), '("async-context", SessionAsyncContextPropertyInfo), '("http-aliases", SessionHttpAliasesPropertyInfo), '("https-aliases", SessionHttpsAliasesPropertyInfo), '("idle-timeout", SessionIdleTimeoutPropertyInfo), '("local-address", SessionLocalAddressPropertyInfo), '("max-conns", SessionMaxConnsPropertyInfo), '("max-conns-per-host", SessionMaxConnsPerHostPropertyInfo), '("proxy-resolver", SessionProxyResolverPropertyInfo), '("proxy-uri", SessionProxyUriPropertyInfo), '("ssl-ca-file", SessionSslCaFilePropertyInfo), '("ssl-strict", SessionSslStrictPropertyInfo), '("ssl-use-system-ca-file", SessionSslUseSystemCaFilePropertyInfo), '("timeout", SessionTimeoutPropertyInfo), '("tls-database", SessionTlsDatabasePropertyInfo), '("tls-interaction", SessionTlsInteractionPropertyInfo), '("use-ntlm", SessionUseNtlmPropertyInfo), '("use-thread-context", SessionUseThreadContextPropertyInfo), '("user-agent", SessionUserAgentPropertyInfo)] :: [(Symbol, *)])

data SessionAuthenticateSignalInfo
instance SignalInfo SessionAuthenticateSignalInfo where
    type HaskellCallbackType SessionAuthenticateSignalInfo = SessionAuthenticateCallback
    connectSignal _ = connectSessionAuthenticate

data SessionConnectionCreatedSignalInfo
instance SignalInfo SessionConnectionCreatedSignalInfo where
    type HaskellCallbackType SessionConnectionCreatedSignalInfo = SessionConnectionCreatedCallback
    connectSignal _ = connectSessionConnectionCreated

data SessionRequestQueuedSignalInfo
instance SignalInfo SessionRequestQueuedSignalInfo where
    type HaskellCallbackType SessionRequestQueuedSignalInfo = SessionRequestQueuedCallback
    connectSignal _ = connectSessionRequestQueued

data SessionRequestStartedSignalInfo
instance SignalInfo SessionRequestStartedSignalInfo where
    type HaskellCallbackType SessionRequestStartedSignalInfo = SessionRequestStartedCallback
    connectSignal _ = connectSessionRequestStarted

data SessionRequestUnqueuedSignalInfo
instance SignalInfo SessionRequestUnqueuedSignalInfo where
    type HaskellCallbackType SessionRequestUnqueuedSignalInfo = SessionRequestUnqueuedCallback
    connectSignal _ = connectSessionRequestUnqueued

data SessionTunnelingSignalInfo
instance SignalInfo SessionTunnelingSignalInfo where
    type HaskellCallbackType SessionTunnelingSignalInfo = SessionTunnelingCallback
    connectSignal _ = connectSessionTunneling

type instance SignalList Session = SessionSignalList
type SessionSignalList = ('[ '("authenticate", SessionAuthenticateSignalInfo), '("connection-created", SessionConnectionCreatedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("request-queued", SessionRequestQueuedSignalInfo), '("request-started", SessionRequestStartedSignalInfo), '("request-unqueued", SessionRequestUnqueuedSignalInfo), '("tunneling", SessionTunnelingSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method Session::new
-- method type : Constructor
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "Soup" "Session"
-- throws : False
-- Skip return : False

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


sessionNew ::
    (MonadIO m) =>
    m Session
sessionNew  = liftIO $ do
    result <- soup_session_new
    checkUnexpectedReturnNULL "soup_session_new" result
    result' <- (wrapObject Session) result
    return result'

-- method Session::abort
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_abort" soup_session_abort :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    IO ()


sessionAbort ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    m ()
sessionAbort _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    soup_session_abort _obj'
    touchManagedPtr _obj
    return ()

-- method Session::add_feature
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature", argType = TInterface "Soup" "SessionFeature", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature", argType = TInterface "Soup" "SessionFeature", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_add_feature" soup_session_add_feature :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr SessionFeature ->                   -- feature : TInterface "Soup" "SessionFeature"
    IO ()


sessionAddFeature ::
    (MonadIO m, SessionK a, SessionFeatureK b) =>
    a ->                                    -- _obj
    b ->                                    -- feature
    m ()
sessionAddFeature _obj feature = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let feature' = unsafeManagedPtrCastPtr feature
    soup_session_add_feature _obj' feature'
    touchManagedPtr _obj
    touchManagedPtr feature
    return ()

-- method Session::add_feature_by_type
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_add_feature_by_type" soup_session_add_feature_by_type :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    CGType ->                               -- feature_type : TBasicType TGType
    IO ()


sessionAddFeatureByType ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    GType ->                                -- feature_type
    m ()
sessionAddFeatureByType _obj feature_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let feature_type' = gtypeToCGType feature_type
    soup_session_add_feature_by_type _obj' feature_type'
    touchManagedPtr _obj
    return ()

-- method Session::cancel_message
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "status_code", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "status_code", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_cancel_message" soup_session_cancel_message :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    Word32 ->                               -- status_code : TBasicType TUInt32
    IO ()


sessionCancelMessage ::
    (MonadIO m, SessionK a, MessageK b) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    Word32 ->                               -- status_code
    m ()
sessionCancelMessage _obj msg status_code = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    soup_session_cancel_message _obj' msg' status_code
    touchManagedPtr _obj
    touchManagedPtr msg
    return ()

-- method Session::get_async_context
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "MainContext"
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_async_context" soup_session_get_async_context :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    IO (Ptr GLib.MainContext)


sessionGetAsyncContext ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    m GLib.MainContext
sessionGetAsyncContext _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- soup_session_get_async_context _obj'
    checkUnexpectedReturnNULL "soup_session_get_async_context" result
    result' <- (newBoxed GLib.MainContext) result
    touchManagedPtr _obj
    return result'

-- method Session::get_feature
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Soup" "SessionFeature"
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_feature" soup_session_get_feature :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    CGType ->                               -- feature_type : TBasicType TGType
    IO (Ptr SessionFeature)


sessionGetFeature ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    GType ->                                -- feature_type
    m SessionFeature
sessionGetFeature _obj feature_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let feature_type' = gtypeToCGType feature_type
    result <- soup_session_get_feature _obj' feature_type'
    checkUnexpectedReturnNULL "soup_session_get_feature" result
    result' <- (newObject SessionFeature) result
    touchManagedPtr _obj
    return result'

-- method Session::get_feature_for_message
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Soup" "SessionFeature"
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_feature_for_message" soup_session_get_feature_for_message :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    CGType ->                               -- feature_type : TBasicType TGType
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    IO (Ptr SessionFeature)


sessionGetFeatureForMessage ::
    (MonadIO m, SessionK a, MessageK b) =>
    a ->                                    -- _obj
    GType ->                                -- feature_type
    b ->                                    -- msg
    m SessionFeature
sessionGetFeatureForMessage _obj feature_type msg = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let feature_type' = gtypeToCGType feature_type
    let msg' = unsafeManagedPtrCastPtr msg
    result <- soup_session_get_feature_for_message _obj' feature_type' msg'
    checkUnexpectedReturnNULL "soup_session_get_feature_for_message" result
    result' <- (newObject SessionFeature) result
    touchManagedPtr _obj
    touchManagedPtr msg
    return result'

-- method Session::get_features
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGSList (TInterface "Soup" "SessionFeature")
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_get_features" soup_session_get_features :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    CGType ->                               -- feature_type : TBasicType TGType
    IO (Ptr (GSList (Ptr SessionFeature)))


sessionGetFeatures ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    GType ->                                -- feature_type
    m [SessionFeature]
sessionGetFeatures _obj feature_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let feature_type' = gtypeToCGType feature_type
    result <- soup_session_get_features _obj' feature_type'
    checkUnexpectedReturnNULL "soup_session_get_features" result
    result' <- unpackGSList result
    result'' <- mapM (newObject SessionFeature) result'
    g_slist_free result
    touchManagedPtr _obj
    return result''

-- method Session::has_feature
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_has_feature" soup_session_has_feature :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    CGType ->                               -- feature_type : TBasicType TGType
    IO CInt


sessionHasFeature ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    GType ->                                -- feature_type
    m Bool
sessionHasFeature _obj feature_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let feature_type' = gtypeToCGType feature_type
    result <- soup_session_has_feature _obj' feature_type'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Session::pause_message
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_pause_message" soup_session_pause_message :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    IO ()


sessionPauseMessage ::
    (MonadIO m, SessionK a, MessageK b) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    m ()
sessionPauseMessage _obj msg = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    soup_session_pause_message _obj' msg'
    touchManagedPtr _obj
    touchManagedPtr msg
    return ()

-- method Session::prefetch_dns
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Soup" "AddressCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Soup" "AddressCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_prefetch_dns" soup_session_prefetch_dns :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    CString ->                              -- hostname : TBasicType TUTF8
    Ptr Gio.Cancellable ->                  -- cancellable : TInterface "Gio" "Cancellable"
    FunPtr AddressCallbackC ->              -- callback : TInterface "Soup" "AddressCallback"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


sessionPrefetchDns ::
    (MonadIO m, SessionK a, Gio.CancellableK b) =>
    a ->                                    -- _obj
    T.Text ->                               -- hostname
    Maybe (b) ->                            -- cancellable
    Maybe (AddressCallback) ->              -- callback
    m ()
sessionPrefetchDns _obj hostname cancellable callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    hostname' <- textToCString hostname
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    ptrcallback <- callocMem :: IO (Ptr (FunPtr AddressCallbackC))
    maybeCallback <- case callback of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jCallback -> do
            jCallback' <- mkAddressCallback (addressCallbackWrapper (Just ptrcallback) jCallback)
            poke ptrcallback jCallback'
            return jCallback'
    let user_data = nullPtr
    soup_session_prefetch_dns _obj' hostname' maybeCancellable maybeCallback user_data
    touchManagedPtr _obj
    whenJust cancellable touchManagedPtr
    freeMem hostname'
    return ()

-- method Session::prepare_for_uri
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TInterface "Soup" "URI", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TInterface "Soup" "URI", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_prepare_for_uri" soup_session_prepare_for_uri :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr URI ->                              -- uri : TInterface "Soup" "URI"
    IO ()

{-# DEPRECATED sessionPrepareForUri ["(Since version 2.38)","use soup_session_prefetch_dns() instead"]#-}
sessionPrepareForUri ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    URI ->                                  -- uri
    m ()
sessionPrepareForUri _obj uri = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let uri' = unsafeManagedPtrGetPtr uri
    soup_session_prepare_for_uri _obj' uri'
    touchManagedPtr _obj
    touchManagedPtr uri
    return ()

-- method Session::queue_message
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "callback", argType = TInterface "Soup" "SessionCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "callback", argType = TInterface "Soup" "SessionCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_queue_message" soup_session_queue_message :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    FunPtr SessionCallbackC ->              -- callback : TInterface "Soup" "SessionCallback"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


sessionQueueMessage ::
    (MonadIO m, SessionK a, MessageK b) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    Maybe (SessionCallback) ->              -- callback
    m ()
sessionQueueMessage _obj msg callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    msg' <- refObject msg
    ptrcallback <- callocMem :: IO (Ptr (FunPtr SessionCallbackC))
    maybeCallback <- case callback of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jCallback -> do
            jCallback' <- mkSessionCallback (sessionCallbackWrapper (Just ptrcallback) jCallback)
            poke ptrcallback jCallback'
            return jCallback'
    let user_data = nullPtr
    soup_session_queue_message _obj' msg' maybeCallback user_data
    touchManagedPtr _obj
    touchManagedPtr msg
    return ()

-- method Session::redirect_message
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_redirect_message" soup_session_redirect_message :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    IO CInt


sessionRedirectMessage ::
    (MonadIO m, SessionK a, MessageK b) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    m Bool
sessionRedirectMessage _obj msg = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    result <- soup_session_redirect_message _obj' msg'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr msg
    return result'

-- method Session::remove_feature
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature", argType = TInterface "Soup" "SessionFeature", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature", argType = TInterface "Soup" "SessionFeature", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_remove_feature" soup_session_remove_feature :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr SessionFeature ->                   -- feature : TInterface "Soup" "SessionFeature"
    IO ()


sessionRemoveFeature ::
    (MonadIO m, SessionK a, SessionFeatureK b) =>
    a ->                                    -- _obj
    b ->                                    -- feature
    m ()
sessionRemoveFeature _obj feature = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let feature' = unsafeManagedPtrCastPtr feature
    soup_session_remove_feature _obj' feature'
    touchManagedPtr _obj
    touchManagedPtr feature
    return ()

-- method Session::remove_feature_by_type
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "feature_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_remove_feature_by_type" soup_session_remove_feature_by_type :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    CGType ->                               -- feature_type : TBasicType TGType
    IO ()


sessionRemoveFeatureByType ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    GType ->                                -- feature_type
    m ()
sessionRemoveFeatureByType _obj feature_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let feature_type' = gtypeToCGType feature_type
    soup_session_remove_feature_by_type _obj' feature_type'
    touchManagedPtr _obj
    return ()

-- method Session::request
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Soup" "Request"
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_request" soup_session_request :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    CString ->                              -- uri_string : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Request)


sessionRequest ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- uri_string
    m Request
sessionRequest _obj uri_string = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    uri_string' <- textToCString uri_string
    onException (do
        result <- propagateGError $ soup_session_request _obj' uri_string'
        checkUnexpectedReturnNULL "soup_session_request" result
        result' <- (wrapObject Request) result
        touchManagedPtr _obj
        freeMem uri_string'
        return result'
     ) (do
        freeMem uri_string'
     )

-- method Session::request_http
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Soup" "RequestHTTP"
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_request_http" soup_session_request_http :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    CString ->                              -- method : TBasicType TUTF8
    CString ->                              -- uri_string : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr RequestHTTP)


sessionRequestHttp ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- method
    T.Text ->                               -- uri_string
    m RequestHTTP
sessionRequestHttp _obj method uri_string = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    method' <- textToCString method
    uri_string' <- textToCString uri_string
    onException (do
        result <- propagateGError $ soup_session_request_http _obj' method' uri_string'
        checkUnexpectedReturnNULL "soup_session_request_http" result
        result' <- (wrapObject RequestHTTP) result
        touchManagedPtr _obj
        freeMem method'
        freeMem uri_string'
        return result'
     ) (do
        freeMem method'
        freeMem uri_string'
     )

-- method Session::request_http_uri
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TInterface "Soup" "URI", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TInterface "Soup" "URI", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Soup" "RequestHTTP"
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_request_http_uri" soup_session_request_http_uri :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    CString ->                              -- method : TBasicType TUTF8
    Ptr URI ->                              -- uri : TInterface "Soup" "URI"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr RequestHTTP)


sessionRequestHttpUri ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- method
    URI ->                                  -- uri
    m RequestHTTP
sessionRequestHttpUri _obj method uri = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    method' <- textToCString method
    let uri' = unsafeManagedPtrGetPtr uri
    onException (do
        result <- propagateGError $ soup_session_request_http_uri _obj' method' uri'
        checkUnexpectedReturnNULL "soup_session_request_http_uri" result
        result' <- (wrapObject RequestHTTP) result
        touchManagedPtr _obj
        touchManagedPtr uri
        freeMem method'
        return result'
     ) (do
        freeMem method'
     )

-- method Session::request_uri
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TInterface "Soup" "URI", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TInterface "Soup" "URI", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Soup" "Request"
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_request_uri" soup_session_request_uri :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr URI ->                              -- uri : TInterface "Soup" "URI"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Request)


sessionRequestUri ::
    (MonadIO m, SessionK a) =>
    a ->                                    -- _obj
    URI ->                                  -- uri
    m Request
sessionRequestUri _obj uri = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let uri' = unsafeManagedPtrGetPtr uri
    onException (do
        result <- propagateGError $ soup_session_request_uri _obj' uri'
        checkUnexpectedReturnNULL "soup_session_request_uri" result
        result' <- (wrapObject Request) result
        touchManagedPtr _obj
        touchManagedPtr uri
        return result'
     ) (do
        return ()
     )

-- method Session::requeue_message
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_requeue_message" soup_session_requeue_message :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    IO ()


sessionRequeueMessage ::
    (MonadIO m, SessionK a, MessageK b) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    m ()
sessionRequeueMessage _obj msg = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    soup_session_requeue_message _obj' msg'
    touchManagedPtr _obj
    touchManagedPtr msg
    return ()

-- method Session::send
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "InputStream"
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_send" soup_session_send :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    Ptr Gio.Cancellable ->                  -- cancellable : TInterface "Gio" "Cancellable"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.InputStream)


sessionSend ::
    (MonadIO m, SessionK a, MessageK b, Gio.CancellableK c) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    Maybe (c) ->                            -- cancellable
    m Gio.InputStream
sessionSend _obj msg cancellable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ soup_session_send _obj' msg' maybeCancellable
        checkUnexpectedReturnNULL "soup_session_send" result
        result' <- (wrapObject Gio.InputStream) result
        touchManagedPtr _obj
        touchManagedPtr msg
        whenJust cancellable touchManagedPtr
        return result'
     ) (do
        return ()
     )

-- method Session::send_async
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_send_async" soup_session_send_async :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    Ptr Gio.Cancellable ->                  -- cancellable : TInterface "Gio" "Cancellable"
    FunPtr Gio.AsyncReadyCallbackC ->       -- callback : TInterface "Gio" "AsyncReadyCallback"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


sessionSendAsync ::
    (MonadIO m, SessionK a, MessageK b, Gio.CancellableK c) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    Maybe (c) ->                            -- cancellable
    Maybe (Gio.AsyncReadyCallback) ->       -- callback
    m ()
sessionSendAsync _obj msg cancellable callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    ptrcallback <- callocMem :: IO (Ptr (FunPtr Gio.AsyncReadyCallbackC))
    maybeCallback <- case callback of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jCallback -> do
            jCallback' <- Gio.mkAsyncReadyCallback (Gio.asyncReadyCallbackWrapper (Just ptrcallback) jCallback)
            poke ptrcallback jCallback'
            return jCallback'
    let user_data = nullPtr
    soup_session_send_async _obj' msg' maybeCancellable maybeCallback user_data
    touchManagedPtr _obj
    touchManagedPtr msg
    whenJust cancellable touchManagedPtr
    return ()

-- method Session::send_finish
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "InputStream"
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_send_finish" soup_session_send_finish :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Gio.AsyncResult ->                  -- result : TInterface "Gio" "AsyncResult"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.InputStream)


sessionSendFinish ::
    (MonadIO m, SessionK a, Gio.AsyncResultK b) =>
    a ->                                    -- _obj
    b ->                                    -- result
    m Gio.InputStream
sessionSendFinish _obj result_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let result_' = unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ soup_session_send_finish _obj' result_'
        checkUnexpectedReturnNULL "soup_session_send_finish" result
        result' <- (wrapObject Gio.InputStream) result
        touchManagedPtr _obj
        touchManagedPtr result_
        return result'
     ) (do
        return ()
     )

-- method Session::send_message
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUInt32
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_send_message" soup_session_send_message :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    IO Word32


sessionSendMessage ::
    (MonadIO m, SessionK a, MessageK b) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    m Word32
sessionSendMessage _obj msg = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    result <- soup_session_send_message _obj' msg'
    touchManagedPtr _obj
    touchManagedPtr msg
    return result

-- method Session::steal_connection
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "IOStream"
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_steal_connection" soup_session_steal_connection :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    IO (Ptr Gio.IOStream)


sessionStealConnection ::
    (MonadIO m, SessionK a, MessageK b) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    m Gio.IOStream
sessionStealConnection _obj msg = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    result <- soup_session_steal_connection _obj' msg'
    checkUnexpectedReturnNULL "soup_session_steal_connection" result
    result' <- (wrapObject Gio.IOStream) result
    touchManagedPtr _obj
    touchManagedPtr msg
    return result'

-- method Session::unpause_message
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_unpause_message" soup_session_unpause_message :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    IO ()


sessionUnpauseMessage ::
    (MonadIO m, SessionK a, MessageK b) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    m ()
sessionUnpauseMessage _obj msg = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    soup_session_unpause_message _obj' msg'
    touchManagedPtr _obj
    touchManagedPtr msg
    return ()

-- method Session::websocket_connect_async
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "origin", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocols", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "origin", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocols", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_websocket_connect_async" soup_session_websocket_connect_async :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    CString ->                              -- origin : TBasicType TUTF8
    Ptr CString ->                          -- protocols : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr Gio.Cancellable ->                  -- cancellable : TInterface "Gio" "Cancellable"
    FunPtr Gio.AsyncReadyCallbackC ->       -- callback : TInterface "Gio" "AsyncReadyCallback"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


sessionWebsocketConnectAsync ::
    (MonadIO m, SessionK a, MessageK b, Gio.CancellableK c) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    Maybe (T.Text) ->                       -- origin
    Maybe ([T.Text]) ->                     -- protocols
    Maybe (c) ->                            -- cancellable
    Maybe (Gio.AsyncReadyCallback) ->       -- callback
    m ()
sessionWebsocketConnectAsync _obj msg origin protocols cancellable callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    maybeOrigin <- case origin of
        Nothing -> return nullPtr
        Just jOrigin -> do
            jOrigin' <- textToCString jOrigin
            return jOrigin'
    maybeProtocols <- case protocols of
        Nothing -> return nullPtr
        Just jProtocols -> do
            jProtocols' <- packZeroTerminatedUTF8CArray jProtocols
            return jProtocols'
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    ptrcallback <- callocMem :: IO (Ptr (FunPtr Gio.AsyncReadyCallbackC))
    maybeCallback <- case callback of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jCallback -> do
            jCallback' <- Gio.mkAsyncReadyCallback (Gio.asyncReadyCallbackWrapper (Just ptrcallback) jCallback)
            poke ptrcallback jCallback'
            return jCallback'
    let user_data = nullPtr
    soup_session_websocket_connect_async _obj' msg' maybeOrigin maybeProtocols maybeCancellable maybeCallback user_data
    touchManagedPtr _obj
    touchManagedPtr msg
    whenJust cancellable touchManagedPtr
    freeMem maybeOrigin
    mapZeroTerminatedCArray freeMem maybeProtocols
    freeMem maybeProtocols
    return ()

-- method Session::websocket_connect_finish
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Soup" "WebsocketConnection"
-- throws : True
-- Skip return : False

foreign import ccall "soup_session_websocket_connect_finish" soup_session_websocket_connect_finish :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Gio.AsyncResult ->                  -- result : TInterface "Gio" "AsyncResult"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr WebsocketConnection)


sessionWebsocketConnectFinish ::
    (MonadIO m, SessionK a, Gio.AsyncResultK b) =>
    a ->                                    -- _obj
    b ->                                    -- result
    m WebsocketConnection
sessionWebsocketConnectFinish _obj result_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let result_' = unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ soup_session_websocket_connect_finish _obj' result_'
        checkUnexpectedReturnNULL "soup_session_websocket_connect_finish" result
        result' <- (wrapObject WebsocketConnection) result
        touchManagedPtr _obj
        touchManagedPtr result_
        return result'
     ) (do
        return ()
     )

-- method Session::would_redirect
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "Session", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msg", argType = TInterface "Soup" "Message", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_would_redirect" soup_session_would_redirect :: 
    Ptr Session ->                          -- _obj : TInterface "Soup" "Session"
    Ptr Message ->                          -- msg : TInterface "Soup" "Message"
    IO CInt


sessionWouldRedirect ::
    (MonadIO m, SessionK a, MessageK b) =>
    a ->                                    -- _obj
    b ->                                    -- msg
    m Bool
sessionWouldRedirect _obj msg = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let msg' = unsafeManagedPtrCastPtr msg
    result <- soup_session_would_redirect _obj' msg'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr msg
    return result'