{-# LINE 1 "src/Netw/Internal/Type.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Netw.Internal.Type 
( Iovec(..)
, sizeofSockaddrStorage
, Protoent(..), protoents
, Servent(..), servents
, _IPPORT_RESERVED, _IPPORT_USERRESERVED
) where



import Foreign
import Foreign.C

import Data.Primitive
import Data.Function

import Data.Word
import GHC.ByteOrder

data Iovec = Iovec { Iovec -> Ptr ()
iovBase :: !(Ptr ()), Iovec -> CSize
iovLen :: !CSize }
instance Storable Iovec where
  sizeOf :: Iovec -> Int
sizeOf   Iovec
_ = (Int
16)
{-# LINE 24 "src/Netw/Internal/Type.hsc" #-}
  alignment _ = 8
{-# LINE 25 "src/Netw/Internal/Type.hsc" #-}

  peek :: Ptr Iovec -> IO Iovec
peek Ptr Iovec
ptr = Ptr () -> CSize -> Iovec
Iovec (Ptr () -> CSize -> Iovec) -> IO (Ptr ()) -> IO (CSize -> Iovec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr Iovec
hsc_ptr -> Ptr Iovec -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Iovec
hsc_ptr Int
0) Ptr Iovec
ptr IO (CSize -> Iovec) -> IO CSize -> IO Iovec
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (\Ptr Iovec
hsc_ptr -> Ptr Iovec -> Int -> IO CSize
forall b. Ptr b -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Iovec
hsc_ptr Int
8) Ptr Iovec
ptr
{-# LINE 27 "src/Netw/Internal/Type.hsc" #-}
  poke ptr iovec = (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (iovBase iovec)
{-# LINE 28 "src/Netw/Internal/Type.hsc" #-}
                >> (\hsc_ptr -> pokeByteOff hsc_ptr 8)  ptr (iovLen  iovec)
{-# LINE 29 "src/Netw/Internal/Type.hsc" #-}

sizeofSockaddrStorage :: Int
sizeofSockaddrStorage :: Int
sizeofSockaddrStorage = (Int
128)
{-# LINE 32 "src/Netw/Internal/Type.hsc" #-}

data Protoent = Protoent
  { Protoent -> String
pName    :: String
  , Protoent -> [String]
pAliases :: [String]
  , Protoent -> CInt
pProto   :: CInt
  }

peekProtoent :: Ptr Protoent -> IO Protoent
peekProtoent :: Ptr Protoent -> IO Protoent
peekProtoent Ptr Protoent
ptr = do
  String
name    <- CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (\Ptr Protoent
hsc_ptr -> Ptr Protoent -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Protoent
hsc_ptr Int
0) Ptr Protoent
ptr
{-# LINE 42 "src/Netw/Internal/Type.hsc" #-}
  proto   <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 43 "src/Netw/Internal/Type.hsc" #-}
  aliases <- mapM peekCString =<< peekArray0 nullPtr =<< (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 44 "src/Netw/Internal/Type.hsc" #-}
  return (Protoent name aliases proto)

foreign import ccall unsafe "getprotoent"
  getprotoent :: IO (Ptr Protoent)
foreign import ccall unsafe "endprotoent"
  endprotoent :: IO ()

protoents :: IO [Protoent]
protoents :: IO [Protoent]
protoents = do
  IO ()
endprotoent
  (IO [Protoent] -> IO [Protoent]) -> IO [Protoent]
forall a. (a -> a) -> a
fix (\ IO [Protoent]
loop -> do
    Ptr Protoent
proto' <- IO (Ptr Protoent)
getprotoent
    if Ptr Protoent
proto' Ptr Protoent -> Ptr Protoent -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Protoent
forall a. Ptr a
nullPtr
    then do
      IO ()
endprotoent
      [Protoent] -> IO [Protoent]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      Protoent
proto <- Ptr Protoent -> IO Protoent
peekProtoent Ptr Protoent
proto'
      (Protoent
proto:) ([Protoent] -> [Protoent]) -> IO [Protoent] -> IO [Protoent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Protoent]
loop
    )

data Servent = Servent
  { Servent -> String
sName    :: String
  , Servent -> [String]
sAliases :: [String]
  , Servent -> Word16
sPort    :: Word16  -- NOTE: This is in host byte order
  , Servent -> String
sProto   :: String
  }

peekServent :: Ptr Servent -> IO Servent
peekServent :: Ptr Servent -> IO Servent
peekServent Ptr Servent
ptr = do
  String
name    <- CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (\Ptr Servent
hsc_ptr -> Ptr Servent -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Servent
hsc_ptr Int
0) Ptr Servent
ptr
{-# LINE 75 "src/Netw/Internal/Type.hsc" #-}
  aliases <- mapM peekCString =<< peekArray0 nullPtr =<< (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 76 "src/Netw/Internal/Type.hsc" #-}
  port :: CInt
          <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 78 "src/Netw/Internal/Type.hsc" #-}
  proto   <- peekCString =<< (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 79 "src/Netw/Internal/Type.hsc" #-}
  return (Servent name aliases (ntoh $ fromIntegral port) proto)
  where ntoh :: Word16 -> Word16
        ntoh :: Word16 -> Word16
ntoh = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Word16 -> Word16
byteSwap16; ByteOrder
BigEndian -> Word16 -> Word16
forall a. a -> a
id

foreign import ccall unsafe "getservent"
  getservent :: IO (Ptr Servent)
foreign import ccall unsafe "endservent"
  endservent :: IO ()

servents :: IO [Servent]
servents :: IO [Servent]
servents = do
  IO ()
endservent
  (IO [Servent] -> IO [Servent]) -> IO [Servent]
forall a. (a -> a) -> a
fix (\ IO [Servent]
loop -> do
    Ptr Servent
serv' <- IO (Ptr Servent)
getservent
    if Ptr Servent
serv' Ptr Servent -> Ptr Servent -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Servent
forall a. Ptr a
nullPtr
    then do
      IO ()
endservent
      [Servent] -> IO [Servent]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      Servent
serv <- Ptr Servent -> IO Servent
peekServent Ptr Servent
serv'
      (Servent
serv:) ([Servent] -> [Servent]) -> IO [Servent] -> IO [Servent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Servent]
loop
    )

_IPPORT_RESERVED :: Word16
_IPPORT_RESERVED :: Word16
_IPPORT_RESERVED = Word16
1024
{-# LINE 104 "src/Netw/Internal/Type.hsc" #-}

_IPPORT_USERRESERVED :: Word16
_IPPORT_USERRESERVED :: Word16
_IPPORT_USERRESERVED = Word16
5000
{-# LINE 107 "src/Netw/Internal/Type.hsc" #-}