Por que a função de colchete de Haskell funciona em executáveis, mas falha na limpeza nos testes?

Estou vendo um comportamento muito estranho, onde a bracketfunção de Haskell está se comportando de maneira diferente, dependendo de ser stack runou stack testnão usada.

Considere o código a seguir, onde dois colchetes aninhados são usados ​​para criar e limpar contêineres do 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
                     )
          )

Quando executo isso stack rune o interrompo Ctrl+C, obtenho a saída esperada:

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

E posso verificar se os dois contêineres do Docker são criados e removidos.

No entanto, se eu colar exatamente o mesmo código em um teste e executar stack test, apenas (parte de) a primeira limpeza acontece:

Inside both brackets, sleeping!
^CInner release
container2

Isso resulta em um contêiner do Docker em execução na minha máquina. O que está acontecendo?

• Eu me certifiquei de que exatamente o mesmo ghc-optionsseja passado para ambos.
• Repo de demonstração completo aqui: https://github.com/thomasjm/bracket-issue

Quando você usa stack run, o Stack efetivamente usa uma execchamada de sistema para transferir o controle para o executável; portanto, o processo para o novo executável substitui o processo de Stack em execução, como se você executasse o executável diretamente do shell. Aqui está a aparência da árvore de processo stack run. Observe em particular que o executável é um filho direto do shell Bash. Mais criticamente, observe que o grupo de processos em primeiro plano do terminal (TPGID) é 17996 e o ​​único processo nesse grupo de processos (PGID) é o bracket-test-exeprocesso.

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, quando você pressiona Ctrl-C para interromper o processo em execução sob stack runou diretamente do shell, o sinal SIGINT é entregue apenas ao bracket-test-exeprocesso. Isso gera uma UserInterruptexceção assíncrona . A maneira como bracketfunciona, quando:

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

recebe uma exceção assíncrona durante o processamento body, executa releasee gera novamente a exceção. Com suas bracketchamadas aninhadas , isso tem o efeito de interromper o corpo interno, processar a liberação interna, aumentar novamente a exceção para interromper o corpo externo e processar a liberação externa e, finalmente, aumentar novamente a exceção para encerrar o programa. (Se houvesse mais ações seguindo a parte externa bracketda sua mainfunção, elas não seriam executadas.)

Por outro lado, quando você usa stack test, o Stack usa withProcessWaitpara iniciar o executável como um processo filho do stack testprocesso. Na árvore de processos a seguir, observe que bracket-test-testé um processo filho de stack test. Criticamente, o grupo de processos em primeiro plano do terminal é 18050 e esse grupo de processos inclui o stack testprocesso e o bracket-test-testprocesso.

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

Quando você pressione Ctrl-C no terminal, o sinal SIGINT é enviado para todos os processos no grupo de processos de primeiro plano do terminal para ambos stack teste bracket-test-testobter o sinal. bracket-test-testcomeçará a processar o sinal e executar os finalizadores conforme descrito acima. No entanto, há uma condição de corrida aqui porque, quando stack testinterrompida, está no meio da withProcessWaitqual é definida mais ou menos da seguinte maneira:

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

portanto, quando bracketé interrompido, ele chama o stopProcessque encerra o processo filho enviando o SIGTERMsinal. Em contraste com SIGINT, isso não gera uma exceção assíncrona. Ele acaba com o filho imediatamente, geralmente antes de concluir a execução de qualquer finalizador.

Não consigo pensar em uma maneira particularmente fácil de solucionar isso. Uma maneira é usar as instalações System.Posixpara colocar o processo em seu próprio grupo de processos:

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"

Agora, Ctrl-C resultará na entrega do SIGINT apenas ao bracket-test-testprocesso. Ele limpará, restaurará o grupo de processos em primeiro plano original para apontar para o stack testprocesso e terminar. Isso resultará na falha do teste e stack testcontinuará sendo executado.

Uma alternativa seria tentar manipular SIGTERMe manter o processo filho em execução para executar a limpeza, mesmo após o stack testtérmino do processo. Isso é meio feio, pois o processo meio que se limpa em segundo plano enquanto você olha para o prompt do shell.