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




{-# language DataKinds #-}

-- | Accessors for reading from @struct sockaddr_in@:
--
-- > struct sockaddr_in {
-- >     sa_family_t    sin_family; /* address family: AF_INET */
-- >     in_port_t      sin_port;   /* port in network byte order */
-- >     struct in_addr sin_addr;   /* internet address */
-- > };
module Posix.Struct.SocketAddressInternet.Peek
  ( family
  , port
  , address
  ) where

import Posix.Socket.Types (SocketAddressInternet,Family)
import Foreign.Ptr (Ptr)
import Foreign.Storable (peekByteOff)
import Data.Word (Word16,Word32)
import System.ByteOrder (Fixed,ByteOrder(BigEndian))

-- | Get @sin_family@.
family :: Ptr SocketAddressInternet -> IO Family
family :: Ptr SocketAddressInternet -> IO Family
family = (\Ptr SocketAddressInternet
hsc_ptr -> Ptr SocketAddressInternet -> Int -> IO Family
forall b. Ptr b -> Int -> IO Family
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SocketAddressInternet
hsc_ptr Int
0)
{-# LINE 29 "src/Posix/Struct/SocketAddressInternet/Peek.hsc" #-}

-- | Get @in_port_t@.
port :: Ptr SocketAddressInternet -> IO (Fixed 'BigEndian Word16)
port :: Ptr SocketAddressInternet -> IO (Fixed 'BigEndian Word16)
port = (\Ptr SocketAddressInternet
hsc_ptr -> Ptr SocketAddressInternet -> Int -> IO (Fixed 'BigEndian Word16)
forall b. Ptr b -> Int -> IO (Fixed 'BigEndian Word16)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SocketAddressInternet
hsc_ptr Int
2)
{-# LINE 33 "src/Posix/Struct/SocketAddressInternet/Peek.hsc" #-}

-- | Get @sin_addr.saddr@. This works on Linux because @struct in_addr@ has
-- a single 32-bit field. I do not know how to perform this in a portable way
-- with hsc2hs.
address :: Ptr SocketAddressInternet -> IO (Fixed 'BigEndian Word32)
address :: Ptr SocketAddressInternet -> IO (Fixed 'BigEndian Word32)
address = (\Ptr SocketAddressInternet
hsc_ptr -> Ptr SocketAddressInternet -> Int -> IO (Fixed 'BigEndian Word32)
forall b. Ptr b -> Int -> IO (Fixed 'BigEndian Word32)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SocketAddressInternet
hsc_ptr Int
4)
{-# LINE 39 "src/Posix/Struct/SocketAddressInternet/Peek.hsc" #-}