{-# LINE 1 "src/LibForeign.hsc" #-}
{-# LANGUAGE CPP,  ForeignFunctionInterface #-}
module LibForeign where

import Foreign (Ptr, alloca, peek, sizeOf, with)
import Foreign.C.Types (CInt (..), CULong (..))
import Foreign.C.Error (Errno (..), getErrno)
import Data.Word (Word32)

-- Platform specific includes

{-# LINE 21 "src/LibForeign.hsc" #-}




{-# LINE 25 "src/LibForeign.hsc" #-}

-- All platforms ---------------------------------------------------------------

foreign import ccall unsafe "getsockopt"
  c_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt

foreign import ccall unsafe "setsockopt"
  c_setsockopt :: CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt

getKeepAliveOnOff_ :: CInt -> IO CInt
getKeepAliveOnOff_ :: CInt -> IO CInt
getKeepAliveOnOff_ CInt
fd =
    (Ptr CInt -> IO CInt) -> IO CInt
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO CInt) -> IO CInt)
-> (Ptr CInt -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ptr -> do
            let sz :: CInt
sz = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Storable a => a -> Int
sizeOf ( CInt
forall a. HasCallStack => a
undefined :: CInt)
            CInt -> (Ptr CInt -> IO CInt) -> IO CInt
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CInt
sz ((Ptr CInt -> IO CInt) -> IO CInt)
-> (Ptr CInt -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ptr_sz -> do
                CInt -> CInt -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt
forall a. CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt
c_getsockopt CInt
fd CInt
c_SOL_SOCKET CInt
c_SO_KEEPALIVE Ptr CInt
ptr Ptr CInt
ptr_sz
                Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptr

c_SOL_SOCKET_ :: Integer
c_SOL_SOCKET_ = Integer
1
{-# LINE 43 "src/LibForeign.hsc" #-}

c_SOL_SOCKET :: CInt
c_SOL_SOCKET :: CInt
c_SOL_SOCKET = Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c_SOL_SOCKET_

c_SO_KEEPALIVE_ :: Integer
c_SO_KEEPALIVE_ = Integer
9
{-# LINE 48 "src/LibForeign.hsc" #-}

c_SO_KEEPALIVE :: CInt
c_SO_KEEPALIVE :: CInt
c_SO_KEEPALIVE = Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c_SO_KEEPALIVE_

-- Win32 -----------------------------------------------------------------------

{-# LINE 64 "src/LibForeign.hsc" #-}

getKeepAliveOption_ :: CInt -> CInt -> CInt -> IO Int
getKeepAliveOption_ :: CInt -> CInt -> CInt -> IO Int
getKeepAliveOption_ CInt
fd CInt
level CInt
option =
    (Ptr Int -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int -> IO Int) -> IO Int) -> (Ptr Int -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int
ptr -> do
        let sz :: CInt
sz = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Storable a => a -> Int
sizeOf ( CInt
forall a. HasCallStack => a
undefined :: CInt)
        CInt -> (Ptr CInt -> IO Int) -> IO Int
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CInt
sz ((Ptr CInt -> IO Int) -> IO Int) -> (Ptr CInt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ptr_sz -> do
            CInt -> CInt -> CInt -> Ptr Int -> Ptr CInt -> IO CInt
forall a. CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt
c_getsockopt CInt
fd CInt
level CInt
option Ptr Int
ptr Ptr CInt
ptr_sz
            Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek Ptr Int
ptr

setKeepAliveOption_ :: CInt -> CInt -> CInt -> CInt -> IO CInt
setKeepAliveOption_ :: CInt -> CInt -> CInt -> CInt -> IO CInt
setKeepAliveOption_ CInt
fd CInt
level CInt
option CInt
value = do
    let sz :: CInt
sz = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Storable a => a -> Int
sizeOf ( Int
forall a. HasCallStack => a
undefined :: Int)
    CInt -> (Ptr CInt -> IO CInt) -> IO CInt
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CInt
value ((Ptr CInt -> IO CInt) -> IO CInt)
-> (Ptr CInt -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ptr ->
        CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt
forall a. CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt
c_setsockopt CInt
fd CInt
level CInt
option Ptr CInt
ptr CInt
sz

setKeepAlive_ :: CInt -> Word32 -> Word32 -> Word32 -> IO CInt
setKeepAlive_ :: CInt -> Word32 -> Word32 -> Word32 -> IO CInt
setKeepAlive_ CInt
fd Word32
onoff Word32
idle Word32
intvl = do

    let intOnOff :: CInt
intOnOff = Integer -> CInt
forall a. Num a => Integer -> a
fromInteger (Integer -> CInt) -> Integer -> CInt
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
onoff
    let intIdle :: CInt
intIdle = Integer -> CInt
forall a. Num a => Integer -> a
fromInteger (Integer -> CInt) -> Integer -> CInt
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
idle
    let intIntvl :: CInt
intIntvl = Integer -> CInt
forall a. Num a => Integer -> a
fromInteger (Integer -> CInt) -> Integer -> CInt
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
intvl

    CInt
onoffrtn <- CInt -> CInt -> CInt -> CInt -> IO CInt
setKeepAliveOption_ CInt
fd CInt
c_SOL_SOCKET CInt
c_SO_KEEPALIVE CInt
intOnOff

-- Apple specific kkep alive settings

{-# LINE 93 "src/LibForeign.hsc" #-}
    CInt
idlertn <- CInt -> CInt -> CInt -> CInt -> IO CInt
setKeepAliveOption_ CInt
fd CInt
c_SOL_TCP CInt
c_TCP_KEEPIDLE CInt
intIdle
    CInt
intrtn <- CInt -> CInt -> CInt -> CInt -> IO CInt
setKeepAliveOption_ CInt
fd CInt
c_SOL_TCP CInt
c_TCP_KEEPINTVL CInt
intIntvl
-- __APPLE__

{-# LINE 97 "src/LibForeign.hsc" #-}
    -- Error check
    Errno CInt
rtn <-
        if CInt
onoffrtn CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
idlertn CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
intrtn CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
        then IO Errno
getErrno
        else Errno -> IO Errno
forall (m :: * -> *) a. Monad m => a -> m a
return (Errno -> IO Errno) -> Errno -> IO Errno
forall a b. (a -> b) -> a -> b
$ CInt -> Errno
Errno CInt
0
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
rtn

c_TCP_KEEPINTVL_ :: Integer
c_TCP_KEEPINTVL_ = Integer
5
{-# LINE 105 "src/LibForeign.hsc" #-}
c_TCP_KEEPINTVL :: CInt
c_TCP_KEEPINTVL :: CInt
c_TCP_KEEPINTVL = Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c_TCP_KEEPINTVL_


{-# LINE 119 "src/LibForeign.hsc" #-}

c_SOL_TCP_ :: Integer
c_SOL_TCP_ = Integer
6
{-# LINE 121 "src/LibForeign.hsc" #-}
c_SOL_TCP :: CInt
c_SOL_TCP :: CInt
c_SOL_TCP = Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c_SOL_TCP_

c_TCP_KEEPIDLE_ :: Integer
c_TCP_KEEPIDLE_ = Integer
4
{-# LINE 125 "src/LibForeign.hsc" #-}
c_TCP_KEEPIDLE :: CInt
c_TCP_KEEPIDLE :: CInt
c_TCP_KEEPIDLE = Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c_TCP_KEEPIDLE_

c_TCP_KEEPCNT_ :: Integer
c_TCP_KEEPCNT_ = Integer
6
{-# LINE 129 "src/LibForeign.hsc" #-}
c_TCP_KEEPCNT :: CInt
c_TCP_KEEPCNT :: CInt
c_TCP_KEEPCNT = Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c_TCP_KEEPCNT_

-- __APPLE__ Check

{-# LINE 134 "src/LibForeign.hsc" #-}

-- End of POSIX ----------------------------------------------------------------

{-# LINE 137 "src/LibForeign.hsc" #-}