From e898cb1a1e748a5575671b9d0f7b174f550f85ff Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 12 Nov 2026 07:40:58 +0900 Subject: [PATCH 1/3] Give Winsock errors the IOErrorType of their errno On Windows every socket error was OtherError. Each Winsock code now gets what errnoToIOError gives the errno of the same name, so a reset is ResourceVanished as on POSIX. WSAEINTR stays OtherError: it is what closesocket gives a blocked call, not an interrupt. Co-Authored-By: Claude Opus 5.5 --- Network/Socket/Cbits.hsc | 48 +++++++++++++++++++++++++++++++++++++ Network/Socket/Internal.hs | 7 +++--- Network/Socket/Wait.hs | 5 ++-- tests/Network/SocketSpec.hs | 12 +++++++++- 4 files changed, 66 insertions(+), 6 deletions(-) diff --git a/Network/Socket/Cbits.hsc b/Network/Socket/Cbits.hsc index 91a60cad..c1195db5 100644 --- a/Network/Socket/Cbits.hsc +++ b/Network/Socket/Cbits.hsc @@ -3,6 +3,9 @@ module Network.Socket.Cbits where #include "HsNet.h" import Network.Socket.Imports +#if defined(mingw32_HOST_OS) +import GHC.IO.Exception (IOErrorType (..)) +#endif -- | This is the value of SOMAXCONN, typically 128. -- 128 is good enough for normal network servers but @@ -41,6 +44,51 @@ wsaEHOSTUNREACH :: CInt wsaEHOSTUNREACH = #const WSAEHOSTUNREACH wsaENOPROTOOPT :: CInt wsaENOPROTOOPT = #const WSAENOPROTOOPT +-- | The 'IOErrorType' which 'Foreign.C.Error.errnoToIOError' gives the +-- errno of the same name. WSAEINTR stays 'OtherError': on Windows it +-- is what closesocket gives a blocked call, not an interrupt. +winsockErrorType :: CInt -> IOErrorType +winsockErrorType rc = case rc of + #{const WSAEACCES} -> PermissionDenied + #{const WSAEADDRINUSE} -> ResourceBusy + #{const WSAEADDRNOTAVAIL} -> UnsupportedOperation + #{const WSAEAFNOSUPPORT} -> UnsupportedOperation + #{const WSAEALREADY} -> AlreadyExists + #{const WSAEBADF} -> InvalidArgument + #{const WSAECONNREFUSED} -> NoSuchThing + #{const WSAECONNRESET} -> ResourceVanished + #{const WSAEDESTADDRREQ} -> InvalidArgument + #{const WSAEDQUOT} -> PermissionDenied + #{const WSAEHOSTDOWN} -> NoSuchThing + #{const WSAEHOSTUNREACH} -> NoSuchThing + #{const WSAEINPROGRESS} -> AlreadyExists + #{const WSAEINVAL} -> InvalidArgument + #{const WSAEISCONN} -> AlreadyExists + #{const WSAELOOP} -> InvalidArgument + #{const WSAEMFILE} -> ResourceExhausted + #{const WSAEMSGSIZE} -> ResourceExhausted + #{const WSAENAMETOOLONG} -> InvalidArgument + #{const WSAENETDOWN} -> ResourceVanished + #{const WSAENETRESET} -> ResourceVanished + #{const WSAENETUNREACH} -> NoSuchThing + #{const WSAENOBUFS} -> ResourceExhausted + #{const WSAENOPROTOOPT} -> UnsupportedOperation + #{const WSAENOTCONN} -> InvalidArgument + #{const WSAENOTEMPTY} -> UnsatisfiedConstraints + #{const WSAENOTSOCK} -> InvalidArgument + #{const WSAEOPNOTSUPP} -> UnsupportedOperation + #{const WSAEPFNOSUPPORT} -> UnsupportedOperation + #{const WSAEPROCLIM} -> PermissionDenied + #{const WSAEPROTONOSUPPORT} -> ProtocolError + #{const WSAEPROTOTYPE} -> ProtocolError + #{const WSAEREMOTE} -> IllegalOperation + #{const WSAESHUTDOWN} -> IllegalOperation + #{const WSAESOCKTNOSUPPORT} -> UnsupportedOperation + #{const WSAESTALE} -> ResourceVanished + #{const WSAETIMEDOUT} -> TimeExpired + #{const WSAETOOMANYREFS} -> ResourceExhausted + #{const WSAEUSERS} -> ResourceExhausted + _ -> OtherError #else fGetFd :: CInt fGetFd = #const F_GETFD diff --git a/Network/Socket/Internal.hs b/Network/Socket/Internal.hs index 2959463c..e3f6661c 100644 --- a/Network/Socket/Internal.hs +++ b/Network/Socket/Internal.hs @@ -154,14 +154,15 @@ throwSocketError = throwErrno -- | Like 'throwSocketError', but the error code is supplied as an argument. -- -- On Windows the code is a Winsock error code rather than an errno. It --- is kept in 'ioe_errno' all the same: Winsock reports every error as --- 'OtherError', so the code is the only thing which tells them apart. +-- is kept in 'ioe_errno' all the same, and the error type is the one +-- the errno of the same name has elsewhere. throwSocketErrorCode :: String -> CInt -> IO a #if defined(mingw32_HOST_OS) throwSocketErrorCode name rc = do pstr <- c_getWSError rc str <- peekCString pstr - let ioe = (mkIOError OtherError name Nothing Nothing){ioe_errno = Just rc} + let typ = winsockErrorType rc + ioe = (mkIOError typ name Nothing Nothing){ioe_errno = Just rc} ioError (ioeSetErrorString ioe str) #else throwSocketErrorCode loc errno = diff --git a/Network/Socket/Wait.hs b/Network/Socket/Wait.hs index c2bd9866..fb9d6382 100644 --- a/Network/Socket/Wait.hs +++ b/Network/Socket/Wait.hs @@ -363,8 +363,9 @@ isTransientAcceptError e = -- earlier send of its own came back as an ICMP port unreachable. -- -- POSIX gives it as @ECONNREFUSED@ and Winsock as @WSAECONNRESET@, so --- the error type differs (@NoSuchThing@ and @OtherError@); this reads --- the code instead. Only a connected socket hears it on any platform. +-- the error type differs (@NoSuchThing@ and @ResourceVanished@); this +-- reads the code instead. Only a connected socket hears it on any +-- platform. -- -- @since 3.2.12.0 isPortUnreachableError :: E.IOException -> Bool diff --git a/tests/Network/SocketSpec.hs b/tests/Network/SocketSpec.hs index 813f08aa..5de6965c 100644 --- a/tests/Network/SocketSpec.hs +++ b/tests/Network/SocketSpec.hs @@ -19,7 +19,8 @@ import Foreign.C.Types () import Network.Socket import Network.Socket.ByteString import Network.Test.Common -import System.IO.Error (tryIOError) +import GHC.IO.Exception (IOErrorType (ResourceVanished)) +import System.IO.Error (ioeGetErrorType, tryIOError) import System.IO.Temp (withSystemTempDirectory) import System.Mem (performGC) import System.Posix.Types (Fd(..)) @@ -378,6 +379,15 @@ spec = do it "is heard by a connected one through recvMsg" $ bounceWith recvMsg' connectSend `shouldThrow` isPortUnreachableError + describe "a connection the peer resets" $ do + it "is reported as ResourceVanished" $ do + let server sock = setSockOpt sock Linger (StructLinger 1 0) + -- Plain recv on Windows reads through GHC's IO manager, + -- which does not go by the Winsock code. + client sock = recvWith sock 1024 retry `shouldThrow` isVanished + isVanished e = ioeGetErrorType e == ResourceVanished + tcpTest client server + describe "gracefulClose" $ do it "does not send TCP RST back" $ do let server sock = do From bcc91308614b534a03acd4edf68bbe55a93f01b3 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Fri, 13 Nov 2026 16:15:50 +0900 Subject: [PATCH 2/3] Drop the import #632 left unused on Windows Co-Authored-By: Claude Opus 5.5 --- Network/Socket/Internal.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/Network/Socket/Internal.hs b/Network/Socket/Internal.hs index e3f6661c..ace6a38b 100644 --- a/Network/Socket/Internal.hs +++ b/Network/Socket/Internal.hs @@ -61,11 +61,6 @@ import GHC.Conc (threadWaitRead, threadWaitWrite) #if defined(mingw32_HOST_OS) import qualified Control.Exception as E import System.IO.Unsafe (unsafePerformIO) -# if __GLASGOW_HASKELL__ >= 707 -import GHC.IO.Exception (IOErrorType(..)) -# else -import GHC.IOBase (IOErrorType(..)) -# endif import System.IO.Error (ioeSetErrorString, mkIOError) #else import Foreign.C.Error (throwErrno, throwErrnoIfMinus1Retry, From ef49e5382b91b20806c57757d629650ddf2022c6 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Fri, 13 Nov 2026 16:24:43 +0900 Subject: [PATCH 3/3] Reset the connection only once it is up, in the test An RST which beat the client's connect failed the connect itself on Linux, before recvWith was reached. Co-Authored-By: Claude Opus 5.5 --- tests/Network/SocketSpec.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/tests/Network/SocketSpec.hs b/tests/Network/SocketSpec.hs index 5de6965c..82228beb 100644 --- a/tests/Network/SocketSpec.hs +++ b/tests/Network/SocketSpec.hs @@ -381,10 +381,16 @@ spec = do describe "a connection the peer resets" $ do it "is reported as ResourceVanished" $ do - let server sock = setSockOpt sock Linger (StructLinger 1 0) + -- The byte makes the reset follow the connect: an RST which + -- beat it would fail the connect itself on Linux. + let server sock = do + void $ recv sock 1 + setSockOpt sock Linger (StructLinger 1 0) -- Plain recv on Windows reads through GHC's IO manager, -- which does not go by the Winsock code. - client sock = recvWith sock 1024 retry `shouldThrow` isVanished + client sock = do + sendAll sock "x" + recvWith sock 1024 retry `shouldThrow` isVanished isVanished e = ioeGetErrorType e == ResourceVanished tcpTest client server