{- |
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.Socket
    ( 

-- * Exported types
    Socket(..)                              ,
    IsSocket                                ,
    toSocket                                ,
    noSocket                                ,


 -- * Methods
-- ** connectAsync #method:connectAsync#
    SocketConnectAsyncMethodInfo            ,
    socketConnectAsync                      ,


-- ** connectSync #method:connectSync#
    SocketConnectSyncMethodInfo             ,
    socketConnectSync                       ,


-- ** disconnect #method:disconnect#
    SocketDisconnectMethodInfo              ,
    socketDisconnect                        ,


-- ** getFd #method:getFd#
    SocketGetFdMethodInfo                   ,
    socketGetFd                             ,


-- ** getLocalAddress #method:getLocalAddress#
    SocketGetLocalAddressMethodInfo         ,
    socketGetLocalAddress                   ,


-- ** getRemoteAddress #method:getRemoteAddress#
    SocketGetRemoteAddressMethodInfo        ,
    socketGetRemoteAddress                  ,


-- ** isConnected #method:isConnected#
    SocketIsConnectedMethodInfo             ,
    socketIsConnected                       ,


-- ** isSsl #method:isSsl#
    SocketIsSslMethodInfo                   ,
    socketIsSsl                             ,


-- ** listen #method:listen#
    SocketListenMethodInfo                  ,
    socketListen                            ,


-- ** read #method:read#
    SocketReadMethodInfo                    ,
    socketRead                              ,


-- ** readUntil #method:readUntil#
    SocketReadUntilMethodInfo               ,
    socketReadUntil                         ,


-- ** startProxySsl #method:startProxySsl#
    SocketStartProxySslMethodInfo           ,
    socketStartProxySsl                     ,


-- ** startSsl #method:startSsl#
    SocketStartSslMethodInfo                ,
    socketStartSsl                          ,


-- ** write #method:write#
    SocketWriteMethodInfo                   ,
    socketWrite                             ,




 -- * Properties
-- ** asyncContext #attr:asyncContext#
    SocketAsyncContextPropertyInfo          ,
    constructSocketAsyncContext             ,
    getSocketAsyncContext                   ,
    socketAsyncContext                      ,


-- ** fd #attr:fd#
    SocketFdPropertyInfo                    ,
    constructSocketFd                       ,
    getSocketFd                             ,
    socketFd                                ,


-- ** gsocket #attr:gsocket#
    SocketGsocketPropertyInfo               ,
    constructSocketGsocket                  ,
    socketGsocket                           ,


-- ** iostream #attr:iostream#
    SocketIostreamPropertyInfo              ,
    constructSocketIostream                 ,
    socketIostream                          ,


-- ** ipv6Only #attr:ipv6Only#
    SocketIpv6OnlyPropertyInfo              ,
    constructSocketIpv6Only                 ,
    getSocketIpv6Only                       ,
    setSocketIpv6Only                       ,
    socketIpv6Only                          ,


-- ** isServer #attr:isServer#
    SocketIsServerPropertyInfo              ,
    getSocketIsServer                       ,
    socketIsServer                          ,


-- ** localAddress #attr:localAddress#
    SocketLocalAddressPropertyInfo          ,
    constructSocketLocalAddress             ,
    getSocketLocalAddress                   ,
    socketLocalAddress                      ,


-- ** nonBlocking #attr:nonBlocking#
    SocketNonBlockingPropertyInfo           ,
    constructSocketNonBlocking              ,
    getSocketNonBlocking                    ,
    setSocketNonBlocking                    ,
    socketNonBlocking                       ,


-- ** remoteAddress #attr:remoteAddress#
    SocketRemoteAddressPropertyInfo         ,
    constructSocketRemoteAddress            ,
    getSocketRemoteAddress                  ,
    socketRemoteAddress                     ,


-- ** sslCreds #attr:sslCreds#
    SocketSslCredsPropertyInfo              ,
    constructSocketSslCreds                 ,
    getSocketSslCreds                       ,
    setSocketSslCreds                       ,
    socketSslCreds                          ,


-- ** sslFallback #attr:sslFallback#
    SocketSslFallbackPropertyInfo           ,
    constructSocketSslFallback              ,
    getSocketSslFallback                    ,
    socketSslFallback                       ,


-- ** sslStrict #attr:sslStrict#
    SocketSslStrictPropertyInfo             ,
    constructSocketSslStrict                ,
    getSocketSslStrict                      ,
    socketSslStrict                         ,


-- ** timeout #attr:timeout#
    SocketTimeoutPropertyInfo               ,
    constructSocketTimeout                  ,
    getSocketTimeout                        ,
    setSocketTimeout                        ,
    socketTimeout                           ,


-- ** tlsCertificate #attr:tlsCertificate#
    SocketTlsCertificatePropertyInfo        ,
    getSocketTlsCertificate                 ,
    socketTlsCertificate                    ,


-- ** tlsErrors #attr:tlsErrors#
    SocketTlsErrorsPropertyInfo             ,
    getSocketTlsErrors                      ,
    socketTlsErrors                         ,


-- ** trustedCertificate #attr:trustedCertificate#
    SocketTrustedCertificatePropertyInfo    ,
    getSocketTrustedCertificate             ,
    socketTrustedCertificate                ,


-- ** useThreadContext #attr:useThreadContext#
    SocketUseThreadContextPropertyInfo      ,
    constructSocketUseThreadContext         ,
    getSocketUseThreadContext               ,
    socketUseThreadContext                  ,




 -- * Signals
-- ** disconnected #signal:disconnected#
    C_SocketDisconnectedCallback            ,
    SocketDisconnectedCallback              ,
    SocketDisconnectedSignalInfo            ,
    afterSocketDisconnected                 ,
    genClosure_SocketDisconnected           ,
    mk_SocketDisconnectedCallback           ,
    noSocketDisconnectedCallback            ,
    onSocketDisconnected                    ,
    wrap_SocketDisconnectedCallback         ,


-- ** event #signal:event#
    C_SocketEventCallback                   ,
    SocketEventCallback                     ,
    SocketEventSignalInfo                   ,
    afterSocketEvent                        ,
    genClosure_SocketEvent                  ,
    mk_SocketEventCallback                  ,
    noSocketEventCallback                   ,
    onSocketEvent                           ,
    wrap_SocketEventCallback                ,


-- ** newConnection #signal:newConnection#
    C_SocketNewConnectionCallback           ,
    SocketNewConnectionCallback             ,
    SocketNewConnectionSignalInfo           ,
    afterSocketNewConnection                ,
    genClosure_SocketNewConnection          ,
    mk_SocketNewConnectionCallback          ,
    noSocketNewConnectionCallback           ,
    onSocketNewConnection                   ,
    wrap_SocketNewConnectionCallback        ,


-- ** readable #signal:readable#
    C_SocketReadableCallback                ,
    SocketReadableCallback                  ,
    SocketReadableSignalInfo                ,
    afterSocketReadable                     ,
    genClosure_SocketReadable               ,
    mk_SocketReadableCallback               ,
    noSocketReadableCallback                ,
    onSocketReadable                        ,
    wrap_SocketReadableCallback             ,


-- ** writable #signal:writable#
    C_SocketWritableCallback                ,
    SocketWritableCallback                  ,
    SocketWritableSignalInfo                ,
    afterSocketWritable                     ,
    genClosure_SocketWritable               ,
    mk_SocketWritableCallback               ,
    noSocketWritableCallback                ,
    onSocketWritable                        ,
    wrap_SocketWritableCallback             ,




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Enums as Gio.Enums
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.IOStream as Gio.IOStream
import qualified GI.Gio.Objects.Socket as Gio.Socket
import qualified GI.Gio.Objects.TlsCertificate as Gio.TlsCertificate
import qualified GI.Soup.Callbacks as Soup.Callbacks
import {-# SOURCE #-} qualified GI.Soup.Enums as Soup.Enums
import {-# SOURCE #-} qualified GI.Soup.Objects.Address as Soup.Address

newtype Socket = Socket (ManagedPtr Socket)
foreign import ccall "soup_socket_get_type"
    c_soup_socket_get_type :: IO GType

instance GObject Socket where
    gobjectType _ = c_soup_socket_get_type
    

class GObject o => IsSocket o
#if MIN_VERSION_base(4,9,0)
instance {-# OVERLAPPABLE #-} (GObject a, O.UnknownAncestorError Socket a) =>
    IsSocket a
#endif
instance IsSocket Socket
instance GObject.Object.IsObject Socket
instance Gio.Initable.IsInitable Socket

toSocket :: IsSocket o => o -> IO Socket
toSocket = unsafeCastTo Socket

noSocket :: Maybe Socket
noSocket = Nothing

type family ResolveSocketMethod (t :: Symbol) (o :: *) :: * where
    ResolveSocketMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSocketMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSocketMethod "connectAsync" o = SocketConnectAsyncMethodInfo
    ResolveSocketMethod "connectSync" o = SocketConnectSyncMethodInfo
    ResolveSocketMethod "disconnect" o = SocketDisconnectMethodInfo
    ResolveSocketMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSocketMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSocketMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveSocketMethod "isConnected" o = SocketIsConnectedMethodInfo
    ResolveSocketMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSocketMethod "isSsl" o = SocketIsSslMethodInfo
    ResolveSocketMethod "listen" o = SocketListenMethodInfo
    ResolveSocketMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSocketMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSocketMethod "read" o = SocketReadMethodInfo
    ResolveSocketMethod "readUntil" o = SocketReadUntilMethodInfo
    ResolveSocketMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSocketMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSocketMethod "replaceData" o = GObject.Object.ObjectReplaceDataMethodInfo
    ResolveSocketMethod "replaceQdata" o = GObject.Object.ObjectReplaceQdataMethodInfo
    ResolveSocketMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSocketMethod "startProxySsl" o = SocketStartProxySslMethodInfo
    ResolveSocketMethod "startSsl" o = SocketStartSslMethodInfo
    ResolveSocketMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSocketMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSocketMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSocketMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSocketMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSocketMethod "write" o = SocketWriteMethodInfo
    ResolveSocketMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSocketMethod "getFd" o = SocketGetFdMethodInfo
    ResolveSocketMethod "getLocalAddress" o = SocketGetLocalAddressMethodInfo
    ResolveSocketMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSocketMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSocketMethod "getRemoteAddress" o = SocketGetRemoteAddressMethodInfo
    ResolveSocketMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSocketMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSocketMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveSocketMethod t Socket, O.MethodInfo info Socket p) => O.IsLabelProxy t (Socket -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveSocketMethod t Socket, O.MethodInfo info Socket p) => O.IsLabel t (Socket -> p) where
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif

-- signal Socket::disconnected
type SocketDisconnectedCallback =
    IO ()

noSocketDisconnectedCallback :: Maybe SocketDisconnectedCallback
noSocketDisconnectedCallback = Nothing

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

foreign import ccall "wrapper"
    mk_SocketDisconnectedCallback :: C_SocketDisconnectedCallback -> IO (FunPtr C_SocketDisconnectedCallback)

genClosure_SocketDisconnected :: SocketDisconnectedCallback -> IO Closure
genClosure_SocketDisconnected cb = do
    let cb' = wrap_SocketDisconnectedCallback cb
    mk_SocketDisconnectedCallback cb' >>= newCClosure


wrap_SocketDisconnectedCallback ::
    SocketDisconnectedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
wrap_SocketDisconnectedCallback _cb _ _ = do
    _cb 


onSocketDisconnected :: (GObject a, MonadIO m) => a -> SocketDisconnectedCallback -> m SignalHandlerId
onSocketDisconnected obj cb = liftIO $ connectSocketDisconnected obj cb SignalConnectBefore
afterSocketDisconnected :: (GObject a, MonadIO m) => a -> SocketDisconnectedCallback -> m SignalHandlerId
afterSocketDisconnected obj cb = connectSocketDisconnected obj cb SignalConnectAfter

connectSocketDisconnected :: (GObject a, MonadIO m) =>
                             a -> SocketDisconnectedCallback -> SignalConnectMode -> m SignalHandlerId
connectSocketDisconnected obj cb after = liftIO $ do
    let cb' = wrap_SocketDisconnectedCallback cb
    cb'' <- mk_SocketDisconnectedCallback cb'
    connectSignalFunPtr obj "disconnected" cb'' after

-- signal Socket::event
type SocketEventCallback =
    Gio.Enums.SocketClientEvent ->
    Gio.IOStream.IOStream ->
    IO ()

noSocketEventCallback :: Maybe SocketEventCallback
noSocketEventCallback = Nothing

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

foreign import ccall "wrapper"
    mk_SocketEventCallback :: C_SocketEventCallback -> IO (FunPtr C_SocketEventCallback)

genClosure_SocketEvent :: SocketEventCallback -> IO Closure
genClosure_SocketEvent cb = do
    let cb' = wrap_SocketEventCallback cb
    mk_SocketEventCallback cb' >>= newCClosure


wrap_SocketEventCallback ::
    SocketEventCallback ->
    Ptr () ->
    CUInt ->
    Ptr Gio.IOStream.IOStream ->
    Ptr () ->
    IO ()
wrap_SocketEventCallback _cb _ event connection _ = do
    let event' = (toEnum . fromIntegral) event
    connection' <- (newObject Gio.IOStream.IOStream) connection
    _cb  event' connection'


onSocketEvent :: (GObject a, MonadIO m) => a -> SocketEventCallback -> m SignalHandlerId
onSocketEvent obj cb = liftIO $ connectSocketEvent obj cb SignalConnectBefore
afterSocketEvent :: (GObject a, MonadIO m) => a -> SocketEventCallback -> m SignalHandlerId
afterSocketEvent obj cb = connectSocketEvent obj cb SignalConnectAfter

connectSocketEvent :: (GObject a, MonadIO m) =>
                      a -> SocketEventCallback -> SignalConnectMode -> m SignalHandlerId
connectSocketEvent obj cb after = liftIO $ do
    let cb' = wrap_SocketEventCallback cb
    cb'' <- mk_SocketEventCallback cb'
    connectSignalFunPtr obj "event" cb'' after

-- signal Socket::new-connection
type SocketNewConnectionCallback =
    Socket ->
    IO ()

noSocketNewConnectionCallback :: Maybe SocketNewConnectionCallback
noSocketNewConnectionCallback = Nothing

type C_SocketNewConnectionCallback =
    Ptr () ->                               -- object
    Ptr Socket ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mk_SocketNewConnectionCallback :: C_SocketNewConnectionCallback -> IO (FunPtr C_SocketNewConnectionCallback)

genClosure_SocketNewConnection :: SocketNewConnectionCallback -> IO Closure
genClosure_SocketNewConnection cb = do
    let cb' = wrap_SocketNewConnectionCallback cb
    mk_SocketNewConnectionCallback cb' >>= newCClosure


wrap_SocketNewConnectionCallback ::
    SocketNewConnectionCallback ->
    Ptr () ->
    Ptr Socket ->
    Ptr () ->
    IO ()
wrap_SocketNewConnectionCallback _cb _ new _ = do
    new' <- (newObject Socket) new
    _cb  new'


onSocketNewConnection :: (GObject a, MonadIO m) => a -> SocketNewConnectionCallback -> m SignalHandlerId
onSocketNewConnection obj cb = liftIO $ connectSocketNewConnection obj cb SignalConnectBefore
afterSocketNewConnection :: (GObject a, MonadIO m) => a -> SocketNewConnectionCallback -> m SignalHandlerId
afterSocketNewConnection obj cb = connectSocketNewConnection obj cb SignalConnectAfter

connectSocketNewConnection :: (GObject a, MonadIO m) =>
                              a -> SocketNewConnectionCallback -> SignalConnectMode -> m SignalHandlerId
connectSocketNewConnection obj cb after = liftIO $ do
    let cb' = wrap_SocketNewConnectionCallback cb
    cb'' <- mk_SocketNewConnectionCallback cb'
    connectSignalFunPtr obj "new-connection" cb'' after

-- signal Socket::readable
type SocketReadableCallback =
    IO ()

noSocketReadableCallback :: Maybe SocketReadableCallback
noSocketReadableCallback = Nothing

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

foreign import ccall "wrapper"
    mk_SocketReadableCallback :: C_SocketReadableCallback -> IO (FunPtr C_SocketReadableCallback)

genClosure_SocketReadable :: SocketReadableCallback -> IO Closure
genClosure_SocketReadable cb = do
    let cb' = wrap_SocketReadableCallback cb
    mk_SocketReadableCallback cb' >>= newCClosure


wrap_SocketReadableCallback ::
    SocketReadableCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
wrap_SocketReadableCallback _cb _ _ = do
    _cb 


onSocketReadable :: (GObject a, MonadIO m) => a -> SocketReadableCallback -> m SignalHandlerId
onSocketReadable obj cb = liftIO $ connectSocketReadable obj cb SignalConnectBefore
afterSocketReadable :: (GObject a, MonadIO m) => a -> SocketReadableCallback -> m SignalHandlerId
afterSocketReadable obj cb = connectSocketReadable obj cb SignalConnectAfter

connectSocketReadable :: (GObject a, MonadIO m) =>
                         a -> SocketReadableCallback -> SignalConnectMode -> m SignalHandlerId
connectSocketReadable obj cb after = liftIO $ do
    let cb' = wrap_SocketReadableCallback cb
    cb'' <- mk_SocketReadableCallback cb'
    connectSignalFunPtr obj "readable" cb'' after

-- signal Socket::writable
type SocketWritableCallback =
    IO ()

noSocketWritableCallback :: Maybe SocketWritableCallback
noSocketWritableCallback = Nothing

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

foreign import ccall "wrapper"
    mk_SocketWritableCallback :: C_SocketWritableCallback -> IO (FunPtr C_SocketWritableCallback)

genClosure_SocketWritable :: SocketWritableCallback -> IO Closure
genClosure_SocketWritable cb = do
    let cb' = wrap_SocketWritableCallback cb
    mk_SocketWritableCallback cb' >>= newCClosure


wrap_SocketWritableCallback ::
    SocketWritableCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
wrap_SocketWritableCallback _cb _ _ = do
    _cb 


onSocketWritable :: (GObject a, MonadIO m) => a -> SocketWritableCallback -> m SignalHandlerId
onSocketWritable obj cb = liftIO $ connectSocketWritable obj cb SignalConnectBefore
afterSocketWritable :: (GObject a, MonadIO m) => a -> SocketWritableCallback -> m SignalHandlerId
afterSocketWritable obj cb = connectSocketWritable obj cb SignalConnectAfter

connectSocketWritable :: (GObject a, MonadIO m) =>
                         a -> SocketWritableCallback -> SignalConnectMode -> m SignalHandlerId
connectSocketWritable obj cb after = liftIO $ do
    let cb' = wrap_SocketWritableCallback cb
    cb'' <- mk_SocketWritableCallback cb'
    connectSignalFunPtr obj "writable" cb'' after

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

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

constructSocketAsyncContext :: (IsSocket o) => Ptr () -> IO (GValueConstruct o)
constructSocketAsyncContext val = constructObjectPropertyPtr "async-context" val

data SocketAsyncContextPropertyInfo
instance AttrInfo SocketAsyncContextPropertyInfo where
    type AttrAllowedOps SocketAsyncContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SocketAsyncContextPropertyInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint SocketAsyncContextPropertyInfo = IsSocket
    type AttrGetType SocketAsyncContextPropertyInfo = (Ptr ())
    type AttrLabel SocketAsyncContextPropertyInfo = "async-context"
    type AttrOrigin SocketAsyncContextPropertyInfo = Socket
    attrGet _ = getSocketAsyncContext
    attrSet _ = undefined
    attrConstruct _ = constructSocketAsyncContext
    attrClear _ = undefined

-- VVV Prop "fd"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

getSocketFd :: (MonadIO m, IsSocket o) => o -> m Int32
getSocketFd obj = liftIO $ getObjectPropertyInt32 obj "fd"

constructSocketFd :: (IsSocket o) => Int32 -> IO (GValueConstruct o)
constructSocketFd val = constructObjectPropertyInt32 "fd" val

data SocketFdPropertyInfo
instance AttrInfo SocketFdPropertyInfo where
    type AttrAllowedOps SocketFdPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SocketFdPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint SocketFdPropertyInfo = IsSocket
    type AttrGetType SocketFdPropertyInfo = Int32
    type AttrLabel SocketFdPropertyInfo = "fd"
    type AttrOrigin SocketFdPropertyInfo = Socket
    attrGet _ = getSocketFd
    attrSet _ = undefined
    attrConstruct _ = constructSocketFd
    attrClear _ = undefined

-- VVV Prop "gsocket"
   -- Type: TInterface (Name {namespace = "Gio", name = "Socket"})
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

constructSocketGsocket :: (IsSocket o, Gio.Socket.IsSocket a) => a -> IO (GValueConstruct o)
constructSocketGsocket val = constructObjectPropertyObject "gsocket" (Just val)

data SocketGsocketPropertyInfo
instance AttrInfo SocketGsocketPropertyInfo where
    type AttrAllowedOps SocketGsocketPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrSetTypeConstraint SocketGsocketPropertyInfo = Gio.Socket.IsSocket
    type AttrBaseTypeConstraint SocketGsocketPropertyInfo = IsSocket
    type AttrGetType SocketGsocketPropertyInfo = ()
    type AttrLabel SocketGsocketPropertyInfo = "gsocket"
    type AttrOrigin SocketGsocketPropertyInfo = Socket
    attrGet _ = undefined
    attrSet _ = undefined
    attrConstruct _ = constructSocketGsocket
    attrClear _ = undefined

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

constructSocketIostream :: (IsSocket o, Gio.IOStream.IsIOStream a) => a -> IO (GValueConstruct o)
constructSocketIostream val = constructObjectPropertyObject "iostream" (Just val)

data SocketIostreamPropertyInfo
instance AttrInfo SocketIostreamPropertyInfo where
    type AttrAllowedOps SocketIostreamPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrSetTypeConstraint SocketIostreamPropertyInfo = Gio.IOStream.IsIOStream
    type AttrBaseTypeConstraint SocketIostreamPropertyInfo = IsSocket
    type AttrGetType SocketIostreamPropertyInfo = ()
    type AttrLabel SocketIostreamPropertyInfo = "iostream"
    type AttrOrigin SocketIostreamPropertyInfo = Socket
    attrGet _ = undefined
    attrSet _ = undefined
    attrConstruct _ = constructSocketIostream
    attrClear _ = undefined

-- VVV Prop "ipv6-only"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

getSocketIpv6Only :: (MonadIO m, IsSocket o) => o -> m Bool
getSocketIpv6Only obj = liftIO $ getObjectPropertyBool obj "ipv6-only"

setSocketIpv6Only :: (MonadIO m, IsSocket o) => o -> Bool -> m ()
setSocketIpv6Only obj val = liftIO $ setObjectPropertyBool obj "ipv6-only" val

constructSocketIpv6Only :: (IsSocket o) => Bool -> IO (GValueConstruct o)
constructSocketIpv6Only val = constructObjectPropertyBool "ipv6-only" val

data SocketIpv6OnlyPropertyInfo
instance AttrInfo SocketIpv6OnlyPropertyInfo where
    type AttrAllowedOps SocketIpv6OnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SocketIpv6OnlyPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint SocketIpv6OnlyPropertyInfo = IsSocket
    type AttrGetType SocketIpv6OnlyPropertyInfo = Bool
    type AttrLabel SocketIpv6OnlyPropertyInfo = "ipv6-only"
    type AttrOrigin SocketIpv6OnlyPropertyInfo = Socket
    attrGet _ = getSocketIpv6Only
    attrSet _ = setSocketIpv6Only
    attrConstruct _ = constructSocketIpv6Only
    attrClear _ = undefined

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

getSocketIsServer :: (MonadIO m, IsSocket o) => o -> m Bool
getSocketIsServer obj = liftIO $ getObjectPropertyBool obj "is-server"

data SocketIsServerPropertyInfo
instance AttrInfo SocketIsServerPropertyInfo where
    type AttrAllowedOps SocketIsServerPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint SocketIsServerPropertyInfo = (~) ()
    type AttrBaseTypeConstraint SocketIsServerPropertyInfo = IsSocket
    type AttrGetType SocketIsServerPropertyInfo = Bool
    type AttrLabel SocketIsServerPropertyInfo = "is-server"
    type AttrOrigin SocketIsServerPropertyInfo = Socket
    attrGet _ = getSocketIsServer
    attrSet _ = undefined
    attrConstruct _ = undefined
    attrClear _ = undefined

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

getSocketLocalAddress :: (MonadIO m, IsSocket o) => o -> m Soup.Address.Address
getSocketLocalAddress obj = liftIO $ checkUnexpectedNothing "getSocketLocalAddress" $ getObjectPropertyObject obj "local-address" Soup.Address.Address

constructSocketLocalAddress :: (IsSocket o, Soup.Address.IsAddress a) => a -> IO (GValueConstruct o)
constructSocketLocalAddress val = constructObjectPropertyObject "local-address" (Just val)

data SocketLocalAddressPropertyInfo
instance AttrInfo SocketLocalAddressPropertyInfo where
    type AttrAllowedOps SocketLocalAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SocketLocalAddressPropertyInfo = Soup.Address.IsAddress
    type AttrBaseTypeConstraint SocketLocalAddressPropertyInfo = IsSocket
    type AttrGetType SocketLocalAddressPropertyInfo = Soup.Address.Address
    type AttrLabel SocketLocalAddressPropertyInfo = "local-address"
    type AttrOrigin SocketLocalAddressPropertyInfo = Socket
    attrGet _ = getSocketLocalAddress
    attrSet _ = undefined
    attrConstruct _ = constructSocketLocalAddress
    attrClear _ = undefined

-- VVV Prop "non-blocking"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

getSocketNonBlocking :: (MonadIO m, IsSocket o) => o -> m Bool
getSocketNonBlocking obj = liftIO $ getObjectPropertyBool obj "non-blocking"

setSocketNonBlocking :: (MonadIO m, IsSocket o) => o -> Bool -> m ()
setSocketNonBlocking obj val = liftIO $ setObjectPropertyBool obj "non-blocking" val

constructSocketNonBlocking :: (IsSocket o) => Bool -> IO (GValueConstruct o)
constructSocketNonBlocking val = constructObjectPropertyBool "non-blocking" val

data SocketNonBlockingPropertyInfo
instance AttrInfo SocketNonBlockingPropertyInfo where
    type AttrAllowedOps SocketNonBlockingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SocketNonBlockingPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint SocketNonBlockingPropertyInfo = IsSocket
    type AttrGetType SocketNonBlockingPropertyInfo = Bool
    type AttrLabel SocketNonBlockingPropertyInfo = "non-blocking"
    type AttrOrigin SocketNonBlockingPropertyInfo = Socket
    attrGet _ = getSocketNonBlocking
    attrSet _ = setSocketNonBlocking
    attrConstruct _ = constructSocketNonBlocking
    attrClear _ = undefined

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

getSocketRemoteAddress :: (MonadIO m, IsSocket o) => o -> m Soup.Address.Address
getSocketRemoteAddress obj = liftIO $ checkUnexpectedNothing "getSocketRemoteAddress" $ getObjectPropertyObject obj "remote-address" Soup.Address.Address

constructSocketRemoteAddress :: (IsSocket o, Soup.Address.IsAddress a) => a -> IO (GValueConstruct o)
constructSocketRemoteAddress val = constructObjectPropertyObject "remote-address" (Just val)

data SocketRemoteAddressPropertyInfo
instance AttrInfo SocketRemoteAddressPropertyInfo where
    type AttrAllowedOps SocketRemoteAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SocketRemoteAddressPropertyInfo = Soup.Address.IsAddress
    type AttrBaseTypeConstraint SocketRemoteAddressPropertyInfo = IsSocket
    type AttrGetType SocketRemoteAddressPropertyInfo = Soup.Address.Address
    type AttrLabel SocketRemoteAddressPropertyInfo = "remote-address"
    type AttrOrigin SocketRemoteAddressPropertyInfo = Socket
    attrGet _ = getSocketRemoteAddress
    attrSet _ = undefined
    attrConstruct _ = constructSocketRemoteAddress
    attrClear _ = undefined

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

getSocketSslCreds :: (MonadIO m, IsSocket o) => o -> m (Ptr ())
getSocketSslCreds obj = liftIO $ getObjectPropertyPtr obj "ssl-creds"

setSocketSslCreds :: (MonadIO m, IsSocket o) => o -> Ptr () -> m ()
setSocketSslCreds obj val = liftIO $ setObjectPropertyPtr obj "ssl-creds" val

constructSocketSslCreds :: (IsSocket o) => Ptr () -> IO (GValueConstruct o)
constructSocketSslCreds val = constructObjectPropertyPtr "ssl-creds" val

data SocketSslCredsPropertyInfo
instance AttrInfo SocketSslCredsPropertyInfo where
    type AttrAllowedOps SocketSslCredsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SocketSslCredsPropertyInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint SocketSslCredsPropertyInfo = IsSocket
    type AttrGetType SocketSslCredsPropertyInfo = (Ptr ())
    type AttrLabel SocketSslCredsPropertyInfo = "ssl-creds"
    type AttrOrigin SocketSslCredsPropertyInfo = Socket
    attrGet _ = getSocketSslCreds
    attrSet _ = setSocketSslCreds
    attrConstruct _ = constructSocketSslCreds
    attrClear _ = undefined

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

getSocketSslFallback :: (MonadIO m, IsSocket o) => o -> m Bool
getSocketSslFallback obj = liftIO $ getObjectPropertyBool obj "ssl-fallback"

constructSocketSslFallback :: (IsSocket o) => Bool -> IO (GValueConstruct o)
constructSocketSslFallback val = constructObjectPropertyBool "ssl-fallback" val

data SocketSslFallbackPropertyInfo
instance AttrInfo SocketSslFallbackPropertyInfo where
    type AttrAllowedOps SocketSslFallbackPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SocketSslFallbackPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint SocketSslFallbackPropertyInfo = IsSocket
    type AttrGetType SocketSslFallbackPropertyInfo = Bool
    type AttrLabel SocketSslFallbackPropertyInfo = "ssl-fallback"
    type AttrOrigin SocketSslFallbackPropertyInfo = Socket
    attrGet _ = getSocketSslFallback
    attrSet _ = undefined
    attrConstruct _ = constructSocketSslFallback
    attrClear _ = undefined

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

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

constructSocketSslStrict :: (IsSocket o) => Bool -> IO (GValueConstruct o)
constructSocketSslStrict val = constructObjectPropertyBool "ssl-strict" val

data SocketSslStrictPropertyInfo
instance AttrInfo SocketSslStrictPropertyInfo where
    type AttrAllowedOps SocketSslStrictPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SocketSslStrictPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint SocketSslStrictPropertyInfo = IsSocket
    type AttrGetType SocketSslStrictPropertyInfo = Bool
    type AttrLabel SocketSslStrictPropertyInfo = "ssl-strict"
    type AttrOrigin SocketSslStrictPropertyInfo = Socket
    attrGet _ = getSocketSslStrict
    attrSet _ = undefined
    attrConstruct _ = constructSocketSslStrict
    attrClear _ = undefined

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

getSocketTimeout :: (MonadIO m, IsSocket o) => o -> m Word32
getSocketTimeout obj = liftIO $ getObjectPropertyUInt32 obj "timeout"

setSocketTimeout :: (MonadIO m, IsSocket o) => o -> Word32 -> m ()
setSocketTimeout obj val = liftIO $ setObjectPropertyUInt32 obj "timeout" val

constructSocketTimeout :: (IsSocket o) => Word32 -> IO (GValueConstruct o)
constructSocketTimeout val = constructObjectPropertyUInt32 "timeout" val

data SocketTimeoutPropertyInfo
instance AttrInfo SocketTimeoutPropertyInfo where
    type AttrAllowedOps SocketTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SocketTimeoutPropertyInfo = (~) Word32
    type AttrBaseTypeConstraint SocketTimeoutPropertyInfo = IsSocket
    type AttrGetType SocketTimeoutPropertyInfo = Word32
    type AttrLabel SocketTimeoutPropertyInfo = "timeout"
    type AttrOrigin SocketTimeoutPropertyInfo = Socket
    attrGet _ = getSocketTimeout
    attrSet _ = setSocketTimeout
    attrConstruct _ = constructSocketTimeout
    attrClear _ = undefined

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

getSocketTlsCertificate :: (MonadIO m, IsSocket o) => o -> m (Maybe Gio.TlsCertificate.TlsCertificate)
getSocketTlsCertificate obj = liftIO $ getObjectPropertyObject obj "tls-certificate" Gio.TlsCertificate.TlsCertificate

data SocketTlsCertificatePropertyInfo
instance AttrInfo SocketTlsCertificatePropertyInfo where
    type AttrAllowedOps SocketTlsCertificatePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SocketTlsCertificatePropertyInfo = (~) ()
    type AttrBaseTypeConstraint SocketTlsCertificatePropertyInfo = IsSocket
    type AttrGetType SocketTlsCertificatePropertyInfo = (Maybe Gio.TlsCertificate.TlsCertificate)
    type AttrLabel SocketTlsCertificatePropertyInfo = "tls-certificate"
    type AttrOrigin SocketTlsCertificatePropertyInfo = Socket
    attrGet _ = getSocketTlsCertificate
    attrSet _ = undefined
    attrConstruct _ = undefined
    attrClear _ = undefined

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

getSocketTlsErrors :: (MonadIO m, IsSocket o) => o -> m [Gio.Flags.TlsCertificateFlags]
getSocketTlsErrors obj = liftIO $ getObjectPropertyFlags obj "tls-errors"

data SocketTlsErrorsPropertyInfo
instance AttrInfo SocketTlsErrorsPropertyInfo where
    type AttrAllowedOps SocketTlsErrorsPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint SocketTlsErrorsPropertyInfo = (~) ()
    type AttrBaseTypeConstraint SocketTlsErrorsPropertyInfo = IsSocket
    type AttrGetType SocketTlsErrorsPropertyInfo = [Gio.Flags.TlsCertificateFlags]
    type AttrLabel SocketTlsErrorsPropertyInfo = "tls-errors"
    type AttrOrigin SocketTlsErrorsPropertyInfo = Socket
    attrGet _ = getSocketTlsErrors
    attrSet _ = undefined
    attrConstruct _ = undefined
    attrClear _ = undefined

-- VVV Prop "trusted-certificate"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

getSocketTrustedCertificate :: (MonadIO m, IsSocket o) => o -> m Bool
getSocketTrustedCertificate obj = liftIO $ getObjectPropertyBool obj "trusted-certificate"

data SocketTrustedCertificatePropertyInfo
instance AttrInfo SocketTrustedCertificatePropertyInfo where
    type AttrAllowedOps SocketTrustedCertificatePropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint SocketTrustedCertificatePropertyInfo = (~) ()
    type AttrBaseTypeConstraint SocketTrustedCertificatePropertyInfo = IsSocket
    type AttrGetType SocketTrustedCertificatePropertyInfo = Bool
    type AttrLabel SocketTrustedCertificatePropertyInfo = "trusted-certificate"
    type AttrOrigin SocketTrustedCertificatePropertyInfo = Socket
    attrGet _ = getSocketTrustedCertificate
    attrSet _ = undefined
    attrConstruct _ = undefined
    attrClear _ = undefined

-- VVV Prop "use-thread-context"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

constructSocketUseThreadContext :: (IsSocket o) => Bool -> IO (GValueConstruct o)
constructSocketUseThreadContext val = constructObjectPropertyBool "use-thread-context" val

data SocketUseThreadContextPropertyInfo
instance AttrInfo SocketUseThreadContextPropertyInfo where
    type AttrAllowedOps SocketUseThreadContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint SocketUseThreadContextPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint SocketUseThreadContextPropertyInfo = IsSocket
    type AttrGetType SocketUseThreadContextPropertyInfo = Bool
    type AttrLabel SocketUseThreadContextPropertyInfo = "use-thread-context"
    type AttrOrigin SocketUseThreadContextPropertyInfo = Socket
    attrGet _ = getSocketUseThreadContext
    attrSet _ = undefined
    attrConstruct _ = constructSocketUseThreadContext
    attrClear _ = undefined

instance O.HasAttributeList Socket
type instance O.AttributeList Socket = SocketAttributeList
type SocketAttributeList = ('[ '("asyncContext", SocketAsyncContextPropertyInfo), '("fd", SocketFdPropertyInfo), '("gsocket", SocketGsocketPropertyInfo), '("iostream", SocketIostreamPropertyInfo), '("ipv6Only", SocketIpv6OnlyPropertyInfo), '("isServer", SocketIsServerPropertyInfo), '("localAddress", SocketLocalAddressPropertyInfo), '("nonBlocking", SocketNonBlockingPropertyInfo), '("remoteAddress", SocketRemoteAddressPropertyInfo), '("sslCreds", SocketSslCredsPropertyInfo), '("sslFallback", SocketSslFallbackPropertyInfo), '("sslStrict", SocketSslStrictPropertyInfo), '("timeout", SocketTimeoutPropertyInfo), '("tlsCertificate", SocketTlsCertificatePropertyInfo), '("tlsErrors", SocketTlsErrorsPropertyInfo), '("trustedCertificate", SocketTrustedCertificatePropertyInfo), '("useThreadContext", SocketUseThreadContextPropertyInfo)] :: [(Symbol, *)])

socketAsyncContext :: AttrLabelProxy "asyncContext"
socketAsyncContext = AttrLabelProxy

socketFd :: AttrLabelProxy "fd"
socketFd = AttrLabelProxy

socketGsocket :: AttrLabelProxy "gsocket"
socketGsocket = AttrLabelProxy

socketIostream :: AttrLabelProxy "iostream"
socketIostream = AttrLabelProxy

socketIpv6Only :: AttrLabelProxy "ipv6Only"
socketIpv6Only = AttrLabelProxy

socketIsServer :: AttrLabelProxy "isServer"
socketIsServer = AttrLabelProxy

socketLocalAddress :: AttrLabelProxy "localAddress"
socketLocalAddress = AttrLabelProxy

socketNonBlocking :: AttrLabelProxy "nonBlocking"
socketNonBlocking = AttrLabelProxy

socketRemoteAddress :: AttrLabelProxy "remoteAddress"
socketRemoteAddress = AttrLabelProxy

socketSslCreds :: AttrLabelProxy "sslCreds"
socketSslCreds = AttrLabelProxy

socketSslFallback :: AttrLabelProxy "sslFallback"
socketSslFallback = AttrLabelProxy

socketSslStrict :: AttrLabelProxy "sslStrict"
socketSslStrict = AttrLabelProxy

socketTimeout :: AttrLabelProxy "timeout"
socketTimeout = AttrLabelProxy

socketTlsCertificate :: AttrLabelProxy "tlsCertificate"
socketTlsCertificate = AttrLabelProxy

socketTlsErrors :: AttrLabelProxy "tlsErrors"
socketTlsErrors = AttrLabelProxy

socketTrustedCertificate :: AttrLabelProxy "trustedCertificate"
socketTrustedCertificate = AttrLabelProxy

socketUseThreadContext :: AttrLabelProxy "useThreadContext"
socketUseThreadContext = AttrLabelProxy

data SocketDisconnectedSignalInfo
instance SignalInfo SocketDisconnectedSignalInfo where
    type HaskellCallbackType SocketDisconnectedSignalInfo = SocketDisconnectedCallback
    connectSignal _ = connectSocketDisconnected

data SocketEventSignalInfo
instance SignalInfo SocketEventSignalInfo where
    type HaskellCallbackType SocketEventSignalInfo = SocketEventCallback
    connectSignal _ = connectSocketEvent

data SocketNewConnectionSignalInfo
instance SignalInfo SocketNewConnectionSignalInfo where
    type HaskellCallbackType SocketNewConnectionSignalInfo = SocketNewConnectionCallback
    connectSignal _ = connectSocketNewConnection

data SocketReadableSignalInfo
instance SignalInfo SocketReadableSignalInfo where
    type HaskellCallbackType SocketReadableSignalInfo = SocketReadableCallback
    connectSignal _ = connectSocketReadable

data SocketWritableSignalInfo
instance SignalInfo SocketWritableSignalInfo where
    type HaskellCallbackType SocketWritableSignalInfo = SocketWritableCallback
    connectSignal _ = connectSocketWritable

type instance O.SignalList Socket = SocketSignalList
type SocketSignalList = ('[ '("disconnected", SocketDisconnectedSignalInfo), '("event", SocketEventSignalInfo), '("newConnection", SocketNewConnectionSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("readable", SocketReadableSignalInfo), '("writable", SocketWritableSignalInfo)] :: [(Symbol, *)])

-- method Socket::connect_async
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "sock", argType = TInterface (Name {namespace = "Soup", name = "Socket"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a client #SoupSocket (which must not already be connected)", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "cancellable", argType = TInterface (Name {namespace = "Gio", name = "Cancellable"}), direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "a #GCancellable, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "callback", argType = TInterface (Name {namespace = "Soup", name = "SocketCallback"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "callback to call after connecting", sinceVersion = Nothing}, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "user_data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "data to pass to @callback", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_socket_connect_async" soup_socket_connect_async :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Soup.Callbacks.C_SocketCallback -> -- callback : TInterface (Name {namespace = "Soup", name = "SocketCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{- |
Begins asynchronously connecting to /@sock@/\'s remote address. The
socket will call /@callback@/ when it succeeds or fails (but not
before returning from this function).

If /@cancellable@/ is non-'Nothing', it can be used to cancel the
connection. /@callback@/ will still be invoked in this case, with a
status of 'GI.Soup.Enums.StatusCancelled'.
-}
socketConnectAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) =>
    a
    {- ^ /@sock@/: a client 'GI.Soup.Objects.Socket.Socket' (which must not already be connected) -}
    -> Maybe (b)
    {- ^ /@cancellable@/: a 'GI.Gio.Objects.Cancellable.Cancellable', or 'Nothing' -}
    -> Soup.Callbacks.SocketCallback
    {- ^ /@callback@/: callback to call after connecting -}
    -> m ()
socketConnectAsync sock cancellable callback = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            jCancellable' <- unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    ptrcallback <- callocMem :: IO (Ptr (FunPtr Soup.Callbacks.C_SocketCallback))
    callback' <- Soup.Callbacks.mk_SocketCallback (Soup.Callbacks.wrap_SocketCallback (Just ptrcallback) (Soup.Callbacks.drop_closures_SocketCallback callback))
    poke ptrcallback callback'
    let userData = nullPtr
    soup_socket_connect_async sock' maybeCancellable callback' userData
    touchManagedPtr sock
    whenJust cancellable touchManagedPtr
    return ()

data SocketConnectAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Soup.Callbacks.SocketCallback -> m ()), MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) => O.MethodInfo SocketConnectAsyncMethodInfo a signature where
    overloadedMethod _ = socketConnectAsync

-- method Socket::connect_sync
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "sock", argType = TInterface (Name {namespace = "Soup", name = "Socket"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a client #SoupSocket (which must not already be connected)", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "cancellable", argType = TInterface (Name {namespace = "Gio", name = "Cancellable"}), direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "a #GCancellable, or %NULL", 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_socket_connect_sync" soup_socket_connect_sync :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    IO Word32

{- |
Attempt to synchronously connect /@sock@/ to its remote address.

If /@cancellable@/ is non-'Nothing', it can be used to cancel the
connection, in which case 'GI.Soup.Objects.Socket.socketConnectSync' will return
'GI.Soup.Enums.StatusCancelled'.
-}
socketConnectSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) =>
    a
    {- ^ /@sock@/: a client 'GI.Soup.Objects.Socket.Socket' (which must not already be connected) -}
    -> Maybe (b)
    {- ^ /@cancellable@/: a 'GI.Gio.Objects.Cancellable.Cancellable', or 'Nothing' -}
    -> m Word32
    {- ^ __Returns:__ a success or failure code. -}
socketConnectSync sock cancellable = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            jCancellable' <- unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    result <- soup_socket_connect_sync sock' maybeCancellable
    touchManagedPtr sock
    whenJust cancellable touchManagedPtr
    return result

data SocketConnectSyncMethodInfo
instance (signature ~ (Maybe (b) -> m Word32), MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) => O.MethodInfo SocketConnectSyncMethodInfo a signature where
    overloadedMethod _ = socketConnectSync

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

foreign import ccall "soup_socket_disconnect" soup_socket_disconnect :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    IO ()

{- |
Disconnects /@sock@/. Any further read or write attempts on it will
fail.
-}
socketDisconnect ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a) =>
    a
    {- ^ /@sock@/: a 'GI.Soup.Objects.Socket.Socket' -}
    -> m ()
socketDisconnect sock = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    soup_socket_disconnect sock'
    touchManagedPtr sock
    return ()

data SocketDisconnectMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSocket a) => O.MethodInfo SocketDisconnectMethodInfo a signature where
    overloadedMethod _ = socketDisconnect

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

foreign import ccall "soup_socket_get_fd" soup_socket_get_fd :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    IO Int32

{- |
Gets /@sock@/\'s underlying file descriptor.

Note that fiddling with the file descriptor may break the
'GI.Soup.Objects.Socket.Socket'.
-}
socketGetFd ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a) =>
    a
    {- ^ /@sock@/: a 'GI.Soup.Objects.Socket.Socket' -}
    -> m Int32
    {- ^ __Returns:__ /@sock@/\'s file descriptor. -}
socketGetFd sock = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    result <- soup_socket_get_fd sock'
    touchManagedPtr sock
    return result

data SocketGetFdMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSocket a) => O.MethodInfo SocketGetFdMethodInfo a signature where
    overloadedMethod _ = socketGetFd

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

foreign import ccall "soup_socket_get_local_address" soup_socket_get_local_address :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    IO (Ptr Soup.Address.Address)

{- |
Returns the 'GI.Soup.Objects.Address.Address' corresponding to the local end of /@sock@/.

Calling this method on an unconnected socket is considered to be
an error, and produces undefined results.
-}
socketGetLocalAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a) =>
    a
    {- ^ /@sock@/: a 'GI.Soup.Objects.Socket.Socket' -}
    -> m Soup.Address.Address
    {- ^ __Returns:__ the 'GI.Soup.Objects.Address.Address' -}
socketGetLocalAddress sock = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    result <- soup_socket_get_local_address sock'
    checkUnexpectedReturnNULL "socketGetLocalAddress" result
    result' <- (newObject Soup.Address.Address) result
    touchManagedPtr sock
    return result'

data SocketGetLocalAddressMethodInfo
instance (signature ~ (m Soup.Address.Address), MonadIO m, IsSocket a) => O.MethodInfo SocketGetLocalAddressMethodInfo a signature where
    overloadedMethod _ = socketGetLocalAddress

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

foreign import ccall "soup_socket_get_remote_address" soup_socket_get_remote_address :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    IO (Ptr Soup.Address.Address)

{- |
Returns the 'GI.Soup.Objects.Address.Address' corresponding to the remote end of /@sock@/.

Calling this method on an unconnected socket is considered to be
an error, and produces undefined results.
-}
socketGetRemoteAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a) =>
    a
    {- ^ /@sock@/: a 'GI.Soup.Objects.Socket.Socket' -}
    -> m Soup.Address.Address
    {- ^ __Returns:__ the 'GI.Soup.Objects.Address.Address' -}
socketGetRemoteAddress sock = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    result <- soup_socket_get_remote_address sock'
    checkUnexpectedReturnNULL "socketGetRemoteAddress" result
    result' <- (newObject Soup.Address.Address) result
    touchManagedPtr sock
    return result'

data SocketGetRemoteAddressMethodInfo
instance (signature ~ (m Soup.Address.Address), MonadIO m, IsSocket a) => O.MethodInfo SocketGetRemoteAddressMethodInfo a signature where
    overloadedMethod _ = socketGetRemoteAddress

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

foreign import ccall "soup_socket_is_connected" soup_socket_is_connected :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    IO CInt

{- |
Tests if /@sock@/ is connected to another host
-}
socketIsConnected ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a) =>
    a
    {- ^ /@sock@/: a 'GI.Soup.Objects.Socket.Socket' -}
    -> m Bool
    {- ^ __Returns:__ 'True' or 'False'. -}
socketIsConnected sock = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    result <- soup_socket_is_connected sock'
    let result' = (/= 0) result
    touchManagedPtr sock
    return result'

data SocketIsConnectedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSocket a) => O.MethodInfo SocketIsConnectedMethodInfo a signature where
    overloadedMethod _ = socketIsConnected

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

foreign import ccall "soup_socket_is_ssl" soup_socket_is_ssl :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    IO CInt

{- |
Tests if /@sock@/ is doing (or has attempted to do) SSL.
-}
socketIsSsl ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a) =>
    a
    {- ^ /@sock@/: a 'GI.Soup.Objects.Socket.Socket' -}
    -> m Bool
    {- ^ __Returns:__ 'True' if /@sock@/ has SSL credentials set -}
socketIsSsl sock = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    result <- soup_socket_is_ssl sock'
    let result' = (/= 0) result
    touchManagedPtr sock
    return result'

data SocketIsSslMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSocket a) => O.MethodInfo SocketIsSslMethodInfo a signature where
    overloadedMethod _ = socketIsSsl

-- method Socket::listen
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "sock", argType = TInterface (Name {namespace = "Soup", name = "Socket"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a server #SoupSocket (which must not already be connected or\nlistening)", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_socket_listen" soup_socket_listen :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    IO CInt

{- |
Makes /@sock@/ start listening on its local address. When connections
come in, /@sock@/ will emit 'GI.Soup.Objects.Socket.Socket'::@/new_connection/@.
-}
socketListen ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a) =>
    a
    {- ^ /@sock@/: a server 'GI.Soup.Objects.Socket.Socket' (which must not already be connected or
listening) -}
    -> m Bool
    {- ^ __Returns:__ whether or not /@sock@/ is now listening. -}
socketListen sock = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    result <- soup_socket_listen sock'
    let result' = (/= 0) result
    touchManagedPtr sock
    return result'

data SocketListenMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSocket a) => O.MethodInfo SocketListenMethodInfo a signature where
    overloadedMethod _ = socketListen

-- method Socket::read
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "sock", argType = TInterface (Name {namespace = "Soup", name = "Socket"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the socket", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "buffer to read\n  into", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "size of @buffer in bytes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "nread", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "on return, the number of bytes read into @buffer", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "cancellable", argType = TInterface (Name {namespace = "Gio", name = "Cancellable"}), direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "a #GCancellable, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : [Arg {argCName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "size of @buffer in bytes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- returnType : Just (TInterface (Name {namespace = "Soup", name = "SocketIOStatus"}))
-- throws : True
-- Skip return : False

foreign import ccall "soup_socket_read" soup_socket_read :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    Ptr Word8 ->                            -- buffer : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- len : TBasicType TUInt64
    Ptr Word64 ->                           -- nread : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

{- |
Attempts to read up to /@len@/ bytes from /@sock@/ into /@buffer@/. If some
data is successfully read, 'GI.Soup.Objects.Socket.socketRead' will return
'GI.Soup.Enums.SocketIOStatusOk', and */@nread@/ will contain the number of bytes
actually read (which may be less than /@len@/).

If /@sock@/ is non-blocking, and no data is available, the return
value will be 'GI.Soup.Enums.SocketIOStatusWouldBlock'. In this case, the caller
can connect to the 'GI.Soup.Objects.Socket.Socket'::@/readable/@ signal to know when there
is more data to read. (NB: You MUST read all available data off the
socket first. 'GI.Soup.Objects.Socket.Socket'::@/readable/@ is only emitted after
'GI.Soup.Objects.Socket.socketRead' returns 'GI.Soup.Enums.SocketIOStatusWouldBlock', and it is only
emitted once. See the documentation for 'GI.Soup.Objects.Socket.Socket':@/non-blocking/@.)
-}
socketRead ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) =>
    a
    {- ^ /@sock@/: the socket -}
    -> ByteString
    {- ^ /@buffer@/: buffer to read
  into -}
    -> Maybe (b)
    {- ^ /@cancellable@/: a 'GI.Gio.Objects.Cancellable.Cancellable', or 'Nothing' -}
    -> m (Soup.Enums.SocketIOStatus,Word64)
    {- ^ __Returns:__ a 'GI.Soup.Enums.SocketIOStatus', as described above (or
'GI.Soup.Enums.SocketIOStatusEof' if the socket is no longer connected, or
'GI.Soup.Enums.SocketIOStatusError' on any other error, in which case /@error@/ will
also be set). /(Can throw 'Data.GI.Base.GError.GError')/ -}
socketRead sock buffer cancellable = liftIO $ do
    let len = fromIntegral $ B.length buffer
    sock' <- unsafeManagedPtrCastPtr sock
    buffer' <- packByteString buffer
    nread <- allocMem :: IO (Ptr Word64)
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            jCancellable' <- unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ soup_socket_read sock' buffer' len nread maybeCancellable
        let result' = (toEnum . fromIntegral) result
        nread' <- peek nread
        touchManagedPtr sock
        whenJust cancellable touchManagedPtr
        freeMem buffer'
        freeMem nread
        return (result', nread')
     ) (do
        freeMem buffer'
        freeMem nread
     )

data SocketReadMethodInfo
instance (signature ~ (ByteString -> Maybe (b) -> m (Soup.Enums.SocketIOStatus,Word64)), MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) => O.MethodInfo SocketReadMethodInfo a signature where
    overloadedMethod _ = socketRead

-- method Socket::read_until
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "sock", argType = TInterface (Name {namespace = "Soup", name = "Socket"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the socket", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "buffer to read\n  into", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "size of @buffer in bytes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "boundary", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "boundary to read until", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "boundary_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "length of @boundary in bytes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "nread", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "on return, the number of bytes read into @buffer", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "got_boundary", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "on return, whether or not the data in @buffer\nends with the boundary string", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "cancellable", argType = TInterface (Name {namespace = "Gio", name = "Cancellable"}), direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "a #GCancellable, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : [Arg {argCName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "size of @buffer in bytes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- returnType : Just (TInterface (Name {namespace = "Soup", name = "SocketIOStatus"}))
-- throws : True
-- Skip return : False

foreign import ccall "soup_socket_read_until" soup_socket_read_until :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    Ptr Word8 ->                            -- buffer : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- len : TBasicType TUInt64
    Ptr () ->                               -- boundary : TBasicType TPtr
    Word64 ->                               -- boundary_len : TBasicType TUInt64
    Ptr Word64 ->                           -- nread : TBasicType TUInt64
    CInt ->                                 -- got_boundary : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

{- |
Like 'GI.Soup.Objects.Socket.socketRead', but reads no further than the first
occurrence of /@boundary@/. (If the boundary is found, it will be
included in the returned data, and */@gotBoundary@/ will be set to
'True'.) Any data after the boundary will returned in future reads.

'GI.Soup.Objects.Socket.socketReadUntil' will almost always return fewer than /@len@/
bytes: if the boundary is found, then it will only return the bytes
up until the end of the boundary, and if the boundary is not found,
then it will leave the last \<literal>(boundary_len - 1)\<\/literal>
bytes in its internal buffer, in case they form the start of the
boundary string. Thus, /@len@/ normally needs to be at least 1 byte
longer than /@boundaryLen@/ if you want to make any progress at all.
-}
socketReadUntil ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) =>
    a
    {- ^ /@sock@/: the socket -}
    -> ByteString
    {- ^ /@buffer@/: buffer to read
  into -}
    -> Ptr ()
    {- ^ /@boundary@/: boundary to read until -}
    -> Word64
    {- ^ /@boundaryLen@/: length of /@boundary@/ in bytes -}
    -> Bool
    {- ^ /@gotBoundary@/: on return, whether or not the data in /@buffer@/
ends with the boundary string -}
    -> Maybe (b)
    {- ^ /@cancellable@/: a 'GI.Gio.Objects.Cancellable.Cancellable', or 'Nothing' -}
    -> m (Soup.Enums.SocketIOStatus,Word64)
    {- ^ __Returns:__ as for 'GI.Soup.Objects.Socket.socketRead' /(Can throw 'Data.GI.Base.GError.GError')/ -}
socketReadUntil sock buffer boundary boundaryLen gotBoundary cancellable = liftIO $ do
    let len = fromIntegral $ B.length buffer
    sock' <- unsafeManagedPtrCastPtr sock
    buffer' <- packByteString buffer
    nread <- allocMem :: IO (Ptr Word64)
    let gotBoundary' = (fromIntegral . fromEnum) gotBoundary
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            jCancellable' <- unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ soup_socket_read_until sock' buffer' len boundary boundaryLen nread gotBoundary' maybeCancellable
        let result' = (toEnum . fromIntegral) result
        nread' <- peek nread
        touchManagedPtr sock
        whenJust cancellable touchManagedPtr
        freeMem buffer'
        freeMem nread
        return (result', nread')
     ) (do
        freeMem buffer'
        freeMem nread
     )

data SocketReadUntilMethodInfo
instance (signature ~ (ByteString -> Ptr () -> Word64 -> Bool -> Maybe (b) -> m (Soup.Enums.SocketIOStatus,Word64)), MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) => O.MethodInfo SocketReadUntilMethodInfo a signature where
    overloadedMethod _ = socketReadUntil

-- method Socket::start_proxy_ssl
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "sock", argType = TInterface (Name {namespace = "Soup", name = "Socket"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the socket", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "ssl_host", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "hostname of the SSL server", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "cancellable", argType = TInterface (Name {namespace = "Gio", name = "Cancellable"}), direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "a #GCancellable", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_socket_start_proxy_ssl" soup_socket_start_proxy_ssl :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    CString ->                              -- ssl_host : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    IO CInt

{- |
Starts using SSL on /@socket@/, expecting to find a host named
/@sslHost@/.
-}
socketStartProxySsl ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) =>
    a
    {- ^ /@sock@/: the socket -}
    -> T.Text
    {- ^ /@sslHost@/: hostname of the SSL server -}
    -> Maybe (b)
    {- ^ /@cancellable@/: a 'GI.Gio.Objects.Cancellable.Cancellable' -}
    -> m Bool
    {- ^ __Returns:__ success or failure -}
socketStartProxySsl sock sslHost cancellable = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    sslHost' <- textToCString sslHost
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            jCancellable' <- unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    result <- soup_socket_start_proxy_ssl sock' sslHost' maybeCancellable
    let result' = (/= 0) result
    touchManagedPtr sock
    whenJust cancellable touchManagedPtr
    freeMem sslHost'
    return result'

data SocketStartProxySslMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m Bool), MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) => O.MethodInfo SocketStartProxySslMethodInfo a signature where
    overloadedMethod _ = socketStartProxySsl

-- method Socket::start_ssl
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "sock", argType = TInterface (Name {namespace = "Soup", name = "Socket"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the socket", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "cancellable", argType = TInterface (Name {namespace = "Gio", name = "Cancellable"}), direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "a #GCancellable", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_socket_start_ssl" soup_socket_start_ssl :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    IO CInt

{- |
Starts using SSL on /@socket@/.
-}
socketStartSsl ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) =>
    a
    {- ^ /@sock@/: the socket -}
    -> Maybe (b)
    {- ^ /@cancellable@/: a 'GI.Gio.Objects.Cancellable.Cancellable' -}
    -> m Bool
    {- ^ __Returns:__ success or failure -}
socketStartSsl sock cancellable = liftIO $ do
    sock' <- unsafeManagedPtrCastPtr sock
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            jCancellable' <- unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    result <- soup_socket_start_ssl sock' maybeCancellable
    let result' = (/= 0) result
    touchManagedPtr sock
    whenJust cancellable touchManagedPtr
    return result'

data SocketStartSslMethodInfo
instance (signature ~ (Maybe (b) -> m Bool), MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) => O.MethodInfo SocketStartSslMethodInfo a signature where
    overloadedMethod _ = socketStartSsl

-- method Socket::write
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "sock", argType = TInterface (Name {namespace = "Soup", name = "Socket"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the socket", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "data to write", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "size of @buffer, in bytes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "nwrote", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "on return, number of bytes written", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "cancellable", argType = TInterface (Name {namespace = "Gio", name = "Cancellable"}), direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "a #GCancellable, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : [Arg {argCName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "size of @buffer, in bytes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- returnType : Just (TInterface (Name {namespace = "Soup", name = "SocketIOStatus"}))
-- throws : True
-- Skip return : False

foreign import ccall "soup_socket_write" soup_socket_write :: 
    Ptr Socket ->                           -- sock : TInterface (Name {namespace = "Soup", name = "Socket"})
    Ptr Word8 ->                            -- buffer : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- len : TBasicType TUInt64
    Ptr Word64 ->                           -- nwrote : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

{- |
Attempts to write /@len@/ bytes from /@buffer@/ to /@sock@/. If some data is
successfully written, the return status will be 'GI.Soup.Enums.SocketIOStatusOk',
and */@nwrote@/ will contain the number of bytes actually written
(which may be less than /@len@/).

If /@sock@/ is non-blocking, and no data could be written right away,
the return value will be 'GI.Soup.Enums.SocketIOStatusWouldBlock'. In this case,
the caller can connect to the 'GI.Soup.Objects.Socket.Socket'::@/writable/@ signal to know
when more data can be written. (NB: 'GI.Soup.Objects.Socket.Socket'::@/writable/@ is only
emitted after 'GI.Soup.Objects.Socket.socketWrite' returns 'GI.Soup.Enums.SocketIOStatusWouldBlock',
and it is only emitted once. See the documentation for
'GI.Soup.Objects.Socket.Socket':@/non-blocking/@.)
-}
socketWrite ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) =>
    a
    {- ^ /@sock@/: the socket -}
    -> ByteString
    {- ^ /@buffer@/: data to write -}
    -> Maybe (b)
    {- ^ /@cancellable@/: a 'GI.Gio.Objects.Cancellable.Cancellable', or 'Nothing' -}
    -> m (Soup.Enums.SocketIOStatus,Word64)
    {- ^ __Returns:__ a 'GI.Soup.Enums.SocketIOStatus', as described above (or
'GI.Soup.Enums.SocketIOStatusEof' or 'GI.Soup.Enums.SocketIOStatusError'. /@error@/ will be set if the
return value is 'GI.Soup.Enums.SocketIOStatusError'.) /(Can throw 'Data.GI.Base.GError.GError')/ -}
socketWrite sock buffer cancellable = liftIO $ do
    let len = fromIntegral $ B.length buffer
    sock' <- unsafeManagedPtrCastPtr sock
    buffer' <- packByteString buffer
    nwrote <- allocMem :: IO (Ptr Word64)
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            jCancellable' <- unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ soup_socket_write sock' buffer' len nwrote maybeCancellable
        let result' = (toEnum . fromIntegral) result
        nwrote' <- peek nwrote
        touchManagedPtr sock
        whenJust cancellable touchManagedPtr
        freeMem buffer'
        freeMem nwrote
        return (result', nwrote')
     ) (do
        freeMem buffer'
        freeMem nwrote
     )

data SocketWriteMethodInfo
instance (signature ~ (ByteString -> Maybe (b) -> m (Soup.Enums.SocketIOStatus,Word64)), MonadIO m, IsSocket a, Gio.Cancellable.IsCancellable b) => O.MethodInfo SocketWriteMethodInfo a signature where
    overloadedMethod _ = socketWrite