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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents an HTTP message being sent or received.
-- 
-- /@statusCode@/ will normally be a t'GI.Soup.Enums.Status' value, eg,
-- 'GI.Soup.Enums.StatusOk', though of course it might actually be an unknown
-- status code. /@reasonPhrase@/ is the actual text returned from the
-- server, which may or may not correspond to the \"standard\"
-- description of /@statusCode@/. At any rate, it is almost certainly
-- not localized, and not very descriptive even if it is in the user\'s
-- language; you should not use /@reasonPhrase@/ in user-visible
-- messages. Rather, you should look at /@statusCode@/, and determine an
-- end-user-appropriate message based on that and on what you were
-- trying to do.
-- 
-- As described in the t'GI.Soup.Structs.MessageBody.MessageBody' documentation, the
-- /@requestBody@/ and /@responseBody@/ \<literal>data\<\/literal> fields
-- will not necessarily be filled in at all times. When the body
-- fields are filled in, they will be terminated with a \'\\0\' byte
-- (which is not included in the \<literal>length\<\/literal>), so you
-- can use them as ordinary C strings (assuming that you know that the
-- body doesn\'t have any other \'\\0\' bytes).
-- 
-- For a client-side t'GI.Soup.Objects.Message.Message', /@requestBody@/\'s
-- \<literal>data\<\/literal> is usually filled in right before libsoup
-- writes the request to the network, but you should not count on
-- this; use 'GI.Soup.Structs.MessageBody.messageBodyFlatten' if you want to ensure that
-- \<literal>data\<\/literal> is filled in. If you are not using
-- t'GI.Soup.Objects.Request.Request' to read the response, then /@responseBody@/\'s
-- \<literal>data\<\/literal> will be filled in before
-- [Message::finished]("GI.Soup.Objects.Message#g:signal:finished") is emitted. (If you are using t'GI.Soup.Objects.Request.Request',
-- then the message body is not accumulated by default, so
-- /@responseBody@/\'s \<literal>data\<\/literal> will always be 'P.Nothing'.)
-- 
-- For a server-side t'GI.Soup.Objects.Message.Message', /@requestBody@/\'s @/data/@ will be
-- filled in before t'GI.Soup.Objects.Message.Message'::@/got_body/@ is emitted.
-- 
-- To prevent the @/data/@ field from being filled in at all (eg, if you
-- are handling the data from a t'GI.Soup.Objects.Message.Message'::@/got_chunk/@, and so don\'t
-- need to see it all at the end), call
-- 'GI.Soup.Structs.MessageBody.messageBodySetAccumulate' on /@responseBody@/ or
-- /@requestBody@/ as appropriate, passing 'P.False'.

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

module GI.Soup.Objects.Message
    ( 

-- * Exported types
    Message(..)                             ,
    IsMessage                               ,
    toMessage                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [contentSniffed]("GI.Soup.Objects.Message#g:method:contentSniffed"), [disableFeature]("GI.Soup.Objects.Message#g:method:disableFeature"), [finished]("GI.Soup.Objects.Message#g:method:finished"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [gotBody]("GI.Soup.Objects.Message#g:method:gotBody"), [gotChunk]("GI.Soup.Objects.Message#g:method:gotChunk"), [gotHeaders]("GI.Soup.Objects.Message#g:method:gotHeaders"), [gotInformational]("GI.Soup.Objects.Message#g:method:gotInformational"), [isFeatureDisabled]("GI.Soup.Objects.Message#g:method:isFeatureDisabled"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isKeepalive]("GI.Soup.Objects.Message#g:method:isKeepalive"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [restarted]("GI.Soup.Objects.Message#g:method:restarted"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [starting]("GI.Soup.Objects.Message#g:method:starting"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure"), [wroteBody]("GI.Soup.Objects.Message#g:method:wroteBody"), [wroteBodyData]("GI.Soup.Objects.Message#g:method:wroteBodyData"), [wroteChunk]("GI.Soup.Objects.Message#g:method:wroteChunk"), [wroteHeaders]("GI.Soup.Objects.Message#g:method:wroteHeaders"), [wroteInformational]("GI.Soup.Objects.Message#g:method:wroteInformational").
-- 
-- ==== Getters
-- [getAddress]("GI.Soup.Objects.Message#g:method:getAddress"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFirstParty]("GI.Soup.Objects.Message#g:method:getFirstParty"), [getFlags]("GI.Soup.Objects.Message#g:method:getFlags"), [getHttpVersion]("GI.Soup.Objects.Message#g:method:getHttpVersion"), [getHttpsStatus]("GI.Soup.Objects.Message#g:method:getHttpsStatus"), [getIsTopLevelNavigation]("GI.Soup.Objects.Message#g:method:getIsTopLevelNavigation"), [getPriority]("GI.Soup.Objects.Message#g:method:getPriority"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSiteForCookies]("GI.Soup.Objects.Message#g:method:getSiteForCookies"), [getSoupRequest]("GI.Soup.Objects.Message#g:method:getSoupRequest"), [getUri]("GI.Soup.Objects.Message#g:method:getUri").
-- 
-- ==== Setters
-- [setChunkAllocator]("GI.Soup.Objects.Message#g:method:setChunkAllocator"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFirstParty]("GI.Soup.Objects.Message#g:method:setFirstParty"), [setFlags]("GI.Soup.Objects.Message#g:method:setFlags"), [setHttpVersion]("GI.Soup.Objects.Message#g:method:setHttpVersion"), [setIsTopLevelNavigation]("GI.Soup.Objects.Message#g:method:setIsTopLevelNavigation"), [setPriority]("GI.Soup.Objects.Message#g:method:setPriority"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRedirect]("GI.Soup.Objects.Message#g:method:setRedirect"), [setRequest]("GI.Soup.Objects.Message#g:method:setRequest"), [setResponse]("GI.Soup.Objects.Message#g:method:setResponse"), [setSiteForCookies]("GI.Soup.Objects.Message#g:method:setSiteForCookies"), [setStatus]("GI.Soup.Objects.Message#g:method:setStatus"), [setStatusFull]("GI.Soup.Objects.Message#g:method:setStatusFull"), [setUri]("GI.Soup.Objects.Message#g:method:setUri").

#if defined(ENABLE_OVERLOADING)
    ResolveMessageMethod                    ,
#endif

-- ** contentSniffed #method:contentSniffed#

#if defined(ENABLE_OVERLOADING)
    MessageContentSniffedMethodInfo         ,
#endif
    messageContentSniffed                   ,


-- ** disableFeature #method:disableFeature#

#if defined(ENABLE_OVERLOADING)
    MessageDisableFeatureMethodInfo         ,
#endif
    messageDisableFeature                   ,


-- ** finished #method:finished#

#if defined(ENABLE_OVERLOADING)
    MessageFinishedMethodInfo               ,
#endif
    messageFinished                         ,


-- ** getAddress #method:getAddress#

#if defined(ENABLE_OVERLOADING)
    MessageGetAddressMethodInfo             ,
#endif
    messageGetAddress                       ,


-- ** getFirstParty #method:getFirstParty#

#if defined(ENABLE_OVERLOADING)
    MessageGetFirstPartyMethodInfo          ,
#endif
    messageGetFirstParty                    ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    MessageGetFlagsMethodInfo               ,
#endif
    messageGetFlags                         ,


-- ** getHttpVersion #method:getHttpVersion#

#if defined(ENABLE_OVERLOADING)
    MessageGetHttpVersionMethodInfo         ,
#endif
    messageGetHttpVersion                   ,


-- ** getHttpsStatus #method:getHttpsStatus#

#if defined(ENABLE_OVERLOADING)
    MessageGetHttpsStatusMethodInfo         ,
#endif
    messageGetHttpsStatus                   ,


-- ** getIsTopLevelNavigation #method:getIsTopLevelNavigation#

#if defined(ENABLE_OVERLOADING)
    MessageGetIsTopLevelNavigationMethodInfo,
#endif
    messageGetIsTopLevelNavigation          ,


-- ** getPriority #method:getPriority#

#if defined(ENABLE_OVERLOADING)
    MessageGetPriorityMethodInfo            ,
#endif
    messageGetPriority                      ,


-- ** getSiteForCookies #method:getSiteForCookies#

#if defined(ENABLE_OVERLOADING)
    MessageGetSiteForCookiesMethodInfo      ,
#endif
    messageGetSiteForCookies                ,


-- ** getSoupRequest #method:getSoupRequest#

#if defined(ENABLE_OVERLOADING)
    MessageGetSoupRequestMethodInfo         ,
#endif
    messageGetSoupRequest                   ,


-- ** getUri #method:getUri#

#if defined(ENABLE_OVERLOADING)
    MessageGetUriMethodInfo                 ,
#endif
    messageGetUri                           ,


-- ** gotBody #method:gotBody#

#if defined(ENABLE_OVERLOADING)
    MessageGotBodyMethodInfo                ,
#endif
    messageGotBody                          ,


-- ** gotChunk #method:gotChunk#

#if defined(ENABLE_OVERLOADING)
    MessageGotChunkMethodInfo               ,
#endif
    messageGotChunk                         ,


-- ** gotHeaders #method:gotHeaders#

#if defined(ENABLE_OVERLOADING)
    MessageGotHeadersMethodInfo             ,
#endif
    messageGotHeaders                       ,


-- ** gotInformational #method:gotInformational#

#if defined(ENABLE_OVERLOADING)
    MessageGotInformationalMethodInfo       ,
#endif
    messageGotInformational                 ,


-- ** isFeatureDisabled #method:isFeatureDisabled#

#if defined(ENABLE_OVERLOADING)
    MessageIsFeatureDisabledMethodInfo      ,
#endif
    messageIsFeatureDisabled                ,


-- ** isKeepalive #method:isKeepalive#

#if defined(ENABLE_OVERLOADING)
    MessageIsKeepaliveMethodInfo            ,
#endif
    messageIsKeepalive                      ,


-- ** new #method:new#

    messageNew                              ,


-- ** newFromUri #method:newFromUri#

    messageNewFromUri                       ,


-- ** restarted #method:restarted#

#if defined(ENABLE_OVERLOADING)
    MessageRestartedMethodInfo              ,
#endif
    messageRestarted                        ,


-- ** setChunkAllocator #method:setChunkAllocator#

#if defined(ENABLE_OVERLOADING)
    MessageSetChunkAllocatorMethodInfo      ,
#endif
    messageSetChunkAllocator                ,


-- ** setFirstParty #method:setFirstParty#

#if defined(ENABLE_OVERLOADING)
    MessageSetFirstPartyMethodInfo          ,
#endif
    messageSetFirstParty                    ,


-- ** setFlags #method:setFlags#

#if defined(ENABLE_OVERLOADING)
    MessageSetFlagsMethodInfo               ,
#endif
    messageSetFlags                         ,


-- ** setHttpVersion #method:setHttpVersion#

#if defined(ENABLE_OVERLOADING)
    MessageSetHttpVersionMethodInfo         ,
#endif
    messageSetHttpVersion                   ,


-- ** setIsTopLevelNavigation #method:setIsTopLevelNavigation#

#if defined(ENABLE_OVERLOADING)
    MessageSetIsTopLevelNavigationMethodInfo,
#endif
    messageSetIsTopLevelNavigation          ,


-- ** setPriority #method:setPriority#

#if defined(ENABLE_OVERLOADING)
    MessageSetPriorityMethodInfo            ,
#endif
    messageSetPriority                      ,


-- ** setRedirect #method:setRedirect#

#if defined(ENABLE_OVERLOADING)
    MessageSetRedirectMethodInfo            ,
#endif
    messageSetRedirect                      ,


-- ** setRequest #method:setRequest#

#if defined(ENABLE_OVERLOADING)
    MessageSetRequestMethodInfo             ,
#endif
    messageSetRequest                       ,


-- ** setResponse #method:setResponse#

#if defined(ENABLE_OVERLOADING)
    MessageSetResponseMethodInfo            ,
#endif
    messageSetResponse                      ,


-- ** setSiteForCookies #method:setSiteForCookies#

#if defined(ENABLE_OVERLOADING)
    MessageSetSiteForCookiesMethodInfo      ,
#endif
    messageSetSiteForCookies                ,


-- ** setStatus #method:setStatus#

#if defined(ENABLE_OVERLOADING)
    MessageSetStatusMethodInfo              ,
#endif
    messageSetStatus                        ,


-- ** setStatusFull #method:setStatusFull#

#if defined(ENABLE_OVERLOADING)
    MessageSetStatusFullMethodInfo          ,
#endif
    messageSetStatusFull                    ,


-- ** setUri #method:setUri#

#if defined(ENABLE_OVERLOADING)
    MessageSetUriMethodInfo                 ,
#endif
    messageSetUri                           ,


-- ** starting #method:starting#

#if defined(ENABLE_OVERLOADING)
    MessageStartingMethodInfo               ,
#endif
    messageStarting                         ,


-- ** wroteBody #method:wroteBody#

#if defined(ENABLE_OVERLOADING)
    MessageWroteBodyMethodInfo              ,
#endif
    messageWroteBody                        ,


-- ** wroteBodyData #method:wroteBodyData#

#if defined(ENABLE_OVERLOADING)
    MessageWroteBodyDataMethodInfo          ,
#endif
    messageWroteBodyData                    ,


-- ** wroteChunk #method:wroteChunk#

#if defined(ENABLE_OVERLOADING)
    MessageWroteChunkMethodInfo             ,
#endif
    messageWroteChunk                       ,


-- ** wroteHeaders #method:wroteHeaders#

#if defined(ENABLE_OVERLOADING)
    MessageWroteHeadersMethodInfo           ,
#endif
    messageWroteHeaders                     ,


-- ** wroteInformational #method:wroteInformational#

#if defined(ENABLE_OVERLOADING)
    MessageWroteInformationalMethodInfo     ,
#endif
    messageWroteInformational               ,




 -- * Properties


-- ** firstParty #attr:firstParty#
-- | The t'GI.Soup.Structs.URI.URI' loaded in the application when the message was
-- queued.
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    MessageFirstPartyPropertyInfo           ,
#endif
    constructMessageFirstParty              ,
    getMessageFirstParty                    ,
#if defined(ENABLE_OVERLOADING)
    messageFirstParty                       ,
#endif
    setMessageFirstParty                    ,


-- ** flags #attr:flags#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageFlagsPropertyInfo                ,
#endif
    constructMessageFlags                   ,
    getMessageFlags                         ,
#if defined(ENABLE_OVERLOADING)
    messageFlags                            ,
#endif
    setMessageFlags                         ,


-- ** httpVersion #attr:httpVersion#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageHttpVersionPropertyInfo          ,
#endif
    constructMessageHttpVersion             ,
    getMessageHttpVersion                   ,
#if defined(ENABLE_OVERLOADING)
    messageHttpVersion                      ,
#endif
    setMessageHttpVersion                   ,


-- ** isTopLevelNavigation #attr:isTopLevelNavigation#
-- | Set when the message is navigating between top level domains.
-- 
-- /Since: 2.70/

#if defined(ENABLE_OVERLOADING)
    MessageIsTopLevelNavigationPropertyInfo ,
#endif
    constructMessageIsTopLevelNavigation    ,
    getMessageIsTopLevelNavigation          ,
#if defined(ENABLE_OVERLOADING)
    messageIsTopLevelNavigation             ,
#endif
    setMessageIsTopLevelNavigation          ,


-- ** method #attr:method#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageMethodPropertyInfo               ,
#endif
    clearMessageMethod                      ,
    constructMessageMethod                  ,
    getMessageMethod                        ,
#if defined(ENABLE_OVERLOADING)
    messageMethod                           ,
#endif
    setMessageMethod                        ,


-- ** priority #attr:priority#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessagePriorityPropertyInfo             ,
#endif
    constructMessagePriority                ,
    getMessagePriority                      ,
#if defined(ENABLE_OVERLOADING)
    messagePriority                         ,
#endif
    setMessagePriority                      ,


-- ** reasonPhrase #attr:reasonPhrase#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageReasonPhrasePropertyInfo         ,
#endif
    clearMessageReasonPhrase                ,
    constructMessageReasonPhrase            ,
    getMessageReasonPhrase                  ,
#if defined(ENABLE_OVERLOADING)
    messageReasonPhrase                     ,
#endif
    setMessageReasonPhrase                  ,


-- ** requestBody #attr:requestBody#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageRequestBodyPropertyInfo          ,
#endif
    getMessageRequestBody                   ,
#if defined(ENABLE_OVERLOADING)
    messageRequestBody                      ,
#endif


-- ** requestBodyData #attr:requestBodyData#
-- | The message\'s HTTP request body, as a t'GI.GLib.Structs.Bytes.Bytes'.
-- 
-- /Since: 2.46/

#if defined(ENABLE_OVERLOADING)
    MessageRequestBodyDataPropertyInfo      ,
#endif
    getMessageRequestBodyData               ,
#if defined(ENABLE_OVERLOADING)
    messageRequestBodyData                  ,
#endif


-- ** requestHeaders #attr:requestHeaders#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageRequestHeadersPropertyInfo       ,
#endif
    getMessageRequestHeaders                ,
#if defined(ENABLE_OVERLOADING)
    messageRequestHeaders                   ,
#endif


-- ** responseBody #attr:responseBody#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageResponseBodyPropertyInfo         ,
#endif
    getMessageResponseBody                  ,
#if defined(ENABLE_OVERLOADING)
    messageResponseBody                     ,
#endif


-- ** responseBodyData #attr:responseBodyData#
-- | The message\'s HTTP response body, as a t'GI.GLib.Structs.Bytes.Bytes'.
-- 
-- /Since: 2.46/

#if defined(ENABLE_OVERLOADING)
    MessageResponseBodyDataPropertyInfo     ,
#endif
    getMessageResponseBodyData              ,
#if defined(ENABLE_OVERLOADING)
    messageResponseBodyData                 ,
#endif


-- ** responseHeaders #attr:responseHeaders#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageResponseHeadersPropertyInfo      ,
#endif
    getMessageResponseHeaders               ,
#if defined(ENABLE_OVERLOADING)
    messageResponseHeaders                  ,
#endif


-- ** serverSide #attr:serverSide#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageServerSidePropertyInfo           ,
#endif
    constructMessageServerSide              ,
    getMessageServerSide                    ,
#if defined(ENABLE_OVERLOADING)
    messageServerSide                       ,
#endif


-- ** siteForCookies #attr:siteForCookies#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageSiteForCookiesPropertyInfo       ,
#endif
    clearMessageSiteForCookies              ,
    constructMessageSiteForCookies          ,
    getMessageSiteForCookies                ,
#if defined(ENABLE_OVERLOADING)
    messageSiteForCookies                   ,
#endif
    setMessageSiteForCookies                ,


-- ** statusCode #attr:statusCode#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageStatusCodePropertyInfo           ,
#endif
    constructMessageStatusCode              ,
    getMessageStatusCode                    ,
#if defined(ENABLE_OVERLOADING)
    messageStatusCode                       ,
#endif
    setMessageStatusCode                    ,


-- ** tlsCertificate #attr:tlsCertificate#
-- | The t'GI.Gio.Objects.TlsCertificate.TlsCertificate' associated with the message
-- 
-- /Since: 2.34/

#if defined(ENABLE_OVERLOADING)
    MessageTlsCertificatePropertyInfo       ,
#endif
    clearMessageTlsCertificate              ,
    constructMessageTlsCertificate          ,
    getMessageTlsCertificate                ,
#if defined(ENABLE_OVERLOADING)
    messageTlsCertificate                   ,
#endif
    setMessageTlsCertificate                ,


-- ** tlsErrors #attr:tlsErrors#
-- | The verification errors on [Message:tlsCertificate]("GI.Soup.Objects.Message#g:attr:tlsCertificate")
-- 
-- /Since: 2.34/

#if defined(ENABLE_OVERLOADING)
    MessageTlsErrorsPropertyInfo            ,
#endif
    constructMessageTlsErrors               ,
    getMessageTlsErrors                     ,
#if defined(ENABLE_OVERLOADING)
    messageTlsErrors                        ,
#endif
    setMessageTlsErrors                     ,


-- ** uri #attr:uri#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    MessageUriPropertyInfo                  ,
#endif
    constructMessageUri                     ,
    getMessageUri                           ,
#if defined(ENABLE_OVERLOADING)
    messageUri                              ,
#endif
    setMessageUri                           ,




 -- * Signals


-- ** contentSniffed #signal:contentSniffed#

    MessageContentSniffedCallback           ,
#if defined(ENABLE_OVERLOADING)
    MessageContentSniffedSignalInfo         ,
#endif
    afterMessageContentSniffed              ,
    onMessageContentSniffed                 ,


-- ** finished #signal:finished#

    MessageFinishedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    MessageFinishedSignalInfo               ,
#endif
    afterMessageFinished                    ,
    onMessageFinished                       ,


-- ** gotBody #signal:gotBody#

    MessageGotBodyCallback                  ,
#if defined(ENABLE_OVERLOADING)
    MessageGotBodySignalInfo                ,
#endif
    afterMessageGotBody                     ,
    onMessageGotBody                        ,


-- ** gotChunk #signal:gotChunk#

    MessageGotChunkCallback                 ,
#if defined(ENABLE_OVERLOADING)
    MessageGotChunkSignalInfo               ,
#endif
    afterMessageGotChunk                    ,
    onMessageGotChunk                       ,


-- ** gotHeaders #signal:gotHeaders#

    MessageGotHeadersCallback               ,
#if defined(ENABLE_OVERLOADING)
    MessageGotHeadersSignalInfo             ,
#endif
    afterMessageGotHeaders                  ,
    onMessageGotHeaders                     ,


-- ** gotInformational #signal:gotInformational#

    MessageGotInformationalCallback         ,
#if defined(ENABLE_OVERLOADING)
    MessageGotInformationalSignalInfo       ,
#endif
    afterMessageGotInformational            ,
    onMessageGotInformational               ,


-- ** networkEvent #signal:networkEvent#

    MessageNetworkEventCallback             ,
#if defined(ENABLE_OVERLOADING)
    MessageNetworkEventSignalInfo           ,
#endif
    afterMessageNetworkEvent                ,
    onMessageNetworkEvent                   ,


-- ** restarted #signal:restarted#

    MessageRestartedCallback                ,
#if defined(ENABLE_OVERLOADING)
    MessageRestartedSignalInfo              ,
#endif
    afterMessageRestarted                   ,
    onMessageRestarted                      ,


-- ** starting #signal:starting#

    MessageStartingCallback                 ,
#if defined(ENABLE_OVERLOADING)
    MessageStartingSignalInfo               ,
#endif
    afterMessageStarting                    ,
    onMessageStarting                       ,


-- ** wroteBody #signal:wroteBody#

    MessageWroteBodyCallback                ,
#if defined(ENABLE_OVERLOADING)
    MessageWroteBodySignalInfo              ,
#endif
    afterMessageWroteBody                   ,
    onMessageWroteBody                      ,


-- ** wroteBodyData #signal:wroteBodyData#

    MessageWroteBodyDataCallback            ,
#if defined(ENABLE_OVERLOADING)
    MessageWroteBodyDataSignalInfo          ,
#endif
    afterMessageWroteBodyData               ,
    onMessageWroteBodyData                  ,


-- ** wroteChunk #signal:wroteChunk#

    MessageWroteChunkCallback               ,
#if defined(ENABLE_OVERLOADING)
    MessageWroteChunkSignalInfo             ,
#endif
    afterMessageWroteChunk                  ,
    onMessageWroteChunk                     ,


-- ** wroteHeaders #signal:wroteHeaders#

    MessageWroteHeadersCallback             ,
#if defined(ENABLE_OVERLOADING)
    MessageWroteHeadersSignalInfo           ,
#endif
    afterMessageWroteHeaders                ,
    onMessageWroteHeaders                   ,


-- ** wroteInformational #signal:wroteInformational#

    MessageWroteInformationalCallback       ,
#if defined(ENABLE_OVERLOADING)
    MessageWroteInformationalSignalInfo     ,
#endif
    afterMessageWroteInformational          ,
    onMessageWroteInformational             ,




    ) where

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

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

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Enums as Gio.Enums
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Objects.IOStream as Gio.IOStream
import qualified GI.Gio.Objects.TlsCertificate as Gio.TlsCertificate
import qualified GI.Soup.Callbacks as Soup.Callbacks
import {-# SOURCE #-} qualified GI.Soup.Enums as Soup.Enums
import {-# SOURCE #-} qualified GI.Soup.Flags as Soup.Flags
import {-# SOURCE #-} qualified GI.Soup.Objects.Address as Soup.Address
import {-# SOURCE #-} qualified GI.Soup.Objects.Request as Soup.Request
import {-# SOURCE #-} qualified GI.Soup.Structs.Buffer as Soup.Buffer
import {-# SOURCE #-} qualified GI.Soup.Structs.MessageBody as Soup.MessageBody
import {-# SOURCE #-} qualified GI.Soup.Structs.MessageHeaders as Soup.MessageHeaders
import {-# SOURCE #-} qualified GI.Soup.Structs.URI as Soup.URI

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

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

foreign import ccall "soup_message_get_type"
    c_soup_message_get_type :: IO B.Types.GType

instance B.Types.TypedObject Message where
    glibType :: IO GType
glibType = IO GType
c_soup_message_get_type

instance B.Types.GObject Message

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveMessageMethod (t :: Symbol) (o :: *) :: * where
    ResolveMessageMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMessageMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMessageMethod "contentSniffed" o = MessageContentSniffedMethodInfo
    ResolveMessageMethod "disableFeature" o = MessageDisableFeatureMethodInfo
    ResolveMessageMethod "finished" o = MessageFinishedMethodInfo
    ResolveMessageMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMessageMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMessageMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMessageMethod "gotBody" o = MessageGotBodyMethodInfo
    ResolveMessageMethod "gotChunk" o = MessageGotChunkMethodInfo
    ResolveMessageMethod "gotHeaders" o = MessageGotHeadersMethodInfo
    ResolveMessageMethod "gotInformational" o = MessageGotInformationalMethodInfo
    ResolveMessageMethod "isFeatureDisabled" o = MessageIsFeatureDisabledMethodInfo
    ResolveMessageMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMessageMethod "isKeepalive" o = MessageIsKeepaliveMethodInfo
    ResolveMessageMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMessageMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMessageMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMessageMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMessageMethod "restarted" o = MessageRestartedMethodInfo
    ResolveMessageMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMessageMethod "starting" o = MessageStartingMethodInfo
    ResolveMessageMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMessageMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMessageMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMessageMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMessageMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMessageMethod "wroteBody" o = MessageWroteBodyMethodInfo
    ResolveMessageMethod "wroteBodyData" o = MessageWroteBodyDataMethodInfo
    ResolveMessageMethod "wroteChunk" o = MessageWroteChunkMethodInfo
    ResolveMessageMethod "wroteHeaders" o = MessageWroteHeadersMethodInfo
    ResolveMessageMethod "wroteInformational" o = MessageWroteInformationalMethodInfo
    ResolveMessageMethod "getAddress" o = MessageGetAddressMethodInfo
    ResolveMessageMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMessageMethod "getFirstParty" o = MessageGetFirstPartyMethodInfo
    ResolveMessageMethod "getFlags" o = MessageGetFlagsMethodInfo
    ResolveMessageMethod "getHttpVersion" o = MessageGetHttpVersionMethodInfo
    ResolveMessageMethod "getHttpsStatus" o = MessageGetHttpsStatusMethodInfo
    ResolveMessageMethod "getIsTopLevelNavigation" o = MessageGetIsTopLevelNavigationMethodInfo
    ResolveMessageMethod "getPriority" o = MessageGetPriorityMethodInfo
    ResolveMessageMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMessageMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMessageMethod "getSiteForCookies" o = MessageGetSiteForCookiesMethodInfo
    ResolveMessageMethod "getSoupRequest" o = MessageGetSoupRequestMethodInfo
    ResolveMessageMethod "getUri" o = MessageGetUriMethodInfo
    ResolveMessageMethod "setChunkAllocator" o = MessageSetChunkAllocatorMethodInfo
    ResolveMessageMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMessageMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMessageMethod "setFirstParty" o = MessageSetFirstPartyMethodInfo
    ResolveMessageMethod "setFlags" o = MessageSetFlagsMethodInfo
    ResolveMessageMethod "setHttpVersion" o = MessageSetHttpVersionMethodInfo
    ResolveMessageMethod "setIsTopLevelNavigation" o = MessageSetIsTopLevelNavigationMethodInfo
    ResolveMessageMethod "setPriority" o = MessageSetPriorityMethodInfo
    ResolveMessageMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMessageMethod "setRedirect" o = MessageSetRedirectMethodInfo
    ResolveMessageMethod "setRequest" o = MessageSetRequestMethodInfo
    ResolveMessageMethod "setResponse" o = MessageSetResponseMethodInfo
    ResolveMessageMethod "setSiteForCookies" o = MessageSetSiteForCookiesMethodInfo
    ResolveMessageMethod "setStatus" o = MessageSetStatusMethodInfo
    ResolveMessageMethod "setStatusFull" o = MessageSetStatusFullMethodInfo
    ResolveMessageMethod "setUri" o = MessageSetUriMethodInfo
    ResolveMessageMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif

-- signal Message::content-sniffed
-- | This signal is emitted after [Message::gotHeaders]("GI.Soup.Objects.Message#g:signal:gotHeaders"), and
-- before the first [Message::gotChunk]("GI.Soup.Objects.Message#g:signal:gotChunk"). If content
-- sniffing is disabled, or no content sniffing will be
-- performed, due to the sniffer deciding to trust the
-- Content-Type sent by the server, this signal is emitted
-- immediately after [Message::gotHeaders]("GI.Soup.Objects.Message#g:signal:gotHeaders"), and /@type@/ is
-- 'P.Nothing'.
-- 
-- If the t'GI.Soup.Objects.ContentSniffer.ContentSniffer' feature is enabled, and the
-- sniffer decided to perform sniffing, the first
-- [Message::gotChunk]("GI.Soup.Objects.Message#g:signal:gotChunk") emission may be delayed, so that the
-- sniffer has enough data to correctly sniff the content. It
-- notified the library user that the content has been
-- sniffed, and allows it to change the header contents in the
-- message, if desired.
-- 
-- After this signal is emitted, the data that was spooled so
-- that sniffing could be done is delivered on the first
-- emission of [Message::gotChunk]("GI.Soup.Objects.Message#g:signal:gotChunk").
-- 
-- /Since: 2.28/
type MessageContentSniffedCallback =
    T.Text
    -- ^ /@type@/: the content type that we got from sniffing
    -> Map.Map T.Text T.Text
    -- ^ /@params@/: a t'GI.GLib.Structs.HashTable.HashTable' with the parameters
    -> IO ()

type C_MessageContentSniffedCallback =
    Ptr Message ->                          -- object
    CString ->
    Ptr (GHashTable CString CString) ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_MessageContentSniffedCallback :: 
    GObject a => (a -> MessageContentSniffedCallback) ->
    C_MessageContentSniffedCallback
wrap_MessageContentSniffedCallback :: forall a.
GObject a =>
(a -> MessageContentSniffedCallback)
-> C_MessageContentSniffedCallback
wrap_MessageContentSniffedCallback a -> MessageContentSniffedCallback
gi'cb Ptr Message
gi'selfPtr CString
type_ Ptr (GHashTable CString CString)
params Ptr ()
_ = do
    Text
type_' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
type_
    [(PtrWrapped CString, PtrWrapped CString)]
params' <- Ptr (GHashTable CString CString)
-> IO [(PtrWrapped CString, PtrWrapped CString)]
forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable CString CString)
params
    let params'' :: [(CString, PtrWrapped CString)]
params'' = (PtrWrapped CString -> CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> [(CString, PtrWrapped CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst PtrWrapped CString -> CString
B.GHT.cstringUnpackPtr [(PtrWrapped CString, PtrWrapped CString)]
params'
    [(Text, PtrWrapped CString)]
params''' <- (CString -> IO Text)
-> [(CString, PtrWrapped CString)]
-> IO [(Text, PtrWrapped CString)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [(CString, PtrWrapped CString)]
params''
    let params'''' :: [(Text, CString)]
params'''' = (PtrWrapped CString -> CString)
-> [(Text, PtrWrapped CString)] -> [(Text, CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond PtrWrapped CString -> CString
B.GHT.cstringUnpackPtr [(Text, PtrWrapped CString)]
params'''
    [(Text, Text)]
params''''' <- (CString -> IO Text) -> [(Text, CString)] -> IO [(Text, Text)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [(Text, CString)]
params''''
    let params'''''' :: Map Text Text
params'''''' = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
params'''''
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> MessageContentSniffedCallback
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self)  Text
type_' Map Text Text
params''''''


-- | Connect a signal handler for the [contentSniffed](#signal:contentSniffed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #contentSniffed callback
-- @
-- 
-- 
onMessageContentSniffed :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageContentSniffedCallback) -> m SignalHandlerId
onMessageContentSniffed :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a
-> ((?self::a) => MessageContentSniffedCallback)
-> m SignalHandlerId
onMessageContentSniffed a
obj (?self::a) => MessageContentSniffedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MessageContentSniffedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MessageContentSniffedCallback
MessageContentSniffedCallback
cb
    let wrapped' :: C_MessageContentSniffedCallback
wrapped' = (a -> MessageContentSniffedCallback)
-> C_MessageContentSniffedCallback
forall a.
GObject a =>
(a -> MessageContentSniffedCallback)
-> C_MessageContentSniffedCallback
wrap_MessageContentSniffedCallback a -> MessageContentSniffedCallback
wrapped
    FunPtr C_MessageContentSniffedCallback
wrapped'' <- C_MessageContentSniffedCallback
-> IO (FunPtr C_MessageContentSniffedCallback)
mk_MessageContentSniffedCallback C_MessageContentSniffedCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageContentSniffedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"content-sniffed" FunPtr C_MessageContentSniffedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageContentSniffedSignalInfo
instance SignalInfo MessageContentSniffedSignalInfo where
    type HaskellCallbackType MessageContentSniffedSignalInfo = MessageContentSniffedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageContentSniffedCallback cb
        cb'' <- mk_MessageContentSniffedCallback cb'
        connectSignalFunPtr obj "content-sniffed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::content-sniffed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:contentSniffed"})

#endif

-- signal Message::finished
-- | Emitted when all HTTP processing is finished for a message.
-- (After t'GI.Soup.Objects.Message.Message'::@/got_body/@ for client-side messages, or
-- after t'GI.Soup.Objects.Message.Message'::@/wrote_body/@ for server-side messages.)
type MessageFinishedCallback =
    IO ()

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

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

wrap_MessageFinishedCallback :: 
    GObject a => (a -> MessageFinishedCallback) ->
    C_MessageFinishedCallback
wrap_MessageFinishedCallback :: forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageFinishedCallback a -> IO ()
gi'cb Ptr Message
gi'selfPtr Ptr ()
_ = do
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> IO ()
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self) 


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

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


#if defined(ENABLE_OVERLOADING)
data MessageFinishedSignalInfo
instance SignalInfo MessageFinishedSignalInfo where
    type HaskellCallbackType MessageFinishedSignalInfo = MessageFinishedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageFinishedCallback cb
        cb'' <- mk_MessageFinishedCallback cb'
        connectSignalFunPtr obj "finished" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::finished"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:finished"})

#endif

-- signal Message::got-body
-- | Emitted after receiving the complete message body. (For a
-- server-side message, this means it has received the request
-- body. For a client-side message, this means it has received
-- the response body and is nearly done with the message.)
-- 
-- See also @/soup_message_add_header_handler()/@ and
-- @/soup_message_add_status_code_handler()/@, which can be used
-- to connect to a subset of emissions of this signal.
type MessageGotBodyCallback =
    IO ()

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

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

wrap_MessageGotBodyCallback :: 
    GObject a => (a -> MessageGotBodyCallback) ->
    C_MessageGotBodyCallback
wrap_MessageGotBodyCallback :: forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageGotBodyCallback a -> IO ()
gi'cb Ptr Message
gi'selfPtr Ptr ()
_ = do
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> IO ()
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self) 


-- | Connect a signal handler for the [gotBody](#signal:gotBody) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #gotBody callback
-- @
-- 
-- 
onMessageGotBody :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageGotBodyCallback) -> m SignalHandlerId
onMessageGotBody :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMessageGotBody a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MessageFinishedCallback
wrapped' = (a -> IO ()) -> C_MessageFinishedCallback
forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageGotBodyCallback a -> IO ()
wrapped
    FunPtr C_MessageFinishedCallback
wrapped'' <- C_MessageFinishedCallback -> IO (FunPtr C_MessageFinishedCallback)
mk_MessageGotBodyCallback C_MessageFinishedCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"got-body" FunPtr C_MessageFinishedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageGotBodySignalInfo
instance SignalInfo MessageGotBodySignalInfo where
    type HaskellCallbackType MessageGotBodySignalInfo = MessageGotBodyCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageGotBodyCallback cb
        cb'' <- mk_MessageGotBodyCallback cb'
        connectSignalFunPtr obj "got-body" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::got-body"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:gotBody"})

#endif

-- signal Message::got-chunk
-- | Emitted after receiving a chunk of a message body. Note
-- that \"chunk\" in this context means any subpiece of the
-- body, not necessarily the specific HTTP 1.1 chunks sent by
-- the other side.
-- 
-- If you cancel or requeue /@msg@/ while processing this signal,
-- then the current HTTP I\/O will be stopped after this signal
-- emission finished, and /@msg@/\'s connection will be closed.
type MessageGotChunkCallback =
    Soup.Buffer.Buffer
    -- ^ /@chunk@/: the just-read chunk
    -> IO ()

type C_MessageGotChunkCallback =
    Ptr Message ->                          -- object
    Ptr Soup.Buffer.Buffer ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_MessageGotChunkCallback :: 
    GObject a => (a -> MessageGotChunkCallback) ->
    C_MessageGotChunkCallback
wrap_MessageGotChunkCallback :: forall a.
GObject a =>
(a -> MessageGotChunkCallback) -> C_MessageGotChunkCallback
wrap_MessageGotChunkCallback a -> MessageGotChunkCallback
gi'cb Ptr Message
gi'selfPtr Ptr Buffer
chunk Ptr ()
_ = do
    Ptr Buffer -> MessageGotChunkCallback -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Buffer
chunk (MessageGotChunkCallback -> IO ())
-> MessageGotChunkCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ \Buffer
chunk' -> do
        Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> MessageGotChunkCallback
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self)  Buffer
chunk'


-- | Connect a signal handler for the [gotChunk](#signal:gotChunk) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #gotChunk callback
-- @
-- 
-- 
onMessageGotChunk :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageGotChunkCallback) -> m SignalHandlerId
onMessageGotChunk :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a -> ((?self::a) => MessageGotChunkCallback) -> m SignalHandlerId
onMessageGotChunk a
obj (?self::a) => MessageGotChunkCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MessageGotChunkCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MessageGotChunkCallback
MessageGotChunkCallback
cb
    let wrapped' :: C_MessageGotChunkCallback
wrapped' = (a -> MessageGotChunkCallback) -> C_MessageGotChunkCallback
forall a.
GObject a =>
(a -> MessageGotChunkCallback) -> C_MessageGotChunkCallback
wrap_MessageGotChunkCallback a -> MessageGotChunkCallback
wrapped
    FunPtr C_MessageGotChunkCallback
wrapped'' <- C_MessageGotChunkCallback -> IO (FunPtr C_MessageGotChunkCallback)
mk_MessageGotChunkCallback C_MessageGotChunkCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageGotChunkCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"got-chunk" FunPtr C_MessageGotChunkCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageGotChunkSignalInfo
instance SignalInfo MessageGotChunkSignalInfo where
    type HaskellCallbackType MessageGotChunkSignalInfo = MessageGotChunkCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageGotChunkCallback cb
        cb'' <- mk_MessageGotChunkCallback cb'
        connectSignalFunPtr obj "got-chunk" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::got-chunk"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:gotChunk"})

#endif

-- signal Message::got-headers
-- | Emitted after receiving all message headers for a message.
-- (For a client-side message, this is after receiving the
-- Status-Line and response headers; for a server-side
-- message, it is after receiving the Request-Line and request
-- headers.)
-- 
-- See also @/soup_message_add_header_handler()/@ and
-- @/soup_message_add_status_code_handler()/@, which can be used
-- to connect to a subset of emissions of this signal.
-- 
-- If you cancel or requeue /@msg@/ while processing this signal,
-- then the current HTTP I\/O will be stopped after this signal
-- emission finished, and /@msg@/\'s connection will be closed.
-- (If you need to requeue a message--eg, after handling
-- authentication or redirection--it is usually better to
-- requeue it from a t'GI.Soup.Objects.Message.Message'::@/got_body/@ handler rather
-- than a t'GI.Soup.Objects.Message.Message'::@/got_headers/@ handler, so that the
-- existing HTTP connection can be reused.)
type MessageGotHeadersCallback =
    IO ()

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

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

wrap_MessageGotHeadersCallback :: 
    GObject a => (a -> MessageGotHeadersCallback) ->
    C_MessageGotHeadersCallback
wrap_MessageGotHeadersCallback :: forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageGotHeadersCallback a -> IO ()
gi'cb Ptr Message
gi'selfPtr Ptr ()
_ = do
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> IO ()
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self) 


-- | Connect a signal handler for the [gotHeaders](#signal:gotHeaders) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #gotHeaders callback
-- @
-- 
-- 
onMessageGotHeaders :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageGotHeadersCallback) -> m SignalHandlerId
onMessageGotHeaders :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMessageGotHeaders a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MessageFinishedCallback
wrapped' = (a -> IO ()) -> C_MessageFinishedCallback
forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageGotHeadersCallback a -> IO ()
wrapped
    FunPtr C_MessageFinishedCallback
wrapped'' <- C_MessageFinishedCallback -> IO (FunPtr C_MessageFinishedCallback)
mk_MessageGotHeadersCallback C_MessageFinishedCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"got-headers" FunPtr C_MessageFinishedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageGotHeadersSignalInfo
instance SignalInfo MessageGotHeadersSignalInfo where
    type HaskellCallbackType MessageGotHeadersSignalInfo = MessageGotHeadersCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageGotHeadersCallback cb
        cb'' <- mk_MessageGotHeadersCallback cb'
        connectSignalFunPtr obj "got-headers" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::got-headers"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:gotHeaders"})

#endif

-- signal Message::got-informational
-- | Emitted after receiving a 1xx (Informational) response for
-- a (client-side) message. The response_headers will be
-- filled in with the headers associated with the
-- informational response; however, those header values will
-- be erased after this signal is done.
-- 
-- If you cancel or requeue /@msg@/ while processing this signal,
-- then the current HTTP I\/O will be stopped after this signal
-- emission finished, and /@msg@/\'s connection will be closed.
type MessageGotInformationalCallback =
    IO ()

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

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

wrap_MessageGotInformationalCallback :: 
    GObject a => (a -> MessageGotInformationalCallback) ->
    C_MessageGotInformationalCallback
wrap_MessageGotInformationalCallback :: forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageGotInformationalCallback a -> IO ()
gi'cb Ptr Message
gi'selfPtr Ptr ()
_ = do
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> IO ()
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self) 


-- | Connect a signal handler for the [gotInformational](#signal:gotInformational) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #gotInformational callback
-- @
-- 
-- 
onMessageGotInformational :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageGotInformationalCallback) -> m SignalHandlerId
onMessageGotInformational :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMessageGotInformational a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MessageFinishedCallback
wrapped' = (a -> IO ()) -> C_MessageFinishedCallback
forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageGotInformationalCallback a -> IO ()
wrapped
    FunPtr C_MessageFinishedCallback
wrapped'' <- C_MessageFinishedCallback -> IO (FunPtr C_MessageFinishedCallback)
mk_MessageGotInformationalCallback C_MessageFinishedCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"got-informational" FunPtr C_MessageFinishedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageGotInformationalSignalInfo
instance SignalInfo MessageGotInformationalSignalInfo where
    type HaskellCallbackType MessageGotInformationalSignalInfo = MessageGotInformationalCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageGotInformationalCallback cb
        cb'' <- mk_MessageGotInformationalCallback cb'
        connectSignalFunPtr obj "got-informational" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::got-informational"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:gotInformational"})

#endif

-- signal Message::network-event
-- | Emitted to indicate that some network-related event
-- related to /@msg@/ has occurred. This essentially proxies the
-- [SocketClient::event]("GI.Gio.Objects.SocketClient#g:signal:event") signal, but only for events that
-- occur while /@msg@/ \"owns\" the connection; if /@msg@/ is sent on
-- an existing persistent connection, then this signal will
-- not be emitted. (If you want to force the message to be
-- sent on a new connection, set the
-- 'GI.Soup.Flags.MessageFlagsNewConnection' flag on it.)
-- 
-- See [SocketClient::event]("GI.Gio.Objects.SocketClient#g:signal:event") for more information on what
-- the different values of /@event@/ correspond to, and what
-- /@connection@/ will be in each case.
-- 
-- /Since: 2.38/
type MessageNetworkEventCallback =
    Gio.Enums.SocketClientEvent
    -- ^ /@event@/: the network event
    -> Gio.IOStream.IOStream
    -- ^ /@connection@/: the current state of the network connection
    -> IO ()

type C_MessageNetworkEventCallback =
    Ptr Message ->                          -- object
    CUInt ->
    Ptr Gio.IOStream.IOStream ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_MessageNetworkEventCallback :: 
    GObject a => (a -> MessageNetworkEventCallback) ->
    C_MessageNetworkEventCallback
wrap_MessageNetworkEventCallback :: forall a.
GObject a =>
(a -> MessageNetworkEventCallback) -> C_MessageNetworkEventCallback
wrap_MessageNetworkEventCallback a -> MessageNetworkEventCallback
gi'cb Ptr Message
gi'selfPtr CUInt
event Ptr IOStream
connection Ptr ()
_ = do
    let event' :: SocketClientEvent
event' = (Int -> SocketClientEvent
forall a. Enum a => Int -> a
toEnum (Int -> SocketClientEvent)
-> (CUInt -> Int) -> CUInt -> SocketClientEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
event
    IOStream
connection' <- ((ManagedPtr IOStream -> IOStream) -> Ptr IOStream -> IO IOStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr IOStream -> IOStream
Gio.IOStream.IOStream) Ptr IOStream
connection
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> MessageNetworkEventCallback
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self)  SocketClientEvent
event' IOStream
connection'


-- | Connect a signal handler for the [networkEvent](#signal:networkEvent) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #networkEvent callback
-- @
-- 
-- 
onMessageNetworkEvent :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageNetworkEventCallback) -> m SignalHandlerId
onMessageNetworkEvent :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a
-> ((?self::a) => MessageNetworkEventCallback) -> m SignalHandlerId
onMessageNetworkEvent a
obj (?self::a) => MessageNetworkEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MessageNetworkEventCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MessageNetworkEventCallback
MessageNetworkEventCallback
cb
    let wrapped' :: C_MessageNetworkEventCallback
wrapped' = (a -> MessageNetworkEventCallback) -> C_MessageNetworkEventCallback
forall a.
GObject a =>
(a -> MessageNetworkEventCallback) -> C_MessageNetworkEventCallback
wrap_MessageNetworkEventCallback a -> MessageNetworkEventCallback
wrapped
    FunPtr C_MessageNetworkEventCallback
wrapped'' <- C_MessageNetworkEventCallback
-> IO (FunPtr C_MessageNetworkEventCallback)
mk_MessageNetworkEventCallback C_MessageNetworkEventCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageNetworkEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"network-event" FunPtr C_MessageNetworkEventCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageNetworkEventSignalInfo
instance SignalInfo MessageNetworkEventSignalInfo where
    type HaskellCallbackType MessageNetworkEventSignalInfo = MessageNetworkEventCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageNetworkEventCallback cb
        cb'' <- mk_MessageNetworkEventCallback cb'
        connectSignalFunPtr obj "network-event" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::network-event"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:networkEvent"})

#endif

-- signal Message::restarted
-- | Emitted when a request that was already sent once is now
-- being sent again (eg, because the first attempt received a
-- redirection response, or because we needed to use
-- authentication).
type MessageRestartedCallback =
    IO ()

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

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

wrap_MessageRestartedCallback :: 
    GObject a => (a -> MessageRestartedCallback) ->
    C_MessageRestartedCallback
wrap_MessageRestartedCallback :: forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageRestartedCallback a -> IO ()
gi'cb Ptr Message
gi'selfPtr Ptr ()
_ = do
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> IO ()
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self) 


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

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


#if defined(ENABLE_OVERLOADING)
data MessageRestartedSignalInfo
instance SignalInfo MessageRestartedSignalInfo where
    type HaskellCallbackType MessageRestartedSignalInfo = MessageRestartedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageRestartedCallback cb
        cb'' <- mk_MessageRestartedCallback cb'
        connectSignalFunPtr obj "restarted" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::restarted"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:restarted"})

#endif

-- signal Message::starting
-- | Emitted just before a message is sent.
-- 
-- /Since: 2.50/
type MessageStartingCallback =
    IO ()

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

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

wrap_MessageStartingCallback :: 
    GObject a => (a -> MessageStartingCallback) ->
    C_MessageStartingCallback
wrap_MessageStartingCallback :: forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageStartingCallback a -> IO ()
gi'cb Ptr Message
gi'selfPtr Ptr ()
_ = do
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> IO ()
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self) 


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

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


#if defined(ENABLE_OVERLOADING)
data MessageStartingSignalInfo
instance SignalInfo MessageStartingSignalInfo where
    type HaskellCallbackType MessageStartingSignalInfo = MessageStartingCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageStartingCallback cb
        cb'' <- mk_MessageStartingCallback cb'
        connectSignalFunPtr obj "starting" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::starting"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:starting"})

#endif

-- signal Message::wrote-body
-- | Emitted immediately after writing the complete body for a
-- message. (For a client-side message, this means that
-- libsoup is done writing and is now waiting for the response
-- from the server. For a server-side message, this means that
-- libsoup has finished writing the response and is nearly
-- done with the message.)
type MessageWroteBodyCallback =
    IO ()

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

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

wrap_MessageWroteBodyCallback :: 
    GObject a => (a -> MessageWroteBodyCallback) ->
    C_MessageWroteBodyCallback
wrap_MessageWroteBodyCallback :: forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageWroteBodyCallback a -> IO ()
gi'cb Ptr Message
gi'selfPtr Ptr ()
_ = do
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> IO ()
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self) 


-- | Connect a signal handler for the [wroteBody](#signal:wroteBody) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #wroteBody callback
-- @
-- 
-- 
onMessageWroteBody :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageWroteBodyCallback) -> m SignalHandlerId
onMessageWroteBody :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMessageWroteBody a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MessageFinishedCallback
wrapped' = (a -> IO ()) -> C_MessageFinishedCallback
forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageWroteBodyCallback a -> IO ()
wrapped
    FunPtr C_MessageFinishedCallback
wrapped'' <- C_MessageFinishedCallback -> IO (FunPtr C_MessageFinishedCallback)
mk_MessageWroteBodyCallback C_MessageFinishedCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"wrote-body" FunPtr C_MessageFinishedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageWroteBodySignalInfo
instance SignalInfo MessageWroteBodySignalInfo where
    type HaskellCallbackType MessageWroteBodySignalInfo = MessageWroteBodyCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageWroteBodyCallback cb
        cb'' <- mk_MessageWroteBodyCallback cb'
        connectSignalFunPtr obj "wrote-body" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::wrote-body"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:wroteBody"})

#endif

-- signal Message::wrote-body-data
-- | Emitted immediately after writing a portion of the message
-- body to the network.
-- 
-- Unlike t'GI.Soup.Objects.Message.Message'::@/wrote_chunk/@, this is emitted after
-- every successful @/write()/@ call, not only after finishing a
-- complete \"chunk\".
-- 
-- /Since: 2.24/
type MessageWroteBodyDataCallback =
    Soup.Buffer.Buffer
    -- ^ /@chunk@/: the data written
    -> IO ()

type C_MessageWroteBodyDataCallback =
    Ptr Message ->                          -- object
    Ptr Soup.Buffer.Buffer ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_MessageWroteBodyDataCallback :: 
    GObject a => (a -> MessageWroteBodyDataCallback) ->
    C_MessageWroteBodyDataCallback
wrap_MessageWroteBodyDataCallback :: forall a.
GObject a =>
(a -> MessageGotChunkCallback) -> C_MessageGotChunkCallback
wrap_MessageWroteBodyDataCallback a -> MessageGotChunkCallback
gi'cb Ptr Message
gi'selfPtr Ptr Buffer
chunk Ptr ()
_ = do
    Ptr Buffer -> MessageGotChunkCallback -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Buffer
chunk (MessageGotChunkCallback -> IO ())
-> MessageGotChunkCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ \Buffer
chunk' -> do
        Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> MessageGotChunkCallback
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self)  Buffer
chunk'


-- | Connect a signal handler for the [wroteBodyData](#signal:wroteBodyData) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #wroteBodyData callback
-- @
-- 
-- 
onMessageWroteBodyData :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageWroteBodyDataCallback) -> m SignalHandlerId
onMessageWroteBodyData :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a -> ((?self::a) => MessageGotChunkCallback) -> m SignalHandlerId
onMessageWroteBodyData a
obj (?self::a) => MessageGotChunkCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MessageGotChunkCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MessageGotChunkCallback
MessageGotChunkCallback
cb
    let wrapped' :: C_MessageGotChunkCallback
wrapped' = (a -> MessageGotChunkCallback) -> C_MessageGotChunkCallback
forall a.
GObject a =>
(a -> MessageGotChunkCallback) -> C_MessageGotChunkCallback
wrap_MessageWroteBodyDataCallback a -> MessageGotChunkCallback
wrapped
    FunPtr C_MessageGotChunkCallback
wrapped'' <- C_MessageGotChunkCallback -> IO (FunPtr C_MessageGotChunkCallback)
mk_MessageWroteBodyDataCallback C_MessageGotChunkCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageGotChunkCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"wrote-body-data" FunPtr C_MessageGotChunkCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageWroteBodyDataSignalInfo
instance SignalInfo MessageWroteBodyDataSignalInfo where
    type HaskellCallbackType MessageWroteBodyDataSignalInfo = MessageWroteBodyDataCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageWroteBodyDataCallback cb
        cb'' <- mk_MessageWroteBodyDataCallback cb'
        connectSignalFunPtr obj "wrote-body-data" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::wrote-body-data"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:wroteBodyData"})

#endif

-- signal Message::wrote-chunk
-- | Emitted immediately after writing a body chunk for a message.
-- 
-- Note that this signal is not parallel to
-- t'GI.Soup.Objects.Message.Message'::@/got_chunk/@; it is emitted only when a complete
-- chunk (added with @/soup_message_body_append()/@ or
-- 'GI.Soup.Structs.MessageBody.messageBodyAppendBuffer') has been written. To get
-- more useful continuous progress information, use
-- t'GI.Soup.Objects.Message.Message'::@/wrote_body_data/@.
type MessageWroteChunkCallback =
    IO ()

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

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

wrap_MessageWroteChunkCallback :: 
    GObject a => (a -> MessageWroteChunkCallback) ->
    C_MessageWroteChunkCallback
wrap_MessageWroteChunkCallback :: forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageWroteChunkCallback a -> IO ()
gi'cb Ptr Message
gi'selfPtr Ptr ()
_ = do
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> IO ()
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self) 


-- | Connect a signal handler for the [wroteChunk](#signal:wroteChunk) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #wroteChunk callback
-- @
-- 
-- 
onMessageWroteChunk :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageWroteChunkCallback) -> m SignalHandlerId
onMessageWroteChunk :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMessageWroteChunk a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MessageFinishedCallback
wrapped' = (a -> IO ()) -> C_MessageFinishedCallback
forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageWroteChunkCallback a -> IO ()
wrapped
    FunPtr C_MessageFinishedCallback
wrapped'' <- C_MessageFinishedCallback -> IO (FunPtr C_MessageFinishedCallback)
mk_MessageWroteChunkCallback C_MessageFinishedCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"wrote-chunk" FunPtr C_MessageFinishedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageWroteChunkSignalInfo
instance SignalInfo MessageWroteChunkSignalInfo where
    type HaskellCallbackType MessageWroteChunkSignalInfo = MessageWroteChunkCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageWroteChunkCallback cb
        cb'' <- mk_MessageWroteChunkCallback cb'
        connectSignalFunPtr obj "wrote-chunk" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::wrote-chunk"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:wroteChunk"})

#endif

-- signal Message::wrote-headers
-- | Emitted immediately after writing the headers for a
-- message. (For a client-side message, this is after writing
-- the request headers; for a server-side message, it is after
-- writing the response headers.)
type MessageWroteHeadersCallback =
    IO ()

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

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

wrap_MessageWroteHeadersCallback :: 
    GObject a => (a -> MessageWroteHeadersCallback) ->
    C_MessageWroteHeadersCallback
wrap_MessageWroteHeadersCallback :: forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageWroteHeadersCallback a -> IO ()
gi'cb Ptr Message
gi'selfPtr Ptr ()
_ = do
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> IO ()
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self) 


-- | Connect a signal handler for the [wroteHeaders](#signal:wroteHeaders) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #wroteHeaders callback
-- @
-- 
-- 
onMessageWroteHeaders :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageWroteHeadersCallback) -> m SignalHandlerId
onMessageWroteHeaders :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMessageWroteHeaders a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MessageFinishedCallback
wrapped' = (a -> IO ()) -> C_MessageFinishedCallback
forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageWroteHeadersCallback a -> IO ()
wrapped
    FunPtr C_MessageFinishedCallback
wrapped'' <- C_MessageFinishedCallback -> IO (FunPtr C_MessageFinishedCallback)
mk_MessageWroteHeadersCallback C_MessageFinishedCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"wrote-headers" FunPtr C_MessageFinishedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageWroteHeadersSignalInfo
instance SignalInfo MessageWroteHeadersSignalInfo where
    type HaskellCallbackType MessageWroteHeadersSignalInfo = MessageWroteHeadersCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageWroteHeadersCallback cb
        cb'' <- mk_MessageWroteHeadersCallback cb'
        connectSignalFunPtr obj "wrote-headers" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::wrote-headers"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:wroteHeaders"})

#endif

-- signal Message::wrote-informational
-- | Emitted immediately after writing a 1xx (Informational)
-- response for a (server-side) message.
type MessageWroteInformationalCallback =
    IO ()

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

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

wrap_MessageWroteInformationalCallback :: 
    GObject a => (a -> MessageWroteInformationalCallback) ->
    C_MessageWroteInformationalCallback
wrap_MessageWroteInformationalCallback :: forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageWroteInformationalCallback a -> IO ()
gi'cb Ptr Message
gi'selfPtr Ptr ()
_ = do
    Ptr Message -> (Message -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Message
gi'selfPtr ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
gi'self -> a -> IO ()
gi'cb (Message -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Message
gi'self) 


-- | Connect a signal handler for the [wroteInformational](#signal:wroteInformational) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' message #wroteInformational callback
-- @
-- 
-- 
onMessageWroteInformational :: (IsMessage a, MonadIO m) => a -> ((?self :: a) => MessageWroteInformationalCallback) -> m SignalHandlerId
onMessageWroteInformational :: forall a (m :: * -> *).
(IsMessage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMessageWroteInformational a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MessageFinishedCallback
wrapped' = (a -> IO ()) -> C_MessageFinishedCallback
forall a. GObject a => (a -> IO ()) -> C_MessageFinishedCallback
wrap_MessageWroteInformationalCallback a -> IO ()
wrapped
    FunPtr C_MessageFinishedCallback
wrapped'' <- C_MessageFinishedCallback -> IO (FunPtr C_MessageFinishedCallback)
mk_MessageWroteInformationalCallback C_MessageFinishedCallback
wrapped'
    a
-> Text
-> FunPtr C_MessageFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"wrote-informational" FunPtr C_MessageFinishedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data MessageWroteInformationalSignalInfo
instance SignalInfo MessageWroteInformationalSignalInfo where
    type HaskellCallbackType MessageWroteInformationalSignalInfo = MessageWroteInformationalCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MessageWroteInformationalCallback cb
        cb'' <- mk_MessageWroteInformationalCallback cb'
        connectSignalFunPtr obj "wrote-informational" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message::wrote-informational"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:signal:wroteInformational"})

#endif

-- VVV Prop "first-party"
   -- Type: TInterface (Name {namespace = "Soup", name = "URI"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@first-party@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #firstParty
-- @
getMessageFirstParty :: (MonadIO m, IsMessage o) => o -> m Soup.URI.URI
getMessageFirstParty :: forall (m :: * -> *) o. (MonadIO m, IsMessage o) => o -> m URI
getMessageFirstParty o
obj = IO URI -> m URI
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe URI) -> IO URI
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getMessageFirstParty" (IO (Maybe URI) -> IO URI) -> IO (Maybe URI) -> IO URI
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr URI -> URI) -> IO (Maybe URI)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"first-party" ManagedPtr URI -> URI
Soup.URI.URI

-- | Set the value of the “@first-party@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' message [ #firstParty 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageFirstParty :: (MonadIO m, IsMessage o) => o -> Soup.URI.URI -> m ()
setMessageFirstParty :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> URI -> m ()
setMessageFirstParty o
obj URI
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe URI -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"first-party" (URI -> Maybe URI
forall a. a -> Maybe a
Just URI
val)

-- | Construct a `GValueConstruct` with valid value for the “@first-party@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMessageFirstParty :: (IsMessage o, MIO.MonadIO m) => Soup.URI.URI -> m (GValueConstruct o)
constructMessageFirstParty :: forall o (m :: * -> *).
(IsMessage o, MonadIO m) =>
URI -> m (GValueConstruct o)
constructMessageFirstParty URI
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"first-party" (URI -> Maybe URI
forall a. a -> Maybe a
P.Just URI
val)

#if defined(ENABLE_OVERLOADING)
data MessageFirstPartyPropertyInfo
instance AttrInfo MessageFirstPartyPropertyInfo where
    type AttrAllowedOps MessageFirstPartyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MessageFirstPartyPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageFirstPartyPropertyInfo = (~) Soup.URI.URI
    type AttrTransferTypeConstraint MessageFirstPartyPropertyInfo = (~) Soup.URI.URI
    type AttrTransferType MessageFirstPartyPropertyInfo = Soup.URI.URI
    type AttrGetType MessageFirstPartyPropertyInfo = Soup.URI.URI
    type AttrLabel MessageFirstPartyPropertyInfo = "first-party"
    type AttrOrigin MessageFirstPartyPropertyInfo = Message
    attrGet = getMessageFirstParty
    attrSet = setMessageFirstParty
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageFirstParty
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.firstParty"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:firstParty"
        })
#endif

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

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

-- | Set the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' message [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageFlags :: (MonadIO m, IsMessage o) => o -> [Soup.Flags.MessageFlags] -> m ()
setMessageFlags :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> [MessageFlags] -> m ()
setMessageFlags o
obj [MessageFlags]
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> [MessageFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"flags" [MessageFlags]
val

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

#if defined(ENABLE_OVERLOADING)
data MessageFlagsPropertyInfo
instance AttrInfo MessageFlagsPropertyInfo where
    type AttrAllowedOps MessageFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MessageFlagsPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageFlagsPropertyInfo = (~) [Soup.Flags.MessageFlags]
    type AttrTransferTypeConstraint MessageFlagsPropertyInfo = (~) [Soup.Flags.MessageFlags]
    type AttrTransferType MessageFlagsPropertyInfo = [Soup.Flags.MessageFlags]
    type AttrGetType MessageFlagsPropertyInfo = [Soup.Flags.MessageFlags]
    type AttrLabel MessageFlagsPropertyInfo = "flags"
    type AttrOrigin MessageFlagsPropertyInfo = Message
    attrGet = getMessageFlags
    attrSet = setMessageFlags
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:flags"
        })
#endif

-- VVV Prop "http-version"
   -- Type: TInterface (Name {namespace = "Soup", name = "HTTPVersion"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@http-version@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #httpVersion
-- @
getMessageHttpVersion :: (MonadIO m, IsMessage o) => o -> m Soup.Enums.HTTPVersion
getMessageHttpVersion :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> m HTTPVersion
getMessageHttpVersion o
obj = IO HTTPVersion -> m HTTPVersion
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO HTTPVersion -> m HTTPVersion)
-> IO HTTPVersion -> m HTTPVersion
forall a b. (a -> b) -> a -> b
$ o -> String -> IO HTTPVersion
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"http-version"

-- | Set the value of the “@http-version@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' message [ #httpVersion 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageHttpVersion :: (MonadIO m, IsMessage o) => o -> Soup.Enums.HTTPVersion -> m ()
setMessageHttpVersion :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> HTTPVersion -> m ()
setMessageHttpVersion o
obj HTTPVersion
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> HTTPVersion -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"http-version" HTTPVersion
val

-- | Construct a `GValueConstruct` with valid value for the “@http-version@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMessageHttpVersion :: (IsMessage o, MIO.MonadIO m) => Soup.Enums.HTTPVersion -> m (GValueConstruct o)
constructMessageHttpVersion :: forall o (m :: * -> *).
(IsMessage o, MonadIO m) =>
HTTPVersion -> m (GValueConstruct o)
constructMessageHttpVersion HTTPVersion
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> HTTPVersion -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"http-version" HTTPVersion
val

#if defined(ENABLE_OVERLOADING)
data MessageHttpVersionPropertyInfo
instance AttrInfo MessageHttpVersionPropertyInfo where
    type AttrAllowedOps MessageHttpVersionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MessageHttpVersionPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageHttpVersionPropertyInfo = (~) Soup.Enums.HTTPVersion
    type AttrTransferTypeConstraint MessageHttpVersionPropertyInfo = (~) Soup.Enums.HTTPVersion
    type AttrTransferType MessageHttpVersionPropertyInfo = Soup.Enums.HTTPVersion
    type AttrGetType MessageHttpVersionPropertyInfo = Soup.Enums.HTTPVersion
    type AttrLabel MessageHttpVersionPropertyInfo = "http-version"
    type AttrOrigin MessageHttpVersionPropertyInfo = Message
    attrGet = getMessageHttpVersion
    attrSet = setMessageHttpVersion
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageHttpVersion
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.httpVersion"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:httpVersion"
        })
#endif

-- VVV Prop "is-top-level-navigation"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

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

#if defined(ENABLE_OVERLOADING)
data MessageIsTopLevelNavigationPropertyInfo
instance AttrInfo MessageIsTopLevelNavigationPropertyInfo where
    type AttrAllowedOps MessageIsTopLevelNavigationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MessageIsTopLevelNavigationPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageIsTopLevelNavigationPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MessageIsTopLevelNavigationPropertyInfo = (~) Bool
    type AttrTransferType MessageIsTopLevelNavigationPropertyInfo = Bool
    type AttrGetType MessageIsTopLevelNavigationPropertyInfo = Bool
    type AttrLabel MessageIsTopLevelNavigationPropertyInfo = "is-top-level-navigation"
    type AttrOrigin MessageIsTopLevelNavigationPropertyInfo = Message
    attrGet = getMessageIsTopLevelNavigation
    attrSet = setMessageIsTopLevelNavigation
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageIsTopLevelNavigation
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.isTopLevelNavigation"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:isTopLevelNavigation"
        })
#endif

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

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

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

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

-- | Set the value of the “@method@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #method
-- @
clearMessageMethod :: (MonadIO m, IsMessage o) => o -> m ()
clearMessageMethod :: forall (m :: * -> *) o. (MonadIO m, IsMessage o) => o -> m ()
clearMessageMethod o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"method" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data MessageMethodPropertyInfo
instance AttrInfo MessageMethodPropertyInfo where
    type AttrAllowedOps MessageMethodPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MessageMethodPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageMethodPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint MessageMethodPropertyInfo = (~) T.Text
    type AttrTransferType MessageMethodPropertyInfo = T.Text
    type AttrGetType MessageMethodPropertyInfo = (Maybe T.Text)
    type AttrLabel MessageMethodPropertyInfo = "method"
    type AttrOrigin MessageMethodPropertyInfo = Message
    attrGet = getMessageMethod
    attrSet = setMessageMethod
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageMethod
    attrClear = clearMessageMethod
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.method"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:method"
        })
#endif

-- VVV Prop "priority"
   -- Type: TInterface (Name {namespace = "Soup", name = "MessagePriority"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #priority
-- @
getMessagePriority :: (MonadIO m, IsMessage o) => o -> m Soup.Enums.MessagePriority
getMessagePriority :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> m MessagePriority
getMessagePriority o
obj = IO MessagePriority -> m MessagePriority
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO MessagePriority -> m MessagePriority)
-> IO MessagePriority -> m MessagePriority
forall a b. (a -> b) -> a -> b
$ o -> String -> IO MessagePriority
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"priority"

-- | Set the value of the “@priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' message [ #priority 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessagePriority :: (MonadIO m, IsMessage o) => o -> Soup.Enums.MessagePriority -> m ()
setMessagePriority :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> MessagePriority -> m ()
setMessagePriority o
obj MessagePriority
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> MessagePriority -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"priority" MessagePriority
val

-- | Construct a `GValueConstruct` with valid value for the “@priority@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMessagePriority :: (IsMessage o, MIO.MonadIO m) => Soup.Enums.MessagePriority -> m (GValueConstruct o)
constructMessagePriority :: forall o (m :: * -> *).
(IsMessage o, MonadIO m) =>
MessagePriority -> m (GValueConstruct o)
constructMessagePriority MessagePriority
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> MessagePriority -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"priority" MessagePriority
val

#if defined(ENABLE_OVERLOADING)
data MessagePriorityPropertyInfo
instance AttrInfo MessagePriorityPropertyInfo where
    type AttrAllowedOps MessagePriorityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MessagePriorityPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessagePriorityPropertyInfo = (~) Soup.Enums.MessagePriority
    type AttrTransferTypeConstraint MessagePriorityPropertyInfo = (~) Soup.Enums.MessagePriority
    type AttrTransferType MessagePriorityPropertyInfo = Soup.Enums.MessagePriority
    type AttrGetType MessagePriorityPropertyInfo = Soup.Enums.MessagePriority
    type AttrLabel MessagePriorityPropertyInfo = "priority"
    type AttrOrigin MessagePriorityPropertyInfo = Message
    attrGet = getMessagePriority
    attrSet = setMessagePriority
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessagePriority
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.priority"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:priority"
        })
#endif

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

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

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

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

-- | Set the value of the “@reason-phrase@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #reasonPhrase
-- @
clearMessageReasonPhrase :: (MonadIO m, IsMessage o) => o -> m ()
clearMessageReasonPhrase :: forall (m :: * -> *) o. (MonadIO m, IsMessage o) => o -> m ()
clearMessageReasonPhrase o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"reason-phrase" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data MessageReasonPhrasePropertyInfo
instance AttrInfo MessageReasonPhrasePropertyInfo where
    type AttrAllowedOps MessageReasonPhrasePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MessageReasonPhrasePropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageReasonPhrasePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint MessageReasonPhrasePropertyInfo = (~) T.Text
    type AttrTransferType MessageReasonPhrasePropertyInfo = T.Text
    type AttrGetType MessageReasonPhrasePropertyInfo = (Maybe T.Text)
    type AttrLabel MessageReasonPhrasePropertyInfo = "reason-phrase"
    type AttrOrigin MessageReasonPhrasePropertyInfo = Message
    attrGet = getMessageReasonPhrase
    attrSet = setMessageReasonPhrase
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageReasonPhrase
    attrClear = clearMessageReasonPhrase
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.reasonPhrase"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:reasonPhrase"
        })
#endif

-- VVV Prop "request-body"
   -- Type: TInterface (Name {namespace = "Soup", name = "MessageBody"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@request-body@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #requestBody
-- @
getMessageRequestBody :: (MonadIO m, IsMessage o) => o -> m (Maybe Soup.MessageBody.MessageBody)
getMessageRequestBody :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> m (Maybe MessageBody)
getMessageRequestBody o
obj = IO (Maybe MessageBody) -> m (Maybe MessageBody)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe MessageBody) -> m (Maybe MessageBody))
-> IO (Maybe MessageBody) -> m (Maybe MessageBody)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr MessageBody -> MessageBody)
-> IO (Maybe MessageBody)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"request-body" ManagedPtr MessageBody -> MessageBody
Soup.MessageBody.MessageBody

#if defined(ENABLE_OVERLOADING)
data MessageRequestBodyPropertyInfo
instance AttrInfo MessageRequestBodyPropertyInfo where
    type AttrAllowedOps MessageRequestBodyPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MessageRequestBodyPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageRequestBodyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MessageRequestBodyPropertyInfo = (~) ()
    type AttrTransferType MessageRequestBodyPropertyInfo = ()
    type AttrGetType MessageRequestBodyPropertyInfo = (Maybe Soup.MessageBody.MessageBody)
    type AttrLabel MessageRequestBodyPropertyInfo = "request-body"
    type AttrOrigin MessageRequestBodyPropertyInfo = Message
    attrGet = getMessageRequestBody
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.requestBody"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:requestBody"
        })
#endif

-- VVV Prop "request-body-data"
   -- Type: TInterface (Name {namespace = "GLib", name = "Bytes"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@request-body-data@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #requestBodyData
-- @
getMessageRequestBodyData :: (MonadIO m, IsMessage o) => o -> m (Maybe GLib.Bytes.Bytes)
getMessageRequestBodyData :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> m (Maybe Bytes)
getMessageRequestBodyData o
obj = IO (Maybe Bytes) -> m (Maybe Bytes)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Bytes) -> m (Maybe Bytes))
-> IO (Maybe Bytes) -> m (Maybe Bytes)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Bytes -> Bytes) -> IO (Maybe Bytes)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"request-body-data" ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes

#if defined(ENABLE_OVERLOADING)
data MessageRequestBodyDataPropertyInfo
instance AttrInfo MessageRequestBodyDataPropertyInfo where
    type AttrAllowedOps MessageRequestBodyDataPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MessageRequestBodyDataPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageRequestBodyDataPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MessageRequestBodyDataPropertyInfo = (~) ()
    type AttrTransferType MessageRequestBodyDataPropertyInfo = ()
    type AttrGetType MessageRequestBodyDataPropertyInfo = (Maybe GLib.Bytes.Bytes)
    type AttrLabel MessageRequestBodyDataPropertyInfo = "request-body-data"
    type AttrOrigin MessageRequestBodyDataPropertyInfo = Message
    attrGet = getMessageRequestBodyData
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.requestBodyData"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:requestBodyData"
        })
#endif

-- VVV Prop "request-headers"
   -- Type: TInterface (Name {namespace = "Soup", name = "MessageHeaders"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@request-headers@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #requestHeaders
-- @
getMessageRequestHeaders :: (MonadIO m, IsMessage o) => o -> m (Maybe Soup.MessageHeaders.MessageHeaders)
getMessageRequestHeaders :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> m (Maybe MessageHeaders)
getMessageRequestHeaders o
obj = IO (Maybe MessageHeaders) -> m (Maybe MessageHeaders)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe MessageHeaders) -> m (Maybe MessageHeaders))
-> IO (Maybe MessageHeaders) -> m (Maybe MessageHeaders)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr MessageHeaders -> MessageHeaders)
-> IO (Maybe MessageHeaders)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"request-headers" ManagedPtr MessageHeaders -> MessageHeaders
Soup.MessageHeaders.MessageHeaders

#if defined(ENABLE_OVERLOADING)
data MessageRequestHeadersPropertyInfo
instance AttrInfo MessageRequestHeadersPropertyInfo where
    type AttrAllowedOps MessageRequestHeadersPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MessageRequestHeadersPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageRequestHeadersPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MessageRequestHeadersPropertyInfo = (~) ()
    type AttrTransferType MessageRequestHeadersPropertyInfo = ()
    type AttrGetType MessageRequestHeadersPropertyInfo = (Maybe Soup.MessageHeaders.MessageHeaders)
    type AttrLabel MessageRequestHeadersPropertyInfo = "request-headers"
    type AttrOrigin MessageRequestHeadersPropertyInfo = Message
    attrGet = getMessageRequestHeaders
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.requestHeaders"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:requestHeaders"
        })
#endif

-- VVV Prop "response-body"
   -- Type: TInterface (Name {namespace = "Soup", name = "MessageBody"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@response-body@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #responseBody
-- @
getMessageResponseBody :: (MonadIO m, IsMessage o) => o -> m (Maybe Soup.MessageBody.MessageBody)
getMessageResponseBody :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> m (Maybe MessageBody)
getMessageResponseBody o
obj = IO (Maybe MessageBody) -> m (Maybe MessageBody)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe MessageBody) -> m (Maybe MessageBody))
-> IO (Maybe MessageBody) -> m (Maybe MessageBody)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr MessageBody -> MessageBody)
-> IO (Maybe MessageBody)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"response-body" ManagedPtr MessageBody -> MessageBody
Soup.MessageBody.MessageBody

#if defined(ENABLE_OVERLOADING)
data MessageResponseBodyPropertyInfo
instance AttrInfo MessageResponseBodyPropertyInfo where
    type AttrAllowedOps MessageResponseBodyPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MessageResponseBodyPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageResponseBodyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MessageResponseBodyPropertyInfo = (~) ()
    type AttrTransferType MessageResponseBodyPropertyInfo = ()
    type AttrGetType MessageResponseBodyPropertyInfo = (Maybe Soup.MessageBody.MessageBody)
    type AttrLabel MessageResponseBodyPropertyInfo = "response-body"
    type AttrOrigin MessageResponseBodyPropertyInfo = Message
    attrGet = getMessageResponseBody
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.responseBody"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:responseBody"
        })
#endif

-- VVV Prop "response-body-data"
   -- Type: TInterface (Name {namespace = "GLib", name = "Bytes"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@response-body-data@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #responseBodyData
-- @
getMessageResponseBodyData :: (MonadIO m, IsMessage o) => o -> m (Maybe GLib.Bytes.Bytes)
getMessageResponseBodyData :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> m (Maybe Bytes)
getMessageResponseBodyData o
obj = IO (Maybe Bytes) -> m (Maybe Bytes)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Bytes) -> m (Maybe Bytes))
-> IO (Maybe Bytes) -> m (Maybe Bytes)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Bytes -> Bytes) -> IO (Maybe Bytes)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"response-body-data" ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes

#if defined(ENABLE_OVERLOADING)
data MessageResponseBodyDataPropertyInfo
instance AttrInfo MessageResponseBodyDataPropertyInfo where
    type AttrAllowedOps MessageResponseBodyDataPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MessageResponseBodyDataPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageResponseBodyDataPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MessageResponseBodyDataPropertyInfo = (~) ()
    type AttrTransferType MessageResponseBodyDataPropertyInfo = ()
    type AttrGetType MessageResponseBodyDataPropertyInfo = (Maybe GLib.Bytes.Bytes)
    type AttrLabel MessageResponseBodyDataPropertyInfo = "response-body-data"
    type AttrOrigin MessageResponseBodyDataPropertyInfo = Message
    attrGet = getMessageResponseBodyData
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.responseBodyData"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:responseBodyData"
        })
#endif

-- VVV Prop "response-headers"
   -- Type: TInterface (Name {namespace = "Soup", name = "MessageHeaders"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@response-headers@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #responseHeaders
-- @
getMessageResponseHeaders :: (MonadIO m, IsMessage o) => o -> m (Maybe Soup.MessageHeaders.MessageHeaders)
getMessageResponseHeaders :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> m (Maybe MessageHeaders)
getMessageResponseHeaders o
obj = IO (Maybe MessageHeaders) -> m (Maybe MessageHeaders)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe MessageHeaders) -> m (Maybe MessageHeaders))
-> IO (Maybe MessageHeaders) -> m (Maybe MessageHeaders)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr MessageHeaders -> MessageHeaders)
-> IO (Maybe MessageHeaders)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"response-headers" ManagedPtr MessageHeaders -> MessageHeaders
Soup.MessageHeaders.MessageHeaders

#if defined(ENABLE_OVERLOADING)
data MessageResponseHeadersPropertyInfo
instance AttrInfo MessageResponseHeadersPropertyInfo where
    type AttrAllowedOps MessageResponseHeadersPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MessageResponseHeadersPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageResponseHeadersPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MessageResponseHeadersPropertyInfo = (~) ()
    type AttrTransferType MessageResponseHeadersPropertyInfo = ()
    type AttrGetType MessageResponseHeadersPropertyInfo = (Maybe Soup.MessageHeaders.MessageHeaders)
    type AttrLabel MessageResponseHeadersPropertyInfo = "response-headers"
    type AttrOrigin MessageResponseHeadersPropertyInfo = Message
    attrGet = getMessageResponseHeaders
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.responseHeaders"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:responseHeaders"
        })
#endif

-- VVV Prop "server-side"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
data MessageServerSidePropertyInfo
instance AttrInfo MessageServerSidePropertyInfo where
    type AttrAllowedOps MessageServerSidePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MessageServerSidePropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageServerSidePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint MessageServerSidePropertyInfo = (~) Bool
    type AttrTransferType MessageServerSidePropertyInfo = Bool
    type AttrGetType MessageServerSidePropertyInfo = Bool
    type AttrLabel MessageServerSidePropertyInfo = "server-side"
    type AttrOrigin MessageServerSidePropertyInfo = Message
    attrGet = getMessageServerSide
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageServerSide
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.serverSide"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:serverSide"
        })
#endif

-- VVV Prop "site-for-cookies"
   -- Type: TInterface (Name {namespace = "Soup", name = "URI"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just True)

-- | Get the value of the “@site-for-cookies@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #siteForCookies
-- @
getMessageSiteForCookies :: (MonadIO m, IsMessage o) => o -> m Soup.URI.URI
getMessageSiteForCookies :: forall (m :: * -> *) o. (MonadIO m, IsMessage o) => o -> m URI
getMessageSiteForCookies o
obj = IO URI -> m URI
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe URI) -> IO URI
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getMessageSiteForCookies" (IO (Maybe URI) -> IO URI) -> IO (Maybe URI) -> IO URI
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr URI -> URI) -> IO (Maybe URI)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"site-for-cookies" ManagedPtr URI -> URI
Soup.URI.URI

-- | Set the value of the “@site-for-cookies@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' message [ #siteForCookies 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageSiteForCookies :: (MonadIO m, IsMessage o) => o -> Soup.URI.URI -> m ()
setMessageSiteForCookies :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> URI -> m ()
setMessageSiteForCookies o
obj URI
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe URI -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"site-for-cookies" (URI -> Maybe URI
forall a. a -> Maybe a
Just URI
val)

-- | Construct a `GValueConstruct` with valid value for the “@site-for-cookies@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMessageSiteForCookies :: (IsMessage o, MIO.MonadIO m) => Soup.URI.URI -> m (GValueConstruct o)
constructMessageSiteForCookies :: forall o (m :: * -> *).
(IsMessage o, MonadIO m) =>
URI -> m (GValueConstruct o)
constructMessageSiteForCookies URI
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"site-for-cookies" (URI -> Maybe URI
forall a. a -> Maybe a
P.Just URI
val)

-- | Set the value of the “@site-for-cookies@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #siteForCookies
-- @
clearMessageSiteForCookies :: (MonadIO m, IsMessage o) => o -> m ()
clearMessageSiteForCookies :: forall (m :: * -> *) o. (MonadIO m, IsMessage o) => o -> m ()
clearMessageSiteForCookies o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe URI -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"site-for-cookies" (Maybe URI
forall a. Maybe a
Nothing :: Maybe Soup.URI.URI)

#if defined(ENABLE_OVERLOADING)
data MessageSiteForCookiesPropertyInfo
instance AttrInfo MessageSiteForCookiesPropertyInfo where
    type AttrAllowedOps MessageSiteForCookiesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MessageSiteForCookiesPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageSiteForCookiesPropertyInfo = (~) Soup.URI.URI
    type AttrTransferTypeConstraint MessageSiteForCookiesPropertyInfo = (~) Soup.URI.URI
    type AttrTransferType MessageSiteForCookiesPropertyInfo = Soup.URI.URI
    type AttrGetType MessageSiteForCookiesPropertyInfo = Soup.URI.URI
    type AttrLabel MessageSiteForCookiesPropertyInfo = "site-for-cookies"
    type AttrOrigin MessageSiteForCookiesPropertyInfo = Message
    attrGet = getMessageSiteForCookies
    attrSet = setMessageSiteForCookies
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageSiteForCookies
    attrClear = clearMessageSiteForCookies
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.siteForCookies"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:siteForCookies"
        })
#endif

-- VVV Prop "status-code"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

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

#if defined(ENABLE_OVERLOADING)
data MessageStatusCodePropertyInfo
instance AttrInfo MessageStatusCodePropertyInfo where
    type AttrAllowedOps MessageStatusCodePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MessageStatusCodePropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageStatusCodePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint MessageStatusCodePropertyInfo = (~) Word32
    type AttrTransferType MessageStatusCodePropertyInfo = Word32
    type AttrGetType MessageStatusCodePropertyInfo = Word32
    type AttrLabel MessageStatusCodePropertyInfo = "status-code"
    type AttrOrigin MessageStatusCodePropertyInfo = Message
    attrGet = getMessageStatusCode
    attrSet = setMessageStatusCode
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageStatusCode
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.statusCode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:statusCode"
        })
#endif

-- VVV Prop "tls-certificate"
   -- Type: TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data MessageTlsCertificatePropertyInfo
instance AttrInfo MessageTlsCertificatePropertyInfo where
    type AttrAllowedOps MessageTlsCertificatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MessageTlsCertificatePropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageTlsCertificatePropertyInfo = Gio.TlsCertificate.IsTlsCertificate
    type AttrTransferTypeConstraint MessageTlsCertificatePropertyInfo = Gio.TlsCertificate.IsTlsCertificate
    type AttrTransferType MessageTlsCertificatePropertyInfo = Gio.TlsCertificate.TlsCertificate
    type AttrGetType MessageTlsCertificatePropertyInfo = (Maybe Gio.TlsCertificate.TlsCertificate)
    type AttrLabel MessageTlsCertificatePropertyInfo = "tls-certificate"
    type AttrOrigin MessageTlsCertificatePropertyInfo = Message
    attrGet = getMessageTlsCertificate
    attrSet = setMessageTlsCertificate
    attrTransfer _ v = do
        unsafeCastTo Gio.TlsCertificate.TlsCertificate v
    attrConstruct = constructMessageTlsCertificate
    attrClear = clearMessageTlsCertificate
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.tlsCertificate"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:tlsCertificate"
        })
#endif

-- VVV Prop "tls-errors"
   -- Type: TInterface (Name {namespace = "Gio", name = "TlsCertificateFlags"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@tls-errors@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' message [ #tlsErrors 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageTlsErrors :: (MonadIO m, IsMessage o) => o -> [Gio.Flags.TlsCertificateFlags] -> m ()
setMessageTlsErrors :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> [TlsCertificateFlags] -> m ()
setMessageTlsErrors o
obj [TlsCertificateFlags]
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> [TlsCertificateFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"tls-errors" [TlsCertificateFlags]
val

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

#if defined(ENABLE_OVERLOADING)
data MessageTlsErrorsPropertyInfo
instance AttrInfo MessageTlsErrorsPropertyInfo where
    type AttrAllowedOps MessageTlsErrorsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MessageTlsErrorsPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageTlsErrorsPropertyInfo = (~) [Gio.Flags.TlsCertificateFlags]
    type AttrTransferTypeConstraint MessageTlsErrorsPropertyInfo = (~) [Gio.Flags.TlsCertificateFlags]
    type AttrTransferType MessageTlsErrorsPropertyInfo = [Gio.Flags.TlsCertificateFlags]
    type AttrGetType MessageTlsErrorsPropertyInfo = [Gio.Flags.TlsCertificateFlags]
    type AttrLabel MessageTlsErrorsPropertyInfo = "tls-errors"
    type AttrOrigin MessageTlsErrorsPropertyInfo = Message
    attrGet = getMessageTlsErrors
    attrSet = setMessageTlsErrors
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageTlsErrors
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.tlsErrors"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:tlsErrors"
        })
#endif

-- VVV Prop "uri"
   -- Type: TInterface (Name {namespace = "Soup", name = "URI"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@uri@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' message [ #uri 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageUri :: (MonadIO m, IsMessage o) => o -> Soup.URI.URI -> m ()
setMessageUri :: forall (m :: * -> *) o.
(MonadIO m, IsMessage o) =>
o -> URI -> m ()
setMessageUri o
obj URI
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe URI -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"uri" (URI -> Maybe URI
forall a. a -> Maybe a
Just URI
val)

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

#if defined(ENABLE_OVERLOADING)
data MessageUriPropertyInfo
instance AttrInfo MessageUriPropertyInfo where
    type AttrAllowedOps MessageUriPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MessageUriPropertyInfo = IsMessage
    type AttrSetTypeConstraint MessageUriPropertyInfo = (~) Soup.URI.URI
    type AttrTransferTypeConstraint MessageUriPropertyInfo = (~) Soup.URI.URI
    type AttrTransferType MessageUriPropertyInfo = Soup.URI.URI
    type AttrGetType MessageUriPropertyInfo = Soup.URI.URI
    type AttrLabel MessageUriPropertyInfo = "uri"
    type AttrOrigin MessageUriPropertyInfo = Message
    attrGet = getMessageUri
    attrSet = setMessageUri
    attrTransfer _ v = do
        return v
    attrConstruct = constructMessageUri
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Message.uri"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-Message.html#g:attr:uri"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Message
type instance O.AttributeList Message = MessageAttributeList
type MessageAttributeList = ('[ '("firstParty", MessageFirstPartyPropertyInfo), '("flags", MessageFlagsPropertyInfo), '("httpVersion", MessageHttpVersionPropertyInfo), '("isTopLevelNavigation", MessageIsTopLevelNavigationPropertyInfo), '("method", MessageMethodPropertyInfo), '("priority", MessagePriorityPropertyInfo), '("reasonPhrase", MessageReasonPhrasePropertyInfo), '("requestBody", MessageRequestBodyPropertyInfo), '("requestBodyData", MessageRequestBodyDataPropertyInfo), '("requestHeaders", MessageRequestHeadersPropertyInfo), '("responseBody", MessageResponseBodyPropertyInfo), '("responseBodyData", MessageResponseBodyDataPropertyInfo), '("responseHeaders", MessageResponseHeadersPropertyInfo), '("serverSide", MessageServerSidePropertyInfo), '("siteForCookies", MessageSiteForCookiesPropertyInfo), '("statusCode", MessageStatusCodePropertyInfo), '("tlsCertificate", MessageTlsCertificatePropertyInfo), '("tlsErrors", MessageTlsErrorsPropertyInfo), '("uri", MessageUriPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
messageFirstParty :: AttrLabelProxy "firstParty"
messageFirstParty = AttrLabelProxy

messageFlags :: AttrLabelProxy "flags"
messageFlags = AttrLabelProxy

messageHttpVersion :: AttrLabelProxy "httpVersion"
messageHttpVersion = AttrLabelProxy

messageIsTopLevelNavigation :: AttrLabelProxy "isTopLevelNavigation"
messageIsTopLevelNavigation = AttrLabelProxy

messageMethod :: AttrLabelProxy "method"
messageMethod = AttrLabelProxy

messagePriority :: AttrLabelProxy "priority"
messagePriority = AttrLabelProxy

messageReasonPhrase :: AttrLabelProxy "reasonPhrase"
messageReasonPhrase = AttrLabelProxy

messageRequestBody :: AttrLabelProxy "requestBody"
messageRequestBody = AttrLabelProxy

messageRequestBodyData :: AttrLabelProxy "requestBodyData"
messageRequestBodyData = AttrLabelProxy

messageRequestHeaders :: AttrLabelProxy "requestHeaders"
messageRequestHeaders = AttrLabelProxy

messageResponseBody :: AttrLabelProxy "responseBody"
messageResponseBody = AttrLabelProxy

messageResponseBodyData :: AttrLabelProxy "responseBodyData"
messageResponseBodyData = AttrLabelProxy

messageResponseHeaders :: AttrLabelProxy "responseHeaders"
messageResponseHeaders = AttrLabelProxy

messageServerSide :: AttrLabelProxy "serverSide"
messageServerSide = AttrLabelProxy

messageSiteForCookies :: AttrLabelProxy "siteForCookies"
messageSiteForCookies = AttrLabelProxy

messageStatusCode :: AttrLabelProxy "statusCode"
messageStatusCode = AttrLabelProxy

messageTlsCertificate :: AttrLabelProxy "tlsCertificate"
messageTlsCertificate = AttrLabelProxy

messageTlsErrors :: AttrLabelProxy "tlsErrors"
messageTlsErrors = AttrLabelProxy

messageUri :: AttrLabelProxy "uri"
messageUri = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Message = MessageSignalList
type MessageSignalList = ('[ '("contentSniffed", MessageContentSniffedSignalInfo), '("finished", MessageFinishedSignalInfo), '("gotBody", MessageGotBodySignalInfo), '("gotChunk", MessageGotChunkSignalInfo), '("gotHeaders", MessageGotHeadersSignalInfo), '("gotInformational", MessageGotInformationalSignalInfo), '("networkEvent", MessageNetworkEventSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("restarted", MessageRestartedSignalInfo), '("starting", MessageStartingSignalInfo), '("wroteBody", MessageWroteBodySignalInfo), '("wroteBodyData", MessageWroteBodyDataSignalInfo), '("wroteChunk", MessageWroteChunkSignalInfo), '("wroteHeaders", MessageWroteHeadersSignalInfo), '("wroteInformational", MessageWroteInformationalSignalInfo)] :: [(Symbol, *)])

#endif

-- method Message::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "method"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the HTTP method for the created request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri_string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the destination endpoint (as a string)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_new" soup_message_new :: 
    CString ->                              -- method : TBasicType TUTF8
    CString ->                              -- uri_string : TBasicType TUTF8
    IO (Ptr Message)

-- | Creates a new empty t'GI.Soup.Objects.Message.Message', which will connect to /@uri@/
messageNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@method@/: the HTTP method for the created request
    -> T.Text
    -- ^ /@uriString@/: the destination endpoint (as a string)
    -> m (Maybe Message)
    -- ^ __Returns:__ the new t'GI.Soup.Objects.Message.Message' (or 'P.Nothing' if /@uri@/
    -- could not be parsed).
messageNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> m (Maybe Message)
messageNew Text
method Text
uriString = IO (Maybe Message) -> m (Maybe Message)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Message) -> m (Maybe Message))
-> IO (Maybe Message) -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ do
    CString
method' <- Text -> IO CString
textToCString Text
method
    CString
uriString' <- Text -> IO CString
textToCString Text
uriString
    Ptr Message
result <- CString -> CString -> IO (Ptr Message)
soup_message_new CString
method' CString
uriString'
    Maybe Message
maybeResult <- Ptr Message -> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Message
result ((Ptr Message -> IO Message) -> IO (Maybe Message))
-> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. (a -> b) -> a -> b
$ \Ptr Message
result' -> do
        Message
result'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Message -> Message
Message) Ptr Message
result'
        Message -> IO Message
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
method'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uriString'
    Maybe Message -> IO (Maybe Message)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_from_uri
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "method"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the HTTP method for the created request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the destination endpoint (as a #SoupURI)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_new_from_uri" soup_message_new_from_uri :: 
    CString ->                              -- method : TBasicType TUTF8
    Ptr Soup.URI.URI ->                     -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO (Ptr Message)

-- | Creates a new empty t'GI.Soup.Objects.Message.Message', which will connect to /@uri@/
messageNewFromUri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@method@/: the HTTP method for the created request
    -> Soup.URI.URI
    -- ^ /@uri@/: the destination endpoint (as a t'GI.Soup.Structs.URI.URI')
    -> m Message
    -- ^ __Returns:__ the new t'GI.Soup.Objects.Message.Message'
messageNewFromUri :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> URI -> m Message
messageNewFromUri Text
method URI
uri = IO Message -> m Message
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Message -> m Message) -> IO Message -> m Message
forall a b. (a -> b) -> a -> b
$ do
    CString
method' <- Text -> IO CString
textToCString Text
method
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    Ptr Message
result <- CString -> Ptr URI -> IO (Ptr Message)
soup_message_new_from_uri CString
method' Ptr URI
uri'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"messageNewFromUri" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Message -> Message
Message) Ptr Message
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
method'
    Message -> IO Message
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::content_sniffed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType = TGHash (TBasicType TPtr) (TBasicType TPtr)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_content_sniffed" soup_message_content_sniffed :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    CString ->                              -- content_type : TBasicType TUTF8
    Ptr (GHashTable (Ptr ()) (Ptr ())) ->   -- params : TGHash (TBasicType TPtr) (TBasicType TPtr)
    IO ()

-- | /No description available in the introspection data./
messageContentSniffed ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> T.Text
    -> Map.Map (Ptr ()) (Ptr ())
    -> m ()
messageContentSniffed :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> Text -> Map (Ptr ()) (Ptr ()) -> m ()
messageContentSniffed a
msg Text
contentType Map (Ptr ()) (Ptr ())
params = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    let params' :: [(Ptr (), Ptr ())]
params' = Map (Ptr ()) (Ptr ()) -> [(Ptr (), Ptr ())]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Ptr ()) (Ptr ())
params
    let params'' :: [(PtrWrapped (Ptr ()), Ptr ())]
params'' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(Ptr (), Ptr ())] -> [(PtrWrapped (Ptr ()), Ptr ())]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
B.GHT.ptrPackPtr [(Ptr (), Ptr ())]
params'
    let params''' :: [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
params''' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(PtrWrapped (Ptr ()), Ptr ())]
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
B.GHT.ptrPackPtr [(PtrWrapped (Ptr ()), Ptr ())]
params''
    Ptr (GHashTable (Ptr ()) (Ptr ()))
params'''' <- GHashFunc (Ptr ())
-> GEqualFunc (Ptr ())
-> Maybe (GDestroyNotify (Ptr ()))
-> Maybe (GDestroyNotify (Ptr ()))
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc (Ptr ())
forall a. GHashFunc (Ptr a)
gDirectHash GEqualFunc (Ptr ())
forall a. GEqualFunc (Ptr a)
gDirectEqual Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
params'''
    Ptr Message
-> CString -> Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
soup_message_content_sniffed Ptr Message
msg' CString
contentType' Ptr (GHashTable (Ptr ()) (Ptr ()))
params''''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
    Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
params''''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageContentSniffedMethodInfo
instance (signature ~ (T.Text -> Map.Map (Ptr ()) (Ptr ()) -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageContentSniffedMethodInfo a signature where
    overloadedMethod = messageContentSniffed

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


#endif

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

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

-- | This disables the actions of t'GI.Soup.Interfaces.SessionFeature.SessionFeature's with the
-- given /@featureType@/ (or a subclass of that type) on /@msg@/, so that
-- /@msg@/ is processed as though the feature(s) hadn\'t been added to the
-- session. Eg, passing @/SOUP_TYPE_CONTENT_SNIFFER/@ for /@featureType@/
-- will disable Content-Type sniffing on the message.
-- 
-- You must call this before queueing /@msg@/ on a session; calling it on
-- a message that has already been queued is undefined. In particular,
-- you cannot call this on a message that is being requeued after a
-- redirect or authentication.
-- 
-- /Since: 2.28/
messageDisableFeature ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> GType
    -- ^ /@featureType@/: the t'GType' of a t'GI.Soup.Interfaces.SessionFeature.SessionFeature'
    -> m ()
messageDisableFeature :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> GType -> m ()
messageDisableFeature a
msg GType
featureType = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    let featureType' :: CGType
featureType' = GType -> CGType
gtypeToCGType GType
featureType
    Ptr Message -> CGType -> IO ()
soup_message_disable_feature Ptr Message
msg' CGType
featureType'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageDisableFeatureMethodInfo
instance (signature ~ (GType -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageDisableFeatureMethodInfo a signature where
    overloadedMethod = messageDisableFeature

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


#endif

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

foreign import ccall "soup_message_finished" soup_message_finished :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO ()

-- | /No description available in the introspection data./
messageFinished ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> m ()
messageFinished :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m ()
messageFinished a
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> IO ()
soup_message_finished Ptr Message
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageFinishedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageFinishedMethodInfo a signature where
    overloadedMethod = messageFinished

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


#endif

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

foreign import ccall "soup_message_get_address" soup_message_get_address :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO (Ptr Soup.Address.Address)

-- | Gets the address /@msg@/\'s URI points to. After first setting the
-- URI on a message, this will be unresolved, although the message\'s
-- session will resolve it before sending the message.
-- 
-- /Since: 2.26/
messageGetAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m Soup.Address.Address
    -- ^ __Returns:__ the address /@msg@/\'s URI points to
messageGetAddress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m Address
messageGetAddress a
msg = IO Address -> m Address
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Address -> m Address) -> IO Address -> m Address
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Address
result <- Ptr Message -> IO (Ptr Address)
soup_message_get_address Ptr Message
msg'
    Text -> Ptr Address -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"messageGetAddress" Ptr Address
result
    Address
result' <- ((ManagedPtr Address -> Address) -> Ptr Address -> IO Address
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Address -> Address
Soup.Address.Address) Ptr Address
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    Address -> IO Address
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Address
result'

#if defined(ENABLE_OVERLOADING)
data MessageGetAddressMethodInfo
instance (signature ~ (m Soup.Address.Address), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGetAddressMethodInfo a signature where
    overloadedMethod = messageGetAddress

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


#endif

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

foreign import ccall "soup_message_get_first_party" soup_message_get_first_party :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO (Ptr Soup.URI.URI)

-- | Gets /@msg@/\'s first-party t'GI.Soup.Structs.URI.URI'
-- 
-- /Since: 2.30/
messageGetFirstParty ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m Soup.URI.URI
    -- ^ __Returns:__ the /@msg@/\'s first party t'GI.Soup.Structs.URI.URI'
messageGetFirstParty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m URI
messageGetFirstParty a
msg = IO URI -> m URI
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr URI
result <- Ptr Message -> IO (Ptr URI)
soup_message_get_first_party Ptr Message
msg'
    Text -> Ptr URI -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"messageGetFirstParty" Ptr URI
result
    URI
result' <- ((ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr URI -> URI
Soup.URI.URI) Ptr URI
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    URI -> IO URI
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return URI
result'

#if defined(ENABLE_OVERLOADING)
data MessageGetFirstPartyMethodInfo
instance (signature ~ (m Soup.URI.URI), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGetFirstPartyMethodInfo a signature where
    overloadedMethod = messageGetFirstParty

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


#endif

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

foreign import ccall "soup_message_get_flags" soup_message_get_flags :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO CUInt

-- | Gets the flags on /@msg@/
messageGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m [Soup.Flags.MessageFlags]
    -- ^ __Returns:__ the flags
messageGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m [MessageFlags]
messageGetFlags a
msg = IO [MessageFlags] -> m [MessageFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [MessageFlags] -> m [MessageFlags])
-> IO [MessageFlags] -> m [MessageFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CUInt
result <- Ptr Message -> IO CUInt
soup_message_get_flags Ptr Message
msg'
    let result' :: [MessageFlags]
result' = CUInt -> [MessageFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    [MessageFlags] -> IO [MessageFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [MessageFlags]
result'

#if defined(ENABLE_OVERLOADING)
data MessageGetFlagsMethodInfo
instance (signature ~ (m [Soup.Flags.MessageFlags]), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGetFlagsMethodInfo a signature where
    overloadedMethod = messageGetFlags

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


#endif

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

foreign import ccall "soup_message_get_http_version" soup_message_get_http_version :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO CUInt

-- | Gets the HTTP version of /@msg@/. This is the minimum of the
-- version from the request and the version from the response.
messageGetHttpVersion ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m Soup.Enums.HTTPVersion
    -- ^ __Returns:__ the HTTP version
messageGetHttpVersion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m HTTPVersion
messageGetHttpVersion a
msg = IO HTTPVersion -> m HTTPVersion
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HTTPVersion -> m HTTPVersion)
-> IO HTTPVersion -> m HTTPVersion
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CUInt
result <- Ptr Message -> IO CUInt
soup_message_get_http_version Ptr Message
msg'
    let result' :: HTTPVersion
result' = (Int -> HTTPVersion
forall a. Enum a => Int -> a
toEnum (Int -> HTTPVersion) -> (CUInt -> Int) -> CUInt -> HTTPVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    HTTPVersion -> IO HTTPVersion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HTTPVersion
result'

#if defined(ENABLE_OVERLOADING)
data MessageGetHttpVersionMethodInfo
instance (signature ~ (m Soup.Enums.HTTPVersion), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGetHttpVersionMethodInfo a signature where
    overloadedMethod = messageGetHttpVersion

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


#endif

-- method Message::get_https_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "certificate"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "@msg's TLS certificate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "errors"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsCertificateFlags" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the verification status of @certificate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_get_https_status" soup_message_get_https_status :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Ptr (Ptr Gio.TlsCertificate.TlsCertificate) -> -- certificate : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    Ptr CUInt ->                            -- errors : TInterface (Name {namespace = "Gio", name = "TlsCertificateFlags"})
    IO CInt

-- | If /@msg@/ is using https (or attempted to use https but got
-- 'GI.Soup.Enums.StatusSslFailed'), this retrieves the t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
-- associated with its connection, and the t'GI.Gio.Flags.TlsCertificateFlags'
-- showing what problems, if any, have been found with that
-- certificate.
-- 
-- \<note>\<para>This is only meaningful with messages processed by a t'GI.Soup.Objects.Session.Session' and is
-- not useful for messages received by a t'GI.Soup.Objects.Server.Server'\<\/para>\<\/note>
-- 
-- /Since: 2.34/
messageGetHttpsStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m ((Bool, Gio.TlsCertificate.TlsCertificate, [Gio.Flags.TlsCertificateFlags]))
    -- ^ __Returns:__ 'P.True' if /@msg@/ used\/attempted https, 'P.False' if not
messageGetHttpsStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m (Bool, TlsCertificate, [TlsCertificateFlags])
messageGetHttpsStatus a
msg = IO (Bool, TlsCertificate, [TlsCertificateFlags])
-> m (Bool, TlsCertificate, [TlsCertificateFlags])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, TlsCertificate, [TlsCertificateFlags])
 -> m (Bool, TlsCertificate, [TlsCertificateFlags]))
-> IO (Bool, TlsCertificate, [TlsCertificateFlags])
-> m (Bool, TlsCertificate, [TlsCertificateFlags])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr (Ptr TlsCertificate)
certificate <- IO (Ptr (Ptr TlsCertificate))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gio.TlsCertificate.TlsCertificate))
    Ptr CUInt
errors <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr Message -> Ptr (Ptr TlsCertificate) -> Ptr CUInt -> IO CInt
soup_message_get_https_status Ptr Message
msg' Ptr (Ptr TlsCertificate)
certificate Ptr CUInt
errors
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr TlsCertificate
certificate' <- Ptr (Ptr TlsCertificate) -> IO (Ptr TlsCertificate)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr TlsCertificate)
certificate
    TlsCertificate
certificate'' <- ((ManagedPtr TlsCertificate -> TlsCertificate)
-> Ptr TlsCertificate -> IO TlsCertificate
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TlsCertificate -> TlsCertificate
Gio.TlsCertificate.TlsCertificate) Ptr TlsCertificate
certificate'
    CUInt
errors' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
errors
    let errors'' :: [TlsCertificateFlags]
errors'' = CUInt -> [TlsCertificateFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
errors'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    Ptr (Ptr TlsCertificate) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr TlsCertificate)
certificate
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
errors
    (Bool, TlsCertificate, [TlsCertificateFlags])
-> IO (Bool, TlsCertificate, [TlsCertificateFlags])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', TlsCertificate
certificate'', [TlsCertificateFlags]
errors'')

#if defined(ENABLE_OVERLOADING)
data MessageGetHttpsStatusMethodInfo
instance (signature ~ (m ((Bool, Gio.TlsCertificate.TlsCertificate, [Gio.Flags.TlsCertificateFlags]))), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGetHttpsStatusMethodInfo a signature where
    overloadedMethod = messageGetHttpsStatus

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


#endif

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

foreign import ccall "soup_message_get_is_top_level_navigation" soup_message_get_is_top_level_navigation :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 2.70/
messageGetIsTopLevelNavigation ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m Bool
messageGetIsTopLevelNavigation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m Bool
messageGetIsTopLevelNavigation a
msg = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CInt
result <- Ptr Message -> IO CInt
soup_message_get_is_top_level_navigation Ptr Message
msg'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MessageGetIsTopLevelNavigationMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGetIsTopLevelNavigationMethodInfo a signature where
    overloadedMethod = messageGetIsTopLevelNavigation

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


#endif

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

foreign import ccall "soup_message_get_priority" soup_message_get_priority :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO CUInt

-- | Retrieves the t'GI.Soup.Enums.MessagePriority'. If not set this value defaults
-- to @/SOUP_MESSAGE_PRIORITY_NORMAL/@.
-- 
-- /Since: 2.44/
messageGetPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m Soup.Enums.MessagePriority
    -- ^ __Returns:__ the priority of the message.
messageGetPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m MessagePriority
messageGetPriority a
msg = IO MessagePriority -> m MessagePriority
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MessagePriority -> m MessagePriority)
-> IO MessagePriority -> m MessagePriority
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CUInt
result <- Ptr Message -> IO CUInt
soup_message_get_priority Ptr Message
msg'
    let result' :: MessagePriority
result' = (Int -> MessagePriority
forall a. Enum a => Int -> a
toEnum (Int -> MessagePriority)
-> (CUInt -> Int) -> CUInt -> MessagePriority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    MessagePriority -> IO MessagePriority
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MessagePriority
result'

#if defined(ENABLE_OVERLOADING)
data MessageGetPriorityMethodInfo
instance (signature ~ (m Soup.Enums.MessagePriority), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGetPriorityMethodInfo a signature where
    overloadedMethod = messageGetPriority

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


#endif

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

foreign import ccall "soup_message_get_site_for_cookies" soup_message_get_site_for_cookies :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO (Ptr Soup.URI.URI)

-- | Gets /@msg@/\'s site for cookies t'GI.Soup.Structs.URI.URI'
-- 
-- /Since: 2.70/
messageGetSiteForCookies ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m Soup.URI.URI
    -- ^ __Returns:__ the /@msg@/\'s site for cookies t'GI.Soup.Structs.URI.URI'
messageGetSiteForCookies :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m URI
messageGetSiteForCookies a
msg = IO URI -> m URI
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr URI
result <- Ptr Message -> IO (Ptr URI)
soup_message_get_site_for_cookies Ptr Message
msg'
    Text -> Ptr URI -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"messageGetSiteForCookies" Ptr URI
result
    URI
result' <- ((ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr URI -> URI
Soup.URI.URI) Ptr URI
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    URI -> IO URI
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return URI
result'

#if defined(ENABLE_OVERLOADING)
data MessageGetSiteForCookiesMethodInfo
instance (signature ~ (m Soup.URI.URI), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGetSiteForCookiesMethodInfo a signature where
    overloadedMethod = messageGetSiteForCookies

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


#endif

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

foreign import ccall "soup_message_get_soup_request" soup_message_get_soup_request :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO (Ptr Soup.Request.Request)

-- | If /@msg@/ is associated with a t'GI.Soup.Objects.Request.Request', this returns that
-- request. Otherwise it returns 'P.Nothing'.
-- 
-- /Since: 2.42/
messageGetSoupRequest ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m Soup.Request.Request
    -- ^ __Returns:__ /@msg@/\'s associated t'GI.Soup.Objects.Request.Request'
messageGetSoupRequest :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m Request
messageGetSoupRequest a
msg = IO Request -> m Request
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> m Request) -> IO Request -> m Request
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Request
result <- Ptr Message -> IO (Ptr Request)
soup_message_get_soup_request Ptr Message
msg'
    Text -> Ptr Request -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"messageGetSoupRequest" Ptr Request
result
    Request
result' <- ((ManagedPtr Request -> Request) -> Ptr Request -> IO Request
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Request -> Request
Soup.Request.Request) Ptr Request
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    Request -> IO Request
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Request
result'

#if defined(ENABLE_OVERLOADING)
data MessageGetSoupRequestMethodInfo
instance (signature ~ (m Soup.Request.Request), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGetSoupRequestMethodInfo a signature where
    overloadedMethod = messageGetSoupRequest

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


#endif

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

foreign import ccall "soup_message_get_uri" soup_message_get_uri :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO (Ptr Soup.URI.URI)

-- | Gets /@msg@/\'s URI
messageGetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m Soup.URI.URI
    -- ^ __Returns:__ the URI /@msg@/ is targeted for.
messageGetUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m URI
messageGetUri a
msg = IO URI -> m URI
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr URI
result <- Ptr Message -> IO (Ptr URI)
soup_message_get_uri Ptr Message
msg'
    Text -> Ptr URI -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"messageGetUri" Ptr URI
result
    URI
result' <- ((ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr URI -> URI
Soup.URI.URI) Ptr URI
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    URI -> IO URI
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return URI
result'

#if defined(ENABLE_OVERLOADING)
data MessageGetUriMethodInfo
instance (signature ~ (m Soup.URI.URI), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGetUriMethodInfo a signature where
    overloadedMethod = messageGetUri

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


#endif

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

foreign import ccall "soup_message_got_body" soup_message_got_body :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO ()

-- | /No description available in the introspection data./
messageGotBody ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> m ()
messageGotBody :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m ()
messageGotBody a
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> IO ()
soup_message_got_body Ptr Message
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageGotBodyMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGotBodyMethodInfo a signature where
    overloadedMethod = messageGotBody

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


#endif

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

foreign import ccall "soup_message_got_chunk" soup_message_got_chunk :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Ptr Soup.Buffer.Buffer ->               -- chunk : TInterface (Name {namespace = "Soup", name = "Buffer"})
    IO ()

-- | /No description available in the introspection data./
messageGotChunk ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> Soup.Buffer.Buffer
    -> m ()
messageGotChunk :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> Buffer -> m ()
messageGotChunk a
msg Buffer
chunk = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Buffer
chunk' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
chunk
    Ptr Message -> Ptr Buffer -> IO ()
soup_message_got_chunk Ptr Message
msg' Ptr Buffer
chunk'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    MessageGotChunkCallback
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
chunk
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageGotChunkMethodInfo
instance (signature ~ (Soup.Buffer.Buffer -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGotChunkMethodInfo a signature where
    overloadedMethod = messageGotChunk

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


#endif

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

foreign import ccall "soup_message_got_headers" soup_message_got_headers :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO ()

-- | /No description available in the introspection data./
messageGotHeaders ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> m ()
messageGotHeaders :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m ()
messageGotHeaders a
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> IO ()
soup_message_got_headers Ptr Message
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageGotHeadersMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGotHeadersMethodInfo a signature where
    overloadedMethod = messageGotHeaders

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


#endif

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

foreign import ccall "soup_message_got_informational" soup_message_got_informational :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO ()

-- | /No description available in the introspection data./
messageGotInformational ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> m ()
messageGotInformational :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m ()
messageGotInformational a
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> IO ()
soup_message_got_informational Ptr Message
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageGotInformationalMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageGotInformationalMethodInfo a signature where
    overloadedMethod = messageGotInformational

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


#endif

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

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

-- | Get whether t'GI.Soup.Interfaces.SessionFeature.SessionFeature's of the given /@featureType@/
-- (or a subclass of that type) are disabled on /@msg@/.
-- See 'GI.Soup.Objects.Message.messageDisableFeature'.
-- 
-- /Since: 2.72/
messageIsFeatureDisabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> GType
    -- ^ /@featureType@/: the t'GType' of a t'GI.Soup.Interfaces.SessionFeature.SessionFeature'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if feature is disabled, or 'P.False' otherwise.
messageIsFeatureDisabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> GType -> m Bool
messageIsFeatureDisabled a
msg GType
featureType = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    let featureType' :: CGType
featureType' = GType -> CGType
gtypeToCGType GType
featureType
    CInt
result <- Ptr Message -> CGType -> IO CInt
soup_message_is_feature_disabled Ptr Message
msg' CGType
featureType'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

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


#endif

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

foreign import ccall "soup_message_is_keepalive" soup_message_is_keepalive :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO CInt

-- | Determines whether or not /@msg@/\'s connection can be kept alive for
-- further requests after processing /@msg@/, based on the HTTP version,
-- Connection header, etc.
messageIsKeepalive ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m Bool
    -- ^ __Returns:__ 'P.True' or 'P.False'.
messageIsKeepalive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m Bool
messageIsKeepalive a
msg = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CInt
result <- Ptr Message -> IO CInt
soup_message_is_keepalive Ptr Message
msg'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MessageIsKeepaliveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMessage a) => O.OverloadedMethod MessageIsKeepaliveMethodInfo a signature where
    overloadedMethod = messageIsKeepalive

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


#endif

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

foreign import ccall "soup_message_restarted" soup_message_restarted :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO ()

-- | /No description available in the introspection data./
messageRestarted ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> m ()
messageRestarted :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m ()
messageRestarted a
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> IO ()
soup_message_restarted Ptr Message
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageRestartedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageRestartedMethodInfo a signature where
    overloadedMethod = messageRestarted

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


#endif

-- method Message::set_chunk_allocator
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allocator"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ChunkAllocator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the chunk allocator callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @allocator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "destroy notifier to free @user_data when @msg is\ndestroyed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_chunk_allocator" soup_message_set_chunk_allocator :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    FunPtr Soup.Callbacks.C_ChunkAllocator -> -- allocator : TInterface (Name {namespace = "Soup", name = "ChunkAllocator"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

{-# DEPRECATED messageSetChunkAllocator ["t'GI.Soup.Objects.Request.Request' provides a much simpler API that lets you","read the response directly into your own buffers without needing to","mess with callbacks, pausing\\/unpausing, etc."] #-}
-- | Sets an alternate chunk-allocation function to use when reading
-- /@msg@/\'s body when using the traditional (ie,
-- non-t'GI.Soup.Objects.Request.Request'-based) API. Every time data is available
-- to read, libsoup will call /@allocator@/, which should return a
-- t'GI.Soup.Structs.Buffer.Buffer'. (See t'GI.Soup.Callbacks.ChunkAllocator' for additional details.)
-- Libsoup will then read data from the network into that buffer, and
-- update the buffer\'s \<literal>length\<\/literal> to indicate how much
-- data it read.
-- 
-- Generally, a custom chunk allocator would be used in conjunction
-- with 'GI.Soup.Structs.MessageBody.messageBodySetAccumulate' 'P.False' and
-- t'GI.Soup.Objects.Message.Message'::@/got_chunk/@, as part of a strategy to avoid unnecessary
-- copying of data. However, you cannot assume that every call to the
-- allocator will be followed by a call to your
-- t'GI.Soup.Objects.Message.Message'::@/got_chunk/@ handler; if an I\/O error occurs, then the
-- buffer will be unreffed without ever having been used. If your
-- buffer-allocation strategy requires special cleanup, use
-- 'GI.Soup.Structs.Buffer.bufferNewWithOwner' rather than doing the cleanup from the
-- t'GI.Soup.Objects.Message.Message'::@/got_chunk/@ handler.
-- 
-- The other thing to remember when using non-accumulating message
-- bodies is that the buffer passed to the t'GI.Soup.Objects.Message.Message'::@/got_chunk/@
-- handler will be unreffed after the handler returns, just as it
-- would be in the non-custom-allocated case. If you want to hand the
-- chunk data off to some other part of your program to use later,
-- you\'ll need to ref the t'GI.Soup.Structs.Buffer.Buffer' (or its owner, in the
-- 'GI.Soup.Structs.Buffer.bufferNewWithOwner' case) to ensure that the data remains
-- valid.
messageSetChunkAllocator ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Soup.Callbacks.ChunkAllocator
    -- ^ /@allocator@/: the chunk allocator callback
    -> m ()
messageSetChunkAllocator :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> ChunkAllocator -> m ()
messageSetChunkAllocator a
msg ChunkAllocator
allocator = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    FunPtr C_ChunkAllocator
allocator' <- C_ChunkAllocator -> IO (FunPtr C_ChunkAllocator)
Soup.Callbacks.mk_ChunkAllocator (Maybe (Ptr (FunPtr C_ChunkAllocator))
-> ChunkAllocator_WithClosures -> C_ChunkAllocator
Soup.Callbacks.wrap_ChunkAllocator Maybe (Ptr (FunPtr C_ChunkAllocator))
forall a. Maybe a
Nothing (ChunkAllocator -> ChunkAllocator_WithClosures
Soup.Callbacks.drop_closures_ChunkAllocator ChunkAllocator
allocator))
    let userData :: Ptr ()
userData = FunPtr C_ChunkAllocator -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ChunkAllocator
allocator'
    let destroyNotify :: FunPtr (Ptr a -> IO ())
destroyNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Message
-> FunPtr C_ChunkAllocator
-> Ptr ()
-> GDestroyNotify (Ptr ())
-> IO ()
soup_message_set_chunk_allocator Ptr Message
msg' FunPtr C_ChunkAllocator
allocator' Ptr ()
userData GDestroyNotify (Ptr ())
forall a. FunPtr (Ptr a -> IO ())
destroyNotify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetChunkAllocatorMethodInfo
instance (signature ~ (Soup.Callbacks.ChunkAllocator -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetChunkAllocatorMethodInfo a signature where
    overloadedMethod = messageSetChunkAllocator

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


#endif

-- method Message::set_first_party
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "first_party"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupURI for the @msg's first party"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_first_party" soup_message_set_first_party :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Ptr Soup.URI.URI ->                     -- first_party : TInterface (Name {namespace = "Soup", name = "URI"})
    IO ()

-- | Sets /@firstParty@/ as the main document t'GI.Soup.Structs.URI.URI' for /@msg@/. For
-- details of when and how this is used refer to the documentation for
-- t'GI.Soup.Enums.CookieJarAcceptPolicy'.
-- 
-- /Since: 2.30/
messageSetFirstParty ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Soup.URI.URI
    -- ^ /@firstParty@/: the t'GI.Soup.Structs.URI.URI' for the /@msg@/\'s first party
    -> m ()
messageSetFirstParty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> URI -> m ()
messageSetFirstParty a
msg URI
firstParty = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr URI
firstParty' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
firstParty
    Ptr Message -> Ptr URI -> IO ()
soup_message_set_first_party Ptr Message
msg' Ptr URI
firstParty'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
firstParty
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetFirstPartyMethodInfo
instance (signature ~ (Soup.URI.URI -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetFirstPartyMethodInfo a signature where
    overloadedMethod = messageSetFirstParty

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


#endif

-- method Message::set_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #SoupMessageFlags values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_flags" soup_message_set_flags :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Soup", name = "MessageFlags"})
    IO ()

-- | Sets the specified flags on /@msg@/.
messageSetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> [Soup.Flags.MessageFlags]
    -- ^ /@flags@/: a set of t'GI.Soup.Flags.MessageFlags' values
    -> m ()
messageSetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> [MessageFlags] -> m ()
messageSetFlags a
msg [MessageFlags]
flags = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    let flags' :: CUInt
flags' = [MessageFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MessageFlags]
flags
    Ptr Message -> CUInt -> IO ()
soup_message_set_flags Ptr Message
msg' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetFlagsMethodInfo
instance (signature ~ ([Soup.Flags.MessageFlags] -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetFlagsMethodInfo a signature where
    overloadedMethod = messageSetFlags

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


#endif

-- method Message::set_http_version
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "version"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "HTTPVersion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the HTTP version" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_http_version" soup_message_set_http_version :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    CUInt ->                                -- version : TInterface (Name {namespace = "Soup", name = "HTTPVersion"})
    IO ()

-- | Sets the HTTP version on /@msg@/. The default version is
-- 'GI.Soup.Enums.HTTPVersionHttp11'. Setting it to 'GI.Soup.Enums.HTTPVersionHttp10' will prevent certain
-- functionality from being used.
messageSetHttpVersion ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Soup.Enums.HTTPVersion
    -- ^ /@version@/: the HTTP version
    -> m ()
messageSetHttpVersion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> HTTPVersion -> m ()
messageSetHttpVersion a
msg HTTPVersion
version = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    let version' :: CUInt
version' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (HTTPVersion -> Int) -> HTTPVersion -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTTPVersion -> Int
forall a. Enum a => a -> Int
fromEnum) HTTPVersion
version
    Ptr Message -> CUInt -> IO ()
soup_message_set_http_version Ptr Message
msg' CUInt
version'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetHttpVersionMethodInfo
instance (signature ~ (Soup.Enums.HTTPVersion -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetHttpVersionMethodInfo a signature where
    overloadedMethod = messageSetHttpVersion

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


#endif

-- method Message::set_is_top_level_navigation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_top_level_navigation"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE indicate the current request is a top-level navigation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_is_top_level_navigation" soup_message_set_is_top_level_navigation :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    CInt ->                                 -- is_top_level_navigation : TBasicType TBoolean
    IO ()

-- | See the <https://tools.ietf.org/html/draft-ietf-httpbis-cookie-same-site-00 same-site spec>
-- for more information.
-- 
-- /Since: 2.70/
messageSetIsTopLevelNavigation ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Bool
    -- ^ /@isTopLevelNavigation@/: if 'P.True' indicate the current request is a top-level navigation
    -> m ()
messageSetIsTopLevelNavigation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> Bool -> m ()
messageSetIsTopLevelNavigation a
msg Bool
isTopLevelNavigation = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    let isTopLevelNavigation' :: CInt
isTopLevelNavigation' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
isTopLevelNavigation
    Ptr Message -> CInt -> IO ()
soup_message_set_is_top_level_navigation Ptr Message
msg' CInt
isTopLevelNavigation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetIsTopLevelNavigationMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetIsTopLevelNavigationMethodInfo a signature where
    overloadedMethod = messageSetIsTopLevelNavigation

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


#endif

-- method Message::set_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessagePriority" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupMessagePriority"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_priority" soup_message_set_priority :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    CUInt ->                                -- priority : TInterface (Name {namespace = "Soup", name = "MessagePriority"})
    IO ()

-- | Sets the priority of a message. Note that this won\'t have any
-- effect unless used before the message is added to the session\'s
-- message processing queue.
-- 
-- The message will be placed just before any other previously added
-- message with lower priority (messages with the same priority are
-- processed on a FIFO basis).
-- 
-- Setting priorities does not currently work with t'GI.Soup.Objects.SessionSync.SessionSync'
-- (or with synchronous messages on a plain t'GI.Soup.Objects.Session.Session') because in
-- the synchronous\/blocking case, priority ends up being determined
-- semi-randomly by thread scheduling.
-- 
-- /Since: 2.44/
messageSetPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Soup.Enums.MessagePriority
    -- ^ /@priority@/: the t'GI.Soup.Enums.MessagePriority'
    -> m ()
messageSetPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> MessagePriority -> m ()
messageSetPriority a
msg MessagePriority
priority = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    let priority' :: CUInt
priority' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (MessagePriority -> Int) -> MessagePriority -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MessagePriority -> Int
forall a. Enum a => a -> Int
fromEnum) MessagePriority
priority
    Ptr Message -> CUInt -> IO ()
soup_message_set_priority Ptr Message
msg' CUInt
priority'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetPriorityMethodInfo
instance (signature ~ (Soup.Enums.MessagePriority -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetPriorityMethodInfo a signature where
    overloadedMethod = messageSetPriority

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


#endif

-- method Message::set_redirect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "status_code"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a 3xx status code" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "redirect_uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the URI to redirect @msg to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_redirect" soup_message_set_redirect :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Word32 ->                               -- status_code : TBasicType TUInt
    CString ->                              -- redirect_uri : TBasicType TUTF8
    IO ()

-- | Sets /@msg@/\'s status_code to /@statusCode@/ and adds a Location header
-- pointing to /@redirectUri@/. Use this from a t'GI.Soup.Objects.Server.Server' when you
-- want to redirect the client to another URI.
-- 
-- /@redirectUri@/ can be a relative URI, in which case it is
-- interpreted relative to /@msg@/\'s current URI. In particular, if
-- /@redirectUri@/ is just a path, it will replace the path
-- \<emphasis>and query\<\/emphasis> of /@msg@/\'s URI.
-- 
-- /Since: 2.38/
messageSetRedirect ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Word32
    -- ^ /@statusCode@/: a 3xx status code
    -> T.Text
    -- ^ /@redirectUri@/: the URI to redirect /@msg@/ to
    -> m ()
messageSetRedirect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> Word32 -> Text -> m ()
messageSetRedirect a
msg Word32
statusCode Text
redirectUri = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CString
redirectUri' <- Text -> IO CString
textToCString Text
redirectUri
    Ptr Message -> Word32 -> CString -> IO ()
soup_message_set_redirect Ptr Message
msg' Word32
statusCode CString
redirectUri'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
redirectUri'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetRedirectMethodInfo
instance (signature ~ (Word32 -> T.Text -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetRedirectMethodInfo a signature where
    overloadedMethod = messageSetRedirect

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


#endif

-- method Message::set_request
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "MIME Content-Type of the body"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "req_use"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MemoryUse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #SoupMemoryUse describing how to handle @req_body"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "req_body"
--           , argType = TCArray False (-1) 4 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "\n  a data buffer containing the body of the message request."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "req_length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the byte length of @req_body."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "req_length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the byte length of @req_body."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_request" soup_message_set_request :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    CString ->                              -- content_type : TBasicType TUTF8
    CUInt ->                                -- req_use : TInterface (Name {namespace = "Soup", name = "MemoryUse"})
    Ptr Word8 ->                            -- req_body : TCArray False (-1) 4 (TBasicType TUInt8)
    Word64 ->                               -- req_length : TBasicType TUInt64
    IO ()

-- | Convenience function to set the request body of a t'GI.Soup.Objects.Message.Message'. If
-- /@contentType@/ is 'P.Nothing', the request body must be empty as well.
messageSetRequest ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: the message
    -> Maybe (T.Text)
    -- ^ /@contentType@/: MIME Content-Type of the body
    -> Soup.Enums.MemoryUse
    -- ^ /@reqUse@/: a t'GI.Soup.Enums.MemoryUse' describing how to handle /@reqBody@/
    -> Maybe (ByteString)
    -- ^ /@reqBody@/: 
    --   a data buffer containing the body of the message request.
    -> m ()
messageSetRequest :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> Maybe Text -> MemoryUse -> Maybe ByteString -> m ()
messageSetRequest a
msg Maybe Text
contentType MemoryUse
reqUse Maybe ByteString
reqBody = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let reqLength :: CGType
reqLength = case Maybe ByteString
reqBody of
            Maybe ByteString
Nothing -> CGType
0
            Just ByteString
jReqBody -> Int -> CGType
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CGType) -> Int -> CGType
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
jReqBody
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CString
maybeContentType <- case Maybe Text
contentType of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jContentType -> do
            CString
jContentType' <- Text -> IO CString
textToCString Text
jContentType
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jContentType'
    let reqUse' :: CUInt
reqUse' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (MemoryUse -> Int) -> MemoryUse -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryUse -> Int
forall a. Enum a => a -> Int
fromEnum) MemoryUse
reqUse
    Ptr Word8
maybeReqBody <- case Maybe ByteString
reqBody of
        Maybe ByteString
Nothing -> Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
forall a. Ptr a
nullPtr
        Just ByteString
jReqBody -> do
            Ptr Word8
jReqBody' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
jReqBody
            Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
jReqBody'
    Ptr Message -> CString -> CUInt -> Ptr Word8 -> CGType -> IO ()
soup_message_set_request Ptr Message
msg' CString
maybeContentType CUInt
reqUse' Ptr Word8
maybeReqBody CGType
reqLength
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeContentType
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
maybeReqBody
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetRequestMethodInfo
instance (signature ~ (Maybe (T.Text) -> Soup.Enums.MemoryUse -> Maybe (ByteString) -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetRequestMethodInfo a signature where
    overloadedMethod = messageSetRequest

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


#endif

-- method Message::set_response
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "MIME Content-Type of the body"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resp_use"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MemoryUse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #SoupMemoryUse describing how to handle @resp_body"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resp_body"
--           , argType = TCArray False (-1) 4 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "\n  a data buffer containing the body of the message response."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resp_length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the byte length of @resp_body."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "resp_length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the byte length of @resp_body."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_response" soup_message_set_response :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    CString ->                              -- content_type : TBasicType TUTF8
    CUInt ->                                -- resp_use : TInterface (Name {namespace = "Soup", name = "MemoryUse"})
    Ptr Word8 ->                            -- resp_body : TCArray False (-1) 4 (TBasicType TUInt8)
    Word64 ->                               -- resp_length : TBasicType TUInt64
    IO ()

-- | Convenience function to set the response body of a t'GI.Soup.Objects.Message.Message'. If
-- /@contentType@/ is 'P.Nothing', the response body must be empty as well.
messageSetResponse ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: the message
    -> Maybe (T.Text)
    -- ^ /@contentType@/: MIME Content-Type of the body
    -> Soup.Enums.MemoryUse
    -- ^ /@respUse@/: a t'GI.Soup.Enums.MemoryUse' describing how to handle /@respBody@/
    -> Maybe (ByteString)
    -- ^ /@respBody@/: 
    --   a data buffer containing the body of the message response.
    -> m ()
messageSetResponse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> Maybe Text -> MemoryUse -> Maybe ByteString -> m ()
messageSetResponse a
msg Maybe Text
contentType MemoryUse
respUse Maybe ByteString
respBody = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let respLength :: CGType
respLength = case Maybe ByteString
respBody of
            Maybe ByteString
Nothing -> CGType
0
            Just ByteString
jRespBody -> Int -> CGType
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CGType) -> Int -> CGType
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
jRespBody
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CString
maybeContentType <- case Maybe Text
contentType of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jContentType -> do
            CString
jContentType' <- Text -> IO CString
textToCString Text
jContentType
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jContentType'
    let respUse' :: CUInt
respUse' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (MemoryUse -> Int) -> MemoryUse -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryUse -> Int
forall a. Enum a => a -> Int
fromEnum) MemoryUse
respUse
    Ptr Word8
maybeRespBody <- case Maybe ByteString
respBody of
        Maybe ByteString
Nothing -> Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
forall a. Ptr a
nullPtr
        Just ByteString
jRespBody -> do
            Ptr Word8
jRespBody' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
jRespBody
            Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
jRespBody'
    Ptr Message -> CString -> CUInt -> Ptr Word8 -> CGType -> IO ()
soup_message_set_response Ptr Message
msg' CString
maybeContentType CUInt
respUse' Ptr Word8
maybeRespBody CGType
respLength
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeContentType
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
maybeRespBody
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetResponseMethodInfo
instance (signature ~ (Maybe (T.Text) -> Soup.Enums.MemoryUse -> Maybe (ByteString) -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetResponseMethodInfo a signature where
    overloadedMethod = messageSetResponse

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


#endif

-- method Message::set_site_for_cookies
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "site_for_cookies"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupURI for the @msg's site for cookies"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_site_for_cookies" soup_message_set_site_for_cookies :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Ptr Soup.URI.URI ->                     -- site_for_cookies : TInterface (Name {namespace = "Soup", name = "URI"})
    IO ()

-- | Sets /@siteForCookies@/ as the policy URL for same-site cookies for /@msg@/.
-- 
-- It is either the URL of the top-level document or 'P.Nothing' depending on whether the registrable
-- domain of this document\'s URL matches the registrable domain of its parent\'s\/opener\'s
-- URL. For the top-level document it is set to the document\'s URL.
-- 
-- See the <https://tools.ietf.org/html/draft-ietf-httpbis-cookie-same-site-00 same-site spec>
-- for more information.
-- 
-- /Since: 2.70/
messageSetSiteForCookies ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Maybe (Soup.URI.URI)
    -- ^ /@siteForCookies@/: the t'GI.Soup.Structs.URI.URI' for the /@msg@/\'s site for cookies
    -> m ()
messageSetSiteForCookies :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> Maybe URI -> m ()
messageSetSiteForCookies a
msg Maybe URI
siteForCookies = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr URI
maybeSiteForCookies <- case Maybe URI
siteForCookies of
        Maybe URI
Nothing -> Ptr URI -> IO (Ptr URI)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr URI
forall a. Ptr a
nullPtr
        Just URI
jSiteForCookies -> do
            Ptr URI
jSiteForCookies' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
jSiteForCookies
            Ptr URI -> IO (Ptr URI)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr URI
jSiteForCookies'
    Ptr Message -> Ptr URI -> IO ()
soup_message_set_site_for_cookies Ptr Message
msg' Ptr URI
maybeSiteForCookies
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    Maybe URI -> (URI -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe URI
siteForCookies URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetSiteForCookiesMethodInfo
instance (signature ~ (Maybe (Soup.URI.URI) -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetSiteForCookiesMethodInfo a signature where
    overloadedMethod = messageSetSiteForCookies

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


#endif

-- method Message::set_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "status_code"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an HTTP status code"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_status" soup_message_set_status :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Word32 ->                               -- status_code : TBasicType TUInt
    IO ()

-- | Sets /@msg@/\'s status code to /@statusCode@/. If /@statusCode@/ is a
-- known value, it will also set /@msg@/\'s reason_phrase.
messageSetStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Word32
    -- ^ /@statusCode@/: an HTTP status code
    -> m ()
messageSetStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> Word32 -> m ()
messageSetStatus a
msg Word32
statusCode = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> Word32 -> IO ()
soup_message_set_status Ptr Message
msg' Word32
statusCode
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetStatusMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetStatusMethodInfo a signature where
    overloadedMethod = messageSetStatus

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


#endif

-- method Message::set_status_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "status_code"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an HTTP status code"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reason_phrase"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a description of the status"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_status_full" soup_message_set_status_full :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Word32 ->                               -- status_code : TBasicType TUInt
    CString ->                              -- reason_phrase : TBasicType TUTF8
    IO ()

-- | Sets /@msg@/\'s status code and reason phrase.
messageSetStatusFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Word32
    -- ^ /@statusCode@/: an HTTP status code
    -> T.Text
    -- ^ /@reasonPhrase@/: a description of the status
    -> m ()
messageSetStatusFull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> Word32 -> Text -> m ()
messageSetStatusFull a
msg Word32
statusCode Text
reasonPhrase = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CString
reasonPhrase' <- Text -> IO CString
textToCString Text
reasonPhrase
    Ptr Message -> Word32 -> CString -> IO ()
soup_message_set_status_full Ptr Message
msg' Word32
statusCode CString
reasonPhrase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
reasonPhrase'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetStatusFullMethodInfo
instance (signature ~ (Word32 -> T.Text -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetStatusFullMethodInfo a signature where
    overloadedMethod = messageSetStatusFull

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


#endif

-- method Message::set_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new #SoupURI" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_set_uri" soup_message_set_uri :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Ptr Soup.URI.URI ->                     -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO ()

-- | Sets /@msg@/\'s URI to /@uri@/. If /@msg@/ has already been sent and you want
-- to re-send it with the new URI, you need to call
-- 'GI.Soup.Objects.Session.sessionRequeueMessage'.
messageSetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> Soup.URI.URI
    -- ^ /@uri@/: the new t'GI.Soup.Structs.URI.URI'
    -> m ()
messageSetUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> URI -> m ()
messageSetUri a
msg URI
uri = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    Ptr Message -> Ptr URI -> IO ()
soup_message_set_uri Ptr Message
msg' Ptr URI
uri'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetUriMethodInfo
instance (signature ~ (Soup.URI.URI -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageSetUriMethodInfo a signature where
    overloadedMethod = messageSetUri

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


#endif

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

foreign import ccall "soup_message_starting" soup_message_starting :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO ()

-- | /No description available in the introspection data./
messageStarting ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> m ()
messageStarting :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m ()
messageStarting a
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> IO ()
soup_message_starting Ptr Message
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageStartingMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageStartingMethodInfo a signature where
    overloadedMethod = messageStarting

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


#endif

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

foreign import ccall "soup_message_wrote_body" soup_message_wrote_body :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO ()

-- | /No description available in the introspection data./
messageWroteBody ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> m ()
messageWroteBody :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m ()
messageWroteBody a
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> IO ()
soup_message_wrote_body Ptr Message
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageWroteBodyMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageWroteBodyMethodInfo a signature where
    overloadedMethod = messageWroteBody

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


#endif

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

foreign import ccall "soup_message_wrote_body_data" soup_message_wrote_body_data :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    Ptr Soup.Buffer.Buffer ->               -- chunk : TInterface (Name {namespace = "Soup", name = "Buffer"})
    IO ()

-- | /No description available in the introspection data./
messageWroteBodyData ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> Soup.Buffer.Buffer
    -> m ()
messageWroteBodyData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> Buffer -> m ()
messageWroteBodyData a
msg Buffer
chunk = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Buffer
chunk' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
chunk
    Ptr Message -> Ptr Buffer -> IO ()
soup_message_wrote_body_data Ptr Message
msg' Ptr Buffer
chunk'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    MessageGotChunkCallback
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
chunk
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageWroteBodyDataMethodInfo
instance (signature ~ (Soup.Buffer.Buffer -> m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageWroteBodyDataMethodInfo a signature where
    overloadedMethod = messageWroteBodyData

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


#endif

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

foreign import ccall "soup_message_wrote_chunk" soup_message_wrote_chunk :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO ()

-- | /No description available in the introspection data./
messageWroteChunk ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> m ()
messageWroteChunk :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m ()
messageWroteChunk a
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> IO ()
soup_message_wrote_chunk Ptr Message
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageWroteChunkMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageWroteChunkMethodInfo a signature where
    overloadedMethod = messageWroteChunk

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


#endif

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

foreign import ccall "soup_message_wrote_headers" soup_message_wrote_headers :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO ()

-- | /No description available in the introspection data./
messageWroteHeaders ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> m ()
messageWroteHeaders :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m ()
messageWroteHeaders a
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> IO ()
soup_message_wrote_headers Ptr Message
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageWroteHeadersMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageWroteHeadersMethodInfo a signature where
    overloadedMethod = messageWroteHeaders

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


#endif

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

foreign import ccall "soup_message_wrote_informational" soup_message_wrote_informational :: 
    Ptr Message ->                          -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO ()

-- | /No description available in the introspection data./
messageWroteInformational ::
    (B.CallStack.HasCallStack, MonadIO m, IsMessage a) =>
    a
    -> m ()
messageWroteInformational :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
a -> m ()
messageWroteInformational a
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    Ptr Message -> IO ()
soup_message_wrote_informational Ptr Message
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageWroteInformationalMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMessage a) => O.OverloadedMethod MessageWroteInformationalMethodInfo a signature where
    overloadedMethod = messageWroteInformational

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


#endif