Merge #3380

3380: cardano-ping: Make sure that the connection is reset by using SO_LINGER r=karknu a=karknu

The way the connection is torn down isn't ideal. Unless the 5s timeout
triggers the connection termination is initiated by the server which
can leave connections in TIME_WAIT.
In the future `ouroboros-network` will use SO_LINGER to trigger a reset
of the connection, but for now at least cardano-node can set it.

Co-authored-by: Karl Knutsson <karl.knutsson@iohk.io>

network-mux/demo/Linger.hsc

@@ -0,0 +1,32 @@
+#include "HsNet.h"
+
+module Linger
+  ( StructLinger (..)
+  ) where
+
+import           Foreign.C (CInt)
+import           Foreign.Storable (Storable (..))
+
+
+-- TODO: to be removed once a new version of `network` library is released.
+data StructLinger = StructLinger {
+    -- | Set the linger option on.
+    sl_onoff  :: CInt,
+
+    -- | Linger timeout.
+    sl_linger :: CInt
+  }
+  deriving (Eq, Ord, Show)
+
+instance Storable StructLinger where
+    sizeOf    _ = (#const sizeof(struct linger))
+    alignment _ = alignment (0 :: CInt)
+
+    peek p = do
+        onoff  <- (#peek struct linger, l_onoff) p
+        linger <- (#peek struct linger, l_linger) p
+        return $ StructLinger onoff linger
+
+    poke p (StructLinger onoff linger) = do
+        (#poke struct linger, l_onoff)  p onoff
+        (#poke struct linger, l_linger) p linger

network-mux/demo/cardano-ping.hs

@@ -40,6 +40,8 @@ import           Network.Mux.Bearer.Socket
 import           Network.Mux.Types
 import           Network.Mux.Timeout
 
+import           Linger
+
 mainnetMagic :: Word32
 mainnetMagic = 764824073
 
@@ -431,6 +433,12 @@ pingClient tracer Options{quiet, json, maxCount} versions peer = bracket
     (Socket.socket (Socket.addrFamily peer) Socket.Stream Socket.defaultProtocol)
     Socket.close
     (\sd -> withTimeoutSerial $ \timeoutfn -> do
+        when (Socket.addrFamily peer /= Socket.AF_UNIX) $ do
+            Socket.setSocketOption sd Socket.NoDelay 1
+            Socket.setSockOpt sd Socket.Linger
+                (StructLinger { sl_onoff  = 1
+                              , sl_linger = 0 })
+
         !t0_s <- getMonotonicTime
         Socket.connect sd (Socket.addrAddress peer)
         !t0_e <- getMonotonicTime

network-mux/network-mux.cabal

@@ -167,6 +167,7 @@ executable cardano-ping
   import:              demo-deps
   hs-source-dirs:      demo
   main-is:             cardano-ping.hs
+  other-modules:       Linger
   build-depends:       base,
                        aeson,
                        network-mux,

ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs

@@ -13,7 +13,7 @@
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Test.Ouroboros.Network.PeerSelection (tests) where
+module Test.Ouroboros.Network.PeerSelection (tests, unfHydra) where
 
 import qualified Data.ByteString.Char8 as BS
 import           Data.Function (on)
@@ -54,6 +54,9 @@ import           Test.QuickCheck.Signal
 import           Test.Tasty (TestTree, testGroup, after, DependencyType(..))
 import           Test.Tasty.QuickCheck (testProperty)
 
+-- Exactly as named.
+unfHydra :: Int
+unfHydra = 1
 
 tests :: TestTree
 tests =