Handle DiffusionError of ExitCode in toplevelExceptionHandler

IntersectMBO · Jun 1, 2023 · e70aee0 · e70aee0
1 parent f64ef88
commit e70aee0
Show file tree

Hide file tree

Showing 8 changed files with 27 additions and 12 deletions.
diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal
@@ -120,7 +120,7 @@ library
                       , optparse-generic
                       , ouroboros-consensus
                       -- for Data.SOP.Strict:
-                      , ouroboros-network
+                      , ouroboros-network ^>= 0.8.1.0
                       , ouroboros-network-api
                       , process
                       , quiet

diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal
@@ -126,7 +126,7 @@ library
                       , ouroboros-consensus >= 0.6
                       , ouroboros-consensus-cardano >= 0.5
                       , ouroboros-consensus-diffusion >= 0.5.1
-                      , ouroboros-network
+                      , ouroboros-network ^>= 0.8.1.0
                       , ouroboros-network-api
                       , ouroboros-network-framework
                       , ouroboros-network-protocols

diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal
@@ -179,7 +179,7 @@ library
                       , ouroboros-consensus-diffusion >= 0.5.1
                       , ouroboros-consensus-protocol >= 0.5
                       , ouroboros-network-api
-                      , ouroboros-network  >= 0.6
+                      , ouroboros-network ^>= 0.8.1.0
                       , ouroboros-network-framework >= 0.6
                       , ouroboros-network-protocols
                       , prettyprinter
@@ -248,7 +248,7 @@ test-suite cardano-node-test
                       , ouroboros-consensus
                       , ouroboros-consensus-cardano
                       , ouroboros-consensus-diffusion
-                      , ouroboros-network
+                      , ouroboros-network ^>= 0.8.1.0
                       , ouroboros-network-api
                       , text
                       , time

diff --git a/cardano-node/src/Cardano/Node/Handlers/TopLevel.hs b/cardano-node/src/Cardano/Node/Handlers/TopLevel.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeApplications #-}
+
 module Cardano.Node.Handlers.TopLevel
   ( toplevelExceptionHandler
   ) where
@@ -53,6 +55,7 @@ import           System.Environment
 import           System.Exit
 import           System.IO
 
+import qualified Ouroboros.Network.Diffusion as Network
 
 -- | An exception handler to use for a program top level, as an alternative to
 -- the default top level handler provided by GHC.
@@ -70,7 +73,8 @@ toplevelExceptionHandler prog = do
     hSetBuffering stderr LineBuffering
     catches prog [
         Handler rethrowAsyncExceptions
-      , Handler rethrowExitCode
+      , Handler rethrowExitCode -- TODO this is possibly not needed anymore
+      , Handler rethrowDiffusionErrorExceptionInLinkedThreadExitSuccess
       , Handler handleSomeException
       ]
   where
@@ -79,7 +83,7 @@ toplevelExceptionHandler prog = do
     -- then we rethrow ExitSuccess. This happens for example when using the
     -- `--shutdown-on-slot-synced` option.
     rethrowAsyncExceptions :: SomeAsyncException -> IO a
-    rethrowAsyncExceptions full@(SomeAsyncException e) = do
+    rethrowAsyncExceptions full@(SomeAsyncException e) =
       case fromException (toException e) of
         Just (ExceptionInLinkedThread _ eInner)
           | Just ExitSuccess <- fromException eInner
@@ -91,6 +95,17 @@ toplevelExceptionHandler prog = do
     rethrowExitCode :: ExitCode -> IO a
     rethrowExitCode = throwIO
 
+    rethrowDiffusionErrorExceptionInLinkedThreadExitSuccess :: Network.Failure -> IO a
+    rethrowDiffusionErrorExceptionInLinkedThreadExitSuccess full =
+      case full of
+        Network.DiffusionError e ->
+          case fromException (toException e) of
+            Just (ExceptionInLinkedThread _ eInner)
+              | Just exitCode <- fromException eInner
+              -> throwIO @ExitCode exitCode
+            _ -> throwIO full
+        _ -> throwIO full
+
     -- Print all other exceptions
     handleSomeException :: SomeException -> IO a
     handleSomeException e = do

diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal
@@ -51,7 +51,7 @@ library
                       , network
                       , optparse-applicative-fork
                       , ouroboros-consensus-cardano
-                      , ouroboros-network
+                      , ouroboros-network ^>= 0.8.1.0
                       , ouroboros-network-protocols
                       , prometheus
                       , servant

diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal
@@ -51,7 +51,7 @@ library
                       , hedgehog-extras ^>= 0.4.5.1
                       , mtl
                       , optparse-applicative-fork
-                      , ouroboros-network
+                      , ouroboros-network ^>= 0.8.1.0
                       , ouroboros-network-api
                       , process
                       , random

diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal
@@ -146,7 +146,7 @@ library
                       , filepath
                       , mime-mail
                       , optparse-applicative
-                      , ouroboros-network
+                      , ouroboros-network ^>= 0.8.1.0
                       , ouroboros-network-api
                       , ouroboros-network-framework
                       , signal
@@ -358,7 +358,7 @@ test-suite cardano-tracer-test-ext
                       , generic-data
                       , Glob
                       , optparse-applicative-fork
-                      , ouroboros-network
+                      , ouroboros-network ^>= 0.8.1.0
                       , ouroboros-network-api
                       , ouroboros-network-framework
                       , process

diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal
@@ -56,7 +56,7 @@ library
                       , hostname
                       , network
                       , optparse-applicative-fork
-                      , ouroboros-network
+                      , ouroboros-network ^>= 0.8.1.0
                       , ouroboros-network-api
                       , ouroboros-network-framework
                       , serialise
@@ -147,7 +147,7 @@ test-suite trace-dispatcher-test
                       , generic-data
                       , hostname
                       , optparse-applicative
-                      , ouroboros-network
+                      , ouroboros-network ^>= 0.8.1.0
                       , text
                       , stm
                       , tasty