{-# LINE 1 "Network/Socket/Options.hsc" #-}
------------------------------------------------------------------------
{-# LINE 2 "Network/Socket/Options.hsc" #-}
-- |
-- Module:       Network.Socket.Options
-- Copyright:    (c) Joseph Adams 2012
-- License:      BSD3
-- Maintainer:   joeyadams3.14159@gmail.com
--
-- Documentation is currently lacking.  For now, see @man 7 socket@ and
-- @man 7 tcp@ of the Linux man-pages, or look up setsockopt in MSDN.
{-# LANGUAGE ForeignFunctionInterface #-}
module Network.Socket.Options
    (
    -- * Getting options
    getAcceptConn,
    getBroadcast,
    getDebug,
    getDontRoute,
    getError,
    getKeepAlive,
    getLinger,
    getOOBInline,
    getRecvBuf,
    getRecvTimeout,
    getReuseAddr,
    getSendBuf,
    getSendTimeout,
    getType,

    -- ** TCP
    getTcpNoDelay,

    -- * Setting options
    setBroadcast,
    setDebug,
    setDontRoute,
    setKeepAlive,
    setLinger,
    setOOBInline,
    setRecvBuf,
    setRecvTimeout,
    setReuseAddr,
    setSendBuf,
    setSendTimeout,

    -- ** TCP
    setTcpNoDelay,

    -- * Types
    HasSocket(..),
    Seconds,
    Microseconds,
    ) where


{-# LINE 57 "Network/Socket/Options.hsc" #-}

{-# LINE 58 "Network/Socket/Options.hsc" #-}

{-# LINE 59 "Network/Socket/Options.hsc" #-}

{-# LINE 60 "Network/Socket/Options.hsc" #-}

{-# LINE 61 "Network/Socket/Options.hsc" #-}

{-# LINE 62 "Network/Socket/Options.hsc" #-}

import Data.Int (Int64)
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (Ptr)
import Foreign.Storable (peek)
import Network.Socket (Socket, SocketType(..), fdSocket)
import Network.Socket.Internal (throwSocketErrorIfMinus1_)
import System.Posix.Types (Fd(Fd))


{-# LINE 73 "Network/Socket/Options.hsc" #-}
import qualified GHC.IO.FD as FD

{-# LINE 75 "Network/Socket/Options.hsc" #-}

-- | The getters and setters in this module can be used not only on 'Socket's,
-- but on raw 'Fd's (file descriptors) as well.
class HasSocket a where
    getSocket :: a -> CInt

instance HasSocket Fd where
    getSocket (Fd n) = n

instance HasSocket Socket where
    getSocket = fdSocket


{-# LINE 88 "Network/Socket/Options.hsc" #-}
instance HasSocket FD.FD where
    getSocket = FD.fdFD

{-# LINE 91 "Network/Socket/Options.hsc" #-}

type Seconds        = Int
type Microseconds   = Int64

{-
It would be cute to have:

    data SocketOption a = ...

so we can say:

    setSocketOption :: Socket -> SocketOption a -> a -> IO ()
    getSocketOption :: Socket -> SocketOption a -> IO a

However, that's probably less convenient to use, and it bars socket options
that support get but not set or vice versa (e.g. SO_ACCEPTCONN and SO_TYPE).
-}

------------------------------------------------------------------------
-- Getting options

-- | This option is get-only.
getAcceptConn :: HasSocket sock => sock -> IO Bool
getAcceptConn = getBool 1 30
{-# LINE 115 "Network/Socket/Options.hsc" #-}

getBroadcast :: HasSocket sock => sock -> IO Bool
getBroadcast = getBool 1 6
{-# LINE 118 "Network/Socket/Options.hsc" #-}

getDebug :: HasSocket sock => sock -> IO Bool
getDebug = getBool 1 1
{-# LINE 121 "Network/Socket/Options.hsc" #-}

getDontRoute :: HasSocket sock => sock -> IO Bool
getDontRoute = getBool 1 5
{-# LINE 124 "Network/Socket/Options.hsc" #-}

-- | This option is get-only.
getError :: HasSocket sock => sock -> IO Int
getError = getInt 1 4
{-# LINE 128 "Network/Socket/Options.hsc" #-}

getKeepAlive :: HasSocket sock => sock -> IO Bool
getKeepAlive = getBool 1 9
{-# LINE 131 "Network/Socket/Options.hsc" #-}

getLinger :: HasSocket sock => sock -> IO (Maybe Seconds)
getLinger sock =
    alloca $ \l_onoff_ptr ->
    alloca $ \l_linger_ptr -> do
        throwSocketErrorIfMinus1_ "getsockopt" $
            c_getsockopt_linger (getSocket sock) l_onoff_ptr l_linger_ptr
        onoff <- peek l_onoff_ptr
        if onoff /= 0
            then (Just . fromIntegral) `fmap` peek l_linger_ptr
            else return Nothing

getOOBInline :: HasSocket sock => sock -> IO Bool
getOOBInline = getBool 1 10
{-# LINE 145 "Network/Socket/Options.hsc" #-}

getRecvBuf :: HasSocket sock => sock -> IO Int
getRecvBuf = getInt 1 8
{-# LINE 148 "Network/Socket/Options.hsc" #-}

getRecvTimeout :: HasSocket sock => sock -> IO Microseconds
getRecvTimeout = getTime 1 20
{-# LINE 151 "Network/Socket/Options.hsc" #-}

getReuseAddr :: HasSocket sock => sock -> IO Bool
getReuseAddr = getBool 1 2
{-# LINE 154 "Network/Socket/Options.hsc" #-}

getSendBuf :: HasSocket sock => sock -> IO Int
getSendBuf = getInt 1 7
{-# LINE 157 "Network/Socket/Options.hsc" #-}

getSendTimeout :: HasSocket sock => sock -> IO Microseconds
getSendTimeout = getTime 1 21
{-# LINE 160 "Network/Socket/Options.hsc" #-}

-- | This option is get-only.
getType :: HasSocket sock => sock -> IO SocketType
getType sock =
    toSocketType `fmap` getCInt 1 3 sock
{-# LINE 165 "Network/Socket/Options.hsc" #-}

toSocketType :: CInt -> SocketType
toSocketType t = case t of

{-# LINE 169 "Network/Socket/Options.hsc" #-}
    1 -> Stream
{-# LINE 170 "Network/Socket/Options.hsc" #-}

{-# LINE 171 "Network/Socket/Options.hsc" #-}

{-# LINE 172 "Network/Socket/Options.hsc" #-}
    2 -> Datagram
{-# LINE 173 "Network/Socket/Options.hsc" #-}

{-# LINE 174 "Network/Socket/Options.hsc" #-}

{-# LINE 175 "Network/Socket/Options.hsc" #-}
    3 -> Raw
{-# LINE 176 "Network/Socket/Options.hsc" #-}

{-# LINE 177 "Network/Socket/Options.hsc" #-}

{-# LINE 178 "Network/Socket/Options.hsc" #-}
    4 -> RDM
{-# LINE 179 "Network/Socket/Options.hsc" #-}

{-# LINE 180 "Network/Socket/Options.hsc" #-}

{-# LINE 181 "Network/Socket/Options.hsc" #-}
    5 -> SeqPacket
{-# LINE 182 "Network/Socket/Options.hsc" #-}

{-# LINE 183 "Network/Socket/Options.hsc" #-}
    _ -> error $ "Network.Socket.Options.getType: Unknown socket type #" ++ show t

getTcpNoDelay :: HasSocket sock => sock -> IO Bool
getTcpNoDelay = getBool 6 1
{-# LINE 187 "Network/Socket/Options.hsc" #-}

------------------------------------------------------------------------
-- Setting options

setBroadcast :: HasSocket sock => sock -> Bool -> IO ()
setBroadcast = setBool 1 6
{-# LINE 193 "Network/Socket/Options.hsc" #-}

setDebug :: HasSocket sock => sock -> Bool -> IO ()
setDebug = setBool 1 1
{-# LINE 196 "Network/Socket/Options.hsc" #-}

setDontRoute :: HasSocket sock => sock -> Bool -> IO ()
setDontRoute = setBool 1 5
{-# LINE 199 "Network/Socket/Options.hsc" #-}

setKeepAlive :: HasSocket sock => sock -> Bool -> IO ()
setKeepAlive = setBool 1 9
{-# LINE 202 "Network/Socket/Options.hsc" #-}

-- | On Windows, the 'Seconds' value is truncated to 16 bits.  This means if a
-- linger time of more than 65535 seconds (about 18.2 hours) is given, it will
-- wrap around.
setLinger :: HasSocket sock => sock -> Maybe Seconds -> IO ()
setLinger sock (Just linger) =
    throwSocketErrorIfMinus1_ "setsockopt" $
        c_setsockopt_linger (getSocket sock) 1 (fromIntegral linger)
setLinger sock Nothing =
    throwSocketErrorIfMinus1_ "setsockopt" $
        c_setsockopt_linger (getSocket sock) 0 0

setOOBInline :: HasSocket sock => sock -> Bool -> IO ()
setOOBInline = setBool 1 10
{-# LINE 216 "Network/Socket/Options.hsc" #-}

setRecvBuf :: HasSocket sock => sock -> Int -> IO ()
setRecvBuf = setInt 1 8
{-# LINE 219 "Network/Socket/Options.hsc" #-}

-- | Note the following about timeout values:
--
--  * A value of 0 or less means the operation will never time out
--
--  * On Windows, the timeout is truncated to milliseconds, 32-bit.  However,
--    if the number of microseconds is from 1 to 999, it will be rounded up to
--    one millisecond, to prevent it from being treated as \"never time out\".
setRecvTimeout :: HasSocket sock => sock -> Microseconds -> IO ()
setRecvTimeout = setTime 1 20
{-# LINE 229 "Network/Socket/Options.hsc" #-}

setReuseAddr :: HasSocket sock => sock -> Bool -> IO ()
setReuseAddr = setBool 1 2
{-# LINE 232 "Network/Socket/Options.hsc" #-}

setSendBuf :: HasSocket sock => sock -> Int -> IO ()
setSendBuf = setInt 1 7
{-# LINE 235 "Network/Socket/Options.hsc" #-}

setSendTimeout :: HasSocket sock => sock -> Microseconds -> IO ()
setSendTimeout = setTime 1 21
{-# LINE 238 "Network/Socket/Options.hsc" #-}

setTcpNoDelay :: HasSocket sock => sock -> Bool -> IO ()
setTcpNoDelay = setBool 6 1
{-# LINE 241 "Network/Socket/Options.hsc" #-}

------------------------------------------------------------------------
-- Wrappers

type SockFd     = CInt
type Level      = CInt
type OptName    = CInt

getBool :: HasSocket sock => Level -> OptName -> sock -> IO Bool
getBool level optname sock =
    (/= 0) `fmap` getCInt level optname sock

setBool :: HasSocket sock => Level -> OptName -> sock -> Bool -> IO ()
setBool level optname sock b =
    setCInt level optname sock (fromIntegral $ fromEnum b)

getInt :: HasSocket sock => Level -> OptName -> sock -> IO Int
getInt level optname sock =
    fromIntegral `fmap` getCInt level optname sock

setInt :: HasSocket sock => Level -> OptName -> sock -> Int -> IO ()
setInt level optname sock n =
    setCInt level optname sock (fromIntegral n)

getCInt :: HasSocket sock => Level -> OptName -> sock -> IO CInt
getCInt level optname sock =
    alloca $ \ptr -> do
        throwSocketErrorIfMinus1_ "getsockopt" $
            c_getsockopt_int (getSocket sock) level optname ptr
        peek ptr

setCInt :: HasSocket sock => Level -> OptName -> sock -> CInt -> IO ()
setCInt level optname sock n =
    throwSocketErrorIfMinus1_ "setsockopt" $
        c_setsockopt_int (getSocket sock) level optname n

getTime :: HasSocket sock => Level -> OptName -> sock -> IO Microseconds
getTime level optname sock =
    alloca $ \ptr -> do
        throwSocketErrorIfMinus1_ "getsockopt" $
            c_getsockopt_time (getSocket sock) level optname ptr
        peek ptr

setTime :: HasSocket sock => Level -> OptName -> sock -> Microseconds -> IO ()
setTime level optname sock usec =
    throwSocketErrorIfMinus1_ "setsockopt" $
        c_setsockopt_time (getSocket sock) level optname usec

foreign import ccall
    c_getsockopt_int :: SockFd -> Level -> OptName -> Ptr CInt -> IO CInt

foreign import ccall
    c_setsockopt_int :: SockFd -> Level -> OptName -> CInt -> IO CInt

foreign import ccall
    c_getsockopt_time :: SockFd -> Level -> OptName -> Ptr Int64 -> IO CInt

foreign import ccall
    c_setsockopt_time :: SockFd -> Level -> OptName -> Int64 -> IO CInt

foreign import ccall
    c_getsockopt_linger :: SockFd
                        -> Ptr CInt -- ^ l_onoff
                        -> Ptr CInt -- ^ l_linger
                        -> IO CInt

foreign import ccall
    c_setsockopt_linger :: SockFd
                        -> CInt     -- ^ l_onoff
                        -> CInt     -- ^ l_linger
                        -> IO CInt