{-# LINE 1 "Network/Socket/Options.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
#include "HsNetDef.h"
module Network.Socket.Options (
SocketOption(..)
, isSupportedSocketOption
, getSocketType
, getSocketOption
, setSocketOption
, c_getsockopt
, c_setsockopt
) where
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (with)
import Network.Socket.Imports
import Network.Socket.Internal
import Network.Socket.Types
data SocketOption
= Debug
| ReuseAddr
| Type
| SoError
| DontRoute
| Broadcast
| SendBuffer
| RecvBuffer
| KeepAlive
| OOBInline
| TimeToLive
| MaxSegment
| NoDelay
| Cork
| Linger
| ReusePort
| RecvLowWater
| SendLowWater
| RecvTimeOut
| SendTimeOut
| UseLoopBack
| UserTimeout
| IPv6Only
| CustomSockOpt (CInt, CInt)
deriving (Show, Typeable)
isSupportedSocketOption :: SocketOption -> Bool
isSupportedSocketOption = isJust . packSocketOption
getSocketType :: Socket -> IO SocketType
getSocketType s = (fromMaybe NoSocketType . unpackSocketType . fromIntegral)
<$> getSocketOption s Type
packSocketOption :: SocketOption -> Maybe (CInt, CInt)
packSocketOption so =
case Just so of
{-# LINE 87 "Network/Socket/Options.hsc" #-}
{-# LINE 88 "Network/Socket/Options.hsc" #-}
Just Debug -> Just ((1), (1))
{-# LINE 89 "Network/Socket/Options.hsc" #-}
{-# LINE 90 "Network/Socket/Options.hsc" #-}
{-# LINE 91 "Network/Socket/Options.hsc" #-}
Just ReuseAddr -> Just ((1), (2))
{-# LINE 92 "Network/Socket/Options.hsc" #-}
{-# LINE 93 "Network/Socket/Options.hsc" #-}
{-# LINE 94 "Network/Socket/Options.hsc" #-}
Just Type -> Just ((1), (3))
{-# LINE 95 "Network/Socket/Options.hsc" #-}
{-# LINE 96 "Network/Socket/Options.hsc" #-}
{-# LINE 97 "Network/Socket/Options.hsc" #-}
Just SoError -> Just ((1), (4))
{-# LINE 98 "Network/Socket/Options.hsc" #-}
{-# LINE 99 "Network/Socket/Options.hsc" #-}
{-# LINE 100 "Network/Socket/Options.hsc" #-}
Just DontRoute -> Just ((1), (5))
{-# LINE 101 "Network/Socket/Options.hsc" #-}
{-# LINE 102 "Network/Socket/Options.hsc" #-}
{-# LINE 103 "Network/Socket/Options.hsc" #-}
Just Broadcast -> Just ((1), (6))
{-# LINE 104 "Network/Socket/Options.hsc" #-}
{-# LINE 105 "Network/Socket/Options.hsc" #-}
{-# LINE 106 "Network/Socket/Options.hsc" #-}
Just SendBuffer -> Just ((1), (7))
{-# LINE 107 "Network/Socket/Options.hsc" #-}
{-# LINE 108 "Network/Socket/Options.hsc" #-}
{-# LINE 109 "Network/Socket/Options.hsc" #-}
Just RecvBuffer -> Just ((1), (8))
{-# LINE 110 "Network/Socket/Options.hsc" #-}
{-# LINE 111 "Network/Socket/Options.hsc" #-}
{-# LINE 112 "Network/Socket/Options.hsc" #-}
Just KeepAlive -> Just ((1), (9))
{-# LINE 113 "Network/Socket/Options.hsc" #-}
{-# LINE 114 "Network/Socket/Options.hsc" #-}
{-# LINE 115 "Network/Socket/Options.hsc" #-}
Just OOBInline -> Just ((1), (10))
{-# LINE 116 "Network/Socket/Options.hsc" #-}
{-# LINE 117 "Network/Socket/Options.hsc" #-}
{-# LINE 118 "Network/Socket/Options.hsc" #-}
Just Linger -> Just ((1), (13))
{-# LINE 119 "Network/Socket/Options.hsc" #-}
{-# LINE 120 "Network/Socket/Options.hsc" #-}
{-# LINE 121 "Network/Socket/Options.hsc" #-}
Just ReusePort -> Just ((1), (15))
{-# LINE 122 "Network/Socket/Options.hsc" #-}
{-# LINE 123 "Network/Socket/Options.hsc" #-}
{-# LINE 124 "Network/Socket/Options.hsc" #-}
Just RecvLowWater -> Just ((1), (18))
{-# LINE 125 "Network/Socket/Options.hsc" #-}
{-# LINE 126 "Network/Socket/Options.hsc" #-}
{-# LINE 127 "Network/Socket/Options.hsc" #-}
Just SendLowWater -> Just ((1), (19))
{-# LINE 128 "Network/Socket/Options.hsc" #-}
{-# LINE 129 "Network/Socket/Options.hsc" #-}
{-# LINE 130 "Network/Socket/Options.hsc" #-}
Just RecvTimeOut -> Just ((1), (20))
{-# LINE 131 "Network/Socket/Options.hsc" #-}
{-# LINE 132 "Network/Socket/Options.hsc" #-}
{-# LINE 133 "Network/Socket/Options.hsc" #-}
Just SendTimeOut -> Just ((1), (21))
{-# LINE 134 "Network/Socket/Options.hsc" #-}
{-# LINE 135 "Network/Socket/Options.hsc" #-}
{-# LINE 138 "Network/Socket/Options.hsc" #-}
{-# LINE 139 "Network/Socket/Options.hsc" #-}
{-# LINE 140 "Network/Socket/Options.hsc" #-}
{-# LINE 141 "Network/Socket/Options.hsc" #-}
Just TimeToLive -> Just ((0), (2))
{-# LINE 142 "Network/Socket/Options.hsc" #-}
{-# LINE 143 "Network/Socket/Options.hsc" #-}
{-# LINE 144 "Network/Socket/Options.hsc" #-}
{-# LINE 145 "Network/Socket/Options.hsc" #-}
{-# LINE 146 "Network/Socket/Options.hsc" #-}
Just MaxSegment -> Just ((6), (2))
{-# LINE 147 "Network/Socket/Options.hsc" #-}
{-# LINE 148 "Network/Socket/Options.hsc" #-}
{-# LINE 149 "Network/Socket/Options.hsc" #-}
Just NoDelay -> Just ((6), (1))
{-# LINE 150 "Network/Socket/Options.hsc" #-}
{-# LINE 151 "Network/Socket/Options.hsc" #-}
{-# LINE 152 "Network/Socket/Options.hsc" #-}
Just UserTimeout -> Just ((6), (18))
{-# LINE 153 "Network/Socket/Options.hsc" #-}
{-# LINE 154 "Network/Socket/Options.hsc" #-}
{-# LINE 155 "Network/Socket/Options.hsc" #-}
Just Cork -> Just ((6), (3))
{-# LINE 156 "Network/Socket/Options.hsc" #-}
{-# LINE 157 "Network/Socket/Options.hsc" #-}
{-# LINE 158 "Network/Socket/Options.hsc" #-}
{-# LINE 159 "Network/Socket/Options.hsc" #-}
{-# LINE 160 "Network/Socket/Options.hsc" #-}
Just IPv6Only -> Just ((41), (26))
{-# LINE 161 "Network/Socket/Options.hsc" #-}
{-# LINE 162 "Network/Socket/Options.hsc" #-}
{-# LINE 163 "Network/Socket/Options.hsc" #-}
Just (CustomSockOpt opt) -> Just opt
_ -> Nothing
packSocketOption' :: String -> SocketOption -> IO (CInt, CInt)
packSocketOption' caller so = maybe err return (packSocketOption so)
where
err = ioError . userError . concat $ ["Network.Socket.", caller,
": socket option ", show so, " unsupported on this system"]
{-# LINE 176 "Network/Socket/Options.hsc" #-}
data StructLinger = StructLinger CInt CInt
instance Storable StructLinger where
sizeOf _ = (8)
{-# LINE 180 "Network/Socket/Options.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
onoff <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 184 "Network/Socket/Options.hsc" #-}
linger <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 185 "Network/Socket/Options.hsc" #-}
return $ StructLinger onoff linger
poke p (StructLinger onoff linger) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p onoff
{-# LINE 189 "Network/Socket/Options.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p linger
{-# LINE 190 "Network/Socket/Options.hsc" #-}
{-# LINE 191 "Network/Socket/Options.hsc" #-}
setSocketOption :: Socket
-> SocketOption
-> Int
-> IO ()
{-# LINE 199 "Network/Socket/Options.hsc" #-}
setSocketOption s Linger v = do
(level, opt) <- packSocketOption' "setSocketOption" Linger
let arg = if v == 0 then StructLinger 0 0 else StructLinger 1 (fromIntegral v)
with arg $ \ptr_arg -> void $ do
let ptr = ptr_arg :: Ptr StructLinger
sz = fromIntegral $ sizeOf (undefined :: StructLinger)
withFdSocket s $ \fd ->
throwSocketErrorIfMinus1_ "Network.Socket.setSocketOption" $
c_setsockopt fd level opt ptr sz
{-# LINE 209 "Network/Socket/Options.hsc" #-}
setSocketOption s so v = do
(level, opt) <- packSocketOption' "setSocketOption" so
with (fromIntegral v) $ \ptr_v -> void $ do
let ptr = ptr_v :: Ptr CInt
sz = fromIntegral $ sizeOf (undefined :: CInt)
withFdSocket s $ \fd ->
throwSocketErrorIfMinus1_ "Network.Socket.setSocketOption" $
c_setsockopt fd level opt ptr sz
getSocketOption :: Socket
-> SocketOption
-> IO Int
{-# LINE 224 "Network/Socket/Options.hsc" #-}
getSocketOption s Linger = do
(level, opt) <- packSocketOption' "getSocketOption" Linger
alloca $ \ptr_v -> do
let ptr = ptr_v :: Ptr StructLinger
sz = fromIntegral $ sizeOf (undefined :: StructLinger)
withFdSocket s $ \fd -> with sz $ \ptr_sz -> do
throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketOption" $
c_getsockopt fd level opt ptr ptr_sz
StructLinger onoff linger <- peek ptr
return $ fromIntegral $ if onoff == 0 then 0 else linger
{-# LINE 235 "Network/Socket/Options.hsc" #-}
getSocketOption s so = do
(level, opt) <- packSocketOption' "getSocketOption" so
alloca $ \ptr_v -> do
let ptr = ptr_v :: Ptr CInt
sz = fromIntegral $ sizeOf (undefined :: CInt)
withFdSocket s $ \fd -> with sz $ \ptr_sz -> do
throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketOption" $
c_getsockopt fd level opt ptr ptr_sz
fromIntegral <$> peek ptr
foreign import CALLCONV unsafe "getsockopt"
c_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt
foreign import CALLCONV unsafe "setsockopt"
c_setsockopt :: CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt