definging CSocket

Author: kazu-yamamoto

Network/Socket/ByteString/Internal.hs

@@ -53,19 +53,19 @@ mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError
 
 #if !defined(mingw32_HOST_OS)
 foreign import ccall unsafe "writev"
-  c_writev :: CInt -> Ptr IOVec -> CInt -> IO CSsize
+  c_writev :: CSocket -> Ptr IOVec -> CInt -> IO CSsize
 
 foreign import ccall unsafe "sendmsg"
-  c_sendmsg :: CInt -> Ptr (MsgHdr SockAddr) -> CInt -> IO CSsize
+  c_sendmsg :: CSocket -> Ptr (MsgHdr SockAddr) -> CInt -> IO CSsize
 
 foreign import ccall unsafe "recvmsg"
-  c_recvmsg :: CInt -> Ptr (MsgHdr SockAddr) -> CInt -> IO CSsize
+  c_recvmsg :: CSocket -> Ptr (MsgHdr SockAddr) -> CInt -> IO CSsize
 #else
   -- fixme Handle for SOCKET, see #426
 foreign import CALLCONV SAFE_ON_WIN "WSASend"
-  c_wsasend :: CInt -> Ptr WSABuf -> DWORD -> LPDWORD -> DWORD -> Ptr () -> Ptr () -> IO CInt
+  c_wsasend :: CSocket -> Ptr WSABuf -> DWORD -> LPDWORD -> DWORD -> Ptr () -> Ptr () -> IO CInt
 foreign import CALLCONV SAFE_ON_WIN "WSASendMsg"
-  c_sendmsg :: CInt -> Ptr (MsgHdr SockAddr) -> DWORD -> LPDWORD -> Ptr () -> Ptr ()  -> IO CInt
+  c_sendmsg :: CSocket -> Ptr (MsgHdr SockAddr) -> DWORD -> LPDWORD -> Ptr () -> Ptr ()  -> IO CInt
 foreign import CALLCONV SAFE_ON_WIN "WSARecvMsg"
-  c_recvmsg :: CInt -> Ptr (MsgHdr SockAddr) -> LPDWORD -> Ptr () -> Ptr () -> IO CInt
+  c_recvmsg :: CSocket -> Ptr (MsgHdr SockAddr) -> LPDWORD -> Ptr () -> Ptr () -> IO CInt
 #endif

Network/Socket/Syscall.hs

@@ -139,7 +139,7 @@ connect :: SocketAddress sa => Socket -> sa -> IO ()
 connect s sa = withSocketsDo $ withSocketAddress sa $ \p_sa sz ->
     connectLoop s p_sa (fromIntegral sz)
 
-connectLoop :: SocketAddress sa => Socket -> Ptr sa -> CInt -> IO ()
+connectLoop :: SocketAddress sa => Socket -> Ptr sa -> CSocket -> IO ()
 connectLoop s p_sa sz = withFdSocket s $ \fd -> loop fd
   where
     errLoc = "Network.Socket.connect: " ++ show s
@@ -223,31 +223,31 @@ accept listing_sock = withNewSocketAddress $ \new_sa sz ->
 #endif
 
 foreign import CALLCONV unsafe "socket"
-  c_socket :: CInt -> CInt -> CInt -> IO CInt
+  c_socket :: CInt -> CInt -> CInt -> IO CSocket
 foreign import CALLCONV unsafe "bind"
-  c_bind :: CInt -> Ptr sa -> CInt{-CSockLen???-} -> IO CInt
+  c_bind :: CSocket -> Ptr sa -> CInt{-CSockLen???-} -> IO CInt
 foreign import CALLCONV SAFE_ON_WIN "connect"
-  c_connect :: CInt -> Ptr sa -> CInt{-CSockLen???-} -> IO CInt
+  c_connect :: CSocket -> Ptr sa -> CInt{-CSockLen???-} -> IO CInt
 foreign import CALLCONV unsafe "listen"
-  c_listen :: CInt -> CInt -> IO CInt
+  c_listen :: CSocket -> CInt -> IO CInt
 
 #ifdef HAVE_ADVANCED_SOCKET_FLAGS
 foreign import CALLCONV unsafe "accept4"
-  c_accept4 :: CInt -> Ptr sa -> Ptr CInt{-CSockLen???-} -> CInt -> IO CInt
+  c_accept4 :: CSocket -> Ptr sa -> Ptr CInt{-CSockLen???-} -> CInt -> IO CSocket
 #else
 foreign import CALLCONV unsafe "accept"
-  c_accept :: CInt -> Ptr sa -> Ptr CInt{-CSockLen???-} -> IO CInt
+  c_accept :: CSocket -> Ptr sa -> Ptr CInt{-CSockLen???-} -> IO CSocket
 #endif
 
 #if defined(mingw32_HOST_OS)
 foreign import CALLCONV safe "accept"
-  c_accept_safe :: CInt -> Ptr sa -> Ptr CInt{-CSockLen???-} -> IO CInt
+  c_accept_safe :: CSocket -> Ptr sa -> Ptr CInt{-CSockLen???-} -> IO CSocket
 foreign import ccall unsafe "rtsSupportsBoundThreads"
   threaded :: Bool
 foreign import ccall unsafe "HsNet.h acceptNewSock"
-  c_acceptNewSock :: Ptr () -> IO CInt
+  c_acceptNewSock :: Ptr () -> IO CSocket
 foreign import ccall unsafe "HsNet.h newAcceptParams"
-  c_newAcceptParams :: CInt -> CInt -> Ptr a -> IO (Ptr ())
+  c_newAcceptParams :: CSocket -> CInt -> Ptr a -> IO (Ptr ())
 foreign import ccall unsafe "HsNet.h &acceptDoProc"
   c_acceptDoProc :: FunPtr (Ptr () -> IO Int)
 foreign import ccall unsafe "free"

Network/Socket/Types.hsc

@@ -14,6 +14,7 @@
 module Network.Socket.Types (
     -- * Socket type
       Socket
+    , CSocket
     , withFdSocket
     , unsafeFdSocket
     , touchSocket
@@ -103,8 +104,14 @@ import Network.Socket.ReadShow
 
 -----------------------------------------------------------------------------
 
+#if defined(mingw32_HOST_OS)
+type CSocket = SOCKET
+#else
+type CSocket = CInt
+#endif
+
 -- | Basic type for a socket.
-data Socket = Socket (IORef CInt) CInt {- for Show -}
+data Socket = Socket (IORef CSocket) CSocket {- for Show -}
 
 instance Show Socket where
     show (Socket _ ofd) = "<socket: " ++ show ofd ++ ">"
@@ -114,7 +121,7 @@ instance Eq Socket where
 
 {-# DEPRECATED fdSocket "Use withFdSocket or unsafeFdSocket instead" #-}
 -- | Currently, this is an alias of `unsafeFdSocket`.
-fdSocket :: Socket -> IO CInt
+fdSocket :: Socket -> IO CSocket
 fdSocket = unsafeFdSocket
 
 -- | Getting a file descriptor from a socket.
@@ -139,7 +146,7 @@ fdSocket = unsafeFdSocket
 --   'touchSocket' can be used for this purpose.
 --
 --   A safer option is to use 'withFdSocket' instead.
-unsafeFdSocket :: Socket -> IO CInt
+unsafeFdSocket :: Socket -> IO CSocket
 unsafeFdSocket (Socket ref _) = readIORef ref
 
 -- | Ensure that the given 'Socket' stays alive (i.e. not garbage-collected)
@@ -171,7 +178,7 @@ touch (IORef (STRef mutVar)) =
 -- descriptor.
 --
 -- Since: 3.1.0.0
-withFdSocket :: Socket -> (CInt -> IO r) -> IO r
+withFdSocket :: Socket -> (CSocket -> IO r) -> IO r
 withFdSocket (Socket ref _) f = do
   fd <- readIORef ref
   -- Should we throw an exception if the socket is already invalid?
@@ -187,7 +194,7 @@ withFdSocket (Socket ref _) f = do
 --   of unexpectedly being closed if the socket is finalized. It is
 --   now the caller's responsibility to ultimately close the
 --   duplicated file descriptor.
-socketToFd :: Socket -> IO CInt
+socketToFd :: Socket -> IO CSocket
 socketToFd s = do
 #if defined(mingw32_HOST_OS)
     fd <- unsafeFdSocket s
@@ -197,7 +204,7 @@ socketToFd s = do
     return fd2
 
 foreign import ccall unsafe "wsaDuplicate"
-   c_wsaDuplicate :: CInt -> IO CInt
+   c_wsaDuplicate :: CSocket -> IO CSocket
 #else
     fd <- unsafeFdSocket s
     -- FIXME: throw error no if -1
@@ -206,18 +213,18 @@ foreign import ccall unsafe "wsaDuplicate"
     return fd2
 
 foreign import ccall unsafe "dup"
-   c_dup :: CInt -> IO CInt
+   c_dup :: CSocket -> IO CSocket
 #endif
 
 -- | Creating a socket from a file descriptor.
-mkSocket :: CInt -> IO Socket
+mkSocket :: CSocket -> IO Socket
 mkSocket fd = do
     ref <- newIORef fd
     let s = Socket ref fd
     void $ mkWeakIORef ref $ close s
     return s
 
-invalidSocket :: CInt
+invalidSocket :: CSocket
 #if defined(mingw32_HOST_OS)
 invalidSocket = #const INVALID_SOCKET
 #else
@@ -226,8 +233,8 @@ invalidSocket = -1
 
 invalidateSocket ::
       Socket
-   -> (CInt -> IO a)
-   -> (CInt -> IO a)
+   -> (CSocket -> IO a)
+   -> (CSocket -> IO a)
    -> IO a
 invalidateSocket (Socket ref _) errorAction normalAction = do
     oldfd <- atomicModifyIORef' ref $ \cur -> (invalidSocket, cur)
@@ -246,7 +253,7 @@ close s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do
     -- closeFdWith avoids the deadlock of IO manager.
     closeFdWith closeFd (toFd oldfd)
   where
-    toFd :: CInt -> Fd
+    toFd :: CSocket -> Fd
     toFd = fromIntegral
     -- closeFd ignores the return value of c_close and
     -- does not throw exceptions
@@ -260,7 +267,7 @@ close' s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do
     -- closeFdWith avoids the deadlock of IO manager.
     closeFdWith closeFd (toFd oldfd)
   where
-    toFd :: CInt -> Fd
+    toFd :: CSocket -> Fd
     toFd = fromIntegral
     closeFd :: Fd -> IO ()
     closeFd fd = do
@@ -269,10 +276,10 @@ close' s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do
 
 #if defined(mingw32_HOST_OS)
 foreign import CALLCONV unsafe "closesocket"
-  c_close :: CInt -> IO CInt
+  c_close :: CSocket -> IO CInt
 #else
 foreign import ccall unsafe "close"
-  c_close :: CInt -> IO CInt
+  c_close :: CSocket -> IO CInt
 #endif
 
 -----------------------------------------------------------------------------