{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Objects.SocketConnection.SocketConnection' is a t'GI.Gio.Objects.IOStream.IOStream' for a connected socket. They
-- can be created either by t'GI.Gio.Objects.SocketClient.SocketClient' when connecting to a host,
-- or by t'GI.Gio.Objects.SocketListener.SocketListener' when accepting a new client.
-- 
-- The type of the t'GI.Gio.Objects.SocketConnection.SocketConnection' object returned from these calls
-- depends on the type of the underlying socket that is in use. For
-- instance, for a TCP\/IP connection it will be a t'GI.Gio.Objects.TcpConnection.TcpConnection'.
-- 
-- Choosing what type of object to construct is done with the socket
-- connection factory, and it is possible for 3rd parties to register
-- custom socket connection types for specific combination of socket
-- family\/type\/protocol using 'GI.Gio.Objects.SocketConnection.socketConnectionFactoryRegisterType'.
-- 
-- To close a t'GI.Gio.Objects.SocketConnection.SocketConnection', use 'GI.Gio.Objects.IOStream.iOStreamClose'. Closing both
-- substreams of the t'GI.Gio.Objects.IOStream.IOStream' separately will not close the underlying
-- t'GI.Gio.Objects.Socket.Socket'.
-- 
-- /Since: 2.22/

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

module GI.Gio.Objects.SocketConnection
    ( 

-- * Exported types
    SocketConnection(..)                    ,
    IsSocketConnection                      ,
    toSocketConnection                      ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveSocketConnectionMethod           ,
#endif


-- ** connect #method:connect#

#if defined(ENABLE_OVERLOADING)
    SocketConnectionConnectMethodInfo       ,
#endif
    socketConnectionConnect                 ,


-- ** connectAsync #method:connectAsync#

#if defined(ENABLE_OVERLOADING)
    SocketConnectionConnectAsyncMethodInfo  ,
#endif
    socketConnectionConnectAsync            ,


-- ** connectFinish #method:connectFinish#

#if defined(ENABLE_OVERLOADING)
    SocketConnectionConnectFinishMethodInfo ,
#endif
    socketConnectionConnectFinish           ,


-- ** factoryLookupType #method:factoryLookupType#

    socketConnectionFactoryLookupType       ,


-- ** factoryRegisterType #method:factoryRegisterType#

    socketConnectionFactoryRegisterType     ,


-- ** getLocalAddress #method:getLocalAddress#

#if defined(ENABLE_OVERLOADING)
    SocketConnectionGetLocalAddressMethodInfo,
#endif
    socketConnectionGetLocalAddress         ,


-- ** getRemoteAddress #method:getRemoteAddress#

#if defined(ENABLE_OVERLOADING)
    SocketConnectionGetRemoteAddressMethodInfo,
#endif
    socketConnectionGetRemoteAddress        ,


-- ** getSocket #method:getSocket#

#if defined(ENABLE_OVERLOADING)
    SocketConnectionGetSocketMethodInfo     ,
#endif
    socketConnectionGetSocket               ,


-- ** isConnected #method:isConnected#

#if defined(ENABLE_OVERLOADING)
    SocketConnectionIsConnectedMethodInfo   ,
#endif
    socketConnectionIsConnected             ,




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

#if defined(ENABLE_OVERLOADING)
    SocketConnectionSocketPropertyInfo      ,
#endif
    constructSocketConnectionSocket         ,
    getSocketConnectionSocket               ,
#if defined(ENABLE_OVERLOADING)
    socketConnectionSocket                  ,
#endif




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.IOStream as Gio.IOStream
import {-# SOURCE #-} qualified GI.Gio.Objects.Socket as Gio.Socket
import {-# SOURCE #-} qualified GI.Gio.Objects.SocketAddress as Gio.SocketAddress

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

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

foreign import ccall "g_socket_connection_get_type"
    c_g_socket_connection_get_type :: IO B.Types.GType

instance B.Types.TypedObject SocketConnection where
    glibType :: IO GType
glibType = IO GType
c_g_socket_connection_get_type

instance B.Types.GObject SocketConnection

-- | Convert 'SocketConnection' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue SocketConnection where
    toGValue :: SocketConnection -> IO GValue
toGValue SocketConnection
o = do
        GType
gtype <- IO GType
c_g_socket_connection_get_type
        SocketConnection
-> (Ptr SocketConnection -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SocketConnection
o (GType
-> (GValue -> Ptr SocketConnection -> IO ())
-> Ptr SocketConnection
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr SocketConnection -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO SocketConnection
fromGValue GValue
gv = do
        Ptr SocketConnection
ptr <- GValue -> IO (Ptr SocketConnection)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr SocketConnection)
        (ManagedPtr SocketConnection -> SocketConnection)
-> Ptr SocketConnection -> IO SocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SocketConnection -> SocketConnection
SocketConnection Ptr SocketConnection
ptr
        
    

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

instance O.HasParentTypes SocketConnection
type instance O.ParentTypes SocketConnection = '[Gio.IOStream.IOStream, GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSocketConnectionMethod (t :: Symbol) (o :: *) :: * where
    ResolveSocketConnectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSocketConnectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSocketConnectionMethod "clearPending" o = Gio.IOStream.IOStreamClearPendingMethodInfo
    ResolveSocketConnectionMethod "close" o = Gio.IOStream.IOStreamCloseMethodInfo
    ResolveSocketConnectionMethod "closeAsync" o = Gio.IOStream.IOStreamCloseAsyncMethodInfo
    ResolveSocketConnectionMethod "closeFinish" o = Gio.IOStream.IOStreamCloseFinishMethodInfo
    ResolveSocketConnectionMethod "connect" o = SocketConnectionConnectMethodInfo
    ResolveSocketConnectionMethod "connectAsync" o = SocketConnectionConnectAsyncMethodInfo
    ResolveSocketConnectionMethod "connectFinish" o = SocketConnectionConnectFinishMethodInfo
    ResolveSocketConnectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSocketConnectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSocketConnectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSocketConnectionMethod "hasPending" o = Gio.IOStream.IOStreamHasPendingMethodInfo
    ResolveSocketConnectionMethod "isClosed" o = Gio.IOStream.IOStreamIsClosedMethodInfo
    ResolveSocketConnectionMethod "isConnected" o = SocketConnectionIsConnectedMethodInfo
    ResolveSocketConnectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSocketConnectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSocketConnectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSocketConnectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSocketConnectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSocketConnectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSocketConnectionMethod "spliceAsync" o = Gio.IOStream.IOStreamSpliceAsyncMethodInfo
    ResolveSocketConnectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSocketConnectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSocketConnectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSocketConnectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSocketConnectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSocketConnectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSocketConnectionMethod "getInputStream" o = Gio.IOStream.IOStreamGetInputStreamMethodInfo
    ResolveSocketConnectionMethod "getLocalAddress" o = SocketConnectionGetLocalAddressMethodInfo
    ResolveSocketConnectionMethod "getOutputStream" o = Gio.IOStream.IOStreamGetOutputStreamMethodInfo
    ResolveSocketConnectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSocketConnectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSocketConnectionMethod "getRemoteAddress" o = SocketConnectionGetRemoteAddressMethodInfo
    ResolveSocketConnectionMethod "getSocket" o = SocketConnectionGetSocketMethodInfo
    ResolveSocketConnectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSocketConnectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSocketConnectionMethod "setPending" o = Gio.IOStream.IOStreamSetPendingMethodInfo
    ResolveSocketConnectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSocketConnectionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data SocketConnectionSocketPropertyInfo
instance AttrInfo SocketConnectionSocketPropertyInfo where
    type AttrAllowedOps SocketConnectionSocketPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SocketConnectionSocketPropertyInfo = IsSocketConnection
    type AttrSetTypeConstraint SocketConnectionSocketPropertyInfo = Gio.Socket.IsSocket
    type AttrTransferTypeConstraint SocketConnectionSocketPropertyInfo = Gio.Socket.IsSocket
    type AttrTransferType SocketConnectionSocketPropertyInfo = Gio.Socket.Socket
    type AttrGetType SocketConnectionSocketPropertyInfo = Gio.Socket.Socket
    type AttrLabel SocketConnectionSocketPropertyInfo = "socket"
    type AttrOrigin SocketConnectionSocketPropertyInfo = SocketConnection
    attrGet = getSocketConnectionSocket
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.Socket.Socket v
    attrConstruct = constructSocketConnectionSocket
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SocketConnection
type instance O.AttributeList SocketConnection = SocketConnectionAttributeList
type SocketConnectionAttributeList = ('[ '("closed", Gio.IOStream.IOStreamClosedPropertyInfo), '("inputStream", Gio.IOStream.IOStreamInputStreamPropertyInfo), '("outputStream", Gio.IOStream.IOStreamOutputStreamPropertyInfo), '("socket", SocketConnectionSocketPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
socketConnectionSocket :: AttrLabelProxy "socket"
socketConnectionSocket = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SocketConnection = SocketConnectionSignalList
type SocketConnectionSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method SocketConnection::connect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketConnection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GSocketAddress specifying the remote address."
--                 , 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 TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_socket_connection_connect" g_socket_connection_connect :: 
    Ptr SocketConnection ->                 -- connection : TInterface (Name {namespace = "Gio", name = "SocketConnection"})
    Ptr Gio.SocketAddress.SocketAddress ->  -- address : TInterface (Name {namespace = "Gio", name = "SocketAddress"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Connect /@connection@/ to the specified remote address.
-- 
-- /Since: 2.32/
socketConnectionConnect ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a, Gio.SocketAddress.IsSocketAddress b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@connection@/: a t'GI.Gio.Objects.SocketConnection.SocketConnection'
    -> b
    -- ^ /@address@/: a t'GI.Gio.Objects.SocketAddress.SocketAddress' specifying the remote address.
    -> Maybe (c)
    -- ^ /@cancellable@/: a @/GCancellable/@ or 'P.Nothing'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
socketConnectionConnect :: a -> b -> Maybe c -> m ()
socketConnectionConnect a
connection b
address Maybe c
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    Ptr SocketAddress
address' <- b -> IO (Ptr SocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
address
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr SocketConnection
-> Ptr SocketAddress
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_socket_connection_connect Ptr SocketConnection
connection' Ptr SocketAddress
address' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
address
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SocketConnectionConnectMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsSocketConnection a, Gio.SocketAddress.IsSocketAddress b, Gio.Cancellable.IsCancellable c) => O.MethodInfo SocketConnectionConnectMethodInfo a signature where
    overloadedMethod = socketConnectionConnect

#endif

-- method SocketConnection::connect_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketConnection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GSocketAddress specifying the remote address."
--                 , 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 = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_socket_connection_connect_async" g_socket_connection_connect_async :: 
    Ptr SocketConnection ->                 -- connection : TInterface (Name {namespace = "Gio", name = "SocketConnection"})
    Ptr Gio.SocketAddress.SocketAddress ->  -- address : TInterface (Name {namespace = "Gio", name = "SocketAddress"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously connect /@connection@/ to the specified remote address.
-- 
-- This clears the t'GI.Gio.Objects.Socket.Socket':@/blocking/@ flag on /@connection@/\'s underlying
-- socket if it is currently set.
-- 
-- Use 'GI.Gio.Objects.SocketConnection.socketConnectionConnectFinish' to retrieve the result.
-- 
-- /Since: 2.32/
socketConnectionConnectAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a, Gio.SocketAddress.IsSocketAddress b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@connection@/: a t'GI.Gio.Objects.SocketConnection.SocketConnection'
    -> b
    -- ^ /@address@/: a t'GI.Gio.Objects.SocketAddress.SocketAddress' specifying the remote address.
    -> Maybe (c)
    -- ^ /@cancellable@/: a @/GCancellable/@ or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
socketConnectionConnectAsync :: a -> b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
socketConnectionConnectAsync a
connection b
address Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    Ptr SocketAddress
address' <- b -> IO (Ptr SocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
address
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr SocketConnection
-> Ptr SocketAddress
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_socket_connection_connect_async Ptr SocketConnection
connection' Ptr SocketAddress
address' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
address
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketConnectionConnectAsyncMethodInfo
instance (signature ~ (b -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSocketConnection a, Gio.SocketAddress.IsSocketAddress b, Gio.Cancellable.IsCancellable c) => O.MethodInfo SocketConnectionConnectAsyncMethodInfo a signature where
    overloadedMethod = socketConnectionConnectAsync

#endif

-- method SocketConnection::connect_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketConnection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_socket_connection_connect_finish" g_socket_connection_connect_finish :: 
    Ptr SocketConnection ->                 -- connection : TInterface (Name {namespace = "Gio", name = "SocketConnection"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Gets the result of a 'GI.Gio.Objects.SocketConnection.socketConnectionConnectAsync' call.
-- 
-- /Since: 2.32/
socketConnectionConnectFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@connection@/: a t'GI.Gio.Objects.SocketConnection.SocketConnection'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
socketConnectionConnectFinish :: a -> b -> m ()
socketConnectionConnectFinish a
connection b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr SocketConnection
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_socket_connection_connect_finish Ptr SocketConnection
connection' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SocketConnectionConnectFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSocketConnection a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo SocketConnectionConnectFinishMethodInfo a signature where
    overloadedMethod = socketConnectionConnectFinish

#endif

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

foreign import ccall "g_socket_connection_get_local_address" g_socket_connection_get_local_address :: 
    Ptr SocketConnection ->                 -- connection : TInterface (Name {namespace = "Gio", name = "SocketConnection"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.SocketAddress.SocketAddress)

-- | Try to get the local address of a socket connection.
-- 
-- /Since: 2.22/
socketConnectionGetLocalAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a) =>
    a
    -- ^ /@connection@/: a t'GI.Gio.Objects.SocketConnection.SocketConnection'
    -> m Gio.SocketAddress.SocketAddress
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketAddress.SocketAddress' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
socketConnectionGetLocalAddress :: a -> m SocketAddress
socketConnectionGetLocalAddress a
connection = IO SocketAddress -> m SocketAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketAddress -> m SocketAddress)
-> IO SocketAddress -> m SocketAddress
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    IO SocketAddress -> IO () -> IO SocketAddress
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr SocketAddress
result <- (Ptr (Ptr GError) -> IO (Ptr SocketAddress))
-> IO (Ptr SocketAddress)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketAddress))
 -> IO (Ptr SocketAddress))
-> (Ptr (Ptr GError) -> IO (Ptr SocketAddress))
-> IO (Ptr SocketAddress)
forall a b. (a -> b) -> a -> b
$ Ptr SocketConnection -> Ptr (Ptr GError) -> IO (Ptr SocketAddress)
g_socket_connection_get_local_address Ptr SocketConnection
connection'
        Text -> Ptr SocketAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketConnectionGetLocalAddress" Ptr SocketAddress
result
        SocketAddress
result' <- ((ManagedPtr SocketAddress -> SocketAddress)
-> Ptr SocketAddress -> IO SocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketAddress -> SocketAddress
Gio.SocketAddress.SocketAddress) Ptr SocketAddress
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
        SocketAddress -> IO SocketAddress
forall (m :: * -> *) a. Monad m => a -> m a
return SocketAddress
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SocketConnectionGetLocalAddressMethodInfo
instance (signature ~ (m Gio.SocketAddress.SocketAddress), MonadIO m, IsSocketConnection a) => O.MethodInfo SocketConnectionGetLocalAddressMethodInfo a signature where
    overloadedMethod = socketConnectionGetLocalAddress

#endif

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

foreign import ccall "g_socket_connection_get_remote_address" g_socket_connection_get_remote_address :: 
    Ptr SocketConnection ->                 -- connection : TInterface (Name {namespace = "Gio", name = "SocketConnection"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.SocketAddress.SocketAddress)

-- | Try to get the remote address of a socket connection.
-- 
-- Since GLib 2.40, when used with 'GI.Gio.Objects.SocketClient.socketClientConnect' or
-- 'GI.Gio.Objects.SocketClient.socketClientConnectAsync', during emission of
-- 'GI.Gio.Enums.SocketClientEventConnecting', this function will return the remote
-- address that will be used for the connection.  This allows
-- applications to print e.g. \"Connecting to example.com
-- (10.42.77.3)...\".
-- 
-- /Since: 2.22/
socketConnectionGetRemoteAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a) =>
    a
    -- ^ /@connection@/: a t'GI.Gio.Objects.SocketConnection.SocketConnection'
    -> m Gio.SocketAddress.SocketAddress
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketAddress.SocketAddress' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
socketConnectionGetRemoteAddress :: a -> m SocketAddress
socketConnectionGetRemoteAddress a
connection = IO SocketAddress -> m SocketAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketAddress -> m SocketAddress)
-> IO SocketAddress -> m SocketAddress
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    IO SocketAddress -> IO () -> IO SocketAddress
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr SocketAddress
result <- (Ptr (Ptr GError) -> IO (Ptr SocketAddress))
-> IO (Ptr SocketAddress)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketAddress))
 -> IO (Ptr SocketAddress))
-> (Ptr (Ptr GError) -> IO (Ptr SocketAddress))
-> IO (Ptr SocketAddress)
forall a b. (a -> b) -> a -> b
$ Ptr SocketConnection -> Ptr (Ptr GError) -> IO (Ptr SocketAddress)
g_socket_connection_get_remote_address Ptr SocketConnection
connection'
        Text -> Ptr SocketAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketConnectionGetRemoteAddress" Ptr SocketAddress
result
        SocketAddress
result' <- ((ManagedPtr SocketAddress -> SocketAddress)
-> Ptr SocketAddress -> IO SocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketAddress -> SocketAddress
Gio.SocketAddress.SocketAddress) Ptr SocketAddress
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
        SocketAddress -> IO SocketAddress
forall (m :: * -> *) a. Monad m => a -> m a
return SocketAddress
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SocketConnectionGetRemoteAddressMethodInfo
instance (signature ~ (m Gio.SocketAddress.SocketAddress), MonadIO m, IsSocketConnection a) => O.MethodInfo SocketConnectionGetRemoteAddressMethodInfo a signature where
    overloadedMethod = socketConnectionGetRemoteAddress

#endif

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

foreign import ccall "g_socket_connection_get_socket" g_socket_connection_get_socket :: 
    Ptr SocketConnection ->                 -- connection : TInterface (Name {namespace = "Gio", name = "SocketConnection"})
    IO (Ptr Gio.Socket.Socket)

-- | Gets the underlying t'GI.Gio.Objects.Socket.Socket' object of the connection.
-- This can be useful if you want to do something unusual on it
-- not supported by the t'GI.Gio.Objects.SocketConnection.SocketConnection' APIs.
-- 
-- /Since: 2.22/
socketConnectionGetSocket ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a) =>
    a
    -- ^ /@connection@/: a t'GI.Gio.Objects.SocketConnection.SocketConnection'
    -> m Gio.Socket.Socket
    -- ^ __Returns:__ a t'GI.Gio.Objects.Socket.Socket' or 'P.Nothing' on error.
socketConnectionGetSocket :: a -> m Socket
socketConnectionGetSocket a
connection = IO Socket -> m Socket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Socket -> m Socket) -> IO Socket -> m Socket
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    Ptr Socket
result <- Ptr SocketConnection -> IO (Ptr Socket)
g_socket_connection_get_socket Ptr SocketConnection
connection'
    Text -> Ptr Socket -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketConnectionGetSocket" Ptr Socket
result
    Socket
result' <- ((ManagedPtr Socket -> Socket) -> Ptr Socket -> IO Socket
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Socket -> Socket
Gio.Socket.Socket) Ptr Socket
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
    Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
result'

#if defined(ENABLE_OVERLOADING)
data SocketConnectionGetSocketMethodInfo
instance (signature ~ (m Gio.Socket.Socket), MonadIO m, IsSocketConnection a) => O.MethodInfo SocketConnectionGetSocketMethodInfo a signature where
    overloadedMethod = socketConnectionGetSocket

#endif

-- method SocketConnection::is_connected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketConnection"
--                 , 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 "g_socket_connection_is_connected" g_socket_connection_is_connected :: 
    Ptr SocketConnection ->                 -- connection : TInterface (Name {namespace = "Gio", name = "SocketConnection"})
    IO CInt

-- | Checks if /@connection@/ is connected. This is equivalent to calling
-- 'GI.Gio.Objects.Socket.socketIsConnected' on /@connection@/\'s underlying t'GI.Gio.Objects.Socket.Socket'.
-- 
-- /Since: 2.32/
socketConnectionIsConnected ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a) =>
    a
    -- ^ /@connection@/: a t'GI.Gio.Objects.SocketConnection.SocketConnection'
    -> m Bool
    -- ^ __Returns:__ whether /@connection@/ is connected
socketConnectionIsConnected :: a -> m Bool
socketConnectionIsConnected a
connection = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    CInt
result <- Ptr SocketConnection -> IO CInt
g_socket_connection_is_connected Ptr SocketConnection
connection'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SocketConnectionIsConnectedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSocketConnection a) => O.MethodInfo SocketConnectionIsConnectedMethodInfo a signature where
    overloadedMethod = socketConnectionIsConnected

#endif

-- method SocketConnection::factory_lookup_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "family"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketFamily" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketFamily" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocol_id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a protocol id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "g_socket_connection_factory_lookup_type" g_socket_connection_factory_lookup_type :: 
    CUInt ->                                -- family : TInterface (Name {namespace = "Gio", name = "SocketFamily"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gio", name = "SocketType"})
    Int32 ->                                -- protocol_id : TBasicType TInt
    IO CGType

-- | Looks up the t'GType' to be used when creating socket connections on
-- sockets with the specified /@family@/, /@type@/ and /@protocolId@/.
-- 
-- If no type is registered, the t'GI.Gio.Objects.SocketConnection.SocketConnection' base type is returned.
-- 
-- /Since: 2.22/
socketConnectionFactoryLookupType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gio.Enums.SocketFamily
    -- ^ /@family@/: a t'GI.Gio.Enums.SocketFamily'
    -> Gio.Enums.SocketType
    -- ^ /@type@/: a t'GI.Gio.Enums.SocketType'
    -> Int32
    -- ^ /@protocolId@/: a protocol id
    -> m GType
    -- ^ __Returns:__ a t'GType'
socketConnectionFactoryLookupType :: SocketFamily -> SocketType -> Int32 -> m GType
socketConnectionFactoryLookupType SocketFamily
family SocketType
type_ Int32
protocolId = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    let family' :: CUInt
family' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SocketFamily -> Int) -> SocketFamily -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketFamily -> Int
forall a. Enum a => a -> Int
fromEnum) SocketFamily
family
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SocketType -> Int) -> SocketType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketType -> Int
forall a. Enum a => a -> Int
fromEnum) SocketType
type_
    CGType
result <- CUInt -> CUInt -> Int32 -> IO CGType
g_socket_connection_factory_lookup_type CUInt
family' CUInt
type_' Int32
protocolId
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SocketConnection::factory_register_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "g_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GType, inheriting from %G_TYPE_SOCKET_CONNECTION"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "family"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketFamily" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketFamily" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocol"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a protocol id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_socket_connection_factory_register_type" g_socket_connection_factory_register_type :: 
    CGType ->                               -- g_type : TBasicType TGType
    CUInt ->                                -- family : TInterface (Name {namespace = "Gio", name = "SocketFamily"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gio", name = "SocketType"})
    Int32 ->                                -- protocol : TBasicType TInt
    IO ()

-- | Looks up the t'GType' to be used when creating socket connections on
-- sockets with the specified /@family@/, /@type@/ and /@protocol@/.
-- 
-- If no type is registered, the t'GI.Gio.Objects.SocketConnection.SocketConnection' base type is returned.
-- 
-- /Since: 2.22/
socketConnectionFactoryRegisterType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@gType@/: a t'GType', inheriting from @/G_TYPE_SOCKET_CONNECTION/@
    -> Gio.Enums.SocketFamily
    -- ^ /@family@/: a t'GI.Gio.Enums.SocketFamily'
    -> Gio.Enums.SocketType
    -- ^ /@type@/: a t'GI.Gio.Enums.SocketType'
    -> Int32
    -- ^ /@protocol@/: a protocol id
    -> m ()
socketConnectionFactoryRegisterType :: GType -> SocketFamily -> SocketType -> Int32 -> m ()
socketConnectionFactoryRegisterType GType
gType SocketFamily
family SocketType
type_ Int32
protocol = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let gType' :: CGType
gType' = GType -> CGType
gtypeToCGType GType
gType
    let family' :: CUInt
family' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SocketFamily -> Int) -> SocketFamily -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketFamily -> Int
forall a. Enum a => a -> Int
fromEnum) SocketFamily
family
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SocketType -> Int) -> SocketType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketType -> Int
forall a. Enum a => a -> Int
fromEnum) SocketType
type_
    CGType -> CUInt -> CUInt -> Int32 -> IO ()
g_socket_connection_factory_register_type CGType
gType' CUInt
family' CUInt
type_' Int32
protocol
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif