¿Por qué la función de soporte de Haskell funciona en ejecutables pero no se limpia en las pruebas?

Veo un comportamiento muy extraño en el que la bracketfunción de Haskell se comporta de manera diferente dependiendo de si se usa stack runo no stack test.

Considere el siguiente código, donde se usan dos corchetes anidados para crear y limpiar contenedores Docker:

module Main where

import Control.Concurrent
import Control.Exception
import System.Process

main :: IO ()
main = do
  bracket (callProcess "docker" ["run", "-d", "--name", "container1", "registry:2"])
          (\() -> do
              putStrLn "Outer release"
              callProcess "docker" ["rm", "-f", "container1"]
              putStrLn "Done with outer release"
          )
          (\() -> do
             bracket (callProcess "docker" ["run", "-d", "--name", "container2", "registry:2"])
                     (\() -> do
                         putStrLn "Inner release"
                         callProcess "docker" ["rm", "-f", "container2"]
                         putStrLn "Done with inner release"
                     )
                     (\() -> do
                         putStrLn "Inside both brackets, sleeping!"
                         threadDelay 300000000
                     )
          )

Cuando ejecuto esto con stack rune interrumpo con Ctrl+C, obtengo el resultado esperado:

Inside both brackets, sleeping!
^CInner release
container2
Done with inner release
Outer release
container1
Done with outer release

Y puedo verificar que ambos contenedores Docker se crean y luego se eliminan.

Sin embargo, si pego exactamente el mismo código en una prueba y ejecuto stack test, solo (parte de) ocurre la primera limpieza:

Inside both brackets, sleeping!
^CInner release
container2

Esto da como resultado un contenedor Docker que se ejecuta en mi máquina. ¿Que esta pasando?

• Me he asegurado de que se ghc-optionsles pase exactamente lo mismo a ambos.
• Repo de demostración completo aquí: https://github.com/thomasjm/bracket-issue

Cuando lo usa stack run, Stack usa efectivamente una execllamada del sistema para transferir el control al ejecutable, por lo que el proceso para el nuevo ejecutable reemplaza el proceso de Stack en ejecución, como si ejecutara el ejecutable directamente desde el shell. Así es como se ve el árbol de procesos stack run. Tenga en cuenta en particular que el ejecutable es un hijo directo del shell Bash. Más críticamente, tenga en cuenta que el grupo de procesos en primer plano del terminal (TPGID) es 17996, y el único proceso en ese grupo de procesos (PGID) es el bracket-test-exeproceso.

PPID   PID  PGID   SID TTY      TPGID STAT   UID   TIME COMMAND
13816 13831 13831 13831 pts/3    17996 Ss    2001   0:00  |       \_ /bin/bash --noediting -i
13831 17996 17996 13831 pts/3    17996 Sl+   2001   0:00  |       |   \_ .../.stack-work/.../bracket-test-exe

Como resultado, cuando presiona Ctrl-C para interrumpir el proceso que se ejecuta debajo stack runo directamente desde el shell, la señal SIGINT se entrega solo al bracket-test-exeproceso. Esto genera una UserInterruptexcepción asincrónica . La forma en que bracketfunciona, cuando:

bracket
  acquire
  (\() -> release)
  (\() -> body)

recibe una excepción asincrónica mientras procesa body, se ejecuta releasey luego vuelve a generar la excepción. Con sus bracketllamadas anidadas , esto tiene el efecto de interrumpir el cuerpo interno, procesar la liberación interna, volver a generar la excepción para interrumpir el cuerpo externo y procesar la liberación externa, y finalmente volver a generar la excepción para finalizar el programa. (Si hubiera más acciones siguiendo lo externo bracketen su mainfunción, no se ejecutarían).

Por otro lado, cuando lo usa stack test, Stack lo utiliza withProcessWaitpara iniciar el ejecutable como un proceso secundario del stack testproceso. En el siguiente árbol de procesos, tenga en cuenta que bracket-test-testes un proceso secundario de stack test. Críticamente, el grupo de procesos en primer plano del terminal es 18050, y ese grupo de procesos incluye tanto el stack testproceso como el bracket-test-testproceso.

PPID   PID  PGID   SID TTY      TPGID STAT   UID   TIME COMMAND
13816 13831 13831 13831 pts/3    18050 Ss    2001   0:00  |       \_ /bin/bash --noediting -i
13831 18050 18050 13831 pts/3    18050 Sl+   2001   0:00  |       |   \_ stack test
18050 18060 18050 13831 pts/3    18050 Sl+   2001   0:00  |       |       \_ .../.stack-work/.../bracket-test-test

Al llegar a Ctrl-C en la terminal, la señal SIGINT se envía a todos los procesos en el grupo de procesos en primer plano de la terminal por lo tanto stack testy bracket-test-testobtener la señal. bracket-test-testcomenzará a procesar la señal y ejecutará los finalizadores como se describe anteriormente. Sin embargo, hay una condición de carrera aquí porque cuando stack testse interrumpe, está en el medio del withProcessWaitcual se define más o menos de la siguiente manera:

withProcessWait config f =
  bracket
    (startProcess config)
    stopProcess
    (\p -> f p <* waitExitCode p)

entonces, cuando bracketse interrumpe, llama, lo stopProcessque termina el proceso secundario enviándole la SIGTERMseñal. En contraposición a SIGINTesto, esto no genera una excepción asincrónica. Simplemente termina al niño inmediatamente, generalmente antes de que pueda terminar de ejecutar los finalizadores.

No puedo pensar en una forma particularmente fácil de solucionar esto. Una forma es utilizar las instalaciones System.Posixpara colocar el proceso en su propio grupo de procesos:

main :: IO ()
main = do
  -- save old terminal foreground process group
  oldpgid <- getTerminalProcessGroupID (Fd 2)
  -- get our PID
  mypid <- getProcessID
  let -- put us in our own foreground process group
      handleInt  = setTerminalProcessGroupID (Fd 2) mypid >> createProcessGroupFor mypid
      -- restore the old foreground process gorup
      releaseInt = setTerminalProcessGroupID (Fd 2) oldpgid
  bracket
    (handleInt >> putStrLn "acquire")
    (\() -> threadDelay 1000000 >> putStrLn "release" >> releaseInt)
    (\() -> putStrLn "between" >> threadDelay 60000000)
  putStrLn "finished"

Ahora, Ctrl-C dará como resultado que SIGINT se entregue solo al bracket-test-testproceso. Se limpiará, restaurará el grupo de procesos en primer plano original para señalar el stack testproceso y finalizará. Esto dará como resultado la falla de la prueba y stack testseguirá ejecutándose.

Una alternativa sería tratar de manejar SIGTERMy mantener el proceso secundario ejecutándose para realizar la limpieza, incluso una vez que el stack testproceso haya finalizado. Esto es un poco feo ya que el proceso se limpiará en segundo plano mientras observa el indicador de shell.