{-# LINE 1 "src/Posix/Struct/AddressInfo/Peek.hsc" #-}




{-# language DataKinds #-}

-- | Accessors for reading from @struct addrinfo@:
--
-- > 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;
-- > };
module Posix.Struct.AddressInfo.Peek
  ( flags
  , family
  , socketType
  , protocol
  , addressLength
  , address
  , next
  ) where

import Posix.Socket.Types (AddressInfoFlags(..),SocketAddress,Family,Type,AddressInfo,Protocol)
import Foreign.C.Types (CInt)
import Foreign.Ptr (Ptr)
import Foreign.Storable (peekByteOff)

-- | Get @ai_flags@.
flags :: Ptr AddressInfo -> IO AddressInfoFlags
flags :: Ptr AddressInfo -> IO AddressInfoFlags
flags Ptr AddressInfo
ptr = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO AddressInfoFlags
forall b. Ptr b -> Int -> IO AddressInfoFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
0) Ptr AddressInfo
ptr
{-# LINE 37 "src/Posix/Struct/AddressInfo/Peek.hsc" #-}

-- | Get @ai_family@.
family :: Ptr AddressInfo -> IO Family
family :: Ptr AddressInfo -> IO Family
family Ptr AddressInfo
ptr = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO Family
forall b. Ptr b -> Int -> IO Family
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
4) Ptr AddressInfo
ptr
{-# LINE 41 "src/Posix/Struct/AddressInfo/Peek.hsc" #-}

-- | Get @ai_socktype@.
socketType :: Ptr AddressInfo -> IO Type
socketType :: Ptr AddressInfo -> IO Type
socketType Ptr AddressInfo
ptr = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO Type
forall b. Ptr b -> Int -> IO Type
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
8) Ptr AddressInfo
ptr
{-# LINE 45 "src/Posix/Struct/AddressInfo/Peek.hsc" #-}

-- | Get @ai_protocol@.
protocol :: Ptr AddressInfo -> IO Protocol
protocol :: Ptr AddressInfo -> IO Protocol
protocol Ptr AddressInfo
ptr = (\Ptr AddressInfo
hsc_ptr -> Ptr AddressInfo -> Int -> IO Protocol
forall b. Ptr b -> Int -> IO Protocol
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddressInfo
hsc_ptr Int
12) Ptr AddressInfo
ptr
{-# LINE 49 "src/Posix/Struct/AddressInfo/Peek.hsc" #-}

-- | Get @ai_addrlen@.
addressLength :: Ptr AddressInfo -> IO CInt
addressLength :: Ptr AddressInfo -> IO CInt
addressLength 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 53 "src/Posix/Struct/AddressInfo/Peek.hsc" #-}

-- | Get @ai_addr@.
address :: Ptr AddressInfo -> IO (Ptr SocketAddress)
address :: Ptr AddressInfo -> IO (Ptr SocketAddress)
address 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 57 "src/Posix/Struct/AddressInfo/Peek.hsc" #-}

-- | Get @ai_next@.
next :: Ptr AddressInfo -> IO (Ptr AddressInfo)
next :: Ptr AddressInfo -> IO (Ptr AddressInfo)
next 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 61 "src/Posix/Struct/AddressInfo/Peek.hsc" #-}