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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A HTTP server.
-- 
-- t'GI.Soup.Objects.Server.Server' implements a simple HTTP server.
-- 
-- To begin, create a server using [ctor/@server@/.new]. Add at least one
-- handler by calling [method/@server@/.add_handler] or
-- [method/@server@/.add_early_handler]; the handler will be called to
-- process any requests underneath the path you pass. (If you want all
-- requests to go to the same handler, just pass \"\/\" (or 'P.Nothing') for
-- the path.)
-- 
-- When a new connection is accepted (or a new request is started on
-- an existing persistent connection), the t'GI.Soup.Objects.Server.Server' will emit
-- [signal/@server@/[requestStarted](#g:signal:requestStarted)] and then begin processing the request
-- as described below, but note that once the message is assigned a
-- status-code, then callbacks after that point will be
-- skipped. Note also that it is not defined when the callbacks happen
-- relative to various [class/@serverMessage@/] signals.
-- 
-- Once the headers have been read, t'GI.Soup.Objects.Server.Server' will check if there is
-- a [class/@authDomain@/] @(qv)@ covering the Request-URI; if so, and if the
-- message does not contain suitable authorization, then the
-- [class/@authDomain@/] will set a status of 'GI.Soup.Enums.StatusUnauthorized' on
-- the message.
-- 
-- After checking for authorization, t'GI.Soup.Objects.Server.Server' will look for \"early\"
-- handlers (added with [method/@server@/.add_early_handler]) matching the
-- Request-URI. If one is found, it will be run; in particular, this
-- can be used to connect to signals to do a streaming read of the
-- request body.
-- 
-- (At this point, if the request headers contain @Expect:
-- 100-continue@, and a status code has been set, then
-- t'GI.Soup.Objects.Server.Server' will skip the remaining steps and return the response.
-- If the request headers contain @Expect:
-- 100-continue@ and no status code has been set,
-- t'GI.Soup.Objects.Server.Server' will return a 'GI.Soup.Enums.StatusContinue' status before
-- continuing.)
-- 
-- The server will then read in the response body (if present). At
-- this point, if there are no handlers at all defined for the
-- Request-URI, then the server will return 'GI.Soup.Enums.StatusNotFound' to
-- the client.
-- 
-- Otherwise (assuming no previous step assigned a status to the
-- message) any \"normal\" handlers (added with
-- [method/@server@/.add_handler]) for the message\'s Request-URI will be
-- run.
-- 
-- Then, if the path has a WebSocket handler registered (and has
-- not yet been assigned a status), t'GI.Soup.Objects.Server.Server' will attempt to
-- validate the WebSocket handshake, filling in the response and
-- setting a status of 'GI.Soup.Enums.StatusSwitchingProtocols' or
-- 'GI.Soup.Enums.StatusBadRequest' accordingly.
-- 
-- If the message still has no status code at this point (and has not
-- been paused with [method/@serverMessage@/.pause]), then it will be
-- given a status of 'GI.Soup.Enums.StatusInternalServerError' (because at
-- least one handler ran, but returned without assigning a status).
-- 
-- Finally, the server will emit [signal/@server@/[requestFinished](#g:signal:requestFinished)] (or
-- [signal/@server@/[requestAborted](#g:signal:requestAborted)] if an I\/O error occurred before
-- handling was completed).
-- 
-- If you want to handle the special \"*\" URI (eg, \"OPTIONS *\"), you
-- must explicitly register a handler for \"*\"; the default handler
-- will not be used for that case.
-- 
-- If you want to process https connections in addition to (or instead
-- of) http connections, you can set the [property/@server@/:tls-certificate]
-- property.
-- 
-- Once the server is set up, make one or more calls to
-- [method/@server@/.listen], [method/@server@/.listen_local], or
-- [method/@server@/.listen_all] to tell it where to listen for
-- connections. (All ports on a t'GI.Soup.Objects.Server.Server' use the same handlers; if
-- you need to handle some ports differently, such as returning
-- different data for http and https, you\'ll need to create multiple
-- @SoupServer@s, or else check the passed-in URI in the handler
-- function.).
-- 
-- t'GI.Soup.Objects.Server.Server' will begin processing connections as soon as you return
-- to (or start) the main loop for the current thread-default
-- [struct/@gLib@/.MainContext].

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

module GI.Soup.Objects.Server
    ( 

-- * Exported types
    Server(..)                              ,
    IsServer                                ,
    toServer                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [acceptIostream]("GI.Soup.Objects.Server#g:method:acceptIostream"), [addAuthDomain]("GI.Soup.Objects.Server#g:method:addAuthDomain"), [addEarlyHandler]("GI.Soup.Objects.Server#g:method:addEarlyHandler"), [addHandler]("GI.Soup.Objects.Server#g:method:addHandler"), [addWebsocketExtension]("GI.Soup.Objects.Server#g:method:addWebsocketExtension"), [addWebsocketHandler]("GI.Soup.Objects.Server#g:method:addWebsocketHandler"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [disconnect]("GI.Soup.Objects.Server#g:method:disconnect"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isHttps]("GI.Soup.Objects.Server#g:method:isHttps"), [listen]("GI.Soup.Objects.Server#g:method:listen"), [listenAll]("GI.Soup.Objects.Server#g:method:listenAll"), [listenLocal]("GI.Soup.Objects.Server#g:method:listenLocal"), [listenSocket]("GI.Soup.Objects.Server#g:method:listenSocket"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [pauseMessage]("GI.Soup.Objects.Server#g:method:pauseMessage"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeAuthDomain]("GI.Soup.Objects.Server#g:method:removeAuthDomain"), [removeHandler]("GI.Soup.Objects.Server#g:method:removeHandler"), [removeWebsocketExtension]("GI.Soup.Objects.Server#g:method:removeWebsocketExtension"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unpauseMessage]("GI.Soup.Objects.Server#g:method:unpauseMessage"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getListeners]("GI.Soup.Objects.Server#g:method:getListeners"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTlsAuthMode]("GI.Soup.Objects.Server#g:method:getTlsAuthMode"), [getTlsCertificate]("GI.Soup.Objects.Server#g:method:getTlsCertificate"), [getTlsDatabase]("GI.Soup.Objects.Server#g:method:getTlsDatabase"), [getUris]("GI.Soup.Objects.Server#g:method:getUris").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTlsAuthMode]("GI.Soup.Objects.Server#g:method:setTlsAuthMode"), [setTlsCertificate]("GI.Soup.Objects.Server#g:method:setTlsCertificate"), [setTlsDatabase]("GI.Soup.Objects.Server#g:method:setTlsDatabase").

#if defined(ENABLE_OVERLOADING)
    ResolveServerMethod                     ,
#endif

-- ** acceptIostream #method:acceptIostream#

#if defined(ENABLE_OVERLOADING)
    ServerAcceptIostreamMethodInfo          ,
#endif
    serverAcceptIostream                    ,


-- ** addAuthDomain #method:addAuthDomain#

#if defined(ENABLE_OVERLOADING)
    ServerAddAuthDomainMethodInfo           ,
#endif
    serverAddAuthDomain                     ,


-- ** addEarlyHandler #method:addEarlyHandler#

#if defined(ENABLE_OVERLOADING)
    ServerAddEarlyHandlerMethodInfo         ,
#endif
    serverAddEarlyHandler                   ,


-- ** addHandler #method:addHandler#

#if defined(ENABLE_OVERLOADING)
    ServerAddHandlerMethodInfo              ,
#endif
    serverAddHandler                        ,


-- ** addWebsocketExtension #method:addWebsocketExtension#

#if defined(ENABLE_OVERLOADING)
    ServerAddWebsocketExtensionMethodInfo   ,
#endif
    serverAddWebsocketExtension             ,


-- ** addWebsocketHandler #method:addWebsocketHandler#

#if defined(ENABLE_OVERLOADING)
    ServerAddWebsocketHandlerMethodInfo     ,
#endif
    serverAddWebsocketHandler               ,


-- ** disconnect #method:disconnect#

#if defined(ENABLE_OVERLOADING)
    ServerDisconnectMethodInfo              ,
#endif
    serverDisconnect                        ,


-- ** getListeners #method:getListeners#

#if defined(ENABLE_OVERLOADING)
    ServerGetListenersMethodInfo            ,
#endif
    serverGetListeners                      ,


-- ** getTlsAuthMode #method:getTlsAuthMode#

#if defined(ENABLE_OVERLOADING)
    ServerGetTlsAuthModeMethodInfo          ,
#endif
    serverGetTlsAuthMode                    ,


-- ** getTlsCertificate #method:getTlsCertificate#

#if defined(ENABLE_OVERLOADING)
    ServerGetTlsCertificateMethodInfo       ,
#endif
    serverGetTlsCertificate                 ,


-- ** getTlsDatabase #method:getTlsDatabase#

#if defined(ENABLE_OVERLOADING)
    ServerGetTlsDatabaseMethodInfo          ,
#endif
    serverGetTlsDatabase                    ,


-- ** getUris #method:getUris#

#if defined(ENABLE_OVERLOADING)
    ServerGetUrisMethodInfo                 ,
#endif
    serverGetUris                           ,


-- ** isHttps #method:isHttps#

#if defined(ENABLE_OVERLOADING)
    ServerIsHttpsMethodInfo                 ,
#endif
    serverIsHttps                           ,


-- ** listen #method:listen#

#if defined(ENABLE_OVERLOADING)
    ServerListenMethodInfo                  ,
#endif
    serverListen                            ,


-- ** listenAll #method:listenAll#

#if defined(ENABLE_OVERLOADING)
    ServerListenAllMethodInfo               ,
#endif
    serverListenAll                         ,


-- ** listenLocal #method:listenLocal#

#if defined(ENABLE_OVERLOADING)
    ServerListenLocalMethodInfo             ,
#endif
    serverListenLocal                       ,


-- ** listenSocket #method:listenSocket#

#if defined(ENABLE_OVERLOADING)
    ServerListenSocketMethodInfo            ,
#endif
    serverListenSocket                      ,


-- ** pauseMessage #method:pauseMessage#

#if defined(ENABLE_OVERLOADING)
    ServerPauseMessageMethodInfo            ,
#endif
    serverPauseMessage                      ,


-- ** removeAuthDomain #method:removeAuthDomain#

#if defined(ENABLE_OVERLOADING)
    ServerRemoveAuthDomainMethodInfo        ,
#endif
    serverRemoveAuthDomain                  ,


-- ** removeHandler #method:removeHandler#

#if defined(ENABLE_OVERLOADING)
    ServerRemoveHandlerMethodInfo           ,
#endif
    serverRemoveHandler                     ,


-- ** removeWebsocketExtension #method:removeWebsocketExtension#

#if defined(ENABLE_OVERLOADING)
    ServerRemoveWebsocketExtensionMethodInfo,
#endif
    serverRemoveWebsocketExtension          ,


-- ** setTlsAuthMode #method:setTlsAuthMode#

#if defined(ENABLE_OVERLOADING)
    ServerSetTlsAuthModeMethodInfo          ,
#endif
    serverSetTlsAuthMode                    ,


-- ** setTlsCertificate #method:setTlsCertificate#

#if defined(ENABLE_OVERLOADING)
    ServerSetTlsCertificateMethodInfo       ,
#endif
    serverSetTlsCertificate                 ,


-- ** setTlsDatabase #method:setTlsDatabase#

#if defined(ENABLE_OVERLOADING)
    ServerSetTlsDatabaseMethodInfo          ,
#endif
    serverSetTlsDatabase                    ,


-- ** unpauseMessage #method:unpauseMessage#

#if defined(ENABLE_OVERLOADING)
    ServerUnpauseMessageMethodInfo          ,
#endif
    serverUnpauseMessage                    ,




 -- * Properties


-- ** rawPaths #attr:rawPaths#
-- | If 'P.True', percent-encoding in the Request-URI path will not be
-- automatically decoded.

#if defined(ENABLE_OVERLOADING)
    ServerRawPathsPropertyInfo              ,
#endif
    constructServerRawPaths                 ,
    getServerRawPaths                       ,
#if defined(ENABLE_OVERLOADING)
    serverRawPaths                          ,
#endif


-- ** serverHeader #attr:serverHeader#
-- | Server header.
-- 
-- If non-'P.Nothing', the value to use for the \"Server\" header on
-- [class/@serverMessage@/]s processed by this server.
-- 
-- The Server header is the server equivalent of the
-- User-Agent header, and provides information about the
-- server and its components. It contains a list of one or
-- more product tokens, separated by whitespace, with the most
-- significant product token coming first. The tokens must be
-- brief, ASCII, and mostly alphanumeric (although \"-\", \"_\",
-- and \".\" are also allowed), and may optionally include a \"\/\"
-- followed by a version string. You may also put comments,
-- enclosed in parentheses, between or after the tokens.
-- 
-- Some HTTP server implementations intentionally do not use
-- version numbers in their Server header, so that
-- installations running older versions of the server don\'t
-- end up advertising their vulnerability to specific security
-- holes.
-- 
-- As with [property/@session@/:user_agent], if you set a
-- [property/@server@/:server-header] property that has trailing
-- whitespace, t'GI.Soup.Objects.Server.Server' will append its own product token (eg,
-- @libsoup\/2.3.2@) to the end of the header for you.

#if defined(ENABLE_OVERLOADING)
    ServerServerHeaderPropertyInfo          ,
#endif
    clearServerServerHeader                 ,
    constructServerServerHeader             ,
    getServerServerHeader                   ,
#if defined(ENABLE_OVERLOADING)
    serverServerHeader                      ,
#endif
    setServerServerHeader                   ,


-- ** tlsAuthMode #attr:tlsAuthMode#
-- | A t'GI.Gio.Enums.TlsAuthenticationMode' for SSL\/TLS client authentication.

#if defined(ENABLE_OVERLOADING)
    ServerTlsAuthModePropertyInfo           ,
#endif
    constructServerTlsAuthMode              ,
    getServerTlsAuthMode                    ,
#if defined(ENABLE_OVERLOADING)
    serverTlsAuthMode                       ,
#endif
    setServerTlsAuthMode                    ,


-- ** tlsCertificate #attr:tlsCertificate#
-- | A [class/@gio@/.TlsCertificate[] that has a
-- [TlsCertificate:privateKey]("GI.Gio.Objects.TlsCertificate#g:attr:privateKey") set.
-- 
-- If this is set, then the server will be able to speak
-- https in addition to (or instead of) plain http.

#if defined(ENABLE_OVERLOADING)
    ServerTlsCertificatePropertyInfo        ,
#endif
    constructServerTlsCertificate           ,
    getServerTlsCertificate                 ,
#if defined(ENABLE_OVERLOADING)
    serverTlsCertificate                    ,
#endif
    setServerTlsCertificate                 ,


-- ** tlsDatabase #attr:tlsDatabase#
-- | A t'GI.Gio.Objects.TlsDatabase.TlsDatabase' to use for validating SSL\/TLS client
-- certificates.

#if defined(ENABLE_OVERLOADING)
    ServerTlsDatabasePropertyInfo           ,
#endif
    constructServerTlsDatabase              ,
    getServerTlsDatabase                    ,
#if defined(ENABLE_OVERLOADING)
    serverTlsDatabase                       ,
#endif
    setServerTlsDatabase                    ,




 -- * Signals


-- ** requestAborted #signal:requestAborted#

    ServerRequestAbortedCallback            ,
#if defined(ENABLE_OVERLOADING)
    ServerRequestAbortedSignalInfo          ,
#endif
    afterServerRequestAborted               ,
    onServerRequestAborted                  ,


-- ** requestFinished #signal:requestFinished#

    ServerRequestFinishedCallback           ,
#if defined(ENABLE_OVERLOADING)
    ServerRequestFinishedSignalInfo         ,
#endif
    afterServerRequestFinished              ,
    onServerRequestFinished                 ,


-- ** requestRead #signal:requestRead#

    ServerRequestReadCallback               ,
#if defined(ENABLE_OVERLOADING)
    ServerRequestReadSignalInfo             ,
#endif
    afterServerRequestRead                  ,
    onServerRequestRead                     ,


-- ** requestStarted #signal:requestStarted#

    ServerRequestStartedCallback            ,
#if defined(ENABLE_OVERLOADING)
    ServerRequestStartedSignalInfo          ,
#endif
    afterServerRequestStarted               ,
    onServerRequestStarted                  ,




    ) where

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

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

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Uri as GLib.Uri
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Enums as Gio.Enums
import qualified GI.Gio.Objects.IOStream as Gio.IOStream
import qualified GI.Gio.Objects.Socket as Gio.Socket
import qualified GI.Gio.Objects.SocketAddress as Gio.SocketAddress
import qualified GI.Gio.Objects.TlsCertificate as Gio.TlsCertificate
import qualified GI.Gio.Objects.TlsDatabase as Gio.TlsDatabase
import qualified GI.Soup.Callbacks as Soup.Callbacks
import {-# SOURCE #-} qualified GI.Soup.Flags as Soup.Flags
import {-# SOURCE #-} qualified GI.Soup.Objects.AuthDomain as Soup.AuthDomain
import {-# SOURCE #-} qualified GI.Soup.Objects.ServerMessage as Soup.ServerMessage

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

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

foreign import ccall "soup_server_get_type"
    c_soup_server_get_type :: IO B.Types.GType

instance B.Types.TypedObject Server where
    glibType :: IO GType
glibType = IO GType
c_soup_server_get_type

instance B.Types.GObject Server

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

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

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

-- | Convert 'Server' 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 Server) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_soup_server_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Server -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Server
P.Nothing = Ptr GValue -> Ptr Server -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Server
forall a. Ptr a
FP.nullPtr :: FP.Ptr Server)
    gvalueSet_ Ptr GValue
gv (P.Just Server
obj) = Server -> (Ptr Server -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Server
obj (Ptr GValue -> Ptr Server -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Server)
gvalueGet_ Ptr GValue
gv = do
        Ptr Server
ptr <- Ptr GValue -> IO (Ptr Server)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Server)
        if Ptr Server
ptr Ptr Server -> Ptr Server -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Server
forall a. Ptr a
FP.nullPtr
        then Server -> Maybe Server
forall a. a -> Maybe a
P.Just (Server -> Maybe Server) -> IO Server -> IO (Maybe Server)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Server -> Server) -> Ptr Server -> IO Server
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Server -> Server
Server Ptr Server
ptr
        else Maybe Server -> IO (Maybe Server)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Server
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveServerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveServerMethod "acceptIostream" o = ServerAcceptIostreamMethodInfo
    ResolveServerMethod "addAuthDomain" o = ServerAddAuthDomainMethodInfo
    ResolveServerMethod "addEarlyHandler" o = ServerAddEarlyHandlerMethodInfo
    ResolveServerMethod "addHandler" o = ServerAddHandlerMethodInfo
    ResolveServerMethod "addWebsocketExtension" o = ServerAddWebsocketExtensionMethodInfo
    ResolveServerMethod "addWebsocketHandler" o = ServerAddWebsocketHandlerMethodInfo
    ResolveServerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveServerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveServerMethod "disconnect" o = ServerDisconnectMethodInfo
    ResolveServerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveServerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveServerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveServerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveServerMethod "isHttps" o = ServerIsHttpsMethodInfo
    ResolveServerMethod "listen" o = ServerListenMethodInfo
    ResolveServerMethod "listenAll" o = ServerListenAllMethodInfo
    ResolveServerMethod "listenLocal" o = ServerListenLocalMethodInfo
    ResolveServerMethod "listenSocket" o = ServerListenSocketMethodInfo
    ResolveServerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveServerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveServerMethod "pauseMessage" o = ServerPauseMessageMethodInfo
    ResolveServerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveServerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveServerMethod "removeAuthDomain" o = ServerRemoveAuthDomainMethodInfo
    ResolveServerMethod "removeHandler" o = ServerRemoveHandlerMethodInfo
    ResolveServerMethod "removeWebsocketExtension" o = ServerRemoveWebsocketExtensionMethodInfo
    ResolveServerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveServerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveServerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveServerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveServerMethod "unpauseMessage" o = ServerUnpauseMessageMethodInfo
    ResolveServerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveServerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveServerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveServerMethod "getListeners" o = ServerGetListenersMethodInfo
    ResolveServerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveServerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveServerMethod "getTlsAuthMode" o = ServerGetTlsAuthModeMethodInfo
    ResolveServerMethod "getTlsCertificate" o = ServerGetTlsCertificateMethodInfo
    ResolveServerMethod "getTlsDatabase" o = ServerGetTlsDatabaseMethodInfo
    ResolveServerMethod "getUris" o = ServerGetUrisMethodInfo
    ResolveServerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveServerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveServerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveServerMethod "setTlsAuthMode" o = ServerSetTlsAuthModeMethodInfo
    ResolveServerMethod "setTlsCertificate" o = ServerSetTlsCertificateMethodInfo
    ResolveServerMethod "setTlsDatabase" o = ServerSetTlsDatabaseMethodInfo
    ResolveServerMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveServerMethod t Server, O.OverloadedMethod info Server p) => OL.IsLabel t (Server -> 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 ~ ResolveServerMethod t Server, O.OverloadedMethod info Server p, R.HasField t Server p) => R.HasField t Server p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- signal Server::request-aborted
-- | Emitted when processing has failed for a message.
-- 
-- This could mean either that it could not be read (if
-- [signal/@server@/[requestRead](#g:signal:requestRead)] has not been emitted for it yet), or that
-- the response could not be written back (if [signal/@server@/[requestRead](#g:signal:requestRead)]
-- has been emitted but [signal/@server@/[requestFinished](#g:signal:requestFinished)] has not been).
-- 
-- /@message@/ is in an undefined state when this signal is
-- emitted; the signal exists primarily to allow the server to
-- free any state that it may have allocated in
-- [signal/@server@/[requestStarted](#g:signal:requestStarted)].
type ServerRequestAbortedCallback =
    Soup.ServerMessage.ServerMessage
    -- ^ /@message@/: the message
    -> IO ()

type C_ServerRequestAbortedCallback =
    Ptr Server ->                           -- object
    Ptr Soup.ServerMessage.ServerMessage ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ServerRequestAbortedCallback :: 
    GObject a => (a -> ServerRequestAbortedCallback) ->
    C_ServerRequestAbortedCallback
wrap_ServerRequestAbortedCallback :: forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestAbortedCallback a -> ServerRequestAbortedCallback
gi'cb Ptr Server
gi'selfPtr Ptr ServerMessage
message Ptr ()
_ = do
    ServerMessage
message' <- ((ManagedPtr ServerMessage -> ServerMessage)
-> Ptr ServerMessage -> IO ServerMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ServerMessage -> ServerMessage
Soup.ServerMessage.ServerMessage) Ptr ServerMessage
message
    Ptr Server -> (Server -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Server
gi'selfPtr ((Server -> IO ()) -> IO ()) -> (Server -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Server
gi'self -> a -> ServerRequestAbortedCallback
gi'cb (Server -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Server
gi'self)  ServerMessage
message'


-- | Connect a signal handler for the [requestAborted](#signal:requestAborted) 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' server #requestAborted callback
-- @
-- 
-- 
onServerRequestAborted :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerRequestAbortedCallback) -> m SignalHandlerId
onServerRequestAborted :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerRequestAbortedCallback)
-> m SignalHandlerId
onServerRequestAborted a
obj (?self::a) => ServerRequestAbortedCallback
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 -> ServerRequestAbortedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerRequestAbortedCallback
ServerRequestAbortedCallback
cb
    let wrapped' :: C_ServerRequestAbortedCallback
wrapped' = (a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestAbortedCallback a -> ServerRequestAbortedCallback
wrapped
    FunPtr C_ServerRequestAbortedCallback
wrapped'' <- C_ServerRequestAbortedCallback
-> IO (FunPtr C_ServerRequestAbortedCallback)
mk_ServerRequestAbortedCallback C_ServerRequestAbortedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerRequestAbortedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"request-aborted" FunPtr C_ServerRequestAbortedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [requestAborted](#signal:requestAborted) 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' server #requestAborted 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.
-- 
afterServerRequestAborted :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerRequestAbortedCallback) -> m SignalHandlerId
afterServerRequestAborted :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerRequestAbortedCallback)
-> m SignalHandlerId
afterServerRequestAborted a
obj (?self::a) => ServerRequestAbortedCallback
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 -> ServerRequestAbortedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerRequestAbortedCallback
ServerRequestAbortedCallback
cb
    let wrapped' :: C_ServerRequestAbortedCallback
wrapped' = (a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestAbortedCallback a -> ServerRequestAbortedCallback
wrapped
    FunPtr C_ServerRequestAbortedCallback
wrapped'' <- C_ServerRequestAbortedCallback
-> IO (FunPtr C_ServerRequestAbortedCallback)
mk_ServerRequestAbortedCallback C_ServerRequestAbortedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerRequestAbortedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"request-aborted" FunPtr C_ServerRequestAbortedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ServerRequestAbortedSignalInfo
instance SignalInfo ServerRequestAbortedSignalInfo where
    type HaskellCallbackType ServerRequestAbortedSignalInfo = ServerRequestAbortedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ServerRequestAbortedCallback cb
        cb'' <- mk_ServerRequestAbortedCallback cb'
        connectSignalFunPtr obj "request-aborted" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Server::request-aborted"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Server.html#g:signal:requestAborted"})

#endif

-- signal Server::request-finished
-- | Emitted when the server has finished writing a response to
-- a request.
type ServerRequestFinishedCallback =
    Soup.ServerMessage.ServerMessage
    -- ^ /@message@/: the message
    -> IO ()

type C_ServerRequestFinishedCallback =
    Ptr Server ->                           -- object
    Ptr Soup.ServerMessage.ServerMessage ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ServerRequestFinishedCallback :: 
    GObject a => (a -> ServerRequestFinishedCallback) ->
    C_ServerRequestFinishedCallback
wrap_ServerRequestFinishedCallback :: forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestFinishedCallback a -> ServerRequestAbortedCallback
gi'cb Ptr Server
gi'selfPtr Ptr ServerMessage
message Ptr ()
_ = do
    ServerMessage
message' <- ((ManagedPtr ServerMessage -> ServerMessage)
-> Ptr ServerMessage -> IO ServerMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ServerMessage -> ServerMessage
Soup.ServerMessage.ServerMessage) Ptr ServerMessage
message
    Ptr Server -> (Server -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Server
gi'selfPtr ((Server -> IO ()) -> IO ()) -> (Server -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Server
gi'self -> a -> ServerRequestAbortedCallback
gi'cb (Server -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Server
gi'self)  ServerMessage
message'


-- | Connect a signal handler for the [requestFinished](#signal:requestFinished) 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' server #requestFinished callback
-- @
-- 
-- 
onServerRequestFinished :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerRequestFinishedCallback) -> m SignalHandlerId
onServerRequestFinished :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerRequestAbortedCallback)
-> m SignalHandlerId
onServerRequestFinished a
obj (?self::a) => ServerRequestAbortedCallback
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 -> ServerRequestAbortedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerRequestAbortedCallback
ServerRequestAbortedCallback
cb
    let wrapped' :: C_ServerRequestAbortedCallback
wrapped' = (a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestFinishedCallback a -> ServerRequestAbortedCallback
wrapped
    FunPtr C_ServerRequestAbortedCallback
wrapped'' <- C_ServerRequestAbortedCallback
-> IO (FunPtr C_ServerRequestAbortedCallback)
mk_ServerRequestFinishedCallback C_ServerRequestAbortedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerRequestAbortedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"request-finished" FunPtr C_ServerRequestAbortedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [requestFinished](#signal:requestFinished) 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' server #requestFinished 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.
-- 
afterServerRequestFinished :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerRequestFinishedCallback) -> m SignalHandlerId
afterServerRequestFinished :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerRequestAbortedCallback)
-> m SignalHandlerId
afterServerRequestFinished a
obj (?self::a) => ServerRequestAbortedCallback
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 -> ServerRequestAbortedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerRequestAbortedCallback
ServerRequestAbortedCallback
cb
    let wrapped' :: C_ServerRequestAbortedCallback
wrapped' = (a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestFinishedCallback a -> ServerRequestAbortedCallback
wrapped
    FunPtr C_ServerRequestAbortedCallback
wrapped'' <- C_ServerRequestAbortedCallback
-> IO (FunPtr C_ServerRequestAbortedCallback)
mk_ServerRequestFinishedCallback C_ServerRequestAbortedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerRequestAbortedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"request-finished" FunPtr C_ServerRequestAbortedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ServerRequestFinishedSignalInfo
instance SignalInfo ServerRequestFinishedSignalInfo where
    type HaskellCallbackType ServerRequestFinishedSignalInfo = ServerRequestFinishedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ServerRequestFinishedCallback cb
        cb'' <- mk_ServerRequestFinishedCallback cb'
        connectSignalFunPtr obj "request-finished" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Server::request-finished"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Server.html#g:signal:requestFinished"})

#endif

-- signal Server::request-read
-- | Emitted when the server has successfully read a request.
-- 
-- /@message@/ will have all of its request-side information
-- filled in, and if the message was authenticated, /@client@/
-- will have information about that. This signal is emitted
-- before any (non-early) handlers are called for the message,
-- and if it sets the message\'s @/status_code/@, then normal
-- handler processing will be skipped.
type ServerRequestReadCallback =
    Soup.ServerMessage.ServerMessage
    -- ^ /@message@/: the message
    -> IO ()

type C_ServerRequestReadCallback =
    Ptr Server ->                           -- object
    Ptr Soup.ServerMessage.ServerMessage ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ServerRequestReadCallback :: 
    GObject a => (a -> ServerRequestReadCallback) ->
    C_ServerRequestReadCallback
wrap_ServerRequestReadCallback :: forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestReadCallback a -> ServerRequestAbortedCallback
gi'cb Ptr Server
gi'selfPtr Ptr ServerMessage
message Ptr ()
_ = do
    ServerMessage
message' <- ((ManagedPtr ServerMessage -> ServerMessage)
-> Ptr ServerMessage -> IO ServerMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ServerMessage -> ServerMessage
Soup.ServerMessage.ServerMessage) Ptr ServerMessage
message
    Ptr Server -> (Server -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Server
gi'selfPtr ((Server -> IO ()) -> IO ()) -> (Server -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Server
gi'self -> a -> ServerRequestAbortedCallback
gi'cb (Server -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Server
gi'self)  ServerMessage
message'


-- | Connect a signal handler for the [requestRead](#signal:requestRead) 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' server #requestRead callback
-- @
-- 
-- 
onServerRequestRead :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerRequestReadCallback) -> m SignalHandlerId
onServerRequestRead :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerRequestAbortedCallback)
-> m SignalHandlerId
onServerRequestRead a
obj (?self::a) => ServerRequestAbortedCallback
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 -> ServerRequestAbortedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerRequestAbortedCallback
ServerRequestAbortedCallback
cb
    let wrapped' :: C_ServerRequestAbortedCallback
wrapped' = (a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestReadCallback a -> ServerRequestAbortedCallback
wrapped
    FunPtr C_ServerRequestAbortedCallback
wrapped'' <- C_ServerRequestAbortedCallback
-> IO (FunPtr C_ServerRequestAbortedCallback)
mk_ServerRequestReadCallback C_ServerRequestAbortedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerRequestAbortedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"request-read" FunPtr C_ServerRequestAbortedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [requestRead](#signal:requestRead) 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' server #requestRead 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.
-- 
afterServerRequestRead :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerRequestReadCallback) -> m SignalHandlerId
afterServerRequestRead :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerRequestAbortedCallback)
-> m SignalHandlerId
afterServerRequestRead a
obj (?self::a) => ServerRequestAbortedCallback
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 -> ServerRequestAbortedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerRequestAbortedCallback
ServerRequestAbortedCallback
cb
    let wrapped' :: C_ServerRequestAbortedCallback
wrapped' = (a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestReadCallback a -> ServerRequestAbortedCallback
wrapped
    FunPtr C_ServerRequestAbortedCallback
wrapped'' <- C_ServerRequestAbortedCallback
-> IO (FunPtr C_ServerRequestAbortedCallback)
mk_ServerRequestReadCallback C_ServerRequestAbortedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerRequestAbortedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"request-read" FunPtr C_ServerRequestAbortedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ServerRequestReadSignalInfo
instance SignalInfo ServerRequestReadSignalInfo where
    type HaskellCallbackType ServerRequestReadSignalInfo = ServerRequestReadCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ServerRequestReadCallback cb
        cb'' <- mk_ServerRequestReadCallback cb'
        connectSignalFunPtr obj "request-read" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Server::request-read"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Server.html#g:signal:requestRead"})

#endif

-- signal Server::request-started
-- | Emitted when the server has started reading a new request.
-- 
-- /@message@/ will be completely blank; not even the
-- Request-Line will have been read yet. About the only thing
-- you can usefully do with it is connect to its signals.
-- 
-- If the request is read successfully, this will eventually
-- be followed by a [signal/@server@/[request_read](#g:signal:request_read) signal]. If a
-- response is then sent, the request processing will end with
-- a [signal/@server@/[requestFinished](#g:signal:requestFinished)] signal. If a network error
-- occurs, the processing will instead end with
-- [signal/@server@/[requestAborted](#g:signal:requestAborted)].
type ServerRequestStartedCallback =
    Soup.ServerMessage.ServerMessage
    -- ^ /@message@/: the new message
    -> IO ()

type C_ServerRequestStartedCallback =
    Ptr Server ->                           -- object
    Ptr Soup.ServerMessage.ServerMessage ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ServerRequestStartedCallback :: 
    GObject a => (a -> ServerRequestStartedCallback) ->
    C_ServerRequestStartedCallback
wrap_ServerRequestStartedCallback :: forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestStartedCallback a -> ServerRequestAbortedCallback
gi'cb Ptr Server
gi'selfPtr Ptr ServerMessage
message Ptr ()
_ = do
    ServerMessage
message' <- ((ManagedPtr ServerMessage -> ServerMessage)
-> Ptr ServerMessage -> IO ServerMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ServerMessage -> ServerMessage
Soup.ServerMessage.ServerMessage) Ptr ServerMessage
message
    Ptr Server -> (Server -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Server
gi'selfPtr ((Server -> IO ()) -> IO ()) -> (Server -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Server
gi'self -> a -> ServerRequestAbortedCallback
gi'cb (Server -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Server
gi'self)  ServerMessage
message'


-- | Connect a signal handler for the [requestStarted](#signal:requestStarted) 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' server #requestStarted callback
-- @
-- 
-- 
onServerRequestStarted :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerRequestStartedCallback) -> m SignalHandlerId
onServerRequestStarted :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerRequestAbortedCallback)
-> m SignalHandlerId
onServerRequestStarted a
obj (?self::a) => ServerRequestAbortedCallback
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 -> ServerRequestAbortedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerRequestAbortedCallback
ServerRequestAbortedCallback
cb
    let wrapped' :: C_ServerRequestAbortedCallback
wrapped' = (a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestStartedCallback a -> ServerRequestAbortedCallback
wrapped
    FunPtr C_ServerRequestAbortedCallback
wrapped'' <- C_ServerRequestAbortedCallback
-> IO (FunPtr C_ServerRequestAbortedCallback)
mk_ServerRequestStartedCallback C_ServerRequestAbortedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerRequestAbortedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"request-started" FunPtr C_ServerRequestAbortedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [requestStarted](#signal:requestStarted) 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' server #requestStarted 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.
-- 
afterServerRequestStarted :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerRequestStartedCallback) -> m SignalHandlerId
afterServerRequestStarted :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerRequestAbortedCallback)
-> m SignalHandlerId
afterServerRequestStarted a
obj (?self::a) => ServerRequestAbortedCallback
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 -> ServerRequestAbortedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerRequestAbortedCallback
ServerRequestAbortedCallback
cb
    let wrapped' :: C_ServerRequestAbortedCallback
wrapped' = (a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
forall a.
GObject a =>
(a -> ServerRequestAbortedCallback)
-> C_ServerRequestAbortedCallback
wrap_ServerRequestStartedCallback a -> ServerRequestAbortedCallback
wrapped
    FunPtr C_ServerRequestAbortedCallback
wrapped'' <- C_ServerRequestAbortedCallback
-> IO (FunPtr C_ServerRequestAbortedCallback)
mk_ServerRequestStartedCallback C_ServerRequestAbortedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerRequestAbortedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"request-started" FunPtr C_ServerRequestAbortedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ServerRequestStartedSignalInfo
instance SignalInfo ServerRequestStartedSignalInfo where
    type HaskellCallbackType ServerRequestStartedSignalInfo = ServerRequestStartedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ServerRequestStartedCallback cb
        cb'' <- mk_ServerRequestStartedCallback cb'
        connectSignalFunPtr obj "request-started" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Server::request-started"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Server.html#g:signal:requestStarted"})

#endif

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

-- | Get the value of the “@raw-paths@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' server #rawPaths
-- @
getServerRawPaths :: (MonadIO m, IsServer o) => o -> m Bool
getServerRawPaths :: forall (m :: * -> *) o. (MonadIO m, IsServer o) => o -> m Bool
getServerRawPaths 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
"raw-paths"

-- | Construct a `GValueConstruct` with valid value for the “@raw-paths@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructServerRawPaths :: (IsServer o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructServerRawPaths :: forall o (m :: * -> *).
(IsServer o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructServerRawPaths 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
"raw-paths" Bool
val

#if defined(ENABLE_OVERLOADING)
data ServerRawPathsPropertyInfo
instance AttrInfo ServerRawPathsPropertyInfo where
    type AttrAllowedOps ServerRawPathsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ServerRawPathsPropertyInfo = IsServer
    type AttrSetTypeConstraint ServerRawPathsPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ServerRawPathsPropertyInfo = (~) Bool
    type AttrTransferType ServerRawPathsPropertyInfo = Bool
    type AttrGetType ServerRawPathsPropertyInfo = Bool
    type AttrLabel ServerRawPathsPropertyInfo = "raw-paths"
    type AttrOrigin ServerRawPathsPropertyInfo = Server
    attrGet = getServerRawPaths
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructServerRawPaths
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Server.rawPaths"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Server.html#g:attr:rawPaths"
        })
#endif

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

-- | Get the value of the “@server-header@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' server #serverHeader
-- @
getServerServerHeader :: (MonadIO m, IsServer o) => o -> m (Maybe T.Text)
getServerServerHeader :: forall (m :: * -> *) o.
(MonadIO m, IsServer o) =>
o -> m (Maybe Text)
getServerServerHeader 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
"server-header"

-- | Set the value of the “@server-header@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' server [ #serverHeader 'Data.GI.Base.Attributes.:=' value ]
-- @
setServerServerHeader :: (MonadIO m, IsServer o) => o -> T.Text -> m ()
setServerServerHeader :: forall (m :: * -> *) o.
(MonadIO m, IsServer o) =>
o -> Text -> m ()
setServerServerHeader 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
"server-header" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@server-header@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructServerServerHeader :: (IsServer o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructServerServerHeader :: forall o (m :: * -> *).
(IsServer o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructServerServerHeader 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
"server-header" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@server-header@” 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' #serverHeader
-- @
clearServerServerHeader :: (MonadIO m, IsServer o) => o -> m ()
clearServerServerHeader :: forall (m :: * -> *) o. (MonadIO m, IsServer o) => o -> m ()
clearServerServerHeader 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
"server-header" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ServerServerHeaderPropertyInfo
instance AttrInfo ServerServerHeaderPropertyInfo where
    type AttrAllowedOps ServerServerHeaderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ServerServerHeaderPropertyInfo = IsServer
    type AttrSetTypeConstraint ServerServerHeaderPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ServerServerHeaderPropertyInfo = (~) T.Text
    type AttrTransferType ServerServerHeaderPropertyInfo = T.Text
    type AttrGetType ServerServerHeaderPropertyInfo = (Maybe T.Text)
    type AttrLabel ServerServerHeaderPropertyInfo = "server-header"
    type AttrOrigin ServerServerHeaderPropertyInfo = Server
    attrGet = getServerServerHeader
    attrSet = setServerServerHeader
    attrTransfer _ v = do
        return v
    attrConstruct = constructServerServerHeader
    attrClear = clearServerServerHeader
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Server.serverHeader"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Server.html#g:attr:serverHeader"
        })
#endif

-- VVV Prop "tls-auth-mode"
   -- Type: TInterface (Name {namespace = "Gio", name = "TlsAuthenticationMode"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@tls-auth-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' server [ #tlsAuthMode 'Data.GI.Base.Attributes.:=' value ]
-- @
setServerTlsAuthMode :: (MonadIO m, IsServer o) => o -> Gio.Enums.TlsAuthenticationMode -> m ()
setServerTlsAuthMode :: forall (m :: * -> *) o.
(MonadIO m, IsServer o) =>
o -> TlsAuthenticationMode -> m ()
setServerTlsAuthMode o
obj TlsAuthenticationMode
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 -> TlsAuthenticationMode -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"tls-auth-mode" TlsAuthenticationMode
val

-- | Construct a `GValueConstruct` with valid value for the “@tls-auth-mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructServerTlsAuthMode :: (IsServer o, MIO.MonadIO m) => Gio.Enums.TlsAuthenticationMode -> m (GValueConstruct o)
constructServerTlsAuthMode :: forall o (m :: * -> *).
(IsServer o, MonadIO m) =>
TlsAuthenticationMode -> m (GValueConstruct o)
constructServerTlsAuthMode TlsAuthenticationMode
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 -> TlsAuthenticationMode -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"tls-auth-mode" TlsAuthenticationMode
val

#if defined(ENABLE_OVERLOADING)
data ServerTlsAuthModePropertyInfo
instance AttrInfo ServerTlsAuthModePropertyInfo where
    type AttrAllowedOps ServerTlsAuthModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ServerTlsAuthModePropertyInfo = IsServer
    type AttrSetTypeConstraint ServerTlsAuthModePropertyInfo = (~) Gio.Enums.TlsAuthenticationMode
    type AttrTransferTypeConstraint ServerTlsAuthModePropertyInfo = (~) Gio.Enums.TlsAuthenticationMode
    type AttrTransferType ServerTlsAuthModePropertyInfo = Gio.Enums.TlsAuthenticationMode
    type AttrGetType ServerTlsAuthModePropertyInfo = Gio.Enums.TlsAuthenticationMode
    type AttrLabel ServerTlsAuthModePropertyInfo = "tls-auth-mode"
    type AttrOrigin ServerTlsAuthModePropertyInfo = Server
    attrGet = getServerTlsAuthMode
    attrSet = setServerTlsAuthMode
    attrTransfer _ v = do
        return v
    attrConstruct = constructServerTlsAuthMode
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Server.tlsAuthMode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.2/docs/GI-Soup-Objects-Server.html#g:attr:tlsAuthMode"
        })
#endif

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

-- | 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' server #tlsCertificate
-- @
getServerTlsCertificate :: (MonadIO m, IsServer o) => o -> m (Maybe Gio.TlsCertificate.TlsCertificate)
getServerTlsCertificate :: forall (m :: * -> *) o.
(MonadIO m, IsServer o) =>
o -> m (Maybe TlsCertificate)
getServerTlsCertificate 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' server [ #tlsCertificate 'Data.GI.Base.Attributes.:=' value ]
-- @
setServerTlsCertificate :: (MonadIO m, IsServer o, Gio.TlsCertificate.IsTlsCertificate a) => o -> a -> m ()
setServerTlsCertificate :: forall (m :: * -> *) o a.
(MonadIO m, IsServer o, IsTlsCertificate a) =>
o -> a -> m ()
setServerTlsCertificate 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`.
constructServerTlsCertificate :: (IsServer o, MIO.MonadIO m, Gio.TlsCertificate.IsTlsCertificate a) => a -> m (GValueConstruct o)
constructServerTlsCertificate :: forall o (m :: * -> *) a.
(IsServer o, MonadIO m, IsTlsCertificate a) =>
a -> m (GValueConstruct o)
constructServerTlsCertificate 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)

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Server
type instance O.AttributeList Server = ServerAttributeList
type ServerAttributeList = ('[ '("rawPaths", ServerRawPathsPropertyInfo), '("serverHeader", ServerServerHeaderPropertyInfo), '("tlsAuthMode", ServerTlsAuthModePropertyInfo), '("tlsCertificate", ServerTlsCertificatePropertyInfo), '("tlsDatabase", ServerTlsDatabasePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
serverRawPaths :: AttrLabelProxy "rawPaths"
serverRawPaths = AttrLabelProxy

serverServerHeader :: AttrLabelProxy "serverHeader"
serverServerHeader = AttrLabelProxy

serverTlsAuthMode :: AttrLabelProxy "tlsAuthMode"
serverTlsAuthMode = AttrLabelProxy

serverTlsCertificate :: AttrLabelProxy "tlsCertificate"
serverTlsCertificate = AttrLabelProxy

serverTlsDatabase :: AttrLabelProxy "tlsDatabase"
serverTlsDatabase = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Server = ServerSignalList
type ServerSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("requestAborted", ServerRequestAbortedSignalInfo), '("requestFinished", ServerRequestFinishedSignalInfo), '("requestRead", ServerRequestReadSignalInfo), '("requestStarted", ServerRequestStartedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Server::accept_iostream
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "IOStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIOStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "local_addr"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the local #GSocketAddress associated with the\n  @stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote_addr"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the remote #GSocketAddress associated with the\n  @stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "soup_server_accept_iostream" soup_server_accept_iostream :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    Ptr Gio.IOStream.IOStream ->            -- stream : TInterface (Name {namespace = "Gio", name = "IOStream"})
    Ptr Gio.SocketAddress.SocketAddress ->  -- local_addr : TInterface (Name {namespace = "Gio", name = "SocketAddress"})
    Ptr Gio.SocketAddress.SocketAddress ->  -- remote_addr : TInterface (Name {namespace = "Gio", name = "SocketAddress"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Adds a new client stream to the /@server@/.
serverAcceptIostream ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a, Gio.IOStream.IsIOStream b, Gio.SocketAddress.IsSocketAddress c, Gio.SocketAddress.IsSocketAddress d) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream'
    -> Maybe (c)
    -- ^ /@localAddr@/: the local t'GI.Gio.Objects.SocketAddress.SocketAddress' associated with the
    --   /@stream@/
    -> Maybe (d)
    -- ^ /@remoteAddr@/: the remote t'GI.Gio.Objects.SocketAddress.SocketAddress' associated with the
    --   /@stream@/
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serverAcceptIostream :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsServer a, IsIOStream b,
 IsSocketAddress c, IsSocketAddress d) =>
a -> b -> Maybe c -> Maybe d -> m ()
serverAcceptIostream a
server b
stream Maybe c
localAddr Maybe d
remoteAddr = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr IOStream
stream' <- b -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
stream
    Ptr SocketAddress
maybeLocalAddr <- case Maybe c
localAddr of
        Maybe c
Nothing -> Ptr SocketAddress -> IO (Ptr SocketAddress)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketAddress
forall a. Ptr a
nullPtr
        Just c
jLocalAddr -> do
            Ptr SocketAddress
jLocalAddr' <- c -> IO (Ptr SocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jLocalAddr
            Ptr SocketAddress -> IO (Ptr SocketAddress)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketAddress
jLocalAddr'
    Ptr SocketAddress
maybeRemoteAddr <- case Maybe d
remoteAddr of
        Maybe d
Nothing -> Ptr SocketAddress -> IO (Ptr SocketAddress)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketAddress
forall a. Ptr a
nullPtr
        Just d
jRemoteAddr -> do
            Ptr SocketAddress
jRemoteAddr' <- d -> IO (Ptr SocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jRemoteAddr
            Ptr SocketAddress -> IO (Ptr SocketAddress)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketAddress
jRemoteAddr'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Server
-> Ptr IOStream
-> Ptr SocketAddress
-> Ptr SocketAddress
-> Ptr (Ptr GError)
-> IO CInt
soup_server_accept_iostream Ptr Server
server' Ptr IOStream
stream' Ptr SocketAddress
maybeLocalAddr Ptr SocketAddress
maybeRemoteAddr
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
stream
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
localAddr c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
remoteAddr d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServerAcceptIostreamMethodInfo
instance (signature ~ (b -> Maybe (c) -> Maybe (d) -> m ()), MonadIO m, IsServer a, Gio.IOStream.IsIOStream b, Gio.SocketAddress.IsSocketAddress c, Gio.SocketAddress.IsSocketAddress d) => O.OverloadedMethod ServerAcceptIostreamMethodInfo a signature where
    overloadedMethod = serverAcceptIostream

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


#endif

-- method Server::add_auth_domain
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "auth_domain"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "AuthDomain" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuthDomain" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_server_add_auth_domain" soup_server_add_auth_domain :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    Ptr Soup.AuthDomain.AuthDomain ->       -- auth_domain : TInterface (Name {namespace = "Soup", name = "AuthDomain"})
    IO ()

-- | Adds an authentication domain to /@server@/.
-- 
-- Each auth domain will have the chance to require authentication for each
-- request that comes in; normally auth domains will require authentication for
-- requests on certain paths that they have been set up to watch, or that meet
-- other criteria set by the caller. If an auth domain determines that a request
-- requires authentication (and the request doesn\'t contain authentication),
-- /@server@/ will automatically reject the request with an appropriate status (401
-- Unauthorized or 407 Proxy Authentication Required). If the request used the
-- SoupServer:100-continue Expectation, /@server@/ will reject it before the
-- request body is sent.
serverAddAuthDomain ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a, Soup.AuthDomain.IsAuthDomain b) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@authDomain@/: a t'GI.Soup.Objects.AuthDomain.AuthDomain'
    -> m ()
serverAddAuthDomain :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsServer a, IsAuthDomain b) =>
a -> b -> m ()
serverAddAuthDomain a
server b
authDomain = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr AuthDomain
authDomain' <- b -> IO (Ptr AuthDomain)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
authDomain
    Ptr Server -> Ptr AuthDomain -> IO ()
soup_server_add_auth_domain Ptr Server
server' Ptr AuthDomain
authDomain'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
authDomain
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerAddAuthDomainMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsServer a, Soup.AuthDomain.IsAuthDomain b) => O.OverloadedMethod ServerAddAuthDomainMethodInfo a signature where
    overloadedMethod = serverAddAuthDomain

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


#endif

-- method Server::add_early_handler
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the toplevel path for the handler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ServerCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to invoke for\n  requests under @path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data for @callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier to free @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_server_add_early_handler" soup_server_add_early_handler :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    CString ->                              -- path : TBasicType TUTF8
    FunPtr Soup.Callbacks.C_ServerCallback -> -- callback : TInterface (Name {namespace = "Soup", name = "ServerCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Adds an \"early\" handler to /@server@/ for requests prefixed by /@path@/.
-- 
-- Note that \"normal\" and \"early\" handlers are matched up together, so if you
-- add a normal handler for \"\/foo\" and an early handler for \"\/foo\/bar\", then a
-- request to \"\/foo\/bar\" (or any path below it) will run only the early handler.
-- (But if you add both handlers at the same path, then both will get run.)
-- 
-- For requests under /@path@/ (that have not already been assigned a
-- status code by a [class/@authDomain@/] or a signal handler), /@callback@/
-- will be invoked after receiving the request headers, but before
-- receiving the request body; the message\'s method and
-- request-headers properties will be set.
-- 
-- Early handlers are generally used for processing requests with request bodies
-- in a streaming fashion. If you determine that the request will contain a
-- message body, normally you would call [method/@messageBody@/.set_accumulate] on
-- the message\'s request-body to turn off request-body accumulation, and connect
-- to the message\'s [signal/@serverMessage@/[gotChunk](#g:signal:gotChunk)] signal to process each
-- chunk as it comes in.
-- 
-- To complete the message processing after the full message body has
-- been read, you can either also connect to [signal/@serverMessage@/[gotBody](#g:signal:gotBody)],
-- or else you can register a non-early handler for /@path@/ as well. As
-- long as you have not set the status-code by the time
-- [signal/@serverMessage@/[gotBody](#g:signal:gotBody)] is emitted, the non-early handler will be
-- run as well.
serverAddEarlyHandler ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> Maybe (T.Text)
    -- ^ /@path@/: the toplevel path for the handler
    -> Soup.Callbacks.ServerCallback
    -- ^ /@callback@/: callback to invoke for
    --   requests under /@path@/
    -> m ()
serverAddEarlyHandler :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> Maybe Text -> ServerCallback -> m ()
serverAddEarlyHandler a
server Maybe Text
path ServerCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr CChar
maybePath <- case Maybe Text
path of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPath -> do
            Ptr CChar
jPath' <- Text -> IO (Ptr CChar)
textToCString Text
jPath
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPath'
    FunPtr C_ServerCallback
callback' <- C_ServerCallback -> IO (FunPtr C_ServerCallback)
Soup.Callbacks.mk_ServerCallback (Maybe (Ptr (FunPtr C_ServerCallback))
-> ServerCallback_WithClosures -> C_ServerCallback
Soup.Callbacks.wrap_ServerCallback Maybe (Ptr (FunPtr C_ServerCallback))
forall a. Maybe a
Nothing (ServerCallback -> ServerCallback_WithClosures
Soup.Callbacks.drop_closures_ServerCallback ServerCallback
callback))
    let userData :: Ptr ()
userData = FunPtr C_ServerCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ServerCallback
callback'
    let destroy :: FunPtr (Ptr a -> IO ())
destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Server
-> Ptr CChar
-> FunPtr C_ServerCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
soup_server_add_early_handler Ptr Server
server' Ptr CChar
maybePath FunPtr C_ServerCallback
callback' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePath
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerAddEarlyHandlerMethodInfo
instance (signature ~ (Maybe (T.Text) -> Soup.Callbacks.ServerCallback -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerAddEarlyHandlerMethodInfo a signature where
    overloadedMethod = serverAddEarlyHandler

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


#endif

-- method Server::add_handler
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the toplevel path for the handler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ServerCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to invoke for\n  requests under @path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data for @callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier to free @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_server_add_handler" soup_server_add_handler :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    CString ->                              -- path : TBasicType TUTF8
    FunPtr Soup.Callbacks.C_ServerCallback -> -- callback : TInterface (Name {namespace = "Soup", name = "ServerCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Adds a handler to /@server@/ for requests prefixed by /@path@/.
-- 
-- If /@path@/ is 'P.Nothing' or \"\/\", then this will be the default handler for all
-- requests that don\'t have a more specific handler. (Note though that if you
-- want to handle requests to the special \"*\" URI, you must explicitly register
-- a handler for \"*\"; the default handler will not be used for that case.)
-- 
-- For requests under /@path@/ (that have not already been assigned a
-- status code by a [class/@authDomain@/], an early server handler, or a
-- signal handler), /@callback@/ will be invoked after receiving the
-- request body; the [class/@serverMessage@/]\'s method, request-headers,
-- and request-body properties will be set.
-- 
-- After determining what to do with the request, the callback must at a minimum
-- call [method/@serverMessage@/.set_status] on the message to set the response
-- status code. Additionally, it may set response headers and\/or fill in the
-- response body.
-- 
-- If the callback cannot fully fill in the response before returning
-- (eg, if it needs to wait for information from a database, or
-- another network server), it should call [method/@serverMessage@/.pause]
-- to tell /@server@/ to not send the response right away. When the
-- response is ready, call [method/@serverMessage@/.unpause] to cause it
-- to be sent.
-- 
-- To send the response body a bit at a time using \"chunked\" encoding, first
-- call [method/@messageHeaders@/.set_encoding] to set 'GI.Soup.Enums.EncodingChunked' on
-- the response-headers. Then call [method/@messageBody@/.append] (or
-- [method/@messageBody@/.append_bytes])) to append each chunk as it becomes ready,
-- and [method/@serverMessage@/.unpause] to make sure it\'s running. (The server
-- will automatically pause the message if it is using chunked encoding but no
-- more chunks are available.) When you are done, call
-- [method/@messageBody@/.complete] to indicate that no more chunks are coming.
serverAddHandler ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> Maybe (T.Text)
    -- ^ /@path@/: the toplevel path for the handler
    -> Soup.Callbacks.ServerCallback
    -- ^ /@callback@/: callback to invoke for
    --   requests under /@path@/
    -> m ()
serverAddHandler :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> Maybe Text -> ServerCallback -> m ()
serverAddHandler a
server Maybe Text
path ServerCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr CChar
maybePath <- case Maybe Text
path of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPath -> do
            Ptr CChar
jPath' <- Text -> IO (Ptr CChar)
textToCString Text
jPath
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPath'
    FunPtr C_ServerCallback
callback' <- C_ServerCallback -> IO (FunPtr C_ServerCallback)
Soup.Callbacks.mk_ServerCallback (Maybe (Ptr (FunPtr C_ServerCallback))
-> ServerCallback_WithClosures -> C_ServerCallback
Soup.Callbacks.wrap_ServerCallback Maybe (Ptr (FunPtr C_ServerCallback))
forall a. Maybe a
Nothing (ServerCallback -> ServerCallback_WithClosures
Soup.Callbacks.drop_closures_ServerCallback ServerCallback
callback))
    let userData :: Ptr ()
userData = FunPtr C_ServerCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ServerCallback
callback'
    let destroy :: FunPtr (Ptr a -> IO ())
destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Server
-> Ptr CChar
-> FunPtr C_ServerCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
soup_server_add_handler Ptr Server
server' Ptr CChar
maybePath FunPtr C_ServerCallback
callback' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePath
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerAddHandlerMethodInfo
instance (signature ~ (Maybe (T.Text) -> Soup.Callbacks.ServerCallback -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerAddHandlerMethodInfo a signature where
    overloadedMethod = serverAddHandler

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


#endif

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

foreign import ccall "soup_server_add_websocket_extension" soup_server_add_websocket_extension :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    CGType ->                               -- extension_type : TBasicType TGType
    IO ()

-- | Add support for a WebSocket extension of the given /@extensionType@/.
-- 
-- When a WebSocket client requests an extension of /@extensionType@/,
-- a new [class/@websocketExtension@/] of type /@extensionType@/ will be created
-- to handle the request.
-- 
-- Note that [class/@websocketExtensionDeflate@/] is supported by default, use
-- [method/@server@/.remove_websocket_extension] if you want to disable it.
serverAddWebsocketExtension ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> GType
    -- ^ /@extensionType@/: a t'GType'
    -> m ()
serverAddWebsocketExtension :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> GType -> m ()
serverAddWebsocketExtension a
server GType
extensionType = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    let extensionType' :: CGType
extensionType' = GType -> CGType
gtypeToCGType GType
extensionType
    Ptr Server -> CGType -> IO ()
soup_server_add_websocket_extension Ptr Server
server' CGType
extensionType'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerAddWebsocketExtensionMethodInfo
instance (signature ~ (GType -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerAddWebsocketExtensionMethodInfo a signature where
    overloadedMethod = serverAddWebsocketExtension

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


#endif

-- method Server::add_websocket_handler
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the toplevel path for the handler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "origin"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the origin of the connection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocols"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the protocols\n  supported by this handler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "ServerWebsocketCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "callback to invoke for\n  successful WebSocket requests under @path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 5
--           , argDestroy = 6
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data for @callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier to free @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_server_add_websocket_handler" soup_server_add_websocket_handler :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    CString ->                              -- path : TBasicType TUTF8
    CString ->                              -- origin : TBasicType TUTF8
    Ptr CString ->                          -- protocols : TCArray True (-1) (-1) (TBasicType TUTF8)
    FunPtr Soup.Callbacks.C_ServerWebsocketCallback -> -- callback : TInterface (Name {namespace = "Soup", name = "ServerWebsocketCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Adds a WebSocket handler to /@server@/ for requests prefixed by /@path@/.
-- 
-- If /@path@/ is 'P.Nothing' or \"\/\", then this will be the default handler for all
-- requests that don\'t have a more specific handler.
-- 
-- When a path has a WebSocket handler registered, /@server@/ will check
-- incoming requests for WebSocket handshakes after all other handlers
-- have run (unless some earlier handler has already set a status code
-- on the message), and update the request\'s status, response headers,
-- and response body accordingly.
-- 
-- If /@origin@/ is non-'P.Nothing', then only requests containing a matching
-- \"Origin\" header will be accepted. If /@protocols@/ is non-'P.Nothing', then
-- only requests containing a compatible \"Sec-WebSocket-Protocols\"
-- header will be accepted. More complicated requirements can be
-- handled by adding a normal handler to /@path@/, and having it perform
-- whatever checks are needed and
-- setting a failure status code if the handshake should be rejected.
serverAddWebsocketHandler ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> Maybe (T.Text)
    -- ^ /@path@/: the toplevel path for the handler
    -> Maybe (T.Text)
    -- ^ /@origin@/: the origin of the connection
    -> Maybe ([T.Text])
    -- ^ /@protocols@/: the protocols
    --   supported by this handler
    -> Soup.Callbacks.ServerWebsocketCallback
    -- ^ /@callback@/: callback to invoke for
    --   successful WebSocket requests under /@path@/
    -> m ()
serverAddWebsocketHandler :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> ServerWebsocketCallback
-> m ()
serverAddWebsocketHandler a
server Maybe Text
path Maybe Text
origin Maybe [Text]
protocols ServerWebsocketCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr CChar
maybePath <- case Maybe Text
path of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPath -> do
            Ptr CChar
jPath' <- Text -> IO (Ptr CChar)
textToCString Text
jPath
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPath'
    Ptr CChar
maybeOrigin <- case Maybe Text
origin of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jOrigin -> do
            Ptr CChar
jOrigin' <- Text -> IO (Ptr CChar)
textToCString Text
jOrigin
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jOrigin'
    Ptr (Ptr CChar)
maybeProtocols <- case Maybe [Text]
protocols of
        Maybe [Text]
Nothing -> Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
forall a. Ptr a
nullPtr
        Just [Text]
jProtocols -> do
            Ptr (Ptr CChar)
jProtocols' <- [Text] -> IO (Ptr (Ptr CChar))
packZeroTerminatedUTF8CArray [Text]
jProtocols
            Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
jProtocols'
    FunPtr C_ServerWebsocketCallback
callback' <- C_ServerWebsocketCallback -> IO (FunPtr C_ServerWebsocketCallback)
Soup.Callbacks.mk_ServerWebsocketCallback (Maybe (Ptr (FunPtr C_ServerWebsocketCallback))
-> ServerWebsocketCallback_WithClosures
-> C_ServerWebsocketCallback
Soup.Callbacks.wrap_ServerWebsocketCallback Maybe (Ptr (FunPtr C_ServerWebsocketCallback))
forall a. Maybe a
Nothing (ServerWebsocketCallback -> ServerWebsocketCallback_WithClosures
Soup.Callbacks.drop_closures_ServerWebsocketCallback ServerWebsocketCallback
callback))
    let userData :: Ptr ()
userData = FunPtr C_ServerWebsocketCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ServerWebsocketCallback
callback'
    let destroy :: FunPtr (Ptr a -> IO ())
destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Server
-> Ptr CChar
-> Ptr CChar
-> Ptr (Ptr CChar)
-> FunPtr C_ServerWebsocketCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
soup_server_add_websocket_handler Ptr Server
server' Ptr CChar
maybePath Ptr CChar
maybeOrigin Ptr (Ptr CChar)
maybeProtocols FunPtr C_ServerWebsocketCallback
callback' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePath
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeOrigin
    (Ptr CChar -> IO ()) -> Ptr (Ptr CChar) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
maybeProtocols
    Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
maybeProtocols
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerAddWebsocketHandlerMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> Maybe ([T.Text]) -> Soup.Callbacks.ServerWebsocketCallback -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerAddWebsocketHandlerMethodInfo a signature where
    overloadedMethod = serverAddWebsocketHandler

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


#endif

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

foreign import ccall "soup_server_disconnect" soup_server_disconnect :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    IO ()

-- | Closes and frees /@server@/\'s listening sockets.
-- 
-- Note that if there are currently requests in progress on /@server@/, that they
-- will continue to be processed if /@server@/\'s [struct/@gLib@/.MainContext] is still
-- running.
-- 
-- You can call [method/@server@/.listen], etc, after calling this function
-- if you want to start listening again.
serverDisconnect ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> m ()
serverDisconnect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> m ()
serverDisconnect a
server = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr Server -> IO ()
soup_server_disconnect Ptr Server
server'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerDisconnectMethodInfo
instance (signature ~ (m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerDisconnectMethodInfo a signature where
    overloadedMethod = serverDisconnect

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


#endif

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

foreign import ccall "soup_server_get_listeners" soup_server_get_listeners :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    IO (Ptr (GSList (Ptr Gio.Socket.Socket)))

-- | Gets /@server@/\'s list of listening sockets.
-- 
-- You should treat these sockets as read-only; writing to or
-- modifiying any of these sockets may cause /@server@/ to malfunction.
serverGetListeners ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> m [Gio.Socket.Socket]
    -- ^ __Returns:__ a
    --   list of listening sockets.
serverGetListeners :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> m [Socket]
serverGetListeners a
server = IO [Socket] -> m [Socket]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Socket] -> m [Socket]) -> IO [Socket] -> m [Socket]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr (GSList (Ptr Socket))
result <- Ptr Server -> IO (Ptr (GSList (Ptr Socket)))
soup_server_get_listeners Ptr Server
server'
    [Ptr Socket]
result' <- Ptr (GSList (Ptr Socket)) -> IO [Ptr Socket]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr Socket))
result
    [Socket]
result'' <- (Ptr Socket -> IO Socket) -> [Ptr Socket] -> IO [Socket]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Socket -> Socket) -> Ptr Socket -> IO Socket
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Socket -> Socket
Gio.Socket.Socket) [Ptr Socket]
result'
    Ptr (GSList (Ptr Socket)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr Socket))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    [Socket] -> IO [Socket]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Socket]
result''

#if defined(ENABLE_OVERLOADING)
data ServerGetListenersMethodInfo
instance (signature ~ (m [Gio.Socket.Socket]), MonadIO m, IsServer a) => O.OverloadedMethod ServerGetListenersMethodInfo a signature where
    overloadedMethod = serverGetListeners

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


#endif

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

foreign import ccall "soup_server_get_tls_auth_mode" soup_server_get_tls_auth_mode :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    IO CUInt

-- | Gets the /@server@/ SSL\/TLS client authentication mode.
serverGetTlsAuthMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> m Gio.Enums.TlsAuthenticationMode
    -- ^ __Returns:__ a t'GI.Gio.Enums.TlsAuthenticationMode'
serverGetTlsAuthMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> m TlsAuthenticationMode
serverGetTlsAuthMode a
server = IO TlsAuthenticationMode -> m TlsAuthenticationMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TlsAuthenticationMode -> m TlsAuthenticationMode)
-> IO TlsAuthenticationMode -> m TlsAuthenticationMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    CUInt
result <- Ptr Server -> IO CUInt
soup_server_get_tls_auth_mode Ptr Server
server'
    let result' :: TlsAuthenticationMode
result' = (Int -> TlsAuthenticationMode
forall a. Enum a => Int -> a
toEnum (Int -> TlsAuthenticationMode)
-> (CUInt -> Int) -> CUInt -> TlsAuthenticationMode
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
server
    TlsAuthenticationMode -> IO TlsAuthenticationMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TlsAuthenticationMode
result'

#if defined(ENABLE_OVERLOADING)
data ServerGetTlsAuthModeMethodInfo
instance (signature ~ (m Gio.Enums.TlsAuthenticationMode), MonadIO m, IsServer a) => O.OverloadedMethod ServerGetTlsAuthModeMethodInfo a signature where
    overloadedMethod = serverGetTlsAuthMode

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


#endif

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

foreign import ccall "soup_server_get_tls_certificate" soup_server_get_tls_certificate :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    IO (Ptr Gio.TlsCertificate.TlsCertificate)

-- | Gets the /@server@/ SSL\/TLS certificate.
serverGetTlsCertificate ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> m (Maybe Gio.TlsCertificate.TlsCertificate)
    -- ^ __Returns:__ a t'GI.Gio.Objects.TlsCertificate.TlsCertificate' or 'P.Nothing'
serverGetTlsCertificate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> m (Maybe TlsCertificate)
serverGetTlsCertificate a
server = IO (Maybe TlsCertificate) -> m (Maybe TlsCertificate)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TlsCertificate) -> m (Maybe TlsCertificate))
-> IO (Maybe TlsCertificate) -> m (Maybe TlsCertificate)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr TlsCertificate
result <- Ptr Server -> IO (Ptr TlsCertificate)
soup_server_get_tls_certificate Ptr Server
server'
    Maybe TlsCertificate
maybeResult <- Ptr TlsCertificate
-> (Ptr TlsCertificate -> IO TlsCertificate)
-> IO (Maybe TlsCertificate)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TlsCertificate
result ((Ptr TlsCertificate -> IO TlsCertificate)
 -> IO (Maybe TlsCertificate))
-> (Ptr TlsCertificate -> IO TlsCertificate)
-> IO (Maybe TlsCertificate)
forall a b. (a -> b) -> a -> b
$ \Ptr TlsCertificate
result' -> do
        TlsCertificate
result'' <- ((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
result'
        TlsCertificate -> IO TlsCertificate
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TlsCertificate
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    Maybe TlsCertificate -> IO (Maybe TlsCertificate)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TlsCertificate
maybeResult

#if defined(ENABLE_OVERLOADING)
data ServerGetTlsCertificateMethodInfo
instance (signature ~ (m (Maybe Gio.TlsCertificate.TlsCertificate)), MonadIO m, IsServer a) => O.OverloadedMethod ServerGetTlsCertificateMethodInfo a signature where
    overloadedMethod = serverGetTlsCertificate

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


#endif

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

foreign import ccall "soup_server_get_tls_database" soup_server_get_tls_database :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    IO (Ptr Gio.TlsDatabase.TlsDatabase)

-- | Gets the /@server@/ SSL\/TLS database.
serverGetTlsDatabase ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> m (Maybe Gio.TlsDatabase.TlsDatabase)
    -- ^ __Returns:__ a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
serverGetTlsDatabase :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> m (Maybe TlsDatabase)
serverGetTlsDatabase a
server = IO (Maybe TlsDatabase) -> m (Maybe TlsDatabase)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TlsDatabase) -> m (Maybe TlsDatabase))
-> IO (Maybe TlsDatabase) -> m (Maybe TlsDatabase)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr TlsDatabase
result <- Ptr Server -> IO (Ptr TlsDatabase)
soup_server_get_tls_database Ptr Server
server'
    Maybe TlsDatabase
maybeResult <- Ptr TlsDatabase
-> (Ptr TlsDatabase -> IO TlsDatabase) -> IO (Maybe TlsDatabase)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TlsDatabase
result ((Ptr TlsDatabase -> IO TlsDatabase) -> IO (Maybe TlsDatabase))
-> (Ptr TlsDatabase -> IO TlsDatabase) -> IO (Maybe TlsDatabase)
forall a b. (a -> b) -> a -> b
$ \Ptr TlsDatabase
result' -> do
        TlsDatabase
result'' <- ((ManagedPtr TlsDatabase -> TlsDatabase)
-> Ptr TlsDatabase -> IO TlsDatabase
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TlsDatabase -> TlsDatabase
Gio.TlsDatabase.TlsDatabase) Ptr TlsDatabase
result'
        TlsDatabase -> IO TlsDatabase
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TlsDatabase
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    Maybe TlsDatabase -> IO (Maybe TlsDatabase)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TlsDatabase
maybeResult

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

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


#endif

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

foreign import ccall "soup_server_get_uris" soup_server_get_uris :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    IO (Ptr (GSList (Ptr GLib.Uri.Uri)))

-- | Gets a list of URIs corresponding to the interfaces /@server@/ is
-- listening on.
-- 
-- These will contain IP addresses, not hostnames, and will also indicate
-- whether the given listener is http or https.
-- 
-- Note that if you used [method/@server@/.listen_all] the returned URIs will use
-- the addresses @0.0.0.0@ and @::@, rather than actually returning separate
-- URIs for each interface on the system.
serverGetUris ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> m [GLib.Uri.Uri]
    -- ^ __Returns:__ a list of @/GUris/@, which you
    --   must free when you are done with it.
serverGetUris :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> m [Uri]
serverGetUris a
server = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr (GSList (Ptr Uri))
result <- Ptr Server -> IO (Ptr (GSList (Ptr Uri)))
soup_server_get_uris Ptr Server
server'
    [Ptr Uri]
result' <- Ptr (GSList (Ptr Uri)) -> IO [Ptr Uri]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr Uri))
result
    [Uri]
result'' <- (Ptr Uri -> IO Uri) -> [Ptr Uri] -> IO [Uri]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Uri -> Uri) -> Ptr Uri -> IO Uri
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Uri -> Uri
GLib.Uri.Uri) [Ptr Uri]
result'
    Ptr (GSList (Ptr Uri)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr Uri))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    [Uri] -> IO [Uri]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Uri]
result''

#if defined(ENABLE_OVERLOADING)
data ServerGetUrisMethodInfo
instance (signature ~ (m [GLib.Uri.Uri]), MonadIO m, IsServer a) => O.OverloadedMethod ServerGetUrisMethodInfo a signature where
    overloadedMethod = serverGetUris

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


#endif

-- method Server::is_https
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , 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_server_is_https" soup_server_is_https :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    IO CInt

-- | Checks whether /@server@/ is capable of https.
-- 
-- In order for a server to run https, you must call
-- [method/@server@/.set_tls_certificate], or set the
-- [property/@server@/:tls-certificate] property, to provide it with a
-- certificate to use.
-- 
-- If you are using the deprecated single-listener APIs, then a return value of
-- 'P.True' indicates that the t'GI.Soup.Objects.Server.Server' serves https exclusively. If you are
-- using [method/@server@/.listen], etc, then a 'P.True' return value merely indicates
-- that the server is *able* to do https, regardless of whether it actually
-- currently is or not. Use [method/@server@/.get_uris] to see if it currently has
-- any https listeners.
serverIsHttps ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@server@/ is configured to serve https.
serverIsHttps :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> m Bool
serverIsHttps a
server = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    CInt
result <- Ptr Server -> IO CInt
soup_server_is_https Ptr Server
server'
    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
server
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ServerIsHttpsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsServer a) => O.OverloadedMethod ServerIsHttpsMethodInfo a signature where
    overloadedMethod = serverIsHttps

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


#endif

-- method Server::listen
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the address of the interface to listen on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "ServerListenOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "listening options for this server"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "soup_server_listen" soup_server_listen :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    Ptr Gio.SocketAddress.SocketAddress ->  -- address : TInterface (Name {namespace = "Gio", name = "SocketAddress"})
    CUInt ->                                -- options : TInterface (Name {namespace = "Soup", name = "ServerListenOptions"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Attempts to set up /@server@/ to listen for connections on /@address@/.
-- 
-- If /@options@/ includes 'GI.Soup.Flags.ServerListenOptionsHttps', and /@server@/ has
-- been configured for TLS, then /@server@/ will listen for https
-- connections on this port. Otherwise it will listen for plain http.
-- 
-- You may call this method (along with the other \"listen\" methods)
-- any number of times on a server, if you want to listen on multiple
-- ports, or set up both http and https service.
-- 
-- After calling this method, /@server@/ will begin accepting and processing
-- connections as soon as the appropriate [struct/@gLib@/.MainContext] is run.
-- 
-- Note that this API does not make use of dual IPv4\/IPv6 sockets; if
-- /@address@/ is an IPv6 address, it will only accept IPv6 connections.
-- You must configure IPv4 listening separately.
serverListen ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a, Gio.SocketAddress.IsSocketAddress b) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@address@/: the address of the interface to listen on
    -> [Soup.Flags.ServerListenOptions]
    -- ^ /@options@/: listening options for this server
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serverListen :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsServer a, IsSocketAddress b) =>
a -> b -> [ServerListenOptions] -> m ()
serverListen a
server b
address [ServerListenOptions]
options = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr SocketAddress
address' <- b -> IO (Ptr SocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
address
    let options' :: CUInt
options' = [ServerListenOptions] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ServerListenOptions]
options
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Server
-> Ptr SocketAddress -> CUInt -> Ptr (Ptr GError) -> IO CInt
soup_server_listen Ptr Server
server' Ptr SocketAddress
address' CUInt
options'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
address
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServerListenMethodInfo
instance (signature ~ (b -> [Soup.Flags.ServerListenOptions] -> m ()), MonadIO m, IsServer a, Gio.SocketAddress.IsSocketAddress b) => O.OverloadedMethod ServerListenMethodInfo a signature where
    overloadedMethod = serverListen

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


#endif

-- method Server::listen_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "port"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the port to listen on, or 0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "ServerListenOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "listening options for this server"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "soup_server_listen_all" soup_server_listen_all :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    Word32 ->                               -- port : TBasicType TUInt
    CUInt ->                                -- options : TInterface (Name {namespace = "Soup", name = "ServerListenOptions"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Attempts to set up /@server@/ to listen for connections on all interfaces
-- on the system.
-- 
-- That is, it listens on the addresses @0.0.0.0@ and\/or @::@, depending on
-- whether /@options@/ includes 'GI.Soup.Flags.ServerListenOptionsIpv4Only',
-- 'GI.Soup.Flags.ServerListenOptionsIpv6Only', or neither.) If /@port@/ is specified, /@server@/
-- will listen on that port. If it is 0, /@server@/ will find an unused port to
-- listen on. (In that case, you can use [method/@server@/.get_uris] to find out
-- what port it ended up choosing.
-- 
-- See [method/@server@/.listen] for more details.
serverListenAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> Word32
    -- ^ /@port@/: the port to listen on, or 0
    -> [Soup.Flags.ServerListenOptions]
    -- ^ /@options@/: listening options for this server
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serverListenAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> Word32 -> [ServerListenOptions] -> m ()
serverListenAll a
server Word32
port [ServerListenOptions]
options = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    let options' :: CUInt
options' = [ServerListenOptions] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ServerListenOptions]
options
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Server -> Word32 -> CUInt -> Ptr (Ptr GError) -> IO CInt
soup_server_listen_all Ptr Server
server' Word32
port CUInt
options'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServerListenAllMethodInfo
instance (signature ~ (Word32 -> [Soup.Flags.ServerListenOptions] -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerListenAllMethodInfo a signature where
    overloadedMethod = serverListenAll

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


#endif

-- method Server::listen_local
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "port"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the port to listen on, or 0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "ServerListenOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "listening options for this server"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "soup_server_listen_local" soup_server_listen_local :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    Word32 ->                               -- port : TBasicType TUInt
    CUInt ->                                -- options : TInterface (Name {namespace = "Soup", name = "ServerListenOptions"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Attempts to set up /@server@/ to listen for connections on \"localhost\".
-- 
-- That is, @127.0.0.1@ and\/or @::1@, depending on whether /@options@/ includes
-- 'GI.Soup.Flags.ServerListenOptionsIpv4Only', 'GI.Soup.Flags.ServerListenOptionsIpv6Only', or neither). If
-- /@port@/ is specified, /@server@/ will listen on that port. If it is 0, /@server@/
-- will find an unused port to listen on. (In that case, you can use
-- [method/@server@/.get_uris] to find out what port it ended up choosing.
-- 
-- See [method/@server@/.listen] for more details.
serverListenLocal ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> Word32
    -- ^ /@port@/: the port to listen on, or 0
    -> [Soup.Flags.ServerListenOptions]
    -- ^ /@options@/: listening options for this server
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serverListenLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> Word32 -> [ServerListenOptions] -> m ()
serverListenLocal a
server Word32
port [ServerListenOptions]
options = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    let options' :: CUInt
options' = [ServerListenOptions] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ServerListenOptions]
options
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Server -> Word32 -> CUInt -> Ptr (Ptr GError) -> IO CInt
soup_server_listen_local Ptr Server
server' Word32
port CUInt
options'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServerListenLocalMethodInfo
instance (signature ~ (Word32 -> [Soup.Flags.ServerListenOptions] -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerListenLocalMethodInfo a signature where
    overloadedMethod = serverListenLocal

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


#endif

-- method Server::listen_socket
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "socket"
--           , argType = TInterface Name { namespace = "Gio" , name = "Socket" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a listening #GSocket"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "ServerListenOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "listening options for this server"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "soup_server_listen_socket" soup_server_listen_socket :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    Ptr Gio.Socket.Socket ->                -- socket : TInterface (Name {namespace = "Gio", name = "Socket"})
    CUInt ->                                -- options : TInterface (Name {namespace = "Soup", name = "ServerListenOptions"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Attempts to set up /@server@/ to listen for connections on /@socket@/.
-- 
-- See [method/@server@/.listen] for more details.
serverListenSocket ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a, Gio.Socket.IsSocket b) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@socket@/: a listening t'GI.Gio.Objects.Socket.Socket'
    -> [Soup.Flags.ServerListenOptions]
    -- ^ /@options@/: listening options for this server
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
serverListenSocket :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsServer a, IsSocket b) =>
a -> b -> [ServerListenOptions] -> m ()
serverListenSocket a
server b
socket [ServerListenOptions]
options = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr Socket
socket' <- b -> IO (Ptr Socket)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
socket
    let options' :: CUInt
options' = [ServerListenOptions] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ServerListenOptions]
options
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Server -> Ptr Socket -> CUInt -> Ptr (Ptr GError) -> IO CInt
soup_server_listen_socket Ptr Server
server' Ptr Socket
socket' CUInt
options'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
socket
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ServerListenSocketMethodInfo
instance (signature ~ (b -> [Soup.Flags.ServerListenOptions] -> m ()), MonadIO m, IsServer a, Gio.Socket.IsSocket b) => O.OverloadedMethod ServerListenSocketMethodInfo a signature where
    overloadedMethod = serverListenSocket

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


#endif

-- method Server::pause_message
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ServerMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServerMessage associated with @server."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_server_pause_message" soup_server_pause_message :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    Ptr Soup.ServerMessage.ServerMessage -> -- msg : TInterface (Name {namespace = "Soup", name = "ServerMessage"})
    IO ()

{-# DEPRECATED serverPauseMessage ["(Since version 3.2)","Use 'GI.Soup.Objects.ServerMessage.serverMessagePause' instead."] #-}
-- | Pauses I\/O on /@msg@/.
-- 
-- This can be used when you need to return from the server handler without
-- having the full response ready yet. Use [method/@server@/.unpause_message] to
-- resume I\/O.
-- 
-- This must only be called on a [class/@serverMessage@/] which was created by the
-- t'GI.Soup.Objects.Server.Server' and are currently doing I\/O, such as those passed into a
-- [callback/@serverCallback@/] or emitted in a [signal/@server@/[requestRead](#g:signal:requestRead)]
-- signal.
serverPauseMessage ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a, Soup.ServerMessage.IsServerMessage b) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.ServerMessage.ServerMessage' associated with /@server@/.
    -> m ()
serverPauseMessage :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsServer a, IsServerMessage b) =>
a -> b -> m ()
serverPauseMessage a
server b
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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr ServerMessage
msg' <- b -> IO (Ptr ServerMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    Ptr Server -> Ptr ServerMessage -> IO ()
soup_server_pause_message Ptr Server
server' Ptr ServerMessage
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerPauseMessageMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsServer a, Soup.ServerMessage.IsServerMessage b) => O.OverloadedMethod ServerPauseMessageMethodInfo a signature where
    overloadedMethod = serverPauseMessage

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


#endif

-- method Server::remove_auth_domain
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "auth_domain"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "AuthDomain" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuthDomain" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_server_remove_auth_domain" soup_server_remove_auth_domain :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    Ptr Soup.AuthDomain.AuthDomain ->       -- auth_domain : TInterface (Name {namespace = "Soup", name = "AuthDomain"})
    IO ()

-- | Removes /@authDomain@/ from /@server@/.
serverRemoveAuthDomain ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a, Soup.AuthDomain.IsAuthDomain b) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@authDomain@/: a t'GI.Soup.Objects.AuthDomain.AuthDomain'
    -> m ()
serverRemoveAuthDomain :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsServer a, IsAuthDomain b) =>
a -> b -> m ()
serverRemoveAuthDomain a
server b
authDomain = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr AuthDomain
authDomain' <- b -> IO (Ptr AuthDomain)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
authDomain
    Ptr Server -> Ptr AuthDomain -> IO ()
soup_server_remove_auth_domain Ptr Server
server' Ptr AuthDomain
authDomain'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
authDomain
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerRemoveAuthDomainMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsServer a, Soup.AuthDomain.IsAuthDomain b) => O.OverloadedMethod ServerRemoveAuthDomainMethodInfo a signature where
    overloadedMethod = serverRemoveAuthDomain

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


#endif

-- method Server::remove_handler
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the toplevel path for the handler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_server_remove_handler" soup_server_remove_handler :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    CString ->                              -- path : TBasicType TUTF8
    IO ()

-- | Removes all handlers (early and normal) registered at /@path@/.
serverRemoveHandler ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> T.Text
    -- ^ /@path@/: the toplevel path for the handler
    -> m ()
serverRemoveHandler :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> Text -> m ()
serverRemoveHandler a
server Text
path = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr CChar
path' <- Text -> IO (Ptr CChar)
textToCString Text
path
    Ptr Server -> Ptr CChar -> IO ()
soup_server_remove_handler Ptr Server
server' Ptr CChar
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
path'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

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

foreign import ccall "soup_server_remove_websocket_extension" soup_server_remove_websocket_extension :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    CGType ->                               -- extension_type : TBasicType TGType
    IO ()

-- | Removes support for WebSocket extension of type /@extensionType@/ (or any subclass of
-- /@extensionType@/) from /@server@/.
serverRemoveWebsocketExtension ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> GType
    -- ^ /@extensionType@/: a t'GType'
    -> m ()
serverRemoveWebsocketExtension :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> GType -> m ()
serverRemoveWebsocketExtension a
server GType
extensionType = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    let extensionType' :: CGType
extensionType' = GType -> CGType
gtypeToCGType GType
extensionType
    Ptr Server -> CGType -> IO ()
soup_server_remove_websocket_extension Ptr Server
server' CGType
extensionType'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerRemoveWebsocketExtensionMethodInfo
instance (signature ~ (GType -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerRemoveWebsocketExtensionMethodInfo a signature where
    overloadedMethod = serverRemoveWebsocketExtension

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


#endif

-- method Server::set_tls_auth_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsAuthenticationMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsAuthenticationMode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_server_set_tls_auth_mode" soup_server_set_tls_auth_mode :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gio", name = "TlsAuthenticationMode"})
    IO ()

-- | Sets /@server@/\'s t'GI.Gio.Enums.TlsAuthenticationMode' to use for SSL\/TLS client authentication.
serverSetTlsAuthMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> Gio.Enums.TlsAuthenticationMode
    -- ^ /@mode@/: a t'GI.Gio.Enums.TlsAuthenticationMode'
    -> m ()
serverSetTlsAuthMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> TlsAuthenticationMode -> m ()
serverSetTlsAuthMode a
server TlsAuthenticationMode
mode = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TlsAuthenticationMode -> Int) -> TlsAuthenticationMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TlsAuthenticationMode -> Int
forall a. Enum a => a -> Int
fromEnum) TlsAuthenticationMode
mode
    Ptr Server -> CUInt -> IO ()
soup_server_set_tls_auth_mode Ptr Server
server' CUInt
mode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerSetTlsAuthModeMethodInfo
instance (signature ~ (Gio.Enums.TlsAuthenticationMode -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerSetTlsAuthModeMethodInfo a signature where
    overloadedMethod = serverSetTlsAuthMode

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


#endif

-- method Server::set_tls_certificate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "certificate"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsCertificate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_server_set_tls_certificate" soup_server_set_tls_certificate :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    Ptr Gio.TlsCertificate.TlsCertificate -> -- certificate : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    IO ()

-- | Sets /@server@/ up to do https, using the given SSL\/TLS /@certificate@/.
serverSetTlsCertificate ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a, Gio.TlsCertificate.IsTlsCertificate b) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@certificate@/: a t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
    -> m ()
serverSetTlsCertificate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsServer a, IsTlsCertificate b) =>
a -> b -> m ()
serverSetTlsCertificate a
server b
certificate = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr TlsCertificate
certificate' <- b -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
certificate
    Ptr Server -> Ptr TlsCertificate -> IO ()
soup_server_set_tls_certificate Ptr Server
server' Ptr TlsCertificate
certificate'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
certificate
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerSetTlsCertificateMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsServer a, Gio.TlsCertificate.IsTlsCertificate b) => O.OverloadedMethod ServerSetTlsCertificateMethodInfo a signature where
    overloadedMethod = serverSetTlsCertificate

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


#endif

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

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

-- | Sets /@server@/\'s t'GI.Gio.Objects.TlsDatabase.TlsDatabase' to use for validating SSL\/TLS client certificates.
serverSetTlsDatabase ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a, Gio.TlsDatabase.IsTlsDatabase b) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@tlsDatabase@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> m ()
serverSetTlsDatabase :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsServer a, IsTlsDatabase b) =>
a -> b -> m ()
serverSetTlsDatabase a
server b
tlsDatabase = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr TlsDatabase
tlsDatabase' <- b -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
tlsDatabase
    Ptr Server -> Ptr TlsDatabase -> IO ()
soup_server_set_tls_database Ptr Server
server' Ptr TlsDatabase
tlsDatabase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
tlsDatabase
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerSetTlsDatabaseMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsServer a, Gio.TlsDatabase.IsTlsDatabase b) => O.OverloadedMethod ServerSetTlsDatabaseMethodInfo a signature where
    overloadedMethod = serverSetTlsDatabase

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


#endif

-- method Server::unpause_message
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ServerMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServerMessage associated with @server."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_server_unpause_message" soup_server_unpause_message :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Soup", name = "Server"})
    Ptr Soup.ServerMessage.ServerMessage -> -- msg : TInterface (Name {namespace = "Soup", name = "ServerMessage"})
    IO ()

{-# DEPRECATED serverUnpauseMessage ["(Since version 3.2)","Use 'GI.Soup.Objects.ServerMessage.serverMessageUnpause' instead."] #-}
-- | Resumes I\/O on /@msg@/.
-- 
-- Use this to resume after calling [method/@server@/.pause_message], or after
-- adding a new chunk to a chunked response.
-- 
-- I\/O won\'t actually resume until you return to the main loop.
-- 
-- This must only be called on a [class/@serverMessage@/] which was created by the
-- t'GI.Soup.Objects.Server.Server' and are currently doing I\/O, such as those passed into a
-- [callback/@serverCallback@/] or emitted in a [signal/@server@/[requestRead](#g:signal:requestRead)]
-- signal.
serverUnpauseMessage ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a, Soup.ServerMessage.IsServerMessage b) =>
    a
    -- ^ /@server@/: a t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.ServerMessage.ServerMessage' associated with /@server@/.
    -> m ()
serverUnpauseMessage :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsServer a, IsServerMessage b) =>
a -> b -> m ()
serverUnpauseMessage a
server b
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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr ServerMessage
msg' <- b -> IO (Ptr ServerMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    Ptr Server -> Ptr ServerMessage -> IO ()
soup_server_unpause_message Ptr Server
server' Ptr ServerMessage
msg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerUnpauseMessageMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsServer a, Soup.ServerMessage.IsServerMessage b) => O.OverloadedMethod ServerUnpauseMessageMethodInfo a signature where
    overloadedMethod = serverUnpauseMessage

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


#endif