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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A class representing a WebSocket connection.
-- 
-- /Since: 2.50/

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

module GI.Soup.Objects.WebsocketConnection
    ( 

-- * Exported types
    WebsocketConnection(..)                 ,
    IsWebsocketConnection                   ,
    toWebsocketConnection                   ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [close]("GI.Soup.Objects.WebsocketConnection#g:method:close"), [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"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sendBinary]("GI.Soup.Objects.WebsocketConnection#g:method:sendBinary"), [sendMessage]("GI.Soup.Objects.WebsocketConnection#g:method:sendMessage"), [sendText]("GI.Soup.Objects.WebsocketConnection#g:method:sendText"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCloseCode]("GI.Soup.Objects.WebsocketConnection#g:method:getCloseCode"), [getCloseData]("GI.Soup.Objects.WebsocketConnection#g:method:getCloseData"), [getConnectionType]("GI.Soup.Objects.WebsocketConnection#g:method:getConnectionType"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getExtensions]("GI.Soup.Objects.WebsocketConnection#g:method:getExtensions"), [getIoStream]("GI.Soup.Objects.WebsocketConnection#g:method:getIoStream"), [getKeepaliveInterval]("GI.Soup.Objects.WebsocketConnection#g:method:getKeepaliveInterval"), [getMaxIncomingPayloadSize]("GI.Soup.Objects.WebsocketConnection#g:method:getMaxIncomingPayloadSize"), [getOrigin]("GI.Soup.Objects.WebsocketConnection#g:method:getOrigin"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getProtocol]("GI.Soup.Objects.WebsocketConnection#g:method:getProtocol"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getState]("GI.Soup.Objects.WebsocketConnection#g:method:getState"), [getUri]("GI.Soup.Objects.WebsocketConnection#g:method:getUri").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setKeepaliveInterval]("GI.Soup.Objects.WebsocketConnection#g:method:setKeepaliveInterval"), [setMaxIncomingPayloadSize]("GI.Soup.Objects.WebsocketConnection#g:method:setMaxIncomingPayloadSize"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveWebsocketConnectionMethod        ,
#endif

-- ** close #method:close#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionCloseMethodInfo      ,
#endif
    websocketConnectionClose                ,


-- ** getCloseCode #method:getCloseCode#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetCloseCodeMethodInfo,
#endif
    websocketConnectionGetCloseCode         ,


-- ** getCloseData #method:getCloseData#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetCloseDataMethodInfo,
#endif
    websocketConnectionGetCloseData         ,


-- ** getConnectionType #method:getConnectionType#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetConnectionTypeMethodInfo,
#endif
    websocketConnectionGetConnectionType    ,


-- ** getExtensions #method:getExtensions#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetExtensionsMethodInfo,
#endif
    websocketConnectionGetExtensions        ,


-- ** getIoStream #method:getIoStream#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetIoStreamMethodInfo,
#endif
    websocketConnectionGetIoStream          ,


-- ** getKeepaliveInterval #method:getKeepaliveInterval#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetKeepaliveIntervalMethodInfo,
#endif
    websocketConnectionGetKeepaliveInterval ,


-- ** getMaxIncomingPayloadSize #method:getMaxIncomingPayloadSize#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetMaxIncomingPayloadSizeMethodInfo,
#endif
    websocketConnectionGetMaxIncomingPayloadSize,


-- ** getOrigin #method:getOrigin#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetOriginMethodInfo  ,
#endif
    websocketConnectionGetOrigin            ,


-- ** getProtocol #method:getProtocol#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetProtocolMethodInfo,
#endif
    websocketConnectionGetProtocol          ,


-- ** getState #method:getState#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetStateMethodInfo   ,
#endif
    websocketConnectionGetState             ,


-- ** getUri #method:getUri#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionGetUriMethodInfo     ,
#endif
    websocketConnectionGetUri               ,


-- ** new #method:new#

    websocketConnectionNew                  ,


-- ** newWithExtensions #method:newWithExtensions#

    websocketConnectionNewWithExtensions    ,


-- ** sendBinary #method:sendBinary#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionSendBinaryMethodInfo ,
#endif
    websocketConnectionSendBinary           ,


-- ** sendMessage #method:sendMessage#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionSendMessageMethodInfo,
#endif
    websocketConnectionSendMessage          ,


-- ** sendText #method:sendText#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionSendTextMethodInfo   ,
#endif
    websocketConnectionSendText             ,


-- ** setKeepaliveInterval #method:setKeepaliveInterval#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionSetKeepaliveIntervalMethodInfo,
#endif
    websocketConnectionSetKeepaliveInterval ,


-- ** setMaxIncomingPayloadSize #method:setMaxIncomingPayloadSize#

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionSetMaxIncomingPayloadSizeMethodInfo,
#endif
    websocketConnectionSetMaxIncomingPayloadSize,




 -- * Properties


-- ** connectionType #attr:connectionType#
-- | The type of connection (client\/server).
-- 
-- /Since: 2.50/

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionConnectionTypePropertyInfo,
#endif
    constructWebsocketConnectionConnectionType,
    getWebsocketConnectionConnectionType    ,
#if defined(ENABLE_OVERLOADING)
    websocketConnectionConnectionType       ,
#endif


-- ** extensions #attr:extensions#
-- | List of t'GI.Soup.Objects.WebsocketExtension.WebsocketExtension' objects that are active in the connection.
-- 
-- /Since: 2.68/

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionExtensionsPropertyInfo,
#endif
    constructWebsocketConnectionExtensions  ,
    getWebsocketConnectionExtensions        ,
#if defined(ENABLE_OVERLOADING)
    websocketConnectionExtensions           ,
#endif


-- ** ioStream #attr:ioStream#
-- | The underlying IO stream the WebSocket is communicating
-- over.
-- 
-- The input and output streams must be pollable streams.
-- 
-- /Since: 2.50/

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionIoStreamPropertyInfo ,
#endif
    constructWebsocketConnectionIoStream    ,
    getWebsocketConnectionIoStream          ,
#if defined(ENABLE_OVERLOADING)
    websocketConnectionIoStream             ,
#endif


-- ** keepaliveInterval #attr:keepaliveInterval#
-- | Interval in seconds on when to send a ping message which will
-- serve as a keepalive message. If set to 0 the keepalive message is
-- disabled.
-- 
-- /Since: 2.58/

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionKeepaliveIntervalPropertyInfo,
#endif
    constructWebsocketConnectionKeepaliveInterval,
    getWebsocketConnectionKeepaliveInterval ,
    setWebsocketConnectionKeepaliveInterval ,
#if defined(ENABLE_OVERLOADING)
    websocketConnectionKeepaliveInterval    ,
#endif


-- ** maxIncomingPayloadSize #attr:maxIncomingPayloadSize#
-- | The maximum payload size for incoming packets the protocol expects
-- or 0 to not limit it.
-- 
-- /Since: 2.56/

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionMaxIncomingPayloadSizePropertyInfo,
#endif
    constructWebsocketConnectionMaxIncomingPayloadSize,
    getWebsocketConnectionMaxIncomingPayloadSize,
    setWebsocketConnectionMaxIncomingPayloadSize,
#if defined(ENABLE_OVERLOADING)
    websocketConnectionMaxIncomingPayloadSize,
#endif


-- ** origin #attr:origin#
-- | The client\'s Origin.
-- 
-- /Since: 2.50/

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionOriginPropertyInfo   ,
#endif
    constructWebsocketConnectionOrigin      ,
    getWebsocketConnectionOrigin            ,
#if defined(ENABLE_OVERLOADING)
    websocketConnectionOrigin               ,
#endif


-- ** protocol #attr:protocol#
-- | The chosen protocol, or 'P.Nothing' if a protocol was not agreed
-- upon.
-- 
-- /Since: 2.50/

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionProtocolPropertyInfo ,
#endif
    constructWebsocketConnectionProtocol    ,
    getWebsocketConnectionProtocol          ,
#if defined(ENABLE_OVERLOADING)
    websocketConnectionProtocol             ,
#endif


-- ** state #attr:state#
-- | The current state of the WebSocket.
-- 
-- /Since: 2.50/

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionStatePropertyInfo    ,
#endif
    getWebsocketConnectionState             ,
#if defined(ENABLE_OVERLOADING)
    websocketConnectionState                ,
#endif


-- ** uri #attr:uri#
-- | The URI of the WebSocket.
-- 
-- For servers this represents the address of the WebSocket,
-- and for clients it is the address connected to.
-- 
-- /Since: 2.50/

#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionUriPropertyInfo      ,
#endif
    constructWebsocketConnectionUri         ,
    getWebsocketConnectionUri               ,
#if defined(ENABLE_OVERLOADING)
    websocketConnectionUri                  ,
#endif




 -- * Signals


-- ** closed #signal:closed#

    WebsocketConnectionClosedCallback       ,
#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionClosedSignalInfo     ,
#endif
    afterWebsocketConnectionClosed          ,
    onWebsocketConnectionClosed             ,


-- ** closing #signal:closing#

    WebsocketConnectionClosingCallback      ,
#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionClosingSignalInfo    ,
#endif
    afterWebsocketConnectionClosing         ,
    onWebsocketConnectionClosing            ,


-- ** error #signal:error#

    WebsocketConnectionErrorCallback        ,
#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionErrorSignalInfo      ,
#endif
    afterWebsocketConnectionError           ,
    onWebsocketConnectionError              ,


-- ** message #signal:message#

    WebsocketConnectionMessageCallback      ,
#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionMessageSignalInfo    ,
#endif
    afterWebsocketConnectionMessage         ,
    onWebsocketConnectionMessage            ,


-- ** pong #signal:pong#

    WebsocketConnectionPongCallback         ,
#if defined(ENABLE_OVERLOADING)
    WebsocketConnectionPongSignalInfo       ,
#endif
    afterWebsocketConnectionPong            ,
    onWebsocketConnectionPong               ,




    ) 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.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Objects.IOStream as Gio.IOStream
import {-# SOURCE #-} qualified GI.Soup.Enums as Soup.Enums
import {-# SOURCE #-} qualified GI.Soup.Objects.WebsocketExtension as Soup.WebsocketExtension
import {-# SOURCE #-} qualified GI.Soup.Structs.URI as Soup.URI

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

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

foreign import ccall "soup_websocket_connection_get_type"
    c_soup_websocket_connection_get_type :: IO B.Types.GType

instance B.Types.TypedObject WebsocketConnection where
    glibType :: IO GType
glibType = IO GType
c_soup_websocket_connection_get_type

instance B.Types.GObject WebsocketConnection

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveWebsocketConnectionMethod (t :: Symbol) (o :: *) :: * where
    ResolveWebsocketConnectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveWebsocketConnectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveWebsocketConnectionMethod "close" o = WebsocketConnectionCloseMethodInfo
    ResolveWebsocketConnectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveWebsocketConnectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveWebsocketConnectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveWebsocketConnectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveWebsocketConnectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveWebsocketConnectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveWebsocketConnectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveWebsocketConnectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveWebsocketConnectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveWebsocketConnectionMethod "sendBinary" o = WebsocketConnectionSendBinaryMethodInfo
    ResolveWebsocketConnectionMethod "sendMessage" o = WebsocketConnectionSendMessageMethodInfo
    ResolveWebsocketConnectionMethod "sendText" o = WebsocketConnectionSendTextMethodInfo
    ResolveWebsocketConnectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveWebsocketConnectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveWebsocketConnectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveWebsocketConnectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveWebsocketConnectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveWebsocketConnectionMethod "getCloseCode" o = WebsocketConnectionGetCloseCodeMethodInfo
    ResolveWebsocketConnectionMethod "getCloseData" o = WebsocketConnectionGetCloseDataMethodInfo
    ResolveWebsocketConnectionMethod "getConnectionType" o = WebsocketConnectionGetConnectionTypeMethodInfo
    ResolveWebsocketConnectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveWebsocketConnectionMethod "getExtensions" o = WebsocketConnectionGetExtensionsMethodInfo
    ResolveWebsocketConnectionMethod "getIoStream" o = WebsocketConnectionGetIoStreamMethodInfo
    ResolveWebsocketConnectionMethod "getKeepaliveInterval" o = WebsocketConnectionGetKeepaliveIntervalMethodInfo
    ResolveWebsocketConnectionMethod "getMaxIncomingPayloadSize" o = WebsocketConnectionGetMaxIncomingPayloadSizeMethodInfo
    ResolveWebsocketConnectionMethod "getOrigin" o = WebsocketConnectionGetOriginMethodInfo
    ResolveWebsocketConnectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveWebsocketConnectionMethod "getProtocol" o = WebsocketConnectionGetProtocolMethodInfo
    ResolveWebsocketConnectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveWebsocketConnectionMethod "getState" o = WebsocketConnectionGetStateMethodInfo
    ResolveWebsocketConnectionMethod "getUri" o = WebsocketConnectionGetUriMethodInfo
    ResolveWebsocketConnectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveWebsocketConnectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveWebsocketConnectionMethod "setKeepaliveInterval" o = WebsocketConnectionSetKeepaliveIntervalMethodInfo
    ResolveWebsocketConnectionMethod "setMaxIncomingPayloadSize" o = WebsocketConnectionSetMaxIncomingPayloadSizeMethodInfo
    ResolveWebsocketConnectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveWebsocketConnectionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal WebsocketConnection::closed
-- | Emitted when the connection has completely closed, either
-- due to an orderly close from the peer, one initiated via
-- 'GI.Soup.Objects.WebsocketConnection.websocketConnectionClose' or a fatal error
-- condition that caused a close.
-- 
-- This signal will be emitted once.
-- 
-- /Since: 2.50/
type WebsocketConnectionClosedCallback =
    IO ()

type C_WebsocketConnectionClosedCallback =
    Ptr WebsocketConnection ->              -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebsocketConnectionClosedCallback :: 
    GObject a => (a -> WebsocketConnectionClosedCallback) ->
    C_WebsocketConnectionClosedCallback
wrap_WebsocketConnectionClosedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_WebsocketConnectionClosedCallback
wrap_WebsocketConnectionClosedCallback a -> IO ()
gi'cb Ptr WebsocketConnection
gi'selfPtr Ptr ()
_ = do
    Ptr WebsocketConnection -> (WebsocketConnection -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebsocketConnection
gi'selfPtr ((WebsocketConnection -> IO ()) -> IO ())
-> (WebsocketConnection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebsocketConnection
gi'self -> a -> IO ()
gi'cb (WebsocketConnection -> a
Coerce.coerce WebsocketConnection
gi'self) 


-- | Connect a signal handler for the [closed](#signal:closed) 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' websocketConnection #closed callback
-- @
-- 
-- 
onWebsocketConnectionClosed :: (IsWebsocketConnection a, MonadIO m) => a -> ((?self :: a) => WebsocketConnectionClosedCallback) -> m SignalHandlerId
onWebsocketConnectionClosed :: forall a (m :: * -> *).
(IsWebsocketConnection a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWebsocketConnectionClosed a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WebsocketConnectionClosedCallback
wrapped' = (a -> IO ()) -> C_WebsocketConnectionClosedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_WebsocketConnectionClosedCallback
wrap_WebsocketConnectionClosedCallback a -> IO ()
wrapped
    FunPtr C_WebsocketConnectionClosedCallback
wrapped'' <- C_WebsocketConnectionClosedCallback
-> IO (FunPtr C_WebsocketConnectionClosedCallback)
mk_WebsocketConnectionClosedCallback C_WebsocketConnectionClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebsocketConnectionClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"closed" FunPtr C_WebsocketConnectionClosedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [closed](#signal:closed) 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' websocketConnection #closed 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.
-- 
afterWebsocketConnectionClosed :: (IsWebsocketConnection a, MonadIO m) => a -> ((?self :: a) => WebsocketConnectionClosedCallback) -> m SignalHandlerId
afterWebsocketConnectionClosed :: forall a (m :: * -> *).
(IsWebsocketConnection a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWebsocketConnectionClosed a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WebsocketConnectionClosedCallback
wrapped' = (a -> IO ()) -> C_WebsocketConnectionClosedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_WebsocketConnectionClosedCallback
wrap_WebsocketConnectionClosedCallback a -> IO ()
wrapped
    FunPtr C_WebsocketConnectionClosedCallback
wrapped'' <- C_WebsocketConnectionClosedCallback
-> IO (FunPtr C_WebsocketConnectionClosedCallback)
mk_WebsocketConnectionClosedCallback C_WebsocketConnectionClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebsocketConnectionClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"closed" FunPtr C_WebsocketConnectionClosedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionClosedSignalInfo
instance SignalInfo WebsocketConnectionClosedSignalInfo where
    type HaskellCallbackType WebsocketConnectionClosedSignalInfo = WebsocketConnectionClosedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebsocketConnectionClosedCallback cb
        cb'' <- mk_WebsocketConnectionClosedCallback cb'
        connectSignalFunPtr obj "closed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection::closed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:signal:closed"})

#endif

-- signal WebsocketConnection::closing
-- | This signal will be emitted during an orderly close.
-- 
-- /Since: 2.50/
type WebsocketConnectionClosingCallback =
    IO ()

type C_WebsocketConnectionClosingCallback =
    Ptr WebsocketConnection ->              -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebsocketConnectionClosingCallback :: 
    GObject a => (a -> WebsocketConnectionClosingCallback) ->
    C_WebsocketConnectionClosingCallback
wrap_WebsocketConnectionClosingCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_WebsocketConnectionClosedCallback
wrap_WebsocketConnectionClosingCallback a -> IO ()
gi'cb Ptr WebsocketConnection
gi'selfPtr Ptr ()
_ = do
    Ptr WebsocketConnection -> (WebsocketConnection -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebsocketConnection
gi'selfPtr ((WebsocketConnection -> IO ()) -> IO ())
-> (WebsocketConnection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebsocketConnection
gi'self -> a -> IO ()
gi'cb (WebsocketConnection -> a
Coerce.coerce WebsocketConnection
gi'self) 


-- | Connect a signal handler for the [closing](#signal:closing) 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' websocketConnection #closing callback
-- @
-- 
-- 
onWebsocketConnectionClosing :: (IsWebsocketConnection a, MonadIO m) => a -> ((?self :: a) => WebsocketConnectionClosingCallback) -> m SignalHandlerId
onWebsocketConnectionClosing :: forall a (m :: * -> *).
(IsWebsocketConnection a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWebsocketConnectionClosing a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WebsocketConnectionClosedCallback
wrapped' = (a -> IO ()) -> C_WebsocketConnectionClosedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_WebsocketConnectionClosedCallback
wrap_WebsocketConnectionClosingCallback a -> IO ()
wrapped
    FunPtr C_WebsocketConnectionClosedCallback
wrapped'' <- C_WebsocketConnectionClosedCallback
-> IO (FunPtr C_WebsocketConnectionClosedCallback)
mk_WebsocketConnectionClosingCallback C_WebsocketConnectionClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebsocketConnectionClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"closing" FunPtr C_WebsocketConnectionClosedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [closing](#signal:closing) 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' websocketConnection #closing 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.
-- 
afterWebsocketConnectionClosing :: (IsWebsocketConnection a, MonadIO m) => a -> ((?self :: a) => WebsocketConnectionClosingCallback) -> m SignalHandlerId
afterWebsocketConnectionClosing :: forall a (m :: * -> *).
(IsWebsocketConnection a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWebsocketConnectionClosing a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WebsocketConnectionClosedCallback
wrapped' = (a -> IO ()) -> C_WebsocketConnectionClosedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_WebsocketConnectionClosedCallback
wrap_WebsocketConnectionClosingCallback a -> IO ()
wrapped
    FunPtr C_WebsocketConnectionClosedCallback
wrapped'' <- C_WebsocketConnectionClosedCallback
-> IO (FunPtr C_WebsocketConnectionClosedCallback)
mk_WebsocketConnectionClosingCallback C_WebsocketConnectionClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebsocketConnectionClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"closing" FunPtr C_WebsocketConnectionClosedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionClosingSignalInfo
instance SignalInfo WebsocketConnectionClosingSignalInfo where
    type HaskellCallbackType WebsocketConnectionClosingSignalInfo = WebsocketConnectionClosingCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebsocketConnectionClosingCallback cb
        cb'' <- mk_WebsocketConnectionClosingCallback cb'
        connectSignalFunPtr obj "closing" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection::closing"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:signal:closing"})

#endif

-- signal WebsocketConnection::error
-- | Emitted when an error occurred on the WebSocket. This may
-- be fired multiple times. Fatal errors will be followed by
-- the [closed]("GI.Soup.Objects.WebsocketConnection#g:signal:closed") signal being emitted.
-- 
-- /Since: 2.50/
type WebsocketConnectionErrorCallback =
    GError
    -- ^ /@error@/: the error that occured
    -> IO ()

type C_WebsocketConnectionErrorCallback =
    Ptr WebsocketConnection ->              -- object
    Ptr GError ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebsocketConnectionErrorCallback :: 
    GObject a => (a -> WebsocketConnectionErrorCallback) ->
    C_WebsocketConnectionErrorCallback
wrap_WebsocketConnectionErrorCallback :: forall a.
GObject a =>
(a -> WebsocketConnectionErrorCallback)
-> C_WebsocketConnectionErrorCallback
wrap_WebsocketConnectionErrorCallback a -> WebsocketConnectionErrorCallback
gi'cb Ptr WebsocketConnection
gi'selfPtr Ptr GError
error_ Ptr ()
_ = do
    GError
error_' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
error_
    Ptr WebsocketConnection -> (WebsocketConnection -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebsocketConnection
gi'selfPtr ((WebsocketConnection -> IO ()) -> IO ())
-> (WebsocketConnection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebsocketConnection
gi'self -> a -> WebsocketConnectionErrorCallback
gi'cb (WebsocketConnection -> a
Coerce.coerce WebsocketConnection
gi'self)  GError
error_'


-- | Connect a signal handler for the [error](#signal:error) 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' websocketConnection #error callback
-- @
-- 
-- 
onWebsocketConnectionError :: (IsWebsocketConnection a, MonadIO m) => a -> ((?self :: a) => WebsocketConnectionErrorCallback) -> m SignalHandlerId
onWebsocketConnectionError :: forall a (m :: * -> *).
(IsWebsocketConnection a, MonadIO m) =>
a
-> ((?self::a) => WebsocketConnectionErrorCallback)
-> m SignalHandlerId
onWebsocketConnectionError a
obj (?self::a) => WebsocketConnectionErrorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
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 -> WebsocketConnectionErrorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebsocketConnectionErrorCallback
WebsocketConnectionErrorCallback
cb
    let wrapped' :: C_WebsocketConnectionErrorCallback
wrapped' = (a -> WebsocketConnectionErrorCallback)
-> C_WebsocketConnectionErrorCallback
forall a.
GObject a =>
(a -> WebsocketConnectionErrorCallback)
-> C_WebsocketConnectionErrorCallback
wrap_WebsocketConnectionErrorCallback a -> WebsocketConnectionErrorCallback
wrapped
    FunPtr C_WebsocketConnectionErrorCallback
wrapped'' <- C_WebsocketConnectionErrorCallback
-> IO (FunPtr C_WebsocketConnectionErrorCallback)
mk_WebsocketConnectionErrorCallback C_WebsocketConnectionErrorCallback
wrapped'
    a
-> Text
-> FunPtr C_WebsocketConnectionErrorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"error" FunPtr C_WebsocketConnectionErrorCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [error](#signal:error) 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' websocketConnection #error 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.
-- 
afterWebsocketConnectionError :: (IsWebsocketConnection a, MonadIO m) => a -> ((?self :: a) => WebsocketConnectionErrorCallback) -> m SignalHandlerId
afterWebsocketConnectionError :: forall a (m :: * -> *).
(IsWebsocketConnection a, MonadIO m) =>
a
-> ((?self::a) => WebsocketConnectionErrorCallback)
-> m SignalHandlerId
afterWebsocketConnectionError a
obj (?self::a) => WebsocketConnectionErrorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
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 -> WebsocketConnectionErrorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebsocketConnectionErrorCallback
WebsocketConnectionErrorCallback
cb
    let wrapped' :: C_WebsocketConnectionErrorCallback
wrapped' = (a -> WebsocketConnectionErrorCallback)
-> C_WebsocketConnectionErrorCallback
forall a.
GObject a =>
(a -> WebsocketConnectionErrorCallback)
-> C_WebsocketConnectionErrorCallback
wrap_WebsocketConnectionErrorCallback a -> WebsocketConnectionErrorCallback
wrapped
    FunPtr C_WebsocketConnectionErrorCallback
wrapped'' <- C_WebsocketConnectionErrorCallback
-> IO (FunPtr C_WebsocketConnectionErrorCallback)
mk_WebsocketConnectionErrorCallback C_WebsocketConnectionErrorCallback
wrapped'
    a
-> Text
-> FunPtr C_WebsocketConnectionErrorCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"error" FunPtr C_WebsocketConnectionErrorCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionErrorSignalInfo
instance SignalInfo WebsocketConnectionErrorSignalInfo where
    type HaskellCallbackType WebsocketConnectionErrorSignalInfo = WebsocketConnectionErrorCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebsocketConnectionErrorCallback cb
        cb'' <- mk_WebsocketConnectionErrorCallback cb'
        connectSignalFunPtr obj "error" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection::error"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:signal:error"})

#endif

-- signal WebsocketConnection::message
-- | Emitted when we receive a message from the peer.
-- 
-- As a convenience, the /@message@/ data will always be
-- NUL-terminated, but the NUL byte will not be included in
-- the length count.
-- 
-- /Since: 2.50/
type WebsocketConnectionMessageCallback =
    Int32
    -- ^ /@type@/: the type of message contents
    -> GLib.Bytes.Bytes
    -- ^ /@message@/: the message data
    -> IO ()

type C_WebsocketConnectionMessageCallback =
    Ptr WebsocketConnection ->              -- object
    Int32 ->
    Ptr GLib.Bytes.Bytes ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebsocketConnectionMessageCallback :: 
    GObject a => (a -> WebsocketConnectionMessageCallback) ->
    C_WebsocketConnectionMessageCallback
wrap_WebsocketConnectionMessageCallback :: forall a.
GObject a =>
(a -> WebsocketConnectionMessageCallback)
-> C_WebsocketConnectionMessageCallback
wrap_WebsocketConnectionMessageCallback a -> WebsocketConnectionMessageCallback
gi'cb Ptr WebsocketConnection
gi'selfPtr Int32
type_ Ptr Bytes
message Ptr ()
_ = do
    Ptr Bytes -> (Bytes -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Bytes
message ((Bytes -> IO ()) -> IO ()) -> (Bytes -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Bytes
message' -> do
        Ptr WebsocketConnection -> (WebsocketConnection -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebsocketConnection
gi'selfPtr ((WebsocketConnection -> IO ()) -> IO ())
-> (WebsocketConnection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebsocketConnection
gi'self -> a -> WebsocketConnectionMessageCallback
gi'cb (WebsocketConnection -> a
Coerce.coerce WebsocketConnection
gi'self)  Int32
type_ Bytes
message'


-- | Connect a signal handler for the [message](#signal:message) 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' websocketConnection #message callback
-- @
-- 
-- 
onWebsocketConnectionMessage :: (IsWebsocketConnection a, MonadIO m) => a -> ((?self :: a) => WebsocketConnectionMessageCallback) -> m SignalHandlerId
onWebsocketConnectionMessage :: forall a (m :: * -> *).
(IsWebsocketConnection a, MonadIO m) =>
a
-> ((?self::a) => WebsocketConnectionMessageCallback)
-> m SignalHandlerId
onWebsocketConnectionMessage a
obj (?self::a) => WebsocketConnectionMessageCallback
cb = IO SignalHandlerId -> m SignalHandlerId
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 -> WebsocketConnectionMessageCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebsocketConnectionMessageCallback
WebsocketConnectionMessageCallback
cb
    let wrapped' :: C_WebsocketConnectionMessageCallback
wrapped' = (a -> WebsocketConnectionMessageCallback)
-> C_WebsocketConnectionMessageCallback
forall a.
GObject a =>
(a -> WebsocketConnectionMessageCallback)
-> C_WebsocketConnectionMessageCallback
wrap_WebsocketConnectionMessageCallback a -> WebsocketConnectionMessageCallback
wrapped
    FunPtr C_WebsocketConnectionMessageCallback
wrapped'' <- C_WebsocketConnectionMessageCallback
-> IO (FunPtr C_WebsocketConnectionMessageCallback)
mk_WebsocketConnectionMessageCallback C_WebsocketConnectionMessageCallback
wrapped'
    a
-> Text
-> FunPtr C_WebsocketConnectionMessageCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"message" FunPtr C_WebsocketConnectionMessageCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [message](#signal:message) 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' websocketConnection #message 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.
-- 
afterWebsocketConnectionMessage :: (IsWebsocketConnection a, MonadIO m) => a -> ((?self :: a) => WebsocketConnectionMessageCallback) -> m SignalHandlerId
afterWebsocketConnectionMessage :: forall a (m :: * -> *).
(IsWebsocketConnection a, MonadIO m) =>
a
-> ((?self::a) => WebsocketConnectionMessageCallback)
-> m SignalHandlerId
afterWebsocketConnectionMessage a
obj (?self::a) => WebsocketConnectionMessageCallback
cb = IO SignalHandlerId -> m SignalHandlerId
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 -> WebsocketConnectionMessageCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebsocketConnectionMessageCallback
WebsocketConnectionMessageCallback
cb
    let wrapped' :: C_WebsocketConnectionMessageCallback
wrapped' = (a -> WebsocketConnectionMessageCallback)
-> C_WebsocketConnectionMessageCallback
forall a.
GObject a =>
(a -> WebsocketConnectionMessageCallback)
-> C_WebsocketConnectionMessageCallback
wrap_WebsocketConnectionMessageCallback a -> WebsocketConnectionMessageCallback
wrapped
    FunPtr C_WebsocketConnectionMessageCallback
wrapped'' <- C_WebsocketConnectionMessageCallback
-> IO (FunPtr C_WebsocketConnectionMessageCallback)
mk_WebsocketConnectionMessageCallback C_WebsocketConnectionMessageCallback
wrapped'
    a
-> Text
-> FunPtr C_WebsocketConnectionMessageCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"message" FunPtr C_WebsocketConnectionMessageCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionMessageSignalInfo
instance SignalInfo WebsocketConnectionMessageSignalInfo where
    type HaskellCallbackType WebsocketConnectionMessageSignalInfo = WebsocketConnectionMessageCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebsocketConnectionMessageCallback cb
        cb'' <- mk_WebsocketConnectionMessageCallback cb'
        connectSignalFunPtr obj "message" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection::message"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:signal:message"})

#endif

-- signal WebsocketConnection::pong
-- | Emitted when we receive a Pong frame (solicited or
-- unsolicited) from the peer.
-- 
-- As a convenience, the /@message@/ data will always be
-- NUL-terminated, but the NUL byte will not be included in
-- the length count.
-- 
-- /Since: 2.60/
type WebsocketConnectionPongCallback =
    GLib.Bytes.Bytes
    -- ^ /@message@/: the application data (if any)
    -> IO ()

type C_WebsocketConnectionPongCallback =
    Ptr WebsocketConnection ->              -- object
    Ptr GLib.Bytes.Bytes ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebsocketConnectionPongCallback :: 
    GObject a => (a -> WebsocketConnectionPongCallback) ->
    C_WebsocketConnectionPongCallback
wrap_WebsocketConnectionPongCallback :: forall a.
GObject a =>
(a -> Bytes -> IO ()) -> C_WebsocketConnectionPongCallback
wrap_WebsocketConnectionPongCallback a -> Bytes -> IO ()
gi'cb Ptr WebsocketConnection
gi'selfPtr Ptr Bytes
message Ptr ()
_ = do
    Ptr Bytes -> (Bytes -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Bytes
message ((Bytes -> IO ()) -> IO ()) -> (Bytes -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Bytes
message' -> do
        Ptr WebsocketConnection -> (WebsocketConnection -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebsocketConnection
gi'selfPtr ((WebsocketConnection -> IO ()) -> IO ())
-> (WebsocketConnection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebsocketConnection
gi'self -> a -> Bytes -> IO ()
gi'cb (WebsocketConnection -> a
Coerce.coerce WebsocketConnection
gi'self)  Bytes
message'


-- | Connect a signal handler for the [pong](#signal:pong) 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' websocketConnection #pong callback
-- @
-- 
-- 
onWebsocketConnectionPong :: (IsWebsocketConnection a, MonadIO m) => a -> ((?self :: a) => WebsocketConnectionPongCallback) -> m SignalHandlerId
onWebsocketConnectionPong :: forall a (m :: * -> *).
(IsWebsocketConnection a, MonadIO m) =>
a -> ((?self::a) => Bytes -> IO ()) -> m SignalHandlerId
onWebsocketConnectionPong a
obj (?self::a) => Bytes -> IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 -> Bytes -> IO ()
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => Bytes -> IO ()
Bytes -> IO ()
cb
    let wrapped' :: C_WebsocketConnectionPongCallback
wrapped' = (a -> Bytes -> IO ()) -> C_WebsocketConnectionPongCallback
forall a.
GObject a =>
(a -> Bytes -> IO ()) -> C_WebsocketConnectionPongCallback
wrap_WebsocketConnectionPongCallback a -> Bytes -> IO ()
wrapped
    FunPtr C_WebsocketConnectionPongCallback
wrapped'' <- C_WebsocketConnectionPongCallback
-> IO (FunPtr C_WebsocketConnectionPongCallback)
mk_WebsocketConnectionPongCallback C_WebsocketConnectionPongCallback
wrapped'
    a
-> Text
-> FunPtr C_WebsocketConnectionPongCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"pong" FunPtr C_WebsocketConnectionPongCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [pong](#signal:pong) 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' websocketConnection #pong 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.
-- 
afterWebsocketConnectionPong :: (IsWebsocketConnection a, MonadIO m) => a -> ((?self :: a) => WebsocketConnectionPongCallback) -> m SignalHandlerId
afterWebsocketConnectionPong :: forall a (m :: * -> *).
(IsWebsocketConnection a, MonadIO m) =>
a -> ((?self::a) => Bytes -> IO ()) -> m SignalHandlerId
afterWebsocketConnectionPong a
obj (?self::a) => Bytes -> IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 -> Bytes -> IO ()
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => Bytes -> IO ()
Bytes -> IO ()
cb
    let wrapped' :: C_WebsocketConnectionPongCallback
wrapped' = (a -> Bytes -> IO ()) -> C_WebsocketConnectionPongCallback
forall a.
GObject a =>
(a -> Bytes -> IO ()) -> C_WebsocketConnectionPongCallback
wrap_WebsocketConnectionPongCallback a -> Bytes -> IO ()
wrapped
    FunPtr C_WebsocketConnectionPongCallback
wrapped'' <- C_WebsocketConnectionPongCallback
-> IO (FunPtr C_WebsocketConnectionPongCallback)
mk_WebsocketConnectionPongCallback C_WebsocketConnectionPongCallback
wrapped'
    a
-> Text
-> FunPtr C_WebsocketConnectionPongCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"pong" FunPtr C_WebsocketConnectionPongCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionPongSignalInfo
instance SignalInfo WebsocketConnectionPongSignalInfo where
    type HaskellCallbackType WebsocketConnectionPongSignalInfo = WebsocketConnectionPongCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebsocketConnectionPongCallback cb
        cb'' <- mk_WebsocketConnectionPongCallback cb'
        connectSignalFunPtr obj "pong" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection::pong"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:signal:pong"})

#endif

-- VVV Prop "connection-type"
   -- Type: TInterface (Name {namespace = "Soup", name = "WebsocketConnectionType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionConnectionTypePropertyInfo
instance AttrInfo WebsocketConnectionConnectionTypePropertyInfo where
    type AttrAllowedOps WebsocketConnectionConnectionTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint WebsocketConnectionConnectionTypePropertyInfo = IsWebsocketConnection
    type AttrSetTypeConstraint WebsocketConnectionConnectionTypePropertyInfo = (~) Soup.Enums.WebsocketConnectionType
    type AttrTransferTypeConstraint WebsocketConnectionConnectionTypePropertyInfo = (~) Soup.Enums.WebsocketConnectionType
    type AttrTransferType WebsocketConnectionConnectionTypePropertyInfo = Soup.Enums.WebsocketConnectionType
    type AttrGetType WebsocketConnectionConnectionTypePropertyInfo = Soup.Enums.WebsocketConnectionType
    type AttrLabel WebsocketConnectionConnectionTypePropertyInfo = "connection-type"
    type AttrOrigin WebsocketConnectionConnectionTypePropertyInfo = WebsocketConnection
    attrGet = getWebsocketConnectionConnectionType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructWebsocketConnectionConnectionType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection.connectionType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:attr:connectionType"
        })
#endif

-- VVV Prop "extensions"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@extensions@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructWebsocketConnectionExtensions :: (IsWebsocketConnection o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructWebsocketConnectionExtensions :: forall o (m :: * -> *).
(IsWebsocketConnection o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructWebsocketConnectionExtensions Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"extensions" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionExtensionsPropertyInfo
instance AttrInfo WebsocketConnectionExtensionsPropertyInfo where
    type AttrAllowedOps WebsocketConnectionExtensionsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint WebsocketConnectionExtensionsPropertyInfo = IsWebsocketConnection
    type AttrSetTypeConstraint WebsocketConnectionExtensionsPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint WebsocketConnectionExtensionsPropertyInfo = (~) (Ptr ())
    type AttrTransferType WebsocketConnectionExtensionsPropertyInfo = Ptr ()
    type AttrGetType WebsocketConnectionExtensionsPropertyInfo = (Ptr ())
    type AttrLabel WebsocketConnectionExtensionsPropertyInfo = "extensions"
    type AttrOrigin WebsocketConnectionExtensionsPropertyInfo = WebsocketConnection
    attrGet = getWebsocketConnectionExtensions
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructWebsocketConnectionExtensions
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection.extensions"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:attr:extensions"
        })
#endif

-- VVV Prop "io-stream"
   -- Type: TInterface (Name {namespace = "Gio", name = "IOStream"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@io-stream@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' websocketConnection #ioStream
-- @
getWebsocketConnectionIoStream :: (MonadIO m, IsWebsocketConnection o) => o -> m Gio.IOStream.IOStream
getWebsocketConnectionIoStream :: forall (m :: * -> *) o.
(MonadIO m, IsWebsocketConnection o) =>
o -> m IOStream
getWebsocketConnectionIoStream o
obj = IO IOStream -> m IOStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO IOStream -> m IOStream) -> IO IOStream -> m IOStream
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe IOStream) -> IO IOStream
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getWebsocketConnectionIoStream" (IO (Maybe IOStream) -> IO IOStream)
-> IO (Maybe IOStream) -> IO IOStream
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr IOStream -> IOStream)
-> IO (Maybe IOStream)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"io-stream" ManagedPtr IOStream -> IOStream
Gio.IOStream.IOStream

-- | Construct a `GValueConstruct` with valid value for the “@io-stream@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructWebsocketConnectionIoStream :: (IsWebsocketConnection o, MIO.MonadIO m, Gio.IOStream.IsIOStream a) => a -> m (GValueConstruct o)
constructWebsocketConnectionIoStream :: forall o (m :: * -> *) a.
(IsWebsocketConnection o, MonadIO m, IsIOStream a) =>
a -> m (GValueConstruct o)
constructWebsocketConnectionIoStream a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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
"io-stream" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionIoStreamPropertyInfo
instance AttrInfo WebsocketConnectionIoStreamPropertyInfo where
    type AttrAllowedOps WebsocketConnectionIoStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint WebsocketConnectionIoStreamPropertyInfo = IsWebsocketConnection
    type AttrSetTypeConstraint WebsocketConnectionIoStreamPropertyInfo = Gio.IOStream.IsIOStream
    type AttrTransferTypeConstraint WebsocketConnectionIoStreamPropertyInfo = Gio.IOStream.IsIOStream
    type AttrTransferType WebsocketConnectionIoStreamPropertyInfo = Gio.IOStream.IOStream
    type AttrGetType WebsocketConnectionIoStreamPropertyInfo = Gio.IOStream.IOStream
    type AttrLabel WebsocketConnectionIoStreamPropertyInfo = "io-stream"
    type AttrOrigin WebsocketConnectionIoStreamPropertyInfo = WebsocketConnection
    attrGet = getWebsocketConnectionIoStream
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.IOStream.IOStream v
    attrConstruct = constructWebsocketConnectionIoStream
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection.ioStream"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:attr:ioStream"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionKeepaliveIntervalPropertyInfo
instance AttrInfo WebsocketConnectionKeepaliveIntervalPropertyInfo where
    type AttrAllowedOps WebsocketConnectionKeepaliveIntervalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint WebsocketConnectionKeepaliveIntervalPropertyInfo = IsWebsocketConnection
    type AttrSetTypeConstraint WebsocketConnectionKeepaliveIntervalPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint WebsocketConnectionKeepaliveIntervalPropertyInfo = (~) Word32
    type AttrTransferType WebsocketConnectionKeepaliveIntervalPropertyInfo = Word32
    type AttrGetType WebsocketConnectionKeepaliveIntervalPropertyInfo = Word32
    type AttrLabel WebsocketConnectionKeepaliveIntervalPropertyInfo = "keepalive-interval"
    type AttrOrigin WebsocketConnectionKeepaliveIntervalPropertyInfo = WebsocketConnection
    attrGet = getWebsocketConnectionKeepaliveInterval
    attrSet = setWebsocketConnectionKeepaliveInterval
    attrTransfer _ v = do
        return v
    attrConstruct = constructWebsocketConnectionKeepaliveInterval
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection.keepaliveInterval"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:attr:keepaliveInterval"
        })
#endif

-- VVV Prop "max-incoming-payload-size"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@max-incoming-payload-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' websocketConnection #maxIncomingPayloadSize
-- @
getWebsocketConnectionMaxIncomingPayloadSize :: (MonadIO m, IsWebsocketConnection o) => o -> m Word64
getWebsocketConnectionMaxIncomingPayloadSize :: forall (m :: * -> *) o.
(MonadIO m, IsWebsocketConnection o) =>
o -> m Word64
getWebsocketConnectionMaxIncomingPayloadSize o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"max-incoming-payload-size"

-- | Set the value of the “@max-incoming-payload-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' websocketConnection [ #maxIncomingPayloadSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setWebsocketConnectionMaxIncomingPayloadSize :: (MonadIO m, IsWebsocketConnection o) => o -> Word64 -> m ()
setWebsocketConnectionMaxIncomingPayloadSize :: forall (m :: * -> *) o.
(MonadIO m, IsWebsocketConnection o) =>
o -> Word64 -> m ()
setWebsocketConnectionMaxIncomingPayloadSize o
obj Word64
val = IO () -> m ()
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 -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"max-incoming-payload-size" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@max-incoming-payload-size@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructWebsocketConnectionMaxIncomingPayloadSize :: (IsWebsocketConnection o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructWebsocketConnectionMaxIncomingPayloadSize :: forall o (m :: * -> *).
(IsWebsocketConnection o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructWebsocketConnectionMaxIncomingPayloadSize Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"max-incoming-payload-size" Word64
val

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionMaxIncomingPayloadSizePropertyInfo
instance AttrInfo WebsocketConnectionMaxIncomingPayloadSizePropertyInfo where
    type AttrAllowedOps WebsocketConnectionMaxIncomingPayloadSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint WebsocketConnectionMaxIncomingPayloadSizePropertyInfo = IsWebsocketConnection
    type AttrSetTypeConstraint WebsocketConnectionMaxIncomingPayloadSizePropertyInfo = (~) Word64
    type AttrTransferTypeConstraint WebsocketConnectionMaxIncomingPayloadSizePropertyInfo = (~) Word64
    type AttrTransferType WebsocketConnectionMaxIncomingPayloadSizePropertyInfo = Word64
    type AttrGetType WebsocketConnectionMaxIncomingPayloadSizePropertyInfo = Word64
    type AttrLabel WebsocketConnectionMaxIncomingPayloadSizePropertyInfo = "max-incoming-payload-size"
    type AttrOrigin WebsocketConnectionMaxIncomingPayloadSizePropertyInfo = WebsocketConnection
    attrGet = getWebsocketConnectionMaxIncomingPayloadSize
    attrSet = setWebsocketConnectionMaxIncomingPayloadSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructWebsocketConnectionMaxIncomingPayloadSize
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection.maxIncomingPayloadSize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:attr:maxIncomingPayloadSize"
        })
#endif

-- VVV Prop "origin"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionOriginPropertyInfo
instance AttrInfo WebsocketConnectionOriginPropertyInfo where
    type AttrAllowedOps WebsocketConnectionOriginPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint WebsocketConnectionOriginPropertyInfo = IsWebsocketConnection
    type AttrSetTypeConstraint WebsocketConnectionOriginPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint WebsocketConnectionOriginPropertyInfo = (~) T.Text
    type AttrTransferType WebsocketConnectionOriginPropertyInfo = T.Text
    type AttrGetType WebsocketConnectionOriginPropertyInfo = (Maybe T.Text)
    type AttrLabel WebsocketConnectionOriginPropertyInfo = "origin"
    type AttrOrigin WebsocketConnectionOriginPropertyInfo = WebsocketConnection
    attrGet = getWebsocketConnectionOrigin
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructWebsocketConnectionOrigin
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection.origin"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:attr:origin"
        })
#endif

-- VVV Prop "protocol"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionProtocolPropertyInfo
instance AttrInfo WebsocketConnectionProtocolPropertyInfo where
    type AttrAllowedOps WebsocketConnectionProtocolPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint WebsocketConnectionProtocolPropertyInfo = IsWebsocketConnection
    type AttrSetTypeConstraint WebsocketConnectionProtocolPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint WebsocketConnectionProtocolPropertyInfo = (~) T.Text
    type AttrTransferType WebsocketConnectionProtocolPropertyInfo = T.Text
    type AttrGetType WebsocketConnectionProtocolPropertyInfo = (Maybe T.Text)
    type AttrLabel WebsocketConnectionProtocolPropertyInfo = "protocol"
    type AttrOrigin WebsocketConnectionProtocolPropertyInfo = WebsocketConnection
    attrGet = getWebsocketConnectionProtocol
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructWebsocketConnectionProtocol
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection.protocol"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:attr:protocol"
        })
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionStatePropertyInfo
instance AttrInfo WebsocketConnectionStatePropertyInfo where
    type AttrAllowedOps WebsocketConnectionStatePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint WebsocketConnectionStatePropertyInfo = IsWebsocketConnection
    type AttrSetTypeConstraint WebsocketConnectionStatePropertyInfo = (~) ()
    type AttrTransferTypeConstraint WebsocketConnectionStatePropertyInfo = (~) ()
    type AttrTransferType WebsocketConnectionStatePropertyInfo = ()
    type AttrGetType WebsocketConnectionStatePropertyInfo = Soup.Enums.WebsocketState
    type AttrLabel WebsocketConnectionStatePropertyInfo = "state"
    type AttrOrigin WebsocketConnectionStatePropertyInfo = WebsocketConnection
    attrGet = getWebsocketConnectionState
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.WebsocketConnection.state"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-WebsocketConnection.html#g:attr:state"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList WebsocketConnection
type instance O.AttributeList WebsocketConnection = WebsocketConnectionAttributeList
type WebsocketConnectionAttributeList = ('[ '("connectionType", WebsocketConnectionConnectionTypePropertyInfo), '("extensions", WebsocketConnectionExtensionsPropertyInfo), '("ioStream", WebsocketConnectionIoStreamPropertyInfo), '("keepaliveInterval", WebsocketConnectionKeepaliveIntervalPropertyInfo), '("maxIncomingPayloadSize", WebsocketConnectionMaxIncomingPayloadSizePropertyInfo), '("origin", WebsocketConnectionOriginPropertyInfo), '("protocol", WebsocketConnectionProtocolPropertyInfo), '("state", WebsocketConnectionStatePropertyInfo), '("uri", WebsocketConnectionUriPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
websocketConnectionConnectionType :: AttrLabelProxy "connectionType"
websocketConnectionConnectionType = AttrLabelProxy

websocketConnectionExtensions :: AttrLabelProxy "extensions"
websocketConnectionExtensions = AttrLabelProxy

websocketConnectionIoStream :: AttrLabelProxy "ioStream"
websocketConnectionIoStream = AttrLabelProxy

websocketConnectionKeepaliveInterval :: AttrLabelProxy "keepaliveInterval"
websocketConnectionKeepaliveInterval = AttrLabelProxy

websocketConnectionMaxIncomingPayloadSize :: AttrLabelProxy "maxIncomingPayloadSize"
websocketConnectionMaxIncomingPayloadSize = AttrLabelProxy

websocketConnectionOrigin :: AttrLabelProxy "origin"
websocketConnectionOrigin = AttrLabelProxy

websocketConnectionProtocol :: AttrLabelProxy "protocol"
websocketConnectionProtocol = AttrLabelProxy

websocketConnectionState :: AttrLabelProxy "state"
websocketConnectionState = AttrLabelProxy

websocketConnectionUri :: AttrLabelProxy "uri"
websocketConnectionUri = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList WebsocketConnection = WebsocketConnectionSignalList
type WebsocketConnectionSignalList = ('[ '("closed", WebsocketConnectionClosedSignalInfo), '("closing", WebsocketConnectionClosingSignalInfo), '("error", WebsocketConnectionErrorSignalInfo), '("message", WebsocketConnectionMessageSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("pong", WebsocketConnectionPongSignalInfo)] :: [(Symbol, *)])

#endif

-- method WebsocketConnection::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "IOStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GIOStream connected to the WebSocket server"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the URI of the connection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "WebsocketConnectionType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of connection (client/side)"
--                 , 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 client"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocol"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the subprotocol in use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Soup" , name = "WebsocketConnection" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_websocket_connection_new" soup_websocket_connection_new :: 
    Ptr Gio.IOStream.IOStream ->            -- stream : TInterface (Name {namespace = "Gio", name = "IOStream"})
    Ptr Soup.URI.URI ->                     -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Soup", name = "WebsocketConnectionType"})
    CString ->                              -- origin : TBasicType TUTF8
    CString ->                              -- protocol : TBasicType TUTF8
    IO (Ptr WebsocketConnection)

-- | Creates a t'GI.Soup.Objects.WebsocketConnection.WebsocketConnection' on /@stream@/. This should be
-- called after completing the handshake to begin using the WebSocket
-- protocol.
-- 
-- /Since: 2.50/
websocketConnectionNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.IOStream.IsIOStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream' connected to the WebSocket server
    -> Soup.URI.URI
    -- ^ /@uri@/: the URI of the connection
    -> Soup.Enums.WebsocketConnectionType
    -- ^ /@type@/: the type of connection (client\/side)
    -> Maybe (T.Text)
    -- ^ /@origin@/: the Origin of the client
    -> Maybe (T.Text)
    -- ^ /@protocol@/: the subprotocol in use
    -> m WebsocketConnection
    -- ^ __Returns:__ a new t'GI.Soup.Objects.WebsocketConnection.WebsocketConnection'
websocketConnectionNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIOStream a) =>
a
-> URI
-> WebsocketConnectionType
-> Maybe Text
-> Maybe Text
-> m WebsocketConnection
websocketConnectionNew a
stream URI
uri WebsocketConnectionType
type_ Maybe Text
origin Maybe Text
protocol = IO WebsocketConnection -> m WebsocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebsocketConnection -> m WebsocketConnection)
-> IO WebsocketConnection -> m WebsocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOStream
stream' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (WebsocketConnectionType -> Int)
-> WebsocketConnectionType
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebsocketConnectionType -> Int
forall a. Enum a => a -> Int
fromEnum) WebsocketConnectionType
type_
    Ptr CChar
maybeOrigin <- case Maybe Text
origin of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jOrigin'
    Ptr CChar
maybeProtocol <- case Maybe Text
protocol of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jProtocol -> do
            Ptr CChar
jProtocol' <- Text -> IO (Ptr CChar)
textToCString Text
jProtocol
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jProtocol'
    Ptr WebsocketConnection
result <- Ptr IOStream
-> Ptr URI
-> CUInt
-> Ptr CChar
-> Ptr CChar
-> IO (Ptr WebsocketConnection)
soup_websocket_connection_new Ptr IOStream
stream' Ptr URI
uri' CUInt
type_' Ptr CChar
maybeOrigin Ptr CChar
maybeProtocol
    Text -> Ptr WebsocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"websocketConnectionNew" Ptr WebsocketConnection
result
    WebsocketConnection
result' <- ((ManagedPtr WebsocketConnection -> WebsocketConnection)
-> Ptr WebsocketConnection -> IO WebsocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr WebsocketConnection -> WebsocketConnection
WebsocketConnection) Ptr WebsocketConnection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeOrigin
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeProtocol
    WebsocketConnection -> IO WebsocketConnection
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketConnection
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method WebsocketConnection::new_with_extensions
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "IOStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GIOStream connected to the WebSocket server"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the URI of the connection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "WebsocketConnectionType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of connection (client/side)"
--                 , 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 client"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocol"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the subprotocol in use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "extensions"
--           , argType =
--               TGList
--                 (TInterface
--                    Name { namespace = "Soup" , name = "WebsocketExtension" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GList of #SoupWebsocketExtension objects"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Soup" , name = "WebsocketConnection" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_websocket_connection_new_with_extensions" soup_websocket_connection_new_with_extensions :: 
    Ptr Gio.IOStream.IOStream ->            -- stream : TInterface (Name {namespace = "Gio", name = "IOStream"})
    Ptr Soup.URI.URI ->                     -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Soup", name = "WebsocketConnectionType"})
    CString ->                              -- origin : TBasicType TUTF8
    CString ->                              -- protocol : TBasicType TUTF8
    Ptr (GList (Ptr Soup.WebsocketExtension.WebsocketExtension)) -> -- extensions : TGList (TInterface (Name {namespace = "Soup", name = "WebsocketExtension"}))
    IO (Ptr WebsocketConnection)

-- | Creates a t'GI.Soup.Objects.WebsocketConnection.WebsocketConnection' on /@stream@/ with the given active /@extensions@/.
-- This should be called after completing the handshake to begin using the WebSocket
-- protocol.
-- 
-- /Since: 2.68/
websocketConnectionNewWithExtensions ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.IOStream.IsIOStream a, Soup.WebsocketExtension.IsWebsocketExtension b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.IOStream.IOStream' connected to the WebSocket server
    -> Soup.URI.URI
    -- ^ /@uri@/: the URI of the connection
    -> Soup.Enums.WebsocketConnectionType
    -- ^ /@type@/: the type of connection (client\/side)
    -> Maybe (T.Text)
    -- ^ /@origin@/: the Origin of the client
    -> Maybe (T.Text)
    -- ^ /@protocol@/: the subprotocol in use
    -> [b]
    -- ^ /@extensions@/: a t'GI.GLib.Structs.List.List' of t'GI.Soup.Objects.WebsocketExtension.WebsocketExtension' objects
    -> m WebsocketConnection
    -- ^ __Returns:__ a new t'GI.Soup.Objects.WebsocketConnection.WebsocketConnection'
websocketConnectionNewWithExtensions :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsIOStream a, IsWebsocketExtension b) =>
a
-> URI
-> WebsocketConnectionType
-> Maybe Text
-> Maybe Text
-> [b]
-> m WebsocketConnection
websocketConnectionNewWithExtensions a
stream URI
uri WebsocketConnectionType
type_ Maybe Text
origin Maybe Text
protocol [b]
extensions = IO WebsocketConnection -> m WebsocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebsocketConnection -> m WebsocketConnection)
-> IO WebsocketConnection -> m WebsocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOStream
stream' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (WebsocketConnectionType -> Int)
-> WebsocketConnectionType
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebsocketConnectionType -> Int
forall a. Enum a => a -> Int
fromEnum) WebsocketConnectionType
type_
    Ptr CChar
maybeOrigin <- case Maybe Text
origin of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jOrigin'
    Ptr CChar
maybeProtocol <- case Maybe Text
protocol of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jProtocol -> do
            Ptr CChar
jProtocol' <- Text -> IO (Ptr CChar)
textToCString Text
jProtocol
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jProtocol'
    [Ptr WebsocketExtension]
extensions' <- (b -> IO (Ptr WebsocketExtension))
-> [b] -> IO [Ptr WebsocketExtension]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM b -> IO (Ptr WebsocketExtension)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject [b]
extensions
    Ptr (GList (Ptr WebsocketExtension))
extensions'' <- [Ptr WebsocketExtension]
-> IO (Ptr (GList (Ptr WebsocketExtension)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr WebsocketExtension]
extensions'
    Ptr WebsocketConnection
result <- Ptr IOStream
-> Ptr URI
-> CUInt
-> Ptr CChar
-> Ptr CChar
-> Ptr (GList (Ptr WebsocketExtension))
-> IO (Ptr WebsocketConnection)
soup_websocket_connection_new_with_extensions Ptr IOStream
stream' Ptr URI
uri' CUInt
type_' Ptr CChar
maybeOrigin Ptr CChar
maybeProtocol Ptr (GList (Ptr WebsocketExtension))
extensions''
    Text -> Ptr WebsocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"websocketConnectionNewWithExtensions" Ptr WebsocketConnection
result
    WebsocketConnection
result' <- ((ManagedPtr WebsocketConnection -> WebsocketConnection)
-> Ptr WebsocketConnection -> IO WebsocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr WebsocketConnection -> WebsocketConnection
WebsocketConnection) Ptr WebsocketConnection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    (b -> IO ()) -> [b] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [b]
extensions
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeOrigin
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeProtocol
    WebsocketConnection -> IO WebsocketConnection
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketConnection
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method WebsocketConnection::close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "WebsocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the WebSocket" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "code"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "close code" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "close data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_websocket_connection_close" soup_websocket_connection_close :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    Word16 ->                               -- code : TBasicType TUInt16
    CString ->                              -- data : TBasicType TUTF8
    IO ()

-- | Close the connection in an orderly fashion.
-- 
-- Note that until the [closed]("GI.Soup.Objects.WebsocketConnection#g:signal:closed") signal fires, the connection
-- is not yet completely closed. The close message is not even sent until the
-- main loop runs.
-- 
-- The /@code@/ and /@data@/ are sent to the peer along with the close request.
-- If /@code@/ is 'GI.Soup.Enums.WebsocketCloseCodeNoStatus' a close message with no body
-- (without code and data) is sent.
-- Note that the /@data@/ must be UTF-8 valid.
-- 
-- /Since: 2.50/
websocketConnectionClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> Word16
    -- ^ /@code@/: close code
    -> Maybe (T.Text)
    -- ^ /@data@/: close data
    -> m ()
websocketConnectionClose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> Word16 -> Maybe Text -> m ()
websocketConnectionClose a
self Word16
code Maybe Text
data_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
maybeData_ <- case Maybe Text
data_ of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jData_ -> do
            Ptr CChar
jData_' <- Text -> IO (Ptr CChar)
textToCString Text
jData_
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jData_'
    Ptr WebsocketConnection -> Word16 -> Ptr CChar -> IO ()
soup_websocket_connection_close Ptr WebsocketConnection
self' Word16
code Ptr CChar
maybeData_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeData_
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionCloseMethodInfo
instance (signature ~ (Word16 -> Maybe (T.Text) -> m ()), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionCloseMethodInfo a signature where
    overloadedMethod = websocketConnectionClose

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


#endif

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

foreign import ccall "soup_websocket_connection_get_close_code" soup_websocket_connection_get_close_code :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO Word16

-- | Get the close code received from the WebSocket peer.
-- 
-- This only becomes valid once the WebSocket is in the
-- 'GI.Soup.Enums.WebsocketStateClosed' state. The value will often be in the
-- t'GI.Soup.Enums.WebsocketCloseCode' enumeration, but may also be an application
-- defined close code.
-- 
-- /Since: 2.50/
websocketConnectionGetCloseCode ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m Word16
    -- ^ __Returns:__ the close code or zero.
websocketConnectionGetCloseCode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m Word16
websocketConnectionGetCloseCode a
self = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word16
result <- Ptr WebsocketConnection -> IO Word16
soup_websocket_connection_get_close_code Ptr WebsocketConnection
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionGetCloseCodeMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionGetCloseCodeMethodInfo a signature where
    overloadedMethod = websocketConnectionGetCloseCode

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


#endif

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

foreign import ccall "soup_websocket_connection_get_close_data" soup_websocket_connection_get_close_data :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO CString

-- | Get the close data received from the WebSocket peer.
-- 
-- This only becomes valid once the WebSocket is in the
-- 'GI.Soup.Enums.WebsocketStateClosed' state. The data may be freed once
-- the main loop is run, so copy it if you need to keep it around.
-- 
-- /Since: 2.50/
websocketConnectionGetCloseData ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m T.Text
    -- ^ __Returns:__ the close data or 'P.Nothing'
websocketConnectionGetCloseData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m Text
websocketConnectionGetCloseData a
self = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr WebsocketConnection -> IO (Ptr CChar)
soup_websocket_connection_get_close_data Ptr WebsocketConnection
self'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"websocketConnectionGetCloseData" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionGetCloseDataMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionGetCloseDataMethodInfo a signature where
    overloadedMethod = websocketConnectionGetCloseData

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


#endif

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

foreign import ccall "soup_websocket_connection_get_connection_type" soup_websocket_connection_get_connection_type :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO CUInt

-- | Get the connection type (client\/server) of the connection.
-- 
-- /Since: 2.50/
websocketConnectionGetConnectionType ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m Soup.Enums.WebsocketConnectionType
    -- ^ __Returns:__ the connection type
websocketConnectionGetConnectionType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m WebsocketConnectionType
websocketConnectionGetConnectionType a
self = IO WebsocketConnectionType -> m WebsocketConnectionType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebsocketConnectionType -> m WebsocketConnectionType)
-> IO WebsocketConnectionType -> m WebsocketConnectionType
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr WebsocketConnection -> IO CUInt
soup_websocket_connection_get_connection_type Ptr WebsocketConnection
self'
    let result' :: WebsocketConnectionType
result' = (Int -> WebsocketConnectionType
forall a. Enum a => Int -> a
toEnum (Int -> WebsocketConnectionType)
-> (CUInt -> Int) -> CUInt -> WebsocketConnectionType
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
self
    WebsocketConnectionType -> IO WebsocketConnectionType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketConnectionType
result'

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionGetConnectionTypeMethodInfo
instance (signature ~ (m Soup.Enums.WebsocketConnectionType), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionGetConnectionTypeMethodInfo a signature where
    overloadedMethod = websocketConnectionGetConnectionType

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


#endif

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

foreign import ccall "soup_websocket_connection_get_extensions" soup_websocket_connection_get_extensions :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO (Ptr (GList (Ptr Soup.WebsocketExtension.WebsocketExtension)))

-- | Get the extensions chosen via negotiation with the peer.
-- 
-- /Since: 2.68/
websocketConnectionGetExtensions ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m [Soup.WebsocketExtension.WebsocketExtension]
    -- ^ __Returns:__ a t'GI.GLib.Structs.List.List' of t'GI.Soup.Objects.WebsocketExtension.WebsocketExtension' objects
websocketConnectionGetExtensions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m [WebsocketExtension]
websocketConnectionGetExtensions a
self = IO [WebsocketExtension] -> m [WebsocketExtension]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [WebsocketExtension] -> m [WebsocketExtension])
-> IO [WebsocketExtension] -> m [WebsocketExtension]
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr (GList (Ptr WebsocketExtension))
result <- Ptr WebsocketConnection
-> IO (Ptr (GList (Ptr WebsocketExtension)))
soup_websocket_connection_get_extensions Ptr WebsocketConnection
self'
    [Ptr WebsocketExtension]
result' <- Ptr (GList (Ptr WebsocketExtension)) -> IO [Ptr WebsocketExtension]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr WebsocketExtension))
result
    [WebsocketExtension]
result'' <- (Ptr WebsocketExtension -> IO WebsocketExtension)
-> [Ptr WebsocketExtension] -> IO [WebsocketExtension]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr WebsocketExtension -> WebsocketExtension)
-> Ptr WebsocketExtension -> IO WebsocketExtension
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr WebsocketExtension -> WebsocketExtension
Soup.WebsocketExtension.WebsocketExtension) [Ptr WebsocketExtension]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [WebsocketExtension] -> IO [WebsocketExtension]
forall (m :: * -> *) a. Monad m => a -> m a
return [WebsocketExtension]
result''

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionGetExtensionsMethodInfo
instance (signature ~ (m [Soup.WebsocketExtension.WebsocketExtension]), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionGetExtensionsMethodInfo a signature where
    overloadedMethod = websocketConnectionGetExtensions

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


#endif

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

foreign import ccall "soup_websocket_connection_get_io_stream" soup_websocket_connection_get_io_stream :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO (Ptr Gio.IOStream.IOStream)

-- | Get the I\/O stream the WebSocket is communicating over.
-- 
-- /Since: 2.50/
websocketConnectionGetIoStream ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m Gio.IOStream.IOStream
    -- ^ __Returns:__ the WebSocket\'s I\/O stream.
websocketConnectionGetIoStream :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m IOStream
websocketConnectionGetIoStream a
self = IO IOStream -> m IOStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOStream -> m IOStream) -> IO IOStream -> m IOStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr IOStream
result <- Ptr WebsocketConnection -> IO (Ptr IOStream)
soup_websocket_connection_get_io_stream Ptr WebsocketConnection
self'
    Text -> Ptr IOStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"websocketConnectionGetIoStream" Ptr IOStream
result
    IOStream
result' <- ((ManagedPtr IOStream -> IOStream) -> Ptr IOStream -> IO IOStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr IOStream -> IOStream
Gio.IOStream.IOStream) Ptr IOStream
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    IOStream -> IO IOStream
forall (m :: * -> *) a. Monad m => a -> m a
return IOStream
result'

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionGetIoStreamMethodInfo
instance (signature ~ (m Gio.IOStream.IOStream), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionGetIoStreamMethodInfo a signature where
    overloadedMethod = websocketConnectionGetIoStream

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


#endif

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

foreign import ccall "soup_websocket_connection_get_keepalive_interval" soup_websocket_connection_get_keepalive_interval :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO Word32

-- | Gets the keepalive interval in seconds or 0 if disabled.
-- 
-- /Since: 2.58/
websocketConnectionGetKeepaliveInterval ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m Word32
    -- ^ __Returns:__ the keepalive interval.
websocketConnectionGetKeepaliveInterval :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m Word32
websocketConnectionGetKeepaliveInterval a
self = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr WebsocketConnection -> IO Word32
soup_websocket_connection_get_keepalive_interval Ptr WebsocketConnection
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionGetKeepaliveIntervalMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionGetKeepaliveIntervalMethodInfo a signature where
    overloadedMethod = websocketConnectionGetKeepaliveInterval

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


#endif

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

foreign import ccall "soup_websocket_connection_get_max_incoming_payload_size" soup_websocket_connection_get_max_incoming_payload_size :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO Word64

-- | Gets the maximum payload size allowed for incoming packets.
-- 
-- /Since: 2.56/
websocketConnectionGetMaxIncomingPayloadSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m Word64
    -- ^ __Returns:__ the maximum payload size.
websocketConnectionGetMaxIncomingPayloadSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m Word64
websocketConnectionGetMaxIncomingPayloadSize a
self = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word64
result <- Ptr WebsocketConnection -> IO Word64
soup_websocket_connection_get_max_incoming_payload_size Ptr WebsocketConnection
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionGetMaxIncomingPayloadSizeMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionGetMaxIncomingPayloadSizeMethodInfo a signature where
    overloadedMethod = websocketConnectionGetMaxIncomingPayloadSize

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


#endif

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

foreign import ccall "soup_websocket_connection_get_origin" soup_websocket_connection_get_origin :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO CString

-- | Get the origin of the WebSocket.
-- 
-- /Since: 2.50/
websocketConnectionGetOrigin ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the origin, or 'P.Nothing'
websocketConnectionGetOrigin :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m (Maybe Text)
websocketConnectionGetOrigin a
self = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr WebsocketConnection -> IO (Ptr CChar)
soup_websocket_connection_get_origin Ptr WebsocketConnection
self'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

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


#endif

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

foreign import ccall "soup_websocket_connection_get_protocol" soup_websocket_connection_get_protocol :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO CString

-- | Get the protocol chosen via negotiation with the peer.
-- 
-- /Since: 2.50/
websocketConnectionGetProtocol ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the chosen protocol, or 'P.Nothing'
websocketConnectionGetProtocol :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m (Maybe Text)
websocketConnectionGetProtocol a
self = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr WebsocketConnection -> IO (Ptr CChar)
soup_websocket_connection_get_protocol Ptr WebsocketConnection
self'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

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


#endif

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

foreign import ccall "soup_websocket_connection_get_state" soup_websocket_connection_get_state :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO CUInt

-- | Get the current state of the WebSocket.
-- 
-- /Since: 2.50/
websocketConnectionGetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m Soup.Enums.WebsocketState
    -- ^ __Returns:__ the state
websocketConnectionGetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m WebsocketState
websocketConnectionGetState a
self = IO WebsocketState -> m WebsocketState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebsocketState -> m WebsocketState)
-> IO WebsocketState -> m WebsocketState
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr WebsocketConnection -> IO CUInt
soup_websocket_connection_get_state Ptr WebsocketConnection
self'
    let result' :: WebsocketState
result' = (Int -> WebsocketState
forall a. Enum a => Int -> a
toEnum (Int -> WebsocketState)
-> (CUInt -> Int) -> CUInt -> WebsocketState
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
self
    WebsocketState -> IO WebsocketState
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketState
result'

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionGetStateMethodInfo
instance (signature ~ (m Soup.Enums.WebsocketState), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionGetStateMethodInfo a signature where
    overloadedMethod = websocketConnectionGetState

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


#endif

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

foreign import ccall "soup_websocket_connection_get_uri" soup_websocket_connection_get_uri :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    IO (Ptr Soup.URI.URI)

-- | Get the URI of the WebSocket.
-- 
-- For servers this represents the address of the WebSocket, and
-- for clients it is the address connected to.
-- 
-- /Since: 2.50/
websocketConnectionGetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> m Soup.URI.URI
    -- ^ __Returns:__ the URI
websocketConnectionGetUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> m URI
websocketConnectionGetUri a
self = IO URI -> m URI
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 WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr URI
result <- Ptr WebsocketConnection -> IO (Ptr URI)
soup_websocket_connection_get_uri Ptr WebsocketConnection
self'
    Text -> Ptr URI -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"websocketConnectionGetUri" Ptr URI
result
    URI
result' <- ((ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr URI -> URI
Soup.URI.URI) Ptr URI
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    URI -> IO URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI
result'

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionGetUriMethodInfo
instance (signature ~ (m Soup.URI.URI), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionGetUriMethodInfo a signature where
    overloadedMethod = websocketConnectionGetUri

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


#endif

-- method WebsocketConnection::send_binary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "WebsocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the WebSocket" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message contents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of @data"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_websocket_connection_send_binary" soup_websocket_connection_send_binary :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    Ptr Word8 ->                            -- data : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    IO ()

-- | Send a binary message to the peer. If /@length@/ is 0, /@data@/ may be 'P.Nothing'.
-- 
-- The message is queued to be sent and will be sent when the main loop
-- is run.
-- 
-- /Since: 2.50/
websocketConnectionSendBinary ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> Maybe (ByteString)
    -- ^ /@data@/: the message contents
    -> m ()
websocketConnectionSendBinary :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> Maybe ByteString -> m ()
websocketConnectionSendBinary a
self Maybe ByteString
data_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let length_ :: Word64
length_ = case Maybe ByteString
data_ of
            Maybe ByteString
Nothing -> Word64
0
            Just ByteString
jData_ -> Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
jData_
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Word8
maybeData_ <- case Maybe ByteString
data_ of
        Maybe ByteString
Nothing -> Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
forall a. Ptr a
nullPtr
        Just ByteString
jData_ -> do
            Ptr Word8
jData_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
jData_
            Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
jData_'
    Ptr WebsocketConnection -> Ptr Word8 -> Word64 -> IO ()
soup_websocket_connection_send_binary Ptr WebsocketConnection
self' Ptr Word8
maybeData_ Word64
length_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
maybeData_
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionSendBinaryMethodInfo
instance (signature ~ (Maybe (ByteString) -> m ()), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionSendBinaryMethodInfo a signature where
    overloadedMethod = websocketConnectionSendBinary

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


#endif

-- method WebsocketConnection::send_message
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "WebsocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the WebSocket" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "WebsocketDataType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of message contents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "message"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message data as #GBytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_websocket_connection_send_message" soup_websocket_connection_send_message :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Soup", name = "WebsocketDataType"})
    Ptr GLib.Bytes.Bytes ->                 -- message : TInterface (Name {namespace = "GLib", name = "Bytes"})
    IO ()

-- | Send a message of the given /@type@/ to the peer. Note that this method,
-- allows to send text messages containing 'P.Nothing' characters.
-- 
-- The message is queued to be sent and will be sent when the main loop
-- is run.
-- 
-- /Since: 2.68/
websocketConnectionSendMessage ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> Soup.Enums.WebsocketDataType
    -- ^ /@type@/: the type of message contents
    -> GLib.Bytes.Bytes
    -- ^ /@message@/: the message data as t'GI.GLib.Structs.Bytes.Bytes'
    -> m ()
websocketConnectionSendMessage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> WebsocketDataType -> Bytes -> m ()
websocketConnectionSendMessage a
self WebsocketDataType
type_ Bytes
message = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (WebsocketDataType -> Int) -> WebsocketDataType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebsocketDataType -> Int
forall a. Enum a => a -> Int
fromEnum) WebsocketDataType
type_
    Ptr Bytes
message' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
message
    Ptr WebsocketConnection -> CUInt -> Ptr Bytes -> IO ()
soup_websocket_connection_send_message Ptr WebsocketConnection
self' CUInt
type_' Ptr Bytes
message'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
message
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionSendMessageMethodInfo
instance (signature ~ (Soup.Enums.WebsocketDataType -> GLib.Bytes.Bytes -> m ()), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionSendMessageMethodInfo a signature where
    overloadedMethod = websocketConnectionSendMessage

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


#endif

-- method WebsocketConnection::send_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "WebsocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the WebSocket" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message contents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_websocket_connection_send_text" soup_websocket_connection_send_text :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    CString ->                              -- text : TBasicType TUTF8
    IO ()

-- | Send a 'P.Nothing'-terminated text (UTF-8) message to the peer. If you need
-- to send text messages containing 'P.Nothing' characters use
-- 'GI.Soup.Objects.WebsocketConnection.websocketConnectionSendMessage' instead.
-- 
-- The message is queued to be sent and will be sent when the main loop
-- is run.
-- 
-- /Since: 2.50/
websocketConnectionSendText ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> T.Text
    -- ^ /@text@/: the message contents
    -> m ()
websocketConnectionSendText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> Text -> m ()
websocketConnectionSendText a
self Text
text = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
text' <- Text -> IO (Ptr CChar)
textToCString Text
text
    Ptr WebsocketConnection -> Ptr CChar -> IO ()
soup_websocket_connection_send_text Ptr WebsocketConnection
self' Ptr CChar
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
text'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method WebsocketConnection::set_keepalive_interval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "WebsocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the WebSocket" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the interval to send a ping message or 0 to disable it"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_websocket_connection_set_keepalive_interval" soup_websocket_connection_set_keepalive_interval :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    Word32 ->                               -- interval : TBasicType TUInt
    IO ()

-- | Sets the interval in seconds on when to send a ping message which will serve
-- as a keepalive message. If set to 0 the keepalive message is disabled.
-- 
-- /Since: 2.58/
websocketConnectionSetKeepaliveInterval ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> Word32
    -- ^ /@interval@/: the interval to send a ping message or 0 to disable it
    -> m ()
websocketConnectionSetKeepaliveInterval :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> Word32 -> m ()
websocketConnectionSetKeepaliveInterval a
self Word32
interval = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr WebsocketConnection -> Word32 -> IO ()
soup_websocket_connection_set_keepalive_interval Ptr WebsocketConnection
self' Word32
interval
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionSetKeepaliveIntervalMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionSetKeepaliveIntervalMethodInfo a signature where
    overloadedMethod = websocketConnectionSetKeepaliveInterval

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


#endif

-- method WebsocketConnection::set_max_incoming_payload_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "WebsocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the WebSocket" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_incoming_payload_size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the maximum payload size"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_websocket_connection_set_max_incoming_payload_size" soup_websocket_connection_set_max_incoming_payload_size :: 
    Ptr WebsocketConnection ->              -- self : TInterface (Name {namespace = "Soup", name = "WebsocketConnection"})
    Word64 ->                               -- max_incoming_payload_size : TBasicType TUInt64
    IO ()

-- | Sets the maximum payload size allowed for incoming packets. It
-- does not limit the outgoing packet size.
-- 
-- /Since: 2.56/
websocketConnectionSetMaxIncomingPayloadSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebsocketConnection a) =>
    a
    -- ^ /@self@/: the WebSocket
    -> Word64
    -- ^ /@maxIncomingPayloadSize@/: the maximum payload size
    -> m ()
websocketConnectionSetMaxIncomingPayloadSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebsocketConnection a) =>
a -> Word64 -> m ()
websocketConnectionSetMaxIncomingPayloadSize a
self Word64
maxIncomingPayloadSize = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsocketConnection
self' <- a -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr WebsocketConnection -> Word64 -> IO ()
soup_websocket_connection_set_max_incoming_payload_size Ptr WebsocketConnection
self' Word64
maxIncomingPayloadSize
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebsocketConnectionSetMaxIncomingPayloadSizeMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsWebsocketConnection a) => O.OverloadedMethod WebsocketConnectionSetMaxIncomingPayloadSizeMethodInfo a signature where
    overloadedMethod = websocketConnectionSetMaxIncomingPayloadSize

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


#endif