invalidating Socket in socketToHandle.

Network/Socket/Handle.hs

@@ -4,7 +4,6 @@ import qualified GHC.IO.Device (IODeviceType(Stream))
 import GHC.IO.Handle.FD (fdToHandle')
 import System.IO (IOMode(..), Handle, BufferMode(..), hSetBuffering)
 
-import Network.Socket.Imports
 import Network.Socket.Types
 
 -- | Turns a Socket into an 'Handle'. By default, the new handle is
@@ -17,8 +16,9 @@ import Network.Socket.Types
 -- on the 'Handle'.
 
 socketToHandle :: Socket -> IOMode -> IO Handle
-socketToHandle s mode = do
-    fd <- fromIntegral <$> fdSocket s
-    h <- fdToHandle' fd (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-}
+socketToHandle s mode = invalidateSocket s err $ \oldfd -> do
+    h <- fdToHandle' oldfd (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-}
     hSetBuffering h NoBuffering
     return h
+  where
+    err _ = ioError $ userError $ "socketToHandle: already a Handle"

Network/Socket/Types.hsc

@@ -10,6 +10,7 @@ module Network.Socket.Types (
       Socket
     , fdSocket
     , mkSocket
+    , invalidateSocket
     , close
     -- * Types of socket
     , SocketType(..)
@@ -97,15 +98,22 @@ mkSocket fd = do
     void $ mkWeakIORef ref $ close s
     return s
 
+invalidateSocket ::
+      Socket
+   -> (CInt -> IO a)
+   -> (CInt -> IO a)
+   -> IO a
+invalidateSocket (Socket ref) errorAction normalAction = do
+    oldfd <- atomicModifyIORef' ref $ \cur -> (-1, cur)
+    if oldfd == -1 then errorAction oldfd else normalAction oldfd
+
 -----------------------------------------------------------------------------
 
 -- | Close the socket. Sending data to or receiving data from closed socket
 --   may lead to undefined behaviour.
 close :: Socket -> IO ()
-close (Socket ref) = do
-    oldfd <- atomicModifyIORef' ref $ \cur -> (-1, cur)
-    when (oldfd /= -1) $
-        closeFdWith (void . c_close . fromIntegral) (fromIntegral oldfd)
+close s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do
+    closeFdWith (void . c_close . fromIntegral) (fromIntegral oldfd)
 
 #if defined(mingw32_HOST_OS)
 foreign import CALLCONV unsafe "closesocket"