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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Objects.SocketClient.SocketClient' is a lightweight high-level utility class for connecting to
-- a network host using a connection oriented socket type.
-- 
-- You create a t'GI.Gio.Objects.SocketClient.SocketClient' object, set any options you want, and then
-- call a sync or async connect operation, which returns a t'GI.Gio.Objects.SocketConnection.SocketConnection'
-- subclass on success.
-- 
-- The type of the t'GI.Gio.Objects.SocketConnection.SocketConnection' object returned 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'.
-- 
-- As t'GI.Gio.Objects.SocketClient.SocketClient' is a lightweight object, you don\'t need to cache it. You
-- can just create a new one any time you need one.
-- 
-- /Since: 2.22/

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

module GI.Gio.Objects.SocketClient
    ( 

-- * Exported types
    SocketClient(..)                        ,
    IsSocketClient                          ,
    toSocketClient                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addApplicationProxy]("GI.Gio.Objects.SocketClient#g:method:addApplicationProxy"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [connect]("GI.Gio.Objects.SocketClient#g:method:connect"), [connectAsync]("GI.Gio.Objects.SocketClient#g:method:connectAsync"), [connectFinish]("GI.Gio.Objects.SocketClient#g:method:connectFinish"), [connectToHost]("GI.Gio.Objects.SocketClient#g:method:connectToHost"), [connectToHostAsync]("GI.Gio.Objects.SocketClient#g:method:connectToHostAsync"), [connectToHostFinish]("GI.Gio.Objects.SocketClient#g:method:connectToHostFinish"), [connectToService]("GI.Gio.Objects.SocketClient#g:method:connectToService"), [connectToServiceAsync]("GI.Gio.Objects.SocketClient#g:method:connectToServiceAsync"), [connectToServiceFinish]("GI.Gio.Objects.SocketClient#g:method:connectToServiceFinish"), [connectToUri]("GI.Gio.Objects.SocketClient#g:method:connectToUri"), [connectToUriAsync]("GI.Gio.Objects.SocketClient#g:method:connectToUriAsync"), [connectToUriFinish]("GI.Gio.Objects.SocketClient#g:method:connectToUriFinish"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getEnableProxy]("GI.Gio.Objects.SocketClient#g:method:getEnableProxy"), [getFamily]("GI.Gio.Objects.SocketClient#g:method:getFamily"), [getLocalAddress]("GI.Gio.Objects.SocketClient#g:method:getLocalAddress"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getProtocol]("GI.Gio.Objects.SocketClient#g:method:getProtocol"), [getProxyResolver]("GI.Gio.Objects.SocketClient#g:method:getProxyResolver"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSocketType]("GI.Gio.Objects.SocketClient#g:method:getSocketType"), [getTimeout]("GI.Gio.Objects.SocketClient#g:method:getTimeout"), [getTls]("GI.Gio.Objects.SocketClient#g:method:getTls"), [getTlsValidationFlags]("GI.Gio.Objects.SocketClient#g:method:getTlsValidationFlags").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEnableProxy]("GI.Gio.Objects.SocketClient#g:method:setEnableProxy"), [setFamily]("GI.Gio.Objects.SocketClient#g:method:setFamily"), [setLocalAddress]("GI.Gio.Objects.SocketClient#g:method:setLocalAddress"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setProtocol]("GI.Gio.Objects.SocketClient#g:method:setProtocol"), [setProxyResolver]("GI.Gio.Objects.SocketClient#g:method:setProxyResolver"), [setSocketType]("GI.Gio.Objects.SocketClient#g:method:setSocketType"), [setTimeout]("GI.Gio.Objects.SocketClient#g:method:setTimeout"), [setTls]("GI.Gio.Objects.SocketClient#g:method:setTls"), [setTlsValidationFlags]("GI.Gio.Objects.SocketClient#g:method:setTlsValidationFlags").

#if defined(ENABLE_OVERLOADING)
    ResolveSocketClientMethod               ,
#endif

-- ** addApplicationProxy #method:addApplicationProxy#

#if defined(ENABLE_OVERLOADING)
    SocketClientAddApplicationProxyMethodInfo,
#endif
    socketClientAddApplicationProxy         ,


-- ** connect #method:connect#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectMethodInfo           ,
#endif
    socketClientConnect                     ,


-- ** connectAsync #method:connectAsync#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectAsyncMethodInfo      ,
#endif
    socketClientConnectAsync                ,


-- ** connectFinish #method:connectFinish#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectFinishMethodInfo     ,
#endif
    socketClientConnectFinish               ,


-- ** connectToHost #method:connectToHost#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectToHostMethodInfo     ,
#endif
    socketClientConnectToHost               ,


-- ** connectToHostAsync #method:connectToHostAsync#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectToHostAsyncMethodInfo,
#endif
    socketClientConnectToHostAsync          ,


-- ** connectToHostFinish #method:connectToHostFinish#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectToHostFinishMethodInfo,
#endif
    socketClientConnectToHostFinish         ,


-- ** connectToService #method:connectToService#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectToServiceMethodInfo  ,
#endif
    socketClientConnectToService            ,


-- ** connectToServiceAsync #method:connectToServiceAsync#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectToServiceAsyncMethodInfo,
#endif
    socketClientConnectToServiceAsync       ,


-- ** connectToServiceFinish #method:connectToServiceFinish#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectToServiceFinishMethodInfo,
#endif
    socketClientConnectToServiceFinish      ,


-- ** connectToUri #method:connectToUri#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectToUriMethodInfo      ,
#endif
    socketClientConnectToUri                ,


-- ** connectToUriAsync #method:connectToUriAsync#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectToUriAsyncMethodInfo ,
#endif
    socketClientConnectToUriAsync           ,


-- ** connectToUriFinish #method:connectToUriFinish#

#if defined(ENABLE_OVERLOADING)
    SocketClientConnectToUriFinishMethodInfo,
#endif
    socketClientConnectToUriFinish          ,


-- ** getEnableProxy #method:getEnableProxy#

#if defined(ENABLE_OVERLOADING)
    SocketClientGetEnableProxyMethodInfo    ,
#endif
    socketClientGetEnableProxy              ,


-- ** getFamily #method:getFamily#

#if defined(ENABLE_OVERLOADING)
    SocketClientGetFamilyMethodInfo         ,
#endif
    socketClientGetFamily                   ,


-- ** getLocalAddress #method:getLocalAddress#

#if defined(ENABLE_OVERLOADING)
    SocketClientGetLocalAddressMethodInfo   ,
#endif
    socketClientGetLocalAddress             ,


-- ** getProtocol #method:getProtocol#

#if defined(ENABLE_OVERLOADING)
    SocketClientGetProtocolMethodInfo       ,
#endif
    socketClientGetProtocol                 ,


-- ** getProxyResolver #method:getProxyResolver#

#if defined(ENABLE_OVERLOADING)
    SocketClientGetProxyResolverMethodInfo  ,
#endif
    socketClientGetProxyResolver            ,


-- ** getSocketType #method:getSocketType#

#if defined(ENABLE_OVERLOADING)
    SocketClientGetSocketTypeMethodInfo     ,
#endif
    socketClientGetSocketType               ,


-- ** getTimeout #method:getTimeout#

#if defined(ENABLE_OVERLOADING)
    SocketClientGetTimeoutMethodInfo        ,
#endif
    socketClientGetTimeout                  ,


-- ** getTls #method:getTls#

#if defined(ENABLE_OVERLOADING)
    SocketClientGetTlsMethodInfo            ,
#endif
    socketClientGetTls                      ,


-- ** getTlsValidationFlags #method:getTlsValidationFlags#

#if defined(ENABLE_OVERLOADING)
    SocketClientGetTlsValidationFlagsMethodInfo,
#endif
    socketClientGetTlsValidationFlags       ,


-- ** new #method:new#

    socketClientNew                         ,


-- ** setEnableProxy #method:setEnableProxy#

#if defined(ENABLE_OVERLOADING)
    SocketClientSetEnableProxyMethodInfo    ,
#endif
    socketClientSetEnableProxy              ,


-- ** setFamily #method:setFamily#

#if defined(ENABLE_OVERLOADING)
    SocketClientSetFamilyMethodInfo         ,
#endif
    socketClientSetFamily                   ,


-- ** setLocalAddress #method:setLocalAddress#

#if defined(ENABLE_OVERLOADING)
    SocketClientSetLocalAddressMethodInfo   ,
#endif
    socketClientSetLocalAddress             ,


-- ** setProtocol #method:setProtocol#

#if defined(ENABLE_OVERLOADING)
    SocketClientSetProtocolMethodInfo       ,
#endif
    socketClientSetProtocol                 ,


-- ** setProxyResolver #method:setProxyResolver#

#if defined(ENABLE_OVERLOADING)
    SocketClientSetProxyResolverMethodInfo  ,
#endif
    socketClientSetProxyResolver            ,


-- ** setSocketType #method:setSocketType#

#if defined(ENABLE_OVERLOADING)
    SocketClientSetSocketTypeMethodInfo     ,
#endif
    socketClientSetSocketType               ,


-- ** setTimeout #method:setTimeout#

#if defined(ENABLE_OVERLOADING)
    SocketClientSetTimeoutMethodInfo        ,
#endif
    socketClientSetTimeout                  ,


-- ** setTls #method:setTls#

#if defined(ENABLE_OVERLOADING)
    SocketClientSetTlsMethodInfo            ,
#endif
    socketClientSetTls                      ,


-- ** setTlsValidationFlags #method:setTlsValidationFlags#

#if defined(ENABLE_OVERLOADING)
    SocketClientSetTlsValidationFlagsMethodInfo,
#endif
    socketClientSetTlsValidationFlags       ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    SocketClientEnableProxyPropertyInfo     ,
#endif
    constructSocketClientEnableProxy        ,
    getSocketClientEnableProxy              ,
    setSocketClientEnableProxy              ,
#if defined(ENABLE_OVERLOADING)
    socketClientEnableProxy                 ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SocketClientFamilyPropertyInfo          ,
#endif
    constructSocketClientFamily             ,
    getSocketClientFamily                   ,
    setSocketClientFamily                   ,
#if defined(ENABLE_OVERLOADING)
    socketClientFamily                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SocketClientLocalAddressPropertyInfo    ,
#endif
    clearSocketClientLocalAddress           ,
    constructSocketClientLocalAddress       ,
    getSocketClientLocalAddress             ,
    setSocketClientLocalAddress             ,
#if defined(ENABLE_OVERLOADING)
    socketClientLocalAddress                ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SocketClientProtocolPropertyInfo        ,
#endif
    constructSocketClientProtocol           ,
    getSocketClientProtocol                 ,
    setSocketClientProtocol                 ,
#if defined(ENABLE_OVERLOADING)
    socketClientProtocol                    ,
#endif


-- ** proxyResolver #attr:proxyResolver#
-- | The proxy resolver to use
-- 
-- /Since: 2.36/

#if defined(ENABLE_OVERLOADING)
    SocketClientProxyResolverPropertyInfo   ,
#endif
    clearSocketClientProxyResolver          ,
    constructSocketClientProxyResolver      ,
    getSocketClientProxyResolver            ,
    setSocketClientProxyResolver            ,
#if defined(ENABLE_OVERLOADING)
    socketClientProxyResolver               ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SocketClientTimeoutPropertyInfo         ,
#endif
    constructSocketClientTimeout            ,
    getSocketClientTimeout                  ,
    setSocketClientTimeout                  ,
#if defined(ENABLE_OVERLOADING)
    socketClientTimeout                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SocketClientTlsPropertyInfo             ,
#endif
    constructSocketClientTls                ,
    getSocketClientTls                      ,
    setSocketClientTls                      ,
#if defined(ENABLE_OVERLOADING)
    socketClientTls                         ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SocketClientTlsValidationFlagsPropertyInfo,
#endif
    constructSocketClientTlsValidationFlags ,
    getSocketClientTlsValidationFlags       ,
    setSocketClientTlsValidationFlags       ,
#if defined(ENABLE_OVERLOADING)
    socketClientTlsValidationFlags          ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SocketClientTypePropertyInfo            ,
#endif
    constructSocketClientType               ,
    getSocketClientType                     ,
    setSocketClientType                     ,
#if defined(ENABLE_OVERLOADING)
    socketClientType                        ,
#endif




 -- * Signals


-- ** event #signal:event#

    SocketClientEventCallback               ,
#if defined(ENABLE_OVERLOADING)
    SocketClientEventSignalInfo             ,
#endif
    afterSocketClientEvent                  ,
    onSocketClientEvent                     ,




    ) where

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

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

import qualified GI.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.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.ProxyResolver as Gio.ProxyResolver
import {-# SOURCE #-} qualified GI.Gio.Interfaces.SocketConnectable as Gio.SocketConnectable
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.SocketAddress as Gio.SocketAddress
import {-# SOURCE #-} qualified GI.Gio.Objects.SocketConnection as Gio.SocketConnection

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

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

foreign import ccall "g_socket_client_get_type"
    c_g_socket_client_get_type :: IO B.Types.GType

instance B.Types.TypedObject SocketClient where
    glibType :: IO GType
glibType = IO GType
c_g_socket_client_get_type

instance B.Types.GObject SocketClient

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

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

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

-- | Convert 'SocketClient' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe SocketClient) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_socket_client_get_type
    gvalueSet_ :: Ptr GValue -> Maybe SocketClient -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SocketClient
P.Nothing = Ptr GValue -> Ptr SocketClient -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SocketClient
forall a. Ptr a
FP.nullPtr :: FP.Ptr SocketClient)
    gvalueSet_ Ptr GValue
gv (P.Just SocketClient
obj) = SocketClient -> (Ptr SocketClient -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SocketClient
obj (Ptr GValue -> Ptr SocketClient -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe SocketClient)
gvalueGet_ Ptr GValue
gv = do
        Ptr SocketClient
ptr <- Ptr GValue -> IO (Ptr SocketClient)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SocketClient)
        if Ptr SocketClient
ptr Ptr SocketClient -> Ptr SocketClient -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SocketClient
forall a. Ptr a
FP.nullPtr
        then SocketClient -> Maybe SocketClient
forall a. a -> Maybe a
P.Just (SocketClient -> Maybe SocketClient)
-> IO SocketClient -> IO (Maybe SocketClient)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SocketClient -> SocketClient)
-> Ptr SocketClient -> IO SocketClient
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SocketClient -> SocketClient
SocketClient Ptr SocketClient
ptr
        else Maybe SocketClient -> IO (Maybe SocketClient)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SocketClient
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveSocketClientMethod (t :: Symbol) (o :: *) :: * where
    ResolveSocketClientMethod "addApplicationProxy" o = SocketClientAddApplicationProxyMethodInfo
    ResolveSocketClientMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSocketClientMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSocketClientMethod "connect" o = SocketClientConnectMethodInfo
    ResolveSocketClientMethod "connectAsync" o = SocketClientConnectAsyncMethodInfo
    ResolveSocketClientMethod "connectFinish" o = SocketClientConnectFinishMethodInfo
    ResolveSocketClientMethod "connectToHost" o = SocketClientConnectToHostMethodInfo
    ResolveSocketClientMethod "connectToHostAsync" o = SocketClientConnectToHostAsyncMethodInfo
    ResolveSocketClientMethod "connectToHostFinish" o = SocketClientConnectToHostFinishMethodInfo
    ResolveSocketClientMethod "connectToService" o = SocketClientConnectToServiceMethodInfo
    ResolveSocketClientMethod "connectToServiceAsync" o = SocketClientConnectToServiceAsyncMethodInfo
    ResolveSocketClientMethod "connectToServiceFinish" o = SocketClientConnectToServiceFinishMethodInfo
    ResolveSocketClientMethod "connectToUri" o = SocketClientConnectToUriMethodInfo
    ResolveSocketClientMethod "connectToUriAsync" o = SocketClientConnectToUriAsyncMethodInfo
    ResolveSocketClientMethod "connectToUriFinish" o = SocketClientConnectToUriFinishMethodInfo
    ResolveSocketClientMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSocketClientMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSocketClientMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSocketClientMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSocketClientMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSocketClientMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSocketClientMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSocketClientMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSocketClientMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSocketClientMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSocketClientMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSocketClientMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSocketClientMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSocketClientMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSocketClientMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSocketClientMethod "getEnableProxy" o = SocketClientGetEnableProxyMethodInfo
    ResolveSocketClientMethod "getFamily" o = SocketClientGetFamilyMethodInfo
    ResolveSocketClientMethod "getLocalAddress" o = SocketClientGetLocalAddressMethodInfo
    ResolveSocketClientMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSocketClientMethod "getProtocol" o = SocketClientGetProtocolMethodInfo
    ResolveSocketClientMethod "getProxyResolver" o = SocketClientGetProxyResolverMethodInfo
    ResolveSocketClientMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSocketClientMethod "getSocketType" o = SocketClientGetSocketTypeMethodInfo
    ResolveSocketClientMethod "getTimeout" o = SocketClientGetTimeoutMethodInfo
    ResolveSocketClientMethod "getTls" o = SocketClientGetTlsMethodInfo
    ResolveSocketClientMethod "getTlsValidationFlags" o = SocketClientGetTlsValidationFlagsMethodInfo
    ResolveSocketClientMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSocketClientMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSocketClientMethod "setEnableProxy" o = SocketClientSetEnableProxyMethodInfo
    ResolveSocketClientMethod "setFamily" o = SocketClientSetFamilyMethodInfo
    ResolveSocketClientMethod "setLocalAddress" o = SocketClientSetLocalAddressMethodInfo
    ResolveSocketClientMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSocketClientMethod "setProtocol" o = SocketClientSetProtocolMethodInfo
    ResolveSocketClientMethod "setProxyResolver" o = SocketClientSetProxyResolverMethodInfo
    ResolveSocketClientMethod "setSocketType" o = SocketClientSetSocketTypeMethodInfo
    ResolveSocketClientMethod "setTimeout" o = SocketClientSetTimeoutMethodInfo
    ResolveSocketClientMethod "setTls" o = SocketClientSetTlsMethodInfo
    ResolveSocketClientMethod "setTlsValidationFlags" o = SocketClientSetTlsValidationFlagsMethodInfo
    ResolveSocketClientMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveSocketClientMethod t SocketClient, O.OverloadedMethod info SocketClient p, R.HasField t SocketClient p) => R.HasField t SocketClient p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- signal SocketClient::event
-- | Emitted when /@client@/\'s activity on /@connectable@/ changes state.
-- Among other things, this can be used to provide progress
-- information about a network connection in the UI. The meanings of
-- the different /@event@/ values are as follows:
-- 
-- * 'GI.Gio.Enums.SocketClientEventResolving': /@client@/ is about to look up /@connectable@/
-- in DNS. /@connection@/ will be 'P.Nothing'.
-- * 'GI.Gio.Enums.SocketClientEventResolved':  /@client@/ has successfully resolved
-- /@connectable@/ in DNS. /@connection@/ will be 'P.Nothing'.
-- * 'GI.Gio.Enums.SocketClientEventConnecting': /@client@/ is about to make a connection
-- to a remote host; either a proxy server or the destination server
-- itself. /@connection@/ is the t'GI.Gio.Objects.SocketConnection.SocketConnection', which is not yet
-- connected.  Since GLib 2.40, you can access the remote
-- address via 'GI.Gio.Objects.SocketConnection.socketConnectionGetRemoteAddress'.
-- * 'GI.Gio.Enums.SocketClientEventConnected': /@client@/ has successfully connected
-- to a remote host. /@connection@/ is the connected t'GI.Gio.Objects.SocketConnection.SocketConnection'.
-- * 'GI.Gio.Enums.SocketClientEventProxyNegotiating': /@client@/ is about to negotiate
-- with a proxy to get it to connect to /@connectable@/. /@connection@/ is
-- the t'GI.Gio.Objects.SocketConnection.SocketConnection' to the proxy server.
-- * 'GI.Gio.Enums.SocketClientEventProxyNegotiated': /@client@/ has negotiated a
-- connection to /@connectable@/ through a proxy server. /@connection@/ is
-- the stream returned from 'GI.Gio.Interfaces.Proxy.proxyConnect', which may or may not
-- be a t'GI.Gio.Objects.SocketConnection.SocketConnection'.
-- * 'GI.Gio.Enums.SocketClientEventTlsHandshaking': /@client@/ is about to begin a TLS
-- handshake. /@connection@/ is a t'GI.Gio.Interfaces.TlsClientConnection.TlsClientConnection'.
-- * 'GI.Gio.Enums.SocketClientEventTlsHandshaked': /@client@/ has successfully completed
-- the TLS handshake. /@connection@/ is a t'GI.Gio.Interfaces.TlsClientConnection.TlsClientConnection'.
-- * 'GI.Gio.Enums.SocketClientEventComplete': /@client@/ has either successfully connected
-- to /@connectable@/ (in which case /@connection@/ is the t'GI.Gio.Objects.SocketConnection.SocketConnection'
-- that it will be returning to the caller) or has failed (in which
-- case /@connection@/ is 'P.Nothing' and the client is about to return an error).
-- 
-- 
-- Each event except 'GI.Gio.Enums.SocketClientEventComplete' may be emitted
-- multiple times (or not at all) for a given connectable (in
-- particular, if /@client@/ ends up attempting to connect to more than
-- one address). However, if /@client@/ emits the [SocketClient::event]("GI.Gio.Objects.SocketClient#g:signal:event")
-- signal at all for a given connectable, then it will always emit
-- it with 'GI.Gio.Enums.SocketClientEventComplete' when it is done.
-- 
-- Note that there may be additional t'GI.Gio.Enums.SocketClientEvent' values in
-- the future; unrecognized /@event@/ values should be ignored.
-- 
-- /Since: 2.32/
type SocketClientEventCallback =
    Gio.Enums.SocketClientEvent
    -- ^ /@event@/: the event that is occurring
    -> Gio.SocketConnectable.SocketConnectable
    -- ^ /@connectable@/: the t'GI.Gio.Interfaces.SocketConnectable.SocketConnectable' that /@event@/ is occurring on
    -> Maybe Gio.IOStream.IOStream
    -- ^ /@connection@/: the current representation of the connection
    -> IO ()

type C_SocketClientEventCallback =
    Ptr SocketClient ->                     -- object
    CUInt ->
    Ptr Gio.SocketConnectable.SocketConnectable ->
    Ptr Gio.IOStream.IOStream ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_SocketClientEventCallback :: 
    GObject a => (a -> SocketClientEventCallback) ->
    C_SocketClientEventCallback
wrap_SocketClientEventCallback :: forall a.
GObject a =>
(a -> SocketClientEventCallback) -> C_SocketClientEventCallback
wrap_SocketClientEventCallback a -> SocketClientEventCallback
gi'cb Ptr SocketClient
gi'selfPtr CUInt
event Ptr SocketConnectable
connectable Ptr IOStream
connection Ptr ()
_ = do
    let event' :: SocketClientEvent
event' = (Int -> SocketClientEvent
forall a. Enum a => Int -> a
toEnum (Int -> SocketClientEvent)
-> (CUInt -> Int) -> CUInt -> SocketClientEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
event
    SocketConnectable
connectable' <- ((ManagedPtr SocketConnectable -> SocketConnectable)
-> Ptr SocketConnectable -> IO SocketConnectable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SocketConnectable -> SocketConnectable
Gio.SocketConnectable.SocketConnectable) Ptr SocketConnectable
connectable
    Maybe IOStream
maybeConnection <-
        if Ptr IOStream
connection Ptr IOStream -> Ptr IOStream -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr IOStream
forall a. Ptr a
nullPtr
        then Maybe IOStream -> IO (Maybe IOStream)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IOStream
forall a. Maybe a
Nothing
        else do
            IOStream
connection' <- ((ManagedPtr IOStream -> IOStream) -> Ptr IOStream -> IO IOStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr IOStream -> IOStream
Gio.IOStream.IOStream) Ptr IOStream
connection
            Maybe IOStream -> IO (Maybe IOStream)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe IOStream -> IO (Maybe IOStream))
-> Maybe IOStream -> IO (Maybe IOStream)
forall a b. (a -> b) -> a -> b
$ IOStream -> Maybe IOStream
forall a. a -> Maybe a
Just IOStream
connection'
    Ptr SocketClient -> (SocketClient -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr SocketClient
gi'selfPtr ((SocketClient -> IO ()) -> IO ())
-> (SocketClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SocketClient
gi'self -> a -> SocketClientEventCallback
gi'cb (SocketClient -> a
Coerce.coerce SocketClient
gi'self)  SocketClientEvent
event' SocketConnectable
connectable' Maybe IOStream
maybeConnection


-- | Connect a signal handler for the [event](#signal:event) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' socketClient #event callback
-- @
-- 
-- 
onSocketClientEvent :: (IsSocketClient a, MonadIO m) => a -> ((?self :: a) => SocketClientEventCallback) -> m SignalHandlerId
onSocketClientEvent :: forall a (m :: * -> *).
(IsSocketClient a, MonadIO m) =>
a -> ((?self::a) => SocketClientEventCallback) -> m SignalHandlerId
onSocketClientEvent a
obj (?self::a) => SocketClientEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SocketClientEventCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SocketClientEventCallback
SocketClientEventCallback
cb
    let wrapped' :: C_SocketClientEventCallback
wrapped' = (a -> SocketClientEventCallback) -> C_SocketClientEventCallback
forall a.
GObject a =>
(a -> SocketClientEventCallback) -> C_SocketClientEventCallback
wrap_SocketClientEventCallback a -> SocketClientEventCallback
wrapped
    FunPtr C_SocketClientEventCallback
wrapped'' <- C_SocketClientEventCallback
-> IO (FunPtr C_SocketClientEventCallback)
mk_SocketClientEventCallback C_SocketClientEventCallback
wrapped'
    a
-> Text
-> FunPtr C_SocketClientEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"event" FunPtr C_SocketClientEventCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [event](#signal:event) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' socketClient #event callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterSocketClientEvent :: (IsSocketClient a, MonadIO m) => a -> ((?self :: a) => SocketClientEventCallback) -> m SignalHandlerId
afterSocketClientEvent :: forall a (m :: * -> *).
(IsSocketClient a, MonadIO m) =>
a -> ((?self::a) => SocketClientEventCallback) -> m SignalHandlerId
afterSocketClientEvent a
obj (?self::a) => SocketClientEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SocketClientEventCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SocketClientEventCallback
SocketClientEventCallback
cb
    let wrapped' :: C_SocketClientEventCallback
wrapped' = (a -> SocketClientEventCallback) -> C_SocketClientEventCallback
forall a.
GObject a =>
(a -> SocketClientEventCallback) -> C_SocketClientEventCallback
wrap_SocketClientEventCallback a -> SocketClientEventCallback
wrapped
    FunPtr C_SocketClientEventCallback
wrapped'' <- C_SocketClientEventCallback
-> IO (FunPtr C_SocketClientEventCallback)
mk_SocketClientEventCallback C_SocketClientEventCallback
wrapped'
    a
-> Text
-> FunPtr C_SocketClientEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"event" FunPtr C_SocketClientEventCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data SocketClientEventSignalInfo
instance SignalInfo SocketClientEventSignalInfo where
    type HaskellCallbackType SocketClientEventSignalInfo = SocketClientEventCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SocketClientEventCallback cb
        cb'' <- mk_SocketClientEventCallback cb'
        connectSignalFunPtr obj "event" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient::event"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#g:signal:event"})

#endif

-- VVV Prop "enable-proxy"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@enable-proxy@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' socketClient [ #enableProxy 'Data.GI.Base.Attributes.:=' value ]
-- @
setSocketClientEnableProxy :: (MonadIO m, IsSocketClient o) => o -> Bool -> m ()
setSocketClientEnableProxy :: forall (m :: * -> *) o.
(MonadIO m, IsSocketClient o) =>
o -> Bool -> m ()
setSocketClientEnableProxy o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"enable-proxy" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@enable-proxy@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSocketClientEnableProxy :: (IsSocketClient o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSocketClientEnableProxy :: forall o (m :: * -> *).
(IsSocketClient o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructSocketClientEnableProxy Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"enable-proxy" Bool
val

#if defined(ENABLE_OVERLOADING)
data SocketClientEnableProxyPropertyInfo
instance AttrInfo SocketClientEnableProxyPropertyInfo where
    type AttrAllowedOps SocketClientEnableProxyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SocketClientEnableProxyPropertyInfo = IsSocketClient
    type AttrSetTypeConstraint SocketClientEnableProxyPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SocketClientEnableProxyPropertyInfo = (~) Bool
    type AttrTransferType SocketClientEnableProxyPropertyInfo = Bool
    type AttrGetType SocketClientEnableProxyPropertyInfo = Bool
    type AttrLabel SocketClientEnableProxyPropertyInfo = "enable-proxy"
    type AttrOrigin SocketClientEnableProxyPropertyInfo = SocketClient
    attrGet = getSocketClientEnableProxy
    attrSet = setSocketClientEnableProxy
    attrTransfer _ v = do
        return v
    attrConstruct = constructSocketClientEnableProxy
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.enableProxy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#g:attr:enableProxy"
        })
#endif

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

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

-- | Set the value of the “@family@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' socketClient [ #family 'Data.GI.Base.Attributes.:=' value ]
-- @
setSocketClientFamily :: (MonadIO m, IsSocketClient o) => o -> Gio.Enums.SocketFamily -> m ()
setSocketClientFamily :: forall (m :: * -> *) o.
(MonadIO m, IsSocketClient o) =>
o -> SocketFamily -> m ()
setSocketClientFamily o
obj SocketFamily
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> SocketFamily -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"family" SocketFamily
val

-- | Construct a `GValueConstruct` with valid value for the “@family@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSocketClientFamily :: (IsSocketClient o, MIO.MonadIO m) => Gio.Enums.SocketFamily -> m (GValueConstruct o)
constructSocketClientFamily :: forall o (m :: * -> *).
(IsSocketClient o, MonadIO m) =>
SocketFamily -> m (GValueConstruct o)
constructSocketClientFamily SocketFamily
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> SocketFamily -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"family" SocketFamily
val

#if defined(ENABLE_OVERLOADING)
data SocketClientFamilyPropertyInfo
instance AttrInfo SocketClientFamilyPropertyInfo where
    type AttrAllowedOps SocketClientFamilyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SocketClientFamilyPropertyInfo = IsSocketClient
    type AttrSetTypeConstraint SocketClientFamilyPropertyInfo = (~) Gio.Enums.SocketFamily
    type AttrTransferTypeConstraint SocketClientFamilyPropertyInfo = (~) Gio.Enums.SocketFamily
    type AttrTransferType SocketClientFamilyPropertyInfo = Gio.Enums.SocketFamily
    type AttrGetType SocketClientFamilyPropertyInfo = Gio.Enums.SocketFamily
    type AttrLabel SocketClientFamilyPropertyInfo = "family"
    type AttrOrigin SocketClientFamilyPropertyInfo = SocketClient
    attrGet = getSocketClientFamily
    attrSet = setSocketClientFamily
    attrTransfer _ v = do
        return v
    attrConstruct = constructSocketClientFamily
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.family"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#g:attr:family"
        })
#endif

-- VVV Prop "local-address"
   -- Type: TInterface (Name {namespace = "Gio", name = "SocketAddress"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just True,Just True)

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

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

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

-- | Set the value of the “@local-address@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #localAddress
-- @
clearSocketClientLocalAddress :: (MonadIO m, IsSocketClient o) => o -> m ()
clearSocketClientLocalAddress :: forall (m :: * -> *) o. (MonadIO m, IsSocketClient o) => o -> m ()
clearSocketClientLocalAddress o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe SocketAddress -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"local-address" (Maybe SocketAddress
forall a. Maybe a
Nothing :: Maybe Gio.SocketAddress.SocketAddress)

#if defined(ENABLE_OVERLOADING)
data SocketClientLocalAddressPropertyInfo
instance AttrInfo SocketClientLocalAddressPropertyInfo where
    type AttrAllowedOps SocketClientLocalAddressPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SocketClientLocalAddressPropertyInfo = IsSocketClient
    type AttrSetTypeConstraint SocketClientLocalAddressPropertyInfo = Gio.SocketAddress.IsSocketAddress
    type AttrTransferTypeConstraint SocketClientLocalAddressPropertyInfo = Gio.SocketAddress.IsSocketAddress
    type AttrTransferType SocketClientLocalAddressPropertyInfo = Gio.SocketAddress.SocketAddress
    type AttrGetType SocketClientLocalAddressPropertyInfo = (Maybe Gio.SocketAddress.SocketAddress)
    type AttrLabel SocketClientLocalAddressPropertyInfo = "local-address"
    type AttrOrigin SocketClientLocalAddressPropertyInfo = SocketClient
    attrGet = getSocketClientLocalAddress
    attrSet = setSocketClientLocalAddress
    attrTransfer _ v = do
        unsafeCastTo Gio.SocketAddress.SocketAddress v
    attrConstruct = constructSocketClientLocalAddress
    attrClear = clearSocketClientLocalAddress
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.localAddress"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#g:attr:localAddress"
        })
#endif

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

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

-- | Set the value of the “@protocol@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' socketClient [ #protocol 'Data.GI.Base.Attributes.:=' value ]
-- @
setSocketClientProtocol :: (MonadIO m, IsSocketClient o) => o -> Gio.Enums.SocketProtocol -> m ()
setSocketClientProtocol :: forall (m :: * -> *) o.
(MonadIO m, IsSocketClient o) =>
o -> SocketProtocol -> m ()
setSocketClientProtocol o
obj SocketProtocol
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> SocketProtocol -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"protocol" SocketProtocol
val

-- | Construct a `GValueConstruct` with valid value for the “@protocol@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSocketClientProtocol :: (IsSocketClient o, MIO.MonadIO m) => Gio.Enums.SocketProtocol -> m (GValueConstruct o)
constructSocketClientProtocol :: forall o (m :: * -> *).
(IsSocketClient o, MonadIO m) =>
SocketProtocol -> m (GValueConstruct o)
constructSocketClientProtocol SocketProtocol
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> SocketProtocol -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"protocol" SocketProtocol
val

#if defined(ENABLE_OVERLOADING)
data SocketClientProtocolPropertyInfo
instance AttrInfo SocketClientProtocolPropertyInfo where
    type AttrAllowedOps SocketClientProtocolPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SocketClientProtocolPropertyInfo = IsSocketClient
    type AttrSetTypeConstraint SocketClientProtocolPropertyInfo = (~) Gio.Enums.SocketProtocol
    type AttrTransferTypeConstraint SocketClientProtocolPropertyInfo = (~) Gio.Enums.SocketProtocol
    type AttrTransferType SocketClientProtocolPropertyInfo = Gio.Enums.SocketProtocol
    type AttrGetType SocketClientProtocolPropertyInfo = Gio.Enums.SocketProtocol
    type AttrLabel SocketClientProtocolPropertyInfo = "protocol"
    type AttrOrigin SocketClientProtocolPropertyInfo = SocketClient
    attrGet = getSocketClientProtocol
    attrSet = setSocketClientProtocol
    attrTransfer _ v = do
        return v
    attrConstruct = constructSocketClientProtocol
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.protocol"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#g:attr:protocol"
        })
#endif

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

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

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

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

-- | Set the value of the “@proxy-resolver@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #proxyResolver
-- @
clearSocketClientProxyResolver :: (MonadIO m, IsSocketClient o) => o -> m ()
clearSocketClientProxyResolver :: forall (m :: * -> *) o. (MonadIO m, IsSocketClient o) => o -> m ()
clearSocketClientProxyResolver o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe ProxyResolver -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"proxy-resolver" (Maybe ProxyResolver
forall a. Maybe a
Nothing :: Maybe Gio.ProxyResolver.ProxyResolver)

#if defined(ENABLE_OVERLOADING)
data SocketClientProxyResolverPropertyInfo
instance AttrInfo SocketClientProxyResolverPropertyInfo where
    type AttrAllowedOps SocketClientProxyResolverPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SocketClientProxyResolverPropertyInfo = IsSocketClient
    type AttrSetTypeConstraint SocketClientProxyResolverPropertyInfo = Gio.ProxyResolver.IsProxyResolver
    type AttrTransferTypeConstraint SocketClientProxyResolverPropertyInfo = Gio.ProxyResolver.IsProxyResolver
    type AttrTransferType SocketClientProxyResolverPropertyInfo = Gio.ProxyResolver.ProxyResolver
    type AttrGetType SocketClientProxyResolverPropertyInfo = Gio.ProxyResolver.ProxyResolver
    type AttrLabel SocketClientProxyResolverPropertyInfo = "proxy-resolver"
    type AttrOrigin SocketClientProxyResolverPropertyInfo = SocketClient
    attrGet = getSocketClientProxyResolver
    attrSet = setSocketClientProxyResolver
    attrTransfer _ v = do
        unsafeCastTo Gio.ProxyResolver.ProxyResolver v
    attrConstruct = constructSocketClientProxyResolver
    attrClear = clearSocketClientProxyResolver
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.proxyResolver"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#g:attr:proxyResolver"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data SocketClientTimeoutPropertyInfo
instance AttrInfo SocketClientTimeoutPropertyInfo where
    type AttrAllowedOps SocketClientTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SocketClientTimeoutPropertyInfo = IsSocketClient
    type AttrSetTypeConstraint SocketClientTimeoutPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint SocketClientTimeoutPropertyInfo = (~) Word32
    type AttrTransferType SocketClientTimeoutPropertyInfo = Word32
    type AttrGetType SocketClientTimeoutPropertyInfo = Word32
    type AttrLabel SocketClientTimeoutPropertyInfo = "timeout"
    type AttrOrigin SocketClientTimeoutPropertyInfo = SocketClient
    attrGet = getSocketClientTimeout
    attrSet = setSocketClientTimeout
    attrTransfer _ v = do
        return v
    attrConstruct = constructSocketClientTimeout
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.timeout"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#g:attr:timeout"
        })
#endif

-- VVV Prop "tls"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@tls@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSocketClientTls :: (IsSocketClient o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSocketClientTls :: forall o (m :: * -> *).
(IsSocketClient o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructSocketClientTls Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"tls" Bool
val

#if defined(ENABLE_OVERLOADING)
data SocketClientTlsPropertyInfo
instance AttrInfo SocketClientTlsPropertyInfo where
    type AttrAllowedOps SocketClientTlsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SocketClientTlsPropertyInfo = IsSocketClient
    type AttrSetTypeConstraint SocketClientTlsPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SocketClientTlsPropertyInfo = (~) Bool
    type AttrTransferType SocketClientTlsPropertyInfo = Bool
    type AttrGetType SocketClientTlsPropertyInfo = Bool
    type AttrLabel SocketClientTlsPropertyInfo = "tls"
    type AttrOrigin SocketClientTlsPropertyInfo = SocketClient
    attrGet = getSocketClientTls
    attrSet = setSocketClientTls
    attrTransfer _ v = do
        return v
    attrConstruct = constructSocketClientTls
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.tls"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#g:attr:tls"
        })
#endif

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

-- | Get the value of the “@tls-validation-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' socketClient #tlsValidationFlags
-- @
getSocketClientTlsValidationFlags :: (MonadIO m, IsSocketClient o) => o -> m [Gio.Flags.TlsCertificateFlags]
getSocketClientTlsValidationFlags :: forall (m :: * -> *) o.
(MonadIO m, IsSocketClient o) =>
o -> m [TlsCertificateFlags]
getSocketClientTlsValidationFlags o
obj = IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [TlsCertificateFlags] -> m [TlsCertificateFlags])
-> IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [TlsCertificateFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"tls-validation-flags"

-- | Set the value of the “@tls-validation-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' socketClient [ #tlsValidationFlags 'Data.GI.Base.Attributes.:=' value ]
-- @
setSocketClientTlsValidationFlags :: (MonadIO m, IsSocketClient o) => o -> [Gio.Flags.TlsCertificateFlags] -> m ()
setSocketClientTlsValidationFlags :: forall (m :: * -> *) o.
(MonadIO m, IsSocketClient o) =>
o -> [TlsCertificateFlags] -> m ()
setSocketClientTlsValidationFlags o
obj [TlsCertificateFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> [TlsCertificateFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"tls-validation-flags" [TlsCertificateFlags]
val

-- | Construct a `GValueConstruct` with valid value for the “@tls-validation-flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSocketClientTlsValidationFlags :: (IsSocketClient o, MIO.MonadIO m) => [Gio.Flags.TlsCertificateFlags] -> m (GValueConstruct o)
constructSocketClientTlsValidationFlags :: forall o (m :: * -> *).
(IsSocketClient o, MonadIO m) =>
[TlsCertificateFlags] -> m (GValueConstruct o)
constructSocketClientTlsValidationFlags [TlsCertificateFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [TlsCertificateFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"tls-validation-flags" [TlsCertificateFlags]
val

#if defined(ENABLE_OVERLOADING)
data SocketClientTlsValidationFlagsPropertyInfo
instance AttrInfo SocketClientTlsValidationFlagsPropertyInfo where
    type AttrAllowedOps SocketClientTlsValidationFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SocketClientTlsValidationFlagsPropertyInfo = IsSocketClient
    type AttrSetTypeConstraint SocketClientTlsValidationFlagsPropertyInfo = (~) [Gio.Flags.TlsCertificateFlags]
    type AttrTransferTypeConstraint SocketClientTlsValidationFlagsPropertyInfo = (~) [Gio.Flags.TlsCertificateFlags]
    type AttrTransferType SocketClientTlsValidationFlagsPropertyInfo = [Gio.Flags.TlsCertificateFlags]
    type AttrGetType SocketClientTlsValidationFlagsPropertyInfo = [Gio.Flags.TlsCertificateFlags]
    type AttrLabel SocketClientTlsValidationFlagsPropertyInfo = "tls-validation-flags"
    type AttrOrigin SocketClientTlsValidationFlagsPropertyInfo = SocketClient
    attrGet = getSocketClientTlsValidationFlags
    attrSet = setSocketClientTlsValidationFlags
    attrTransfer _ v = do
        return v
    attrConstruct = constructSocketClientTlsValidationFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.tlsValidationFlags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#g:attr:tlsValidationFlags"
        })
#endif

-- VVV Prop "type"
   -- Type: TInterface (Name {namespace = "Gio", name = "SocketType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' socketClient [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setSocketClientType :: (MonadIO m, IsSocketClient o) => o -> Gio.Enums.SocketType -> m ()
setSocketClientType :: forall (m :: * -> *) o.
(MonadIO m, IsSocketClient o) =>
o -> SocketType -> m ()
setSocketClientType o
obj SocketType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> SocketType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"type" SocketType
val

-- | Construct a `GValueConstruct` with valid value for the “@type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSocketClientType :: (IsSocketClient o, MIO.MonadIO m) => Gio.Enums.SocketType -> m (GValueConstruct o)
constructSocketClientType :: forall o (m :: * -> *).
(IsSocketClient o, MonadIO m) =>
SocketType -> m (GValueConstruct o)
constructSocketClientType SocketType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> SocketType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"type" SocketType
val

#if defined(ENABLE_OVERLOADING)
data SocketClientTypePropertyInfo
instance AttrInfo SocketClientTypePropertyInfo where
    type AttrAllowedOps SocketClientTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SocketClientTypePropertyInfo = IsSocketClient
    type AttrSetTypeConstraint SocketClientTypePropertyInfo = (~) Gio.Enums.SocketType
    type AttrTransferTypeConstraint SocketClientTypePropertyInfo = (~) Gio.Enums.SocketType
    type AttrTransferType SocketClientTypePropertyInfo = Gio.Enums.SocketType
    type AttrGetType SocketClientTypePropertyInfo = Gio.Enums.SocketType
    type AttrLabel SocketClientTypePropertyInfo = "type"
    type AttrOrigin SocketClientTypePropertyInfo = SocketClient
    attrGet = getSocketClientType
    attrSet = setSocketClientType
    attrTransfer _ v = do
        return v
    attrConstruct = constructSocketClientType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.type"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#g:attr:type"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SocketClient
type instance O.AttributeList SocketClient = SocketClientAttributeList
type SocketClientAttributeList = ('[ '("enableProxy", SocketClientEnableProxyPropertyInfo), '("family", SocketClientFamilyPropertyInfo), '("localAddress", SocketClientLocalAddressPropertyInfo), '("protocol", SocketClientProtocolPropertyInfo), '("proxyResolver", SocketClientProxyResolverPropertyInfo), '("timeout", SocketClientTimeoutPropertyInfo), '("tls", SocketClientTlsPropertyInfo), '("tlsValidationFlags", SocketClientTlsValidationFlagsPropertyInfo), '("type", SocketClientTypePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
socketClientEnableProxy :: AttrLabelProxy "enableProxy"
socketClientEnableProxy = AttrLabelProxy

socketClientFamily :: AttrLabelProxy "family"
socketClientFamily = AttrLabelProxy

socketClientLocalAddress :: AttrLabelProxy "localAddress"
socketClientLocalAddress = AttrLabelProxy

socketClientProtocol :: AttrLabelProxy "protocol"
socketClientProtocol = AttrLabelProxy

socketClientProxyResolver :: AttrLabelProxy "proxyResolver"
socketClientProxyResolver = AttrLabelProxy

socketClientTimeout :: AttrLabelProxy "timeout"
socketClientTimeout = AttrLabelProxy

socketClientTls :: AttrLabelProxy "tls"
socketClientTls = AttrLabelProxy

socketClientTlsValidationFlags :: AttrLabelProxy "tlsValidationFlags"
socketClientTlsValidationFlags = AttrLabelProxy

socketClientType :: AttrLabelProxy "type"
socketClientType = AttrLabelProxy

#endif

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

#endif

-- method SocketClient::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "SocketClient" })
-- throws : False
-- Skip return : False

foreign import ccall "g_socket_client_new" g_socket_client_new :: 
    IO (Ptr SocketClient)

-- | Creates a new t'GI.Gio.Objects.SocketClient.SocketClient' with the default options.
-- 
-- /Since: 2.22/
socketClientNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m SocketClient
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketClient.SocketClient'.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'.
socketClientNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m SocketClient
socketClientNew  = IO SocketClient -> m SocketClient
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketClient -> m SocketClient)
-> IO SocketClient -> m SocketClient
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
result <- IO (Ptr SocketClient)
g_socket_client_new
    Text -> Ptr SocketClient -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketClientNew" Ptr SocketClient
result
    SocketClient
result' <- ((ManagedPtr SocketClient -> SocketClient)
-> Ptr SocketClient -> IO SocketClient
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketClient -> SocketClient
SocketClient) Ptr SocketClient
result
    SocketClient -> IO SocketClient
forall (m :: * -> *) a. Monad m => a -> m a
return SocketClient
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SocketClient::add_application_proxy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocol"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The proxy protocol" , 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_client_add_application_proxy" g_socket_client_add_application_proxy :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CString ->                              -- protocol : TBasicType TUTF8
    IO ()

-- | Enable proxy protocols to be handled by the application. When the
-- indicated proxy protocol is returned by the t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver',
-- t'GI.Gio.Objects.SocketClient.SocketClient' will consider this protocol as supported but will
-- not try to find a t'GI.Gio.Interfaces.Proxy.Proxy' instance to handle handshaking. The
-- application must check for this case by calling
-- 'GI.Gio.Objects.SocketConnection.socketConnectionGetRemoteAddress' on the returned
-- t'GI.Gio.Objects.SocketConnection.SocketConnection', and seeing if it\'s a t'GI.Gio.Objects.ProxyAddress.ProxyAddress' of the
-- appropriate type, to determine whether or not it needs to handle
-- the proxy handshaking itself.
-- 
-- This should be used for proxy protocols that are dialects of
-- another protocol such as HTTP proxy. It also allows cohabitation of
-- proxy protocols that are reused between protocols. A good example
-- is HTTP. It can be used to proxy HTTP, FTP and Gopher and can also
-- be use as generic socket proxy through the HTTP CONNECT method.
-- 
-- When the proxy is detected as being an application proxy, TLS handshake
-- will be skipped. This is required to let the application do the proxy
-- specific handshake.
socketClientAddApplicationProxy ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'
    -> T.Text
    -- ^ /@protocol@/: The proxy protocol
    -> m ()
socketClientAddApplicationProxy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> Text -> m ()
socketClientAddApplicationProxy a
client Text
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
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CString
protocol' <- Text -> IO CString
textToCString Text
protocol
    Ptr SocketClient -> CString -> IO ()
g_socket_client_add_application_proxy Ptr SocketClient
client' CString
protocol'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
protocol'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo SocketClientAddApplicationProxyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientAddApplicationProxy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientAddApplicationProxy"
        })


#endif

-- method SocketClient::connect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connectable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketConnectable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GSocketConnectable 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 "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "SocketConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "g_socket_client_connect" g_socket_client_connect :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    Ptr Gio.SocketConnectable.SocketConnectable -> -- connectable : TInterface (Name {namespace = "Gio", name = "SocketConnectable"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.SocketConnection.SocketConnection)

-- | Tries to resolve the /@connectable@/ and make a network connection to it.
-- 
-- Upon a successful connection, a new t'GI.Gio.Objects.SocketConnection.SocketConnection' is constructed
-- and returned.  The caller owns this new object and must drop their
-- reference to it when finished with it.
-- 
-- The type of the t'GI.Gio.Objects.SocketConnection.SocketConnection' object returned depends on the type of
-- the underlying socket that is used. For instance, for a TCP\/IP connection
-- it will be a t'GI.Gio.Objects.TcpConnection.TcpConnection'.
-- 
-- The socket created will be the same family as the address that the
-- /@connectable@/ resolves to, unless family is set with 'GI.Gio.Objects.SocketClient.socketClientSetFamily'
-- or indirectly via 'GI.Gio.Objects.SocketClient.socketClientSetLocalAddress'. The socket type
-- defaults to 'GI.Gio.Enums.SocketTypeStream' but can be set with
-- 'GI.Gio.Objects.SocketClient.socketClientSetSocketType'.
-- 
-- If a local address is specified with 'GI.Gio.Objects.SocketClient.socketClientSetLocalAddress' the
-- socket will be bound to this address before connecting.
-- 
-- /Since: 2.22/
socketClientConnect ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.SocketConnectable.IsSocketConnectable b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> b
    -- ^ /@connectable@/: a t'GI.Gio.Interfaces.SocketConnectable.SocketConnectable' specifying the remote address.
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> m Gio.SocketConnection.SocketConnection
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketConnection.SocketConnection' on success, 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
socketClientConnect :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSocketClient a, IsSocketConnectable b,
 IsCancellable c) =>
a -> b -> Maybe c -> m SocketConnection
socketClientConnect a
client b
connectable Maybe c
cancellable = IO SocketConnection -> m SocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketConnection -> m SocketConnection)
-> IO SocketConnection -> m SocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr SocketConnectable
connectable' <- b -> IO (Ptr SocketConnectable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connectable
    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 SocketConnection -> IO () -> IO SocketConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr SocketConnection
result <- (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketConnection))
 -> IO (Ptr SocketConnection))
-> (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a b. (a -> b) -> a -> b
$ Ptr SocketClient
-> Ptr SocketConnectable
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr SocketConnection)
g_socket_client_connect Ptr SocketClient
client' Ptr SocketConnectable
connectable' Ptr Cancellable
maybeCancellable
        Text -> Ptr SocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketClientConnect" Ptr SocketConnection
result
        SocketConnection
result' <- ((ManagedPtr SocketConnection -> SocketConnection)
-> Ptr SocketConnection -> IO SocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketConnection -> SocketConnection
Gio.SocketConnection.SocketConnection) Ptr SocketConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connectable
        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
        SocketConnection -> IO SocketConnection
forall (m :: * -> *) a. Monad m => a -> m a
return SocketConnection
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectMethodInfo
instance (signature ~ (b -> Maybe (c) -> m Gio.SocketConnection.SocketConnection), MonadIO m, IsSocketClient a, Gio.SocketConnectable.IsSocketConnectable b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SocketClientConnectMethodInfo a signature where
    overloadedMethod = socketClientConnect

instance O.OverloadedMethodInfo SocketClientConnectMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnect"
        })


#endif

-- method SocketClient::connect_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connectable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketConnectable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GSocketConnectable 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_client_connect_async" g_socket_client_connect_async :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    Ptr Gio.SocketConnectable.SocketConnectable -> -- connectable : TInterface (Name {namespace = "Gio", name = "SocketConnectable"})
    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 ()

-- | This is the asynchronous version of 'GI.Gio.Objects.SocketClient.socketClientConnect'.
-- 
-- You may wish to prefer the asynchronous version even in synchronous
-- command line programs because, since 2.60, it implements
-- <https://tools.ietf.org/html/rfc8305 RFC 8305> \"Happy Eyeballs\"
-- recommendations to work around long connection timeouts in networks
-- where IPv6 is broken by performing an IPv4 connection simultaneously
-- without waiting for IPv6 to time out, which is not supported by the
-- synchronous call. (This is not an API guarantee, and may change in
-- the future.)
-- 
-- When the operation is finished /@callback@/ will be
-- called. You can then call 'GI.Gio.Objects.SocketClient.socketClientConnectFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.22/
socketClientConnectAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.SocketConnectable.IsSocketConnectable b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'
    -> b
    -- ^ /@connectable@/: a t'GI.Gio.Interfaces.SocketConnectable.SocketConnectable' specifying the remote address.
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
socketClientConnectAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSocketClient a, IsSocketConnectable b,
 IsCancellable c) =>
a -> b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
socketClientConnectAsync a
client b
connectable 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr SocketConnectable
connectable' <- b -> IO (Ptr SocketConnectable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connectable
    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 SocketClient
-> Ptr SocketConnectable
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_socket_client_connect_async Ptr SocketClient
client' Ptr SocketConnectable
connectable' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connectable
    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 SocketClientConnectAsyncMethodInfo
instance (signature ~ (b -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSocketClient a, Gio.SocketConnectable.IsSocketConnectable b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SocketClientConnectAsyncMethodInfo a signature where
    overloadedMethod = socketClientConnectAsync

instance O.OverloadedMethodInfo SocketClientConnectAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectAsync"
        })


#endif

-- method SocketClient::connect_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , 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 "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "SocketConnection" })
-- throws : True
-- Skip return : False

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

-- | Finishes an async connect operation. See 'GI.Gio.Objects.SocketClient.socketClientConnectAsync'
-- 
-- /Since: 2.22/
socketClientConnectFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m Gio.SocketConnection.SocketConnection
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketConnection.SocketConnection' on success, 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
socketClientConnectFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsAsyncResult b) =>
a -> b -> m SocketConnection
socketClientConnectFinish a
client b
result_ = IO SocketConnection -> m SocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketConnection -> m SocketConnection)
-> IO SocketConnection -> m SocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO SocketConnection -> IO () -> IO SocketConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr SocketConnection
result <- (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketConnection))
 -> IO (Ptr SocketConnection))
-> (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a b. (a -> b) -> a -> b
$ Ptr SocketClient
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr SocketConnection)
g_socket_client_connect_finish Ptr SocketClient
client' Ptr AsyncResult
result_'
        Text -> Ptr SocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketClientConnectFinish" Ptr SocketConnection
result
        SocketConnection
result' <- ((ManagedPtr SocketConnection -> SocketConnection)
-> Ptr SocketConnection -> IO SocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketConnection -> SocketConnection
Gio.SocketConnection.SocketConnection) Ptr SocketConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        SocketConnection -> IO SocketConnection
forall (m :: * -> *) a. Monad m => a -> m a
return SocketConnection
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectFinishMethodInfo
instance (signature ~ (b -> m Gio.SocketConnection.SocketConnection), MonadIO m, IsSocketClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SocketClientConnectFinishMethodInfo a signature where
    overloadedMethod = socketClientConnectFinish

instance O.OverloadedMethodInfo SocketClientConnectFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectFinish"
        })


#endif

-- method SocketClient::connect_to_host
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "host_and_port"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the name and optionally port of the host to connect to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_port"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the default port to connect to"
--                 , 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
--               (TInterface Name { namespace = "Gio" , name = "SocketConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "g_socket_client_connect_to_host" g_socket_client_connect_to_host :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CString ->                              -- host_and_port : TBasicType TUTF8
    Word16 ->                               -- default_port : TBasicType TUInt16
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.SocketConnection.SocketConnection)

-- | This is a helper function for 'GI.Gio.Objects.SocketClient.socketClientConnect'.
-- 
-- Attempts to create a TCP connection to the named host.
-- 
-- /@hostAndPort@/ may be in any of a number of recognized formats; an IPv6
-- address, an IPv4 address, or a domain name (in which case a DNS
-- lookup is performed).  Quoting with [] is supported for all address
-- types.  A port override may be specified in the usual way with a
-- colon.  Ports may be given as decimal numbers or symbolic names (in
-- which case an \/etc\/services lookup is performed).
-- 
-- If no port override is given in /@hostAndPort@/ then /@defaultPort@/ will be
-- used as the port number to connect to.
-- 
-- In general, /@hostAndPort@/ is expected to be provided by the user (allowing
-- them to give the hostname, and a port override if necessary) and
-- /@defaultPort@/ is expected to be provided by the application.
-- 
-- In the case that an IP address is given, a single connection
-- attempt is made.  In the case that a name is given, multiple
-- connection attempts may be made, in turn and according to the
-- number of address records in DNS, until a connection succeeds.
-- 
-- Upon a successful connection, a new t'GI.Gio.Objects.SocketConnection.SocketConnection' is constructed
-- and returned.  The caller owns this new object and must drop their
-- reference to it when finished with it.
-- 
-- In the event of any failure (DNS error, service not found, no hosts
-- connectable) 'P.Nothing' is returned and /@error@/ (if non-'P.Nothing') is set
-- accordingly.
-- 
-- /Since: 2.22/
socketClientConnectToHost ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'
    -> T.Text
    -- ^ /@hostAndPort@/: the name and optionally port of the host to connect to
    -> Word16
    -- ^ /@defaultPort@/: the default port to connect to
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m Gio.SocketConnection.SocketConnection
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketConnection.SocketConnection' on success, 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
socketClientConnectToHost :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsCancellable b) =>
a -> Text -> Word16 -> Maybe b -> m SocketConnection
socketClientConnectToHost a
client Text
hostAndPort Word16
defaultPort Maybe b
cancellable = IO SocketConnection -> m SocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketConnection -> m SocketConnection)
-> IO SocketConnection -> m SocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CString
hostAndPort' <- Text -> IO CString
textToCString Text
hostAndPort
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO SocketConnection -> IO () -> IO SocketConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr SocketConnection
result <- (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketConnection))
 -> IO (Ptr SocketConnection))
-> (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a b. (a -> b) -> a -> b
$ Ptr SocketClient
-> CString
-> Word16
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr SocketConnection)
g_socket_client_connect_to_host Ptr SocketClient
client' CString
hostAndPort' Word16
defaultPort Ptr Cancellable
maybeCancellable
        Text -> Ptr SocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketClientConnectToHost" Ptr SocketConnection
result
        SocketConnection
result' <- ((ManagedPtr SocketConnection -> SocketConnection)
-> Ptr SocketConnection -> IO SocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketConnection -> SocketConnection
Gio.SocketConnection.SocketConnection) Ptr SocketConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
hostAndPort'
        SocketConnection -> IO SocketConnection
forall (m :: * -> *) a. Monad m => a -> m a
return SocketConnection
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
hostAndPort'
     )

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectToHostMethodInfo
instance (signature ~ (T.Text -> Word16 -> Maybe (b) -> m Gio.SocketConnection.SocketConnection), MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SocketClientConnectToHostMethodInfo a signature where
    overloadedMethod = socketClientConnectToHost

instance O.OverloadedMethodInfo SocketClientConnectToHostMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectToHost",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectToHost"
        })


#endif

-- method SocketClient::connect_to_host_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "host_and_port"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the name and optionally the port of the host to connect to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_port"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the default port to connect to"
--                 , 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 = 5
--           , 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_client_connect_to_host_async" g_socket_client_connect_to_host_async :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CString ->                              -- host_and_port : TBasicType TUTF8
    Word16 ->                               -- default_port : TBasicType TUInt16
    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 ()

-- | This is the asynchronous version of 'GI.Gio.Objects.SocketClient.socketClientConnectToHost'.
-- 
-- When the operation is finished /@callback@/ will be
-- called. You can then call 'GI.Gio.Objects.SocketClient.socketClientConnectToHostFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.22/
socketClientConnectToHostAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'
    -> T.Text
    -- ^ /@hostAndPort@/: the name and optionally the port of the host to connect to
    -> Word16
    -- ^ /@defaultPort@/: the default port to connect to
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
socketClientConnectToHostAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsCancellable b) =>
a -> Text -> Word16 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
socketClientConnectToHostAsync a
client Text
hostAndPort Word16
defaultPort Maybe b
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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CString
hostAndPort' <- Text -> IO CString
textToCString Text
hostAndPort
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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 SocketClient
-> CString
-> Word16
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_socket_client_connect_to_host_async Ptr SocketClient
client' CString
hostAndPort' Word16
defaultPort Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
hostAndPort'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectToHostAsyncMethodInfo
instance (signature ~ (T.Text -> Word16 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SocketClientConnectToHostAsyncMethodInfo a signature where
    overloadedMethod = socketClientConnectToHostAsync

instance O.OverloadedMethodInfo SocketClientConnectToHostAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectToHostAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectToHostAsync"
        })


#endif

-- method SocketClient::connect_to_host_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , 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 "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "SocketConnection" })
-- throws : True
-- Skip return : False

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

-- | Finishes an async connect operation. See 'GI.Gio.Objects.SocketClient.socketClientConnectToHostAsync'
-- 
-- /Since: 2.22/
socketClientConnectToHostFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m Gio.SocketConnection.SocketConnection
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketConnection.SocketConnection' on success, 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
socketClientConnectToHostFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsAsyncResult b) =>
a -> b -> m SocketConnection
socketClientConnectToHostFinish a
client b
result_ = IO SocketConnection -> m SocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketConnection -> m SocketConnection)
-> IO SocketConnection -> m SocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO SocketConnection -> IO () -> IO SocketConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr SocketConnection
result <- (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketConnection))
 -> IO (Ptr SocketConnection))
-> (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a b. (a -> b) -> a -> b
$ Ptr SocketClient
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr SocketConnection)
g_socket_client_connect_to_host_finish Ptr SocketClient
client' Ptr AsyncResult
result_'
        Text -> Ptr SocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketClientConnectToHostFinish" Ptr SocketConnection
result
        SocketConnection
result' <- ((ManagedPtr SocketConnection -> SocketConnection)
-> Ptr SocketConnection -> IO SocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketConnection -> SocketConnection
Gio.SocketConnection.SocketConnection) Ptr SocketConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        SocketConnection -> IO SocketConnection
forall (m :: * -> *) a. Monad m => a -> m a
return SocketConnection
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectToHostFinishMethodInfo
instance (signature ~ (b -> m Gio.SocketConnection.SocketConnection), MonadIO m, IsSocketClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SocketClientConnectToHostFinishMethodInfo a signature where
    overloadedMethod = socketClientConnectToHostFinish

instance O.OverloadedMethodInfo SocketClientConnectToHostFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectToHostFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectToHostFinish"
        })


#endif

-- method SocketClient::connect_to_service
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketConnection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "domain"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a domain name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "service"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the service to connect to"
--                 , 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
--               (TInterface Name { namespace = "Gio" , name = "SocketConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "g_socket_client_connect_to_service" g_socket_client_connect_to_service :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CString ->                              -- domain : TBasicType TUTF8
    CString ->                              -- service : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.SocketConnection.SocketConnection)

-- | Attempts to create a TCP connection to a service.
-- 
-- This call looks up the SRV record for /@service@/ at /@domain@/ for the
-- \"tcp\" protocol.  It then attempts to connect, in turn, to each of
-- the hosts providing the service until either a connection succeeds
-- or there are no hosts remaining.
-- 
-- Upon a successful connection, a new t'GI.Gio.Objects.SocketConnection.SocketConnection' is constructed
-- and returned.  The caller owns this new object and must drop their
-- reference to it when finished with it.
-- 
-- In the event of any failure (DNS error, service not found, no hosts
-- connectable) 'P.Nothing' is returned and /@error@/ (if non-'P.Nothing') is set
-- accordingly.
socketClientConnectToService ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketConnection.SocketConnection'
    -> T.Text
    -- ^ /@domain@/: a domain name
    -> T.Text
    -- ^ /@service@/: the name of the service to connect to
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m Gio.SocketConnection.SocketConnection
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketConnection.SocketConnection' if successful, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
socketClientConnectToService :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsCancellable b) =>
a -> Text -> Text -> Maybe b -> m SocketConnection
socketClientConnectToService a
client Text
domain Text
service Maybe b
cancellable = IO SocketConnection -> m SocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketConnection -> m SocketConnection)
-> IO SocketConnection -> m SocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CString
domain' <- Text -> IO CString
textToCString Text
domain
    CString
service' <- Text -> IO CString
textToCString Text
service
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO SocketConnection -> IO () -> IO SocketConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr SocketConnection
result <- (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketConnection))
 -> IO (Ptr SocketConnection))
-> (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a b. (a -> b) -> a -> b
$ Ptr SocketClient
-> CString
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr SocketConnection)
g_socket_client_connect_to_service Ptr SocketClient
client' CString
domain' CString
service' Ptr Cancellable
maybeCancellable
        Text -> Ptr SocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketClientConnectToService" Ptr SocketConnection
result
        SocketConnection
result' <- ((ManagedPtr SocketConnection -> SocketConnection)
-> Ptr SocketConnection -> IO SocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketConnection -> SocketConnection
Gio.SocketConnection.SocketConnection) Ptr SocketConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
domain'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
service'
        SocketConnection -> IO SocketConnection
forall (m :: * -> *) a. Monad m => a -> m a
return SocketConnection
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
domain'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
service'
     )

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectToServiceMethodInfo
instance (signature ~ (T.Text -> T.Text -> Maybe (b) -> m Gio.SocketConnection.SocketConnection), MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SocketClientConnectToServiceMethodInfo a signature where
    overloadedMethod = socketClientConnectToService

instance O.OverloadedMethodInfo SocketClientConnectToServiceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectToService",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectToService"
        })


#endif

-- method SocketClient::connect_to_service_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "domain"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a domain name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "service"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the service to connect to"
--                 , 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 = 5
--           , 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_client_connect_to_service_async" g_socket_client_connect_to_service_async :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CString ->                              -- domain : TBasicType TUTF8
    CString ->                              -- service : TBasicType TUTF8
    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 ()

-- | This is the asynchronous version of
-- 'GI.Gio.Objects.SocketClient.socketClientConnectToService'.
-- 
-- /Since: 2.22/
socketClientConnectToServiceAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'
    -> T.Text
    -- ^ /@domain@/: a domain name
    -> T.Text
    -- ^ /@service@/: the name of the service to connect to
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
socketClientConnectToServiceAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsCancellable b) =>
a -> Text -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
socketClientConnectToServiceAsync a
client Text
domain Text
service Maybe b
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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CString
domain' <- Text -> IO CString
textToCString Text
domain
    CString
service' <- Text -> IO CString
textToCString Text
service
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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 SocketClient
-> CString
-> CString
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_socket_client_connect_to_service_async Ptr SocketClient
client' CString
domain' CString
service' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
domain'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
service'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectToServiceAsyncMethodInfo
instance (signature ~ (T.Text -> T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SocketClientConnectToServiceAsyncMethodInfo a signature where
    overloadedMethod = socketClientConnectToServiceAsync

instance O.OverloadedMethodInfo SocketClientConnectToServiceAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectToServiceAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectToServiceAsync"
        })


#endif

-- method SocketClient::connect_to_service_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , 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 "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "SocketConnection" })
-- throws : True
-- Skip return : False

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

-- | Finishes an async connect operation. See 'GI.Gio.Objects.SocketClient.socketClientConnectToServiceAsync'
-- 
-- /Since: 2.22/
socketClientConnectToServiceFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m Gio.SocketConnection.SocketConnection
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketConnection.SocketConnection' on success, 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
socketClientConnectToServiceFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsAsyncResult b) =>
a -> b -> m SocketConnection
socketClientConnectToServiceFinish a
client b
result_ = IO SocketConnection -> m SocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketConnection -> m SocketConnection)
-> IO SocketConnection -> m SocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO SocketConnection -> IO () -> IO SocketConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr SocketConnection
result <- (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketConnection))
 -> IO (Ptr SocketConnection))
-> (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a b. (a -> b) -> a -> b
$ Ptr SocketClient
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr SocketConnection)
g_socket_client_connect_to_service_finish Ptr SocketClient
client' Ptr AsyncResult
result_'
        Text -> Ptr SocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketClientConnectToServiceFinish" Ptr SocketConnection
result
        SocketConnection
result' <- ((ManagedPtr SocketConnection -> SocketConnection)
-> Ptr SocketConnection -> IO SocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketConnection -> SocketConnection
Gio.SocketConnection.SocketConnection) Ptr SocketConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        SocketConnection -> IO SocketConnection
forall (m :: * -> *) a. Monad m => a -> m a
return SocketConnection
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectToServiceFinishMethodInfo
instance (signature ~ (b -> m Gio.SocketConnection.SocketConnection), MonadIO m, IsSocketClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SocketClientConnectToServiceFinishMethodInfo a signature where
    overloadedMethod = socketClientConnectToServiceFinish

instance O.OverloadedMethodInfo SocketClientConnectToServiceFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectToServiceFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectToServiceFinish"
        })


#endif

-- method SocketClient::connect_to_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A network URI" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_port"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the default port to connect to"
--                 , 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
--               (TInterface Name { namespace = "Gio" , name = "SocketConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "g_socket_client_connect_to_uri" g_socket_client_connect_to_uri :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CString ->                              -- uri : TBasicType TUTF8
    Word16 ->                               -- default_port : TBasicType TUInt16
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.SocketConnection.SocketConnection)

-- | This is a helper function for 'GI.Gio.Objects.SocketClient.socketClientConnect'.
-- 
-- Attempts to create a TCP connection with a network URI.
-- 
-- /@uri@/ may be any valid URI containing an \"authority\" (hostname\/port)
-- component. If a port is not specified in the URI, /@defaultPort@/
-- will be used. TLS will be negotiated if [SocketClient:tls]("GI.Gio.Objects.SocketClient#g:attr:tls") is 'P.True'.
-- (t'GI.Gio.Objects.SocketClient.SocketClient' does not know to automatically assume TLS for
-- certain URI schemes.)
-- 
-- Using this rather than 'GI.Gio.Objects.SocketClient.socketClientConnect' or
-- 'GI.Gio.Objects.SocketClient.socketClientConnectToHost' allows t'GI.Gio.Objects.SocketClient.SocketClient' to
-- determine when to use application-specific proxy protocols.
-- 
-- Upon a successful connection, a new t'GI.Gio.Objects.SocketConnection.SocketConnection' is constructed
-- and returned.  The caller owns this new object and must drop their
-- reference to it when finished with it.
-- 
-- In the event of any failure (DNS error, service not found, no hosts
-- connectable) 'P.Nothing' is returned and /@error@/ (if non-'P.Nothing') is set
-- accordingly.
-- 
-- /Since: 2.26/
socketClientConnectToUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'
    -> T.Text
    -- ^ /@uri@/: A network URI
    -> Word16
    -- ^ /@defaultPort@/: the default port to connect to
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m Gio.SocketConnection.SocketConnection
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketConnection.SocketConnection' on success, 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
socketClientConnectToUri :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsCancellable b) =>
a -> Text -> Word16 -> Maybe b -> m SocketConnection
socketClientConnectToUri a
client Text
uri Word16
defaultPort Maybe b
cancellable = IO SocketConnection -> m SocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketConnection -> m SocketConnection)
-> IO SocketConnection -> m SocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO SocketConnection -> IO () -> IO SocketConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr SocketConnection
result <- (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketConnection))
 -> IO (Ptr SocketConnection))
-> (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a b. (a -> b) -> a -> b
$ Ptr SocketClient
-> CString
-> Word16
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr SocketConnection)
g_socket_client_connect_to_uri Ptr SocketClient
client' CString
uri' Word16
defaultPort Ptr Cancellable
maybeCancellable
        Text -> Ptr SocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketClientConnectToUri" Ptr SocketConnection
result
        SocketConnection
result' <- ((ManagedPtr SocketConnection -> SocketConnection)
-> Ptr SocketConnection -> IO SocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketConnection -> SocketConnection
Gio.SocketConnection.SocketConnection) Ptr SocketConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        SocketConnection -> IO SocketConnection
forall (m :: * -> *) a. Monad m => a -> m a
return SocketConnection
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
     )

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectToUriMethodInfo
instance (signature ~ (T.Text -> Word16 -> Maybe (b) -> m Gio.SocketConnection.SocketConnection), MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SocketClientConnectToUriMethodInfo a signature where
    overloadedMethod = socketClientConnectToUri

instance O.OverloadedMethodInfo SocketClientConnectToUriMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectToUri",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectToUri"
        })


#endif

-- method SocketClient::connect_to_uri_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a network uri" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_port"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the default port to connect to"
--                 , 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 = 5
--           , 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_client_connect_to_uri_async" g_socket_client_connect_to_uri_async :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CString ->                              -- uri : TBasicType TUTF8
    Word16 ->                               -- default_port : TBasicType TUInt16
    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 ()

-- | This is the asynchronous version of 'GI.Gio.Objects.SocketClient.socketClientConnectToUri'.
-- 
-- When the operation is finished /@callback@/ will be
-- called. You can then call 'GI.Gio.Objects.SocketClient.socketClientConnectToUriFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.26/
socketClientConnectToUriAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'
    -> T.Text
    -- ^ /@uri@/: a network uri
    -> Word16
    -- ^ /@defaultPort@/: the default port to connect to
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
socketClientConnectToUriAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsCancellable b) =>
a -> Text -> Word16 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
socketClientConnectToUriAsync a
client Text
uri Word16
defaultPort Maybe b
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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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 SocketClient
-> CString
-> Word16
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_socket_client_connect_to_uri_async Ptr SocketClient
client' CString
uri' Word16
defaultPort Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectToUriAsyncMethodInfo
instance (signature ~ (T.Text -> Word16 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSocketClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SocketClientConnectToUriAsyncMethodInfo a signature where
    overloadedMethod = socketClientConnectToUriAsync

instance O.OverloadedMethodInfo SocketClientConnectToUriAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectToUriAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectToUriAsync"
        })


#endif

-- method SocketClient::connect_to_uri_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , 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 "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "SocketConnection" })
-- throws : True
-- Skip return : False

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

-- | Finishes an async connect operation. See 'GI.Gio.Objects.SocketClient.socketClientConnectToUriAsync'
-- 
-- /Since: 2.26/
socketClientConnectToUriFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m Gio.SocketConnection.SocketConnection
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketConnection.SocketConnection' on success, 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
socketClientConnectToUriFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsAsyncResult b) =>
a -> b -> m SocketConnection
socketClientConnectToUriFinish a
client b
result_ = IO SocketConnection -> m SocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketConnection -> m SocketConnection)
-> IO SocketConnection -> m SocketConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO SocketConnection -> IO () -> IO SocketConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr SocketConnection
result <- (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketConnection))
 -> IO (Ptr SocketConnection))
-> (Ptr (Ptr GError) -> IO (Ptr SocketConnection))
-> IO (Ptr SocketConnection)
forall a b. (a -> b) -> a -> b
$ Ptr SocketClient
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr SocketConnection)
g_socket_client_connect_to_uri_finish Ptr SocketClient
client' Ptr AsyncResult
result_'
        Text -> Ptr SocketConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketClientConnectToUriFinish" Ptr SocketConnection
result
        SocketConnection
result' <- ((ManagedPtr SocketConnection -> SocketConnection)
-> Ptr SocketConnection -> IO SocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketConnection -> SocketConnection
Gio.SocketConnection.SocketConnection) Ptr SocketConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        SocketConnection -> IO SocketConnection
forall (m :: * -> *) a. Monad m => a -> m a
return SocketConnection
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SocketClientConnectToUriFinishMethodInfo
instance (signature ~ (b -> m Gio.SocketConnection.SocketConnection), MonadIO m, IsSocketClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SocketClientConnectToUriFinishMethodInfo a signature where
    overloadedMethod = socketClientConnectToUriFinish

instance O.OverloadedMethodInfo SocketClientConnectToUriFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientConnectToUriFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientConnectToUriFinish"
        })


#endif

-- method SocketClient::get_enable_proxy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , 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_client_get_enable_proxy" g_socket_client_get_enable_proxy :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    IO CInt

-- | Gets the proxy enable state; see 'GI.Gio.Objects.SocketClient.socketClientSetEnableProxy'
-- 
-- /Since: 2.26/
socketClientGetEnableProxy ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> m Bool
    -- ^ __Returns:__ whether proxying is enabled
socketClientGetEnableProxy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> m Bool
socketClientGetEnableProxy a
client = 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr SocketClient -> IO CInt
g_socket_client_get_enable_proxy Ptr SocketClient
client'
    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
client
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SocketClientGetEnableProxyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientGetEnableProxyMethodInfo a signature where
    overloadedMethod = socketClientGetEnableProxy

instance O.OverloadedMethodInfo SocketClientGetEnableProxyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientGetEnableProxy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientGetEnableProxy"
        })


#endif

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

foreign import ccall "g_socket_client_get_family" g_socket_client_get_family :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    IO CUInt

-- | Gets the socket family of the socket client.
-- 
-- See 'GI.Gio.Objects.SocketClient.socketClientSetFamily' for details.
-- 
-- /Since: 2.22/
socketClientGetFamily ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> m Gio.Enums.SocketFamily
    -- ^ __Returns:__ a t'GI.Gio.Enums.SocketFamily'
socketClientGetFamily :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> m SocketFamily
socketClientGetFamily a
client = IO SocketFamily -> m SocketFamily
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketFamily -> m SocketFamily)
-> IO SocketFamily -> m SocketFamily
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CUInt
result <- Ptr SocketClient -> IO CUInt
g_socket_client_get_family Ptr SocketClient
client'
    let result' :: SocketFamily
result' = (Int -> SocketFamily
forall a. Enum a => Int -> a
toEnum (Int -> SocketFamily) -> (CUInt -> Int) -> CUInt -> SocketFamily
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    SocketFamily -> IO SocketFamily
forall (m :: * -> *) a. Monad m => a -> m a
return SocketFamily
result'

#if defined(ENABLE_OVERLOADING)
data SocketClientGetFamilyMethodInfo
instance (signature ~ (m Gio.Enums.SocketFamily), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientGetFamilyMethodInfo a signature where
    overloadedMethod = socketClientGetFamily

instance O.OverloadedMethodInfo SocketClientGetFamilyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientGetFamily",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientGetFamily"
        })


#endif

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

foreign import ccall "g_socket_client_get_local_address" g_socket_client_get_local_address :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    IO (Ptr Gio.SocketAddress.SocketAddress)

-- | Gets the local address of the socket client.
-- 
-- See 'GI.Gio.Objects.SocketClient.socketClientSetLocalAddress' for details.
-- 
-- /Since: 2.22/
socketClientGetLocalAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> m (Maybe Gio.SocketAddress.SocketAddress)
    -- ^ __Returns:__ a t'GI.Gio.Objects.SocketAddress.SocketAddress' or 'P.Nothing'. Do not free.
socketClientGetLocalAddress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> m (Maybe SocketAddress)
socketClientGetLocalAddress a
client = IO (Maybe SocketAddress) -> m (Maybe SocketAddress)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SocketAddress) -> m (Maybe SocketAddress))
-> IO (Maybe SocketAddress) -> m (Maybe SocketAddress)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr SocketAddress
result <- Ptr SocketClient -> IO (Ptr SocketAddress)
g_socket_client_get_local_address Ptr SocketClient
client'
    Maybe SocketAddress
maybeResult <- Ptr SocketAddress
-> (Ptr SocketAddress -> IO SocketAddress)
-> IO (Maybe SocketAddress)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr SocketAddress
result ((Ptr SocketAddress -> IO SocketAddress)
 -> IO (Maybe SocketAddress))
-> (Ptr SocketAddress -> IO SocketAddress)
-> IO (Maybe SocketAddress)
forall a b. (a -> b) -> a -> b
$ \Ptr SocketAddress
result' -> do
        SocketAddress
result'' <- ((ManagedPtr SocketAddress -> SocketAddress)
-> Ptr SocketAddress -> IO SocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SocketAddress -> SocketAddress
Gio.SocketAddress.SocketAddress) Ptr SocketAddress
result'
        SocketAddress -> IO SocketAddress
forall (m :: * -> *) a. Monad m => a -> m a
return SocketAddress
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe SocketAddress -> IO (Maybe SocketAddress)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SocketAddress
maybeResult

#if defined(ENABLE_OVERLOADING)
data SocketClientGetLocalAddressMethodInfo
instance (signature ~ (m (Maybe Gio.SocketAddress.SocketAddress)), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientGetLocalAddressMethodInfo a signature where
    overloadedMethod = socketClientGetLocalAddress

instance O.OverloadedMethodInfo SocketClientGetLocalAddressMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientGetLocalAddress",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientGetLocalAddress"
        })


#endif

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

foreign import ccall "g_socket_client_get_protocol" g_socket_client_get_protocol :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    IO CInt

-- | Gets the protocol name type of the socket client.
-- 
-- See 'GI.Gio.Objects.SocketClient.socketClientSetProtocol' for details.
-- 
-- /Since: 2.22/
socketClientGetProtocol ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'
    -> m Gio.Enums.SocketProtocol
    -- ^ __Returns:__ a t'GI.Gio.Enums.SocketProtocol'
socketClientGetProtocol :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> m SocketProtocol
socketClientGetProtocol a
client = IO SocketProtocol -> m SocketProtocol
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketProtocol -> m SocketProtocol)
-> IO SocketProtocol -> m SocketProtocol
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr SocketClient -> IO CInt
g_socket_client_get_protocol Ptr SocketClient
client'
    let result' :: SocketProtocol
result' = (Int -> SocketProtocol
forall a. Enum a => Int -> a
toEnum (Int -> SocketProtocol) -> (CInt -> Int) -> CInt -> SocketProtocol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    SocketProtocol -> IO SocketProtocol
forall (m :: * -> *) a. Monad m => a -> m a
return SocketProtocol
result'

#if defined(ENABLE_OVERLOADING)
data SocketClientGetProtocolMethodInfo
instance (signature ~ (m Gio.Enums.SocketProtocol), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientGetProtocolMethodInfo a signature where
    overloadedMethod = socketClientGetProtocol

instance O.OverloadedMethodInfo SocketClientGetProtocolMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientGetProtocol",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientGetProtocol"
        })


#endif

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

foreign import ccall "g_socket_client_get_proxy_resolver" g_socket_client_get_proxy_resolver :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    IO (Ptr Gio.ProxyResolver.ProxyResolver)

-- | Gets the t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver' being used by /@client@/. Normally, this will
-- be the resolver returned by 'GI.Gio.Functions.proxyResolverGetDefault', but you
-- can override it with 'GI.Gio.Objects.SocketClient.socketClientSetProxyResolver'.
-- 
-- /Since: 2.36/
socketClientGetProxyResolver ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> m Gio.ProxyResolver.ProxyResolver
    -- ^ __Returns:__ The t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver' being used by
    --   /@client@/.
socketClientGetProxyResolver :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> m ProxyResolver
socketClientGetProxyResolver a
client = IO ProxyResolver -> m ProxyResolver
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProxyResolver -> m ProxyResolver)
-> IO ProxyResolver -> m ProxyResolver
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr ProxyResolver
result <- Ptr SocketClient -> IO (Ptr ProxyResolver)
g_socket_client_get_proxy_resolver Ptr SocketClient
client'
    Text -> Ptr ProxyResolver -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketClientGetProxyResolver" Ptr ProxyResolver
result
    ProxyResolver
result' <- ((ManagedPtr ProxyResolver -> ProxyResolver)
-> Ptr ProxyResolver -> IO ProxyResolver
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ProxyResolver -> ProxyResolver
Gio.ProxyResolver.ProxyResolver) Ptr ProxyResolver
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    ProxyResolver -> IO ProxyResolver
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyResolver
result'

#if defined(ENABLE_OVERLOADING)
data SocketClientGetProxyResolverMethodInfo
instance (signature ~ (m Gio.ProxyResolver.ProxyResolver), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientGetProxyResolverMethodInfo a signature where
    overloadedMethod = socketClientGetProxyResolver

instance O.OverloadedMethodInfo SocketClientGetProxyResolverMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientGetProxyResolver",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientGetProxyResolver"
        })


#endif

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

foreign import ccall "g_socket_client_get_socket_type" g_socket_client_get_socket_type :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    IO CUInt

-- | Gets the socket type of the socket client.
-- 
-- See 'GI.Gio.Objects.SocketClient.socketClientSetSocketType' for details.
-- 
-- /Since: 2.22/
socketClientGetSocketType ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> m Gio.Enums.SocketType
    -- ^ __Returns:__ a t'GI.Gio.Enums.SocketFamily'
socketClientGetSocketType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> m SocketType
socketClientGetSocketType a
client = IO SocketType -> m SocketType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketType -> m SocketType) -> IO SocketType -> m SocketType
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CUInt
result <- Ptr SocketClient -> IO CUInt
g_socket_client_get_socket_type Ptr SocketClient
client'
    let result' :: SocketType
result' = (Int -> SocketType
forall a. Enum a => Int -> a
toEnum (Int -> SocketType) -> (CUInt -> Int) -> CUInt -> SocketType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    SocketType -> IO SocketType
forall (m :: * -> *) a. Monad m => a -> m a
return SocketType
result'

#if defined(ENABLE_OVERLOADING)
data SocketClientGetSocketTypeMethodInfo
instance (signature ~ (m Gio.Enums.SocketType), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientGetSocketTypeMethodInfo a signature where
    overloadedMethod = socketClientGetSocketType

instance O.OverloadedMethodInfo SocketClientGetSocketTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientGetSocketType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientGetSocketType"
        })


#endif

-- method SocketClient::get_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient" , 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 "g_socket_client_get_timeout" g_socket_client_get_timeout :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    IO Word32

-- | Gets the I\/O timeout time for sockets created by /@client@/.
-- 
-- See 'GI.Gio.Objects.SocketClient.socketClientSetTimeout' for details.
-- 
-- /Since: 2.26/
socketClientGetTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'
    -> m Word32
    -- ^ __Returns:__ the timeout in seconds
socketClientGetTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> m Word32
socketClientGetTimeout a
client = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Word32
result <- Ptr SocketClient -> IO Word32
g_socket_client_get_timeout Ptr SocketClient
client'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SocketClientGetTimeoutMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientGetTimeoutMethodInfo a signature where
    overloadedMethod = socketClientGetTimeout

instance O.OverloadedMethodInfo SocketClientGetTimeoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientGetTimeout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientGetTimeout"
        })


#endif

-- method SocketClient::get_tls
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , 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_client_get_tls" g_socket_client_get_tls :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    IO CInt

-- | Gets whether /@client@/ creates TLS connections. See
-- 'GI.Gio.Objects.SocketClient.socketClientSetTls' for details.
-- 
-- /Since: 2.28/
socketClientGetTls ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> m Bool
    -- ^ __Returns:__ whether /@client@/ uses TLS
socketClientGetTls :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> m Bool
socketClientGetTls a
client = 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr SocketClient -> IO CInt
g_socket_client_get_tls Ptr SocketClient
client'
    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
client
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SocketClientGetTlsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientGetTlsMethodInfo a signature where
    overloadedMethod = socketClientGetTls

instance O.OverloadedMethodInfo SocketClientGetTlsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientGetTls",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientGetTls"
        })


#endif

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

foreign import ccall "g_socket_client_get_tls_validation_flags" g_socket_client_get_tls_validation_flags :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    IO CUInt

-- | Gets the TLS validation flags used creating TLS connections via
-- /@client@/.
-- 
-- /Since: 2.28/
socketClientGetTlsValidationFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> m [Gio.Flags.TlsCertificateFlags]
    -- ^ __Returns:__ the TLS validation flags
socketClientGetTlsValidationFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> m [TlsCertificateFlags]
socketClientGetTlsValidationFlags a
client = IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TlsCertificateFlags] -> m [TlsCertificateFlags])
-> IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CUInt
result <- Ptr SocketClient -> IO CUInt
g_socket_client_get_tls_validation_flags Ptr SocketClient
client'
    let result' :: [TlsCertificateFlags]
result' = CUInt -> [TlsCertificateFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    [TlsCertificateFlags] -> IO [TlsCertificateFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [TlsCertificateFlags]
result'

#if defined(ENABLE_OVERLOADING)
data SocketClientGetTlsValidationFlagsMethodInfo
instance (signature ~ (m [Gio.Flags.TlsCertificateFlags]), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientGetTlsValidationFlagsMethodInfo a signature where
    overloadedMethod = socketClientGetTlsValidationFlags

instance O.OverloadedMethodInfo SocketClientGetTlsValidationFlagsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientGetTlsValidationFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientGetTlsValidationFlags"
        })


#endif

-- method SocketClient::set_enable_proxy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to enable proxies"
--                 , 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_client_set_enable_proxy" g_socket_client_set_enable_proxy :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CInt ->                                 -- enable : TBasicType TBoolean
    IO ()

-- | Sets whether or not /@client@/ attempts to make connections via a
-- proxy server. When enabled (the default), t'GI.Gio.Objects.SocketClient.SocketClient' will use a
-- t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver' to determine if a proxy protocol such as SOCKS is
-- needed, and automatically do the necessary proxy negotiation.
-- 
-- See also 'GI.Gio.Objects.SocketClient.socketClientSetProxyResolver'.
-- 
-- /Since: 2.26/
socketClientSetEnableProxy ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> Bool
    -- ^ /@enable@/: whether to enable proxies
    -> m ()
socketClientSetEnableProxy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> Bool -> m ()
socketClientSetEnableProxy a
client Bool
enable = 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let enable' :: CInt
enable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
enable
    Ptr SocketClient -> CInt -> IO ()
g_socket_client_set_enable_proxy Ptr SocketClient
client' CInt
enable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientSetEnableProxyMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientSetEnableProxyMethodInfo a signature where
    overloadedMethod = socketClientSetEnableProxy

instance O.OverloadedMethodInfo SocketClientSetEnableProxyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientSetEnableProxy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientSetEnableProxy"
        })


#endif

-- method SocketClient::set_family
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_socket_client_set_family" g_socket_client_set_family :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CUInt ->                                -- family : TInterface (Name {namespace = "Gio", name = "SocketFamily"})
    IO ()

-- | Sets the socket family of the socket client.
-- If this is set to something other than 'GI.Gio.Enums.SocketFamilyInvalid'
-- then the sockets created by this object will be of the specified
-- family.
-- 
-- This might be useful for instance if you want to force the local
-- connection to be an ipv4 socket, even though the address might
-- be an ipv6 mapped to ipv4 address.
-- 
-- /Since: 2.22/
socketClientSetFamily ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> Gio.Enums.SocketFamily
    -- ^ /@family@/: a t'GI.Gio.Enums.SocketFamily'
    -> m ()
socketClientSetFamily :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> SocketFamily -> m ()
socketClientSetFamily a
client SocketFamily
family = 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    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
    Ptr SocketClient -> CUInt -> IO ()
g_socket_client_set_family Ptr SocketClient
client' CUInt
family'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientSetFamilyMethodInfo
instance (signature ~ (Gio.Enums.SocketFamily -> m ()), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientSetFamilyMethodInfo a signature where
    overloadedMethod = socketClientSetFamily

instance O.OverloadedMethodInfo SocketClientSetFamilyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientSetFamily",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientSetFamily"
        })


#endif

-- method SocketClient::set_local_address
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , 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 = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketAddress, or %NULL"
--                 , 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_client_set_local_address" g_socket_client_set_local_address :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    Ptr Gio.SocketAddress.SocketAddress ->  -- address : TInterface (Name {namespace = "Gio", name = "SocketAddress"})
    IO ()

-- | Sets the local address of the socket client.
-- The sockets created by this object will bound to the
-- specified address (if not 'P.Nothing') before connecting.
-- 
-- This is useful if you want to ensure that the local
-- side of the connection is on a specific port, or on
-- a specific interface.
-- 
-- /Since: 2.22/
socketClientSetLocalAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.SocketAddress.IsSocketAddress b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> Maybe (b)
    -- ^ /@address@/: a t'GI.Gio.Objects.SocketAddress.SocketAddress', or 'P.Nothing'
    -> m ()
socketClientSetLocalAddress :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsSocketAddress b) =>
a -> Maybe b -> m ()
socketClientSetLocalAddress a
client Maybe b
address = 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr SocketAddress
maybeAddress <- case Maybe b
address of
        Maybe b
Nothing -> Ptr SocketAddress -> IO (Ptr SocketAddress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketAddress
forall a. Ptr a
nullPtr
        Just b
jAddress -> do
            Ptr SocketAddress
jAddress' <- b -> IO (Ptr SocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jAddress
            Ptr SocketAddress -> IO (Ptr SocketAddress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketAddress
jAddress'
    Ptr SocketClient -> Ptr SocketAddress -> IO ()
g_socket_client_set_local_address Ptr SocketClient
client' Ptr SocketAddress
maybeAddress
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
address b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientSetLocalAddressMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSocketClient a, Gio.SocketAddress.IsSocketAddress b) => O.OverloadedMethod SocketClientSetLocalAddressMethodInfo a signature where
    overloadedMethod = socketClientSetLocalAddress

instance O.OverloadedMethodInfo SocketClientSetLocalAddressMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientSetLocalAddress",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientSetLocalAddress"
        })


#endif

-- method SocketClient::set_protocol
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocol"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketProtocol" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketProtocol" , 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_client_set_protocol" g_socket_client_set_protocol :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CInt ->                                 -- protocol : TInterface (Name {namespace = "Gio", name = "SocketProtocol"})
    IO ()

-- | Sets the protocol of the socket client.
-- The sockets created by this object will use of the specified
-- protocol.
-- 
-- If /@protocol@/ is 'GI.Gio.Enums.SocketProtocolDefault' that means to use the default
-- protocol for the socket family and type.
-- 
-- /Since: 2.22/
socketClientSetProtocol ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> Gio.Enums.SocketProtocol
    -- ^ /@protocol@/: a t'GI.Gio.Enums.SocketProtocol'
    -> m ()
socketClientSetProtocol :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> SocketProtocol -> m ()
socketClientSetProtocol a
client SocketProtocol
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
    Ptr SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let protocol' :: CInt
protocol' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (SocketProtocol -> Int) -> SocketProtocol -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketProtocol -> Int
forall a. Enum a => a -> Int
fromEnum) SocketProtocol
protocol
    Ptr SocketClient -> CInt -> IO ()
g_socket_client_set_protocol Ptr SocketClient
client' CInt
protocol'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientSetProtocolMethodInfo
instance (signature ~ (Gio.Enums.SocketProtocol -> m ()), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientSetProtocolMethodInfo a signature where
    overloadedMethod = socketClientSetProtocol

instance O.OverloadedMethodInfo SocketClientSetProtocolMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientSetProtocol",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientSetProtocol"
        })


#endif

-- method SocketClient::set_proxy_resolver
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proxy_resolver"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ProxyResolver" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GProxyResolver, or %NULL for the\n  default."
--                 , 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_client_set_proxy_resolver" g_socket_client_set_proxy_resolver :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    Ptr Gio.ProxyResolver.ProxyResolver ->  -- proxy_resolver : TInterface (Name {namespace = "Gio", name = "ProxyResolver"})
    IO ()

-- | Overrides the t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver' used by /@client@/. You can call this if
-- you want to use specific proxies, rather than using the system
-- default proxy settings.
-- 
-- Note that whether or not the proxy resolver is actually used
-- depends on the setting of [SocketClient:enableProxy]("GI.Gio.Objects.SocketClient#g:attr:enableProxy"), which is not
-- changed by this function (but which is 'P.True' by default)
-- 
-- /Since: 2.36/
socketClientSetProxyResolver ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a, Gio.ProxyResolver.IsProxyResolver b) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> Maybe (b)
    -- ^ /@proxyResolver@/: a t'GI.Gio.Interfaces.ProxyResolver.ProxyResolver', or 'P.Nothing' for the
    --   default.
    -> m ()
socketClientSetProxyResolver :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketClient a, IsProxyResolver b) =>
a -> Maybe b -> m ()
socketClientSetProxyResolver a
client Maybe b
proxyResolver = 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr ProxyResolver
maybeProxyResolver <- case Maybe b
proxyResolver of
        Maybe b
Nothing -> Ptr ProxyResolver -> IO (Ptr ProxyResolver)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ProxyResolver
forall a. Ptr a
nullPtr
        Just b
jProxyResolver -> do
            Ptr ProxyResolver
jProxyResolver' <- b -> IO (Ptr ProxyResolver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProxyResolver
            Ptr ProxyResolver -> IO (Ptr ProxyResolver)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ProxyResolver
jProxyResolver'
    Ptr SocketClient -> Ptr ProxyResolver -> IO ()
g_socket_client_set_proxy_resolver Ptr SocketClient
client' Ptr ProxyResolver
maybeProxyResolver
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
proxyResolver b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientSetProxyResolverMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSocketClient a, Gio.ProxyResolver.IsProxyResolver b) => O.OverloadedMethod SocketClientSetProxyResolverMethodInfo a signature where
    overloadedMethod = socketClientSetProxyResolver

instance O.OverloadedMethodInfo SocketClientSetProxyResolverMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientSetProxyResolver",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientSetProxyResolver"
        })


#endif

-- method SocketClient::set_socket_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_socket_client_set_socket_type" g_socket_client_set_socket_type :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gio", name = "SocketType"})
    IO ()

-- | Sets the socket type of the socket client.
-- The sockets created by this object will be of the specified
-- type.
-- 
-- It doesn\'t make sense to specify a type of 'GI.Gio.Enums.SocketTypeDatagram',
-- as GSocketClient is used for connection oriented services.
-- 
-- /Since: 2.22/
socketClientSetSocketType ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> Gio.Enums.SocketType
    -- ^ /@type@/: a t'GI.Gio.Enums.SocketType'
    -> m ()
socketClientSetSocketType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> SocketType -> m ()
socketClientSetSocketType a
client SocketType
type_ = 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    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_
    Ptr SocketClient -> CUInt -> IO ()
g_socket_client_set_socket_type Ptr SocketClient
client' CUInt
type_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientSetSocketTypeMethodInfo
instance (signature ~ (Gio.Enums.SocketType -> m ()), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientSetSocketTypeMethodInfo a signature where
    overloadedMethod = socketClientSetSocketType

instance O.OverloadedMethodInfo SocketClientSetSocketTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientSetSocketType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientSetSocketType"
        })


#endif

-- method SocketClient::set_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the timeout" , 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_client_set_timeout" g_socket_client_set_timeout :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    Word32 ->                               -- timeout : TBasicType TUInt
    IO ()

-- | Sets the I\/O timeout for sockets created by /@client@/. /@timeout@/ is a
-- time in seconds, or 0 for no timeout (the default).
-- 
-- The timeout value affects the initial connection attempt as well,
-- so setting this may cause calls to 'GI.Gio.Objects.SocketClient.socketClientConnect', etc,
-- to fail with 'GI.Gio.Enums.IOErrorEnumTimedOut'.
-- 
-- /Since: 2.26/
socketClientSetTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> Word32
    -- ^ /@timeout@/: the timeout
    -> m ()
socketClientSetTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> Word32 -> m ()
socketClientSetTimeout a
client Word32
timeout = 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr SocketClient -> Word32 -> IO ()
g_socket_client_set_timeout Ptr SocketClient
client' Word32
timeout
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientSetTimeoutMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientSetTimeoutMethodInfo a signature where
    overloadedMethod = socketClientSetTimeout

instance O.OverloadedMethodInfo SocketClientSetTimeoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientSetTimeout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientSetTimeout"
        })


#endif

-- method SocketClient::set_tls
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tls"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to use TLS" , 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_client_set_tls" g_socket_client_set_tls :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CInt ->                                 -- tls : TBasicType TBoolean
    IO ()

-- | Sets whether /@client@/ creates TLS (aka SSL) connections. If /@tls@/ is
-- 'P.True', /@client@/ will wrap its connections in a t'GI.Gio.Interfaces.TlsClientConnection.TlsClientConnection'
-- and perform a TLS handshake when connecting.
-- 
-- Note that since t'GI.Gio.Objects.SocketClient.SocketClient' must return a t'GI.Gio.Objects.SocketConnection.SocketConnection',
-- but t'GI.Gio.Interfaces.TlsClientConnection.TlsClientConnection' is not a t'GI.Gio.Objects.SocketConnection.SocketConnection', this
-- actually wraps the resulting t'GI.Gio.Interfaces.TlsClientConnection.TlsClientConnection' in a
-- t'GI.Gio.Objects.TcpWrapperConnection.TcpWrapperConnection' when returning it. You can use
-- 'GI.Gio.Objects.TcpWrapperConnection.tcpWrapperConnectionGetBaseIoStream' on the return value
-- to extract the t'GI.Gio.Interfaces.TlsClientConnection.TlsClientConnection'.
-- 
-- If you need to modify the behavior of the TLS handshake (eg, by
-- setting a client-side certificate to use, or connecting to the
-- [TlsConnection::acceptCertificate]("GI.Gio.Objects.TlsConnection#g:signal:acceptCertificate") signal), you can connect to
-- /@client@/\'s [SocketClient::event]("GI.Gio.Objects.SocketClient#g:signal:event") signal and wait for it to be
-- emitted with 'GI.Gio.Enums.SocketClientEventTlsHandshaking', which will give you
-- a chance to see the t'GI.Gio.Interfaces.TlsClientConnection.TlsClientConnection' before the handshake
-- starts.
-- 
-- /Since: 2.28/
socketClientSetTls ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> Bool
    -- ^ /@tls@/: whether to use TLS
    -> m ()
socketClientSetTls :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> Bool -> m ()
socketClientSetTls a
client Bool
tls = 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let tls' :: CInt
tls' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
tls
    Ptr SocketClient -> CInt -> IO ()
g_socket_client_set_tls Ptr SocketClient
client' CInt
tls'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientSetTlsMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientSetTlsMethodInfo a signature where
    overloadedMethod = socketClientSetTls

instance O.OverloadedMethodInfo SocketClientSetTlsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientSetTls",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientSetTls"
        })


#endif

-- method SocketClient::set_tls_validation_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSocketClient." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsCertificateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the validation flags"
--                 , 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_client_set_tls_validation_flags" g_socket_client_set_tls_validation_flags :: 
    Ptr SocketClient ->                     -- client : TInterface (Name {namespace = "Gio", name = "SocketClient"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "TlsCertificateFlags"})
    IO ()

-- | Sets the TLS validation flags used when creating TLS connections
-- via /@client@/. The default value is 'GI.Gio.Flags.TlsCertificateFlagsValidateAll'.
-- 
-- /Since: 2.28/
socketClientSetTlsValidationFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsSocketClient a) =>
    a
    -- ^ /@client@/: a t'GI.Gio.Objects.SocketClient.SocketClient'.
    -> [Gio.Flags.TlsCertificateFlags]
    -- ^ /@flags@/: the validation flags
    -> m ()
socketClientSetTlsValidationFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketClient a) =>
a -> [TlsCertificateFlags] -> m ()
socketClientSetTlsValidationFlags a
client [TlsCertificateFlags]
flags = 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 SocketClient
client' <- a -> IO (Ptr SocketClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let flags' :: CUInt
flags' = [TlsCertificateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TlsCertificateFlags]
flags
    Ptr SocketClient -> CUInt -> IO ()
g_socket_client_set_tls_validation_flags Ptr SocketClient
client' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SocketClientSetTlsValidationFlagsMethodInfo
instance (signature ~ ([Gio.Flags.TlsCertificateFlags] -> m ()), MonadIO m, IsSocketClient a) => O.OverloadedMethod SocketClientSetTlsValidationFlagsMethodInfo a signature where
    overloadedMethod = socketClientSetTlsValidationFlags

instance O.OverloadedMethodInfo SocketClientSetTlsValidationFlagsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.SocketClient.socketClientSetTlsValidationFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketClient.html#v:socketClientSetTlsValidationFlags"
        })


#endif