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

import Foreign
import Foreign.C.Types
import Foreign.C.Error
import Data.Word (Word32)

-- Platform specific includes

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




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


getKeepAliveOnOff_ :: CInt -> IO CInt
getKeepAliveOnOff_ fd =
    alloca $ \ptr -> do
            let sz = fromIntegral $ sizeOf ( undefined :: CInt)
            with sz $ \ptr_sz -> do
                c_getsockopt fd c_SOL_SOCKET c_SO_KEEPALIVE ptr ptr_sz
                peek ptr


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

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

    let intOnOff = fromInteger $ toInteger onoff
    let intIdle = fromInteger $ toInteger idle
    let intIntvl = fromInteger $ toInteger intvl

    onoffrtn <- setKeepAliveOption_ fd c_SOL_SOCKET c_SO_KEEPALIVE intOnOff
    idlertn <- setKeepAliveOption_ fd c_SOL_TCP c_TCP_KEEPIDLE intIdle
    intrtn <- setKeepAliveOption_ fd c_SOL_TCP c_TCP_KEEPINTVL intIntvl

    -- Error check
    Errno rtn <-
        if onoffrtn + idlertn + intrtn /= 0
        then getErrno
        else return $ Errno 0
    return rtn

getKeepAliveOption_ :: CInt -> CInt -> CInt -> IO Int
getKeepAliveOption_ fd level option =
    alloca $ \ptr -> do
        let sz = fromIntegral $ sizeOf ( undefined :: CInt)
        with sz $ \ptr_sz -> do
            c_getsockopt fd level option ptr ptr_sz
            peek ptr

setKeepAliveOption_ :: CInt -> CInt -> CInt -> CInt -> IO CInt
setKeepAliveOption_ fd level option value = do
    let sz = fromIntegral $ sizeOf ( undefined :: Int)
    with value $ \ptr ->
        c_setsockopt fd level option ptr sz



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

c_SOL_SOCKET_ = 1
{-# LINE 73 "src/LibForeign.hsc" #-}

c_SOL_SOCKET :: CInt
c_SOL_SOCKET = fromIntegral c_SOL_SOCKET_

c_SO_KEEPALIVE_ = 9
{-# LINE 78 "src/LibForeign.hsc" #-}

c_SO_KEEPALIVE :: CInt
c_SO_KEEPALIVE = fromIntegral c_SO_KEEPALIVE_


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

c_SOL_TCP_ = 6
{-# LINE 90 "src/LibForeign.hsc" #-}

c_SOL_TCP :: CInt
c_SOL_TCP = fromIntegral c_SOL_TCP_

c_TCP_KEEPIDLE_ = 4
{-# LINE 95 "src/LibForeign.hsc" #-}

c_TCP_KEEPIDLE :: CInt
c_TCP_KEEPIDLE = fromIntegral c_TCP_KEEPIDLE_


c_TCP_KEEPCNT_ = 6
{-# LINE 101 "src/LibForeign.hsc" #-}

c_TCP_KEEPCNT :: CInt
c_TCP_KEEPCNT = fromIntegral c_TCP_KEEPCNT_

c_TCP_KEEPINTVL_ = 5
{-# LINE 106 "src/LibForeign.hsc" #-}

c_TCP_KEEPINTVL :: CInt
c_TCP_KEEPINTVL = fromIntegral c_TCP_KEEPINTVL_


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

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