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

module GI.Soup.Objects.WebsocketConnection
    ( 

-- * Exported types
    WebsocketConnection(..)                 ,
    WebsocketConnectionK                    ,
    toWebsocketConnection                   ,
    noWebsocketConnection                   ,


 -- * Methods
-- ** websocketConnectionClose
    websocketConnectionClose                ,


-- ** websocketConnectionGetCloseCode
    websocketConnectionGetCloseCode         ,


-- ** websocketConnectionGetCloseData
    websocketConnectionGetCloseData         ,


-- ** websocketConnectionGetConnectionType
    websocketConnectionGetConnectionType    ,


-- ** websocketConnectionGetIoStream
    websocketConnectionGetIoStream          ,


-- ** websocketConnectionGetOrigin
    websocketConnectionGetOrigin            ,


-- ** websocketConnectionGetProtocol
    websocketConnectionGetProtocol          ,


-- ** websocketConnectionGetState
    websocketConnectionGetState             ,


-- ** websocketConnectionGetUri
    websocketConnectionGetUri               ,


-- ** websocketConnectionNew
    websocketConnectionNew                  ,


-- ** websocketConnectionSendBinary
    websocketConnectionSendBinary           ,


-- ** websocketConnectionSendText
    websocketConnectionSendText             ,




 -- * Properties
-- ** ConnectionType
    WebsocketConnectionConnectionTypePropertyInfo,
    constructWebsocketConnectionConnectionType,
    getWebsocketConnectionConnectionType    ,


-- ** IoStream
    WebsocketConnectionIoStreamPropertyInfo ,
    constructWebsocketConnectionIoStream    ,
    getWebsocketConnectionIoStream          ,


-- ** Origin
    WebsocketConnectionOriginPropertyInfo   ,
    constructWebsocketConnectionOrigin      ,
    getWebsocketConnectionOrigin            ,


-- ** Protocol
    WebsocketConnectionProtocolPropertyInfo ,
    constructWebsocketConnectionProtocol    ,
    getWebsocketConnectionProtocol          ,


-- ** State
    WebsocketConnectionStatePropertyInfo    ,
    getWebsocketConnectionState             ,


-- ** Uri
    WebsocketConnectionUriPropertyInfo      ,
    constructWebsocketConnectionUri         ,
    getWebsocketConnectionUri               ,




 -- * Signals
-- ** Closed
    WebsocketConnectionClosedCallback       ,
    WebsocketConnectionClosedCallbackC      ,
    WebsocketConnectionClosedSignalInfo     ,
    afterWebsocketConnectionClosed          ,
    mkWebsocketConnectionClosedCallback     ,
    noWebsocketConnectionClosedCallback     ,
    onWebsocketConnectionClosed             ,
    websocketConnectionClosedCallbackWrapper,
    websocketConnectionClosedClosure        ,


-- ** Closing
    WebsocketConnectionClosingCallback      ,
    WebsocketConnectionClosingCallbackC     ,
    WebsocketConnectionClosingSignalInfo    ,
    afterWebsocketConnectionClosing         ,
    mkWebsocketConnectionClosingCallback    ,
    noWebsocketConnectionClosingCallback    ,
    onWebsocketConnectionClosing            ,
    websocketConnectionClosingCallbackWrapper,
    websocketConnectionClosingClosure       ,


-- ** Error
    WebsocketConnectionErrorCallback        ,
    WebsocketConnectionErrorCallbackC       ,
    WebsocketConnectionErrorSignalInfo      ,
    afterWebsocketConnectionError           ,
    mkWebsocketConnectionErrorCallback      ,
    noWebsocketConnectionErrorCallback      ,
    onWebsocketConnectionError              ,
    websocketConnectionErrorCallbackWrapper ,
    websocketConnectionErrorClosure         ,


-- ** Message
    WebsocketConnectionMessageCallback      ,
    WebsocketConnectionMessageCallbackC     ,
    WebsocketConnectionMessageSignalInfo    ,
    afterWebsocketConnectionMessage         ,
    mkWebsocketConnectionMessageCallback    ,
    noWebsocketConnectionMessageCallback    ,
    onWebsocketConnectionMessage            ,
    websocketConnectionMessageCallbackWrapper,
    websocketConnectionMessageClosure       ,




    ) where

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

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

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

newtype WebsocketConnection = WebsocketConnection (ForeignPtr WebsocketConnection)
foreign import ccall "soup_websocket_connection_get_type"
    c_soup_websocket_connection_get_type :: IO GType

type instance ParentTypes WebsocketConnection = WebsocketConnectionParentTypes
type WebsocketConnectionParentTypes = '[GObject.Object]

instance GObject WebsocketConnection where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_soup_websocket_connection_get_type
    

class GObject o => WebsocketConnectionK o
instance (GObject o, IsDescendantOf WebsocketConnection o) => WebsocketConnectionK o

toWebsocketConnection :: WebsocketConnectionK o => o -> IO WebsocketConnection
toWebsocketConnection = unsafeCastTo WebsocketConnection

noWebsocketConnection :: Maybe WebsocketConnection
noWebsocketConnection = Nothing

-- signal WebsocketConnection::closed
type WebsocketConnectionClosedCallback =
    IO ()

noWebsocketConnectionClosedCallback :: Maybe WebsocketConnectionClosedCallback
noWebsocketConnectionClosedCallback = Nothing

type WebsocketConnectionClosedCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkWebsocketConnectionClosedCallback :: WebsocketConnectionClosedCallbackC -> IO (FunPtr WebsocketConnectionClosedCallbackC)

websocketConnectionClosedClosure :: WebsocketConnectionClosedCallback -> IO Closure
websocketConnectionClosedClosure cb = newCClosure =<< mkWebsocketConnectionClosedCallback wrapped
    where wrapped = websocketConnectionClosedCallbackWrapper cb

websocketConnectionClosedCallbackWrapper ::
    WebsocketConnectionClosedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
websocketConnectionClosedCallbackWrapper _cb _ _ = do
    _cb 

onWebsocketConnectionClosed :: (GObject a, MonadIO m) => a -> WebsocketConnectionClosedCallback -> m SignalHandlerId
onWebsocketConnectionClosed obj cb = liftIO $ connectWebsocketConnectionClosed obj cb SignalConnectBefore
afterWebsocketConnectionClosed :: (GObject a, MonadIO m) => a -> WebsocketConnectionClosedCallback -> m SignalHandlerId
afterWebsocketConnectionClosed obj cb = connectWebsocketConnectionClosed obj cb SignalConnectAfter

connectWebsocketConnectionClosed :: (GObject a, MonadIO m) =>
                                    a -> WebsocketConnectionClosedCallback -> SignalConnectMode -> m SignalHandlerId
connectWebsocketConnectionClosed obj cb after = liftIO $ do
    cb' <- mkWebsocketConnectionClosedCallback (websocketConnectionClosedCallbackWrapper cb)
    connectSignalFunPtr obj "closed" cb' after

-- signal WebsocketConnection::closing
type WebsocketConnectionClosingCallback =
    IO ()

noWebsocketConnectionClosingCallback :: Maybe WebsocketConnectionClosingCallback
noWebsocketConnectionClosingCallback = Nothing

type WebsocketConnectionClosingCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkWebsocketConnectionClosingCallback :: WebsocketConnectionClosingCallbackC -> IO (FunPtr WebsocketConnectionClosingCallbackC)

websocketConnectionClosingClosure :: WebsocketConnectionClosingCallback -> IO Closure
websocketConnectionClosingClosure cb = newCClosure =<< mkWebsocketConnectionClosingCallback wrapped
    where wrapped = websocketConnectionClosingCallbackWrapper cb

websocketConnectionClosingCallbackWrapper ::
    WebsocketConnectionClosingCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
websocketConnectionClosingCallbackWrapper _cb _ _ = do
    _cb 

onWebsocketConnectionClosing :: (GObject a, MonadIO m) => a -> WebsocketConnectionClosingCallback -> m SignalHandlerId
onWebsocketConnectionClosing obj cb = liftIO $ connectWebsocketConnectionClosing obj cb SignalConnectBefore
afterWebsocketConnectionClosing :: (GObject a, MonadIO m) => a -> WebsocketConnectionClosingCallback -> m SignalHandlerId
afterWebsocketConnectionClosing obj cb = connectWebsocketConnectionClosing obj cb SignalConnectAfter

connectWebsocketConnectionClosing :: (GObject a, MonadIO m) =>
                                     a -> WebsocketConnectionClosingCallback -> SignalConnectMode -> m SignalHandlerId
connectWebsocketConnectionClosing obj cb after = liftIO $ do
    cb' <- mkWebsocketConnectionClosingCallback (websocketConnectionClosingCallbackWrapper cb)
    connectSignalFunPtr obj "closing" cb' after

-- signal WebsocketConnection::error
type WebsocketConnectionErrorCallback =
    GError ->
    IO ()

noWebsocketConnectionErrorCallback :: Maybe WebsocketConnectionErrorCallback
noWebsocketConnectionErrorCallback = Nothing

type WebsocketConnectionErrorCallbackC =
    Ptr () ->                               -- object
    Ptr GError ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkWebsocketConnectionErrorCallback :: WebsocketConnectionErrorCallbackC -> IO (FunPtr WebsocketConnectionErrorCallbackC)

websocketConnectionErrorClosure :: WebsocketConnectionErrorCallback -> IO Closure
websocketConnectionErrorClosure cb = newCClosure =<< mkWebsocketConnectionErrorCallback wrapped
    where wrapped = websocketConnectionErrorCallbackWrapper cb

websocketConnectionErrorCallbackWrapper ::
    WebsocketConnectionErrorCallback ->
    Ptr () ->
    Ptr GError ->
    Ptr () ->
    IO ()
websocketConnectionErrorCallbackWrapper _cb _ error_ _ = do
    error_' <- (newBoxed GError) error_
    _cb  error_'

onWebsocketConnectionError :: (GObject a, MonadIO m) => a -> WebsocketConnectionErrorCallback -> m SignalHandlerId
onWebsocketConnectionError obj cb = liftIO $ connectWebsocketConnectionError obj cb SignalConnectBefore
afterWebsocketConnectionError :: (GObject a, MonadIO m) => a -> WebsocketConnectionErrorCallback -> m SignalHandlerId
afterWebsocketConnectionError obj cb = connectWebsocketConnectionError obj cb SignalConnectAfter

connectWebsocketConnectionError :: (GObject a, MonadIO m) =>
                                   a -> WebsocketConnectionErrorCallback -> SignalConnectMode -> m SignalHandlerId
connectWebsocketConnectionError obj cb after = liftIO $ do
    cb' <- mkWebsocketConnectionErrorCallback (websocketConnectionErrorCallbackWrapper cb)
    connectSignalFunPtr obj "error" cb' after

-- signal WebsocketConnection::message
type WebsocketConnectionMessageCallback =
    Int32 ->
    GLib.Bytes ->
    IO ()

noWebsocketConnectionMessageCallback :: Maybe WebsocketConnectionMessageCallback
noWebsocketConnectionMessageCallback = Nothing

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

foreign import ccall "wrapper"
    mkWebsocketConnectionMessageCallback :: WebsocketConnectionMessageCallbackC -> IO (FunPtr WebsocketConnectionMessageCallbackC)

websocketConnectionMessageClosure :: WebsocketConnectionMessageCallback -> IO Closure
websocketConnectionMessageClosure cb = newCClosure =<< mkWebsocketConnectionMessageCallback wrapped
    where wrapped = websocketConnectionMessageCallbackWrapper cb

websocketConnectionMessageCallbackWrapper ::
    WebsocketConnectionMessageCallback ->
    Ptr () ->
    Int32 ->
    Ptr GLib.Bytes ->
    Ptr () ->
    IO ()
websocketConnectionMessageCallbackWrapper _cb _ type_ message _ = do
    message' <- (newBoxed GLib.Bytes) message
    _cb  type_ message'

onWebsocketConnectionMessage :: (GObject a, MonadIO m) => a -> WebsocketConnectionMessageCallback -> m SignalHandlerId
onWebsocketConnectionMessage obj cb = liftIO $ connectWebsocketConnectionMessage obj cb SignalConnectBefore
afterWebsocketConnectionMessage :: (GObject a, MonadIO m) => a -> WebsocketConnectionMessageCallback -> m SignalHandlerId
afterWebsocketConnectionMessage obj cb = connectWebsocketConnectionMessage obj cb SignalConnectAfter

connectWebsocketConnectionMessage :: (GObject a, MonadIO m) =>
                                     a -> WebsocketConnectionMessageCallback -> SignalConnectMode -> m SignalHandlerId
connectWebsocketConnectionMessage obj cb after = liftIO $ do
    cb' <- mkWebsocketConnectionMessageCallback (websocketConnectionMessageCallbackWrapper cb)
    connectSignalFunPtr obj "message" cb' after

-- VVV Prop "connection-type"
   -- Type: TInterface "Soup" "WebsocketConnectionType"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getWebsocketConnectionConnectionType :: (MonadIO m, WebsocketConnectionK o) => o -> m WebsocketConnectionType
getWebsocketConnectionConnectionType obj = liftIO $ getObjectPropertyEnum obj "connection-type"

constructWebsocketConnectionConnectionType :: WebsocketConnectionType -> IO ([Char], GValue)
constructWebsocketConnectionConnectionType val = constructObjectPropertyEnum "connection-type" val

data WebsocketConnectionConnectionTypePropertyInfo
instance AttrInfo WebsocketConnectionConnectionTypePropertyInfo where
    type AttrAllowedOps WebsocketConnectionConnectionTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebsocketConnectionConnectionTypePropertyInfo = (~) WebsocketConnectionType
    type AttrBaseTypeConstraint WebsocketConnectionConnectionTypePropertyInfo = WebsocketConnectionK
    type AttrGetType WebsocketConnectionConnectionTypePropertyInfo = WebsocketConnectionType
    type AttrLabel WebsocketConnectionConnectionTypePropertyInfo = "WebsocketConnection::connection-type"
    attrGet _ = getWebsocketConnectionConnectionType
    attrSet _ = undefined
    attrConstruct _ = constructWebsocketConnectionConnectionType

-- VVV Prop "io-stream"
   -- Type: TInterface "Gio" "IOStream"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getWebsocketConnectionIoStream :: (MonadIO m, WebsocketConnectionK o) => o -> m Gio.IOStream
getWebsocketConnectionIoStream obj = liftIO $ getObjectPropertyObject obj "io-stream" Gio.IOStream

constructWebsocketConnectionIoStream :: (Gio.IOStreamK a) => a -> IO ([Char], GValue)
constructWebsocketConnectionIoStream val = constructObjectPropertyObject "io-stream" val

data WebsocketConnectionIoStreamPropertyInfo
instance AttrInfo WebsocketConnectionIoStreamPropertyInfo where
    type AttrAllowedOps WebsocketConnectionIoStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebsocketConnectionIoStreamPropertyInfo = Gio.IOStreamK
    type AttrBaseTypeConstraint WebsocketConnectionIoStreamPropertyInfo = WebsocketConnectionK
    type AttrGetType WebsocketConnectionIoStreamPropertyInfo = Gio.IOStream
    type AttrLabel WebsocketConnectionIoStreamPropertyInfo = "WebsocketConnection::io-stream"
    attrGet _ = getWebsocketConnectionIoStream
    attrSet _ = undefined
    attrConstruct _ = constructWebsocketConnectionIoStream

-- VVV Prop "origin"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getWebsocketConnectionOrigin :: (MonadIO m, WebsocketConnectionK o) => o -> m T.Text
getWebsocketConnectionOrigin obj = liftIO $ getObjectPropertyString obj "origin"

constructWebsocketConnectionOrigin :: T.Text -> IO ([Char], GValue)
constructWebsocketConnectionOrigin val = constructObjectPropertyString "origin" val

data WebsocketConnectionOriginPropertyInfo
instance AttrInfo WebsocketConnectionOriginPropertyInfo where
    type AttrAllowedOps WebsocketConnectionOriginPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebsocketConnectionOriginPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint WebsocketConnectionOriginPropertyInfo = WebsocketConnectionK
    type AttrGetType WebsocketConnectionOriginPropertyInfo = T.Text
    type AttrLabel WebsocketConnectionOriginPropertyInfo = "WebsocketConnection::origin"
    attrGet _ = getWebsocketConnectionOrigin
    attrSet _ = undefined
    attrConstruct _ = constructWebsocketConnectionOrigin

-- VVV Prop "protocol"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getWebsocketConnectionProtocol :: (MonadIO m, WebsocketConnectionK o) => o -> m T.Text
getWebsocketConnectionProtocol obj = liftIO $ getObjectPropertyString obj "protocol"

constructWebsocketConnectionProtocol :: T.Text -> IO ([Char], GValue)
constructWebsocketConnectionProtocol val = constructObjectPropertyString "protocol" val

data WebsocketConnectionProtocolPropertyInfo
instance AttrInfo WebsocketConnectionProtocolPropertyInfo where
    type AttrAllowedOps WebsocketConnectionProtocolPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebsocketConnectionProtocolPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint WebsocketConnectionProtocolPropertyInfo = WebsocketConnectionK
    type AttrGetType WebsocketConnectionProtocolPropertyInfo = T.Text
    type AttrLabel WebsocketConnectionProtocolPropertyInfo = "WebsocketConnection::protocol"
    attrGet _ = getWebsocketConnectionProtocol
    attrSet _ = undefined
    attrConstruct _ = constructWebsocketConnectionProtocol

-- VVV Prop "state"
   -- Type: TInterface "Soup" "WebsocketState"
   -- Flags: [PropertyReadable]

getWebsocketConnectionState :: (MonadIO m, WebsocketConnectionK o) => o -> m WebsocketState
getWebsocketConnectionState obj = liftIO $ getObjectPropertyEnum obj "state"

data WebsocketConnectionStatePropertyInfo
instance AttrInfo WebsocketConnectionStatePropertyInfo where
    type AttrAllowedOps WebsocketConnectionStatePropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint WebsocketConnectionStatePropertyInfo = (~) ()
    type AttrBaseTypeConstraint WebsocketConnectionStatePropertyInfo = WebsocketConnectionK
    type AttrGetType WebsocketConnectionStatePropertyInfo = WebsocketState
    type AttrLabel WebsocketConnectionStatePropertyInfo = "WebsocketConnection::state"
    attrGet _ = getWebsocketConnectionState
    attrSet _ = undefined
    attrConstruct _ = undefined

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

getWebsocketConnectionUri :: (MonadIO m, WebsocketConnectionK o) => o -> m URI
getWebsocketConnectionUri obj = liftIO $ getObjectPropertyBoxed obj "uri" URI

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

data WebsocketConnectionUriPropertyInfo
instance AttrInfo WebsocketConnectionUriPropertyInfo where
    type AttrAllowedOps WebsocketConnectionUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebsocketConnectionUriPropertyInfo = (~) URI
    type AttrBaseTypeConstraint WebsocketConnectionUriPropertyInfo = WebsocketConnectionK
    type AttrGetType WebsocketConnectionUriPropertyInfo = URI
    type AttrLabel WebsocketConnectionUriPropertyInfo = "WebsocketConnection::uri"
    attrGet _ = getWebsocketConnectionUri
    attrSet _ = undefined
    attrConstruct _ = constructWebsocketConnectionUri

type instance AttributeList WebsocketConnection = WebsocketConnectionAttributeList
type WebsocketConnectionAttributeList = ('[ '("connection-type", WebsocketConnectionConnectionTypePropertyInfo), '("io-stream", WebsocketConnectionIoStreamPropertyInfo), '("origin", WebsocketConnectionOriginPropertyInfo), '("protocol", WebsocketConnectionProtocolPropertyInfo), '("state", WebsocketConnectionStatePropertyInfo), '("uri", WebsocketConnectionUriPropertyInfo)] :: [(Symbol, *)])

data WebsocketConnectionClosedSignalInfo
instance SignalInfo WebsocketConnectionClosedSignalInfo where
    type HaskellCallbackType WebsocketConnectionClosedSignalInfo = WebsocketConnectionClosedCallback
    connectSignal _ = connectWebsocketConnectionClosed

data WebsocketConnectionClosingSignalInfo
instance SignalInfo WebsocketConnectionClosingSignalInfo where
    type HaskellCallbackType WebsocketConnectionClosingSignalInfo = WebsocketConnectionClosingCallback
    connectSignal _ = connectWebsocketConnectionClosing

data WebsocketConnectionErrorSignalInfo
instance SignalInfo WebsocketConnectionErrorSignalInfo where
    type HaskellCallbackType WebsocketConnectionErrorSignalInfo = WebsocketConnectionErrorCallback
    connectSignal _ = connectWebsocketConnectionError

data WebsocketConnectionMessageSignalInfo
instance SignalInfo WebsocketConnectionMessageSignalInfo where
    type HaskellCallbackType WebsocketConnectionMessageSignalInfo = WebsocketConnectionMessageCallback
    connectSignal _ = connectWebsocketConnectionMessage

type instance SignalList WebsocketConnection = WebsocketConnectionSignalList
type WebsocketConnectionSignalList = ('[ '("closed", WebsocketConnectionClosedSignalInfo), '("closing", WebsocketConnectionClosingSignalInfo), '("error", WebsocketConnectionErrorSignalInfo), '("message", WebsocketConnectionMessageSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method WebsocketConnection::new
-- method type : Constructor
-- Args : [Arg {argName = "stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TInterface "Soup" "URI", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Soup" "WebsocketConnectionType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "origin", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TInterface "Soup" "URI", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Soup" "WebsocketConnectionType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "origin", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Soup" "WebsocketConnection"
-- throws : False
-- Skip return : False

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


websocketConnectionNew ::
    (MonadIO m, Gio.IOStreamK a) =>
    a ->                                    -- stream
    URI ->                                  -- uri
    WebsocketConnectionType ->              -- type
    Maybe (T.Text) ->                       -- origin
    Maybe (T.Text) ->                       -- protocol
    m WebsocketConnection
websocketConnectionNew stream uri type_ origin protocol = liftIO $ do
    let stream' = unsafeManagedPtrCastPtr stream
    let uri' = unsafeManagedPtrGetPtr uri
    let type_' = (fromIntegral . fromEnum) type_
    maybeOrigin <- case origin of
        Nothing -> return nullPtr
        Just jOrigin -> do
            jOrigin' <- textToCString jOrigin
            return jOrigin'
    maybeProtocol <- case protocol of
        Nothing -> return nullPtr
        Just jProtocol -> do
            jProtocol' <- textToCString jProtocol
            return jProtocol'
    result <- soup_websocket_connection_new stream' uri' type_' maybeOrigin maybeProtocol
    checkUnexpectedReturnNULL "soup_websocket_connection_new" result
    result' <- (wrapObject WebsocketConnection) result
    touchManagedPtr stream
    touchManagedPtr uri
    freeMem maybeOrigin
    freeMem maybeProtocol
    return result'

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

foreign import ccall "soup_websocket_connection_close" soup_websocket_connection_close :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    Word16 ->                               -- code : TBasicType TUInt16
    CString ->                              -- data : TBasicType TUTF8
    IO ()


websocketConnectionClose ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    Word16 ->                               -- code
    Maybe (T.Text) ->                       -- data
    m ()
websocketConnectionClose _obj code data_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeData_ <- case data_ of
        Nothing -> return nullPtr
        Just jData_ -> do
            jData_' <- textToCString jData_
            return jData_'
    soup_websocket_connection_close _obj' code maybeData_
    touchManagedPtr _obj
    freeMem maybeData_
    return ()

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

foreign import ccall "soup_websocket_connection_get_close_code" soup_websocket_connection_get_close_code :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    IO Word16


websocketConnectionGetCloseCode ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    m Word16
websocketConnectionGetCloseCode _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- soup_websocket_connection_get_close_code _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "soup_websocket_connection_get_close_data" soup_websocket_connection_get_close_data :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    IO CString


websocketConnectionGetCloseData ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    m T.Text
websocketConnectionGetCloseData _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- soup_websocket_connection_get_close_data _obj'
    checkUnexpectedReturnNULL "soup_websocket_connection_get_close_data" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "soup_websocket_connection_get_connection_type" soup_websocket_connection_get_connection_type :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    IO CUInt


websocketConnectionGetConnectionType ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    m WebsocketConnectionType
websocketConnectionGetConnectionType _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- soup_websocket_connection_get_connection_type _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "soup_websocket_connection_get_io_stream" soup_websocket_connection_get_io_stream :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    IO (Ptr Gio.IOStream)


websocketConnectionGetIoStream ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    m Gio.IOStream
websocketConnectionGetIoStream _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- soup_websocket_connection_get_io_stream _obj'
    checkUnexpectedReturnNULL "soup_websocket_connection_get_io_stream" result
    result' <- (newObject Gio.IOStream) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "soup_websocket_connection_get_origin" soup_websocket_connection_get_origin :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    IO CString


websocketConnectionGetOrigin ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    m T.Text
websocketConnectionGetOrigin _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- soup_websocket_connection_get_origin _obj'
    checkUnexpectedReturnNULL "soup_websocket_connection_get_origin" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "soup_websocket_connection_get_protocol" soup_websocket_connection_get_protocol :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    IO CString


websocketConnectionGetProtocol ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    m T.Text
websocketConnectionGetProtocol _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- soup_websocket_connection_get_protocol _obj'
    checkUnexpectedReturnNULL "soup_websocket_connection_get_protocol" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "soup_websocket_connection_get_state" soup_websocket_connection_get_state :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    IO CUInt


websocketConnectionGetState ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    m WebsocketState
websocketConnectionGetState _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- soup_websocket_connection_get_state _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "soup_websocket_connection_get_uri" soup_websocket_connection_get_uri :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    IO (Ptr URI)


websocketConnectionGetUri ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    m URI
websocketConnectionGetUri _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- soup_websocket_connection_get_uri _obj'
    checkUnexpectedReturnNULL "soup_websocket_connection_get_uri" result
    result' <- (newBoxed URI) result
    touchManagedPtr _obj
    return result'

-- method WebsocketConnection::send_binary
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Soup" "WebsocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Soup" "WebsocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "soup_websocket_connection_send_binary" soup_websocket_connection_send_binary :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    Ptr Word8 ->                            -- data : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    IO ()


websocketConnectionSendBinary ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    ByteString ->                           -- data
    m ()
websocketConnectionSendBinary _obj data_ = liftIO $ do
    let length_ = fromIntegral $ B.length data_
    let _obj' = unsafeManagedPtrCastPtr _obj
    data_' <- packByteString data_
    soup_websocket_connection_send_binary _obj' data_' length_
    touchManagedPtr _obj
    freeMem data_'
    return ()

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

foreign import ccall "soup_websocket_connection_send_text" soup_websocket_connection_send_text :: 
    Ptr WebsocketConnection ->              -- _obj : TInterface "Soup" "WebsocketConnection"
    CString ->                              -- text : TBasicType TUTF8
    IO ()


websocketConnectionSendText ::
    (MonadIO m, WebsocketConnectionK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- text
    m ()
websocketConnectionSendText _obj text = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    text' <- textToCString text
    soup_websocket_connection_send_text _obj' text'
    touchManagedPtr _obj
    freeMem text'
    return ()