module System.Socket.Internal.Socket (
Socket (..)
, GetSocketOption (..)
, getSocketOptionBool
, getSocketOptionInt
, getSocketOptionCInt
, SetSocketOption (..)
, setSocketOptionBool
, setSocketOptionInt
, setSocketOptionCInt
, Error (..)
, ReuseAddress (..)
) where
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad
import Control.Applicative
import Foreign.Ptr
import Foreign.Storable
import Foreign.C.Types
import Foreign.Marshal.Alloc
import System.Posix.Types
import System.Socket.Internal.Platform
import System.Socket.Internal.Exception
newtype Socket f t p
= Socket (MVar Fd)
class GetSocketOption o where
getSocketOption :: Socket f t p -> IO o
class SetSocketOption o where
setSocketOption :: Socket f t p -> o -> IO ()
data Error
= Error SocketException
deriving (Eq, Ord, Show)
instance GetSocketOption Error where
getSocketOption s =
Error . SocketException <$> getSocketOptionCInt s (1) (4)
data ReuseAddress
= ReuseAddress Bool
deriving (Eq, Ord, Show)
instance GetSocketOption ReuseAddress where
getSocketOption s =
ReuseAddress <$> getSocketOptionBool s (1) (2)
instance SetSocketOption ReuseAddress where
setSocketOption s (ReuseAddress o) =
setSocketOptionBool s (1) (2) o
setSocketOptionBool :: Socket f t p -> CInt -> CInt -> Bool -> IO ()
setSocketOptionBool (Socket mfd) level name value = do
withMVar mfd $ \fd->
alloca $ \vPtr-> do
if value
then poke vPtr 1
else poke vPtr 0
i <- c_setsockopt fd level name
(vPtr :: Ptr CInt)
(fromIntegral $ sizeOf (undefined :: CInt))
when (i < 0) $ do
c_get_last_socket_error >>= throwIO
getSocketOptionBool :: Socket f t p -> CInt -> CInt -> IO Bool
getSocketOptionBool (Socket mfd) level name = do
withMVar mfd $ \fd->
alloca $ \vPtr-> do
alloca $ \lPtr-> do
i <- c_getsockopt fd level name
(vPtr :: Ptr CInt)
(lPtr :: Ptr CInt)
if i < 0 then do
c_get_last_socket_error >>= throwIO
else do
v <- peek vPtr
return (v == 1)
setSocketOptionInt :: Socket f t p -> CInt -> CInt -> Int -> IO ()
setSocketOptionInt (Socket mfd) level name value = do
withMVar mfd $ \fd->
alloca $ \vPtr-> do
poke vPtr (fromIntegral value :: CInt)
i <- c_setsockopt fd level name
(vPtr :: Ptr CInt)
(fromIntegral $ sizeOf (undefined :: CInt))
when (i < 0) $ do
c_get_last_socket_error >>= throwIO
getSocketOptionInt :: Socket f t p -> CInt -> CInt -> IO Int
getSocketOptionInt (Socket mfd) level name = do
withMVar mfd $ \fd->
alloca $ \vPtr-> do
alloca $ \lPtr-> do
i <- c_getsockopt fd level name
(vPtr :: Ptr CInt)
(lPtr :: Ptr CInt)
if i < 0 then do
c_get_last_socket_error >>= throwIO
else do
v <- peek vPtr
return (fromIntegral v)
setSocketOptionCInt :: Socket f t p -> CInt -> CInt -> CInt -> IO ()
setSocketOptionCInt (Socket mfd) level name value = do
withMVar mfd $ \fd->
alloca $ \vPtr-> do
poke vPtr value
i <- c_setsockopt fd level name
(vPtr :: Ptr CInt)
(fromIntegral $ sizeOf (undefined :: CInt))
when (i < 0) $ do
c_get_last_socket_error >>= throwIO
getSocketOptionCInt :: Socket f t p -> CInt -> CInt -> IO CInt
getSocketOptionCInt (Socket mfd) level name = do
withMVar mfd $ \fd->
alloca $ \vPtr-> do
alloca $ \lPtr-> do
i <- c_getsockopt fd level name
(vPtr :: Ptr CInt)
(lPtr :: Ptr CInt)
if i < 0 then do
c_get_last_socket_error >>= throwIO
else do
peek vPtr