From 72729e4505b27894d83493b9be6215d0763be4e2 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Tue, 3 Sep 2019 12:00:29 +0900
Subject: [PATCH 1/3] implementing socketToFd

---
 Network/Socket.hs        |  1 +
 Network/Socket/Types.hsc | 13 +++++++++++++
 2 files changed, 14 insertions(+)

diff --git a/Network/Socket.hs b/Network/Socket.hs
index fd6743ae..22db4aea 100644
--- a/Network/Socket.hs
+++ b/Network/Socket.hs
@@ -141,6 +141,7 @@ module Network.Socket
     , withFdSocket
     , unsafeFdSocket
     , touchSocket
+    , socketToFd
     , fdSocket
     , mkSocket
     , socketToHandle
diff --git a/Network/Socket/Types.hsc b/Network/Socket/Types.hsc
index 2ec6d263..ab4d4ebf 100644
--- a/Network/Socket/Types.hsc
+++ b/Network/Socket/Types.hsc
@@ -14,6 +14,7 @@ module Network.Socket.Types (
     , withFdSocket
     , unsafeFdSocket
     , touchSocket
+    , socketToFd
     , fdSocket
     , mkSocket
     , invalidateSocket
@@ -166,6 +167,18 @@ withFdSocket (Socket ref _) f = do
   touch ref
   return r
 
+-- | Socket is closed and a duplicated file descriptor is returned.
+socketToFd :: Socket -> IO CInt
+socketToFd s = do
+    fd <- unsafeFdSocket s
+    -- FIXME: throw error no if -1
+    fd2 <- c_dup fd
+    close s
+    return fd2
+
+foreign import ccall unsafe "dup"
+   c_dup :: CInt -> IO CInt
+
 -- | Creating a socket from a file descriptor.
 mkSocket :: CInt -> IO Socket
 mkSocket fd = do

From d0bba03c254af47800dddf7d41d5bc5c75b7bdf6 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Thu, 5 Sep 2019 12:16:33 +0900
Subject: [PATCH 2/3] suggestion for doc from vdukhovni.

---
 Network/Socket/Types.hsc | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/Network/Socket/Types.hsc b/Network/Socket/Types.hsc
index ab4d4ebf..54b87449 100644
--- a/Network/Socket/Types.hsc
+++ b/Network/Socket/Types.hsc
@@ -168,6 +168,10 @@ withFdSocket (Socket ref _) f = do
   return r
 
 -- | Socket is closed and a duplicated file descriptor is returned.
+--   The duplicated descriptor is no longer subject to the possibility
+--   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 s = do
     fd <- unsafeFdSocket s

From 27d981574fbc814050a02e8ee9dc9df430372f30 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Wed, 18 Sep 2019 08:42:16 +0900
Subject: [PATCH 3/3] Supporting socket2fd on Windows

Credit: Tamar Christina <tamar@zhox.com>
---
 Network/Socket/Types.hsc    | 11 +++++++++++
 cbits/initWinSock.c         | 15 +++++++++++++++
 tests/Network/SocketSpec.hs | 10 ++++++++++
 3 files changed, 36 insertions(+)

diff --git a/Network/Socket/Types.hsc b/Network/Socket/Types.hsc
index 54b87449..bcb42950 100644
--- a/Network/Socket/Types.hsc
+++ b/Network/Socket/Types.hsc
@@ -174,6 +174,16 @@ withFdSocket (Socket ref _) f = do
 --   duplicated file descriptor.
 socketToFd :: Socket -> IO CInt
 socketToFd s = do
+#if defined(mingw32_HOST_OS)
+    fd <- unsafeFdSocket s
+    fd2 <- c_wsaDuplicate fd
+    -- FIXME: throw error no if -1
+    close s
+    return fd2
+
+foreign import ccall unsafe "wsaDuplicate"
+   c_wsaDuplicate :: CInt -> IO CInt
+#else
     fd <- unsafeFdSocket s
     -- FIXME: throw error no if -1
     fd2 <- c_dup fd
@@ -182,6 +192,7 @@ socketToFd s = do
 
 foreign import ccall unsafe "dup"
    c_dup :: CInt -> IO CInt
+#endif
 
 -- | Creating a socket from a file descriptor.
 mkSocket :: CInt -> IO Socket
diff --git a/cbits/initWinSock.c b/cbits/initWinSock.c
index e2e8008c..e720b852 100644
--- a/cbits/initWinSock.c
+++ b/cbits/initWinSock.c
@@ -40,4 +40,19 @@ initWinSock ()
   return 0;
 }
 
+SOCKET
+wsaDuplicate (SOCKET s)
+{
+  WSAPROTOCOL_INFOW protocolInfo;
+  if (WSADuplicateSocketW (s, GetCurrentProcessId (), &protocolInfo) != 0)
+    return -1;
+
+  SOCKET res = WSASocketW(FROM_PROTOCOL_INFO, FROM_PROTOCOL_INFO,
+                          FROM_PROTOCOL_INFO, &protocolInfo, 0, 0);
+  if (res == SOCKET_ERROR)
+    return -1;
+
+  return res;
+}
+
 #endif
diff --git a/tests/Network/SocketSpec.hs b/tests/Network/SocketSpec.hs
index 262a412f..9bea422b 100644
--- a/tests/Network/SocketSpec.hs
+++ b/tests/Network/SocketSpec.hs
@@ -209,3 +209,13 @@ spec = do
                     threadDelay 10000
                     void $ recv sock 1024
             tcpTest client server
+
+    describe "socketToFd" $ do
+        it "socketToFd can send using fd" $ do
+            let server sock = do
+                    void $ recv sock 1024
+                client sock = do
+                    fd <- socketToFd sock
+                    s <- mkSocket fd
+                    sendAll s "HELLO WORLD"
+            tcpTest client server