Execute shell commands in appropriate network namespace

Changelog: Execute shell commands in appropriate network namespace

1 files changed, 6 insertions, 2 deletions

diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index e107017..abef32d 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -7,6 +7,7 @@ module Run.Monad (
 
     finally,
     forkTest,
+    forkTestUsing,
 ) where
 
 import Control.Concurrent
@@ -110,9 +111,12 @@ finally act handler = do
     return x
 
 forkTest :: TestRun () -> TestRun ThreadId
-forkTest act = do
+forkTest = forkTestUsing forkIO
+
+forkTestUsing :: (IO () -> IO ThreadId) -> TestRun () -> TestRun ThreadId
+forkTestUsing fork act = do
     tenv <- ask
-    liftIO $ forkIO $ do
+    liftIO $ fork $ do
         runExceptT (flip runReaderT tenv $ fromTestRun act) >>= \case
             Left e -> atomically $ writeTVar (teFailed $ fst tenv) (Just e)
             Right () -> return ()