{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IPv4 or IPv6 socket address; that is, the combination of a
-- t'GI.Gio.Objects.InetAddress.InetAddress' and a port number.

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

module GI.Gio.Objects.InetSocketAddress
    ( 

-- * Exported types
    InetSocketAddress(..)                   ,
    IsInetSocketAddress                     ,
    toInetSocketAddress                     ,
    noInetSocketAddress                     ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveInetSocketAddressMethod          ,
#endif


-- ** getAddress #method:getAddress#

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressGetAddressMethodInfo   ,
#endif
    inetSocketAddressGetAddress             ,


-- ** getFlowinfo #method:getFlowinfo#

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressGetFlowinfoMethodInfo  ,
#endif
    inetSocketAddressGetFlowinfo            ,


-- ** getPort #method:getPort#

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressGetPortMethodInfo      ,
#endif
    inetSocketAddressGetPort                ,


-- ** getScopeId #method:getScopeId#

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressGetScopeIdMethodInfo   ,
#endif
    inetSocketAddressGetScopeId             ,


-- ** new #method:new#

    inetSocketAddressNew                    ,


-- ** newFromString #method:newFromString#

    inetSocketAddressNewFromString          ,




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

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressAddressPropertyInfo    ,
#endif
    constructInetSocketAddressAddress       ,
    getInetSocketAddressAddress             ,
#if defined(ENABLE_OVERLOADING)
    inetSocketAddressAddress                ,
#endif


-- ** flowinfo #attr:flowinfo#
-- | The @sin6_flowinfo@ field, for IPv6 addresses.
-- 
-- /Since: 2.32/

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressFlowinfoPropertyInfo   ,
#endif
    constructInetSocketAddressFlowinfo      ,
    getInetSocketAddressFlowinfo            ,
#if defined(ENABLE_OVERLOADING)
    inetSocketAddressFlowinfo               ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressPortPropertyInfo       ,
#endif
    constructInetSocketAddressPort          ,
    getInetSocketAddressPort                ,
#if defined(ENABLE_OVERLOADING)
    inetSocketAddressPort                   ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressScopeIdPropertyInfo    ,
#endif
    constructInetSocketAddressScopeId       ,
    getInetSocketAddressScopeId             ,
#if defined(ENABLE_OVERLOADING)
    inetSocketAddressScopeId                ,
#endif




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Interfaces.SocketConnectable as Gio.SocketConnectable
import {-# SOURCE #-} qualified GI.Gio.Objects.InetAddress as Gio.InetAddress
import {-# SOURCE #-} qualified GI.Gio.Objects.SocketAddress as Gio.SocketAddress

-- | Memory-managed wrapper type.
newtype InetSocketAddress = InetSocketAddress (ManagedPtr InetSocketAddress)
    deriving (InetSocketAddress -> InetSocketAddress -> Bool
(InetSocketAddress -> InetSocketAddress -> Bool)
-> (InetSocketAddress -> InetSocketAddress -> Bool)
-> Eq InetSocketAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InetSocketAddress -> InetSocketAddress -> Bool
$c/= :: InetSocketAddress -> InetSocketAddress -> Bool
== :: InetSocketAddress -> InetSocketAddress -> Bool
$c== :: InetSocketAddress -> InetSocketAddress -> Bool
Eq)
foreign import ccall "g_inet_socket_address_get_type"
    c_g_inet_socket_address_get_type :: IO GType

instance GObject InetSocketAddress where
    gobjectType :: IO GType
gobjectType = IO GType
c_g_inet_socket_address_get_type
    

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

-- | Type class for types which can be safely cast to `InetSocketAddress`, for instance with `toInetSocketAddress`.
class (GObject o, O.IsDescendantOf InetSocketAddress o) => IsInetSocketAddress o
instance (GObject o, O.IsDescendantOf InetSocketAddress o) => IsInetSocketAddress o

instance O.HasParentTypes InetSocketAddress
type instance O.ParentTypes InetSocketAddress = '[Gio.SocketAddress.SocketAddress, GObject.Object.Object, Gio.SocketConnectable.SocketConnectable]

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

-- | A convenience alias for `Nothing` :: `Maybe` `InetSocketAddress`.
noInetSocketAddress :: Maybe InetSocketAddress
noInetSocketAddress :: Maybe InetSocketAddress
noInetSocketAddress = Maybe InetSocketAddress
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveInetSocketAddressMethod (t :: Symbol) (o :: *) :: * where
    ResolveInetSocketAddressMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveInetSocketAddressMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveInetSocketAddressMethod "enumerate" o = Gio.SocketConnectable.SocketConnectableEnumerateMethodInfo
    ResolveInetSocketAddressMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveInetSocketAddressMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveInetSocketAddressMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveInetSocketAddressMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveInetSocketAddressMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveInetSocketAddressMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveInetSocketAddressMethod "proxyEnumerate" o = Gio.SocketConnectable.SocketConnectableProxyEnumerateMethodInfo
    ResolveInetSocketAddressMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveInetSocketAddressMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveInetSocketAddressMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveInetSocketAddressMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveInetSocketAddressMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveInetSocketAddressMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveInetSocketAddressMethod "toNative" o = Gio.SocketAddress.SocketAddressToNativeMethodInfo
    ResolveInetSocketAddressMethod "toString" o = Gio.SocketConnectable.SocketConnectableToStringMethodInfo
    ResolveInetSocketAddressMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveInetSocketAddressMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveInetSocketAddressMethod "getAddress" o = InetSocketAddressGetAddressMethodInfo
    ResolveInetSocketAddressMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveInetSocketAddressMethod "getFamily" o = Gio.SocketAddress.SocketAddressGetFamilyMethodInfo
    ResolveInetSocketAddressMethod "getFlowinfo" o = InetSocketAddressGetFlowinfoMethodInfo
    ResolveInetSocketAddressMethod "getNativeSize" o = Gio.SocketAddress.SocketAddressGetNativeSizeMethodInfo
    ResolveInetSocketAddressMethod "getPort" o = InetSocketAddressGetPortMethodInfo
    ResolveInetSocketAddressMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveInetSocketAddressMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveInetSocketAddressMethod "getScopeId" o = InetSocketAddressGetScopeIdMethodInfo
    ResolveInetSocketAddressMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveInetSocketAddressMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveInetSocketAddressMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveInetSocketAddressMethod l o = O.MethodResolutionFailed l o

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

#endif

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

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

-- | Construct a `GValueConstruct` with valid value for the “@address@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInetSocketAddressAddress :: (IsInetSocketAddress o, Gio.InetAddress.IsInetAddress a) => a -> IO (GValueConstruct o)
constructInetSocketAddressAddress :: a -> IO (GValueConstruct o)
constructInetSocketAddressAddress val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "address" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressAddressPropertyInfo
instance AttrInfo InetSocketAddressAddressPropertyInfo where
    type AttrAllowedOps InetSocketAddressAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint InetSocketAddressAddressPropertyInfo = IsInetSocketAddress
    type AttrSetTypeConstraint InetSocketAddressAddressPropertyInfo = Gio.InetAddress.IsInetAddress
    type AttrTransferTypeConstraint InetSocketAddressAddressPropertyInfo = Gio.InetAddress.IsInetAddress
    type AttrTransferType InetSocketAddressAddressPropertyInfo = Gio.InetAddress.InetAddress
    type AttrGetType InetSocketAddressAddressPropertyInfo = Gio.InetAddress.InetAddress
    type AttrLabel InetSocketAddressAddressPropertyInfo = "address"
    type AttrOrigin InetSocketAddressAddressPropertyInfo = InetSocketAddress
    attrGet = getInetSocketAddressAddress
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.InetAddress.InetAddress v
    attrConstruct = constructInetSocketAddressAddress
    attrClear = undefined
#endif

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

-- | Get the value of the “@flowinfo@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inetSocketAddress #flowinfo
-- @
getInetSocketAddressFlowinfo :: (MonadIO m, IsInetSocketAddress o) => o -> m Word32
getInetSocketAddressFlowinfo :: o -> m Word32
getInetSocketAddressFlowinfo obj :: o
obj = 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
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj "flowinfo"

-- | Construct a `GValueConstruct` with valid value for the “@flowinfo@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInetSocketAddressFlowinfo :: (IsInetSocketAddress o) => Word32 -> IO (GValueConstruct o)
constructInetSocketAddressFlowinfo :: Word32 -> IO (GValueConstruct o)
constructInetSocketAddressFlowinfo val :: Word32
val = String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 "flowinfo" Word32
val

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressFlowinfoPropertyInfo
instance AttrInfo InetSocketAddressFlowinfoPropertyInfo where
    type AttrAllowedOps InetSocketAddressFlowinfoPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InetSocketAddressFlowinfoPropertyInfo = IsInetSocketAddress
    type AttrSetTypeConstraint InetSocketAddressFlowinfoPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint InetSocketAddressFlowinfoPropertyInfo = (~) Word32
    type AttrTransferType InetSocketAddressFlowinfoPropertyInfo = Word32
    type AttrGetType InetSocketAddressFlowinfoPropertyInfo = Word32
    type AttrLabel InetSocketAddressFlowinfoPropertyInfo = "flowinfo"
    type AttrOrigin InetSocketAddressFlowinfoPropertyInfo = InetSocketAddress
    attrGet = getInetSocketAddressFlowinfo
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInetSocketAddressFlowinfo
    attrClear = undefined
#endif

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

-- | Get the value of the “@port@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inetSocketAddress #port
-- @
getInetSocketAddressPort :: (MonadIO m, IsInetSocketAddress o) => o -> m Word32
getInetSocketAddressPort :: o -> m Word32
getInetSocketAddressPort obj :: o
obj = 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
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj "port"

-- | Construct a `GValueConstruct` with valid value for the “@port@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInetSocketAddressPort :: (IsInetSocketAddress o) => Word32 -> IO (GValueConstruct o)
constructInetSocketAddressPort :: Word32 -> IO (GValueConstruct o)
constructInetSocketAddressPort val :: Word32
val = String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 "port" Word32
val

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressPortPropertyInfo
instance AttrInfo InetSocketAddressPortPropertyInfo where
    type AttrAllowedOps InetSocketAddressPortPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InetSocketAddressPortPropertyInfo = IsInetSocketAddress
    type AttrSetTypeConstraint InetSocketAddressPortPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint InetSocketAddressPortPropertyInfo = (~) Word32
    type AttrTransferType InetSocketAddressPortPropertyInfo = Word32
    type AttrGetType InetSocketAddressPortPropertyInfo = Word32
    type AttrLabel InetSocketAddressPortPropertyInfo = "port"
    type AttrOrigin InetSocketAddressPortPropertyInfo = InetSocketAddress
    attrGet = getInetSocketAddressPort
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInetSocketAddressPort
    attrClear = undefined
#endif

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

-- | Get the value of the “@scope-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inetSocketAddress #scopeId
-- @
getInetSocketAddressScopeId :: (MonadIO m, IsInetSocketAddress o) => o -> m Word32
getInetSocketAddressScopeId :: o -> m Word32
getInetSocketAddressScopeId obj :: o
obj = 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
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj "scope-id"

-- | Construct a `GValueConstruct` with valid value for the “@scope-id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInetSocketAddressScopeId :: (IsInetSocketAddress o) => Word32 -> IO (GValueConstruct o)
constructInetSocketAddressScopeId :: Word32 -> IO (GValueConstruct o)
constructInetSocketAddressScopeId val :: Word32
val = String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 "scope-id" Word32
val

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressScopeIdPropertyInfo
instance AttrInfo InetSocketAddressScopeIdPropertyInfo where
    type AttrAllowedOps InetSocketAddressScopeIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InetSocketAddressScopeIdPropertyInfo = IsInetSocketAddress
    type AttrSetTypeConstraint InetSocketAddressScopeIdPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint InetSocketAddressScopeIdPropertyInfo = (~) Word32
    type AttrTransferType InetSocketAddressScopeIdPropertyInfo = Word32
    type AttrGetType InetSocketAddressScopeIdPropertyInfo = Word32
    type AttrLabel InetSocketAddressScopeIdPropertyInfo = "scope-id"
    type AttrOrigin InetSocketAddressScopeIdPropertyInfo = InetSocketAddress
    attrGet = getInetSocketAddressScopeId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInetSocketAddressScopeId
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList InetSocketAddress
type instance O.AttributeList InetSocketAddress = InetSocketAddressAttributeList
type InetSocketAddressAttributeList = ('[ '("address", InetSocketAddressAddressPropertyInfo), '("family", Gio.SocketAddress.SocketAddressFamilyPropertyInfo), '("flowinfo", InetSocketAddressFlowinfoPropertyInfo), '("port", InetSocketAddressPortPropertyInfo), '("scopeId", InetSocketAddressScopeIdPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
inetSocketAddressAddress :: AttrLabelProxy "address"
inetSocketAddressAddress = AttrLabelProxy

inetSocketAddressFlowinfo :: AttrLabelProxy "flowinfo"
inetSocketAddressFlowinfo = AttrLabelProxy

inetSocketAddressPort :: AttrLabelProxy "port"
inetSocketAddressPort = AttrLabelProxy

inetSocketAddressScopeId :: AttrLabelProxy "scopeId"
inetSocketAddressScopeId = AttrLabelProxy

#endif

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

#endif

-- method InetSocketAddress::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InetAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInetAddress" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "port"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a port number" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "InetSocketAddress" })
-- throws : False
-- Skip return : False

foreign import ccall "g_inet_socket_address_new" g_inet_socket_address_new :: 
    Ptr Gio.InetAddress.InetAddress ->      -- address : TInterface (Name {namespace = "Gio", name = "InetAddress"})
    Word16 ->                               -- port : TBasicType TUInt16
    IO (Ptr InetSocketAddress)

-- | Creates a new t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress' for /@address@/ and /@port@/.
-- 
-- /Since: 2.22/
inetSocketAddressNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.InetAddress.IsInetAddress a) =>
    a
    -- ^ /@address@/: a t'GI.Gio.Objects.InetAddress.InetAddress'
    -> Word16
    -- ^ /@port@/: a port number
    -> m InetSocketAddress
    -- ^ __Returns:__ a new t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
inetSocketAddressNew :: a -> Word16 -> m InetSocketAddress
inetSocketAddressNew address :: a
address port :: Word16
port = IO InetSocketAddress -> m InetSocketAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InetSocketAddress -> m InetSocketAddress)
-> IO InetSocketAddress -> m InetSocketAddress
forall a b. (a -> b) -> a -> b
$ do
    Ptr InetAddress
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Ptr InetSocketAddress
result <- Ptr InetAddress -> Word16 -> IO (Ptr InetSocketAddress)
g_inet_socket_address_new Ptr InetAddress
address' Word16
port
    Text -> Ptr InetSocketAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "inetSocketAddressNew" Ptr InetSocketAddress
result
    InetSocketAddress
result' <- ((ManagedPtr InetSocketAddress -> InetSocketAddress)
-> Ptr InetSocketAddress -> IO InetSocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InetSocketAddress -> InetSocketAddress
InetSocketAddress) Ptr InetSocketAddress
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    InetSocketAddress -> IO InetSocketAddress
forall (m :: * -> *) a. Monad m => a -> m a
return InetSocketAddress
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method InetSocketAddress::new_from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "address"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the string form of an IP address"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "port"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a port number" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "InetSocketAddress" })
-- throws : False
-- Skip return : False

foreign import ccall "g_inet_socket_address_new_from_string" g_inet_socket_address_new_from_string :: 
    CString ->                              -- address : TBasicType TUTF8
    Word32 ->                               -- port : TBasicType TUInt
    IO (Ptr InetSocketAddress)

-- | Creates a new t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress' for /@address@/ and /@port@/.
-- 
-- If /@address@/ is an IPv6 address, it can also contain a scope ID
-- (separated from the address by a @%@).
-- 
-- /Since: 2.40/
inetSocketAddressNewFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@address@/: the string form of an IP address
    -> Word32
    -- ^ /@port@/: a port number
    -> m InetSocketAddress
    -- ^ __Returns:__ a new t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress', or 'P.Nothing' if /@address@/ cannot be
    -- parsed.
inetSocketAddressNewFromString :: Text -> Word32 -> m InetSocketAddress
inetSocketAddressNewFromString address :: Text
address port :: Word32
port = IO InetSocketAddress -> m InetSocketAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InetSocketAddress -> m InetSocketAddress)
-> IO InetSocketAddress -> m InetSocketAddress
forall a b. (a -> b) -> a -> b
$ do
    CString
address' <- Text -> IO CString
textToCString Text
address
    Ptr InetSocketAddress
result <- CString -> Word32 -> IO (Ptr InetSocketAddress)
g_inet_socket_address_new_from_string CString
address' Word32
port
    Text -> Ptr InetSocketAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "inetSocketAddressNewFromString" Ptr InetSocketAddress
result
    InetSocketAddress
result' <- ((ManagedPtr InetSocketAddress -> InetSocketAddress)
-> Ptr InetSocketAddress -> IO InetSocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InetSocketAddress -> InetSocketAddress
InetSocketAddress) Ptr InetSocketAddress
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
address'
    InetSocketAddress -> IO InetSocketAddress
forall (m :: * -> *) a. Monad m => a -> m a
return InetSocketAddress
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "g_inet_socket_address_get_address" g_inet_socket_address_get_address :: 
    Ptr InetSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "InetSocketAddress"})
    IO (Ptr Gio.InetAddress.InetAddress)

-- | Gets /@address@/\'s t'GI.Gio.Objects.InetAddress.InetAddress'.
-- 
-- /Since: 2.22/
inetSocketAddressGetAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsInetSocketAddress a) =>
    a
    -- ^ /@address@/: a t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
    -> m Gio.InetAddress.InetAddress
    -- ^ __Returns:__ the t'GI.Gio.Objects.InetAddress.InetAddress' for /@address@/, which must be
    -- 'GI.GObject.Objects.Object.objectRef'\'d if it will be stored
inetSocketAddressGetAddress :: a -> m InetAddress
inetSocketAddressGetAddress address :: a
address = IO InetAddress -> m InetAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InetAddress -> m InetAddress)
-> IO InetAddress -> m InetAddress
forall a b. (a -> b) -> a -> b
$ do
    Ptr InetSocketAddress
address' <- a -> IO (Ptr InetSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Ptr InetAddress
result <- Ptr InetSocketAddress -> IO (Ptr InetAddress)
g_inet_socket_address_get_address Ptr InetSocketAddress
address'
    Text -> Ptr InetAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "inetSocketAddressGetAddress" Ptr InetAddress
result
    InetAddress
result' <- ((ManagedPtr InetAddress -> InetAddress)
-> Ptr InetAddress -> IO InetAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr InetAddress -> InetAddress
Gio.InetAddress.InetAddress) Ptr InetAddress
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    InetAddress -> IO InetAddress
forall (m :: * -> *) a. Monad m => a -> m a
return InetAddress
result'

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressGetAddressMethodInfo
instance (signature ~ (m Gio.InetAddress.InetAddress), MonadIO m, IsInetSocketAddress a) => O.MethodInfo InetSocketAddressGetAddressMethodInfo a signature where
    overloadedMethod = inetSocketAddressGetAddress

#endif

-- method InetSocketAddress::get_flowinfo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InetSocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a %G_SOCKET_FAMILY_IPV6 #GInetSocketAddress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "g_inet_socket_address_get_flowinfo" g_inet_socket_address_get_flowinfo :: 
    Ptr InetSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "InetSocketAddress"})
    IO Word32

-- | Gets the @sin6_flowinfo@ field from /@address@/,
-- which must be an IPv6 address.
-- 
-- /Since: 2.32/
inetSocketAddressGetFlowinfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsInetSocketAddress a) =>
    a
    -- ^ /@address@/: a 'GI.Gio.Enums.SocketFamilyIpv6' t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
    -> m Word32
    -- ^ __Returns:__ the flowinfo field
inetSocketAddressGetFlowinfo :: a -> m Word32
inetSocketAddressGetFlowinfo address :: a
address = 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 InetSocketAddress
address' <- a -> IO (Ptr InetSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Word32
result <- Ptr InetSocketAddress -> IO Word32
g_inet_socket_address_get_flowinfo Ptr InetSocketAddress
address'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressGetFlowinfoMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsInetSocketAddress a) => O.MethodInfo InetSocketAddressGetFlowinfoMethodInfo a signature where
    overloadedMethod = inetSocketAddressGetFlowinfo

#endif

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

foreign import ccall "g_inet_socket_address_get_port" g_inet_socket_address_get_port :: 
    Ptr InetSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "InetSocketAddress"})
    IO Word16

-- | Gets /@address@/\'s port.
-- 
-- /Since: 2.22/
inetSocketAddressGetPort ::
    (B.CallStack.HasCallStack, MonadIO m, IsInetSocketAddress a) =>
    a
    -- ^ /@address@/: a t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
    -> m Word16
    -- ^ __Returns:__ the port for /@address@/
inetSocketAddressGetPort :: a -> m Word16
inetSocketAddressGetPort address :: a
address = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr InetSocketAddress
address' <- a -> IO (Ptr InetSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Word16
result <- Ptr InetSocketAddress -> IO Word16
g_inet_socket_address_get_port Ptr InetSocketAddress
address'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressGetPortMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsInetSocketAddress a) => O.MethodInfo InetSocketAddressGetPortMethodInfo a signature where
    overloadedMethod = inetSocketAddressGetPort

#endif

-- method InetSocketAddress::get_scope_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InetSocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a %G_SOCKET_FAMILY_IPV6 #GInetAddress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "g_inet_socket_address_get_scope_id" g_inet_socket_address_get_scope_id :: 
    Ptr InetSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "InetSocketAddress"})
    IO Word32

-- | Gets the @sin6_scope_id@ field from /@address@/,
-- which must be an IPv6 address.
-- 
-- /Since: 2.32/
inetSocketAddressGetScopeId ::
    (B.CallStack.HasCallStack, MonadIO m, IsInetSocketAddress a) =>
    a
    -- ^ /@address@/: a 'GI.Gio.Enums.SocketFamilyIpv6' t'GI.Gio.Objects.InetAddress.InetAddress'
    -> m Word32
    -- ^ __Returns:__ the scope id field
inetSocketAddressGetScopeId :: a -> m Word32
inetSocketAddressGetScopeId address :: a
address = 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 InetSocketAddress
address' <- a -> IO (Ptr InetSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Word32
result <- Ptr InetSocketAddress -> IO Word32
g_inet_socket_address_get_scope_id Ptr InetSocketAddress
address'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressGetScopeIdMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsInetSocketAddress a) => O.MethodInfo InetSocketAddressGetScopeIdMethodInfo a signature where
    overloadedMethod = inetSocketAddressGetScopeId

#endif