WIP : Basic WinIO support

.github/workflows/haskell.yml

@@ -16,7 +16,8 @@ jobs:
       fail-fast: false
       matrix:
         os: [ubuntu-latest, macOS-latest, windows-latest]
-        ghc: ['8.0', '8.2', '8.4', '8.6', '8.8', '8.10.4']
+        # ghc: ['8.0', '8.2', '8.4', '8.6', '8.8', '8.10.4', '9.0.1']
+        ghc: ['9.0.1']
         exclude:
         - os: windows-latest
           ghc: "8.0"
@@ -38,6 +39,10 @@ jobs:
           ghc: "8.6"
         - os: macOS-latest
           ghc: "8.8"
+        - os: macOS-latest
+          ghc: "9.0.1"
+        #- os: ubuntu-latest
+        #  ghc: "9.0.1"
 
     steps:
     - uses: actions/checkout@v2

CHANGELOG.md

@@ -1,3 +1,8 @@
+## Version 3.2.0.0
+
+* Basic support for WINIO
+  [#509](https://github.com/haskell/network/pull/509)
+
 ## Version 3.1.2.2
 
 * Allow bytestring 0.11

Network/Socket/Fcntl.hs

@@ -6,6 +6,10 @@ import qualified System.Posix.Internals
 
 #if !defined(mingw32_HOST_OS)
 import Network.Socket.Cbits
+#else
+# if defined(__IO_MANAGER_WINIO__)
+import GHC.IO.SubSystem ((<!>))
+# endif
 #endif
 import Network.Socket.Imports
 
@@ -46,12 +50,20 @@ getCloseOnExec fd = do
 #endif
 
 -- | Get the nonblocking flag.
---   On Windows, this function always returns 'False'.
+--   On Windows, this function always returns 'False' when using MIO but
+--   returns `True` when using WinIO.  Technically on Windows whether the
+--   the socket blocks or not is not determined by the socket itself but
+--   by the operations used on the socket.  Becuase we will always use
+--   overlapping I/O when WinIO is enabled we return `True` here.
 --
 --   Since 2.7.0.0.
 getNonBlock :: CInt -> IO Bool
 #if defined(mingw32_HOST_OS)
-getNonBlock _ = return False
+# if defined(__IO_MANAGER_WINIO__)
+getNonBlock _ = return False <!> return True
+# else
+getNonBlock _ = return False 
+# endif
 #else
 getNonBlock fd = do
     flags <- c_fcntl_read fd fGetFl 0

Network/Socket/Handle.hs

@@ -20,6 +20,7 @@ import Network.Socket.Types
 -- cooperate with peer's 'gracefulClose', i.e. proper shutdown
 -- sequence with appropriate handshakes specified by the protocol.
 
+-- TODO: WinIO doesn't use fd, add support
 socketToHandle :: Socket -> IOMode -> IO Handle
 socketToHandle s mode = invalidateSocket s err $ \oldfd -> do
     h <- fdToHandle' oldfd (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-}

cbits/cmsg.c

@@ -38,6 +38,9 @@ WSASendMsg (SOCKET s, LPWSAMSG lpMsg, DWORD flags,
     DWORD len;
     if (WSAIoctl(s, SIO_GET_EXTENSION_FUNCTION_POINTER,
         &WSASendMsgGUID, sizeof(WSASendMsgGUID), &ptr_SendMsg,
+        /* Sadly we can't perform this async for now as C code can't wait for
+           completion events from the Haskell RTS.  This needs to be moved to
+           Haskell on a re-designed async Network.  */
         sizeof(ptr_SendMsg), &len, NULL, NULL) != 0)
       return -1;
   }
@@ -58,6 +61,9 @@ WSARecvMsg (SOCKET s, LPWSAMSG lpMsg, LPDWORD lpdwNumberOfBytesRecvd,
     DWORD len;
     if (WSAIoctl(s, SIO_GET_EXTENSION_FUNCTION_POINTER,
         &WSARecvMsgGUID, sizeof(WSARecvMsgGUID), &ptr_RecvMsg,
+        /* Sadly we can't perform this async for now as C code can't wait for
+           completion events from the Haskell RTS.  This needs to be moved to
+           Haskell on a re-designed async Network.  */
         sizeof(ptr_RecvMsg), &len, NULL, NULL) != 0)
       return -1;
   }

network.cabal

@@ -1,6 +1,6 @@
 cabal-version:  1.18
 name:           network
-version:        3.1.2.2
+version:        3.2.0.0
 license:        BSD3
 license-file:   LICENSE
 maintainer:     Kazu Yamamoto, Evan Borden
@@ -124,9 +124,14 @@ library
     c-sources: cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c
     extra-libraries: ws2_32, iphlpapi, mswsock
     -- See https://github.com/haskell/network/pull/362
-    if impl(ghc >= 7.10)
+    if impl(ghc >= 7.10 && < 9.0)
       cpp-options: -D_WIN32_WINNT=0x0600
       cc-options: -D_WIN32_WINNT=0x0600
+    if impl(ghc >= 9.0)
+      cpp-options: -D_WIN32_WINNT=0x0601
+      cc-options: -D_WIN32_WINNT=0x0601
+      build-depends:
+        Win32 >= 2.12.0.0
 
 test-suite spec
   default-language: Haskell2010
@@ -141,6 +146,11 @@ test-suite spec
     Network.Socket.ByteString.LazySpec
   type: exitcode-stdio-1.0
   ghc-options: -Wall -threaded
+
+  -- On GHC's newer than 9 enable native IO managers
+  if impl(ghc >= 9.0)
+    ghc-options: -with-rtsopts=--io-manager=native
+
   -- NB: make sure to versions of hspec and hspec-discover
   --     that work together; easiest way is to constraint
   --     both packages to a small enough version range.