{-# LINE 1 "Network/Socket/Options.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
#include "HsNetDef.h"
module Network.Socket.Options (
SocketOption(SockOpt
,UnsupportedSocketOption
,Debug,ReuseAddr,SoDomain,Type,SoProtocol,SoError,DontRoute
,Broadcast,SendBuffer,RecvBuffer,KeepAlive,OOBInline,TimeToLive
,MaxSegment,NoDelay,Cork,Linger,ReusePort
,RecvLowWater,SendLowWater,RecvTimeOut,SendTimeOut
,UseLoopBack,UserTimeout,IPv6Only
,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo
,RecvIPv6HopLimit,RecvIPv6TClass,RecvIPv6PktInfo
,CustomSockOpt)
, isSupportedSocketOption
, whenSupported
, getSocketType
, getSocketOption
, setSocketOption
, getSockOpt
, setSockOpt
, StructLinger (..)
) where
import qualified Text.Read as P
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (with)
import Network.Socket.Imports
import Network.Socket.Internal
import Network.Socket.Types
import Network.Socket.ReadShow
data SocketOption = SockOpt
{-# LINE 50 "Network/Socket/Options.hsc" #-}
!CInt
!CInt
{-# LINE 56 "Network/Socket/Options.hsc" #-}
deriving (Eq)
isSupportedSocketOption :: SocketOption -> Bool
isSupportedSocketOption opt = opt /= SockOpt (-1) (-1)
getSocketType :: Socket -> IO SocketType
getSocketType s = unpackSocketType <$> getSockOpt s Type
pattern UnsupportedSocketOption :: SocketOption
pattern UnsupportedSocketOption = SockOpt (-1) (-1)
{-# LINE 72 "Network/Socket/Options.hsc" #-}
pattern Debug :: SocketOption
{-# LINE 75 "Network/Socket/Options.hsc" #-}
pattern Debug = SockOpt (1) (1)
{-# LINE 76 "Network/Socket/Options.hsc" #-}
{-# LINE 79 "Network/Socket/Options.hsc" #-}
pattern ReuseAddr :: SocketOption
{-# LINE 82 "Network/Socket/Options.hsc" #-}
pattern ReuseAddr = SockOpt (1) (2)
{-# LINE 83 "Network/Socket/Options.hsc" #-}
{-# LINE 86 "Network/Socket/Options.hsc" #-}
pattern SoDomain :: SocketOption
{-# LINE 90 "Network/Socket/Options.hsc" #-}
pattern SoDomain = SockOpt (1) (39)
{-# LINE 91 "Network/Socket/Options.hsc" #-}
{-# LINE 94 "Network/Socket/Options.hsc" #-}
pattern Type :: SocketOption
{-# LINE 98 "Network/Socket/Options.hsc" #-}
pattern Type = SockOpt (1) (3)
{-# LINE 99 "Network/Socket/Options.hsc" #-}
{-# LINE 102 "Network/Socket/Options.hsc" #-}
pattern SoProtocol :: SocketOption
{-# LINE 106 "Network/Socket/Options.hsc" #-}
pattern SoProtocol = SockOpt (1) (38)
{-# LINE 107 "Network/Socket/Options.hsc" #-}
{-# LINE 110 "Network/Socket/Options.hsc" #-}
pattern SoError :: SocketOption
{-# LINE 114 "Network/Socket/Options.hsc" #-}
pattern SoError = SockOpt (1) (4)
{-# LINE 115 "Network/Socket/Options.hsc" #-}
{-# LINE 118 "Network/Socket/Options.hsc" #-}
pattern DontRoute :: SocketOption
{-# LINE 121 "Network/Socket/Options.hsc" #-}
pattern DontRoute = SockOpt (1) (5)
{-# LINE 122 "Network/Socket/Options.hsc" #-}
{-# LINE 125 "Network/Socket/Options.hsc" #-}
pattern Broadcast :: SocketOption
{-# LINE 128 "Network/Socket/Options.hsc" #-}
pattern Broadcast = SockOpt (1) (6)
{-# LINE 129 "Network/Socket/Options.hsc" #-}
{-# LINE 132 "Network/Socket/Options.hsc" #-}
pattern SendBuffer :: SocketOption
{-# LINE 135 "Network/Socket/Options.hsc" #-}
pattern SendBuffer = SockOpt (1) (7)
{-# LINE 136 "Network/Socket/Options.hsc" #-}
{-# LINE 139 "Network/Socket/Options.hsc" #-}
pattern RecvBuffer :: SocketOption
{-# LINE 142 "Network/Socket/Options.hsc" #-}
pattern RecvBuffer = SockOpt (1) (8)
{-# LINE 143 "Network/Socket/Options.hsc" #-}
{-# LINE 146 "Network/Socket/Options.hsc" #-}
pattern KeepAlive :: SocketOption
{-# LINE 149 "Network/Socket/Options.hsc" #-}
pattern KeepAlive = SockOpt (1) (9)
{-# LINE 150 "Network/Socket/Options.hsc" #-}
{-# LINE 153 "Network/Socket/Options.hsc" #-}
pattern OOBInline :: SocketOption
{-# LINE 156 "Network/Socket/Options.hsc" #-}
pattern OOBInline = SockOpt (1) (10)
{-# LINE 157 "Network/Socket/Options.hsc" #-}
{-# LINE 160 "Network/Socket/Options.hsc" #-}
pattern Linger :: SocketOption
{-# LINE 163 "Network/Socket/Options.hsc" #-}
pattern Linger = SockOpt (1) (13)
{-# LINE 164 "Network/Socket/Options.hsc" #-}
{-# LINE 167 "Network/Socket/Options.hsc" #-}
pattern ReusePort :: SocketOption
{-# LINE 170 "Network/Socket/Options.hsc" #-}
pattern ReusePort = SockOpt (1) (15)
{-# LINE 171 "Network/Socket/Options.hsc" #-}
{-# LINE 174 "Network/Socket/Options.hsc" #-}
pattern RecvLowWater :: SocketOption
{-# LINE 177 "Network/Socket/Options.hsc" #-}
pattern RecvLowWater = SockOpt (1) (18)
{-# LINE 178 "Network/Socket/Options.hsc" #-}
{-# LINE 181 "Network/Socket/Options.hsc" #-}
pattern SendLowWater :: SocketOption
{-# LINE 184 "Network/Socket/Options.hsc" #-}
pattern SendLowWater = SockOpt (1) (19)
{-# LINE 185 "Network/Socket/Options.hsc" #-}
{-# LINE 188 "Network/Socket/Options.hsc" #-}
pattern RecvTimeOut :: SocketOption
{-# LINE 191 "Network/Socket/Options.hsc" #-}
pattern RecvTimeOut = SockOpt (1) (20)
{-# LINE 192 "Network/Socket/Options.hsc" #-}
{-# LINE 195 "Network/Socket/Options.hsc" #-}
pattern SendTimeOut :: SocketOption
{-# LINE 198 "Network/Socket/Options.hsc" #-}
pattern SendTimeOut = SockOpt (1) (21)
{-# LINE 199 "Network/Socket/Options.hsc" #-}
{-# LINE 202 "Network/Socket/Options.hsc" #-}
pattern UseLoopBack :: SocketOption
{-# LINE 207 "Network/Socket/Options.hsc" #-}
pattern UseLoopBack = SockOpt (-1) (-1)
{-# LINE 209 "Network/Socket/Options.hsc" #-}
{-# LINE 210 "Network/Socket/Options.hsc" #-}
{-# LINE 212 "Network/Socket/Options.hsc" #-}
pattern MaxSegment :: SocketOption
{-# LINE 215 "Network/Socket/Options.hsc" #-}
pattern MaxSegment = SockOpt (6) (2)
{-# LINE 216 "Network/Socket/Options.hsc" #-}
{-# LINE 219 "Network/Socket/Options.hsc" #-}
pattern NoDelay :: SocketOption
{-# LINE 222 "Network/Socket/Options.hsc" #-}
pattern NoDelay = SockOpt (6) (1)
{-# LINE 223 "Network/Socket/Options.hsc" #-}
{-# LINE 226 "Network/Socket/Options.hsc" #-}
pattern UserTimeout :: SocketOption
{-# LINE 229 "Network/Socket/Options.hsc" #-}
pattern UserTimeout = SockOpt (6) (18)
{-# LINE 230 "Network/Socket/Options.hsc" #-}
{-# LINE 233 "Network/Socket/Options.hsc" #-}
pattern Cork :: SocketOption
{-# LINE 236 "Network/Socket/Options.hsc" #-}
pattern Cork = SockOpt (6) (3)
{-# LINE 237 "Network/Socket/Options.hsc" #-}
{-# LINE 240 "Network/Socket/Options.hsc" #-}
{-# LINE 241 "Network/Socket/Options.hsc" #-}
{-# LINE 243 "Network/Socket/Options.hsc" #-}
pattern TimeToLive :: SocketOption
{-# LINE 246 "Network/Socket/Options.hsc" #-}
pattern TimeToLive = SockOpt (0) (2)
{-# LINE 247 "Network/Socket/Options.hsc" #-}
{-# LINE 250 "Network/Socket/Options.hsc" #-}
pattern RecvIPv4TTL :: SocketOption
{-# LINE 253 "Network/Socket/Options.hsc" #-}
pattern RecvIPv4TTL = SockOpt (0) (12)
{-# LINE 254 "Network/Socket/Options.hsc" #-}
{-# LINE 257 "Network/Socket/Options.hsc" #-}
pattern RecvIPv4TOS :: SocketOption
{-# LINE 260 "Network/Socket/Options.hsc" #-}
pattern RecvIPv4TOS = SockOpt (0) (13)
{-# LINE 261 "Network/Socket/Options.hsc" #-}
{-# LINE 264 "Network/Socket/Options.hsc" #-}
pattern RecvIPv4PktInfo :: SocketOption
{-# LINE 269 "Network/Socket/Options.hsc" #-}
pattern RecvIPv4PktInfo = SockOpt (0) (8)
{-# LINE 270 "Network/Socket/Options.hsc" #-}
{-# LINE 273 "Network/Socket/Options.hsc" #-}
{-# LINE 274 "Network/Socket/Options.hsc" #-}
{-# LINE 276 "Network/Socket/Options.hsc" #-}
pattern IPv6Only :: SocketOption
{-# LINE 279 "Network/Socket/Options.hsc" #-}
pattern IPv6Only = SockOpt (41) (26)
{-# LINE 280 "Network/Socket/Options.hsc" #-}
{-# LINE 283 "Network/Socket/Options.hsc" #-}
pattern RecvIPv6HopLimit :: SocketOption
{-# LINE 286 "Network/Socket/Options.hsc" #-}
pattern RecvIPv6HopLimit = SockOpt (41) (51)
{-# LINE 287 "Network/Socket/Options.hsc" #-}
{-# LINE 290 "Network/Socket/Options.hsc" #-}
pattern RecvIPv6TClass :: SocketOption
{-# LINE 293 "Network/Socket/Options.hsc" #-}
pattern RecvIPv6TClass = SockOpt (41) (66)
{-# LINE 294 "Network/Socket/Options.hsc" #-}
{-# LINE 297 "Network/Socket/Options.hsc" #-}
pattern RecvIPv6PktInfo :: SocketOption
{-# LINE 300 "Network/Socket/Options.hsc" #-}
pattern RecvIPv6PktInfo = SockOpt (41) (49)
{-# LINE 301 "Network/Socket/Options.hsc" #-}
{-# LINE 306 "Network/Socket/Options.hsc" #-}
{-# LINE 307 "Network/Socket/Options.hsc" #-}
pattern CustomSockOpt :: (CInt, CInt) -> SocketOption
pattern CustomSockOpt xy <- ((\(SockOpt x y) -> (x, y)) -> xy)
where
CustomSockOpt (x, y) = SockOpt x y
{-# LINE 314 "Network/Socket/Options.hsc" #-}
{-# COMPLETE CustomSockOpt #-}
{-# LINE 316 "Network/Socket/Options.hsc" #-}
{-# LINE 317 "Network/Socket/Options.hsc" #-}
data StructLinger = StructLinger {
sl_onoff :: CInt,
sl_linger :: CInt
}
deriving (Eq, Ord, Show)
instance Storable StructLinger where
sizeOf _ = (8)
{-# LINE 330 "Network/Socket/Options.hsc" #-}
alignment _ = alignment (0 :: CInt)
peek p = do
onoff <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 334 "Network/Socket/Options.hsc" #-}
linger <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 335 "Network/Socket/Options.hsc" #-}
return $ StructLinger onoff linger
poke p (StructLinger onoff linger) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p onoff
{-# LINE 339 "Network/Socket/Options.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p linger
{-# LINE 340 "Network/Socket/Options.hsc" #-}
{-# LINE 341 "Network/Socket/Options.hsc" #-}
whenSupported :: SocketOption -> IO a -> IO ()
whenSupported s action
| isSupportedSocketOption s = action >> return ()
| otherwise = return ()
setSocketOption :: Socket
-> SocketOption
-> Int
-> IO ()
{-# LINE 356 "Network/Socket/Options.hsc" #-}
setSocketOption s so@Linger v = do
let arg = if v == 0 then StructLinger 0 0 else StructLinger 1 (fromIntegral v)
setSockOpt s so arg
{-# LINE 360 "Network/Socket/Options.hsc" #-}
setSocketOption s sa v = setSockOpt s sa (fromIntegral v :: CInt)
setSockOpt :: Storable a
=> Socket
-> SocketOption
-> a
-> IO ()
setSockOpt s (SockOpt level opt) v = do
with v $ \ptr -> void $ do
let sz = fromIntegral $ sizeOf v
withFdSocket s $ \fd ->
throwSocketErrorIfMinus1_ "Network.Socket.setSockOpt" $
c_setsockopt fd level opt ptr sz
getSocketOption :: Socket
-> SocketOption
-> IO Int
{-# LINE 381 "Network/Socket/Options.hsc" #-}
getSocketOption s so@Linger = do
StructLinger onoff linger <- getSockOpt s so
return $ fromIntegral $ if onoff == 0 then 0 else linger
{-# LINE 385 "Network/Socket/Options.hsc" #-}
getSocketOption s so = do
n :: CInt <- getSockOpt s so
return $ fromIntegral n
getSockOpt :: forall a . Storable a
=> Socket
-> SocketOption
-> IO a
getSockOpt s (SockOpt level opt) = do
alloca $ \ptr -> do
let sz = fromIntegral $ sizeOf (undefined :: a)
withFdSocket s $ \fd -> with sz $ \ptr_sz -> do
throwSocketErrorIfMinus1Retry_ "Network.Socket.getSockOpt" $
c_getsockopt fd level opt ptr ptr_sz
peek ptr
socketOptionBijection :: Bijection SocketOption String
socketOptionBijection =
[ (UnsupportedSocketOption, "UnsupportedSocketOption")
, (Debug, "Debug")
, (ReuseAddr, "ReuseAddr")
, (SoDomain, "SoDomain")
, (Type, "Type")
, (SoProtocol, "SoProtocol")
, (SoError, "SoError")
, (DontRoute, "DontRoute")
, (Broadcast, "Broadcast")
, (SendBuffer, "SendBuffer")
, (RecvBuffer, "RecvBuffer")
, (KeepAlive, "KeepAlive")
, (OOBInline, "OOBInline")
, (Linger, "Linger")
, (ReusePort, "ReusePort")
, (RecvLowWater, "RecvLowWater")
, (SendLowWater, "SendLowWater")
, (RecvTimeOut, "RecvTimeOut")
, (SendTimeOut, "SendTimeOut")
, (UseLoopBack, "UseLoopBack")
, (MaxSegment, "MaxSegment")
, (NoDelay, "NoDelay")
, (UserTimeout, "UserTimeout")
, (Cork, "Cork")
, (TimeToLive, "TimeToLive")
, (RecvIPv4TTL, "RecvIPv4TTL")
, (RecvIPv4TOS, "RecvIPv4TOS")
, (RecvIPv4PktInfo, "RecvIPv4PktInfo")
, (IPv6Only, "IPv6Only")
, (RecvIPv6HopLimit, "RecvIPv6HopLimit")
, (RecvIPv6TClass, "RecvIPv6TClass")
, (RecvIPv6PktInfo, "RecvIPv6PktInfo")
]
instance Show SocketOption where
showsPrec = bijectiveShow socketOptionBijection def
where
defname = "SockOpt"
unwrap = \(CustomSockOpt nm) -> nm
def = defShow defname unwrap showIntInt
instance Read SocketOption where
readPrec = bijectiveRead socketOptionBijection def
where
defname = "SockOpt"
def = defRead defname CustomSockOpt readIntInt
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