test: duplex communication over 2 SMP connections

tests/SMPClient.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module SMPClient where
 
@@ -14,20 +15,20 @@ import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
 import UnliftIO.IO
 
-testSMPClient :: MonadUnliftIO m => HostName -> ServiceName -> (Handle -> m a) -> m a
-testSMPClient host port client = do
-  threadDelay 1000 -- TODO hack: thread delay for SMP server to start
-  runTCPClient host port $ \h -> do
-    line <- getLn h
-    if line == "Welcome to SMP"
-      then client h
-      else error "not connected"
+testHost :: HostName
+testHost = "localhost"
 
 testPort :: ServiceName
 testPort = "5000"
 
-testHost :: HostName
-testHost = "localhost"
+testSMPClient :: MonadUnliftIO m => (Handle -> m a) -> m a
+testSMPClient client = do
+  threadDelay 5000 -- TODO hack: thread delay for SMP server to start
+  runTCPClient testHost testPort $ \h -> do
+    line <- getLn h
+    if line == "Welcome to SMP"
+      then client h
+      else error "not connected"
 
 cfg :: Config
 cfg =
@@ -38,12 +39,18 @@ cfg =
       msgIdBytes = 6
     }
 
+withSmpServer :: (MonadUnliftIO m, MonadRandom m) => m a -> m a
+withSmpServer = E.bracket (forkIO $ runSMPServer cfg) (liftIO . killThread) . const
+
 runSmpTest :: (MonadUnliftIO m, MonadRandom m) => (Handle -> m a) -> m a
-runSmpTest test =
-  E.bracket
-    (forkIO $ runSMPServer cfg)
-    (liftIO . killThread)
-    \_ -> testSMPClient "localhost" testPort test
+runSmpTest test = withSmpServer $ testSMPClient test
+
+runSmpTestN :: forall m a. (MonadUnliftIO m, MonadRandom m) => Int -> ([Handle] -> m a) -> m a
+runSmpTestN nClients test = withSmpServer $ run [] nClients
+  where
+    run :: [Handle] -> Int -> m a
+    run hs 0 = test hs
+    run hs n = testSMPClient $ \h -> run (h : hs) (n - 1)
 
 smpServerTest :: [RawTransmission] -> IO [RawTransmission]
 smpServerTest commands = runSmpTest \h -> mapM (sendReceive h) commands