Perché la funzione di parentesi di Haskell funziona negli eseguibili ma non riesce a ripulire nei test?

Sto vedendo un comportamento molto strano in cui la bracketfunzione di Haskell si sta comportando in modo diverso a seconda che venga utilizzata stack runo meno stack test.

Si consideri il codice seguente, in cui vengono utilizzate due parentesi nidificate per creare e pulire i contenitori 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 eseguo questo con stack rune interrompo con Ctrl+C, ottengo l'output previsto:

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

E posso verificare che entrambi i contenitori Docker vengano creati e quindi rimossi.

Tuttavia, se incollo esattamente lo stesso codice in un test ed eseguo stack test, si verifica solo (parte di) la prima pulizia:

Inside both brackets, sleeping!
^CInner release
container2

Ciò si traduce in un contenitore Docker lasciato in esecuzione sul mio computer. Cosa sta succedendo?

• Ho fatto in modo che lo stesso ghc-optionssia passato a entrambi.
• Repository dimostrativo completo qui: https://github.com/thomasjm/bracket-issue

Quando lo usi stack run, Stack utilizza efficacemente una execchiamata di sistema per trasferire il controllo all'eseguibile, quindi il processo per il nuovo eseguibile sostituisce il processo Stack in esecuzione, come se eseguissi l'eseguibile direttamente dalla shell. Ecco come appare l'albero di processo stack run. Si noti in particolare che l'eseguibile è un figlio diretto della shell Bash. Più criticamente, si noti che il gruppo di processi in primo piano del terminale (TPGID) è 17996 e l'unico processo in quel gruppo di processi (PGID) è il 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

Di conseguenza, quando si preme Ctrl-C per interrompere il processo in esecuzione sotto stack runo direttamente dalla shell, il segnale SIGINT viene inviato solo al bracket-test-exeprocesso. Ciò solleva UserInterruptun'eccezione asincrona . Il modo in cui bracketfunziona quando:

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

riceve un'eccezione asincrona durante l'elaborazione body, viene eseguita releasee quindi genera nuovamente l'eccezione. Con le bracketchiamate annidate , ciò ha l'effetto di interrompere il corpo interno, elaborare il rilascio interno, ri-sollevare l'eccezione per interrompere il corpo esterno, elaborare il rilascio esterno e infine ri-sollevare l'eccezione per terminare il programma. (Se ci fossero più azioni che seguono l'esterno bracketnella tua mainfunzione, non verrebbero eseguite.)

D'altra parte, quando si utilizza stack test, Stack utilizza withProcessWaitper avviare l'eseguibile come processo figlio del stack testprocesso. Nell'albero del processo seguente, notare che bracket-test-testè un processo figlio di stack test. Criticamente, il gruppo di processi in primo piano del terminale è 18050 e quel gruppo di processi include sia il stack testprocesso che il 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 si preme Ctrl-C nel terminale, il segnale SIGINT viene inviato a tutti i processi nel gruppo di processi in primo piano del terminale in modo che entrambi stack teste bracket-test-testottengano il segnale. bracket-test-testinizierà l'elaborazione del segnale e l'esecuzione dei finalizzatori come descritto sopra. Tuttavia, c'è una condizione di gara qui perché quando stack testviene interrotta, è nel mezzo della withProcessWaitquale viene definita più o meno come segue:

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

quindi, quando bracketviene interrotto, chiama stopProcessche termina il processo figlio inviandogli il SIGTERMsegnale. In constrast a SIGINT, questo non solleva un'eccezione asincrona. Termina immediatamente il figlio immediatamente, in genere prima che possa terminare l'esecuzione di qualsiasi finalizzatore.

Non riesco a pensare a un modo particolarmente semplice per aggirare questo. Un modo è utilizzare le strutture System.Posixper inserire il processo nel proprio gruppo di processi:

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"

Ora, Ctrl-C comporterà che SIGINT verrà consegnato solo al bracket-test-testprocesso. Pulirà, ripristinerà il gruppo di processi in primo piano originale per puntare al stack testprocesso e terminerà. Ciò comporterà il fallimento del test e stack testcontinuerà a funzionare.

Un'alternativa sarebbe quella di provare a gestire SIGTERMe mantenere in esecuzione il processo figlio per eseguire la pulizia, anche una volta stack testterminato il processo. Questo è un po 'brutto poiché il processo sarà in qualche modo ripulito in background mentre stai guardando il prompt della shell.