subscription: configure sockets

Use `Ouroboros.Network.Socket.configureSocket` to configure outbound
sockets.

Author: coot

ouroboros-network-framework/src/Ouroboros/Network/Subscription/Client.hs

@@ -58,6 +58,7 @@ clientSubscriptionWorker snocket
            nmsConnectionTable
            nmsPeerStates
            snocket
+           mempty
            WorkerCallbacks
             { wcSocketStateChangeTx   = socketStateChangeTx
             , wcCompleteApplicationTx = completeApplicationTx cspErrorPolicies

ouroboros-network-framework/src/Ouroboros/Network/Subscription/Ip.hs

@@ -203,6 +203,7 @@ subscriptionWorker snocket
            nmsConnectionTable
            nmsPeerStates
            snocket
+           ((. Just) <$> configureSocket)
            WorkerCallbacks
              { wcSocketStateChangeTx   = socketStateChangeTx
              , wcCompleteApplicationTx = completeApplicationTx errorPolicies

ouroboros-network-framework/src/Ouroboros/Network/Subscription/Worker.hs

@@ -152,6 +152,7 @@ safeConnect :: ( MonadThrow m
                , MonadMask m
                )
             => Snocket m sock addr
+            -> (sock -> addr -> m ()) -- ^ configure the socket
             -> addr
             -- ^ remote addr
             -> addr
@@ -167,7 +168,7 @@ safeConnect :: ( MonadThrow m
             -- masked; it receives: unmask function, allocated socket and
             -- connection error.
             -> m t
-safeConnect sn remoteAddr localAddr malloc mclean k =
+safeConnect sn configureSock remoteAddr localAddr malloc mclean k =
     bracket
       (do sock <- Snocket.open sn (Snocket.addrFamily sn remoteAddr)
           malloc
@@ -176,6 +177,7 @@ safeConnect sn remoteAddr localAddr malloc mclean k =
       (\sock -> Snocket.close sn sock >> mclean)
       (\sock -> mask $ \unmask -> do
           res <- try $ do
+            configureSock sock localAddr
             let doBind = case Snocket.addrFamily sn localAddr of
                               Snocket.SocketFamily fam -> fam /= AF_UNIX
                               _                        -> False -- Bind is a nop for Named Pipes anyway
@@ -224,6 +226,7 @@ subscriptionLoop
     -> ThreadsVar          m
 
     -> Snocket             m sock addr
+    -> (sock -> addr -> m ())
 
     -> WorkerCallbacks m s addr a x
     -> WorkerParams m localAddrs addr
@@ -232,7 +235,7 @@ subscriptionLoop
     -- ^ application
     -> m Void
 subscriptionLoop
-      tr tbl resQ sVar threadsVar snocket
+      tr tbl resQ sVar threadsVar snocket configureSock
       WorkerCallbacks { wcSocketStateChangeTx   = socketStateChangeTx
                       , wcCompleteApplicationTx = completeApplicationTx
                       }
@@ -344,6 +347,7 @@ subscriptionLoop
                     -- this bracket.
                     safeConnect
                       snocket
+                      configureSock
                       remoteAddr
                       localAddr
                       (do
@@ -558,18 +562,19 @@ worker
     -> StateVar            IO s
 
     -> Snocket             IO sock addr
+    -> (sock -> addr -> IO ())
 
     -> WorkerCallbacks     IO s addr a x
     -> WorkerParams        IO   localAddrs addr
 
     -> (sock -> IO a)
     -- ^ application
     -> IO x
-worker tr errTrace tbl sVar snocket workerCallbacks@WorkerCallbacks {wcCompleteApplicationTx, wcMainTx } workerParams k = do
+worker tr errTrace tbl sVar snocket configureSock workerCallbacks@WorkerCallbacks {wcCompleteApplicationTx, wcMainTx } workerParams k = do
     resQ <- newResultQ
     threadsVar <- newTVarIO Set.empty
     withAsync
-      (subscriptionLoop tr tbl resQ sVar threadsVar snocket
+      (subscriptionLoop tr tbl resQ sVar threadsVar snocket configureSock
          workerCallbacks workerParams k) $ \_ ->
            mainLoop errTrace resQ threadsVar sVar wcCompleteApplicationTx wcMainTx
            `finally` killThreads threadsVar

ouroboros-network-framework/test/Test/Ouroboros/Network/Subscription.hs

@@ -22,6 +22,7 @@ import           Control.Monad.Class.MonadTime
 import           Control.Monad.Class.MonadTimer
 import           Control.Monad.IOSim (runSimStrictShutdown)
 import           Control.Tracer
+import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy as BL
 import           Data.Functor (void)
 import qualified Data.IP as IP
@@ -120,8 +121,8 @@ tests =
         -- the above tests takes about 10 minutes to run due to delays in
         -- realtime.
         , testProperty "Resolve Subscribe (IO)" prop_sub_io
-        , testProperty "Send Recive with Dns worker (IO)" prop_send_recv
-        , testProperty "Send Recieve with IP worker, Initiator and responder (IO)"
+        , testProperty "Send Receive with Dns worker (IO)" prop_send_recv
+        , testProperty "Send Receive with IP worker, Initiator and responder (IO)"
                prop_send_recv_init_and_rsp
         -- , testProperty "subscription demo" _demo
         ]
@@ -917,7 +918,7 @@ instance (Show a) => Show (WithThreadAndTime a) where
         printf "%s: %s: %s" (show wtatOccuredAt) (show wtatWithinThread) (show wtatEvent)
 
 _verboseTracer :: Show a => Tracer IO a
-_verboseTracer = threadAndTimeTracer $ showTracing stdoutTracer
+_verboseTracer = threadAndTimeTracer $ Tracer (BSC.putStrLn . BSC.pack . show)
 
 threadAndTimeTracer :: Tracer IO (WithThreadAndTime a) -> Tracer IO a
 threadAndTimeTracer tr = Tracer $ \s -> do

ouroboros-network/test/Test/PeerState.hs

@@ -359,6 +359,7 @@ prop_subscriptionWorker
              tbl
              peerStatesVar
              (mkSnocket sockType localAddr remoteAddr)
+             mempty
              WorkerCallbacks {
                  wcSocketStateChangeTx = \ss s -> do
                    s' <- socketStateChangeTx ss s