{-# LINE 1 "src/Posix/Socket/Types.hsc" #-}
{-# language DataKinds #-}
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language GADTSyntax #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language KindSignatures #-}
{-# language MagicHash #-}
{-# language PatternSynonyms #-}
{-# language UnboxedTuples #-}
{-# language NamedFieldPuns #-}

-- This is needed because hsc2hs does not currently handle ticked
-- promoted data constructors correctly.
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}






-- | All of the data constructors provided by this module are unsafe.
--   Only use them if you really know what you are doing.
module Posix.Socket.Types
  ( Family(..)
  , Type(..)
  , Protocol(..)
  , Level(..)
  , OptionName(..)
  , OptionValue(..)
  , SocketAddress(..)
  , SocketAddressInternet(..)
  , SocketAddressInternet6(..)
  , SocketAddressUnix(..)
  , MessageFlags(..)
  , Message(..)
  , ShutdownType(..)
  , AddressInfoFlags(..)
    -- * Phantom Types
  , AddressInfo
    -- * Socket Families
  , pattern Unix
  , pattern Unspecified
  , pattern Internet
  , pattern Internet6
    -- * Socket Types
  , stream
  , datagram
  , raw
  , sequencedPacket
    -- * Protocols
  , defaultProtocol
  , rawProtocol
  , icmp
  , tcp
  , udp
  , ip
  , ipv6
    -- * Receive Flags
  , peek
  , outOfBand
  , waitAll
    -- * Send Flags
  , noSignal
    -- * Shutdown Types
  , read
  , write
  , readWrite
    -- * Socket Levels
  , levelSocket
    -- * Option Names
  , optionError
  , bindToDevice
  , broadcast
  , reuseAddress
    -- * AddressInfo
    -- ** Peek
  , peekAddressInfoFlags
  , peekAddressInfoFamily
  , peekAddressInfoSocketType
  , peekAddressInfoProtocol
  , peekAddressInfoAddressLength
  , peekAddressInfoAddress
  , peekAddressInfoNext
    -- ** Poke
  , pokeAddressInfoFlags
  , pokeAddressInfoFamily
  , pokeAddressInfoSocketType
  , pokeAddressInfoProtocol
    -- ** Metadata
  , sizeofAddressInfo
    -- * Message Header
    -- ** Peek
  , peekMessageHeaderName
  , peekMessageHeaderNameLength
  , peekMessageHeaderIOVector
  , peekMessageHeaderIOVectorLength
  , peekMessageHeaderControl
  , peekMessageHeaderControlLength
  , peekMessageHeaderFlags
  , peekControlMessageHeaderLevel
  , peekControlMessageHeaderLength
  , peekControlMessageHeaderType
    -- ** Poke
  , pokeMessageHeaderName
  , pokeMessageHeaderNameLength
  , pokeMessageHeaderIOVector
  , pokeMessageHeaderIOVectorLength
  , pokeMessageHeaderControl
  , pokeMessageHeaderControlLength
  , pokeMessageHeaderFlags
    -- ** Metadata
  , sizeofMessageHeader
    -- * IO Vector
    -- ** Peek
  , peekIOVectorBase
  , peekIOVectorLength
    -- ** Poke
  , pokeIOVectorBase
  , pokeIOVectorLength
    -- ** Metadata
  , sizeofIOVector
  ) where

import Prelude hiding (read)

import Data.Bits (Bits,(.|.))
import Data.Primitive (ByteArray,Prim(..))
import Data.Primitive.Addr (Addr(..))
import Data.Word (Word16,Word32,Word64)
import Foreign.C.Types (CInt(..),CSize)
import Foreign.Storable (Storable,peekByteOff,pokeByteOff)
import GHC.Ptr (Ptr(..))
import GHC.Exts (Int(I#),Int#,(*#),(+#))

import qualified Data.Kind
import qualified Data.Primitive as PM

-- | Phantom for pointers to @addrinfo@ in address resolution functions.
-- According to POSIX:
--
-- > struct addrinfo {
-- >     int              ai_flags;
-- >     int              ai_family;
-- >     int              ai_socktype;
-- >     int              ai_protocol;
-- >     socklen_t        ai_addrlen;
-- >     struct sockaddr *ai_addr;
-- >     char            *ai_canonname;
-- >     struct addrinfo *ai_next;
-- > };
data AddressInfo

-- | A socket communications domain, sometimes referred to as a family. The spec
--   mandates @AF_UNIX@, @AF_UNSPEC@, and @AF_INET@.
newtype Family = Family CInt
  deriving newtype (Ptr Family -> IO Family
Ptr Family -> Int -> IO Family
Ptr Family -> Int -> Family -> IO ()
Ptr Family -> Family -> IO ()
Family -> Int
(Family -> Int)
-> (Family -> Int)
-> (Ptr Family -> Int -> IO Family)
-> (Ptr Family -> Int -> Family -> IO ())
-> (forall b. Ptr b -> Int -> IO Family)
-> (forall b. Ptr b -> Int -> Family -> IO ())
-> (Ptr Family -> IO Family)
-> (Ptr Family -> Family -> IO ())
-> Storable Family
forall b. Ptr b -> Int -> IO Family
forall b. Ptr b -> Int -> Family -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Family -> Int
sizeOf :: Family -> Int
$calignment :: Family -> Int
alignment :: Family -> Int
$cpeekElemOff :: Ptr Family -> Int -> IO Family
peekElemOff :: Ptr Family -> Int -> IO Family
$cpokeElemOff :: Ptr Family -> Int -> Family -> IO ()
pokeElemOff :: Ptr Family -> Int -> Family -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Family
peekByteOff :: forall b. Ptr b -> Int -> IO Family
$cpokeByteOff :: forall b. Ptr b -> Int -> Family -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Family -> IO ()
$cpeek :: Ptr Family -> IO Family
peek :: Ptr Family -> IO Family
$cpoke :: Ptr Family -> Family -> IO ()
poke :: Ptr Family -> Family -> IO ()
Storable)

-- | A socket type. The spec mandates @SOCK_STREAM@, @SOCK_DGRAM@,
--   and @SOCK_SEQPACKET@. Other types may be available on a per-platform
--   basis.
--
--   TODO: Change this to SocketType
newtype Type = Type CInt
  deriving newtype (Ptr Type -> IO Type
Ptr Type -> Int -> IO Type
Ptr Type -> Int -> Type -> IO ()
Ptr Type -> Type -> IO ()
Type -> Int
(Type -> Int)
-> (Type -> Int)
-> (Ptr Type -> Int -> IO Type)
-> (Ptr Type -> Int -> Type -> IO ())
-> (forall b. Ptr b -> Int -> IO Type)
-> (forall b. Ptr b -> Int -> Type -> IO ())
-> (Ptr Type -> IO Type)
-> (Ptr Type -> Type -> IO ())
-> Storable Type
forall b. Ptr b -> Int -> IO Type
forall b. Ptr b -> Int -> Type -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Type -> Int
sizeOf :: Type -> Int
$calignment :: Type -> Int
alignment :: Type -> Int
$cpeekElemOff :: Ptr Type -> Int -> IO Type
peekElemOff :: Ptr Type -> Int -> IO Type
$cpokeElemOff :: Ptr Type -> Int -> Type -> IO ()
pokeElemOff :: Ptr Type -> Int -> Type -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Type
peekByteOff :: forall b. Ptr b -> Int -> IO Type
$cpokeByteOff :: forall b. Ptr b -> Int -> Type -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Type -> IO ()
$cpeek :: Ptr Type -> IO Type
peek :: Ptr Type -> IO Type
$cpoke :: Ptr Type -> Type -> IO ()
poke :: Ptr Type -> Type -> IO ()
Storable)

newtype Protocol = Protocol { Protocol -> CInt
getProtocol :: CInt }
  deriving newtype (Ptr Protocol -> IO Protocol
Ptr Protocol -> Int -> IO Protocol
Ptr Protocol -> Int -> Protocol -> IO ()
Ptr Protocol -> Protocol -> IO ()
Protocol -> Int
(Protocol -> Int)
-> (Protocol -> Int)
-> (Ptr Protocol -> Int -> IO Protocol)
-> (Ptr Protocol -> Int -> Protocol -> IO ())
-> (forall b. Ptr b -> Int -> IO Protocol)
-> (forall b. Ptr b -> Int -> Protocol -> IO ())
-> (Ptr Protocol -> IO Protocol)
-> (Ptr Protocol -> Protocol -> IO ())
-> Storable Protocol
forall b. Ptr b -> Int -> IO Protocol
forall b. Ptr b -> Int -> Protocol -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Protocol -> Int
sizeOf :: Protocol -> Int
$calignment :: Protocol -> Int
alignment :: Protocol -> Int
$cpeekElemOff :: Ptr Protocol -> Int -> IO Protocol
peekElemOff :: Ptr Protocol -> Int -> IO Protocol
$cpokeElemOff :: Ptr Protocol -> Int -> Protocol -> IO ()
pokeElemOff :: Ptr Protocol -> Int -> Protocol -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Protocol
peekByteOff :: forall b. Ptr b -> Int -> IO Protocol
$cpokeByteOff :: forall b. Ptr b -> Int -> Protocol -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Protocol -> IO ()
$cpeek :: Ptr Protocol -> IO Protocol
peek :: Ptr Protocol -> IO Protocol
$cpoke :: Ptr Protocol -> Protocol -> IO ()
poke :: Ptr Protocol -> Protocol -> IO ()
Storable)

newtype Level = Level CInt

-- | Options used in the @option_name@ argument in @getsockopt@
--   or @setsockopt@.  
newtype OptionName = OptionName CInt

-- | Which end of the socket to shutdown.
newtype ShutdownType = ShutdownType CInt

-- | The direction of a message. The data constructor are only used
--   at the type level as phantom arguments.
data Message = Send | Receive

-- | Receive flags are given by @MessageFlags Receive@ and send flags
--   are given by @MessageFlags Send@. This is done because there are
--   several flags that are applicable in either a receiving
--   context or a sending context.
newtype MessageFlags :: Message -> Data.Kind.Type where
  MessageFlags :: CInt -> MessageFlags m
  deriving stock (MessageFlags a -> MessageFlags a -> Bool
(MessageFlags a -> MessageFlags a -> Bool)
-> (MessageFlags a -> MessageFlags a -> Bool)
-> Eq (MessageFlags a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: Message). MessageFlags a -> MessageFlags a -> Bool
$c== :: forall (a :: Message). MessageFlags a -> MessageFlags a -> Bool
== :: MessageFlags a -> MessageFlags a -> Bool
$c/= :: forall (a :: Message). MessageFlags a -> MessageFlags a -> Bool
/= :: MessageFlags a -> MessageFlags a -> Bool
Eq)
  deriving newtype (Eq (MessageFlags a)
MessageFlags a
Eq (MessageFlags a) =>
(MessageFlags a -> MessageFlags a -> MessageFlags a)
-> (MessageFlags a -> MessageFlags a -> MessageFlags a)
-> (MessageFlags a -> MessageFlags a -> MessageFlags a)
-> (MessageFlags a -> MessageFlags a)
-> (MessageFlags a -> Int -> MessageFlags a)
-> (MessageFlags a -> Int -> MessageFlags a)
-> MessageFlags a
-> (Int -> MessageFlags a)
-> (MessageFlags a -> Int -> MessageFlags a)
-> (MessageFlags a -> Int -> MessageFlags a)
-> (MessageFlags a -> Int -> MessageFlags a)
-> (MessageFlags a -> Int -> Bool)
-> (MessageFlags a -> Maybe Int)
-> (MessageFlags a -> Int)
-> (MessageFlags a -> Bool)
-> (MessageFlags a -> Int -> MessageFlags a)
-> (MessageFlags a -> Int -> MessageFlags a)
-> (MessageFlags a -> Int -> MessageFlags a)
-> (MessageFlags a -> Int -> MessageFlags a)
-> (MessageFlags a -> Int -> MessageFlags a)
-> (MessageFlags a -> Int -> MessageFlags a)
-> (MessageFlags a -> Int)
-> Bits (MessageFlags a)
Int -> MessageFlags a
MessageFlags a -> Bool
MessageFlags a -> Int
MessageFlags a -> Maybe Int
MessageFlags a -> MessageFlags a
MessageFlags a -> Int -> Bool
MessageFlags a -> Int -> MessageFlags a
MessageFlags a -> MessageFlags a -> MessageFlags a
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
forall (a :: Message). Eq (MessageFlags a)
forall (a :: Message). MessageFlags a
forall (a :: Message). Int -> MessageFlags a
forall (a :: Message). MessageFlags a -> Bool
forall (a :: Message). MessageFlags a -> Int
forall (a :: Message). MessageFlags a -> Maybe Int
forall (a :: Message). MessageFlags a -> MessageFlags a
forall (a :: Message). MessageFlags a -> Int -> Bool
forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
forall (a :: Message).
MessageFlags a -> MessageFlags a -> MessageFlags a
$c.&. :: forall (a :: Message).
MessageFlags a -> MessageFlags a -> MessageFlags a
.&. :: MessageFlags a -> MessageFlags a -> MessageFlags a
$c.|. :: forall (a :: Message).
MessageFlags a -> MessageFlags a -> MessageFlags a
.|. :: MessageFlags a -> MessageFlags a -> MessageFlags a
$cxor :: forall (a :: Message).
MessageFlags a -> MessageFlags a -> MessageFlags a
xor :: MessageFlags a -> MessageFlags a -> MessageFlags a
$ccomplement :: forall (a :: Message). MessageFlags a -> MessageFlags a
complement :: MessageFlags a -> MessageFlags a
$cshift :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
shift :: MessageFlags a -> Int -> MessageFlags a
$crotate :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
rotate :: MessageFlags a -> Int -> MessageFlags a
$czeroBits :: forall (a :: Message). MessageFlags a
zeroBits :: MessageFlags a
$cbit :: forall (a :: Message). Int -> MessageFlags a
bit :: Int -> MessageFlags a
$csetBit :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
setBit :: MessageFlags a -> Int -> MessageFlags a
$cclearBit :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
clearBit :: MessageFlags a -> Int -> MessageFlags a
$ccomplementBit :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
complementBit :: MessageFlags a -> Int -> MessageFlags a
$ctestBit :: forall (a :: Message). MessageFlags a -> Int -> Bool
testBit :: MessageFlags a -> Int -> Bool
$cbitSizeMaybe :: forall (a :: Message). MessageFlags a -> Maybe Int
bitSizeMaybe :: MessageFlags a -> Maybe Int
$cbitSize :: forall (a :: Message). MessageFlags a -> Int
bitSize :: MessageFlags a -> Int
$cisSigned :: forall (a :: Message). MessageFlags a -> Bool
isSigned :: MessageFlags a -> Bool
$cshiftL :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
shiftL :: MessageFlags a -> Int -> MessageFlags a
$cunsafeShiftL :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
unsafeShiftL :: MessageFlags a -> Int -> MessageFlags a
$cshiftR :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
shiftR :: MessageFlags a -> Int -> MessageFlags a
$cunsafeShiftR :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
unsafeShiftR :: MessageFlags a -> Int -> MessageFlags a
$crotateL :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
rotateL :: MessageFlags a -> Int -> MessageFlags a
$crotateR :: forall (a :: Message). MessageFlags a -> Int -> MessageFlags a
rotateR :: MessageFlags a -> Int -> MessageFlags a
$cpopCount :: forall (a :: Message). MessageFlags a -> Int
popCount :: MessageFlags a -> Int
Bits)

instance Semigroup (MessageFlags m) where <> :: MessageFlags m -> MessageFlags m -> MessageFlags m
(<>) = MessageFlags m -> MessageFlags m -> MessageFlags m
forall a. Bits a => a -> a -> a
(.|.)
instance Monoid (MessageFlags m) where mempty :: MessageFlags m
mempty = CInt -> MessageFlags m
forall (m :: Message). CInt -> MessageFlags m
MessageFlags CInt
0

newtype AddressInfoFlags = AddressInfoFlags CInt
  deriving newtype (AddressInfoFlags -> AddressInfoFlags -> Bool
(AddressInfoFlags -> AddressInfoFlags -> Bool)
-> (AddressInfoFlags -> AddressInfoFlags -> Bool)
-> Eq AddressInfoFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddressInfoFlags -> AddressInfoFlags -> Bool
== :: AddressInfoFlags -> AddressInfoFlags -> Bool
$c/= :: AddressInfoFlags -> AddressInfoFlags -> Bool
/= :: AddressInfoFlags -> AddressInfoFlags -> Bool
Eq,Ptr AddressInfoFlags -> IO AddressInfoFlags
Ptr AddressInfoFlags -> Int -> IO AddressInfoFlags
Ptr AddressInfoFlags -> Int -> AddressInfoFlags -> IO ()
Ptr AddressInfoFlags -> AddressInfoFlags -> IO ()
AddressInfoFlags -> Int
(AddressInfoFlags -> Int)
-> (AddressInfoFlags -> Int)
-> (Ptr AddressInfoFlags -> Int -> IO AddressInfoFlags)
-> (Ptr AddressInfoFlags -> Int -> AddressInfoFlags -> IO ())
-> (forall b. Ptr b -> Int -> IO AddressInfoFlags)
-> (forall b. Ptr b -> Int -> AddressInfoFlags -> IO ())
-> (Ptr AddressInfoFlags -> IO AddressInfoFlags)
-> (Ptr AddressInfoFlags -> AddressInfoFlags -> IO ())
-> Storable AddressInfoFlags
forall b. Ptr b -> Int -> IO AddressInfoFlags
forall b. Ptr b -> Int -> AddressInfoFlags -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: AddressInfoFlags -> Int
sizeOf :: AddressInfoFlags -> Int
$calignment :: AddressInfoFlags -> Int
alignment :: AddressInfoFlags -> Int
$cpeekElemOff :: Ptr AddressInfoFlags -> Int -> IO AddressInfoFlags
peekElemOff :: Ptr AddressInfoFlags -> Int -> IO AddressInfoFlags
$cpokeElemOff :: Ptr AddressInfoFlags -> Int -> AddressInfoFlags -> IO ()
pokeElemOff :: Ptr AddressInfoFlags -> Int -> AddressInfoFlags -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO AddressInfoFlags
peekByteOff :: forall b. Ptr b -> Int -> IO AddressInfoFlags
$cpokeByteOff :: forall b. Ptr b -> Int -> AddressInfoFlags -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> AddressInfoFlags -> IO ()
$cpeek :: Ptr AddressInfoFlags -> IO AddressInfoFlags
peek :: Ptr AddressInfoFlags -> IO AddressInfoFlags
$cpoke :: Ptr AddressInfoFlags -> AddressInfoFlags -> IO ()
poke :: Ptr AddressInfoFlags -> AddressInfoFlags -> IO ()
Storable)

instance Semigroup AddressInfoFlags where
  AddressInfoFlags CInt
x <> :: AddressInfoFlags -> AddressInfoFlags -> AddressInfoFlags
<> AddressInfoFlags CInt
y = CInt -> AddressInfoFlags
AddressInfoFlags (CInt
x CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
y)
instance Monoid AddressInfoFlags where mempty :: AddressInfoFlags
mempty = CInt -> AddressInfoFlags
AddressInfoFlags CInt
0

-- | The @sockaddr@ data. This is an extensible tagged union, so this library
--   has chosen to represent it as byte array. It is up to platform-specific
--   libraries to inhabit this type with values. The byte array backing this
--   may be unpinned or pinned.
newtype SocketAddress = SocketAddress ByteArray
  deriving newtype (SocketAddress -> SocketAddress -> Bool
(SocketAddress -> SocketAddress -> Bool)
-> (SocketAddress -> SocketAddress -> Bool) -> Eq SocketAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocketAddress -> SocketAddress -> Bool
== :: SocketAddress -> SocketAddress -> Bool
$c/= :: SocketAddress -> SocketAddress -> Bool
/= :: SocketAddress -> SocketAddress -> Bool
Eq,Int -> SocketAddress -> ShowS
[SocketAddress] -> ShowS
SocketAddress -> String
(Int -> SocketAddress -> ShowS)
-> (SocketAddress -> String)
-> ([SocketAddress] -> ShowS)
-> Show SocketAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SocketAddress -> ShowS
showsPrec :: Int -> SocketAddress -> ShowS
$cshow :: SocketAddress -> String
show :: SocketAddress -> String
$cshowList :: [SocketAddress] -> ShowS
showList :: [SocketAddress] -> ShowS
Show)

-- | The @option_value@ data.
newtype OptionValue = OptionValue ByteArray

-- | An address for an Internet socket over IPv4. The
--   <http://pubs.opengroup.org/onlinepubs/000095399/basedefs/netinet/in.h.html POSIX specification>
--   mandates three fields:
--
--   > sa_family_t     sin_family   AF_INET
--   > in_port_t       sin_port     Port number
--   > struct in_addr  sin_addr     IP address
--
--   This type omits the first field since is a constant that
--   is only relevant for serialization purposes. The spec also
--   mandates that @sin_port@ and @sin_addr@ be in network
--   byte order, so keep in mind that these values are not
--   immidiately useable.
data SocketAddressInternet = SocketAddressInternet
  { SocketAddressInternet -> Word16
port :: !Word16
  , SocketAddressInternet -> Word32
address :: !Word32
  } deriving (SocketAddressInternet -> SocketAddressInternet -> Bool
(SocketAddressInternet -> SocketAddressInternet -> Bool)
-> (SocketAddressInternet -> SocketAddressInternet -> Bool)
-> Eq SocketAddressInternet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocketAddressInternet -> SocketAddressInternet -> Bool
== :: SocketAddressInternet -> SocketAddressInternet -> Bool
$c/= :: SocketAddressInternet -> SocketAddressInternet -> Bool
/= :: SocketAddressInternet -> SocketAddressInternet -> Bool
Eq,Int -> SocketAddressInternet -> ShowS
[SocketAddressInternet] -> ShowS
SocketAddressInternet -> String
(Int -> SocketAddressInternet -> ShowS)
-> (SocketAddressInternet -> String)
-> ([SocketAddressInternet] -> ShowS)
-> Show SocketAddressInternet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SocketAddressInternet -> ShowS
showsPrec :: Int -> SocketAddressInternet -> ShowS
$cshow :: SocketAddressInternet -> String
show :: SocketAddressInternet -> String
$cshowList :: [SocketAddressInternet] -> ShowS
showList :: [SocketAddressInternet] -> ShowS
Show)

-- | The index and read functions ignore @sin_family@. The write functions
-- will set @sin_family@ to @AF_INET@.
instance Prim SocketAddressInternet where
  sizeOf# :: SocketAddressInternet -> Int#
sizeOf# SocketAddressInternet
_ = Int -> Int#
unI (Int
16)
{-# LINE 233 "src/Posix/Socket/Types.hsc" #-}
  alignment# _ = PM.alignment# (undefined :: Word)
  indexByteArray# :: ByteArray# -> Int# -> SocketAddressInternet
indexByteArray# ByteArray#
arr Int#
i = SocketAddressInternet
    { $sel:port:SocketAddressInternet :: Word16
port = (\ByteArray#
hsc_arr Int#
hsc_ix -> ByteArray# -> Int# -> Word16
forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
hsc_arr (Int#
1# Int# -> Int# -> Int#
+# (Int#
hsc_ix Int# -> Int# -> Int#
*# Int#
8#))) ByteArray#
arr Int#
i
{-# LINE 236 "src/Posix/Socket/Types.hsc" #-}
    , address = (\hsc_arr hsc_ix -> indexByteArray# hsc_arr (1# +# (hsc_ix *# 4#))) arr i
{-# LINE 237 "src/Posix/Socket/Types.hsc" #-}
    }
  indexOffAddr# :: Addr# -> Int# -> SocketAddressInternet
indexOffAddr# Addr#
arr Int#
i = SocketAddressInternet
    { $sel:port:SocketAddressInternet :: Word16
port = (\Addr#
hsc_arr Int#
hsc_ix -> Addr# -> Int# -> Word16
forall a. Prim a => Addr# -> Int# -> a
indexOffAddr# Addr#
hsc_arr (Int#
1# Int# -> Int# -> Int#
+# (Int#
hsc_ix Int# -> Int# -> Int#
*# Int#
8#))) Addr#
arr Int#
i
{-# LINE 240 "src/Posix/Socket/Types.hsc" #-}
    , address = (\hsc_arr hsc_ix -> indexOffAddr# hsc_arr (1# +# (hsc_ix *# 4#))) arr i
{-# LINE 241 "src/Posix/Socket/Types.hsc" #-}
    }
  readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, SocketAddressInternet #)
readByteArray# MutableByteArray# s
arr Int#
i State# s
s0 =
    case (\MutableByteArray# s
hsc_arr Int#
hsc_ix -> MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16 #)
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16 #)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readByteArray# MutableByteArray# s
hsc_arr (Int#
1# Int# -> Int# -> Int#
+# (Int#
hsc_ix Int# -> Int# -> Int#
*# Int#
8#))) MutableByteArray# s
arr Int#
i State# s
s0 of
{-# LINE 244 "src/Posix/Socket/Types.hsc" #-}
      (# s1, port #) -> case (\hsc_arr hsc_ix -> readByteArray# hsc_arr (1# +# (hsc_ix *# 4#))) arr i s1 of
{-# LINE 245 "src/Posix/Socket/Types.hsc" #-}
        (# s2, address #) -> (# s2, SocketAddressInternet{port,address} #)
  readOffAddr# :: forall s.
Addr# -> Int# -> State# s -> (# State# s, SocketAddressInternet #)
readOffAddr# Addr#
arr Int#
i State# s
s0 =
    case (\Addr#
hsc_arr Int#
hsc_ix -> Addr# -> Int# -> State# s -> (# State# s, Word16 #)
forall s. Addr# -> Int# -> State# s -> (# State# s, Word16 #)
forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, a #)
readOffAddr# Addr#
hsc_arr (Int#
1# Int# -> Int# -> Int#
+# (Int#
hsc_ix Int# -> Int# -> Int#
*# Int#
8#))) Addr#
arr Int#
i State# s
s0 of
{-# LINE 248 "src/Posix/Socket/Types.hsc" #-}
      (# s1, port #) -> case (\hsc_arr hsc_ix -> readOffAddr# hsc_arr (1# +# (hsc_ix *# 4#))) arr i s1 of
{-# LINE 249 "src/Posix/Socket/Types.hsc" #-}
        (# s2, address #) -> (# s2, SocketAddressInternet{port,address} #)
  writeByteArray# :: forall s.
MutableByteArray# s
-> Int# -> SocketAddressInternet -> State# s -> State# s
writeByteArray# MutableByteArray# s
arr Int#
i SocketAddressInternet{Word16
$sel:port:SocketAddressInternet :: SocketAddressInternet -> Word16
port :: Word16
port,Word32
$sel:address:SocketAddressInternet :: SocketAddressInternet -> Word32
address :: Word32
address} State# s
s0 =
    case (\MutableByteArray# s
hsc_arr Int#
hsc_ix -> MutableByteArray# s -> Int# -> Word16 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> Word16 -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# s
hsc_arr (Int#
0# Int# -> Int# -> Int#
+# (Int#
hsc_ix Int# -> Int# -> Int#
*# Int#
8#))) MutableByteArray# s
arr Int#
i (Word16
2 :: Word16) State# s
s0 of
{-# LINE 252 "src/Posix/Socket/Types.hsc" #-}
      s1 -> case (\hsc_arr hsc_ix -> writeByteArray# hsc_arr (1# +# (hsc_ix *# 8#))) arr i port s1 of
{-# LINE 253 "src/Posix/Socket/Types.hsc" #-}
        s2 -> (\hsc_arr hsc_ix -> writeByteArray# hsc_arr (1# +# (hsc_ix *# 4#))) arr i address s2
{-# LINE 254 "src/Posix/Socket/Types.hsc" #-}
  writeOffAddr# arr i SocketAddressInternet{port,address} s0 =
    case (\hsc_arr hsc_ix -> writeOffAddr# hsc_arr (0# +# (hsc_ix *# 8#))) arr i (2 :: Word16) s0 of
{-# LINE 256 "src/Posix/Socket/Types.hsc" #-}
      s1 -> case (\hsc_arr hsc_ix -> writeOffAddr# hsc_arr (1# +# (hsc_ix *# 8#))) arr i port s1 of
{-# LINE 257 "src/Posix/Socket/Types.hsc" #-}
        s2 -> (\hsc_arr hsc_ix -> writeOffAddr# hsc_arr (1# +# (hsc_ix *# 4#))) arr i address s2
{-# LINE 258 "src/Posix/Socket/Types.hsc" #-}
  setByteArray# = PM.defaultSetByteArray#
  setOffAddr# :: forall s.
Addr#
-> Int# -> Int# -> SocketAddressInternet -> State# s -> State# s
setOffAddr# = Addr#
-> Int# -> Int# -> SocketAddressInternet -> State# s -> State# s
forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
PM.defaultSetOffAddr#

-- Revisit this. We really need a standard Word128 type somewhere.
-- Solution: use the wideword package.
data SocketAddressInternet6 = SocketAddressInternet6
  { SocketAddressInternet6 -> Word16
port :: !Word16
  , SocketAddressInternet6 -> Word32
flowInfo :: !Word32
  , SocketAddressInternet6 -> Word64
addressA :: !Word64
  , SocketAddressInternet6 -> Word64
addressB :: !Word64
  , SocketAddressInternet6 -> Word32
scopeId :: !Word32
  }

-- | An address for a UNIX domain socket. The
--   <http://pubs.opengroup.org/onlinepubs/009604499/basedefs/sys/un.h.html POSIX specification>
--   mandates two fields:
--
--   > sa_family_t  sun_family  Address family. 
--   > char         sun_path[]  Socket pathname. 
--
--   However, the first field is omitted since it is always @AF_UNIX@.
--   It is adding during serialization. Although @sun_path@ is a
--   null-terminated string, @SocketAddressUnix@ should not have
--   a trailing null byte. The conversion function @encodeSocketAddressUnix@
--   adds the null terminator. The size of path should not equal
--   or exceed the platform-dependent size of @sun_path@.
newtype SocketAddressUnix = SocketAddressUnix
  { SocketAddressUnix -> ByteArray
path :: ByteArray
  }

-- | The @SOCK_STREAM@ socket type.
stream :: Type
stream :: Type
stream = CInt -> Type
Type CInt
1
{-# LINE 291 "src/Posix/Socket/Types.hsc" #-}

-- | The @SOCK_DGRAM@ socket type.
datagram :: Type
datagram :: Type
datagram = CInt -> Type
Type CInt
2
{-# LINE 295 "src/Posix/Socket/Types.hsc" #-}

-- | The @SOCK_RAW@ socket type. POSIX declares raw sockets optional.
--   However, they are included here for convenience. Please open an
--   issue if this prevents this library from compiling on a
--   POSIX-compliant operating system that anyone uses for haskell
--   development. Keep in mind that even though raw sockets may exist
--   on all POSIX-compliant operating systems, they may differ in
--   their behavior.
raw :: Type
raw :: Type
raw = CInt -> Type
Type CInt
3
{-# LINE 305 "src/Posix/Socket/Types.hsc" #-}

-- | The @SOCK_SEQPACKET@ socket type.
sequencedPacket :: Type
sequencedPacket :: Type
sequencedPacket = CInt -> Type
Type CInt
5
{-# LINE 309 "src/Posix/Socket/Types.hsc" #-}

-- | The @AF_UNIX@ communications domain.
pattern Unix :: Family
pattern $mUnix :: forall {r}. Family -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnix :: Family
Unix = Family 1
{-# LINE 313 "src/Posix/Socket/Types.hsc" #-}

-- | The @AF_UNSPEC@ communications domain.
pattern Unspecified :: Family
pattern $mUnspecified :: forall {r}. Family -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnspecified :: Family
Unspecified = Family 0
{-# LINE 317 "src/Posix/Socket/Types.hsc" #-}

-- | The @AF_INET@ communications domain.
pattern Internet :: Family
pattern $mInternet :: forall {r}. Family -> ((# #) -> r) -> ((# #) -> r) -> r
$bInternet :: Family
Internet = Family 2
{-# LINE 321 "src/Posix/Socket/Types.hsc" #-}

-- | The @AF_INET6@ communications domain. POSIX declares raw sockets
--   optional. However, they are included here for convenience. Please
--   open an issue if this prevents this library from compiling on a
--   POSIX-compliant operating system that anyone uses for haskell
--   development.
pattern Internet6 :: Family
pattern $mInternet6 :: forall {r}. Family -> ((# #) -> r) -> ((# #) -> r) -> r
$bInternet6 :: Family
Internet6 = Family 10
{-# LINE 329 "src/Posix/Socket/Types.hsc" #-}

-- | The @MSG_OOB@ receive flag or send flag.
outOfBand :: MessageFlags m
outOfBand :: forall (a :: Message). MessageFlags a
outOfBand = CInt -> MessageFlags m
forall (m :: Message). CInt -> MessageFlags m
MessageFlags CInt
1
{-# LINE 333 "src/Posix/Socket/Types.hsc" #-}

-- | The @MSG_PEEK@ receive flag.
peek :: MessageFlags Receive
peek :: MessageFlags 'Receive
peek = CInt -> MessageFlags 'Receive
forall (m :: Message). CInt -> MessageFlags m
MessageFlags CInt
2
{-# LINE 337 "src/Posix/Socket/Types.hsc" #-}

-- | The @MSG_WAITALL@ receive flag.
waitAll :: MessageFlags Receive
waitAll :: MessageFlags 'Receive
waitAll = CInt -> MessageFlags 'Receive
forall (m :: Message). CInt -> MessageFlags m
MessageFlags CInt
256
{-# LINE 341 "src/Posix/Socket/Types.hsc" #-}

-- | The @MSG_NOSIGNAL@ send flag.
noSignal :: MessageFlags Send
noSignal :: MessageFlags 'Send
noSignal = CInt -> MessageFlags 'Send
forall (m :: Message). CInt -> MessageFlags m
MessageFlags CInt
16384
{-# LINE 345 "src/Posix/Socket/Types.hsc" #-}

-- | The default protocol for a socket type.
defaultProtocol :: Protocol
defaultProtocol :: Protocol
defaultProtocol = CInt -> Protocol
Protocol CInt
0

-- | The @IPPROTO_RAW@ protocol.
rawProtocol :: Protocol
rawProtocol :: Protocol
rawProtocol = CInt -> Protocol
Protocol CInt
255
{-# LINE 353 "src/Posix/Socket/Types.hsc" #-}

-- | The @IPPROTO_ICMP@ protocol.
icmp :: Protocol
icmp :: Protocol
icmp = CInt -> Protocol
Protocol CInt
1
{-# LINE 357 "src/Posix/Socket/Types.hsc" #-}

-- | The @IPPROTO_TCP@ protocol.
tcp :: Protocol
tcp :: Protocol
tcp = CInt -> Protocol
Protocol CInt
6
{-# LINE 361 "src/Posix/Socket/Types.hsc" #-}

-- | The @IPPROTO_UDP@ protocol.
udp :: Protocol
udp :: Protocol
udp = CInt -> Protocol
Protocol CInt
17
{-# LINE 365 "src/Posix/Socket/Types.hsc" #-}

-- | The @IPPROTO_IP@ protocol.
ip :: Protocol
ip :: Protocol
ip = CInt -> Protocol
Protocol CInt
0
{-# LINE 369 "src/Posix/Socket/Types.hsc" #-}

-- | The @IPPROTO_IPV6@ protocol.
ipv6 :: Protocol
ipv6 :: Protocol
ipv6 = CInt -> Protocol
Protocol CInt
41
{-# LINE 373 "src/Posix/Socket/Types.hsc" #-}

-- | Disable further receive operations (e.g. @SHUT_RD@)
read :: ShutdownType
read :: ShutdownType
read = CInt -> ShutdownType
ShutdownType CInt
0
{-# LINE 377 "src/Posix/Socket/Types.hsc" #-}

-- | Disable further send operations (e.g. @SHUT_WR@)
write :: ShutdownType
write :: ShutdownType
write = CInt -> ShutdownType
ShutdownType CInt
1
{-# LINE 381 "src/Posix/Socket/Types.hsc" #-}

-- | Disable further send operations (e.g. @SHUT_RDWR@)
readWrite :: ShutdownType
readWrite :: ShutdownType
readWrite = CInt -> ShutdownType
ShutdownType CInt
2
{-# LINE 385 "src/Posix/Socket/Types.hsc" #-}

-- | Socket error status (e.g. @SOL_SOCKET@)
levelSocket :: Level
levelSocket :: Level
levelSocket = CInt -> Level
Level CInt
1
{-# LINE 389 "src/Posix/Socket/Types.hsc" #-}

-- | Socket error status (e.g. @SO_ERROR@)
optionError :: OptionName
optionError :: OptionName
optionError = CInt -> OptionName
OptionName CInt
4
{-# LINE 393 "src/Posix/Socket/Types.hsc" #-}

-- | Bind to device (e.g. @SO_BINDTODEVICE@)
bindToDevice :: OptionName
bindToDevice :: OptionName
bindToDevice = CInt -> OptionName
OptionName CInt
25
{-# LINE 397 "src/Posix/Socket/Types.hsc" #-}

-- | Allow reuse of local address (e.g. @SO_REUSEADDR@)
reuseAddress :: OptionName
reuseAddress :: OptionName
reuseAddress = CInt -> OptionName
OptionName CInt
2
{-# LINE 401 "src/Posix/Socket/Types.hsc" #-}

-- | Transmission of broadcast messages is supported (e.g. @SO_BROADCAST@)
broadcast :: OptionName
broadcast :: OptionName
broadcast = CInt -> OptionName
OptionName CInt
6
{-# LINE 405 "src/Posix/Socket/Types.hsc" #-}

peekControlMessageHeaderLength :: Addr -> IO CInt
peekControlMessageHeaderLength :: Addr -> IO CInt
peekControlMessageHeaderLength (Addr Addr#
p) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
0) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 408 "src/Posix/Socket/Types.hsc" #-}

peekControlMessageHeaderLevel :: Addr -> IO Level
peekControlMessageHeaderLevel :: Addr -> IO Level
peekControlMessageHeaderLevel (Addr Addr#
p) = do
  CInt
i <- (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
8) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 412 "src/Posix/Socket/Types.hsc" #-}
  pure (Level i)

-- | Get @cmsg_type@.
peekControlMessageHeaderType :: Addr -> IO Type
peekControlMessageHeaderType :: Addr -> IO Type
peekControlMessageHeaderType (Addr Addr#
p) = do
  CInt
i <- (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
12) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 418 "src/Posix/Socket/Types.hsc" #-}
  pure (Type i)

-- Think about reintroducing this function when it becomes necessary.
-- advanceControlMessageHeaderData :: Addr -> Addr
-- advanceControlMessageHeaderData p =
--   PM.plusAddr p (#{size struct cmsghdr})

-- | Get @iov_base@.
peekIOVectorBase :: Addr -> IO Addr
peekIOVectorBase :: Addr -> IO Addr
peekIOVectorBase (Addr Addr#
p) = do
  Ptr Addr#
x <- (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
0) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 429 "src/Posix/Socket/Types.hsc" #-}
  pure (Addr x)

-- | Get @iov_len@.
peekIOVectorLength :: Addr -> IO CSize
peekIOVectorLength :: Addr -> IO CSize
peekIOVectorLength (Addr Addr#
p) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO CSize
forall b. Ptr b -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
8) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 434 "src/Posix/Socket/Types.hsc" #-}

-- | The size of a serialized @msghdr@.
sizeofMessageHeader :: CInt
sizeofMessageHeader :: CInt
sizeofMessageHeader = (CInt
56)
{-# LINE 438 "src/Posix/Socket/Types.hsc" #-}

-- | Get @ai_flags@.
peekAddressInfoFlags :: Ptr AddressInfo -> IO AddressInfoFlags
peekAddressInfoFlags :: Ptr AddressInfo -> IO AddressInfoFlags
peekAddressInfoFlags Ptr AddressInfo
ptr = do
  CInt
x <- (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
0) Ptr AddressInfo
ptr
{-# LINE 443 "src/Posix/Socket/Types.hsc" #-}
  pure (AddressInfoFlags x)

-- | Set @ai_flags@.
pokeAddressInfoFlags :: Ptr AddressInfo -> AddressInfoFlags -> IO ()
pokeAddressInfoFlags :: Ptr AddressInfo -> AddressInfoFlags -> IO ()
pokeAddressInfoFlags Ptr AddressInfo
ptr (AddressInfoFlags CInt
x) = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddressInfo
hsc_ptr Int
0) Ptr AddressInfo
ptr CInt
x
{-# LINE 448 "src/Posix/Socket/Types.hsc" #-}

-- | Get @ai_family@.
peekAddressInfoFamily :: Ptr AddressInfo -> IO Family
peekAddressInfoFamily :: Ptr AddressInfo -> IO Family
peekAddressInfoFamily Ptr AddressInfo
ptr = do
  CInt
x <- (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
4) Ptr AddressInfo
ptr
{-# LINE 453 "src/Posix/Socket/Types.hsc" #-}
  pure (Family x)

-- | Get @ai_socktype@.
peekAddressInfoSocketType :: Ptr AddressInfo -> IO Type
peekAddressInfoSocketType :: Ptr AddressInfo -> IO Type
peekAddressInfoSocketType Ptr AddressInfo
ptr = do
  CInt
x <- (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
8) Ptr AddressInfo
ptr
{-# LINE 459 "src/Posix/Socket/Types.hsc" #-}
  pure (Type x)

-- | Get @ai_protocol@.
peekAddressInfoProtocol :: Ptr AddressInfo -> IO Protocol
peekAddressInfoProtocol :: Ptr AddressInfo -> IO Protocol
peekAddressInfoProtocol Ptr AddressInfo
ptr = do
  CInt
x <- (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
12) Ptr AddressInfo
ptr
{-# LINE 465 "src/Posix/Socket/Types.hsc" #-}
  pure (Protocol x)

-- | Get @ai_addrlen@.
peekAddressInfoAddressLength :: Ptr AddressInfo -> IO CInt
peekAddressInfoAddressLength :: Ptr AddressInfo -> IO CInt
peekAddressInfoAddressLength Ptr AddressInfo
ptr = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
16) Ptr AddressInfo
ptr
{-# LINE 470 "src/Posix/Socket/Types.hsc" #-}

-- | Get @ai_addr@.
peekAddressInfoAddress :: Ptr AddressInfo -> IO (Ptr SocketAddress)
peekAddressInfoAddress :: Ptr AddressInfo -> IO (Ptr SocketAddress)
peekAddressInfoAddress Ptr AddressInfo
ptr = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO (Ptr SocketAddress)
forall b. Ptr b -> Int -> IO (Ptr SocketAddress)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
24) Ptr AddressInfo
ptr
{-# LINE 474 "src/Posix/Socket/Types.hsc" #-}

-- | Get @ai_next@.
peekAddressInfoNext :: Ptr AddressInfo -> IO (Ptr AddressInfo)
peekAddressInfoNext :: Ptr AddressInfo -> IO (Ptr AddressInfo)
peekAddressInfoNext Ptr AddressInfo
ptr = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO (Ptr AddressInfo)
forall b. Ptr b -> Int -> IO (Ptr AddressInfo)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
40) Ptr AddressInfo
ptr
{-# LINE 478 "src/Posix/Socket/Types.hsc" #-}

-- | Set @ai_family@.
pokeAddressInfoFamily :: Ptr AddressInfo -> Family -> IO ()
pokeAddressInfoFamily :: Ptr AddressInfo -> Family -> IO ()
pokeAddressInfoFamily Ptr AddressInfo
ptr (Family CInt
x) = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddressInfo
hsc_ptr Int
4) Ptr AddressInfo
ptr CInt
x
{-# LINE 482 "src/Posix/Socket/Types.hsc" #-}

-- | Set @ai_socktype@.
pokeAddressInfoSocketType :: Ptr AddressInfo -> Type -> IO ()
pokeAddressInfoSocketType :: Ptr AddressInfo -> Type -> IO ()
pokeAddressInfoSocketType Ptr AddressInfo
ptr (Type CInt
x) = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddressInfo
hsc_ptr Int
8) Ptr AddressInfo
ptr CInt
x
{-# LINE 486 "src/Posix/Socket/Types.hsc" #-}

-- | Set @ai_protocol@.
pokeAddressInfoProtocol :: Ptr AddressInfo -> Protocol -> IO ()
pokeAddressInfoProtocol :: Ptr AddressInfo -> Protocol -> IO ()
pokeAddressInfoProtocol Ptr AddressInfo
ptr (Protocol CInt
x) = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddressInfo
hsc_ptr Int
12) Ptr AddressInfo
ptr CInt
x
{-# LINE 490 "src/Posix/Socket/Types.hsc" #-}

-- | The size of a serialized @addrinfo@.
sizeofAddressInfo :: Int
sizeofAddressInfo :: Int
sizeofAddressInfo = (Int
48)
{-# LINE 494 "src/Posix/Socket/Types.hsc" #-}

-- | The size of a serialized @iovec@.
sizeofIOVector :: CInt
sizeofIOVector :: CInt
sizeofIOVector = (CInt
16)
{-# LINE 498 "src/Posix/Socket/Types.hsc" #-}

peekMessageHeaderName :: Addr -> IO Addr
peekMessageHeaderName :: Addr -> IO Addr
peekMessageHeaderName (Addr Addr#
p) = do
  Ptr Addr#
x <- (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
0) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 502 "src/Posix/Socket/Types.hsc" #-}
  pure (Addr x)

pokeMessageHeaderName :: Addr -> Addr -> IO ()
pokeMessageHeaderName :: Addr -> Addr -> IO ()
pokeMessageHeaderName (Addr Addr#
p) (Addr Addr#
x) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> Ptr Any -> IO ()
forall b. Ptr b -> Int -> Ptr Any -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Any
hsc_ptr Int
0) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
x)
{-# LINE 506 "src/Posix/Socket/Types.hsc" #-}

pokeMessageHeaderNameLength :: Addr -> CInt -> IO ()
pokeMessageHeaderNameLength :: Addr -> CInt -> IO ()
pokeMessageHeaderNameLength (Addr Addr#
p) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Any
hsc_ptr Int
8) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 509 "src/Posix/Socket/Types.hsc" #-}

pokeMessageHeaderIOVector :: Addr -> Addr -> IO ()
pokeMessageHeaderIOVector :: Addr -> Addr -> IO ()
pokeMessageHeaderIOVector (Addr Addr#
p) (Addr Addr#
x) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> Ptr Any -> IO ()
forall b. Ptr b -> Int -> Ptr Any -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Any
hsc_ptr Int
16) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
x)
{-# LINE 512 "src/Posix/Socket/Types.hsc" #-}

pokeMessageHeaderIOVectorLength :: Addr -> CSize -> IO ()
pokeMessageHeaderIOVectorLength :: Addr -> CSize -> IO ()
pokeMessageHeaderIOVectorLength (Addr Addr#
p) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Any
hsc_ptr Int
24) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 515 "src/Posix/Socket/Types.hsc" #-}

pokeMessageHeaderControl :: Addr -> Addr -> IO ()
pokeMessageHeaderControl :: Addr -> Addr -> IO ()
pokeMessageHeaderControl (Addr Addr#
p) (Addr Addr#
x) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> Ptr Any -> IO ()
forall b. Ptr b -> Int -> Ptr Any -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Any
hsc_ptr Int
32) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
x)
{-# LINE 518 "src/Posix/Socket/Types.hsc" #-}

pokeMessageHeaderControlLength :: Addr -> CSize -> IO ()
pokeMessageHeaderControlLength :: Addr -> CSize -> IO ()
pokeMessageHeaderControlLength (Addr Addr#
p) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Any
hsc_ptr Int
40) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 521 "src/Posix/Socket/Types.hsc" #-}

pokeMessageHeaderFlags :: Addr -> MessageFlags Receive -> IO ()
pokeMessageHeaderFlags :: Addr -> MessageFlags 'Receive -> IO ()
pokeMessageHeaderFlags (Addr Addr#
p) (MessageFlags CInt
i) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Any
hsc_ptr Int
48) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p) CInt
i
{-# LINE 524 "src/Posix/Socket/Types.hsc" #-}

peekMessageHeaderNameLength :: Addr -> IO CInt
peekMessageHeaderNameLength :: Addr -> IO CInt
peekMessageHeaderNameLength (Addr Addr#
p) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
8) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 527 "src/Posix/Socket/Types.hsc" #-}

peekMessageHeaderIOVector :: Addr -> IO Addr
peekMessageHeaderIOVector :: Addr -> IO Addr
peekMessageHeaderIOVector (Addr Addr#
p) = do
  Ptr Addr#
r <- (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
16) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 531 "src/Posix/Socket/Types.hsc" #-}
  pure (Addr r)

peekMessageHeaderIOVectorLength :: Addr -> IO CSize
peekMessageHeaderIOVectorLength :: Addr -> IO CSize
peekMessageHeaderIOVectorLength (Addr Addr#
p) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO CSize
forall b. Ptr b -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
24) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 535 "src/Posix/Socket/Types.hsc" #-}

peekMessageHeaderControl :: Addr -> IO Addr
peekMessageHeaderControl :: Addr -> IO Addr
peekMessageHeaderControl (Addr Addr#
p) = do
  Ptr Addr#
r <- (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
32) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 539 "src/Posix/Socket/Types.hsc" #-}
  pure (Addr r)

pokeIOVectorBase :: Addr -> Addr -> IO ()
pokeIOVectorBase :: Addr -> Addr -> IO ()
pokeIOVectorBase (Addr Addr#
p) (Addr Addr#
x) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> Ptr Any -> IO ()
forall b. Ptr b -> Int -> Ptr Any -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Any
hsc_ptr Int
0) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
x)
{-# LINE 543 "src/Posix/Socket/Types.hsc" #-}

pokeIOVectorLength :: Addr -> CSize -> IO ()
pokeIOVectorLength :: Addr -> CSize -> IO ()
pokeIOVectorLength (Addr Addr#
p) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Any
hsc_ptr Int
8) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 546 "src/Posix/Socket/Types.hsc" #-}

peekMessageHeaderControlLength :: Addr -> IO CSize
peekMessageHeaderControlLength :: Addr -> IO CSize
peekMessageHeaderControlLength (Addr Addr#
p) = (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO CSize
forall b. Ptr b -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
40) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 549 "src/Posix/Socket/Types.hsc" #-}

peekMessageHeaderFlags :: Addr -> IO (MessageFlags Receive)
peekMessageHeaderFlags :: Addr -> IO (MessageFlags 'Receive)
peekMessageHeaderFlags (Addr Addr#
p) = do
  CInt
i <- (\Ptr Any
hsc_ptr -> Ptr Any -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
48) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p)
{-# LINE 553 "src/Posix/Socket/Types.hsc" #-}
  pure (MessageFlags i)

unI :: Int -> Int#
unI :: Int -> Int#
unI (I# Int#
i) = Int#
i