Add experimental WinIO support

Another attempt at #364, #509, #602 with the following design choices:

1. On Windows systems, `Socket` becomes an `Either` over the existing
   "Posix" socket implemntation and a Windows equivalent using its
   `SOCKET` type.

2. On Posix systems, or without enabling the WinIO manager with
   `--io-manager=native`, the current behavior is unchanged.

3. *With* the WinIO manager, a greenfield implementation around the
   relevant syscalls is used, using IO Completion Ports
   (AKA "Overlapped IO") through GHC's `withOverlapped`

For the places we need to mux between the two
(`Network.Socket.Syscall`, `Network.Socket.Buffer`, etc.)
the existing implementation is moved into a `Posix.hsc`
and the WinIO one is defined in `WinIO.hsc`.

There's certainly some cleanup and style improvements that could be
done, but it passes all existing tests, and hopefully provides a clean
separation between the existing code (which can stay unchanged) and
direct use of Windows syscalls through `withOverlapped`.

Author: mrkline

Network/Socket/Buffer.hs

@@ -0,0 +1,80 @@
+{-# LANGUAGE CPP #-}
+
+#include "HsNetDef.h"
+
+module Network.Socket.Buffer (
+    sendBufTo
+  , sendBuf
+  , recvBufFrom
+  , recvBuf
+  , recvBufNoWait
+  , sendBufMsg
+  , recvBufMsg
+  ) where
+
+import Network.Socket.Imports
+import Network.Socket.Types
+import Network.Socket.Flag
+
+#if defined(mingw32_HOST_OS)
+import Network.Socket.Win32.CmsgHdr
+#else
+import Network.Socket.Posix.CmsgHdr
+#endif
+
+import qualified Network.Socket.Buffer.Posix as Posix
+#if defined(mingw32_HOST_OS)
+import qualified Network.Socket.Buffer.WinIO as Win
+#endif
+
+sendBufTo :: SocketAddress sa => Socket -> Ptr a -> Int -> sa -> IO Int
+#if defined(mingw32_HOST_OS)
+sendBufTo = eitherSocket Posix.sendBufTo Win.sendBufTo
+#else
+sendBufTo = Posix.sendBufTo
+#endif
+
+sendBuf :: Socket -> Ptr Word8 -> Int -> IO Int
+#if defined(mingw32_HOST_OS)
+sendBuf = eitherSocket Posix.sendBuf Win.sendBuf
+#else
+sendBuf = Posix.sendBuf
+#endif
+
+recvBufFrom :: SocketAddress sa => Socket -> Ptr a -> Int -> IO (Int, sa)
+#if defined(mingw32_HOST_OS)
+recvBufFrom = eitherSocket Posix.recvBufFrom Win.recvBufFrom
+#else
+recvBufFrom = Posix.recvBufFrom
+#endif
+
+recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int
+#if defined(mingw32_HOST_OS)
+recvBuf = eitherSocket Posix.recvBuf Win.recvBuf
+#else
+recvBuf = Posix.recvBuf
+#endif
+
+recvBufNoWait :: Socket -> Ptr Word8 -> Int -> IO Int
+#if defined(mingw32_HOST_OS)
+recvBufNoWait = eitherSocket Posix.recvBufNoWait Win.recvBufNoWait
+#else
+recvBufNoWait = Posix.recvBufNoWait
+#endif
+
+sendBufMsg :: SocketAddress sa
+           => Socket -> sa -> [(Ptr Word8,Int)] -> [Cmsg] -> MsgFlag -> IO Int
+#if defined(mingw32_HOST_OS)
+sendBufMsg = eitherSocket Posix.sendBufMsg Win.sendBufMsg
+#else
+sendBufMsg = Posix.sendBufMsg
+#endif
+
+recvBufMsg :: SocketAddress sa
+           => Socket -> [(Ptr Word8,Int)] -> Int -> MsgFlag
+           -> IO (sa,Int,[Cmsg],MsgFlag)
+#if defined(mingw32_HOST_OS)
+recvBufMsg = eitherSocket Posix.recvBufMsg Win.recvBufMsg
+#else
+recvBufMsg = Posix.recvBufMsg
+#endif

Network/Socket/Buffer.hsc Network/Socket/Buffer/Posix.hscNetwork/Socket/Buffer.hsc renamed to Network/Socket/Buffer/Posix.hsc

@@ -5,7 +5,7 @@
 #  include "windows.h"
 #endif
 
-module Network.Socket.Buffer (
+module Network.Socket.Buffer.Posix (
     sendBufTo
   , sendBuf
   , recvBufFrom
@@ -17,8 +17,6 @@ module Network.Socket.Buffer (
 
 #if !defined(mingw32_HOST_OS)
 import Foreign.C.Error (getErrno, eAGAIN, eWOULDBLOCK)
-#else
-import Foreign.Ptr (nullPtr)
 #endif
 import Foreign.Marshal.Alloc (alloca, allocaBytes)
 import Foreign.Marshal.Utils (with)
@@ -27,6 +25,7 @@ import System.IO.Error (mkIOError, ioeSetErrorString, catchIOError)
 
 #if defined(mingw32_HOST_OS)
 import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr)
+import qualified Network.Socket.Types as Generic
 import Network.Socket.Win32.CmsgHdr
 import Network.Socket.Win32.MsgHdr
 import Network.Socket.Win32.WSABuf
@@ -37,14 +36,45 @@ import Network.Socket.Posix.IOVec
 #endif
 
 import Network.Socket.Imports
+#if defined(mingw32_HOST_OS)
+import Network.Socket.Internal hiding (throwSocketErrorWaitRead, throwSocketErrorWaitWrite, throwSocketErrorWaitReadBut)
+#else
 import Network.Socket.Internal
-import Network.Socket.Name
-import Network.Socket.Types
+#endif
+import Network.Socket.Name (getPeerName)
+import Network.Socket.Types (
+    SocketAddress,
+    withSocketAddress,
+    withNewSocketAddress,
+    peekSocketAddress,
+    )
+import Network.Socket.Types.Posix
 import Network.Socket.Flag
 
 #if defined(mingw32_HOST_OS)
 type DWORD   = Word32
 type LPDWORD = Ptr DWORD
+
+-- On Windows, the generic throwSocketErrorWait* functions from Internal
+-- take the generic Socket type, not Posix.Socket. But on Windows these
+-- functions simply retry (the wait action is discarded), so the Socket
+-- parameter is unused. We define local versions for Posix.Socket.
+throwSocketErrorWaitRead :: (Eq a, Num a) => Socket -> String -> IO a -> IO a
+throwSocketErrorWaitRead _ = throwSocketErrorIfMinus1Retry
+
+throwSocketErrorWaitWrite :: (Eq a, Num a) => Socket -> String -> IO a -> IO a
+throwSocketErrorWaitWrite _ = throwSocketErrorIfMinus1Retry
+
+throwSocketErrorWaitReadBut :: (Eq a, Num a) => (CInt -> Bool) -> Socket -> String -> IO a -> IO a
+throwSocketErrorWaitReadBut exempt _ = throwSocketErrorIfMinus1ButRetry exempt
+
+-- getPeerName takes the generic Socket; wrap our Posix.Socket.
+getPeerName' :: SocketAddress sa => Socket -> IO sa
+getPeerName' s = getPeerName (Generic.Socket (Left s))
+#else
+-- On non-Windows, Socket = Posix.Socket, so the generic versions work.
+getPeerName' :: SocketAddress sa => Socket -> IO sa
+getPeerName' = getPeerName
 #endif
 
 -- | Send data to the socket.  The recipient can be specified
@@ -122,7 +152,7 @@ recvBufFrom s ptr nbytes
             len <- throwSocketErrorWaitRead s "Network.Socket.recvBufFrom" $
                      c_recvfrom fd ptr cnbytes flags ptr_sa ptr_len
             sockaddr <- peekSocketAddress ptr_sa
-                `catchIOError` \_ -> getPeerName s
+                `catchIOError` \_ -> getPeerName' s
             return (fromIntegral len, sockaddr)
 
 -- | Receive data from the socket.  The socket must be in a connected
@@ -290,11 +320,11 @@ recvBufMsg s bufsizs clen flags = do
                             c_recvmsg fd msgHdrPtr len_ptr nullPtr nullPtr
                     peek len_ptr
 #endif
-            sockaddr <- peekSocketAddress addrPtr `catchIOError` \_ -> getPeerName s
+            sockaddr <- peekSocketAddress addrPtr `catchIOError` \_ -> getPeerName' s
             hdr <- peek msgHdrPtr
-            cmsgs <- parseCmsgs msgHdrPtr
+            cmsgs' <- parseCmsgs msgHdrPtr
             let flags' = MsgFlag $ fromIntegral $ msgFlags hdr
-            return (sockaddr, len, cmsgs, flags')
+            return (sockaddr, len, cmsgs', flags')
 
 #if !defined(mingw32_HOST_OS)
 foreign import ccall unsafe "send"
@@ -321,4 +351,3 @@ foreign import CALLCONV SAFE_ON_WIN "sendto"
   c_sendto :: CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> CInt -> IO CInt
 foreign import CALLCONV SAFE_ON_WIN "recvfrom"
   c_recvfrom :: CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> Ptr CInt -> IO CInt
-