diff --git a/demos/demo-processes/app/Main.hs b/demos/demo-processes/app/Main.hs
index 81080c2f..e0d17a9f 100644
--- a/demos/demo-processes/app/Main.hs
+++ b/demos/demo-processes/app/Main.hs
@@ -17,19 +17,19 @@ import Test.Sandwich
 parallelNDemo :: TopSpec
 parallelNDemo = describe "Creating processes with logging" $ do
   it "createProcessWithLogging" $ do
-    p <- createProcessWithLogging (shell "echo hiiiiii")
+    (p, _) <- createProcessWithLogging (shell "echo hiiiiii")
     liftIO (waitForProcess p) >>= (`shouldBe` ExitSuccess)
 
   it "createProcessWithLogging'" $ do
-    p <- createProcessWithLogging' LevelDebug (shell "echo hiiiiii")
+    (p, _) <- createProcessWithLogging' LevelDebug (shell "echo hiiiiii")
     liftIO (waitForProcess p) >>= (`shouldBe` ExitSuccess)
 
   it "createProcessWithLoggingAndStdin" $ do
-    p <- createProcessWithLoggingAndStdin (shell "echo hiiiiii") ""
+    (p, _) <- createProcessWithLoggingAndStdin (shell "echo hiiiiii") ""
     liftIO (waitForProcess p) >>= (`shouldBe` ExitSuccess)
 
   it "createProcessWithLoggingAndStdin'" $ do
-    p <- createProcessWithLoggingAndStdin' LevelDebug (shell "echo hiiiiii") ""
+    (p, _) <- createProcessWithLoggingAndStdin' LevelDebug (shell "echo hiiiiii") ""
     liftIO (waitForProcess p) >>= (`shouldBe` ExitSuccess)
 
   it "readCreateProcessWithLogging" $ do
diff --git a/demos/demo-stress/app/Main.hs b/demos/demo-stress/app/Main.hs
new file mode 100644
index 00000000..24897547
--- /dev/null
+++ b/demos/demo-stress/app/Main.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Main where
+
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.String.Interpolate
+import Data.Text (Text)
+import System.Random
+import Test.Sandwich
+
+
+-- | 400 test nodes running in parallel, each generating a few hundred log lines
+-- over ~5 minutes total. Designed to stress-test the TUI's memory behavior
+-- when all tests finish and statuses stabilize.
+stressSpec :: TopSpec
+stressSpec = parallel $ do
+  forM_ [(1 :: Int)..20] $ \nodeId ->
+    it [i|test #{nodeId}|] $ stressTest nodeId
+
+stressTest :: Int -> ExampleM context ()
+stressTest nodeId = do
+  gen <- liftIO $ newStdGen
+  -- Each test generates 100-300 log lines
+  let logCount = 100 + (nodeId * 47 `mod` 200)
+  -- Spread the work over the 5-minute window.
+  -- Total run time per test: ~4-5 minutes with jitter.
+  let baseSleepUs = (5 * 60 * 100000) `div` logCount
+  go gen logCount baseSleepUs (1 :: Int)
+  where
+    go _ 0 _ _ = return ()
+    go gen remaining baseSleepUs lineNum = do
+      let (jitter, gen') = uniformR (0, baseSleepUs `div` 2) gen
+      let sleepUs = baseSleepUs + jitter - (baseSleepUs `div` 4)
+      liftIO $ threadDelay sleepUs
+      -- Generate log lines of varying verbosity
+      let msg = makeLogMessage nodeId lineNum
+      case lineNum `mod` 4 of
+        0 -> debug msg
+        1 -> info msg
+        2 -> warn msg
+        _ -> debug msg
+      go gen' (remaining - 1) baseSleepUs (lineNum + 1)
+
+makeLogMessage :: Int -> Int -> Text
+makeLogMessage nodeId lineNum =
+  let padding = replicate ((nodeId + lineNum) `mod` 80 + 20) '='
+  in [i|[node=#{nodeId} line=#{lineNum}] Processing step #{lineNum}: #{padding} status=ok detail=#{detail lineNum}|]
+  where
+    detail n
+      | n `mod` 10 == 0 = "checkpoint reached, flushing buffers and syncing state across all connected peers" :: Text
+      | n `mod` 7 == 0 = "retrying operation after transient failure on upstream dependency"
+      | n `mod` 5 == 0 = "cache miss, fetching from backing store"
+      | n `mod` 3 == 0 = "validating intermediate result set"
+      | otherwise = "nominal"
+
+main :: IO ()
+main = runSandwichWithCommandLineArgs options stressSpec
+  where
+    options = defaultOptions {
+      optionsTestArtifactsDirectory = defaultTestArtifactsDirectory
+      }
diff --git a/demos/demo-stress/demo-stress.cabal b/demos/demo-stress/demo-stress.cabal
new file mode 100644
index 00000000..f35b37d3
--- /dev/null
+++ b/demos/demo-stress/demo-stress.cabal
@@ -0,0 +1,34 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.39.1.
+--
+-- see: https://github.com/sol/hpack
+
+name:           demo-stress
+version:        0.1.0.0
+license:        BSD3
+build-type:     Simple
+
+executable demo-stress
+  main-is: Main.hs
+  other-modules:
+      Paths_demo_stress
+  hs-source-dirs:
+      app
+  default-extensions:
+      OverloadedStrings
+      QuasiQuotes
+      NamedFieldPuns
+      RecordWildCards
+      ScopedTypeVariables
+      FlexibleContexts
+      FlexibleInstances
+      LambdaCase
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -fdistinct-constructor-tables -finfo-table-map -g
+  build-depends:
+      base
+    , random
+    , sandwich
+    , string-interpolate
+    , text
+  default-language: Haskell2010
diff --git a/demos/demo-stress/package.yaml b/demos/demo-stress/package.yaml
new file mode 100644
index 00000000..2b297e7d
--- /dev/null
+++ b/demos/demo-stress/package.yaml
@@ -0,0 +1,33 @@
+name:                demo-stress
+version:             0.1.0.0
+license:             BSD3
+
+dependencies:
+- base
+- random
+- sandwich
+- string-interpolate
+- text
+
+default-extensions:
+- OverloadedStrings
+- QuasiQuotes
+- NamedFieldPuns
+- RecordWildCards
+- ScopedTypeVariables
+- FlexibleContexts
+- FlexibleInstances
+- LambdaCase
+
+ghc-options:
+- -threaded
+- -rtsopts
+- -with-rtsopts=-N
+- -fdistinct-constructor-tables
+- -finfo-table-map
+- -g
+
+executables:
+  demo-stress:
+    main: Main.hs
+    source-dirs: app
diff --git a/sandwich-contexts-docker/lib/Test/Sandwich/Contexts/Docker/Registry.hs b/sandwich-contexts-docker/lib/Test/Sandwich/Contexts/Docker/Registry.hs
index 643782ec..51af3aae 100644
--- a/sandwich-contexts-docker/lib/Test/Sandwich/Contexts/Docker/Registry.hs
+++ b/sandwich-contexts-docker/lib/Test/Sandwich/Contexts/Docker/Registry.hs
@@ -32,6 +32,7 @@ import qualified System.Random as R
 import Test.Sandwich
 import Test.Sandwich.Contexts.Docker (createNetwork, doesNetworkExist, getDockerState)
 import Test.Sandwich.Contexts.Docker.Container (isInContainer)
+import UnliftIO.Async
 import UnliftIO.Exception
 import UnliftIO.Process
 
@@ -50,7 +51,7 @@ type HasDockerRegistryContext context = HasLabel context "dockerRegistry" Docker
 -- * Introduce
 
 introduceDockerRegistry :: (
-  HasCallStack, MonadUnliftIO m
+  HasCallStack, MonadUnliftIO m, HasBaseContext context
   ) => SpecFree (LabelValue "dockerRegistry" DockerRegistryContext :> context) m () -> SpecFree context m ()
 introduceDockerRegistry = introduceWith "introduce Docker registry" dockerRegistry $ \action -> do
   void $ withDockerRegistry Nothing action
@@ -65,7 +66,7 @@ pushDockerImages images = before "push Docker images" $ do
 -- * Implementation
 
 withDockerRegistry :: (
-  MonadUnliftIO m, MonadLoggerIO m
+  MonadUnliftIO m, MonadLoggerIO m, HasBaseContextMonad context m
   ) => Maybe (HostName, PortNumber) -> (DockerRegistryContext -> m a) -> m a
 withDockerRegistry optExternalDockerRegistry action = do
   case optExternalDockerRegistry of
@@ -74,7 +75,7 @@ withDockerRegistry optExternalDockerRegistry action = do
                                      , dockerRegistryPort = port }
     Nothing -> withNewDockerRegistry action
 
-withNewDockerRegistry :: (MonadUnliftIO m, MonadLoggerIO m) => (DockerRegistryContext -> m a) -> m a
+withNewDockerRegistry :: (MonadUnliftIO m, MonadLoggerIO m, HasBaseContextMonad context m) => (DockerRegistryContext -> m a) -> m a
 withNewDockerRegistry action = do
   registryID <- makeUUID' 5
 
@@ -89,12 +90,14 @@ withNewDockerRegistry action = do
                   Right _ -> return ()
                   Left err -> warn [i|Creating Docker network "kind" failed: '#{err}'|]
 
-              ps <- createProcessWithLogging (proc "docker" ["run", "-d", "--restart=always"
-                                                            , "-p", [i|5000|]
-                                                            ,  "--name", containerName
-                                                            ,  "--net=kind"
-                                                            , "registry:2"])
-              waitForProcess ps
+              (ps, asy) <- createProcessWithLogging (
+                proc "docker" ["run", "-d", "--restart=always"
+                              , "-p", [i|5000|]
+                                  ,  "--name", containerName
+                                  ,  "--net=kind"
+                                  , "registry:2"]
+                )
+              finally (waitForProcess ps) (cancel asy)
           )
           (\_ -> do
               info [i|Deleting registry '#{containerName}'|]
@@ -122,7 +125,7 @@ pushContainerToRegistryTimed imageName drc = timeAction [i|Pushing docker image
   pushContainerToRegistry imageName drc
 
 pushContainerToRegistry :: (
-  HasCallStack, MonadUnliftIO m, MonadLogger m
+  HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m
   ) => Text -> DockerRegistryContext -> m Text
 pushContainerToRegistry imageName (DockerRegistryContext {..}) = do
   imageNamePart <- case splitOn "/" imageName of
@@ -138,12 +141,14 @@ pushContainerToRegistry imageName (DockerRegistryContext {..}) = do
       -- We need to push to our local registry, but we'll get an insecure Docker registry error unless
       -- we're pushing to localhost. To accomplish this, we'll launch a new Docker container with host networking
       -- to do the push
-      ps <- createProcessWithLogging (shell [i|docker run --rm --network host -v /var/run/docker.sock:/var/run/docker.sock docker:stable docker push #{pushedName}|])
-      void $ liftIO $ waitForProcess ps
+      (ps, asy) <- createProcessWithLogging (shell [i|docker run --rm --network host -v /var/run/docker.sock:/var/run/docker.sock docker:stable docker push #{pushedName}|])
+      finally (void $ liftIO $ waitForProcess ps)
+              (cancel asy)
 
     False -> do
-      ps <- createProcessWithLogging (shell [i|docker push #{pushedName}|])
-      void $ liftIO $ waitForProcess ps
+      (ps, asy) <- createProcessWithLogging (shell [i|docker push #{pushedName}|])
+      finally (void $ liftIO $ waitForProcess ps)
+              (cancel asy)
 
   debug [i|finished pushing.|]
 
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes.hs
index fa310ea8..aae43105 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes.hs
@@ -41,6 +41,7 @@ module Test.Sandwich.Contexts.Kubernetes (
   -- * Forward services
   , withForwardKubernetesService
   , withForwardKubernetesService'
+  , withForwardKubernetesServiceFileLogging'
 
   -- * Logs
   , module Test.Sandwich.Contexts.Kubernetes.KubectlLogs
@@ -119,3 +120,24 @@ withForwardKubernetesService' kcc@(KubernetesClusterContext {kubernetesClusterTy
   Minikube.withForwardKubernetesService' kcc kubernetesClusterTypeMinikubeProfileName
 withForwardKubernetesService' kcc@(KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterKind {})}) kubectlBinary =
   Kind.withForwardKubernetesService' kcc kubectlBinary
+
+-- | Same as 'withForwardKubernetesService', but allows you to pass in the 'KubernetesClusterContext' and @kubectl@ binary.
+withForwardKubernetesServiceFileLogging' :: (
+  MonadLoggerIO m, MonadUnliftIO m
+  , HasBaseContextMonad context m
+  )
+  -- | Kubernetes cluster context
+  => KubernetesClusterContext
+  -- | Binary path for kubectl
+  -> FilePath
+  -- | Namespace
+  -> Text
+  -- | Service name
+  -> Text
+  -- | Callback receiving the service 'URL'.
+  -> (URI -> m a)
+  -> m a
+withForwardKubernetesServiceFileLogging' kcc@(KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterMinikube {..})}) _kubectlBinary =
+  Minikube.withForwardKubernetesServiceFileLogging' kcc kubernetesClusterTypeMinikubeProfileName
+withForwardKubernetesServiceFileLogging' kcc@(KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterKind {})}) kubectlBinary =
+  Kind.withForwardKubernetesServiceFileLogging' kcc kubectlBinary
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Images.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Images.hs
index ef278d54..d6ee3d82 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Images.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Images.hs
@@ -100,7 +100,7 @@ clusterContainsImage image = do
 
 -- | Same as 'clusterContainsImage', but allows you to pass in the 'KubernetesClusterContext'.
 clusterContainsImage' :: (
-  HasCallStack, MonadUnliftIO m, MonadLogger m
+  HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m
   )
   -- | Cluster context
   => KubernetesClusterContext
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KataContainers/HelmChart.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KataContainers/HelmChart.hs
index 90fc8651..16a1cf9b 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KataContainers/HelmChart.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KataContainers/HelmChart.hs
@@ -22,7 +22,7 @@ import UnliftIO.Process
 
 withKataContainers :: (
   MonadFail m, MonadLoggerIO m, MonadUnliftIO m
-  , MonadReader context m, HasFile context "helm"
+  , HasBaseContextMonad context m, HasFile context "helm"
   )
   => KubernetesClusterContext
   -> KataContainersOptions
@@ -33,7 +33,7 @@ withKataContainers kcc options action = do
   withKataContainers' helmBinary kcc options action
 
 withKataContainers' :: (
-  MonadFail m, MonadLoggerIO m, MonadUnliftIO m
+  MonadFail m, MonadLoggerIO m, MonadUnliftIO m, HasBaseContextMonad context m
   )
   => FilePath
   -> KubernetesClusterContext
@@ -54,7 +54,7 @@ withKataContainers' helmBinary kcc options@(KataContainersOptions {..}) action =
 
   env <- getKubectlEnvironment kcc
 
-  createProcessWithLogging ((proc helmBinary args) { env = Just env })
+  createProcessWithFileLogging ((proc helmBinary args) { env = Just env })
     >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
   action (KataContainersContext options)
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster.hs
index f93d78e7..30445123 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster.hs
@@ -216,9 +216,10 @@ withKindCluster' kindBinary kubectlBinary opts@(KindClusterOptions {..}) action
 
   (bracket (startKindCluster kindBinary opts clusterName kindConfigFile kindKubeConfigFile environmentToUse driver)
            (\_ -> do
-               ps <- createProcessWithLogging ((proc kindBinary ["delete", "cluster", "--name", toString clusterName]) {
-                                                  env = environmentToUse
-                                                  })
+               ps <- createProcessWithFileLogging (
+                 (proc kindBinary ["delete", "cluster", "--name", toString clusterName]) {
+                     env = environmentToUse
+                     })
                void $ waitForProcess ps
            ))
            (\kcc -> bracket_ (setUpKindCluster kcc kindBinary kubectlBinary environmentToUse driver)
@@ -227,15 +228,17 @@ withKindCluster' kindBinary kubectlBinary opts@(KindClusterOptions {..}) action
            )
 
 startKindCluster :: (
-  MonadLoggerIO m, MonadUnliftIO m
+  MonadLoggerIO m, MonadUnliftIO m, HasBaseContextMonad context m
   ) => FilePath -> KindClusterOptions -> Text -> FilePath -> FilePath -> Maybe [(String, String)] -> Text -> m KubernetesClusterContext
 startKindCluster kindBinary (KindClusterOptions {..}) clusterName kindConfigFile kindKubeConfigFile environmentToUse driver = do
-  ps <- createProcessWithLogging ((proc kindBinary ["create", "cluster", "-v", "1", "--name", toString clusterName
-                                                   , "--config", kindConfigFile
-                                                   , "--kubeconfig", kindKubeConfigFile]) {
-                                     delegate_ctlc = True
-                                     , env = environmentToUse
-                                     })
+  ps <- createProcessWithFileLogging (
+    (proc kindBinary ["create", "cluster", "-v", "1", "--name", toString clusterName
+                     , "--config", kindConfigFile
+                     , "--kubeconfig", kindKubeConfigFile]) {
+        delegate_ctlc = True
+        , env = environmentToUse
+        }
+    )
   void $ waitForProcess ps
 
   whenM isInContainer $
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/Images.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/Images.hs
index 967d0e27..fdea9a20 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/Images.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/Images.hs
@@ -30,7 +30,7 @@ import UnliftIO.Temporary
 
 -- | Load an image into a Kind cluster.
 loadImageKind :: (
-  HasCallStack, MonadUnliftIO m, MonadLoggerIO m
+  HasCallStack, MonadUnliftIO m, MonadLoggerIO m, HasBaseContextMonad context m
   )
   -- | Path to @kind@ binary
   => FilePath
@@ -63,7 +63,7 @@ loadImageKind kindBinary clusterName imageLoadSpec env = do
             withSystemTempDirectory "image-tarball" $ \tempDir -> do
               let tarFile = tempDir </> "image.tar"
               -- TODO: don't depend on external gzip binary
-              createProcessWithLogging (shell [i|cat "#{image}" | gzip -d > "#{tarFile}"|])
+              createProcessWithFileLogging (shell [i|cat "#{image}" | gzip -d > "#{tarFile}"|])
                 >>= waitForProcess >>= (`shouldBe` ExitSuccess)
               imageLoad tarFile
               readImageName (toString image)
@@ -72,7 +72,7 @@ loadImageKind kindBinary clusterName imageLoadSpec env = do
     ImageLoadSpecDocker image pullPolicy -> do
       _ <- dockerPullIfNecessary image pullPolicy
 
-      createProcessWithLogging (
+      createProcessWithFileLogging (
         (shell [i|#{kindBinary} load docker-image #{image} --name #{clusterName}|]) {
             env = env
             }) >>= waitForProcess >>= (`shouldBe` ExitSuccess)
@@ -86,14 +86,14 @@ loadImageKind kindBinary clusterName imageLoadSpec env = do
       return image
   where
     imageLoad tarFile =
-      createProcessWithLogging (
+      createProcessWithFileLogging (
         (shell [i|#{kindBinary} load image-archive #{tarFile} --name #{clusterName}|]) {
             env = env
             }) >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
 -- | Get the set of loaded images on the given Kind cluster.
 getLoadedImagesKind :: (
-  HasCallStack, MonadUnliftIO m, MonadLogger m
+  HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m
   )
   => KubernetesClusterContext
   -- | Driver (should be "docker" or "podman")
@@ -128,7 +128,7 @@ getLoadedImagesKind kcc driver kindBinary env = do
 
 -- | Test if the Kind cluster contains a given image.
 clusterContainsImageKind :: (
-  HasCallStack, MonadUnliftIO m, MonadLogger m
+  HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m
   )
   => KubernetesClusterContext
   -- | Driver (should be "docker" or "podman")
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/ServiceForwardIngress.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/ServiceForwardIngress.hs
index a738f392..326b92d6 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/ServiceForwardIngress.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/ServiceForwardIngress.hs
@@ -34,7 +34,7 @@ import UnliftIO.Timeout
 
 
 withForwardKubernetesService' :: (
-  MonadUnliftIO m, MonadLoggerIO m
+  MonadUnliftIO m, MonadLoggerIO m, HasBaseContextMonad context m
   ) => KubernetesClusterContext -> FilePath -> Text -> Text -> (URI -> m a) -> m a
 withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterKind {..}), ..}) kubectlBinary namespace service action = do
   baseEnv <- maybe getEnvironment return kubernetesClusterTypeKindClusterEnvironment
@@ -46,11 +46,12 @@ withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(
     let configFile = dir </> "ingress.yaml"
     liftIO $ T.writeFile configFile (ingressConfig service randomHost)
 
-    createProcessWithLogging ((proc kubectlBinary ["create"
-                                                  , "--namespace", toString namespace
-                                                  , "-f", configFile]) {
-                                 env = Just env
-                                 }) >>= waitForProcess >>= (`shouldBe` ExitSuccess)
+    createProcessWithFileLogging (
+      (proc kubectlBinary ["create"
+                          , "--namespace", toString namespace
+                          , "-f", configFile]) {
+          env = Just env
+          }) >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
   -- TODO: wait for ingress to be ready?
   -- Possibly not necessary since the server context waits for 200 after this
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/ServiceForwardPortForward.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/ServiceForwardPortForward.hs
index 51d52db6..fbc91f45 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/ServiceForwardPortForward.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/ServiceForwardPortForward.hs
@@ -51,3 +51,9 @@ withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(
       }
 
 withForwardKubernetesService' _ _ _ _ _ = error "withForwardKubernetesService' must be called with a kind KubernetesClusterContext"
+
+withForwardKubernetesServiceFileLogging' :: (
+  MonadUnliftIO m, MonadLoggerIO m
+  , HasBaseContextMonad context m
+  ) => KubernetesClusterContext -> FilePath -> Text -> Text -> (URI -> m a) -> m a
+withForwardKubernetesServiceFileLogging' = withForwardKubernetesService'
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/Setup.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/Setup.hs
index b62c2900..7fbbf79d 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/Setup.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/Setup.hs
@@ -25,12 +25,12 @@ import UnliftIO.Process
 
 
 setUpKindCluster :: (
-  MonadLoggerIO m, MonadUnliftIO m
+  MonadLoggerIO m, MonadUnliftIO m, HasBaseContextMonad context m
   ) => KubernetesClusterContext -> FilePath -> FilePath -> Maybe [(String, String)] -> Text -> m ()
 setUpKindCluster kcc@(KubernetesClusterContext {..}) kindBinary kubectlBinary environmentToUse driver = do
   baseEnv <- maybe getEnvironment return environmentToUse
   let env = L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)
-  let runWithKubeConfig cmd = createProcessWithLogging ((shell cmd) { env = Just env, delegate_ctlc = True })
+  let runWithKubeConfig cmd = createProcessWithFileLogging ((shell cmd) { env = Just env, delegate_ctlc = True })
 
   info [i|Installing ingress-nginx|]
   runWithKubeConfig [i|#{kubectlBinary} apply -f https://raw.githubusercontent.com/kubernetes/ingress-nginx/main/deploy/static/provider/kind/deploy.yaml|]
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KubectlPortForward.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KubectlPortForward.hs
index f1d02bb1..9c03c58c 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KubectlPortForward.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KubectlPortForward.hs
@@ -22,7 +22,6 @@ import Test.Sandwich.Contexts.Kubernetes.Types
 import Test.Sandwich.Contexts.Kubernetes.Util.Ports
 import Test.Sandwich.Contexts.Kubernetes.Util.SocketUtil
 import Test.Sandwich.Util.Process (gracefullyStopProcess)
-import UnliftIO.Async
 import UnliftIO.Concurrent
 import UnliftIO.Directory
 import UnliftIO.Exception
@@ -110,7 +109,7 @@ withKubectlPortForward' kubectlBinary kubeConfigFile namespace isAcceptablePort
                   )
           threadDelay 1_000_000  -- 1 second delay between restarts to ensure we don't spin here
 
-    withAsync restarterThread $ \_ -> do
+    managedWithAsync_ "kubectl-port-forward-restarter" restarterThread $ do
       let policy = constantDelay 100000 <> limitRetries 100
       void $ liftIO $ retrying policy (\_ ret -> return ret) $ \_ -> do
         not <$> isPortOpen (simpleSockAddr (127, 0, 0, 1) port)
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Longhorn.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Longhorn.hs
index a42038d1..516f3106 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Longhorn.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Longhorn.hs
@@ -71,14 +71,14 @@ withLonghorn options action = do
   kubectlBinary <- askFile @"kubectl"
   withLonghorn' kcc kubectlBinary options action
 
-withLonghorn' :: forall m a. (
-  HasCallStack, MonadFail m, MonadLoggerIO m, MonadUnliftIO m
+withLonghorn' :: forall context m a. (
+  HasCallStack, MonadFail m, MonadLoggerIO m, MonadUnliftIO m, HasBaseContextMonad context m
   ) => KubernetesClusterContext -> String -> LonghornOptions -> (LonghornContext -> m a) -> m a
 withLonghorn' (KubernetesClusterContext {kubernetesClusterKubeConfigPath}) kubectlBinary options@(LonghornOptions {..}) action = do
   baseEnv <- getEnvironment
   let env = L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)
 
-  createProcessWithLogging ((proc kubectlBinary ["apply", "-f", longhornYaml]) { env = Just env })
+  createProcessWithFileLogging ((proc kubectlBinary ["apply", "-f", longhornYaml]) { env = Just env })
     >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
   action $ LonghornContext options
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinikubeCluster/Forwards.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinikubeCluster/Forwards.hs
index 5ba25818..ef883320 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinikubeCluster/Forwards.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinikubeCluster/Forwards.hs
@@ -11,21 +11,24 @@ import Control.Monad.Logger
 import qualified Data.List as L
 import Data.String.Interpolate
 import Data.Text as T
+import qualified Data.Text.IO as T
 import Network.URI
 import Relude hiding (withFile)
-import System.IO (hGetLine)
+import System.FilePath
+import System.IO (hClose, hGetLine, openTempFile)
 import System.Process (getPid)
 import Test.Sandwich
 import Test.Sandwich.Contexts.Kubernetes.Types
+
 import Test.Sandwich.Util.Process
-import UnliftIO.Async
+import UnliftIO.Concurrent (threadDelay)
 import UnliftIO.Environment
 import UnliftIO.Exception
 import UnliftIO.Process
 
 
 withForwardKubernetesService' :: (
-  HasCallStack, MonadLoggerIO m, MonadUnliftIO m
+  HasCallStack, MonadLoggerIO m, MonadUnliftIO m, HasBaseContextMonad context m
   ) => KubernetesClusterContext -> Text -> Text -> Text -> (URI -> m a) -> m a
 withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterMinikube {..}), ..}) profile namespace service action = do
   baseEnv <- liftIO getEnvironment
@@ -53,7 +56,7 @@ withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(
           line <- liftIO $ hGetLine stderrRead
           info [i|minikube service stderr: #{line}|]
 
-  withAsync forwardStderr $ \_ -> do
+  managedWithAsync_ "minikube-service-stderr" forwardStderr $ do
     let cp = (proc kubernetesClusterTypeMinikubeBinary args) {
           env = Just env
           , std_out = UseHandle stdoutWrite
@@ -73,5 +76,59 @@ withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(
       action =<< case parseURI (toString (T.strip (toText raw))) of
         Nothing -> expectationFailure [i|Couldn't parse URI in withForwardKubernetesService': #{raw}|]
         Just x -> pure x
-
 withForwardKubernetesService' _ _profile _namespace _service _action = error "Expected Minikube KubernetesClusterContext"
+
+withForwardKubernetesServiceFileLogging' :: (
+  HasCallStack, MonadLoggerIO m, MonadUnliftIO m, HasBaseContextMonad context m
+  ) => KubernetesClusterContext -> Text -> Text -> Text -> (URI -> m a) -> m a
+withForwardKubernetesServiceFileLogging' (KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterMinikube {..}), ..}) profile namespace service action = do
+  baseEnv <- liftIO getEnvironment
+  let env = L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)
+
+  let extraFlags = case "--rootless" `L.elem` kubernetesClusterTypeMinikubeFlags of
+        True -> ["--rootless"]
+        False -> []
+
+  let args = extraFlags <> [
+        "--profile", toString profile
+        , "--namespace", toString namespace
+        , "--logtostderr"
+        , "service"
+        , toString service
+        , "--url"]
+  info [i|#{kubernetesClusterTypeMinikubeBinary} #{T.unwords $ fmap toText args}|]
+
+  let cp = (proc kubernetesClusterTypeMinikubeBinary args) {
+        env = Just env
+        , create_group = True
+        }
+
+  let fileName = namespace <> "-" <> "service"
+
+  getCurrentFolder >>= \case
+    Nothing -> expectationFailure [i|withForwardKubernetesServiceFileLogging': no current folder.|]
+    Just dir ->
+      bracket (liftIO $ openTempFile dir (toString fileName <.> "out")) (\(_outFile, hOut) -> liftIO $ hClose hOut) $ \(outFile, hOut) ->
+      bracket (liftIO $ openTempFile dir (toString fileName <.> "err")) (\(_errFile, hErr) -> liftIO $ hClose hErr) $ \(_errFile, hErr) -> do
+        let stop (_, _, _, p) = liftIO (getPid p) >>= \case
+              Nothing -> return ()
+              Just _pid -> gracefullyStopProcess p 120_000_000
+
+        bracket (createProcess (cp { std_out = UseHandle hOut, std_err = UseHandle hErr })) stop $ \_ -> do
+          raw <- readFirstLine outFile
+
+          info [i|withForwardKubernetesServiceFileLogging': (#{namespace}) #{service} -> #{raw}|]
+
+          action =<< case parseURI (toString (T.strip raw)) of
+            Nothing -> expectationFailure [i|Couldn't parse URI in withForwardKubernetesServiceFileLogging': #{raw}|]
+            Just x -> pure x
+  where
+    readFirstLine :: MonadIO m => FilePath -> m Text
+    readFirstLine fp = liftIO loop
+      where
+        loop = do
+          contents <- T.readFile fp
+          case T.lines contents of
+            (x:_) -> pure x
+            [] -> threadDelay 50_000 >> loop
+withForwardKubernetesServiceFileLogging' _ _profile _namespace _service _action = error "Expected Minikube KubernetesClusterContext"
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinikubeCluster/Images.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinikubeCluster/Images.hs
index 6e66b704..6bcd019c 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinikubeCluster/Images.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinikubeCluster/Images.hs
@@ -32,7 +32,7 @@ import UnliftIO.Temporary
 
 -- | Load an image onto a cluster. This image can come from a variety of sources, as specified by the 'ImageLoadSpec'.
 loadImageMinikube :: (
-  HasCallStack, MonadUnliftIO m, MonadLoggerIO m, MonadFail m
+  HasCallStack, MonadUnliftIO m, MonadLoggerIO m, MonadFail m, HasBaseContextMonad context m
   )
   -- | Path to @minikube@ binary
   => FilePath
@@ -57,7 +57,7 @@ loadImageMinikube minikubeBinary clusterName minikubeFlags imageLoadSpec = do
           withSystemTempDirectory "image-tarball" $ \tempDir -> do
             let tarFile = tempDir </> "image.tar"
             -- TODO: don't depend on external tar file
-            createProcessWithLogging (shell [i|tar -C "#{image}" --dereference --hard-dereference --xform s:'^./':: -c . > "#{tarFile}"|])
+            createProcessWithFileLogging (shell [i|tar -C "#{image}" --dereference --hard-dereference --xform s:'^./':: -c . > "#{tarFile}"|])
               >>= waitForProcess >>= (`shouldBe` ExitSuccess)
             imageLoad tarFile False
             readImageName (toString image)
@@ -69,7 +69,7 @@ loadImageMinikube minikubeBinary clusterName minikubeFlags imageLoadSpec = do
             withSystemTempDirectory "image-tarball" $ \tempDir -> do
               let tarFile = tempDir </> "image.tar"
               -- TODO: don't depend on external gzip file
-              createProcessWithLogging (shell [i|cat "#{image}" | gzip -d > "#{tarFile}"|])
+              createProcessWithFileLogging (shell [i|cat "#{image}" | gzip -d > "#{tarFile}"|])
                 >>= waitForProcess >>= (`shouldBe` ExitSuccess)
               imageLoad tarFile False
               readImageName (toString image)
@@ -84,7 +84,7 @@ loadImageMinikube minikubeBinary clusterName minikubeFlags imageLoadSpec = do
       imageLoad (toString image) True >> return image
 
   where
-    imageLoad :: (MonadLoggerIO m, HasCallStack) => String -> Bool -> m ()
+    imageLoad :: (MonadLoggerIO m, HasBaseContextMonad context m, HasCallStack) => String -> Bool -> m ()
     imageLoad toLoad daemon = do
       let extraFlags = case "--rootless" `L.elem` minikubeFlags of
                          True -> ["--rootless"]
@@ -100,13 +100,14 @@ loadImageMinikube minikubeBinary clusterName minikubeFlags imageLoadSpec = do
 
       -- Gather stderr output while also logging it
       logFn <- askLoggerIO
+      ctx <- ask
       stderrOutputVar <- newIORef mempty
       let customLogFn loc src level str = do
             modifyIORef' stderrOutputVar (<> str)
             logFn loc src level str
 
-      liftIO $ flip runLoggingT customLogFn $
-        createProcessWithLogging (proc minikubeBinary args)
+      liftIO $ flip runLoggingT customLogFn $ flip runReaderT ctx $
+        createProcessWithFileLogging (proc minikubeBinary args)
           >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
       stderrOutput <- fromLogStr <$> readIORef stderrOutputVar
@@ -132,7 +133,7 @@ loadImageMinikube minikubeBinary clusterName minikubeFlags imageLoadSpec = do
 
 -- | Get the loaded images on a cluster, by cluster name.
 getLoadedImagesMinikube :: (
-  MonadUnliftIO m, MonadLogger m
+  MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m
   )
   -- | Path to @minikube@ binary
   => FilePath
@@ -150,7 +151,7 @@ getLoadedImagesMinikube minikubeBinary clusterName minikubeFlags = do
 
 -- | Test if the cluster contains a given image, by cluster name.
 clusterContainsImageMinikube :: (
-  MonadUnliftIO m, MonadLogger m
+  MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m
   )
   -- | Path to @minikube@ binary
   => FilePath
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioOperator.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioOperator.hs
index e7ef3572..63d8cf63 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioOperator.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioOperator.hs
@@ -197,7 +197,7 @@ withMinioOperator'' kubectlBinary kcc preloadImages allYaml action = do
     forM_ images $ \image ->
       loadImageIfNecessary' kcc (ImageLoadSpecDocker image IfNotPresent)
 
-  let create = createProcessWithLoggingAndStdin ((proc kubectlBinary ["apply", "-f", "-"]) { env = Just env }) (toString allYaml)
+  let create = createProcessWithFileLoggingAndStdin ((proc kubectlBinary ["apply", "-f", "-"]) { env = Just env }) (toString allYaml)
                  >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
   let namespaceToDestroy = fromMaybe "minio-operator" (findNamespace (toText allYaml))
@@ -209,10 +209,12 @@ withMinioOperator'' kubectlBinary kcc preloadImages allYaml action = do
         -- gets deleted first and then subsequent deletes encounter missing objects.
         -- If this doesn't work, we can fall back to just deleting the namespace below.
         -- But I think this will be better because it should pick up CRDs?
-        createProcessWithLoggingAndStdin ((proc kubectlBinary ["delete", "-f", "-"
-                                                              , "--ignore-not-found", "--wait=false", "--all=true"
-                                                              ]) {
-                                             env = Just env, delegate_ctlc = True }) (toString allYaml)
+        createProcessWithFileLoggingAndStdin (
+          (proc kubectlBinary ["delete", "-f", "-"
+                              , "--ignore-not-found", "--wait=false", "--all=true"
+                              ]) {
+              env = Just env, delegate_ctlc = True
+              }) (toString allYaml)
           >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
         -- createProcessWithLogging ((proc kubectlBinary ["delete", "namespace", toString namespaceToDestroy, "-f"]) {
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioS3Server.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioS3Server.hs
index 24d1809b..e15a0333 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioS3Server.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioS3Server.hs
@@ -142,7 +142,7 @@ withK8SMinioS3Server' kubectlBinary kcc@(KubernetesClusterContext {..}) MinioOpe
   env <- getKubectlEnvironment kcc
   let runWithKubeConfig :: (HasCallStack) => String -> [String] -> m ()
       runWithKubeConfig prog args = do
-        createProcessWithLogging ((proc prog args) { env = Just env, delegate_ctlc = True })
+        createProcessWithFileLogging ((proc prog args) { env = Just env, delegate_ctlc = True })
           >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
   deploymentName <- ("minio-" <>) <$> makeUUID' 5
@@ -179,21 +179,21 @@ withK8SMinioS3Server' kubectlBinary kcc@(KubernetesClusterContext {..}) MinioOpe
 
         info [i|Got username and password: #{(username, password)}|]
 
-        createProcessWithLoggingAndStdin ((proc kubectlBinary ["apply", "-f", "-"]) { env = Just env }) (toString finalYaml)
+        createProcessWithFileLoggingAndStdin ((proc kubectlBinary ["apply", "-f", "-"]) { env = Just env }) (toString finalYaml)
           >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
         return (userAndPassword, finalYaml)
 
   let destroy (_, finalYaml) = do
         info [i|-------------------------- DESTROYING --------------------------|]
-        createProcessWithLoggingAndStdin ((proc kubectlBinary ["delete", "-f", "-"]) { env = Just env }) (toString finalYaml)
+        createProcessWithFileLoggingAndStdin ((proc kubectlBinary ["delete", "-f", "-"]) { env = Just env }) (toString finalYaml)
           >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
 
   -- Create network policy allowing ingress/egress for v1.min.io/tenant = deploymentName
   let createNetworkPolicy = do
         let NetworkPolicies policyNames yaml = fromMaybe (defaultNetworkPolicies deploymentName) minioS3ServerNetworkPolicies
-        createProcessWithLoggingAndStdin ((proc kubectlBinary ["create", "--namespace", toString minioS3ServerNamespace, "-f", "-"]) { env = Just env, delegate_ctlc = True }) yaml
+        createProcessWithFileLoggingAndStdin ((proc kubectlBinary ["create", "--namespace", toString minioS3ServerNamespace, "-f", "-"]) { env = Just env, delegate_ctlc = True }) yaml
           >>= waitForProcess >>= (`shouldBe` ExitSuccess)
         pure policyNames
   let destroyNetworkPolicy policyNames = do
@@ -203,19 +203,21 @@ withK8SMinioS3Server' kubectlBinary kcc@(KubernetesClusterContext {..}) MinioOpe
   bracket createNetworkPolicy destroyNetworkPolicy $ \_ -> bracket create destroy $ \((username, password), _) -> do
     do
       uuid <- makeUUID
-      p <- createProcessWithLogging ((proc kubectlBinary [
-                                         "run", "discoverer-" <> toString uuid
-                                         , "--rm", "-i"
-                                         , "--attach"
-                                         , [i|--image=#{busyboxImage}|]
-                                         , "--image-pull-policy=IfNotPresent"
-                                         , "--restart=Never"
-                                         , "--command"
-                                         , "--namespace", toString minioS3ServerNamespace
-                                         , "--labels=app=discover-pod"
-                                         , "--"
-                                         , "sh", "-c", [i|until nc -vz minio 80; do echo "Waiting for minio..."; sleep 3; done;|]
-                                         ]) { env = Just env })
+      p <- createProcessWithFileLogging (
+        (proc kubectlBinary [
+            "run", "discoverer-" <> toString uuid
+            , "--rm", "-i"
+            , "--attach"
+            , [i|--image=#{busyboxImage}|]
+            , "--image-pull-policy=IfNotPresent"
+            , "--restart=Never"
+            , "--command"
+            , "--namespace", toString minioS3ServerNamespace
+            , "--labels=app=discover-pod"
+            , "--"
+            , "sh", "-c", [i|until nc -vz minio 80; do echo "Waiting for minio..."; sleep 3; done;|]
+            ]) { env = Just env }
+        )
       timeout 300_000_000 (waitForProcess p >>= (`shouldBe` ExitSuccess)) >>= \case
         Just () -> return ()
         Nothing -> expectationFailure [i|Failed to wait for minio to come online.|]
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Namespace.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Namespace.hs
index 439a7f57..5b9bde06 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Namespace.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Namespace.hs
@@ -151,7 +151,7 @@ createKubernetesNamespace'' :: (
 createKubernetesNamespace'' kcc kubectl namespace = do
   let args = ["create", "namespace", toString namespace]
   env <- getKubectlEnvironment kcc
-  createProcessWithLogging ((proc kubectl args) { env = Just env, delegate_ctlc = True })
+  createProcessWithFileLogging ((proc kubectl args) { env = Just env, delegate_ctlc = True })
     >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
 -- | Destroy a Kubernetes namespace.
@@ -171,5 +171,5 @@ destroyKubernetesNamespace'' kcc kubectl force namespace = do
   let args = ["delete", "namespace", toString namespace]
            <> if force then ["--force"] else []
   env <- getKubectlEnvironment kcc
-  createProcessWithLogging ((proc kubectl args) { env = Just env, delegate_ctlc = True })
+  createProcessWithFileLogging ((proc kubectl args) { env = Just env, delegate_ctlc = True })
     >>= waitForProcess >>= (`shouldBe` ExitSuccess)
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/SeaweedFS.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/SeaweedFS.hs
index 7744c345..7c5778a0 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/SeaweedFS.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/SeaweedFS.hs
@@ -166,7 +166,7 @@ withSeaweedFS' kcc@(KubernetesClusterContext {kubernetesClusterKubeConfigPath})
     _ <- readCreateProcess (proc "cp" ["-r", toString operatorPath, target]) ""
     _ <- readCreateProcess (proc "chmod" ["-R", "u+w", target]) ""
 
-    let runOperatorCmd cmd extraEnv = createProcessWithLogging (
+    let runOperatorCmd cmd extraEnv = createProcessWithFileLogging (
           (shell cmd) {
               env = Just (env <> extraEnv)
               , cwd = Just target
@@ -193,7 +193,7 @@ withSeaweedFS' kcc@(KubernetesClusterContext {kubernetesClusterKubeConfigPath})
     info [i|------------------ Creating SeaweedFS deployment ------------------|]
 
     let val = decodeUtf8 $ A.encode $ example namespace options
-    createProcessWithLoggingAndStdin ((shell [i|#{kubectlBinary} create -f -|]) { env = Just env }) val
+    createProcessWithFileLoggingAndStdin ((shell [i|#{kubectlBinary} create -f -|]) { env = Just env }) val
       >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
     action $ SeaweedFSContext {
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Typesense.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Typesense.hs
index 13f3a05b..a88ab051 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Typesense.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Typesense.hs
@@ -143,12 +143,12 @@ withTypesense' kcc _kubectlBinary namespace options@(TypesenseOptions {..}) acti
 
   -- Add the Helm repository
   info [i|Adding Typesense Helm repository...|]
-  createProcessWithLogging ((proc helmBinary [
+  createProcessWithFileLogging ((proc helmBinary [
     "repo", "add", "springboard", "https://helm-charts.springboardvr.com"
     ]) { env = Just env })
     >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
-  createProcessWithLogging ((proc helmBinary ["repo", "update"]) { env = Just env })
+  createProcessWithFileLogging ((proc helmBinary ["repo", "update"]) { env = Just env })
     >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
   -- Install Typesense via Helm
@@ -170,7 +170,7 @@ withTypesense' kcc _kubectlBinary namespace options@(TypesenseOptions {..}) acti
 
   info [i|helm #{T.intercalate " " (fmap toText helmArgs)}|]
 
-  createProcessWithLogging ((proc helmBinary helmArgs) { env = Just env })
+  createProcessWithFileLogging ((proc helmBinary helmArgs) { env = Just env })
     >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
   let serviceName = typesenseReleaseName
@@ -184,10 +184,10 @@ withTypesense' kcc _kubectlBinary namespace options@(TypesenseOptions {..}) acti
       , typesenseNamespace = namespace
       }
 
-cleanupTypesense :: (MonadLoggerIO m, MonadUnliftIO m) => FilePath -> [(String, String)] -> Text -> Text -> m ()
+cleanupTypesense :: (MonadLoggerIO m, MonadUnliftIO m, HasBaseContextMonad context m) => FilePath -> [(String, String)] -> Text -> Text -> m ()
 cleanupTypesense helmBinary env namespace releaseName = do
   info [i|Cleaning up Typesense release '#{releaseName}' in namespace '#{namespace}'...|]
-  createProcessWithLogging ((proc helmBinary [
+  createProcessWithFileLogging ((proc helmBinary [
     "uninstall", toString releaseName
     , "--namespace", toString namespace
     ]) { env = Just env })
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Util/Images.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Util/Images.hs
index a6b8fa09..8781fdc2 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Util/Images.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Util/Images.hs
@@ -38,25 +38,25 @@ import UnliftIO.Temporary
 
 -- | Pull an image using Docker if it isn't already present.
 -- Returns 'True' if a pull was done.
-dockerPullIfNecessary :: (MonadUnliftIO m, MonadLoggerIO m) => Text -> ImagePullPolicy -> m Bool
+dockerPullIfNecessary :: (MonadUnliftIO m, MonadLoggerIO m, HasBaseContextMonad context m) => Text -> ImagePullPolicy -> m Bool
 dockerPullIfNecessary = commonPullIfNecessary "docker"
 
-isDockerImagePresent :: (MonadUnliftIO m, MonadLoggerIO m) => Text -> m Bool
+isDockerImagePresent :: (MonadUnliftIO m, MonadLoggerIO m, HasBaseContextMonad context m) => Text -> m Bool
 isDockerImagePresent = isImagePresentCommon "docker"
 
 -- * Podman
 
 -- | Pull an image using Docker if it isn't already present.
 -- Returns 'True' if a pull was done.
-podmanPullIfNecessary :: (MonadUnliftIO m, MonadLoggerIO m) => Text -> ImagePullPolicy -> m Bool
+podmanPullIfNecessary :: (MonadUnliftIO m, MonadLoggerIO m, HasBaseContextMonad context m) => Text -> ImagePullPolicy -> m Bool
 podmanPullIfNecessary = commonPullIfNecessary "podman"
 
-isPodmanImagePresent :: (MonadUnliftIO m, MonadLoggerIO m) => Text -> m Bool
+isPodmanImagePresent :: (MonadUnliftIO m, MonadLoggerIO m, HasBaseContextMonad context m) => Text -> m Bool
 isPodmanImagePresent = isImagePresentCommon "podman"
 
 -- * Common
 
-commonPullIfNecessary :: (MonadUnliftIO m, MonadLoggerIO m) => String -> Text -> ImagePullPolicy -> m Bool
+commonPullIfNecessary :: (MonadUnliftIO m, MonadLoggerIO m, HasBaseContextMonad context m) => String -> Text -> ImagePullPolicy -> m Bool
 commonPullIfNecessary binary image pullPolicy = isImagePresentCommon binary image >>= \case
   True ->
     if | pullPolicy == Always -> doPull
@@ -66,19 +66,19 @@ commonPullIfNecessary binary image pullPolicy = isImagePresentCommon binary imag
        | otherwise -> doPull
   where
     doPull = do
-      createProcessWithLogging (proc binary ["pull", toString image])
+      createProcessWithFileLogging (proc binary ["pull", toString image])
         >>= waitForProcess >>= (`shouldBe` ExitSuccess)
       return True
 
-isImagePresentCommon :: (MonadUnliftIO m, MonadLoggerIO m) => String -> Text -> m Bool
+isImagePresentCommon :: (MonadUnliftIO m, MonadLoggerIO m, HasBaseContextMonad context m) => String -> Text -> m Bool
 isImagePresentCommon binary image = do
-  createProcessWithLogging (proc binary ["inspect", "--type=image", toString image]) >>= waitForProcess >>= \case
+  createProcessWithFileLogging (proc binary ["inspect", "--type=image", toString image]) >>= waitForProcess >>= \case
     ExitSuccess -> return True
     ExitFailure _ -> return False
 
 -- * Image name reading
 
-readImageName :: (HasCallStack, MonadUnliftIO m, MonadLogger m) => FilePath -> m Text
+readImageName :: (HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => FilePath -> m Text
 readImageName path = doesDirectoryExist path >>= \case
   True -> readUncompressedImageName path
   False -> case takeExtension path of
@@ -113,7 +113,7 @@ getImageNameFromManifestJson path contents = do
     getRepoTags (A.Object (aesonLookup "RepoTags" -> Just (A.Array repoItems))) = [t | A.String t <- V.toList repoItems]
     getRepoTags _ = []
 
-imageLoadSpecToImageName :: (MonadUnliftIO m, MonadLogger m) => ImageLoadSpec -> m Text
+imageLoadSpecToImageName :: (MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => ImageLoadSpec -> m Text
 imageLoadSpecToImageName (ImageLoadSpecTarball image) = readImageName image
 imageLoadSpecToImageName (ImageLoadSpecDocker image _) = pure image
 imageLoadSpecToImageName (ImageLoadSpecPodman image _) = pure image
diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Waits.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Waits.hs
index d3f23d2b..88625776 100644
--- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Waits.hs
+++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Waits.hs
@@ -109,7 +109,7 @@ listPods namespace labels =
 -- | Wait for a set of pods to be in the Ready condition, specified by a set of labels.
 waitForPodsToBeReady :: (
   MonadUnliftIO m, MonadLogger m
-  , MonadReader context m, HasKubernetesClusterContext context, HasFile context "kubectl"
+  , MonadReader context m, HasBaseContext context, HasKubernetesClusterContext context, HasFile context "kubectl"
   )
   -- | Namespace
   => Text
@@ -123,17 +123,19 @@ waitForPodsToBeReady namespace labels timeInSeconds = do
   kubeConfigFile <- kubernetesClusterKubeConfigPath <$> getContext kubernetesCluster
 
   let labelArgs = [[i|-l #{k}=#{v}|] | (k, v) <- M.toList labels]
-  p <- createProcessWithLogging (proc kubectlBinary (
-                                  ["wait", "pods"
-                                  , "--kubeconfig", kubeConfigFile
-                                  , "-n", toString namespace
-                                  ]
-                                  <> labelArgs
-                                  <> [
-                                    "--for", "condition=Ready"
-                                    , "--timeout=" <> show timeInSeconds <> "s"
-                                    ]
-                                ))
+  p <- createProcessWithFileLogging (
+    proc kubectlBinary (
+        ["wait", "pods"
+        , "--kubeconfig", kubeConfigFile
+        , "-n", toString namespace
+        ]
+        <> labelArgs
+        <> [
+            "--for", "condition=Ready"
+           , "--timeout=" <> show timeInSeconds <> "s"
+           ]
+        )
+    )
   waitForProcess p >>= \case
     ExitSuccess -> return ()
     ExitFailure n -> expectationFailure [i|Failed to wait for pods to exist (code #{n})|]
diff --git a/sandwich-contexts-minio/lib/Test/Sandwich/Contexts/MinIO.hs b/sandwich-contexts-minio/lib/Test/Sandwich/Contexts/MinIO.hs
index fdd78e70..a1797928 100644
--- a/sandwich-contexts-minio/lib/Test/Sandwich/Contexts/MinIO.hs
+++ b/sandwich-contexts-minio/lib/Test/Sandwich/Contexts/MinIO.hs
@@ -70,7 +70,7 @@ import Test.Sandwich.Contexts.MinIO.Util
 import Test.Sandwich.Contexts.Nix
 import Test.Sandwich.Contexts.Types.Network
 import Test.Sandwich.Contexts.Types.S3
-import UnliftIO.Async
+
 import UnliftIO.Directory
 import UnliftIO.Exception
 import UnliftIO.Process
@@ -193,7 +193,7 @@ withMinIOViaBinary' minioPath (MinIOContextOptions {..}) action = do
           line <- liftIO $ T.hGetLine hRead
           debug [i|minio: #{line}|]
 
-    withAsync forwardOutput $ \_ -> do
+    managedWithAsync_ "minio-output-forward" forwardOutput $ do
       (hostname, port) <- case uriToUse of
         Nothing -> expectationFailure [i|Couldn't find MinIO URI to use.|]
         Just (URI { uriAuthority=(Just URIAuth {..}) }) -> case readMaybe (L.drop 1 uriPort) of
@@ -286,9 +286,9 @@ withMinIOViaContainer (MinIOContextOptions {..}) (ContainerOptions {..}) action
 
               info [i|Got command: #{cp}"|]
 
-              createProcessWithLogging cp
+              createProcessWithFileLogging cp
           )
-          (\_ -> do
+          (\_ ->
               void $ liftIO $ readCreateProcess (shell [i|#{containerOptionsSystem} rm -f --volumes #{containerName}|]) ""
           )
           (\p -> do
diff --git a/sandwich-contexts/lib/Test/Sandwich/Contexts/FakeSmtpServer.hs b/sandwich-contexts/lib/Test/Sandwich/Contexts/FakeSmtpServer.hs
index f3392379..5e098e6e 100644
--- a/sandwich-contexts/lib/Test/Sandwich/Contexts/FakeSmtpServer.hs
+++ b/sandwich-contexts/lib/Test/Sandwich/Contexts/FakeSmtpServer.hs
@@ -54,6 +54,7 @@ import Test.Sandwich.Contexts.Files
 import Test.Sandwich.Contexts.HttpWaits
 import Test.Sandwich.Contexts.Nix
 import Test.Sandwich.Contexts.Util.Aeson
+import UnliftIO.Async
 import UnliftIO.Directory
 import UnliftIO.Exception
 
@@ -178,8 +179,9 @@ withFakeSMTPServer (FakeSmtpServerOptions {..}) action = do
                                            create_group = True
                                            })
           )
-          (\p -> do
-              void $ liftIO (interruptProcessGroupOf p >> waitForProcess p)
+          (\(p, asy) -> do
+              finally (void $ liftIO (interruptProcessGroupOf p >> waitForProcess p))
+                      (cancel asy)
           )
           (\_ -> do
               let hostname = "localhost"
diff --git a/sandwich-contexts/lib/Test/Sandwich/Contexts/Nix.hs b/sandwich-contexts/lib/Test/Sandwich/Contexts/Nix.hs
index 06b3c628..42fbfcbd 100644
--- a/sandwich-contexts/lib/Test/Sandwich/Contexts/Nix.hs
+++ b/sandwich-contexts/lib/Test/Sandwich/Contexts/Nix.hs
@@ -83,7 +83,7 @@ import Test.Sandwich
 import Test.Sandwich.Contexts.Files.Types
 import Test.Sandwich.Contexts.Util.Aeson
 import qualified Text.Show
-import UnliftIO.Async
+import UnliftIO.Async (Async, wait)
 import UnliftIO.Directory
 import UnliftIO.Environment
 import UnliftIO.MVar (modifyMVar)
@@ -359,7 +359,7 @@ buildNixCallPackageDerivation' nc@(NixContext {..}) derivation = do
     case M.lookup derivation m of
       Just x -> return (m, x)
       Nothing -> do
-        asy <- async $ do
+        asy <- managedAsync "nix-build-call-package" $ do
           maybeNixExpressionDir <- getCurrentFolder >>= \case
             Just dir -> (Just <$>) $ liftIO $ createTempDirectory dir "nix-expression"
             Nothing -> return Nothing
@@ -399,7 +399,7 @@ buildNixExpression' nc@(NixContext {..}) expr = do
     case M.lookup expr m of
       Just x -> return (m, x)
       Nothing -> do
-        asy <- async $ do
+        asy <- managedAsync "nix-build-expression" $ do
           maybeNixExpressionDir <- getCurrentFolder >>= \case
             Just dir -> (Just <$>) $ liftIO $ createTempDirectory dir "nix-expression"
             Nothing -> pure Nothing
@@ -413,7 +413,7 @@ buildNixExpression' nc@(NixContext {..}) expr = do
 --   nc <- getContext nixContext
 --   runNixBuild' nc expr outputPath
 
-runNixBuild' :: (MonadUnliftIO m, MonadLogger m) => NixContext -> Text -> Maybe String -> m String
+runNixBuild' :: (MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => NixContext -> Text -> Maybe String -> m String
 runNixBuild' (NixContext {nixContextNixpkgsDerivation}) expr maybeOutputPath = do
   maybeEnv <- case nixpkgsDerivationAllowUnfree nixContextNixpkgsDerivation of
     False -> pure Nothing
diff --git a/sandwich-contexts/lib/Test/Sandwich/Contexts/PostgreSQL.hs b/sandwich-contexts/lib/Test/Sandwich/Contexts/PostgreSQL.hs
index ffcf33a9..afdb1c30 100644
--- a/sandwich-contexts/lib/Test/Sandwich/Contexts/PostgreSQL.hs
+++ b/sandwich-contexts/lib/Test/Sandwich/Contexts/PostgreSQL.hs
@@ -69,6 +69,7 @@ import Test.Sandwich.Contexts.ReverseProxy.TCP
 import Test.Sandwich.Contexts.Types.Network
 import Test.Sandwich.Contexts.UnixSocketPath
 import Test.Sandwich.Contexts.Util.UUID (makeUUID)
+import UnliftIO.Async
 import UnliftIO.Directory
 import UnliftIO.Environment
 import UnliftIO.Exception
@@ -261,15 +262,17 @@ withPostgresUnixSocket postgresBinDir username password database extraLines acti
         withTempFile baseDir "pwfile" $ \pwfile h -> do
           liftIO $ T.hPutStrLn h password
           hClose h
-          createProcessWithLogging ((proc (postgresBinDir </> "initdb") [dbDirName
-                                                                          , "--username", toString username
-                                                                          , "-A", "md5"
-                                                                          , "--pwfile", pwfile
-                                                                          ]) {
-                                       cwd = Just dir
-                                       , env = Just env
-                                       })
-            >>= waitForProcess >>= (`shouldBe` ExitSuccess)
+          (ps, asy) <- createProcessWithLogging (
+            (proc (postgresBinDir </> "initdb") [dbDirName
+                                                , "--username", toString username
+                                                , "-A", "md5"
+                                                , "--pwfile", pwfile
+                                                ]) {
+                cwd = Just dir
+                , env = Just env
+                })
+          finally (waitForProcess ps >>= (`shouldBe` ExitSuccess))
+                  (cancel asy)
 
         -- Turn off the TCP interface; we'll have it listen solely on a Unix socket
         withFile (dir </> dbDirName </> "postgresql.conf") AppendMode $ \h -> liftIO $ do
@@ -287,7 +290,8 @@ withPostgresUnixSocket postgresBinDir username password database extraLines acti
                                       , "-o", [i|--unix_socket_directories='#{unixSockDir}'|]
                                       , "start" , "--wait"
                                       ]) { cwd = Just dir })
-          >>= waitForProcess >>= (`shouldBe` ExitSuccess)
+          >>= \(ps, asy) -> finally (waitForProcess ps >>= (`shouldBe` ExitSuccess))
+                                    (cancel asy)
 
         -- Create the default db
         createProcessWithLogging ((proc (postgresBinDir </> "psql") [
@@ -296,7 +300,8 @@ withPostgresUnixSocket postgresBinDir username password database extraLines acti
                                       [i|postgresql://#{username}:#{password}@/?host=#{unixSockDir}|]
                                       , "-c", [i|CREATE DATABASE #{database};|]
                                       ]) { cwd = Just dir })
-          >>= waitForProcess >>= (`shouldBe` ExitSuccess)
+          >>= \(ps, asy) -> finally (waitForProcess ps >>= (`shouldBe` ExitSuccess))
+                                    (cancel asy)
 
 
         files <- listDirectory unixSockDir
@@ -356,17 +361,18 @@ withPostgresContainer :: (
   -> m a
 withPostgresContainer options action = do
   bracket (createPostgresDatabase options)
-          (\(containerName, _p) -> timeAction "cleanup Postgres database" $ do
-              info [i|Doing #{postgresContainerContainerSystem options} rm -f --volumes #{containerName}|]
-              (exitCode, sout, serr) <-  liftIO $ readCreateProcessWithExitCode (shell [i|#{postgresContainerContainerSystem options} rm -f --volumes #{containerName}|]) ""
-              when (exitCode /= ExitSuccess) $
-                expectationFailure [i|Failed to destroy Postgres container. Stdout: '#{sout}'. Stderr: '#{serr}'|]
+          (\(containerName, _p, asy) -> timeAction "cleanup Postgres database" $ do
+              flip finally (cancel asy) $ do
+                info [i|Doing #{postgresContainerContainerSystem options} rm -f --volumes #{containerName}|]
+                (exitCode, sout, serr) <-  liftIO $ readCreateProcessWithExitCode (shell [i|#{postgresContainerContainerSystem options} rm -f --volumes #{containerName}|]) ""
+                when (exitCode /= ExitSuccess) $
+                  expectationFailure [i|Failed to destroy Postgres container. Stdout: '#{sout}'. Stderr: '#{serr}'|]
           )
           (waitForPostgresDatabase options >=> action)
 
 createPostgresDatabase :: (
   HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m
-  ) => PostgresContainerOptions -> m (Text, ProcessHandle)
+  ) => PostgresContainerOptions -> m (Text, ProcessHandle, Async ())
 createPostgresDatabase (PostgresContainerOptions {..}) = timeAction "create Postgres database" $ do
   containerName <- maybe (("postgres-" <>) <$> makeUUID) return postgresContainerContainerName
 
@@ -386,13 +392,13 @@ createPostgresDatabase (PostgresContainerOptions {..}) = timeAction "create Post
 
   info [i|cmd: #{containerSystem} #{T.unwords args}|]
 
-  p <- createProcessWithLogging (proc (show containerSystem) (fmap toString args))
-  return (containerName, p)
+  (p, asy) <- createProcessWithLogging (proc (show containerSystem) (fmap toString args))
+  return (containerName, p, asy)
 
 waitForPostgresDatabase :: (
   MonadUnliftIO m, MonadLoggerIO m, MonadMask m
-  ) => PostgresContainerOptions -> (Text, ProcessHandle) -> m PostgresContext
-waitForPostgresDatabase (PostgresContainerOptions {..}) (containerName, p) = do
+  ) => PostgresContainerOptions -> (Text, ProcessHandle, Async ()) -> m PostgresContext
+waitForPostgresDatabase (PostgresContainerOptions {..}) (containerName, p, _) = do
   containerID <- waitForProcess p >>= \case
     ExitSuccess -> containerNameToContainerId postgresContainerContainerSystem containerName
     _ -> expectationFailure [i|Failed to start Postgres container.|]
diff --git a/sandwich-contexts/lib/Test/Sandwich/Contexts/ReverseProxy/TCP.hs b/sandwich-contexts/lib/Test/Sandwich/Contexts/ReverseProxy/TCP.hs
index 38722433..cb75f630 100644
--- a/sandwich-contexts/lib/Test/Sandwich/Contexts/ReverseProxy/TCP.hs
+++ b/sandwich-contexts/lib/Test/Sandwich/Contexts/ReverseProxy/TCP.hs
@@ -14,13 +14,13 @@ import Data.Streaming.Network (setAfterBind)
 import Data.String.Interpolate
 import Network.Socket
 import Relude
-import Test.Sandwich (expectationFailure)
-import UnliftIO.Async
+import Test.Sandwich (expectationFailure, HasBaseContextMonad, managedWithAsync_)
+import UnliftIO.Async (concurrently_)
 import UnliftIO.Exception
 import UnliftIO.Timeout
 
 
-withProxyToUnixSocket :: MonadUnliftIO m => FilePath -> (PortNumber -> m a) -> m a
+withProxyToUnixSocket :: (MonadUnliftIO m, HasBaseContextMonad context m) => FilePath -> (PortNumber -> m a) -> m a
 withProxyToUnixSocket socketPath f = do
   portVar <- newEmptyMVar
   let ss = DCN.serverSettings 0 "*"
@@ -30,7 +30,7 @@ withProxyToUnixSocket socketPath f = do
                SockAddrInet6 port _ _ _ -> putMVar portVar port
                x -> expectationFailure [i|withProxyToUnixSocket: expected to bind a TCP socket, but got other addr: #{x}|]
            )
-  withAsync (liftIO $ DCN.runTCPServer ss app `onException` (tryPutMVar portVar (-1))) $ \_ ->
+  managedWithAsync_ "tcp-reverse-proxy" (liftIO $ DCN.runTCPServer ss app `onException` (tryPutMVar portVar (-1))) $
     timeout 60_000_000 (readMVar portVar) >>= \case
       Nothing -> expectationFailure [i|withProxyToUnixSocket: didn't get port within 60s|]
       Just (-1) -> expectationFailure [i|withProxyToUnixSocket: TCP server threw exception|]
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Chrome.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Chrome.hs
index ec26fe52..ef88a820 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Chrome.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Chrome.hs
@@ -32,10 +32,11 @@ import Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform
 import UnliftIO.Directory
 
 
-type Constraints m = (
+type Constraints context m = (
   HasCallStack
   , MonadLogger m
   , MonadUnliftIO m
+  , HasBaseContextMonad context m
   )
 
 -- | Manually obtain a chrome binary, according to the 'ChromeToUse' policy,
@@ -108,7 +109,7 @@ obtainChromeDriver (UseChromeDriverFromNixpkgs nixContext) = do
   debug [i|Built chromedriver: #{ret}|]
   return $ Right ret
 
-downloadChromeDriverIfNecessary' :: Constraints m => FilePath -> ChromeDriverVersion -> m (Either T.Text FilePath)
+downloadChromeDriverIfNecessary' :: Constraints context m => FilePath -> ChromeDriverVersion -> m (Either T.Text FilePath)
 downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion = runExceptT $ do
   let chromeDriverPath = getChromeDriverPath toolsDir chromeDriverVersion
 
@@ -118,7 +119,7 @@ downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion = runExceptT $ do
 
   return chromeDriverPath
 
-downloadChromeDriverIfNecessary :: Constraints m => FilePath -> FilePath -> m (Either T.Text FilePath)
+downloadChromeDriverIfNecessary :: Constraints context m => FilePath -> FilePath -> m (Either T.Text FilePath)
 downloadChromeDriverIfNecessary chromePath toolsDir = runExceptT $ do
   chromeDriverVersion <- ExceptT $ liftIO $ getChromeDriverVersion chromePath
   ExceptT $ downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Common.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Common.hs
index 642c14f3..e75fb3bf 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Common.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Common.hs
@@ -1,58 +1,65 @@
 
 module Test.Sandwich.WebDriver.Internal.Binaries.Common where
 
-import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.IO.Unlift
 import Control.Monad.Logger
 import Data.String.Interpolate
 import qualified Data.Text as T
-import System.Directory
 import System.Exit
 import System.FilePath
-import System.Process
 import Test.Sandwich.Expectations
 import Test.Sandwich.Logging
+import Test.Sandwich.Misc (HasBaseContextMonad)
 import Test.Sandwich.WebDriver.Internal.Util
+import UnliftIO.Async
+import UnliftIO.Directory
+import UnliftIO.Exception
+import UnliftIO.Process
 import UnliftIO.Temporary
 
 
-downloadAndUnzipToPath :: (MonadUnliftIO m, MonadLogger m) => T.Text -> FilePath -> m (Either T.Text ())
+downloadAndUnzipToPath :: (MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => T.Text -> FilePath -> m (Either T.Text ())
 downloadAndUnzipToPath downloadPath localPath = leftOnException' $ do
   info [i|Downloading #{downloadPath} to #{localPath}|]
-  liftIO $ createDirectoryIfMissing True (takeDirectory localPath)
+  createDirectoryIfMissing True (takeDirectory localPath)
   withSystemTempDirectory "sandwich-webdriver-tool-download" $ \dir -> do
     curlDownloadToPath (T.unpack downloadPath) (dir </> "temp.zip")
 
     createProcessWithLogging ((proc "unzip" ["temp.zip", "-d", "unzipped"]) { cwd = Just dir })
-      >>= liftIO . waitForProcess >>= (`shouldBe` ExitSuccess)
+      >>= \(ps, asy) -> finally (waitForProcess ps >>= (`shouldBe` ExitSuccess))
+                                (cancel asy)
     let unzipped = dir </> "unzipped"
 
     executables <- (filter (/= "") . T.splitOn "\n" . T.pack) <$> readCreateProcessWithLogging (proc "find" [unzipped, "-executable", "-type", "f"]) ""
     case executables of
-      [] -> liftIO $ throwIO $ userError [i|No executable found in file downloaded from #{downloadPath}|]
+      [] -> throwIO $ userError [i|No executable found in file downloaded from #{downloadPath}|]
       [x] -> do
-        liftIO $ copyFile (T.unpack x) localPath
+        copyFile (T.unpack x) localPath
         createProcessWithLogging (shell [i|chmod u+x #{localPath}|])
-          >>= liftIO . waitForProcess >>= (`shouldBe` ExitSuccess)
-      xs -> liftIO $ throwIO $ userError [i|Found multiple executable found in file downloaded from #{downloadPath}: #{xs}|]
+          >>= \(ps, asy) -> finally (waitForProcess ps >>= (`shouldBe` ExitSuccess))
+                                    (cancel asy)
+      xs -> throwIO $ userError [i|Found multiple executable found in file downloaded from #{downloadPath}: #{xs}|]
 
-downloadAndUntarballToPath :: (MonadUnliftIO m, MonadLogger m) => T.Text -> FilePath -> m (Either T.Text ())
+downloadAndUntarballToPath :: (MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => T.Text -> FilePath -> m (Either T.Text ())
 downloadAndUntarballToPath downloadPath localPath = leftOnException' $ do
   info [i|Downloading #{downloadPath} to #{localPath}|]
-  liftIO $ createDirectoryIfMissing True (takeDirectory localPath)
+  createDirectoryIfMissing True (takeDirectory localPath)
   createProcessWithLogging (shell [i|wget -qO- #{downloadPath} | tar xvz  -C #{takeDirectory localPath}|])
-    >>= liftIO . waitForProcess >>= (`shouldBe` ExitSuccess)
+    >>= \(ps, asy) -> finally (liftIO $ waitForProcess ps >>= (`shouldBe` ExitSuccess))
+                              (cancel asy)
   createProcessWithLogging (shell [i|chmod u+x #{localPath}|])
-    >>= liftIO . waitForProcess >>= (`shouldBe` ExitSuccess)
+    >>= \(ps, asy) -> finally (liftIO $ waitForProcess ps >>= (`shouldBe` ExitSuccess))
+                              (cancel asy)
 
-curlDownloadToPath :: (MonadUnliftIO m, MonadLogger m) => String -> FilePath -> m ()
+curlDownloadToPath :: (MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => String -> FilePath -> m ()
 curlDownloadToPath downloadPath localPath = do
   info [i|Downloading #{downloadPath} to #{localPath}|]
-  liftIO $ createDirectoryIfMissing True (takeDirectory localPath)
-  p <- createProcessWithLogging (proc "curl" [downloadPath, "-o", localPath, "-s"])
-  liftIO (waitForProcess p) >>= (`shouldBe` ExitSuccess)
+  createDirectoryIfMissing True (takeDirectory localPath)
+  (p, asy) <- createProcessWithLogging (proc "curl" [downloadPath, "-o", localPath, "-s"])
+  finally (liftIO (waitForProcess p) >>= (`shouldBe` ExitSuccess))
+          (cancel asy)
 
 unlessM :: Monad m => m Bool -> m () -> m ()
 unlessM b s = b >>= (\t -> unless t s)
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Selenium.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Selenium.hs
index c17bfdf4..93923f0a 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Selenium.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/Selenium.hs
@@ -24,10 +24,11 @@ import Test.Sandwich.WebDriver.Internal.Util
 import UnliftIO.Directory
 
 
-type Constraints m = (
+type Constraints context m = (
   HasCallStack
   , MonadLogger m
   , MonadUnliftIO m
+  , HasBaseContextMonad context m
   )
 
 -- * Obtaining binaries
@@ -76,13 +77,13 @@ obtainSelenium (UseSeleniumFromNixpkgs nc) = do
 
 -- * Lower level helpers
 
-downloadSeleniumIfNecessary :: Constraints m => FilePath -> m (Either T.Text FilePath)
+downloadSeleniumIfNecessary :: Constraints context m => FilePath -> m (Either T.Text FilePath)
 downloadSeleniumIfNecessary toolsDir = leftOnException' $ do
   let seleniumPath = [i|#{toolsDir}/selenium-server.jar|]
   liftIO (doesFileExist seleniumPath) >>= flip unless (downloadSelenium seleniumPath)
   return seleniumPath
   where
-    downloadSelenium :: Constraints m => FilePath -> m ()
+    downloadSelenium :: Constraints context m => FilePath -> m ()
     downloadSelenium seleniumPath = void $ do
       info [i|Downloading selenium-server.jar to #{seleniumPath}|]
       curlDownloadToPath defaultSeleniumJarUrl seleniumPath
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/OnDemand.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/OnDemand.hs
index 18cb8f3a..c93fb4a6 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/OnDemand.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/OnDemand.hs
@@ -7,19 +7,19 @@ import Data.String.Interpolate
 import Data.Text as T
 import Test.Sandwich
 import Test.Sandwich.WebDriver.Internal.Types
-import UnliftIO.Async
+import UnliftIO.Async (wait)
 import UnliftIO.Exception
 import UnliftIO.MVar
 
 
-getOnDemand :: forall m a. (
-  MonadUnliftIO m, MonadLogger m
+getOnDemand :: forall context m a. (
+  MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m
   ) => MVar (OnDemand a) -> m (Either Text a) -> m a
 getOnDemand onDemandVar doObtain = do
   result <- modifyMVar onDemandVar $ \case
     OnDemandErrored msg -> expectationFailure (T.unpack msg)
     OnDemandNotStarted -> do
-      asy <- async $ do
+      asy <- managedAsync "webdriver-on-demand" $ do
         let handler :: SomeException -> m a
             handler e = do
               modifyMVar_ onDemandVar (const $ return $ OnDemandErrored [i|Got exception: #{e}|])
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs
index 2c3b3592..e1f1fb77 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs
@@ -17,9 +17,9 @@ import GHC.Stack
 import Test.Sandwich.WebDriver.Internal.Types
 import qualified Test.WebDriver as W
 
-#ifndef mingw32_HOST_OS
-import Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb
-#endif
+-- #ifndef mingw32_HOST_OS
+-- import Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb
+-- #endif
 
 
 type Constraints m = (
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Video.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Video.hs
index 79370a57..35ff3f63 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Video.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Video.hs
@@ -48,6 +48,7 @@ import Test.Sandwich.WebDriver.Video.Internal
 import Test.Sandwich.WebDriver.Video.Types
 import Test.Sandwich.WebDriver.Windows
 import Test.WebDriver
+import UnliftIO.Async
 import UnliftIO.Directory
 import UnliftIO.Exception
 
@@ -61,6 +62,7 @@ type BaseVideoConstraints context m = (
 data VideoProcess = VideoProcess {
   -- | The process handle
   videoProcessProcess :: ProcessHandle
+  , videoProcessAsync :: Async ()
   , videoProcessCreatedFiles :: [FilePath]
   }
 -- defaultVideoProcess :: ProcessHandle -> VideoProcess
@@ -122,15 +124,16 @@ startVideoRecording path (width, height, x, y) vs = do
 
   case logToDisk vs of
     False -> do
-      p <- createProcessWithLogging cp
-      return $ VideoProcess p [videoPath]
+      (p, asy) <- createProcessWithLogging cp
+      return $ VideoProcess p asy [videoPath]
     True -> do
       let stdoutPath = path <.> "stdout" <.> "log"
       let stderrPath = path <.> "stderr" <.> "log"
       liftIO $ bracket (openFile stdoutPath AppendMode) hClose $ \hout ->
         bracket (openFile stderrPath AppendMode) hClose $ \herr -> do
           (_, _, _, p) <- createProcess (cp { std_out = UseHandle hout, std_err = UseHandle herr })
-          return $ VideoProcess p [videoPath, stdoutPath, stderrPath]
+          asy <- async $ return ()
+          return $ VideoProcess p asy [videoPath, stdoutPath, stderrPath]
 
 -- | Gracefully stop the 'ProcessHandle' returned by 'startVideoRecording'.
 endVideoRecording :: (
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Windows.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Windows.hs
index 262865fb..ee05ac9e 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Windows.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Windows.hs
@@ -69,7 +69,7 @@ getScreenResolution :: (MonadIO m) => TestWebDriverContext -> m (Int, Int, Int,
 -- getScreenResolution (TestWebDriverContext {wdWebDriver=(_, maybeXvfbSession)}) = case maybeXvfbSession of
 --   Nothing -> liftIO getResolution
 --   Just (XvfbSession {..}) -> liftIO $ getResolutionForDisplay xvfbDisplayNum
-getScreenResolution twdc = liftIO getResolution
+getScreenResolution _twdc = liftIO getResolution
 
 getScreenPixelDimensions :: (WebDriver m) => Int -> Int -> m (Double, Double)
 getScreenPixelDimensions width height = do
diff --git a/sandwich-webdriver/unix-src/Test/Sandwich/WebDriver/Internal/StartWebDriver/Xvfb.hs b/sandwich-webdriver/unix-src/Test/Sandwich/WebDriver/Internal/StartWebDriver/Xvfb.hs
index 71f12b62..50b92d8c 100644
--- a/sandwich-webdriver/unix-src/Test/Sandwich/WebDriver/Internal/StartWebDriver/Xvfb.hs
+++ b/sandwich-webdriver/unix-src/Test/Sandwich/WebDriver/Internal/StartWebDriver/Xvfb.hs
@@ -101,7 +101,7 @@ createXvfbSession webdriverRoot w h (Fd fd) xvfbToUse xvfbOnDemand = do
 
   -- Start the Xvfb session
   authFile <- liftIO $ writeTempFile webdriverRoot ".Xauthority" ""
-  p <- createProcessWithLogging $ (
+  p <- createProcessWithFileLogging $ (
     proc xvfb [":" <> show serverNum
               , "-screen", "0", [i|#{w}x#{h}x24|]
               , "-displayfd", [i|#{fd}|]
diff --git a/sandwich/package.yaml b/sandwich/package.yaml
index 5be75eb9..f08591c8 100644
--- a/sandwich/package.yaml
+++ b/sandwich/package.yaml
@@ -44,6 +44,7 @@ dependencies:
 - monad-control
 - monad-logger
 - mtl
+- network
 - optparse-applicative
 - pretty-show
 - process
@@ -86,6 +87,7 @@ library:
   - Test.Sandwich.Formatters.LogSaver
   - Test.Sandwich.Formatters.Print
   - Test.Sandwich.Formatters.Silent
+  - Test.Sandwich.Formatters.Socket
   - Test.Sandwich.Formatters.TerminalUI
   - Test.Sandwich.Internal
   - Test.Sandwich.TH
diff --git a/sandwich/sandwich.cabal b/sandwich/sandwich.cabal
index 8031b3bf..5e55166e 100644
--- a/sandwich/sandwich.cabal
+++ b/sandwich/sandwich.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.38.0.
+-- This file has been generated from package.yaml by hpack version 0.39.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -38,6 +38,7 @@ library
       Test.Sandwich.Formatters.LogSaver
       Test.Sandwich.Formatters.Print
       Test.Sandwich.Formatters.Silent
+      Test.Sandwich.Formatters.Socket
       Test.Sandwich.Formatters.TerminalUI
       Test.Sandwich.Internal
       Test.Sandwich.TH
@@ -57,8 +58,11 @@ library
       Test.Sandwich.Formatters.Print.PrintPretty
       Test.Sandwich.Formatters.Print.Types
       Test.Sandwich.Formatters.Print.Util
+      Test.Sandwich.Formatters.Socket.Commands
+      Test.Sandwich.Formatters.Socket.Server
       Test.Sandwich.Formatters.TerminalUI.AttrMap
       Test.Sandwich.Formatters.TerminalUI.CrossPlatform
+      Test.Sandwich.Formatters.TerminalUI.DebugSocket
       Test.Sandwich.Formatters.TerminalUI.Draw
       Test.Sandwich.Formatters.TerminalUI.Draw.ColorProgressBar
       Test.Sandwich.Formatters.TerminalUI.Draw.RunTimes
@@ -70,6 +74,7 @@ library
       Test.Sandwich.Formatters.TerminalUI.OpenInEditor
       Test.Sandwich.Formatters.TerminalUI.Types
       Test.Sandwich.Golden.Update
+      Test.Sandwich.Instrumentation
       Test.Sandwich.Internal.Formatters
       Test.Sandwich.Internal.Inspection
       Test.Sandwich.Internal.Running
@@ -81,6 +86,9 @@ library
       Test.Sandwich.Interpreters.RunTree.Logging
       Test.Sandwich.Interpreters.RunTree.Util
       Test.Sandwich.Interpreters.StartTree
+      Test.Sandwich.Logging.Process
+      Test.Sandwich.Logging.ProcessFileLogging
+      Test.Sandwich.ManagedAsync
       Test.Sandwich.ParallelN
       Test.Sandwich.RunTree
       Test.Sandwich.Shutdown
@@ -128,6 +136,7 @@ library
     , monad-control
     , monad-logger
     , mtl
+    , network
     , optparse-applicative
     , pretty-show
     , process
@@ -190,6 +199,7 @@ executable sandwich-demo
     , monad-control
     , monad-logger
     , mtl
+    , network
     , optparse-applicative
     , pretty-show
     , process
@@ -250,6 +260,7 @@ executable sandwich-discover
     , monad-control
     , monad-logger
     , mtl
+    , network
     , optparse-applicative
     , pretty-show
     , process
@@ -316,6 +327,7 @@ executable sandwich-test
     , monad-control
     , monad-logger
     , mtl
+    , network
     , optparse-applicative
     , pretty-show
     , process
@@ -383,6 +395,7 @@ test-suite sandwich-test-suite
     , monad-control
     , monad-logger
     , mtl
+    , network
     , optparse-applicative
     , pretty-show
     , process
diff --git a/sandwich/src/Test/Sandwich.hs b/sandwich/src/Test/Sandwich.hs
index ba5e4bd2..b3ef909a 100644
--- a/sandwich/src/Test/Sandwich.hs
+++ b/sandwich/src/Test/Sandwich.hs
@@ -56,6 +56,15 @@ module Test.Sandwich (
   , withTimingProfile
   , withTimingProfile'
 
+  -- * Managed async
+  --
+  -- | If you want to run asyncs within your tests, we can help keep track of
+  -- them and make sure they get cleaned up.
+  , managedAsync
+  , managedAsyncWithUnmask
+  , managedWithAsync
+  , managedWithAsync_
+
   -- * Exports
   , module Test.Sandwich.Contexts
   , module Test.Sandwich.Expectations
@@ -72,6 +81,7 @@ import qualified Control.Exception as E
 import Control.Monad
 import Control.Monad.Free
 import Control.Monad.IO.Class
+import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Logger
 import Control.Monad.Reader
 import qualified Data.Aeson as A
@@ -84,22 +94,27 @@ import qualified Data.Map as M
 import Data.Maybe
 import Data.String.Interpolate
 import qualified Data.Text as T
+import Data.Time (getCurrentTime)
+import Debug.Trace (traceMarkerIO)
 import GHC.IO.Encoding
 import Options.Applicative
 import qualified Options.Applicative as OA
 import System.Environment
 import System.Exit
 import System.FilePath
+import System.IO (hSetBuffering, BufferMode(..), IOMode(..), openFile, hClose)
 import Test.Sandwich.ArgParsing
 import Test.Sandwich.Contexts
 import Test.Sandwich.Expectations
 import Test.Sandwich.Formatters.Common.Count
 import Test.Sandwich.Golden.Update
+import Test.Sandwich.Instrumentation
 import Test.Sandwich.Internal.Running
 import Test.Sandwich.Interpreters.FilterTreeModule
 import Test.Sandwich.Interpreters.RunTree
 import Test.Sandwich.Interpreters.RunTree.Util
 import Test.Sandwich.Logging
+import qualified Test.Sandwich.ManagedAsync as MA
 import Test.Sandwich.Misc
 import Test.Sandwich.Nodes
 import Test.Sandwich.Options
@@ -169,12 +184,14 @@ runSandwichWithCommandLineArgs' baseOptions userOptionsParser spec = do
          let cliNodeOptions = defaultNodeOptions { nodeOptionsVisibilityThreshold = systemVisibilityThreshold
                                                  , nodeOptionsCreateFolder = False }
 
-         runWithRepeat repeatCount totalTests $
+         let mkRunId idx = if repeatCount == 1 then "run" else [i|repeat-#{idx}|]
+         runWithRepeat repeatCount totalTests $ \repeatIdx -> do
+           let opts = options { optionsRunId = mkRunId repeatIdx }
            case optIndividualTestModule clo of
-             Nothing -> runSandwich' (Just $ clo { optUserOptions = () }) options $
+             Nothing -> runSandwich' (Just $ clo { optUserOptions = () }) opts $
                introduce' cliNodeOptions "some command line options" someCommandLineOptions (pure (SomeCommandLineOptions clo)) (const $ return ())
                  $ introduce' cliNodeOptions "command line options" commandLineOptions (pure clo) (const $ return ()) spec
-             Just (IndividualTestModuleName x) -> runSandwich' (Just $ clo { optUserOptions = () }) options $ filterTreeToModule x $
+             Just (IndividualTestModuleName x) -> runSandwich' (Just $ clo { optUserOptions = () }) opts $ filterTreeToModule x $
                introduce' cliNodeOptions "some command line options" someCommandLineOptions (pure (SomeCommandLineOptions clo)) (const $ return ())
                  $ introduce' cliNodeOptions "command line options" commandLineOptions (pure clo) (const $ return ()) spec
              Just (IndividualTestMainFn x) -> do
@@ -193,8 +210,26 @@ runSandwichWithCommandLineArgs' baseOptions userOptionsParser spec = do
 -- may also include other nodes like "introduce" nodes).
 runSandwich' :: Maybe (CommandLineOptions ()) -> Options -> CoreSpec -> IO (ExitReason, Int, Int)
 runSandwich' maybeCommandLineOptions options spec' = do
+  let runId = optionsRunId options
   baseContext <- baseContextFromOptions options
 
+  -- Open late-log file if --log-logs is active
+  maybeLateLogHandle <- case (maybeCommandLineOptions, baseContextRunRoot baseContext) of
+    (Just clo, Just runRoot) | optLogLogs clo -> do
+      h <- openFile (runRoot </> "late-logs.log") AppendMode
+      hSetBuffering h LineBuffering
+      return (Just h)
+    _ -> return Nothing
+
+  let options' = options { optionsLateLogFile = maybeLateLogHandle }
+
+  let milestone msg = do
+        traceMarkerIO [i|sandwich: #{msg}|]
+        now <- getCurrentTime
+        case optionsEventBroadcast options' of
+          Just chan -> atomically $ writeTChan chan (NodeEvent now 0 "sandwich" (EventMilestone msg))
+          Nothing -> return ()
+
   -- To prevent weird errors saving files like "commitAndReleaseBuffer: invalid argument (invalid character)",
   -- especially on Windows
   -- See https://gitlab.haskell.org/ghc/ghc/issues/8118
@@ -213,15 +248,46 @@ runSandwich' maybeCommandLineOptions options spec' = do
                         , nodeOptionsCreateFolder = False
                         }) "Finalize test timer" (asks getTestTimer >>= liftIO . finalizeSpeedScopeTestTimer) spec'
 
-  rts <- startSandwichTree' baseContext options spec
-
-  formatterAsyncs <- forM (optionsFormatters options) $ \(SomeFormatter f) -> async $ do
-    let loggingFn = case baseContextRunRoot baseContext of
-          Nothing -> flip runLoggingT (\_ _ _ _ -> return ())
-          Just rootPath -> runFileLoggingT (rootPath </> (formatterName f) <.> "log")
-
-    loggingFn $
-      runFormatter f rts maybeCommandLineOptions baseContext
+  milestone "startSandwichTree'"
+  rts <- startSandwichTree' baseContext options' spec
+
+  milestone "spawning formatters"
+  formatterAsyncs <- forM (optionsFormatters options') $ \(SomeFormatter f) ->
+    MA.managedAsync runId (T.pack [i|formatter:#{formatterName f}|]) $ do
+      let loggingFn = case baseContextRunRoot baseContext of
+            Nothing -> flip runLoggingT (\_ _ _ _ -> return ())
+            Just rootPath -> runFileLoggingT (rootPath </> (formatterName f) <.> "log")
+
+      loggingFn $
+        runFormatter f rts maybeCommandLineOptions baseContext
+
+  -- Spawn file writer asyncs for --log-logs, --log-events, --log-rts-stats, --log-events (managed-asyncs)
+  milestone "spawning file stream asyncs"
+  (fileStreamAsyncs, maybeManagedAsyncStreamAsync) <- case (maybeCommandLineOptions, baseContextRunRoot baseContext) of
+    (Just clo, Just runRoot) -> do
+      others <- fmap catMaybes $ sequence
+        [ if optLogLogs clo
+          then case optionsLogBroadcast options' of
+            Just chan -> Just <$> MA.managedAsync runId "stream-logs" (streamLogsToFile (runRoot </> "all-logs.log") chan)
+            Nothing -> return Nothing
+          else return Nothing
+        , if optLogEvents clo
+          then do
+            writeTreeFile (runRoot </> "events-tree.txt") rts
+            case optionsEventBroadcast options' of
+              Just chan -> Just <$> MA.managedAsync runId "stream-events" (streamEventsToFile (runRoot </> "events.log") chan)
+              Nothing -> return Nothing
+          else return Nothing
+        , if optLogRtsStats clo
+          then Just <$> MA.managedAsync runId "stream-rts-stats" (streamRtsStatsToFile (runRoot </> "rts-stats.log"))
+          else return Nothing
+        ]
+      -- Spawn the managed-async event stream separately so we can cancel it last
+      maybeManagedAsync <- if optLogAsyncs clo
+        then Just <$> MA.managedAsync runId "stream-managed-asyncs" (streamManagedAsyncEventsToFile (runRoot </> "asyncs.log") MA.asyncEventBroadcast)
+        else return Nothing
+      return (others, maybeManagedAsync)
+    _ -> return ([], Nothing)
 
   exitReasonRef <- newIORef NormalExit
 
@@ -238,24 +304,50 @@ runSandwich' maybeCommandLineOptions options spec' = do
   _ <- installHandler sigTERM shutdown
 
   -- Wait for the tree to finish
+  milestone "waiting for tree"
   mapM_ waitForTree rts
+  milestone "tree finished"
 
   -- Wait for all formatters to finish
+  milestone "waiting for formatters"
   finalResults :: [Either E.SomeException ()] <- forM formatterAsyncs $ E.try . wait
   let failures = lefts finalResults
   unless (null failures) $
     putStrLn [i|Some formatters failed: '#{failures}'|]
+  milestone "formatters finished"
 
   -- Run finalizeFormatter method on formatters
-  forM_ (optionsFormatters options) $ \(SomeFormatter f) -> do
+  milestone "finalizing formatters"
+  forM_ (optionsFormatters options') $ \(SomeFormatter f) -> do
     let loggingFn = case baseContextRunRoot baseContext of
           Nothing -> flip runLoggingT (\_ _ _ _ -> return ())
           Just rootPath -> runFileLoggingT (rootPath </> (formatterName f) <.> "log")
 
     loggingFn $ finalizeFormatter f rts baseContext
 
+  milestone "fixing tree"
   fixedTree <- atomically $ mapM fixRunTree rts
 
+  -- Cancel file stream asyncs (but not the managed-async stream yet)
+  milestone "cancelling file stream asyncs"
+  mapM_ cancel fileStreamAsyncs
+
+  -- Cancel the managed-async stream last, so its finally block captures the final state
+  mapM_ cancel maybeManagedAsyncStreamAsync
+
+  -- Check for stale managed asyncs from this run
+  milestone "checking for stale asyncs"
+  allAsyncs <- MA.getManagedAsyncInfos
+  let staleAsyncs = M.filter (\x -> MA.asyncInfoRunId x == runId) allAsyncs
+  unless (M.null staleAsyncs) $ do
+    putStrLn [i|WARNING: #{M.size staleAsyncs} managed asyncs still running after tree finished:|]
+    forM_ (M.toList staleAsyncs) $ \(tid, x) ->
+      putStrLn [i|  #{tid}: #{MA.asyncInfoName x}|]
+
+  -- Close late-log file handle
+  mapM_ hClose maybeLateLogHandle
+
+  milestone "done"
   exitReason <- readIORef exitReasonRef
   let failedItBlocks = countWhere isFailedItBlock fixedTree
   let failedBlocks = countWhere isFailedBlock fixedTree
@@ -269,3 +361,21 @@ countItNodes (Free (IntroduceWith'' {..})) = countItNodes next + countItNodes su
 countItNodes (Free (Introduce'' {..})) = countItNodes next + countItNodes subspecAugmented
 countItNodes (Free x) = countItNodes (next x) + countItNodes (subspec x)
 countItNodes (Pure _) = 0
+
+-- * Managed async (context-aware aliases)
+
+-- | Launch a managed async thread, tracking it with the run ID from 'BaseContext'.
+managedAsync :: (MonadUnliftIO m, HasBaseContextMonad context m) => T.Text -> m a -> m (Async a)
+managedAsync = MA.managedAsyncContext
+
+-- | Like 'managedAsync', but the action receives an unmask function.
+managedAsyncWithUnmask :: (MonadUnliftIO m, HasBaseContextMonad context m) => T.Text -> ((forall b. m b -> m b) -> m a) -> m (Async a)
+managedAsyncWithUnmask = MA.managedAsyncWithUnmaskContext
+
+-- | Run a managed async thread scoped to a callback.
+managedWithAsync :: (MonadUnliftIO m, HasBaseContextMonad context m) => T.Text -> m a -> (Async a -> m b) -> m b
+managedWithAsync = MA.managedWithAsyncContext
+
+-- | Like 'managedWithAsync', but ignores the 'Async' handle.
+managedWithAsync_ :: (MonadUnliftIO m, HasBaseContextMonad context m) => T.Text -> m a -> m b -> m b
+managedWithAsync_ = MA.managedWithAsyncContext_
diff --git a/sandwich/src/Test/Sandwich/ArgParsing.hs b/sandwich/src/Test/Sandwich/ArgParsing.hs
index a318b082..ec04844e 100644
--- a/sandwich/src/Test/Sandwich/ArgParsing.hs
+++ b/sandwich/src/Test/Sandwich/ArgParsing.hs
@@ -5,6 +5,7 @@
 
 module Test.Sandwich.ArgParsing where
 
+import Control.Concurrent.STM
 import Control.Monad.Logger
 import Data.Function
 import qualified Data.List as L
@@ -19,6 +20,7 @@ import Test.Sandwich.Formatters.FailureReport
 import Test.Sandwich.Formatters.MarkdownSummary
 import Test.Sandwich.Formatters.Print.Types
 import Test.Sandwich.Formatters.Silent
+import Test.Sandwich.Formatters.Socket
 import Test.Sandwich.Formatters.TerminalUI
 import Test.Sandwich.Formatters.TerminalUI.Types
 import Test.Sandwich.Internal.Running
@@ -94,6 +96,12 @@ mainCommandLineOptions userOptionsParser individualTestParser = CommandLineOptio
   <*> optional (option auto (long "warn-on-long-execution-ms" <> showDefault <> help "Warn on long-running nodes by writing to a file in the run root." <> metavar "INT"))
   <*> optional (option auto (long "cancel-on-long-execution-ms" <> showDefault <> help "Cancel long-running nodes and write to a file in the run root." <> metavar "INT"))
   <*> optional (strOption (long "markdown-summary" <> help "File path to write a Markdown summary of the results." <> metavar "STRING"))
+  <*> switch (long "tui-debug" <> help "Enable TUI debug socket at <test-root>/tui-debug.sock")
+  <*> switch (long "socket" <> help "Enable interactive socket formatter at <test-root>/socket.sock")
+  <*> switch (long "log-logs" <> help "Stream all test logs to <run-root>/logs.txt (for debugging)")
+  <*> switch (long "log-events" <> help "Stream node lifecycle events to <run-root>/events.txt (for debugging)")
+  <*> switch (long "log-rts-stats" <> help "Stream RTS memory stats to <run-root>/rts-stats.txt (for debugging)")
+  <*> switch (long "log-asyncs" <> help "Stream managed async lifecycle events to <run-root>/managed-asyncs.log (for debugging)")
 
   <*> optional (flag False True (long "list-tests" <> help "List individual test modules"))
   <*> optional (flag False True (long "list-tests-json" <> help "List individual test modules in JSON format"))
@@ -253,17 +261,32 @@ addOptionsFromArgs baseOptions (CommandLineOptions {..}) = do
           printFormatter
         (_, TUI) ->
           let mainTerminalUiFormatter = headMay [x | SomeFormatter (cast -> Just x@(TerminalUIFormatter {})) <- optionsFormatters baseOptions]
-          in SomeFormatter $ (fromMaybe defaultTerminalUIFormatter mainTerminalUiFormatter) { terminalUILogLevel = optLogLevel }
+          in SomeFormatter $ (fromMaybe defaultTerminalUIFormatter mainTerminalUiFormatter) {
+            terminalUILogLevel = optLogLevel
+            , terminalUIDebugSocket = optTuiDebugSocket
+            }
         (_, Print) -> printFormatter
         (_, PrintFailures) -> failureReportFormatter
         (_, Silent) -> silentFormatter
 
   -- Strip out any "main" formatters since the options control that
-  let baseFormatters = optionsFormatters baseOptions
-                     & tryAddMarkdownSummaryFormatter optMarkdownSummaryPath
-                     & filter (not . isMainFormatter)
-
-  let finalFormatters = baseFormatters <> [mainFormatter]
+  (baseFormatters, socketLogBroadcast, socketEventBroadcast) <- optionsFormatters baseOptions
+                    & tryAddMarkdownSummaryFormatter optMarkdownSummaryPath
+                    & tryAddSocketFormatter optSocketFormatter
+  let baseFormatters' = filter (not . isMainFormatter) baseFormatters
+
+  -- Ensure broadcast channels exist if file logging flags need them
+  maybeLogBroadcast <- case socketLogBroadcast of
+    Just ch -> return (Just ch)
+    Nothing | optLogLogs -> Just <$> newBroadcastTChanIO
+    Nothing -> return Nothing
+
+  maybeEventBroadcast <- case socketEventBroadcast of
+    Just ch -> return (Just ch)
+    Nothing | optLogEvents -> Just <$> newBroadcastTChanIO
+    Nothing -> return Nothing
+
+  let finalFormatters = baseFormatters' <> [mainFormatter]
                       & fmap (setVisibilityThreshold optVisibilityThreshold)
 
   let options = baseOptions {
@@ -282,6 +305,8 @@ addOptionsFromArgs baseOptions (CommandLineOptions {..}) = do
     , optionsDryRun = fromMaybe (optionsDryRun baseOptions) optDryRun
     , optionsWarnOnLongExecutionMs = (optionsWarnOnLongExecutionMs baseOptions) <|> optWarnOnLongExecutionMs
     , optionsCancelOnLongExecutionMs = (optionsCancelOnLongExecutionMs baseOptions) <|> optCancelOnLongExecutionMs
+    , optionsLogBroadcast = maybeLogBroadcast
+    , optionsEventBroadcast = maybeEventBroadcast
     }
 
   return (options, optRepeatCount)
@@ -318,3 +343,20 @@ addOptionsFromArgs baseOptions (CommandLineOptions {..}) = do
     tryAddMarkdownSummaryFormatter (Just path) xs
       | L.any isMarkdownSummaryFormatter xs = fmap (setMarkdownSummaryFormatterPath path) xs
       | otherwise = (SomeFormatter (defaultMarkdownSummaryFormatter path)) : xs
+
+    isSocketFormatter :: SomeFormatter -> Bool
+    isSocketFormatter (SomeFormatter x) = case cast x of
+      Just (_ :: SocketFormatter) -> True
+      Nothing -> False
+
+    tryAddSocketFormatter :: Bool -> [SomeFormatter] -> IO ([SomeFormatter], Maybe (TChan (Int, String, LogEntry)), Maybe (TChan NodeEvent))
+    tryAddSocketFormatter False xs = return (xs, Nothing, Nothing)
+    tryAddSocketFormatter True xs
+      | L.any isSocketFormatter xs =
+          -- Extract the broadcast channels from the existing formatter
+          let logChan = headMay [socketFormatterLogBroadcast sf | SomeFormatter (cast -> Just sf@(SocketFormatter {})) <- xs]
+              eventChan = headMay [socketFormatterEventBroadcast sf | SomeFormatter (cast -> Just sf@(SocketFormatter {})) <- xs]
+          in return (xs, logChan, eventChan)
+      | otherwise = do
+          sf <- defaultSocketFormatter
+          return ((SomeFormatter sf) : xs, Just (socketFormatterLogBroadcast sf), Just (socketFormatterEventBroadcast sf))
diff --git a/sandwich/src/Test/Sandwich/Formatters/Print/Logs.hs b/sandwich/src/Test/Sandwich/Formatters/Print/Logs.hs
index d446b572..d0dbc8ab 100644
--- a/sandwich/src/Test/Sandwich/Formatters/Print/Logs.hs
+++ b/sandwich/src/Test/Sandwich/Formatters/Print/Logs.hs
@@ -7,6 +7,7 @@ import Control.Concurrent.STM
 import Control.Monad.IO.Class
 import Control.Monad.Logger
 import Control.Monad.Reader
+import qualified Data.ByteString.Char8 as BS8
 import Data.String.Interpolate
 import System.IO
 import Test.Sandwich.Formatters.Print.Color
@@ -30,7 +31,6 @@ printLogs runTreeLogs = do
         forM_ logEntries $ \entry ->
           when (logEntryLevel entry >= logLevel) $ printLogEntry entry
 
-
 printLogEntry :: (
   MonadReader (PrintFormatter, Int, Handle) m, MonadIO m
   ) => LogEntry -> m ()
@@ -53,7 +53,7 @@ printLogEntry (LogEntry {..}) = do
   pc logChColor (show ch)
   p "] "
 
-  p (show logEntryStr)
+  p (BS8.unpack logEntryStr)
 
   p "\n"
 
diff --git a/sandwich/src/Test/Sandwich/Formatters/Socket.hs b/sandwich/src/Test/Sandwich/Formatters/Socket.hs
new file mode 100644
index 00000000..1da1b0de
--- /dev/null
+++ b/sandwich/src/Test/Sandwich/Formatters/Socket.hs
@@ -0,0 +1,83 @@
+-- | The socket formatter creates a Unix domain socket that accepts interactive,
+-- line-based commands to query the live test tree state.
+--
+-- This is a "secondary formatter," i.e. one that can run in the background while
+-- a "primary formatter" (such as the TerminalUI or Print formatters) runs in the
+-- foreground.
+--
+-- The socket server stays alive for the entire duration of the test executable,
+-- so you can query it even after tests have completed (until 'finalizeFormatter'
+-- cleans it up).
+--
+-- Connect with @socat - UNIX-CONNECT:\<run-root\>/socket.sock@ and type
+-- @help@ to see available commands.
+
+module Test.Sandwich.Formatters.Socket (
+  defaultSocketFormatter
+  , SocketFormatter(..)
+  ) where
+
+import Control.Concurrent.STM
+import Control.Monad.IO.Class
+import Data.IORef
+import System.FilePath
+import Test.Sandwich.Formatters.Socket.Server
+import Test.Sandwich.Interpreters.RunTree.Util (waitForTree)
+import Test.Sandwich.ManagedAsync
+import Test.Sandwich.Types.ArgParsing
+import Test.Sandwich.Types.RunTree
+import UnliftIO.Async (Async, cancel)
+
+
+data SocketFormatter = SocketFormatter {
+  socketFormatterPath :: Maybe FilePath
+  -- ^ Socket path. Nothing = \<run-root\>/socket.sock
+  , socketFormatterServerAsync :: IORef (Maybe (Async ()))
+  -- ^ Internal: handle to the running server thread, used for cleanup.
+  , socketFormatterLogBroadcast :: TChan (Int, String, LogEntry)
+  -- ^ Broadcast channel for streaming logs to connected clients.
+  , socketFormatterEventBroadcast :: TChan NodeEvent
+  -- ^ Broadcast channel for streaming node lifecycle events to connected clients.
+  }
+
+instance Show SocketFormatter where
+  show (SocketFormatter {socketFormatterPath}) =
+    "SocketFormatter {socketFormatterPath = " <> show socketFormatterPath <> "}"
+
+defaultSocketFormatter :: IO SocketFormatter
+defaultSocketFormatter = do
+  ref <- newIORef Nothing
+  chan <- newBroadcastTChanIO
+  eventChan <- newBroadcastTChanIO
+  return SocketFormatter {
+    socketFormatterPath = Nothing
+    , socketFormatterServerAsync = ref
+    , socketFormatterLogBroadcast = chan
+    , socketFormatterEventBroadcast = eventChan
+    }
+
+instance Formatter SocketFormatter where
+  formatterName _ = "socket-formatter"
+  runFormatter = run
+  finalizeFormatter sf _ _ = liftIO $ do
+    mAsync <- readIORef (socketFormatterServerAsync sf)
+    case mAsync of
+      Nothing -> return ()
+      Just a -> cancel a
+
+run :: (MonadIO m) => SocketFormatter -> [RunNode BaseContext] -> Maybe (CommandLineOptions ()) -> BaseContext -> m ()
+run (SocketFormatter {..}) rts _maybeCommandLineOptions bc = do
+  let runId = baseContextRunId bc
+  case resolveSocketPath of
+    Nothing -> return ()
+    Just path -> liftIO $ do
+      a <- managedAsync runId "socket-server" (socketServer runId path rts socketFormatterLogBroadcast socketFormatterEventBroadcast)
+      writeIORef socketFormatterServerAsync (Just a)
+      -- Block until all tests complete
+      mapM_ waitForTree rts
+  where
+    resolveSocketPath = case socketFormatterPath of
+      Just p -> Just p
+      Nothing -> case baseContextRunRoot bc of
+        Just runRoot -> Just (runRoot </> "socket.sock")
+        Nothing -> Nothing
diff --git a/sandwich/src/Test/Sandwich/Formatters/Socket/Commands.hs b/sandwich/src/Test/Sandwich/Formatters/Socket/Commands.hs
new file mode 100644
index 00000000..f36607b4
--- /dev/null
+++ b/sandwich/src/Test/Sandwich/Formatters/Socket/Commands.hs
@@ -0,0 +1,246 @@
+{-# LANGUAGE RankNTypes #-}
+
+module Test.Sandwich.Formatters.Socket.Commands (
+  handleCommand
+  ) where
+
+import Control.Concurrent.STM
+import Control.Monad.Logger
+import qualified Data.ByteString.Char8 as BS8
+import Data.Foldable (toList)
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+import Data.String.Interpolate
+import Data.Time
+import Test.Sandwich.Formatters.Common.Count
+import Test.Sandwich.Formatters.Common.Util
+import Test.Sandwich.RunTree
+import Test.Sandwich.Types.RunTree
+import Test.Sandwich.Types.Spec
+import Text.Read (readMaybe)
+
+
+-- | Handle a single command and return the response text.
+-- The response does NOT include the trailing ".\n" terminator; the caller adds that.
+handleCommand :: [RunNode BaseContext] -> UTCTime -> String -> IO String
+handleCommand rts now cmd = case words cmd of
+  ["help"] -> return helpText
+  ["status"] -> cmdStatus rts
+  ["active"] -> cmdActive rts now
+  ["failures"] -> cmdFailures rts
+  ["pending"] -> cmdPending rts
+  ["tree"] -> cmdTree rts
+  ["node", idStr] -> case readMaybe idStr of
+    Just nid -> cmdNode rts nid
+    Nothing -> return [i|Error: invalid node id "#{idStr}"|]
+  ["logs", idStr] -> case readMaybe idStr of
+    Just nid -> cmdLogs rts nid
+    Nothing -> return [i|Error: invalid node id "#{idStr}"|]
+  [] -> return ""
+  (c:_) -> return [i|Unknown command: #{c}\nType "help" for available commands.|]
+
+helpText :: String
+helpText = unlines
+  [ "Available commands:"
+  , "  help        - Show this help"
+  , "  status      - Summary counts: total, running, succeeded, failed, pending, not started"
+  , "  active      - List currently running nodes"
+  , "  failures    - List failed nodes with failure reason"
+  , "  pending     - List pending nodes"
+  , "  tree        - Full tree with indented status"
+  , "  node <id>   - Detail for a specific node"
+  , "  logs <id>   - Show logs for a specific node"
+  , "  stream-logs      - Stream all logs live (disconnect to stop)"
+  , "  stream-events    - Stream node lifecycle events (started/done) live"
+  , "  stream-rts-stats - Stream GHC RTS memory stats every 1s (needs +RTS -T)"
+  ]
+
+-- | Snapshot the tree atomically
+snapshot :: [RunNode BaseContext] -> IO [RunNodeFixed BaseContext]
+snapshot rts = atomically $ mapM fixRunTree rts
+
+-- * Commands
+
+cmdStatus :: [RunNode BaseContext] -> IO String
+cmdStatus rts = do
+  fixed <- snapshot rts
+  let total = countWhere isItBlock fixed
+      running = countWhere isRunningItBlock fixed
+      succeeded = countWhere isSuccessItBlock fixed
+      failed = countWhere isFailedItBlock fixed
+      pend = countWhere isPendingItBlock fixed
+      notStarted = countWhere isNotStartedItBlock fixed
+  return $ unlines
+    [ [i|total:       #{total}|]
+    , [i|running:     #{running}|]
+    , [i|succeeded:   #{succeeded}|]
+    , [i|failed:      #{failed}|]
+    , [i|pending:     #{pend}|]
+    , [i|not started: #{notStarted}|]
+    ]
+
+cmdActive :: [RunNode BaseContext] -> UTCTime -> IO String
+cmdActive rts now = do
+  fixed <- snapshot rts
+  let nodes = concatMap (extractValues getActiveInfo) fixed
+      activeNodes = [x | Just x <- nodes]
+  if null activeNodes
+    then return "No nodes currently running."
+    else return $ unlines [formatActive n | n <- activeNodes]
+  where
+    getActiveInfo :: RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Maybe (String, Int, NominalDiffTime)
+    getActiveInfo node = case runTreeStatus (runNodeCommon node) of
+      Running {statusStartTime} ->
+        let c = runNodeCommon node
+        in Just (runTreeLabel c, runTreeId c, diffUTCTime now statusStartTime)
+      _ -> Nothing
+
+    formatActive (label, nid, elapsed) =
+      let elapsedStr = formatNominalDiffTime elapsed
+      in [i|  [#{nid}] #{label} (#{elapsedStr})|]
+
+cmdFailures :: [RunNode BaseContext] -> IO String
+cmdFailures rts = do
+  fixed <- snapshot rts
+  let nodes = concatMap (extractValues getFailureInfo) fixed
+      failedNodes = [x | Just x <- nodes]
+  if null failedNodes
+    then return "No failures."
+    else return $ unlines [formatFailure n | n <- failedNodes]
+  where
+    getFailureInfo :: RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Maybe (String, Int, FailureReason)
+    getFailureInfo node = case runTreeStatus (runNodeCommon node) of
+      Done {statusResult = Failure (Pending {})} -> Nothing
+      Done {statusResult = Failure reason} ->
+        let c = runNodeCommon node
+        in Just (runTreeLabel c, runTreeId c, reason)
+      _ -> Nothing
+
+    formatFailure (label, nid, reason) =
+      [i|  [#{nid}] #{label}: #{showFailureReason reason}|]
+
+cmdPending :: [RunNode BaseContext] -> IO String
+cmdPending rts = do
+  fixed <- snapshot rts
+  let nodes = concatMap (extractValues getPendingInfo) fixed
+      pendingNodes = [x | Just x <- nodes]
+  if null pendingNodes
+    then return "No pending nodes."
+    else return $ unlines [formatPendingNode n | n <- pendingNodes]
+  where
+    getPendingInfo :: RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Maybe (String, Int, Maybe String)
+    getPendingInfo node = case runTreeStatus (runNodeCommon node) of
+      Done {statusResult = Failure (Pending {failurePendingMessage})} ->
+        let c = runNodeCommon node
+        in Just (runTreeLabel c, runTreeId c, failurePendingMessage)
+      _ -> Nothing
+
+    formatPendingNode (label, nid, msg) = case msg of
+      Just m -> [i|  [#{nid}] #{label}: #{m}|]
+      Nothing -> [i|  [#{nid}] #{label}|]
+
+cmdTree :: [RunNode BaseContext] -> IO String
+cmdTree rts = do
+  fixed <- snapshot rts
+  return $ unlines $ concatMap (renderTree 0) fixed
+
+renderTree :: Int -> RunNodeWithStatus context Status (Seq LogEntry) Bool -> [String]
+renderTree depth node =
+  let c = runNodeCommon node
+      indent = replicate (depth * 2) ' '
+      statusStr = showStatusBrief (runTreeStatus c)
+      label = runTreeLabel c
+      nid = runTreeId c
+      line = [i|#{indent}[#{statusStr}] [#{nid}] #{label}|]
+      children = case node of
+        RunNodeIt {} -> []
+        RunNodeIntroduce {runNodeChildrenAugmented} -> concatMap (renderTree (depth + 1)) runNodeChildrenAugmented
+        RunNodeIntroduceWith {runNodeChildrenAugmented} -> concatMap (renderTree (depth + 1)) runNodeChildrenAugmented
+        _ -> concatMap (renderTree (depth + 1)) (runNodeChildren node)
+  in line : children
+
+cmdNode :: [RunNode BaseContext] -> Int -> IO String
+cmdNode rts nid = do
+  fixed <- snapshot rts
+  let allCommons = concatMap (extractValues (runNodeCommon)) fixed
+      match = [c | c <- allCommons, runTreeId c == nid]
+  case match of
+    [] -> return [i|Error: no node with id #{nid}|]
+    (c:_) -> return $ unlines
+      [ [i|id:     #{runTreeId c}|]
+      , [i|label:  #{runTreeLabel c}|]
+      , [i|status: #{showStatusDetail (runTreeStatus c)}|]
+      , [i|folder: #{maybe "(none)" id (runTreeFolder c)}|]
+      ]
+
+cmdLogs :: [RunNode BaseContext] -> Int -> IO String
+cmdLogs rts nid = do
+  fixed <- snapshot rts
+  let allNodes = concatMap (extractValues (\n -> (runNodeCommon n))) fixed
+      match = [c | c <- allNodes, runTreeId c == nid]
+  case match of
+    [] -> return [i|Error: no node with id #{nid}|]
+    (c:_) -> do
+      let logs = runTreeLogs c
+      if Seq.null logs
+        then return "(no logs)"
+        else return $ unlines [showLogEntry e | e <- toList logs]
+
+-- * Formatting helpers
+
+showStatusBrief :: Status -> String
+showStatusBrief NotStarted = "NOT STARTED"
+showStatusBrief (Running {}) = "RUNNING"
+showStatusBrief (Done {statusResult = Success}) = "OK"
+showStatusBrief (Done {statusResult = Failure (Pending {})}) = "PENDING"
+showStatusBrief (Done {statusResult = Failure _}) = "FAIL"
+showStatusBrief (Done {statusResult = DryRun}) = "DRY RUN"
+showStatusBrief (Done {statusResult = Cancelled}) = "CANCELLED"
+
+showStatusDetail :: Status -> String
+showStatusDetail NotStarted = "not started"
+showStatusDetail (Running {statusStartTime}) = [i|running (started #{show statusStartTime})|]
+showStatusDetail (Done {statusStartTime, statusEndTime, statusResult}) =
+  let elapsed = formatNominalDiffTime (diffUTCTime statusEndTime statusStartTime)
+  in [i|#{showResultBrief statusResult} (#{elapsed})|]
+
+showResultBrief :: Result -> String
+showResultBrief Success = "succeeded"
+showResultBrief (Failure (Pending {})) = "pending"
+showResultBrief (Failure _) = "failed"
+showResultBrief DryRun = "dry run"
+showResultBrief Cancelled = "cancelled"
+
+showFailureReason :: FailureReason -> String
+showFailureReason (Reason {failureReason}) = failureReason
+showFailureReason (ExpectedButGot {failureValue1, failureValue2}) =
+  [i|Expected #{show failureValue1} but got #{show failureValue2}|]
+showFailureReason (DidNotExpectButGot {failureValue1}) =
+  [i|Did not expect #{show failureValue1}|]
+showFailureReason (GotException {failureMessage, failureException}) =
+  case failureMessage of
+    Just msg -> [i|#{msg}: #{show failureException}|]
+    Nothing -> show failureException
+showFailureReason (Pending {failurePendingMessage}) =
+  maybe "pending" id failurePendingMessage
+showFailureReason (GetContextException {failureException}) =
+  [i|Context exception: #{show failureException}|]
+showFailureReason (GotAsyncException {failureMessage, failureAsyncException}) =
+  case failureMessage of
+    Just msg -> [i|#{msg}: #{show failureAsyncException}|]
+    Nothing -> show failureAsyncException
+showFailureReason (ChildrenFailed {failureNumChildren}) =
+  [i|#{failureNumChildren} children failed|]
+showFailureReason (RawImage {failureFallback}) = failureFallback
+
+showLogEntry :: LogEntry -> String
+showLogEntry (LogEntry {logEntryTime, logEntryLevel, logEntryStr}) =
+  let levelStr :: String
+      levelStr = case logEntryLevel of
+        LevelDebug -> "DEBUG"
+        LevelInfo -> "INFO"
+        LevelWarn -> "WARN"
+        LevelError -> "ERROR"
+        LevelOther t -> show t
+      msgStr = BS8.unpack logEntryStr
+  in [i|#{show logEntryTime} [#{levelStr}] #{msgStr}|]
diff --git a/sandwich/src/Test/Sandwich/Formatters/Socket/Server.hs b/sandwich/src/Test/Sandwich/Formatters/Socket/Server.hs
new file mode 100644
index 00000000..fc979ad2
--- /dev/null
+++ b/sandwich/src/Test/Sandwich/Formatters/Socket/Server.hs
@@ -0,0 +1,149 @@
+module Test.Sandwich.Formatters.Socket.Server (
+  socketServer
+  ) where
+
+import Control.Concurrent.STM
+import Control.Monad
+import Control.Monad.Logger
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS8
+import Data.IORef
+import Data.String.Interpolate
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Data.Time
+import GHC.Stats
+import Network.Socket
+import Network.Socket.ByteString (recv, sendAll)
+import System.Directory (removeFile)
+import Test.Sandwich.Formatters.Socket.Commands
+import Test.Sandwich.Instrumentation (formatRtsStats)
+import Test.Sandwich.ManagedAsync
+import Test.Sandwich.Types.RunTree
+import Test.Sandwich.Types.Spec
+import UnliftIO.Concurrent (threadDelay)
+import UnliftIO.Exception
+
+
+-- | Bidirectional Unix socket server. Each client connection reads line-based
+-- commands and sends back responses terminated by a line containing just ".".
+socketServer :: T.Text -> FilePath -> [RunNode BaseContext] -> TChan (Int, String, LogEntry) -> TChan NodeEvent -> IO ()
+socketServer runId socketPath rts logBroadcast eventBroadcast = do
+  -- Clean up any existing socket file
+  removeFile socketPath `catch` \(_ :: IOError) -> return ()
+
+  bracket (socket AF_UNIX Stream defaultProtocol) close $ \sock -> do
+    bind sock (SockAddrUnix socketPath)
+    listen sock 5
+    forever $ do
+      (conn, _) <- accept sock
+      void $ managedAsync runId "socket-connection" $ handleConnection conn rts logBroadcast eventBroadcast
+
+handleConnection :: Socket -> [RunNode BaseContext] -> TChan (Int, String, LogEntry) -> TChan NodeEvent -> IO ()
+handleConnection conn rts logBroadcast eventBroadcast = do
+  bufRef <- newIORef BS.empty
+  handle (\(_ :: IOError) -> close conn) $ do
+    sendAll conn "Connected to sandwich socket formatter. Type \"help\" for commands.\n\n> "
+    forever $ do
+      line <- readLine conn bufRef
+      now <- getCurrentTime
+      let cmd = BS8.unpack (stripCR line)
+      case words cmd of
+        ["stream-logs"] -> streamLogs conn logBroadcast
+        ["stream-events"] -> streamEvents conn eventBroadcast
+        ["stream-rts-stats"] -> streamRtsStats conn
+        _ -> do
+          response <- handleCommand rts now cmd
+          unless (null response) $ do
+            sendAll conn (BS8.pack response)
+            sendAll conn "\n"
+          sendAll conn "> "
+
+-- | Stream all log entries to the client until the connection is closed.
+-- This is a blocking operation that never returns to the command loop.
+streamLogs :: Socket -> TChan (Int, String, LogEntry) -> IO ()
+streamLogs conn broadcastChan = do
+  sendAll conn "Streaming logs (disconnect to stop)...\n"
+  -- Duplicate the broadcast channel to get our own read position
+  chan <- atomically $ dupTChan broadcastChan
+  handle (\(_ :: IOError) -> return ()) $ forever $ do
+    (nodeId, nodeLabel, LogEntry {..}) <- atomically $ readTChan chan
+    let levelStr :: String
+        levelStr = case logEntryLevel of
+          LevelDebug -> "DEBUG"
+          LevelInfo -> "INFO"
+          LevelWarn -> "WARN"
+          LevelError -> "ERROR"
+          LevelOther t -> show t
+        msgStr = BS8.unpack logEntryStr
+        formatted = [i|#{show logEntryTime} [#{levelStr}] [#{nodeId}] #{nodeLabel}: #{msgStr}\n|]
+    sendAll conn (BS8.pack formatted)
+
+-- | Stream node lifecycle events (started, done) to the client.
+streamEvents :: Socket -> TChan NodeEvent -> IO ()
+streamEvents conn broadcastChan = do
+  sendAll conn "Streaming events (disconnect to stop)...\n"
+  chan <- atomically $ dupTChan broadcastChan
+  handle (\(_ :: IOError) -> return ()) $ forever $ do
+    NodeEvent {..} <- atomically $ readTChan chan
+    let typeStr :: String
+        typeStr = case nodeEventType of
+          EventStarted -> "STARTED"
+          EventDone Success -> "DONE:OK"
+          EventDone (Failure (Pending {})) -> "DONE:PENDING"
+          EventDone (Failure reason) -> [i|DONE:FAIL: #{showFailureReasonBrief reason}|]
+          EventDone DryRun -> "DONE:DRYRUN"
+          EventDone Cancelled -> "DONE:CANCELLED"
+          EventSetupStarted -> "SETUP:STARTED"
+          EventSetupFinished -> "SETUP:FINISHED"
+          EventTeardownStarted -> "TEARDOWN:STARTED"
+          EventTeardownFinished -> "TEARDOWN:FINISHED"
+          EventMilestone msg -> [i|MILESTONE: #{msg}|]
+        formatted = [i|#{show nodeEventTime} [#{nodeEventId}] #{nodeEventLabel}: #{typeStr}\n|]
+    sendAll conn (BS8.pack formatted)
+
+showFailureReasonBrief :: FailureReason -> String
+showFailureReasonBrief (Reason {failureReason}) = failureReason
+showFailureReasonBrief (ChildrenFailed {failureNumChildren}) = [i|#{failureNumChildren} children failed|]
+showFailureReasonBrief _ = "(see node detail)"
+
+-- | Stream RTS stats to the client every second until the connection is closed.
+-- Requires the program to be run with +RTS -T for stats to be available.
+streamRtsStats :: Socket -> IO ()
+streamRtsStats conn = do
+  enabled <- getRTSStatsEnabled
+  if not enabled
+    then sendAll conn "RTS stats not available. Run with +RTS -T to enable.\n> "
+    else do
+      sendAll conn "Streaming RTS stats every 1s (disconnect to stop)...\n"
+      handle (\(_ :: IOError) -> return ()) $ forever $ do
+        stats <- getRTSStats
+        let gc' = gc stats
+        now <- getCurrentTime
+        let line = formatRtsStats now stats gc'
+        sendAll conn "\n\n"
+        sendAll conn (T.encodeUtf8 line)
+        threadDelay 1_000_000
+
+-- | Read a single line from the socket, buffering leftover bytes.
+-- Returns the line without the trailing newline.
+readLine :: Socket -> IORef BS.ByteString -> IO BS.ByteString
+readLine conn bufRef = do
+  buf <- readIORef bufRef
+  case BS8.elemIndex '\n' buf of
+    Just idx -> do
+      let (line, rest) = BS.splitAt idx buf
+      writeIORef bufRef (BS.drop 1 rest) -- skip the '\n'
+      return line
+    Nothing -> do
+      chunk <- recv conn 4096
+      when (BS.null chunk) $ throwIO (userError "connection closed")
+      writeIORef bufRef (buf <> chunk)
+      readLine conn bufRef
+
+-- | Strip trailing carriage return (for clients that send \r\n)
+stripCR :: BS.ByteString -> BS.ByteString
+stripCR bs
+  | BS.null bs = bs
+  | BS8.last bs == '\r' = BS.init bs
+  | otherwise = bs
diff --git a/sandwich/src/Test/Sandwich/Formatters/TerminalUI.hs b/sandwich/src/Test/Sandwich/Formatters/TerminalUI.hs
index 54e0eaf0..8c945852 100644
--- a/sandwich/src/Test/Sandwich/Formatters/TerminalUI.hs
+++ b/sandwich/src/Test/Sandwich/Formatters/TerminalUI.hs
@@ -16,6 +16,7 @@ module Test.Sandwich.Formatters.TerminalUI (
   , terminalUIDefaultEditor
   , terminalUIOpenInEditor
   , terminalUICustomExceptionFormatters
+  , terminalUIDebugSocket
 
   -- * Auxiliary types
   , InitialFolding(..)
@@ -29,13 +30,13 @@ import Brick as B
 import Brick.BChan
 import Brick.Widgets.List
 import Control.Concurrent
-import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Logger hiding (logError)
 import Control.Monad.Trans
 import Control.Monad.Trans.State hiding (get, put)
+import qualified Data.ByteString.Char8 as BS8
 import Data.Either
 import Data.Foldable
 import qualified Data.List as L
@@ -43,6 +44,7 @@ import Data.Maybe
 import qualified Data.Sequence as Seq
 import qualified Data.Set as S
 import Data.String.Interpolate
+import Data.Text (Text)
 import Data.Time
 import qualified Data.Vector as Vec
 import GHC.Stack
@@ -53,6 +55,7 @@ import Safe
 import System.FilePath
 import Test.Sandwich.Formatters.TerminalUI.AttrMap
 import Test.Sandwich.Formatters.TerminalUI.CrossPlatform
+import Test.Sandwich.Formatters.TerminalUI.DebugSocket
 import Test.Sandwich.Formatters.TerminalUI.Draw
 import Test.Sandwich.Formatters.TerminalUI.Filter
 import Test.Sandwich.Formatters.TerminalUI.Keys
@@ -60,12 +63,14 @@ import Test.Sandwich.Formatters.TerminalUI.Types
 import Test.Sandwich.Interpreters.RunTree.Util
 import Test.Sandwich.Interpreters.StartTree
 import Test.Sandwich.Logging
+import Test.Sandwich.ManagedAsync
 import Test.Sandwich.RunTree
 import Test.Sandwich.Shutdown
 import Test.Sandwich.Types.ArgParsing
 import Test.Sandwich.Types.RunTree
 import Test.Sandwich.Types.Spec
 import Test.Sandwich.Util
+import UnliftIO.Async (cancel)
 import UnliftIO.Exception
 
 
@@ -85,6 +90,13 @@ runApp (TerminalUIFormatter {..}) rts _maybeCommandLineOptions baseContext = do
 
   (rtsFixed, initialSomethingRunning) <- liftIO $ atomically $ runStateT (mapM fixRunTree' rts) False
 
+  -- Create debug channel for optional debug socket server
+  debugChan <- liftIO $ newBroadcastTChanIO
+  let debugFn :: Text -> IO ()
+      debugFn msg = do
+        now <- getCurrentTime
+        atomically $ writeTChan debugChan (BS8.pack [i|#{formatTime defaultTimeLocale "%H:%M:%S%3Q" now} #{msg}\n|])
+
   let initialState = updateFilteredTree $
         AppState {
           _appRunTreeBase = rts
@@ -105,8 +117,8 @@ runApp (TerminalUIFormatter {..}) rts _maybeCommandLineOptions baseContext = do
           , _appShowVisibilityThresholds = terminalUIShowVisibilityThresholds
           , _appShowLogSizes = terminalUIShowLogSizes
 
-          , _appOpenInEditor = terminalUIOpenInEditor terminalUIDefaultEditor (const $ return ())
-          , _appDebug = (const $ return ())
+          , _appOpenInEditor = terminalUIOpenInEditor terminalUIDefaultEditor debugFn
+          , _appDebug = debugFn
           , _appCustomExceptionFormatters = terminalUICustomExceptionFormatters
         }
 
@@ -117,12 +129,15 @@ runApp (TerminalUIFormatter {..}) rts _maybeCommandLineOptions baseContext = do
   currentFixedTree <- liftIO $ newTVarIO rtsFixed
   let eventAsync = liftIO $ forever $ do
         handleAny (\e -> flip runLoggingT logFn (logError [i|Got exception in event async: #{e}|]) >> threadDelay terminalUIRefreshPeriod) $ do
+          debugFn "eventAsync: waiting for tree change"
           (newFixedTree, somethingRunning) <- atomically $ flip runStateT False $ do
             currentFixed <- lift $ readTVar currentFixedTree
             newFixed <- mapM fixRunTree' rts
             when (fmap getCommons newFixed == fmap getCommons currentFixed) (lift retry)
             lift $ writeTVar currentFixedTree newFixed
             return newFixed
+          let nodeCount = length $ concatMap getCommons newFixedTree
+          debugFn [i|eventAsync: tree changed, nodes=#{nodeCount} somethingRunning=#{somethingRunning}|]
           writeBChan eventChan (RunTreeUpdated newFixedTree somethingRunning)
           threadDelay terminalUIRefreshPeriod
 
@@ -136,12 +151,20 @@ runApp (TerminalUIFormatter {..}) rts _maybeCommandLineOptions baseContext = do
 
   let updateCurrentTimeForever period = forever $ do
         now <- getCurrentTime
+        debugFn "CurrentTimeUpdated tick"
         writeBChan eventChan (CurrentTimeUpdated now)
         threadDelay period
 
+  -- Optionally start the debug socket server in the test tree root
+  let runId = baseContextRunId baseContext
+  let withDebugSocket = case (terminalUIDebugSocket, baseContextRunRoot baseContext) of
+        (True, Just runRoot) -> \action -> managedWithAsync_ runId "tui-debug-socket" (debugSocketServer runId (runRoot </> "tui-debug.sock") debugChan) action
+        _ -> id
+
   liftIO $
-    (case terminalUIClockUpdatePeriod of Nothing -> id; Just ts -> \action -> withAsync (updateCurrentTimeForever ts) (\_ -> action)) $
-    withAsync eventAsync $ \_ ->
+    withDebugSocket $
+    (case terminalUIClockUpdatePeriod of Nothing -> id; Just ts -> \action -> managedWithAsync_ runId "tui-clock-update" (updateCurrentTimeForever ts) action) $
+    managedWithAsync_ runId "tui-event-async" eventAsync $
     void $ customMain initialVty buildVty (Just eventChan) app initialState
 
 app :: App AppState AppEvent ClickableName
@@ -188,9 +211,7 @@ appEvent s (AppEvent (RunTreeUpdated newTree somethingRunning)) = do
     & appSomethingRunning .~ somethingRunning
     & updateFilteredTree
 appEvent s (AppEvent (CurrentTimeUpdated ts)) = do
-  continue $ case (s ^. appSomethingRunning) of
-    True -> s & appCurrentTime .~ ts
-    False -> s
+  continue $ s & appCurrentTime .~ ts
 
 appEvent s (MouseDown ColorBar _ _ (B.Location (x, _))) = do
   lookupExtent ColorBar >>= \case
@@ -271,9 +292,10 @@ appEvent s (VtyEvent e) =
           _ -> return ()
     V.EvKey c [] | c == runAllKey -> do
       now <- liftIO getCurrentTime
+      let appRunId = baseContextRunId (s ^. appBaseContext)
       when (all (not . isRunning . runTreeStatus . runNodeCommon) (s ^. appRunTree)) $ liftIO $ do
         mapM_ clearRecursively (s ^. appRunTreeBase)
-        void $ async $ void $ runNodesSequentially (s ^. appRunTreeBase) (s ^. appBaseContext)
+        void $ managedAsync appRunId "tui-run-all" $ void $ runNodesSequentially (s ^. appRunTreeBase) (s ^. appBaseContext)
       continue $ s
         & appStartTime .~ now
         & appCurrentTime .~ now
@@ -283,6 +305,7 @@ appEvent s (VtyEvent e) =
         _ -> do
           -- Get the set of IDs for only this node's ancestors and children
           let ancestorIds = S.fromList $ toList $ runTreeAncestors node
+          let appRunId = baseContextRunId (s ^. appBaseContext)
           case findRunNodeChildrenById ident (s ^. appRunTree) of
             Nothing -> continue s
             Just childIds -> do
@@ -292,7 +315,7 @@ appEvent s (VtyEvent e) =
               -- Start a run for all affected nodes
               now <- liftIO getCurrentTime
               let bc = (s ^. appBaseContext) { baseContextOnlyRunIds = Just allIds }
-              void $ liftIO $ async $ void $ runNodesSequentially (s ^. appRunTreeBase) bc
+              void $ liftIO $ managedAsync appRunId "tui-run-selected" $ void $ runNodesSequentially (s ^. appRunTreeBase) bc
               continue $ s
                 & appStartTime .~ now
                 & appCurrentTime .~ now
@@ -376,37 +399,37 @@ modifyToggled :: AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
 modifyToggled s f = case listSelectedElement (s ^. appMainList) of
   Nothing -> continue s
   Just (_i, MainListElem {..}) -> do
-    liftIO $ atomically $ modifyTVar (runTreeToggled node) f
+    liftIO $ atomically $ modifyTVar' (runTreeToggled node) f
     continue s
 
 modifyOpen :: AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
 modifyOpen s f = case listSelectedElement (s ^. appMainList) of
   Nothing -> continue s
   Just (_i, MainListElem {..}) -> do
-    liftIO $ atomically $ modifyTVar (runTreeOpen node) f
+    liftIO $ atomically $ modifyTVar' (runTreeOpen node) f
     continue s
 
 openIndices :: [RunNode context] -> Seq.Seq Int -> IO ()
 openIndices nodes openSet =
   atomically $ forM_ (concatMap getCommons nodes) $ \node ->
     when ((runTreeId node) `elem` (toList openSet)) $
-      modifyTVar (runTreeOpen node) (const True)
+      modifyTVar' (runTreeOpen node) (const True)
 
 openToDepth :: (Foldable t) => t MainListElem -> Int -> IO ()
 openToDepth elems thresh =
   atomically $ forM_ elems $ \(MainListElem {..}) ->
-    if | (depth < thresh) -> modifyTVar (runTreeOpen node) (const True)
-       | otherwise -> modifyTVar (runTreeOpen node) (const False)
+    if | (depth < thresh) -> modifyTVar' (runTreeOpen node) (const True)
+       | otherwise -> modifyTVar' (runTreeOpen node) (const False)
 
 setInitialFolding :: InitialFolding -> [RunNode BaseContext] -> IO ()
 setInitialFolding InitialFoldingAllOpen _rts = return ()
 setInitialFolding InitialFoldingAllClosed rts =
   atomically $ forM_ (concatMap getCommons rts) $ \(RunNodeCommonWithStatus {..}) ->
-    modifyTVar runTreeOpen (const False)
+    modifyTVar' runTreeOpen (const False)
 setInitialFolding (InitialFoldingTopNOpen n) rts =
   atomically $ forM_ (concatMap getCommons rts) $ \(RunNodeCommonWithStatus {..}) ->
     when (Seq.length runTreeAncestors > n) $
-      modifyTVar runTreeOpen (const False)
+      modifyTVar' runTreeOpen (const False)
 
 updateFilteredTree :: AppState -> AppState
 updateFilteredTree s = s
diff --git a/sandwich/src/Test/Sandwich/Formatters/TerminalUI/DebugSocket.hs b/sandwich/src/Test/Sandwich/Formatters/TerminalUI/DebugSocket.hs
new file mode 100644
index 00000000..9c5bc01f
--- /dev/null
+++ b/sandwich/src/Test/Sandwich/Formatters/TerminalUI/DebugSocket.hs
@@ -0,0 +1,37 @@
+module Test.Sandwich.Formatters.TerminalUI.DebugSocket (
+  debugSocketServer
+  ) where
+
+import Control.Concurrent.STM
+import Control.Monad
+import Data.ByteString (ByteString)
+import qualified Data.Text as T
+import Network.Socket
+import Network.Socket.ByteString (sendAll)
+import System.Directory (removeFile)
+import Test.Sandwich.ManagedAsync
+import UnliftIO.Exception
+
+
+-- | Debug socket server that accepts connections and broadcasts events.
+-- Connect with @nc -U \<path\>@ to receive line-oriented debug events.
+debugSocketServer :: T.Text -> FilePath -> TChan ByteString -> IO ()
+debugSocketServer runId socketPath chan = do
+  -- Clean up any existing socket file
+  removeFile socketPath `catch` \(_ :: IOError) -> return ()
+
+  bracket (socket AF_UNIX Stream defaultProtocol) close $ \sock -> do
+    bind sock (SockAddrUnix socketPath)
+    listen sock 5
+    forever $ do
+      (conn, _) <- accept sock
+      -- Spawn a thread to handle this connection
+      void $ managedAsync runId "tui-debug-connection" $ handleConnection conn
+  where
+    handleConnection conn = do
+      -- Duplicate the channel so this client gets its own read position
+      chan' <- atomically $ dupTChan chan
+      -- Send events until error (client disconnect)
+      handle (\(_ :: IOError) -> close conn) $ forever $ do
+        msg <- atomically $ readTChan chan'
+        sendAll conn msg
diff --git a/sandwich/src/Test/Sandwich/Formatters/TerminalUI/Draw.hs b/sandwich/src/Test/Sandwich/Formatters/TerminalUI/Draw.hs
index b517dc41..9c6f504e 100644
--- a/sandwich/src/Test/Sandwich/Formatters/TerminalUI/Draw.hs
+++ b/sandwich/src/Test/Sandwich/Formatters/TerminalUI/Draw.hs
@@ -77,7 +77,7 @@ mainList app = hCenter $ padAll 1 $ L.renderListWithIndex listDrawElement True (
                       , withAttr visibilityThresholdIndicatorAttr $ str $ show visibilityLevel
                       , str "]"]
       , if not (app ^. appShowLogSizes) then Nothing else
-          let totalSize = sum $ fmap (BS.length . fromLogStr . logEntryStr) logs
+          let totalSize = sum $ fmap (BS.length . logEntryStr) logs
           in if totalSize > 0 then Just $ hBox [str " [", withAttr logSizeAttr (str $ formatBytes totalSize), str "]"] else Nothing
       , Just $ padRight Max $ withAttr toggleMarkerAttr $ str (if toggled then " [-]" else " [+]")
       , if not (app ^. appShowRunTimes) then Nothing else case status of
@@ -107,7 +107,7 @@ mainList app = hCenter $ padAll 1 $ L.renderListWithIndex listDrawElement True (
       , str " "
       , logLocWidget logEntryLoc
       , str " "
-      , txtWrap (E.decodeUtf8 $ fromLogStr logEntryStr)
+      , txtWrap (E.decodeUtf8 logEntryStr)
       ]
 
     logLocWidget (Loc {loc_start=(line, ch), ..}) = hBox [
diff --git a/sandwich/src/Test/Sandwich/Formatters/TerminalUI/Types.hs b/sandwich/src/Test/Sandwich/Formatters/TerminalUI/Types.hs
index 496f00ee..53ea3a04 100644
--- a/sandwich/src/Test/Sandwich/Formatters/TerminalUI/Types.hs
+++ b/sandwich/src/Test/Sandwich/Formatters/TerminalUI/Types.hs
@@ -55,6 +55,9 @@ data TerminalUIFormatter = TerminalUIFormatter {
   -- It's also passed a debug callback that accepts a 'T.Text'; messages logged with this function will go into the formatter logs.
   , terminalUICustomExceptionFormatters :: CustomExceptionFormatters
   -- ^ Custom exception formatters, used to nicely format custom exception types.
+  , terminalUIDebugSocket :: Bool
+  -- ^ If True, create a Unix socket at @\<test-root\>/tui-debug.sock@ for debug output.
+  -- Connect with @nc -U \<path\>@ to receive line-oriented debug events about the TUI event loop.
   }
 
 instance Show TerminalUIFormatter where
@@ -81,6 +84,7 @@ defaultTerminalUIFormatter = TerminalUIFormatter {
   , terminalUIDefaultEditor = Just "emacsclient +$((LINE+1)):COLUMN --no-wait"
   , terminalUIOpenInEditor = autoOpenInEditor
   , terminalUICustomExceptionFormatters = []
+  , terminalUIDebugSocket = False
   }
 
 type CustomExceptionFormatters = [SomeException -> Maybe CustomTUIException]
diff --git a/sandwich/src/Test/Sandwich/Instrumentation.hs b/sandwich/src/Test/Sandwich/Instrumentation.hs
new file mode 100644
index 00000000..076ed61c
--- /dev/null
+++ b/sandwich/src/Test/Sandwich/Instrumentation.hs
@@ -0,0 +1,179 @@
+module Test.Sandwich.Instrumentation (
+  streamLogsToFile
+  , streamEventsToFile
+  , streamRtsStatsToFile
+  , streamManagedAsyncEventsToFile
+  , writeTreeFile
+
+  , formatRtsStats
+  ) where
+
+import Control.Concurrent.STM
+import Control.Monad
+import Control.Monad.Logger
+import qualified Data.ByteString.Char8 as BS8
+import Data.IORef
+import qualified Data.Map.Strict as M
+import Data.String.Interpolate
+import Data.Text (Text)
+import qualified Data.Text.IO as T
+import Data.Time
+import Data.Word
+import Debug.Trace (traceMarkerIO)
+import GHC.Stats
+import System.IO (IOMode(..), hFlush, hPutStr, hSetBuffering, BufferMode(..), withFile)
+import Test.Sandwich.ManagedAsync (AsyncEvent(..), AsyncInfo(..), getManagedAsyncInfos)
+import Test.Sandwich.Types.RunTree
+import Test.Sandwich.Types.Spec
+import UnliftIO.Concurrent (threadDelay)
+import UnliftIO.Exception
+
+
+-- | Stream all log entries from a broadcast channel to a file,
+-- including the recursive heap size of each LogEntry.
+-- When cancelled, writes a summary line with total bytes.
+streamLogsToFile :: FilePath -> TChan (Int, String, LogEntry) -> IO ()
+streamLogsToFile path broadcastChan = do
+  chan <- atomically $ dupTChan broadcastChan
+  totalRef <- newIORef (0 :: Word64)
+  countRef <- newIORef (0 :: Int)
+  withFile path AppendMode $ \h -> do
+    hSetBuffering h LineBuffering
+    let loop = forever $ do
+          (nodeId, nodeLabel, LogEntry {..}) <- atomically $ readTChan chan
+          let entrySize = fromIntegral (BS8.length logEntryStr) :: Word64
+          modifyIORef' totalRef (+ entrySize)
+          modifyIORef' countRef (+ 1)
+          let levelStr :: String
+              levelStr = case logEntryLevel of
+                LevelDebug -> "DEBUG"
+                LevelInfo -> "INFO"
+                LevelWarn -> "WARN"
+                LevelError -> "ERROR"
+                LevelOther t -> show t
+              msgStr = BS8.unpack logEntryStr
+              formatted = [i|#{show logEntryTime} [#{levelStr}] [#{nodeId}] #{nodeLabel}: #{msgStr} (#{entrySize} bytes)\n|]
+          hPutStr h formatted
+          hFlush h
+    loop `finally` do
+      total <- readIORef totalRef
+      count <- readIORef countRef
+      hPutStr h [i|\nTotal: #{count} log entries, #{formatBytes total} total log bytes\n|]
+      hFlush h
+
+-- | Stream node lifecycle events from a broadcast channel to a file.
+streamEventsToFile :: FilePath -> TChan NodeEvent -> IO ()
+streamEventsToFile path broadcastChan = do
+  chan <- atomically $ dupTChan broadcastChan
+  withFile path AppendMode $ \h -> do
+    hSetBuffering h LineBuffering
+    forever $ do
+      NodeEvent {..} <- atomically $ readTChan chan
+      let typeStr :: String
+          typeStr = case nodeEventType of
+            EventStarted -> "STARTED"
+            EventDone Success -> "DONE:OK"
+            EventDone (Failure (Pending {})) -> "DONE:PENDING"
+            EventDone (Failure reason) -> [i|DONE:FAIL: #{showFailureReasonBrief reason}|]
+            EventDone DryRun -> "DONE:DRYRUN"
+            EventDone Cancelled -> "DONE:CANCELLED"
+            EventSetupStarted -> "SETUP:STARTED"
+            EventSetupFinished -> "SETUP:FINISHED"
+            EventTeardownStarted -> "TEARDOWN:STARTED"
+            EventTeardownFinished -> "TEARDOWN:FINISHED"
+            EventMilestone msg -> [i|MILESTONE: #{msg}|]
+          formatted = [i|#{show nodeEventTime} [#{nodeEventId}] #{nodeEventLabel}: #{typeStr}\n|]
+      traceMarkerIO [i|[#{nodeEventId}] #{nodeEventLabel}: #{typeStr}|]
+      hPutStr h formatted
+      hFlush h
+
+-- | Poll RTS stats every second and append to a file.
+-- Requires the program to be run with +RTS -T for stats to be available.
+streamRtsStatsToFile :: FilePath -> IO ()
+streamRtsStatsToFile path = do
+  enabled <- getRTSStatsEnabled
+  when enabled $ do
+    withFile path AppendMode $ \h -> do
+      hSetBuffering h LineBuffering
+      forever $ do
+        now <- getCurrentTime
+        stats <- getRTSStats
+        let gc' = gc stats
+        T.hPutStr h "\n\n"
+        T.hPutStr h $ formatRtsStats now stats gc'
+        hFlush h
+        threadDelay 1000000
+
+showFailureReasonBrief :: FailureReason -> String
+showFailureReasonBrief (Reason {failureReason}) = failureReason
+showFailureReasonBrief (ChildrenFailed {failureNumChildren}) = [i|#{failureNumChildren} children failed|]
+showFailureReasonBrief _ = "(see node detail)"
+
+formatRtsStats :: UTCTime -> RTSStats -> GCDetails -> Text
+formatRtsStats now stats gc' = [__i|
+  #{now}
+  live_bytes:         #{formatBytes (gcdetails_live_bytes gc')}
+  heap_size:          #{formatBytes (gcdetails_mem_in_use_bytes gc')}
+  allocated_bytes:    #{formatBytes (allocated_bytes stats)}
+  max_live_bytes:     #{formatBytes (max_live_bytes stats)}
+  large_objects:      #{formatBytes (gcdetails_large_objects_bytes gc')}
+  compact_bytes:      #{formatBytes (gcdetails_compact_bytes gc')}
+  slop_bytes:         #{formatBytes (gcdetails_slop_bytes gc')}
+  gcs:                #{gcs stats}
+  major_gcs:          #{major_gcs stats}
+  gc_cpu:             #{nsToMs (gc_cpu_ns stats)}ms
+  mutator_cpu:        #{nsToMs (mutator_cpu_ns stats)}ms
+  |]
+  where
+    nsToMs :: RtsTime -> RtsTime
+    nsToMs ns = ns `div` 1000000
+
+formatBytes :: Word64 -> String
+formatBytes b
+  | b < 1024 = [i|#{b} B|]
+  | b < 1024 * 1024 = [i|#{b `div` 1024} KiB (#{b})|]
+  | b < 1024 * 1024 * 1024 = [i|#{b `div` (1024 * 1024)} MiB (#{b})|]
+  | otherwise = [i|#{b `div` (1024 * 1024 * 1024)} GiB (#{b})|]
+
+-- | Stream managed async lifecycle events (started/finished) from a broadcast channel to a file.
+-- When cancelled, writes a summary of all asyncs still alive at that point.
+streamManagedAsyncEventsToFile :: FilePath -> TChan AsyncEvent -> IO ()
+streamManagedAsyncEventsToFile path broadcastChan = do
+  chan <- atomically $ dupTChan broadcastChan
+  withFile path AppendMode $ \h -> do
+    hSetBuffering h LineBuffering
+    let loop = forever $ do
+          event <- atomically $ readTChan chan
+          now <- getCurrentTime
+          let line :: String
+              line = case event of
+                AsyncStarted info -> [i|#{show now} STARTED (#{asyncInfoThreadId info}, parent #{asyncInfoParentThreadId info}, #{asyncInfoRunId info}) "#{asyncInfoName info}" |]
+                AsyncFinished info -> [i|#{show now} FINISHED (#{asyncInfoThreadId info}, #{asyncInfoRunId info}) "#{asyncInfoName info}"|]
+          hPutStr h (line <> "\n")
+          hFlush h
+    loop `finally` do
+      now <- getCurrentTime
+      remaining <- getManagedAsyncInfos
+      hPutStr h [i|\n#{show now} === Remaining managed asyncs: #{M.size remaining} ===\n|]
+      forM_ (M.toList remaining) $ \(tid, info) ->
+        hPutStr h [i|  #{tid}: #{asyncInfoName info} (runId: #{asyncInfoRunId info})\n|]
+      hFlush h
+
+-- | Write a tree of node IDs and labels to a file for cross-referencing with events.
+writeTreeFile :: FilePath -> [RunNodeWithStatus context s l t] -> IO ()
+writeTreeFile path rts =
+  writeFile path $ unlines $ concatMap (renderTree 0) rts
+
+renderTree :: Int -> RunNodeWithStatus context s l t -> [String]
+renderTree depth node = line : children
+  where
+    c = runNodeCommon node
+    indent = replicate (depth * 2) ' '
+    label = runTreeLabel c
+    nid = runTreeId c
+    line = [i|#{indent}[#{nid}] #{label}|]
+    children = case node of
+      RunNodeIt {} -> []
+      RunNodeIntroduce {runNodeChildrenAugmented} -> concatMap (renderTree (depth + 1)) runNodeChildrenAugmented
+      RunNodeIntroduceWith {runNodeChildrenAugmented} -> concatMap (renderTree (depth + 1)) runNodeChildrenAugmented
+      _ -> concatMap (renderTree (depth + 1)) (runNodeChildren node)
diff --git a/sandwich/src/Test/Sandwich/Internal/Running.hs b/sandwich/src/Test/Sandwich/Internal/Running.hs
index d95ecc72..199b5635 100644
--- a/sandwich/src/Test/Sandwich/Internal/Running.hs
+++ b/sandwich/src/Test/Sandwich/Internal/Running.hs
@@ -1,9 +1,9 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE RankNTypes #-}
 
 module Test.Sandwich.Internal.Running where
 
-import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Free
@@ -22,6 +22,7 @@ import Test.Sandwich.Interpreters.PruneTree
 import Test.Sandwich.Interpreters.RunTree
 import Test.Sandwich.Interpreters.RunTree.Util
 import Test.Sandwich.Interpreters.StartTree
+import Test.Sandwich.ManagedAsync
 import Test.Sandwich.Options
 import Test.Sandwich.TestTimer
 import Test.Sandwich.Types.General
@@ -38,13 +39,14 @@ startSandwichTree options spec = do
 
 startSandwichTree' :: BaseContext -> Options -> CoreSpec -> IO [RunNode BaseContext]
 startSandwichTree' baseContext (Options {optionsPruneTree=(unwrapTreeFilter -> pruneOpts), optionsFilterTree=(unwrapTreeFilter -> filterOpts), optionsDryRun}) spec = do
+  let runId = baseContextRunId baseContext
   runTree <- spec
     & (\tree -> L.foldl' pruneTree tree pruneOpts)
     & (\tree -> L.foldl' filterTree tree filterOpts)
     & atomically . specToRunTreeVariable baseContext
 
   if | optionsDryRun -> markAllChildrenWithResult runTree baseContext DryRun
-     | otherwise -> void $ async $ void $ runNodesSequentially runTree baseContext
+     | otherwise -> void $ managedAsync runId [i|root-nodes:#{runId}|] $ void $ runNodesSequentially runTree baseContext
 
   return runTree
 
@@ -58,20 +60,22 @@ runSandwichTree options spec = do
   return rts
 
 -- | For 0 repeats, repeat until a failure
-runWithRepeat :: Int -> Int -> IO (ExitReason, Int, Int) -> IO ()
-runWithRepeat 0 totalTests action = do
-  (_, _itNodeFailures, totalFailures) <- action
-  if | totalFailures == 0 -> runWithRepeat 0 totalTests action
-     | otherwise -> exitFailure
+runWithRepeat :: Int -> Int -> (Int -> IO (ExitReason, Int, Int)) -> IO ()
+runWithRepeat 0 _totalTests action = go 0
+  where
+    go !idx = do
+      (_, _itNodeFailures, totalFailures) <- action idx
+      if | totalFailures == 0 -> go (idx + 1)
+         | otherwise -> exitFailure
 -- | For 1 repeat, run once and return
 runWithRepeat n totalTests action = do
-  (successes, total) <- (flip execStateT (0 :: Int, 0 :: Int)) $ flip fix (n - 1) $ \loop n' -> do
-    (exitReason, _itNodeFailures, totalFailures) <- liftIO action
+  (successes, total) <- (flip execStateT (0 :: Int, 0 :: Int)) $ flip fix (0 :: Int) $ \loop idx -> do
+    (exitReason, _itNodeFailures, totalFailures) <- liftIO $ action idx
 
     modify $ \(successes, total) -> (successes + (if totalFailures == 0 then 1 else 0), total + 1)
 
     if | exitReason == SignalExit -> return ()
-       | n' > 0 -> loop (n' - 1)
+       | idx < n - 1 -> loop (idx + 1)
        | otherwise -> return ()
 
   putStrLn [i|#{successes} runs succeeded out of #{total} repeat#{if n > 1 then ("s" :: String) else ""} (#{totalTests} tests)|]
@@ -80,6 +84,7 @@ runWithRepeat n totalTests action = do
 
 baseContextFromOptions :: Options -> IO BaseContext
 baseContextFromOptions options@(Options {..}) = do
+  let runId = optionsRunId
   runRoot <- case optionsTestArtifactsDirectory of
     TestArtifactsNone -> return Nothing
     TestArtifactsFixedDirectory dir' -> do
@@ -117,6 +122,7 @@ baseContextFromOptions options@(Options {..}) = do
     , baseContextOnlyRunIds = Nothing
     , baseContextTestTimerProfile = defaultProfileName
     , baseContextTestTimer = testTimer
+    , baseContextRunId = runId
     }
 
 
diff --git a/sandwich/src/Test/Sandwich/Interpreters/RunTree/Logging.hs b/sandwich/src/Test/Sandwich/Interpreters/RunTree/Logging.hs
index ce97af07..4929f587 100644
--- a/sandwich/src/Test/Sandwich/Interpreters/RunTree/Logging.hs
+++ b/sandwich/src/Test/Sandwich/Interpreters/RunTree/Logging.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 
 module Test.Sandwich.Interpreters.RunTree.Logging (
   logToMemory
@@ -15,24 +16,31 @@ import Data.Time.Clock
 import System.IO
 import Test.Sandwich.Types.RunTree
 
+forceSeq :: Seq LogEntry -> Seq LogEntry
+forceSeq s = foldl' (\_ e -> e `seq` ()) () s `seq` s
+
 logToMemory :: Maybe LogLevel -> TVar (Seq LogEntry) -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
 logToMemory Nothing _ _ _ _ _ = return ()
 logToMemory (Just minLevel) logs loc logSrc logLevel logStr =
   when (logLevel >= minLevel) $ do
     ts <- getCurrentTime
-    atomically $ modifyTVar logs (|> LogEntry ts loc logSrc logLevel logStr)
+    let !bs = fromLogStr logStr
+    let !entry = LogEntry ts loc logSrc logLevel bs
+    atomically $ modifyTVar' logs (\s -> let s' = s |> entry in forceSeq s' `seq` s')
 
 logToMemoryAndFile :: Maybe LogLevel -> Maybe LogLevel -> LogEntryFormatter -> TVar (Seq LogEntry) -> Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
 logToMemoryAndFile maybeMemLogLevel maybeSavedLogLevel formatter logs h loc logSrc logLevel logStr = do
+  let !bs = fromLogStr logStr
   maybeTs <- case maybeMemLogLevel of
     Just x | x <= logLevel -> do
       ts <- getCurrentTime
-      atomically $ modifyTVar logs (|> LogEntry ts loc logSrc logLevel logStr)
+      let !entry = LogEntry ts loc logSrc logLevel bs
+      atomically $ modifyTVar' logs (\s -> let s' = s |> entry in forceSeq s' `seq` s')
       return $ Just ts
     _ -> return Nothing
 
   case maybeSavedLogLevel of
     Just x | x <= logLevel -> do
       ts <- maybe getCurrentTime return maybeTs
-      BS8.hPutStr h $ formatter ts loc logSrc logLevel logStr
+      BS8.hPutStr h $ formatter ts loc logSrc logLevel bs
     _ -> return ()
diff --git a/sandwich/src/Test/Sandwich/Interpreters/RunTree/Util.hs b/sandwich/src/Test/Sandwich/Interpreters/RunTree/Util.hs
index 88c96ffb..57df417e 100644
--- a/sandwich/src/Test/Sandwich/Interpreters/RunTree/Util.hs
+++ b/sandwich/src/Test/Sandwich/Interpreters/RunTree/Util.hs
@@ -5,11 +5,8 @@ module Test.Sandwich.Interpreters.RunTree.Util where
 
 import Control.Concurrent.STM
 import Control.Monad.Free
-import Control.Monad.Logger
 import qualified Data.List as L
-import Data.Sequence as Seq hiding ((:>))
 import Data.String.Interpolate
-import Data.Time.Clock
 import Test.Sandwich.Types.RunTree
 import Test.Sandwich.Types.Spec
 import Text.Printf
@@ -23,13 +20,6 @@ waitForTree node = atomically $
     NotStarted {} -> retry
     Running {} -> retry
 
--- | Append a log message outside of ExampleT. Only stored to in-memory logs, not disk.
--- Only for debugging the interpreter, should not be exposed.
-appendLogMessage :: ToLogStr msg => TVar (Seq LogEntry) -> msg -> IO ()
-appendLogMessage logs msg = do
-  ts <- getCurrentTime
-  atomically $ modifyTVar logs (|> LogEntry ts (Loc "" "" "" (0, 0) (0, 0)) "manual" LevelDebug (toLogStr msg))
-
 -- | Count how many folder children are present as children or siblings of the given node.
 countImmediateFolderChildren :: Free (SpecCommand context m) a -> Int
 countImmediateFolderChildren (Free (It'' _loc no _l _ex next))
diff --git a/sandwich/src/Test/Sandwich/Interpreters/StartTree.hs b/sandwich/src/Test/Sandwich/Interpreters/StartTree.hs
index 43019838..85f5baae 100644
--- a/sandwich/src/Test/Sandwich/Interpreters/StartTree.hs
+++ b/sandwich/src/Test/Sandwich/Interpreters/StartTree.hs
@@ -15,6 +15,7 @@ import Control.Monad.IO.Class
 import Control.Monad.IO.Unlift
 import Control.Monad.Logger
 import Control.Monad.Trans.Reader
+import qualified Data.ByteString.Char8 as BS8
 import Data.IORef
 import qualified Data.List as L
 import Data.Sequence hiding ((:>))
@@ -36,6 +37,7 @@ import Test.Sandwich.Formatters.Print.Logs
 import Test.Sandwich.Formatters.Print.Printing
 import Test.Sandwich.Interpreters.RunTree.Logging
 import Test.Sandwich.Interpreters.RunTree.Util
+import Test.Sandwich.ManagedAsync
 import Test.Sandwich.RunTree
 import Test.Sandwich.TestTimer
 import Test.Sandwich.Types.RunTree
@@ -97,22 +99,28 @@ startTree node@(RunNodeIntroduce {..}) ctx' = do
     -- We want to err on the side of avoiding deadlocks so we use the @base@ version.
     -- This also plays nicer with the 'withMaybeWarnOnLongExecution' and 'withMaybeCancelOnLongExecution' functions.
     -- See the discussion at https://github.com/fpco/safe-exceptions/issues/3
+    let opts = baseContextOptions (getBaseContext ctx)
     liftIO $ E.bracket
       (do
           let asyncExceptionResult e = Failure $ GotAsyncException Nothing (Just [i|introduceWith #{runTreeLabel} alloc handler got async exception|]) (SomeAsyncExceptionWithEq e)
           let label = runTreeLabel <> " (setup)"
-          flip withException (\(e :: SomeAsyncException) -> markAllChildrenWithResult runNodeChildrenAugmented ctx (asyncExceptionResult e)) $
-            timed runNodeCommon runTreeRecordTime (getBaseContext ctx) label $
+          getCurrentTime >>= \t -> emitEvent opts t runTreeId runTreeLabel EventSetupStarted
+          flip withException (\(e :: SomeAsyncException) -> markAllChildrenWithResult runNodeChildrenAugmented ctx (asyncExceptionResult e)) $ do
+            ret <- timed runNodeCommon runTreeRecordTime (getBaseContext ctx) label $
               runExampleM' runNodeCommon label runNodeAlloc ctx runTreeLogs (Just [i|Failure in introduce '#{runTreeLabel}' allocation handler|])
+            getCurrentTime >>= \t -> emitEvent opts t runTreeId runTreeLabel EventSetupFinished
+            return ret
       )
       (\(ret, setupStartTime, setupFinishTime) -> case ret of
           Left failureReason -> writeIORef result (Failure failureReason, mkSetupTimingInfo setupStartTime)
           Right intro -> do
             teardownStartTime <- getCurrentTime
             addTeardownStartTimeToStatus runTreeStatus teardownStartTime
+            emitEvent opts teardownStartTime runTreeId runTreeLabel EventTeardownStarted
             let label = runTreeLabel <> " (teardown)"
             (ret', _, _) <- timed runNodeCommon runTreeRecordTime (getBaseContext ctx) label $
               runExampleM runNodeCommon label (runNodeCleanup intro) ctx runTreeLogs (Just [i|Failure in introduce '#{runTreeLabel}' cleanup handler|])
+            getCurrentTime >>= \t -> emitEvent opts t runTreeId runTreeLabel EventTeardownFinished
             writeIORef result (ret', ExtraTimingInfo (Just setupFinishTime) (Just teardownStartTime))
       )
       (\(ret, _setupStartTime, setupFinishTime) -> do
@@ -166,6 +174,8 @@ startTree node@(RunNodeIntroduceWith {..}) ctx' = do
             -- let teardownLabel = runTreeLabel <> " (teardown)"
             -- handleStartEvent tt (baseContextTestTimerProfile (getBaseContext ctx)) (T.pack setupLabel)
 
+            let opts = baseContextOptions (getBaseContext ctx)
+            liftIO getCurrentTime >>= \t -> liftIO $ emitEvent opts t runTreeId runTreeLabel EventSetupStarted
             results <- runNodeIntroduceAction $ \intro -> do
               -- Record the end event in the test timing
               -- TODO: do we need to deal with exceptions here and in teardown? I think we we fail to emit the
@@ -173,6 +183,7 @@ startTree node@(RunNodeIntroduceWith {..}) ctx' = do
               -- handleEndEvent tt (baseContextTestTimerProfile (getBaseContext ctx)) (T.pack setupLabel)
               setupFinishTime <- liftIO getCurrentTime
               addSetupFinishTimeToStatus runTreeStatus setupFinishTime
+              liftIO $ emitEvent opts setupFinishTime runTreeId runTreeLabel EventSetupFinished
 
               liftIO $ writeIORef didAllocateVar True
 
@@ -181,6 +192,7 @@ startTree node@(RunNodeIntroduceWith {..}) ctx' = do
 
               teardownStartTime <- liftIO getCurrentTime
               addTeardownStartTimeToStatus runTreeStatus teardownStartTime
+              liftIO $ emitEvent opts teardownStartTime runTreeId runTreeLabel EventTeardownStarted
 
               liftIO $ writeIORef beginningCleanupVar (Just teardownStartTime)
               -- handleStartEvent tt (baseContextTestTimerProfile (getBaseContext ctx)) (T.pack teardownLabel)
@@ -191,6 +203,7 @@ startTree node@(RunNodeIntroduceWith {..}) ctx' = do
               Nothing -> return ()
               Just teardownStartTime -> do
                 -- handleEndEvent tt (baseContextTestTimerProfile (getBaseContext ctx)) (T.pack teardownLabel)
+                liftIO getCurrentTime >>= \t -> liftIO $ emitEvent opts t runTreeId runTreeLabel EventTeardownFinished
                 liftIO $ modifyIORef' didRunWrappedAction $ \(ret, timingInfo) ->
                   (ret, timingInfo { teardownStartTime = Just teardownStartTime })
 
@@ -207,15 +220,20 @@ startTree node@(RunNodeAround {..}) ctx' = do
   let ctx = modifyBaseContext ctx' $ baseContextFromCommon runNodeCommon
   didRunWrappedAction <- liftIO $ newIORef (Left (), emptyExtraTimingInfo)
   runInAsync node ctx $ do
+    let opts = baseContextOptions (getBaseContext ctx)
     let wrappedAction = do
           flip withException (\e -> recordExceptionInStatus runTreeStatus e) $ do
+            liftIO getCurrentTime >>= \t -> liftIO $ emitEvent opts t runTreeId runTreeLabel EventSetupStarted
             runNodeActionWith $ do
               setupFinishTime <- liftIO getCurrentTime
               addSetupFinishTimeToStatus runTreeStatus setupFinishTime
+              liftIO $ emitEvent opts setupFinishTime runTreeId runTreeLabel EventSetupFinished
               results <- liftIO $ runNodesSequentially runNodeChildren ctx
+              liftIO getCurrentTime >>= \t -> liftIO $ emitEvent opts t runTreeId runTreeLabel EventTeardownStarted
               liftIO $ writeIORef didRunWrappedAction (Right results, mkSetupTimingInfo setupFinishTime)
               return results
 
+          liftIO getCurrentTime >>= \t -> liftIO $ emitEvent opts t runTreeId runTreeLabel EventTeardownFinished
           (liftIO $ readIORef didRunWrappedAction) >>= \case
             (Left (), timingInfo) -> return (Failure $ Reason Nothing [i|around '#{runTreeLabel}' handler didn't call action|], timingInfo)
             (Right _, timingInfo) -> return (Success, timingInfo)
@@ -250,14 +268,16 @@ runInAsync node ctx action = do
   let RunNodeCommonWithStatus {..} = runNodeCommon node
   let bc@(BaseContext {..}) = getBaseContext ctx
   let timerFn = if runTreeRecordTime then timeAction' (getTestTimer bc) baseContextTestTimerProfile (T.pack runTreeLabel) else id
+  let asyncName = T.pack [i|node #{runTreeId}, #{runTreeLabel}|]
   startTime <- liftIO getCurrentTime
   mvar <- liftIO newEmptyMVar
-  myAsync <- liftIO $ asyncWithUnmask $ \unmask -> do
+  myAsync <- liftIO $ managedAsyncWithUnmask baseContextRunId asyncName $ \unmask -> do
     flip withException (recordExceptionInStatus runTreeStatus) $ unmask $ do
       readMVar mvar
       (result, extraTimingInfo) <- timerFn action
       endTime <- liftIO getCurrentTime
       liftIO $ atomically $ writeTVar runTreeStatus $ Done startTime (setupFinishTime extraTimingInfo) (teardownStartTime extraTimingInfo) endTime result
+      liftIO $ emitEvent baseContextOptions endTime runTreeId runTreeLabel (EventDone result)
 
       whenFailure result $ \reason -> do
         -- Make sure the folder exists, if configured
@@ -312,6 +332,7 @@ runInAsync node ctx action = do
 
       return result
   liftIO $ atomically $ writeTVar runTreeStatus $ Running startTime Nothing Nothing myAsync
+  liftIO $ emitEvent baseContextOptions startTime runTreeId runTreeLabel EventStarted
   liftIO $ putMVar mvar ()
   return myAsync  -- TODO: fix race condition with writing to runTreeStatus (here and above)
 
@@ -346,7 +367,7 @@ markAllChildrenWithResult :: (MonadIO m, HasBaseContext context') => [RunNode co
 markAllChildrenWithResult children baseContext status = do
   now <- liftIO getCurrentTime
   forM_ (L.filter (shouldRunChild' baseContext) $ concatMap getCommons children) $ \child ->
-    liftIO $ atomically $ modifyTVar (runTreeStatus child) $ \case
+    liftIO $ atomically $ modifyTVar' (runTreeStatus child) $ \case
       Running {..} -> Done now statusSetupFinishTime statusTeardownStartTime now status
       done@(Done {}) -> done { statusResult = status }
       _ -> Done now Nothing Nothing now status
@@ -372,12 +393,12 @@ shouldRunChild' ctx common = case baseContextOnlyRunIds $ getBaseContext ctx of
 
 -- * Running examples
 
-runExampleM :: HasBaseContext r => RunNodeCommonWithStatus s l t -> String -> ExampleM r () -> r -> TVar (Seq LogEntry) -> Maybe String -> IO Result
+runExampleM :: HasBaseContext r => RunNodeCommonWithStatus (TVar Status) l t -> String -> ExampleM r () -> r -> TVar (Seq LogEntry) -> Maybe String -> IO Result
 runExampleM rnc label ex ctx logs exceptionMessage = runExampleM' rnc label ex ctx logs exceptionMessage >>= \case
   Left err -> return $ Failure err
   Right () -> return Success
 
-runExampleM' :: HasBaseContext r => RunNodeCommonWithStatus s l t -> String -> ExampleM r a -> r -> TVar (Seq LogEntry) -> Maybe String -> IO (Either FailureReason a)
+runExampleM' :: HasBaseContext r => RunNodeCommonWithStatus (TVar Status) l t -> String -> ExampleM r a -> r -> TVar (Seq LogEntry) -> Maybe String -> IO (Either FailureReason a)
 runExampleM' rnc label ex ctx logs exceptionMessage = do
   maybeTestDirectory <- getTestDirectory ctx
   let options = baseContextOptions $ getBaseContext ctx
@@ -393,10 +414,31 @@ runExampleM' rnc label ex ctx logs exceptionMessage = do
 
   where
     withLogFn :: Maybe FilePath -> Options -> (LogFn -> IO a) -> IO a
-    withLogFn Nothing (Options {..}) action = action (logToMemory optionsSavedLogLevel logs)
+    withLogFn Nothing (Options {..}) action = action (withLateLogCheck optionsLateLogFile $ withBroadcast optionsLogBroadcast $ logToMemory optionsSavedLogLevel logs)
     withLogFn (Just logPath) (Options {..}) action = withFile (logPath </> "test_logs.txt") AppendMode $ \h -> do
       hSetBuffering h LineBuffering
-      action (logToMemoryAndFile optionsMemoryLogLevel optionsSavedLogLevel optionsLogFormatter logs h)
+      action (withLateLogCheck optionsLateLogFile $ withBroadcast optionsLogBroadcast $ logToMemoryAndFile optionsMemoryLogLevel optionsSavedLogLevel optionsLogFormatter logs h)
+
+    withBroadcast :: Maybe (TChan (Int, String, LogEntry)) -> LogFn -> LogFn
+    withBroadcast Nothing logFn = logFn
+    withBroadcast (Just chan) logFn = \loc logSrc logLevel logStr -> do
+      logFn loc logSrc logLevel logStr
+      ts <- getCurrentTime
+      atomically $ writeTChan chan (runTreeId rnc, runTreeLabel rnc, LogEntry ts loc logSrc logLevel (fromLogStr logStr))
+
+    withLateLogCheck :: Maybe Handle -> LogFn -> LogFn
+    withLateLogCheck Nothing logFn = logFn
+    withLateLogCheck (Just lateH) logFn = \loc logSrc logLevel logStr -> do
+      logFn loc logSrc logLevel logStr
+      status <- readTVarIO (runTreeStatus rnc)
+      case status of
+        Done {} -> do
+          ts <- getCurrentTime
+          let bs = fromLogStr logStr
+          let line = [i|#{show ts} [LATE] [#{runTreeId rnc}] #{runTreeLabel rnc}: #{BS8.unpack bs}\n|]
+          BS8.hPutStr lateH (BS8.pack line)
+          hFlush lateH
+        _ -> return ()
 
     getTestDirectory :: (HasBaseContext a) => a -> IO (Maybe FilePath)
     getTestDirectory (getBaseContext -> (BaseContext {..})) = case baseContextPath of
@@ -413,17 +455,22 @@ runExampleM' rnc label ex ctx logs exceptionMessage = do
         _ -> GotException Nothing msg (SomeExceptionWithEq e)
 
 addSetupFinishTimeToStatus :: (MonadIO m) => TVar Status -> UTCTime -> m ()
-addSetupFinishTimeToStatus statusVar setupFinishTime = atomically $ modifyTVar statusVar $ \case
+addSetupFinishTimeToStatus statusVar setupFinishTime = atomically $ modifyTVar' statusVar $ \case
   status@(Running {}) -> status { statusSetupFinishTime = Just setupFinishTime }
   status@(Done {}) -> status { statusSetupFinishTime = Just setupFinishTime }
   x -> x
 
 addTeardownStartTimeToStatus :: (MonadIO m) => TVar Status -> UTCTime -> m ()
-addTeardownStartTimeToStatus statusVar t = atomically $ modifyTVar statusVar $ \case
+addTeardownStartTimeToStatus statusVar t = atomically $ modifyTVar' statusVar $ \case
   status@(Running {}) -> status { statusTeardownStartTime = Just t }
   status@(Done {}) -> status { statusTeardownStartTime = Just t }
   x -> x
 
+emitEvent :: Options -> UTCTime -> Int -> String -> NodeEventType -> IO ()
+emitEvent (Options {optionsEventBroadcast = Just chan}) ts nid label evtType =
+  atomically $ writeTChan chan (NodeEvent ts nid label evtType)
+emitEvent _ _ _ _ _ = return ()
+
 recordExceptionInStatus :: (MonadIO m) => TVar Status -> SomeException -> m ()
 recordExceptionInStatus status e = do
   endTime <- liftIO getCurrentTime
@@ -432,7 +479,7 @@ recordExceptionInStatus status e = do
         _ -> case fromException e of
           Just (e' :: FailureReason) -> Failure e'
           _ -> Failure (GotException Nothing Nothing (SomeExceptionWithEq e))
-  liftIO $ atomically $ modifyTVar status $ \case
+  liftIO $ atomically $ modifyTVar' status $ \case
     Running {..} -> Done statusStartTime statusSetupFinishTime statusTeardownStartTime endTime ret
     _ -> Done endTime Nothing Nothing endTime ret
 
@@ -449,8 +496,7 @@ withMaybeWarnOnLongExecution :: (MonadUnliftIO m) => BaseContext -> RunNodeCommo
 withMaybeWarnOnLongExecution (BaseContext {..}) rnc@(RunNodeCommonWithStatus {..}) label inner = case optionsWarnOnLongExecutionMs baseContextOptions of
   Nothing -> inner
   Just maxTimeMs -> do
-    withAsync (waiter maxTimeMs) $ \_ -> do
-      inner
+    managedWithAsync_ baseContextRunId (T.pack [i|warn-long:#{runTreeId}:#{label}|]) (waiter maxTimeMs) inner
 
   where
     waiter maxTimeMs = do
diff --git a/sandwich/src/Test/Sandwich/Logging.hs b/sandwich/src/Test/Sandwich/Logging.hs
index c50a4b6e..742d9153 100644
--- a/sandwich/src/Test/Sandwich/Logging.hs
+++ b/sandwich/src/Test/Sandwich/Logging.hs
@@ -22,33 +22,16 @@ module Test.Sandwich.Logging (
 
   -- * Process functions with file logging
   , createProcessWithFileLogging
+  , readCreateProcessWithFileLogging
+  , createProcessWithFileLoggingAndStdin
+  , callCommandWithFileLogging
   ) where
 
-import Control.Concurrent
-import Control.DeepSeq (rnf)
-import qualified Control.Exception as C
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.IO.Unlift
 import Control.Monad.Logger hiding (logOther)
-import Data.String.Interpolate
 import Data.Text (Text)
-import Foreign.C.Error
-import GHC.IO.Exception
 import GHC.Stack
-import System.FilePath
-import System.IO
-import System.IO.Error (mkIOError)
-import System.Process
-import Test.Sandwich.Contexts
-import Test.Sandwich.Expectations
-import Test.Sandwich.Types.RunTree
-import UnliftIO.Async hiding (wait)
-import UnliftIO.Exception
-
-#if !MIN_VERSION_base(4,13,0)
-import Control.Monad.Fail
-#endif
+import Test.Sandwich.Logging.Process
+import Test.Sandwich.Logging.ProcessFileLogging
 
 
 -- * Basic logging functions
@@ -73,174 +56,3 @@ logError = logErrorCS callStack
 -- | Log with a custom 'LogLevel'.
 logOther :: (HasCallStack, MonadLogger m) => LogLevel -> Text -> m ()
 logOther = logOtherCS callStack
-
-
--- * System.Process helpers
---
--- | Functions for launching processes while capturing their output in the logs.
-
--- | Spawn a process with its stdout and stderr connected to the logging system.
--- Every line output by the process will be fed to a 'debug' call.
-createProcessWithLogging :: (HasCallStack, MonadUnliftIO m, MonadLogger m) => CreateProcess -> m ProcessHandle
-createProcessWithLogging = withFrozenCallStack (createProcessWithLogging' LevelDebug)
-
--- | Spawn a process with its stdout and stderr connected to the logging system.
-createProcessWithLogging' :: (HasCallStack, MonadUnliftIO m, MonadLogger m) => LogLevel -> CreateProcess -> m ProcessHandle
-createProcessWithLogging' logLevel cp = do
-  (hRead, hWrite) <- liftIO createPipe
-
-  let name = case cmdspec cp of
-        ShellCommand {} -> "shell"
-        RawCommand path _ -> path
-
-  _ <- async $ forever $ do
-    line <- liftIO $ hGetLine hRead
-    logOtherCS callStack logLevel [i|#{name}: #{line}|]
-
-  (_, _, _, p) <- liftIO $ createProcess (cp { std_out = UseHandle hWrite, std_err = UseHandle hWrite })
-  return p
-
--- | Spawn a process with its stdout and stderr logged to a file in the test tree.
-createProcessWithFileLogging :: (HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => FilePath -> CreateProcess -> m ProcessHandle
-createProcessWithFileLogging name cp = withFrozenCallStack $ do
-  getCurrentFolder >>= \case
-    Nothing -> expectationFailure [i|createProcessWithFileLogging': no current folder, so unable to log for name '#{name}'.|]
-    Just dir ->
-      bracket (liftIO $ openTempFile dir (name <.> "out")) (\(_outfile, hOut) -> liftIO $ hClose hOut) $ \(_outfile, hOut) ->
-      bracket (liftIO $ openTempFile dir (name <.> "err")) (\(_errfile, hErr) -> liftIO $ hClose hErr) $ \(_errfile, hErr) -> do
-        (_, _, _, p) <- liftIO $ createProcess (cp { std_out = UseHandle hOut, std_err = UseHandle hErr })
-        return p
-
--- | Like 'readCreateProcess', but capture the stderr output in the logs.
--- Every line output by the process will be fed to a 'debug' call.
-readCreateProcessWithLogging :: (HasCallStack, MonadUnliftIO m, MonadLogger m) => CreateProcess -> String -> m String
-readCreateProcessWithLogging = withFrozenCallStack (readCreateProcessWithLogging' LevelDebug)
-
--- | Like 'readCreateProcess', but capture the stderr output in the logs.
-readCreateProcessWithLogging' :: (HasCallStack, MonadUnliftIO m, MonadLogger m) => LogLevel -> CreateProcess -> String -> m String
-readCreateProcessWithLogging' logLevel cp input = do
-  (hReadErr, hWriteErr) <- liftIO createPipe
-
-  let name = case cmdspec cp of
-        ShellCommand {} -> "shell"
-        RawCommand path _ -> path
-
-  _ <- async $ forever $ do
-    line <- liftIO $ hGetLine hReadErr
-    logOtherCS callStack logLevel [i|#{name}: #{line}|]
-
-  -- Do this just like 'readCreateProcess'
-  -- https://hackage.haskell.org/package/process-1.6.17.0/docs/src/System.Process.html#readCreateProcess
-  (ex, output) <- liftIO $ withCreateProcess (cp { std_in = CreatePipe, std_out = CreatePipe, std_err = UseHandle hWriteErr }) $ \sin' sout _ p -> do
-    case (sin', sout) of
-      (Just hIn, Just hOut) -> do
-        output  <- hGetContents hOut
-        withForkWait (C.evaluate $ rnf output) $ \waitOut -> do
-          -- now write any input
-          unless (Prelude.null input) $
-            ignoreSigPipe $ hPutStr hIn input
-          -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
-          ignoreSigPipe $ hClose hIn
-
-          -- wait on the output
-          waitOut
-          hClose hOut
-
-        -- wait on the process
-        ex <- waitForProcess p
-        return (ex, output)
-      (Nothing, _) -> liftIO $ throwIO $ userError "readCreateProcessWithStderrLogging: Failed to get a stdin handle."
-      (_, Nothing) -> liftIO $ throwIO $ userError "readCreateProcessWithStderrLogging: Failed to get a stdout handle."
-
-  case ex of
-    ExitSuccess -> return output
-    ExitFailure r -> liftIO $ processFailedException "readCreateProcessWithLogging" cmd args r
-
-  where
-    cmd = case cp of
-            CreateProcess { cmdspec = ShellCommand sc } -> sc
-            CreateProcess { cmdspec = RawCommand fp _ } -> fp
-    args = case cp of
-             CreateProcess { cmdspec = ShellCommand _ } -> []
-             CreateProcess { cmdspec = RawCommand _ args' } -> args'
-
-
--- | Spawn a process with its stdout and stderr connected to the logging system.
--- Every line output by the process will be fed to a 'debug' call.
-createProcessWithLoggingAndStdin :: (HasCallStack, MonadUnliftIO m, MonadFail m, MonadLogger m) => CreateProcess -> String -> m ProcessHandle
-createProcessWithLoggingAndStdin = withFrozenCallStack (createProcessWithLoggingAndStdin' LevelDebug)
-
--- | Spawn a process with its stdout and stderr connected to the logging system.
-createProcessWithLoggingAndStdin' :: (HasCallStack, MonadUnliftIO m, MonadFail m, MonadLogger m) => LogLevel -> CreateProcess -> String -> m ProcessHandle
-createProcessWithLoggingAndStdin' logLevel cp input = do
-  (hRead, hWrite) <- liftIO createPipe
-
-  let name = case cmdspec cp of
-        ShellCommand {} -> "shell"
-        RawCommand path _ -> path
-
-  _ <- async $ forever $ do
-    line <- liftIO $ hGetLine hRead
-    logOtherCS callStack logLevel [i|#{name}: #{line}|]
-
-  (Just inh, _, _, p) <- liftIO $ createProcess (
-    cp { std_out = UseHandle hWrite
-       , std_err = UseHandle hWrite
-       , std_in = CreatePipe }
-    )
-
-  unless (Prelude.null input) $
-    liftIO $ ignoreSigPipe $ hPutStr inh input
-  -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
-  liftIO $ ignoreSigPipe $ hClose inh
-
-  return p
-
--- | Higher level version of 'createProcessWithLogging', accepting a shell command.
-callCommandWithLogging :: (HasCallStack, MonadUnliftIO m, MonadLogger m) => String -> m ()
-callCommandWithLogging = withFrozenCallStack (callCommandWithLogging' LevelDebug)
-
--- | Higher level version of 'createProcessWithLogging'', accepting a shell command.
-callCommandWithLogging' :: (HasCallStack, MonadUnliftIO m, MonadLogger m) => LogLevel -> String -> m ()
-callCommandWithLogging' logLevel cmd = do
-  (hRead, hWrite) <- liftIO createPipe
-
-  (_, _, _, p) <- liftIO $ createProcess (shell cmd) {
-    delegate_ctlc = True
-    , std_out = UseHandle hWrite
-    , std_err = UseHandle hWrite
-    }
-
-  _ <- async $ forever $ do
-    line <- liftIO $ hGetLine hRead
-    logOtherCS callStack logLevel [i|#{cmd}: #{line}|]
-
-  liftIO (waitForProcess p) >>= \case
-    ExitSuccess -> return ()
-    ExitFailure r -> liftIO $ throwIO $ userError [i|callCommandWithLogging failed for '#{cmd}': '#{r}'|]
-
-
--- * Util
-
--- Copied from System.Process
-withForkWait :: IO () -> (IO () ->  IO a) -> IO a
-withForkWait asy body = do
-  waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ()))
-  mask $ \restore -> do
-    tid <- forkIO $ try (restore asy) >>= putMVar waitVar
-    let wait = takeMVar waitVar >>= either throwIO return
-    restore (body wait) `C.onException` killThread tid
-
--- Copied from System.Process
-ignoreSigPipe :: IO () -> IO ()
-ignoreSigPipe = C.handle $ \case
-  IOError { ioe_type  = ResourceVanished, ioe_errno = Just ioe } | Errno ioe == ePIPE -> return ()
-  e -> throwIO e
-
--- Copied from System.Process
-processFailedException :: String -> String -> [String] -> Int -> IO a
-processFailedException fun cmd args exit_code =
-  ioError (mkIOError OtherError (fun ++ ": " ++ cmd ++
-                                 Prelude.concatMap ((' ':) . show) args ++
-                                 " (exit " ++ show exit_code ++ ")")
-            Nothing Nothing)
diff --git a/sandwich/src/Test/Sandwich/Logging/Process.hs b/sandwich/src/Test/Sandwich/Logging/Process.hs
new file mode 100644
index 00000000..36cd45e2
--- /dev/null
+++ b/sandwich/src/Test/Sandwich/Logging/Process.hs
@@ -0,0 +1,198 @@
+{-# LANGUAGE CPP #-}
+
+-- | Functions for launching processes while capturing their output in the test logs.
+
+module Test.Sandwich.Logging.Process (
+  -- * Process functions with direct logging
+  createProcessWithLogging
+  , readCreateProcessWithLogging
+  , createProcessWithLoggingAndStdin
+  , callCommandWithLogging
+
+  , createProcessWithLogging'
+  , readCreateProcessWithLogging'
+  , createProcessWithLoggingAndStdin'
+  , callCommandWithLogging'
+  ) where
+
+import Control.Concurrent
+import Control.DeepSeq (rnf)
+import qualified Control.Exception as C
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.IO.Unlift
+import Control.Monad.Logger hiding (logOther)
+import Data.String.Interpolate
+import Foreign.C.Error
+import GHC.IO.Exception
+import GHC.Stack
+import System.IO
+import System.IO.Error (mkIOError)
+import Test.Sandwich.ManagedAsync
+import Test.Sandwich.Types.RunTree
+import UnliftIO.Async
+import UnliftIO.Exception
+import UnliftIO.Process
+
+#if !MIN_VERSION_base(4,13,0)
+import Control.Monad.Fail
+#endif
+
+
+-- | Spawn a process with its stdout and stderr connected to the logging system.
+-- Every line output by the process will be fed to a 'debug' call.
+createProcessWithLogging :: (HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => CreateProcess -> m (ProcessHandle, Async ())
+createProcessWithLogging = withFrozenCallStack (createProcessWithLogging' LevelDebug)
+
+-- | Spawn a process with its stdout and stderr connected to the logging system.
+createProcessWithLogging' :: (HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => LogLevel -> CreateProcess -> m (ProcessHandle, Async ())
+createProcessWithLogging' logLevel cp = do
+  (hRead, hWrite) <- liftIO createPipe
+
+  let name = case cmdspec cp of
+        ShellCommand {} -> "shell"
+        RawCommand path _ -> path
+
+  streamsReaderAsy <- managedAsyncContext "streams-reader" $ forever $ do
+    line <- liftIO $ hGetLine hRead
+    logOtherCS callStack logLevel [i|#{name}: #{line}|]
+
+  (_, _, _, p) <- liftIO $ createProcess (cp { std_out = UseHandle hWrite, std_err = UseHandle hWrite })
+  return (p, streamsReaderAsy)
+
+-- | Like 'readCreateProcess', but capture the stderr output in the logs.
+-- Every line output by the process will be fed to a 'debug' call.
+readCreateProcessWithLogging :: (HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => CreateProcess -> String -> m String
+readCreateProcessWithLogging = withFrozenCallStack (readCreateProcessWithLogging' LevelDebug)
+
+-- | Like 'readCreateProcess', but capture the stderr output in the logs.
+readCreateProcessWithLogging' :: (HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => LogLevel -> CreateProcess -> String -> m String
+readCreateProcessWithLogging' logLevel cp input = do
+  (hReadErr, hWriteErr) <- liftIO createPipe
+
+  let name = case cmdspec cp of
+        ShellCommand {} -> "shell"
+        RawCommand path _ -> path
+
+  let stderrReader = forever $ do
+        line <- liftIO $ hGetLine hReadErr
+        logOtherCS callStack logLevel [i|#{name}: #{line}|]
+
+  (ex, output) <-
+    managedWithAsyncContext_ "stderr-reader" stderrReader $
+    withCreateProcess (cp { std_in = CreatePipe, std_out = CreatePipe, std_err = UseHandle hWriteErr }) $ \sin' sout _ p ->
+      -- Do this just like 'readCreateProcess'
+      -- https://hackage.haskell.org/package/process-1.6.17.0/docs/src/System.Process.html#readCreateProcess
+      case (sin', sout) of
+        (Just hIn, Just hOut) -> liftIO $ do
+          output  <- hGetContents hOut
+          withForkWait (C.evaluate $ rnf output) $ \waitOut -> do
+            -- now write any input
+            unless (Prelude.null input) $
+              ignoreSigPipe $ hPutStr hIn input
+            -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
+            ignoreSigPipe $ hClose hIn
+
+            -- wait on the output
+            waitOut
+            hClose hOut
+
+          -- wait on the process
+          ex <- waitForProcess p
+          return (ex, output)
+        (Nothing, _) -> liftIO $ throwIO $ userError "readCreateProcessWithStderrLogging: Failed to get a stdin handle."
+        (_, Nothing) -> liftIO $ throwIO $ userError "readCreateProcessWithStderrLogging: Failed to get a stdout handle."
+
+  case ex of
+    ExitSuccess -> return output
+    ExitFailure r -> liftIO $ processFailedException "readCreateProcessWithLogging" cmd args r
+
+  where
+    cmd = case cp of
+            CreateProcess { cmdspec = ShellCommand sc } -> sc
+            CreateProcess { cmdspec = RawCommand fp _ } -> fp
+    args = case cp of
+             CreateProcess { cmdspec = ShellCommand _ } -> []
+             CreateProcess { cmdspec = RawCommand _ args' } -> args'
+
+
+-- | Spawn a process with its stdout and stderr connected to the logging system.
+-- Every line output by the process will be fed to a 'debug' call.
+createProcessWithLoggingAndStdin :: (HasCallStack, MonadUnliftIO m, MonadFail m, MonadLogger m, HasBaseContextMonad context m) => CreateProcess -> String -> m (ProcessHandle, Async ())
+createProcessWithLoggingAndStdin = withFrozenCallStack (createProcessWithLoggingAndStdin' LevelDebug)
+
+-- | Spawn a process with its stdout and stderr connected to the logging system.
+createProcessWithLoggingAndStdin' :: (HasCallStack, MonadUnliftIO m, MonadFail m, MonadLogger m, HasBaseContextMonad context m) => LogLevel -> CreateProcess -> String -> m (ProcessHandle, Async ())
+createProcessWithLoggingAndStdin' logLevel cp input = do
+  (hRead, hWrite) <- liftIO createPipe
+
+  let name = case cmdspec cp of
+        ShellCommand {} -> "shell"
+        RawCommand path _ -> path
+
+  readAsy <- managedAsyncContext "read-process-streams" $ forever $ do
+    line <- liftIO $ hGetLine hRead
+    logOtherCS callStack logLevel [i|#{name}: #{line}|]
+
+  (Just inh, _, _, p) <- liftIO $ createProcess (
+    cp { std_out = UseHandle hWrite
+       , std_err = UseHandle hWrite
+       , std_in = CreatePipe }
+    )
+
+  unless (Prelude.null input) $
+    liftIO $ ignoreSigPipe $ hPutStr inh input
+  -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
+  liftIO $ ignoreSigPipe $ hClose inh
+
+  return (p, readAsy)
+
+-- | Higher level version of 'createProcessWithLogging', accepting a shell command.
+callCommandWithLogging :: (HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => String -> m ()
+callCommandWithLogging = withFrozenCallStack (callCommandWithLogging' LevelDebug)
+
+-- | Higher level version of 'createProcessWithLogging'', accepting a shell command.
+callCommandWithLogging' :: (HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => LogLevel -> String -> m ()
+callCommandWithLogging' logLevel cmd = do
+  (hRead, hWrite) <- liftIO createPipe
+
+  (_, _, _, p) <- liftIO $ createProcess (shell cmd) {
+    delegate_ctlc = True
+    , std_out = UseHandle hWrite
+    , std_err = UseHandle hWrite
+    }
+
+  let streamsReader = forever $ do
+        line <- liftIO $ hGetLine hRead
+        logOtherCS callStack logLevel [i|#{cmd}: #{line}|]
+
+  managedWithAsyncContext_ "stderr-reader" streamsReader $
+    liftIO (waitForProcess p) >>= \case
+      ExitSuccess -> return ()
+      ExitFailure r -> liftIO $ throwIO $ userError [i|callCommandWithLogging failed for '#{cmd}': '#{r}'|]
+
+
+-- * Util
+
+-- Copied from System.Process
+withForkWait :: IO () -> (IO () ->  IO a) -> IO a
+withForkWait asy body = do
+  waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ()))
+  mask $ \restore -> do
+    tid <- forkIO $ try (restore asy) >>= putMVar waitVar
+    let wait' = takeMVar waitVar >>= either throwIO return
+    restore (body wait') `C.onException` killThread tid
+
+-- Copied from System.Process
+ignoreSigPipe :: IO () -> IO ()
+ignoreSigPipe = C.handle $ \case
+  IOError { ioe_type  = ResourceVanished, ioe_errno = Just ioe } | Errno ioe == ePIPE -> return ()
+  e -> throwIO e
+
+-- Copied from System.Process
+processFailedException :: String -> String -> [String] -> Int -> IO a
+processFailedException fun cmd args exit_code =
+  ioError (mkIOError OtherError (fun ++ ": " ++ cmd ++
+                                 Prelude.concatMap ((' ':) . show) args ++
+                                 " (exit " ++ show exit_code ++ ")")
+            Nothing Nothing)
diff --git a/sandwich/src/Test/Sandwich/Logging/ProcessFileLogging.hs b/sandwich/src/Test/Sandwich/Logging/ProcessFileLogging.hs
new file mode 100644
index 00000000..377dd5ca
--- /dev/null
+++ b/sandwich/src/Test/Sandwich/Logging/ProcessFileLogging.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE CPP #-}
+
+-- | Functions for launching processes while capturing their output to files in the test tree.
+
+module Test.Sandwich.Logging.ProcessFileLogging (
+  createProcessWithFileLogging
+  , readCreateProcessWithFileLogging
+  , createProcessWithFileLoggingAndStdin
+  , callCommandWithFileLogging
+  ) where
+
+import Control.Concurrent
+import Control.DeepSeq (rnf)
+import qualified Control.Exception as C
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.IO.Unlift
+import Control.Monad.Logger
+import Data.String.Interpolate
+import Foreign.C.Error
+import GHC.IO.Exception
+import GHC.Stack
+import System.FilePath
+import System.IO
+import System.Process
+import Test.Sandwich.Contexts
+import Test.Sandwich.Expectations
+import Test.Sandwich.Types.RunTree
+import UnliftIO.Exception
+
+#if !MIN_VERSION_base(4,13,0)
+import Control.Monad.Fail
+#endif
+
+
+-- | Derive a short name from a 'CreateProcess' for use in log file names.
+-- For 'RawCommand', takes the base filename of the executable.
+-- For 'ShellCommand', takes the first word of the command string.
+processName :: CreateProcess -> String
+processName cp = case cmdspec cp of
+  RawCommand path _ -> takeFileName path
+  ShellCommand cmd -> case words cmd of
+    (w:_) -> takeFileName w
+    [] -> "shell"
+
+-- | Spawn a process with its stdout and stderr logged to files in the test tree.
+createProcessWithFileLogging :: (
+  HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m
+  ) => CreateProcess -> m ProcessHandle
+createProcessWithFileLogging cp = withFrozenCallStack $ do
+  let name = processName cp
+  getCurrentFolder >>= \case
+    Nothing -> expectationFailure [i|createProcessWithFileLogging: no current folder, so unable to log for '#{name}'.|]
+    Just dir ->
+      bracket (liftIO $ openTempFile dir (name <.> "out")) (\(_outfile, hOut) -> liftIO $ hClose hOut) $ \(_outfile, hOut) ->
+      bracket (liftIO $ openTempFile dir (name <.> "err")) (\(_errfile, hErr) -> liftIO $ hClose hErr) $ \(_errfile, hErr) -> do
+        (_, _, _, p) <- liftIO $ createProcess (cp { std_out = UseHandle hOut, std_err = UseHandle hErr })
+        return p
+
+-- | Like 'readCreateProcess', but capture the stderr output to a file in the test tree.
+-- Returns the stdout output as a 'String'.
+readCreateProcessWithFileLogging :: (
+  HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m
+  ) => CreateProcess -> String -> m String
+readCreateProcessWithFileLogging cp input = withFrozenCallStack $ do
+  let name = processName cp
+  getCurrentFolder >>= \case
+    Nothing -> expectationFailure [i|readCreateProcessWithFileLogging: no current folder, so unable to log for '#{name}'.|]
+    Just dir ->
+      bracket (liftIO $ openTempFile dir (name <.> "err")) (\(_errfile, hErr) -> liftIO $ hClose hErr) $ \(_errfile, hErr) -> do
+        (ex, output) <- liftIO $ withCreateProcess (cp { std_in = CreatePipe, std_out = CreatePipe, std_err = UseHandle hErr }) $ \sin' sout _ p -> do
+          case (sin', sout) of
+            (Just hIn, Just hOut) -> do
+              output <- hGetContents hOut
+              withForkWait (C.evaluate $ rnf output) $ \waitOut -> do
+                unless (Prelude.null input) $
+                  ignoreSigPipe $ hPutStr hIn input
+                ignoreSigPipe $ hClose hIn
+                waitOut
+                hClose hOut
+              ex <- waitForProcess p
+              return (ex, output)
+            (Nothing, _) -> throwIO $ userError "readCreateProcessWithFileLogging: Failed to get a stdin handle."
+            (_, Nothing) -> throwIO $ userError "readCreateProcessWithFileLogging: Failed to get a stdout handle."
+        case ex of
+          ExitSuccess -> return output
+          ExitFailure r -> liftIO $ throwIO $ userError [i|readCreateProcessWithFileLogging failed for '#{name}': exit code #{r}|]
+
+-- | Spawn a process with its stdout and stderr logged to files in the test tree,
+-- passing the given string as stdin.
+createProcessWithFileLoggingAndStdin :: (HasCallStack, MonadUnliftIO m, MonadFail m, MonadLogger m, HasBaseContextMonad context m) => CreateProcess -> String -> m ProcessHandle
+createProcessWithFileLoggingAndStdin cp input = withFrozenCallStack $ do
+  let name = processName cp
+  getCurrentFolder >>= \case
+    Nothing -> expectationFailure [i|createProcessWithFileLoggingAndStdin: no current folder, so unable to log for '#{name}'.|]
+    Just dir ->
+      bracket (liftIO $ openTempFile dir (name <.> "out")) (\(_outfile, hOut) -> liftIO $ hClose hOut) $ \(_outfile, hOut) ->
+      bracket (liftIO $ openTempFile dir (name <.> "err")) (\(_errfile, hErr) -> liftIO $ hClose hErr) $ \(_errfile, hErr) -> do
+        (Just inh, _, _, p) <- liftIO $ createProcess (cp { std_out = UseHandle hOut
+                                                           , std_err = UseHandle hErr
+                                                           , std_in = CreatePipe })
+        unless (Prelude.null input) $
+          liftIO $ ignoreSigPipe $ hPutStr inh input
+        liftIO $ ignoreSigPipe $ hClose inh
+        return p
+
+-- | Higher level version of 'createProcessWithFileLogging', accepting a shell command.
+callCommandWithFileLogging :: (HasCallStack, MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => String -> m ()
+callCommandWithFileLogging cmd = withFrozenCallStack $ do
+  let name = processName (shell cmd)
+  getCurrentFolder >>= \case
+    Nothing -> expectationFailure [i|callCommandWithFileLogging: no current folder, so unable to log for '#{name}'.|]
+    Just dir ->
+      bracket (liftIO $ openTempFile dir (name <.> "out")) (\(_outfile, hOut) -> liftIO $ hClose hOut) $ \(_outfile, hOut) ->
+      bracket (liftIO $ openTempFile dir (name <.> "err")) (\(_errfile, hErr) -> liftIO $ hClose hErr) $ \(_errfile, hErr) -> do
+        (_, _, _, p) <- liftIO $ createProcess (shell cmd) {
+          delegate_ctlc = True
+          , std_out = UseHandle hOut
+          , std_err = UseHandle hErr
+          }
+        liftIO (waitForProcess p) >>= \case
+          ExitSuccess -> return ()
+          ExitFailure r -> liftIO $ throwIO $ userError [i|callCommandWithFileLogging failed for '#{cmd}': '#{r}'|]
+
+
+-- * Util
+
+-- Copied from System.Process
+withForkWait :: IO () -> (IO () ->  IO a) -> IO a
+withForkWait asy body = do
+  waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ()))
+  mask $ \restore -> do
+    tid <- forkIO $ try (restore asy) >>= putMVar waitVar
+    let wait = takeMVar waitVar >>= either throwIO return
+    restore (body wait) `C.onException` killThread tid
+
+-- Copied from System.Process
+ignoreSigPipe :: IO () -> IO ()
+ignoreSigPipe = C.handle $ \case
+  IOError { ioe_type  = ResourceVanished, ioe_errno = Just ioe } | Errno ioe == ePIPE -> return ()
+  e -> throwIO e
diff --git a/sandwich/src/Test/Sandwich/ManagedAsync.hs b/sandwich/src/Test/Sandwich/ManagedAsync.hs
new file mode 100644
index 00000000..c0e1fa3d
--- /dev/null
+++ b/sandwich/src/Test/Sandwich/ManagedAsync.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE RankNTypes #-}
+
+module Test.Sandwich.ManagedAsync (
+  -- * With explicit run ID
+  managedAsync
+  , managedAsyncWithUnmask
+  , managedWithAsync
+  , managedWithAsync_
+
+  -- * With run ID from BaseContext
+  , managedAsyncContext
+  , managedAsyncWithUnmaskContext
+  , managedWithAsyncContext
+  , managedWithAsyncContext_
+
+  -- * Types and utilities
+  , AsyncInfo(..)
+  , AsyncEvent(..)
+  , asyncEventBroadcast
+  , getManagedAsyncInfos
+  ) where
+
+import Control.Concurrent (ThreadId, myThreadId)
+import Control.Concurrent.STM
+import Control.Monad.IO.Unlift
+import Control.Monad.Reader
+import Data.IORef
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import System.IO.Unsafe (unsafePerformIO)
+import Test.Sandwich.Types.RunTree (HasBaseContextMonad, BaseContext(..), getBaseContext)
+import UnliftIO.Async
+import UnliftIO.Exception
+
+
+data AsyncInfo = AsyncInfo {
+  asyncInfoThreadId :: !T.Text
+  , asyncInfoParentThreadId :: !T.Text
+  , asyncInfoName :: !T.Text
+  , asyncInfoRunId :: !T.Text
+  } deriving (Show, Eq)
+
+data AsyncEvent = AsyncStarted !AsyncInfo | AsyncFinished !AsyncInfo
+
+{-# NOINLINE allManagedAsyncs #-}
+allManagedAsyncs :: IORef (M.Map ThreadId AsyncInfo)
+allManagedAsyncs = unsafePerformIO $ newIORef M.empty
+
+{-# NOINLINE asyncEventBroadcast #-}
+asyncEventBroadcast :: TChan AsyncEvent
+asyncEventBroadcast = unsafePerformIO newBroadcastTChanIO
+
+getManagedAsyncInfos :: IO (M.Map T.Text AsyncInfo)
+getManagedAsyncInfos = M.mapKeys (T.pack . show) <$> readIORef allManagedAsyncs
+
+managedAsync :: MonadUnliftIO m => T.Text -> T.Text -> m a -> m (Async a)
+managedAsync runId name action = do
+  parentThreadId <- liftIO myThreadId
+  async $ bracketedAction parentThreadId runId name action
+
+managedAsyncWithUnmask :: MonadUnliftIO m => T.Text -> T.Text -> ((forall b. m b -> m b) -> m a) -> m (Async a)
+managedAsyncWithUnmask runId name action = do
+  parentThreadId <- liftIO myThreadId
+  asyncWithUnmask $ \unmask -> bracketedAction parentThreadId runId name (action unmask)
+
+managedWithAsync :: MonadUnliftIO m => T.Text -> T.Text -> m a -> (Async a -> m b) -> m b
+managedWithAsync runId name action cb = do
+  parentThreadId <- liftIO myThreadId
+  withAsync (bracketedAction parentThreadId runId name action) cb
+
+managedWithAsync_ :: MonadUnliftIO m => T.Text -> T.Text -> m a -> m b -> m b
+managedWithAsync_ runId name f g = managedWithAsync runId name f (const g)
+
+-- * With run ID from BaseContext
+
+-- | Like 'managedAsync', but extracts the run ID from 'BaseContext'.
+managedAsyncContext :: (MonadUnliftIO m, HasBaseContextMonad context m) => T.Text -> m a -> m (Async a)
+managedAsyncContext name action = do
+  runId <- baseContextRunId <$> asks getBaseContext
+  managedAsync runId name action
+
+-- | Like 'managedAsyncWithUnmask', but extracts the run ID from 'BaseContext'.
+managedAsyncWithUnmaskContext :: (MonadUnliftIO m, HasBaseContextMonad context m) => T.Text -> ((forall b. m b -> m b) -> m a) -> m (Async a)
+managedAsyncWithUnmaskContext name action = do
+  runId <- baseContextRunId <$> asks getBaseContext
+  managedAsyncWithUnmask runId name action
+
+-- | Like 'managedWithAsync', but extracts the run ID from 'BaseContext'.
+managedWithAsyncContext :: (MonadUnliftIO m, HasBaseContextMonad context m) => T.Text -> m a -> (Async a -> m b) -> m b
+managedWithAsyncContext name action cb = do
+  runId <- baseContextRunId <$> asks getBaseContext
+  managedWithAsync runId name action cb
+
+-- | Like 'managedWithAsync_', but extracts the run ID from 'BaseContext'.
+managedWithAsyncContext_ :: (MonadUnliftIO m, HasBaseContextMonad context m) => T.Text -> m a -> m b -> m b
+managedWithAsyncContext_ name f g = managedWithAsyncContext name f (const g)
+
+-- * Internal
+
+bracketedAction :: MonadUnliftIO m => ThreadId -> T.Text -> T.Text -> m a -> m a
+bracketedAction parentThreadId runId name action = bracket record unrecord (const action)
+  where
+    record :: MonadUnliftIO m => m ThreadId
+    record = do
+      asyncThreadId <- liftIO myThreadId
+      let info = AsyncInfo {
+            asyncInfoThreadId = T.pack (show asyncThreadId)
+            , asyncInfoParentThreadId = T.pack (show parentThreadId)
+            , asyncInfoName = name
+            , asyncInfoRunId = runId
+            }
+      liftIO $ atomicModifyIORef' allManagedAsyncs (\m -> (M.insert asyncThreadId info m, ()))
+      liftIO $ atomically $ writeTChan asyncEventBroadcast (AsyncStarted info)
+      return asyncThreadId
+
+    unrecord :: MonadUnliftIO m => ThreadId -> m ()
+    unrecord asyncThreadId = liftIO $ do
+      mInfo <- atomicModifyIORef' allManagedAsyncs (\m -> (M.delete asyncThreadId m, M.lookup asyncThreadId m))
+      case mInfo of
+        Just info -> atomically $ writeTChan asyncEventBroadcast (AsyncFinished info)
+        Nothing -> return ()
diff --git a/sandwich/src/Test/Sandwich/Misc.hs b/sandwich/src/Test/Sandwich/Misc.hs
index 15578f63..58b5e108 100644
--- a/sandwich/src/Test/Sandwich/Misc.hs
+++ b/sandwich/src/Test/Sandwich/Misc.hs
@@ -34,7 +34,8 @@ module Test.Sandwich.Misc (
 
   -- * Context classes
   , BaseContext
-  , HasBaseContext
+  , baseContextRunId
+  , HasBaseContext(..)
   , HasBaseContextMonad
   , HasCommandLineOptions
   , SomeCommandLineOptions(..)
diff --git a/sandwich/src/Test/Sandwich/Options.hs b/sandwich/src/Test/Sandwich/Options.hs
index c27928b0..ffdff1a7 100644
--- a/sandwich/src/Test/Sandwich/Options.hs
+++ b/sandwich/src/Test/Sandwich/Options.hs
@@ -57,6 +57,10 @@ defaultOptions = Options {
   , optionsTestTimerType = SpeedScopeTestTimerType { speedScopeTestTimerWriteRawTimings = False }
   , optionsWarnOnLongExecutionMs = Nothing
   , optionsCancelOnLongExecutionMs = Nothing
+  , optionsLogBroadcast = Nothing
+  , optionsEventBroadcast = Nothing
+  , optionsLateLogFile = Nothing
+  , optionsRunId = "run0"
   }
 
 -- | Generate a test artifacts directory based on a timestamp.
diff --git a/sandwich/src/Test/Sandwich/Types/ArgParsing.hs b/sandwich/src/Test/Sandwich/Types/ArgParsing.hs
index f10b7032..f2f6bf27 100644
--- a/sandwich/src/Test/Sandwich/Types/ArgParsing.hs
+++ b/sandwich/src/Test/Sandwich/Types/ArgParsing.hs
@@ -59,6 +59,12 @@ data CommandLineOptions a = CommandLineOptions {
   , optWarnOnLongExecutionMs :: Maybe Int
   , optCancelOnLongExecutionMs :: Maybe Int
   , optMarkdownSummaryPath :: Maybe FilePath
+  , optTuiDebugSocket :: Bool
+  , optSocketFormatter :: Bool
+  , optLogLogs :: Bool
+  , optLogEvents :: Bool
+  , optLogRtsStats :: Bool
+  , optLogAsyncs :: Bool
 
   , optListAvailableTests :: Maybe Bool
   , optListAvailableTestsJson :: Maybe Bool
diff --git a/sandwich/src/Test/Sandwich/Types/RunTree.hs b/sandwich/src/Test/Sandwich/Types/RunTree.hs
index 39147ac2..b6d5a286 100644
--- a/sandwich/src/Test/Sandwich/Types/RunTree.hs
+++ b/sandwich/src/Test/Sandwich/Types/RunTree.hs
@@ -23,6 +23,7 @@ import qualified Data.Text as T
 import Data.Time
 import Data.Typeable
 import GHC.Stack
+import System.IO (Handle)
 import Test.Sandwich.Types.ArgParsing
 import Test.Sandwich.Types.Spec
 import Test.Sandwich.Types.TestTimer
@@ -111,13 +112,30 @@ type RunNodeCommon = RunNodeCommonWithStatus (Var Status) (Var (Seq LogEntry)) (
 
 type Var = TVar
 data LogEntry = LogEntry {
-  logEntryTime :: UTCTime
-  , logEntryLoc :: Loc
-  , logEntrySource :: LogSource
-  , logEntryLevel :: LogLevel
-  , logEntryStr :: LogStr
+  logEntryTime :: !UTCTime
+  , logEntryLoc :: !Loc
+  , logEntrySource :: !LogSource
+  , logEntryLevel :: !LogLevel
+  , logEntryStr :: !BS8.ByteString
   } deriving (Show, Eq)
 
+data NodeEvent = NodeEvent {
+  nodeEventTime :: !UTCTime
+  , nodeEventId :: !Int
+  , nodeEventLabel :: !String
+  , nodeEventType :: !NodeEventType
+  } deriving (Show, Eq)
+
+data NodeEventType
+  = EventStarted
+  | EventDone !Result
+  | EventSetupStarted
+  | EventSetupFinished
+  | EventTeardownStarted
+  | EventTeardownFinished
+  | EventMilestone !String
+  deriving (Show, Eq)
+
 -- | Context passed around through the evaluation of a RunTree
 data RunTreeContext = RunTreeContext {
   runTreeCurrentAncestors :: Seq Int
@@ -136,6 +154,7 @@ data BaseContext = BaseContext {
   , baseContextOnlyRunIds :: Maybe (S.Set Int)
   , baseContextTestTimerProfile :: T.Text
   , baseContextTestTimer :: TestTimer
+  , baseContextRunId :: T.Text
   }
 
 -- | Has-* class for asserting a 'BaseContext' is available.
@@ -228,7 +247,7 @@ newtype TreeFilter = TreeFilter { unTreeFilter :: [String] }
 type LogFn = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
 
 -- | A callback for formatting a log entry to a 'BS8.ByteString'.
-type LogEntryFormatter = UTCTime -> Loc -> LogSource -> LogLevel -> LogStr -> BS8.ByteString
+type LogEntryFormatter = UTCTime -> Loc -> LogSource -> LogLevel -> BS8.ByteString -> BS8.ByteString
 
 -- The defaultLogStr formatter weirdly puts information after the message. Use our own
 defaultLogEntryFormatter :: LogEntryFormatter
@@ -240,7 +259,7 @@ defaultLogEntryFormatter ts loc src level msg = fromLogStr $
   <> toLogStr src
   <> ") "
   <> (if isDefaultLoc loc then "" else "@(" <> toLogStr (BS8.pack fileLocStr) <> ") ")
-  <> msg
+  <> toLogStr msg
   <> "\n"
 
   where
@@ -295,6 +314,15 @@ data Options = Options {
   -- ^ If set, alerts user to nodes that run for the given number of milliseconds, by writing to a file in the root directory.
   , optionsCancelOnLongExecutionMs :: Maybe Int
   -- ^ Same as 'optionsWarnOnLongExecutionMs', but also cancels the problematic nodes.
+  , optionsLogBroadcast :: Maybe (TChan (Int, String, LogEntry))
+  -- ^ Broadcast channel for streaming log entries to external consumers (e.g. socket formatter).
+  -- Each entry is tagged with (nodeId, nodeLabel, logEntry).
+  , optionsEventBroadcast :: Maybe (TChan NodeEvent)
+  -- ^ Broadcast channel for streaming node lifecycle events (started, done) to external consumers.
+  , optionsLateLogFile :: Maybe Handle
+  -- ^ If set, log writes that occur after a node is already Done will be written to this file handle.
+  , optionsRunId :: T.Text
+  -- ^ An identifier for this test run, used to track managed async threads.
   }
 
 -- | A wrapper type for exceptions with attached callstacks. Haskell doesn't currently offer a way
diff --git a/sandwich/test/TestUtil.hs b/sandwich/test/TestUtil.hs
index 98e54aad..14f45c09 100644
--- a/sandwich/test/TestUtil.hs
+++ b/sandwich/test/TestUtil.hs
@@ -4,6 +4,7 @@
 module TestUtil where
 
 import Control.Concurrent.STM
+import qualified Data.ByteString.Char8 as BS8
 import Control.Monad.IO.Class
 import Control.Monad.Logger
 import Control.Monad.Trans.Writer
@@ -58,7 +59,7 @@ runAndGetResults spec = do
   fixedTree <- atomically $ mapM fixRunTree finalTree
   return $ fmap statusToResult $ concatMap getStatuses fixedTree
 
-runAndGetResultsAndLogs :: (HasCallStack) => CoreSpec -> IO ([Result], [[LogStr]])
+runAndGetResultsAndLogs :: (HasCallStack) => CoreSpec -> IO ([Result], [[BS8.ByteString]])
 runAndGetResultsAndLogs spec = do
   finalTree <- runSandwichTree defaultOptions spec
   getResultsAndMessages <$> fixTree finalTree
@@ -66,13 +67,13 @@ runAndGetResultsAndLogs spec = do
 fixTree :: [RunNode context] -> IO [RunNodeFixed context]
 fixTree rts = atomically $ mapM fixRunTree rts
 
-getResultsAndMessages :: (HasCallStack) => [RunNodeFixed context] -> ([Result], [[LogStr]])
+getResultsAndMessages :: (HasCallStack) => [RunNodeFixed context] -> ([Result], [[BS8.ByteString]])
 getResultsAndMessages fixedTree = (results, msgs)
   where
     results = fmap statusToResult $ concatMap getStatuses fixedTree
     msgs = getMessages fixedTree
 
-getMessages :: [RunNodeFixed context] -> [[LogStr]]
+getMessages :: [RunNodeFixed context] -> [[BS8.ByteString]]
 getMessages fixedTree = fmap (toList . (fmap logEntryStr)) $ concatMap getLogs fixedTree
 
 getStatuses :: RunNodeWithStatus context s l t -> [(String, s)]
diff --git a/stack.yaml b/stack.yaml
index 664c77e6..581c3367 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -48,6 +48,7 @@ packages:
 - ./demos/demo-setup-teardown
 - ./demos/demo-slack
 - ./demos/demo-stack-test
+- ./demos/demo-stress
 - ./demos/demo-timing
 - ./demos/demo-timing-parallel
 - ./demos/demo-tui
@@ -59,6 +60,7 @@ packages:
 - ./demos/demo-webdriver-video
 
 extra-deps:
+
 # For sandwich-webdriver
 
 - webdriver-0.14.0.0
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 03f1d81d..758424af 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -1,89 +1,89 @@
 # This file was autogenerated by Stack.
 # You should not edit this file by hand.
 # For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/lock_files
+#   https://docs.haskellstack.org/en/stable/topics/lock_files
 
 packages:
 - completed:
     hackage: webdriver-0.14.0.0@sha256:3a529a3520b3d9be4dcc0c51fabd96ee3e67661ac18e6d4417100ac187da4c15,6463
     pantry-tree:
-      size: 5522
       sha256: 2770f7329cc59c8c60cc639ec56d11904cf04fc245c4195039ec6fec328dc0fd
+      size: 5522
   original:
     hackage: webdriver-0.14.0.0
 - completed:
-    name: minio-hs
-    version: 1.7.0
+    commit: 3e665784228cba7261560c104b8f1d928e7b5bd4
     git: https://github.com/minio/minio-hs
+    name: minio-hs
     pantry-tree:
-      size: 4744
       sha256: b40b79fedd757eac8825f89eafc5ee13f3991898e407cb3d1c9b5a3b15bffdfc
-    commit: 3e665784228cba7261560c104b8f1d928e7b5bd4
+      size: 4744
+    version: 1.7.0
   original:
-    git: https://github.com/minio/minio-hs
     commit: 3e665784228cba7261560c104b8f1d928e7b5bd4
+    git: https://github.com/minio/minio-hs
 - completed:
-    subdir: v1.44
-    name: docker-engine
-    version: 144.0.0
+    commit: 58535cd46712dff421f2148e438c49c2700ea20e
     git: https://github.com/codedownio/docker-engine.git
+    name: docker-engine
     pantry-tree:
-      size: 2451
       sha256: cc9ed672084a86834dff2ff143002e988142864b51bd620ea8d4180e6f1041b8
-    commit: 58535cd46712dff421f2148e438c49c2700ea20e
-  original:
+      size: 2451
     subdir: v1.44
-    git: https://github.com/codedownio/docker-engine.git
+    version: 144.0.0
+  original:
     commit: 58535cd46712dff421f2148e438c49c2700ea20e
+    git: https://github.com/codedownio/docker-engine.git
+    subdir: v1.44
 - completed:
     hackage: kubernetes-api-130.0.0@sha256:aa2d91343a2639efbb3cbb1256ba7eaa43d3476e6e35a50770ecb4b19bf8c114,5635
     pantry-tree:
-      size: 6518
       sha256: a94bf97a25641331d46db1e4243aaf11e8b193f7f6dcd890cb6364ad5ec3c320
+      size: 6518
   original:
     hackage: kubernetes-api-130.0.0
 - completed:
     hackage: kubernetes-api-client-0.6.1.2@sha256:1e8fc7d53511f08380b54cea92ab85c50c88e7ba97552d10e8712ee918976015,5034
     pantry-tree:
-      size: 2026
       sha256: f339c3ef1e14988806ba79fb885f6802be06510ae9bb2a6ae1809a5adceeea0c
+      size: 2026
   original:
     hackage: kubernetes-api-client-0.6.1.2
 - completed:
-    name: oidc-client
-    version: 0.8.0.0
+    commit: 2d19db09bf13f02f49248f7b21703b2c59e06ecc
     git: https://github.com/krdlab/haskell-oidc-client
+    name: oidc-client
     pantry-tree:
-      size: 1846
       sha256: 1ba8f7b134dffd636721d4cebc4c52721b8cb628bc332eed3088443cd2cc969c
-    commit: 2d19db09bf13f02f49248f7b21703b2c59e06ecc
+      size: 1846
+    version: 0.8.0.0
   original:
-    git: https://github.com/krdlab/haskell-oidc-client
     commit: 2d19db09bf13f02f49248f7b21703b2c59e06ecc
+    git: https://github.com/krdlab/haskell-oidc-client
 - completed:
     hackage: HaskellNet-0.6.2@sha256:afc178bd40f0e8d8368bef8308881f73985ccbe3ce8f4c68ba5d7db3ca18cc36,2478
     pantry-tree:
-      size: 1689
       sha256: 6c69d25f62ce5ecb49b87546d052b67fa8e548f7c161dd87274c696c563f9314
+      size: 1689
   original:
     hackage: HaskellNet-0.6.2
 - completed:
     hackage: cryptonite-0.30@sha256:12c85dea7be63e5ad90bcb487eb3846bf3c413347f94336fa1dede7b28f9936a,18301
     pantry-tree:
-      size: 23323
       sha256: df1cbe4cc40d569cc75ffed40bc5deac43cb085653980b42b9b6a5d4b745a30a
+      size: 23323
   original:
     hackage: cryptonite-0.30@sha256:12c85dea7be63e5ad90bcb487eb3846bf3c413347f94336fa1dede7b28f9936a,18301
 - completed:
     hackage: cryptonite-conduit-0.2.2@sha256:bfbae677a44f3a5cf3bf7f36271682979a402825f3d1e8767cfd62f2ddb702c2,1984
     pantry-tree:
-      size: 595
       sha256: 251e4a1b3d382e4cbf9d378a5550cf617bb2650d61339db93253f2189bbfa918
+      size: 595
   original:
     hackage: cryptonite-conduit-0.2.2@sha256:bfbae677a44f3a5cf3bf7f36271682979a402825f3d1e8767cfd62f2ddb702c2,1984
 snapshots:
 - completed:
+    sha256: 89f1083d6c74b5b78ace9ca630e015f016d4a8d2ffcace7ae02bad57289ba9e9
     size: 690943
     url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2025/9/6.yaml
-    sha256: 89f1083d6c74b5b78ace9ca630e015f016d4a8d2ffcace7ae02bad57289ba9e9
   original: nightly-2025-09-06