From 46af29ab9c8d3fdb02bdc1fe05268e63743aafd0 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Tue, 26 Jun 2018 14:57:18 +0900
Subject: [PATCH 1/3] making "socket" exception-safe (#166).

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

diff --git a/Network/Socket/Syscall.hs b/Network/Socket/Syscall.hs
index b4c68558..96251ba2 100644
--- a/Network/Socket/Syscall.hs
+++ b/Network/Socket/Syscall.hs
@@ -82,7 +82,7 @@ socket family stype protocol = do
     fd <- throwSocketErrorIfMinus1Retry "Network.Socket.socket" $
               c_socket (packFamily family) c_stype' protocol
 #ifndef HAVE_ADVANCED_SOCKET_FLAGS
-    setNonBlockIfNeeded fd
+    setNonBlockIfNeeded fd `onException` c_close fd
 #endif
     s <- mkSocket fd
 #if HAVE_DECL_IPV6_V6ONLY
diff --git a/Network/Socket/Types.hsc b/Network/Socket/Types.hsc
index 8f29699a..d4a675be 100644
--- a/Network/Socket/Types.hsc
+++ b/Network/Socket/Types.hsc
@@ -13,6 +13,7 @@ module Network.Socket.Types (
     , mkSocket
     , invalidateSocket
     , close
+    , c_close
     -- * Types of socket
     , SocketType(..)
     , isSupportedSocketType

From 330e9f0d7c97b2f8c34708412c98d7a6fedaa8af Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Tue, 26 Jun 2018 15:06:40 +0900
Subject: [PATCH 2/3] refactoring.

---
 Network/Socket/Syscall.hs | 32 +++++++++++++++++++++-----------
 1 file changed, 21 insertions(+), 11 deletions(-)

diff --git a/Network/Socket/Syscall.hs b/Network/Socket/Syscall.hs
index 96251ba2..66bbf0ff 100644
--- a/Network/Socket/Syscall.hs
+++ b/Network/Socket/Syscall.hs
@@ -73,20 +73,29 @@ socket :: Family         -- Family Name (usually AF_INET)
        -> ProtocolNumber -- Protocol Number (getProtocolByName to find value)
        -> IO Socket      -- Unconnected Socket
 socket family stype protocol = do
-    c_stype <- packSocketTypeOrThrow "socket" stype
+    c_stype <- modifyFlag <$> packSocketTypeOrThrow "socket" stype
+    fd <- throwSocketErrorIfMinus1Retry "Network.Socket.socket" $
+              c_socket (packFamily family) c_stype protocol
+    setNonBlock fd `onException` c_close fd
+    s <- mkSocket fd
+    unsetIPv6Only s `onException` close s
+    return s
+  where
+
 #ifdef HAVE_ADVANCED_SOCKET_FLAGS
-    let c_stype' = c_stype .|. sockNonBlock
+    modifyFlag c_stype = c_stype .|. sockNonBlock
 #else
-    let c_stype' = c_stype
+    modifyFlag c_stype = c_stype
 #endif
-    fd <- throwSocketErrorIfMinus1Retry "Network.Socket.socket" $
-              c_socket (packFamily family) c_stype' protocol
-#ifndef HAVE_ADVANCED_SOCKET_FLAGS
-    setNonBlockIfNeeded fd `onException` c_close fd
+
+#ifdef HAVE_ADVANCED_SOCKET_FLAGS
+    setNonBlock _ = return ()
+#else
+    setNonBlock fd = setNonBlockIfNeeded fd
 #endif
-    s <- mkSocket fd
+
 #if HAVE_DECL_IPV6_V6ONLY
-    when (family == AF_INET6 && stype `elem` [Stream, Datagram]) $
+    unsetIPv6Only s = when (family == AF_INET6 && stype `elem` [Stream, Datagram]) $
 # if defined(mingw32_HOST_OS)
       -- The IPv6Only option is only supported on Windows Vista and later,
       -- so trying to change it might throw an error.
@@ -97,10 +106,11 @@ socket family stype protocol = do
 # else
       -- The default value of the IPv6Only option is platform specific,
       -- so we explicitly set it to 0 to provide a common default.
-      setSocketOption s IPv6Only 0 `onException` close s
+      setSocketOption s IPv6Only 0
 # endif
+#else
+    unsetIPv6Only _ = return ()
 #endif
-    return s
 
 -----------------------------------------------------------------------------
 -- Binding a socket

From 7194db7e1f5e732c278fda0982671c3dbe383328 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Tue, 26 Jun 2018 15:33:18 +0900
Subject: [PATCH 3/3] fixing import.

---
 Network/Socket/Syscall.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/Network/Socket/Syscall.hs b/Network/Socket/Syscall.hs
index 66bbf0ff..90314c17 100644
--- a/Network/Socket/Syscall.hs
+++ b/Network/Socket/Syscall.hs
@@ -6,15 +6,14 @@
 module Network.Socket.Syscall where
 
 import Foreign.Marshal.Utils (with)
+import qualified Control.Exception as E
 
 #if defined(mingw32_HOST_OS)
-import qualified Control.Exception as E
 import Foreign (FunPtr)
 import GHC.Conc (asyncDoProc)
 #else
 import Foreign.C.Error (getErrno, eINTR, eINPROGRESS)
 import GHC.Conc (threadWaitWrite)
-import GHC.IO (onException)
 #endif
 
 #ifdef HAVE_ADVANCED_SOCKET_FLAGS
@@ -76,9 +75,9 @@ socket family stype protocol = do
     c_stype <- modifyFlag <$> packSocketTypeOrThrow "socket" stype
     fd <- throwSocketErrorIfMinus1Retry "Network.Socket.socket" $
               c_socket (packFamily family) c_stype protocol
-    setNonBlock fd `onException` c_close fd
+    setNonBlock fd `E.onException` c_close fd
     s <- mkSocket fd
-    unsetIPv6Only s `onException` close s
+    unsetIPv6Only s `E.onException` close s
     return s
   where