Skip to content
This repository was archived by the owner on Aug 1, 2023. It is now read-only.

Commit 4be5660

Browse files
authored
[GH-144] Fix exception handling (#147)
* [GH-144] Rethrow cought exceptions to check if the application is throwing them. * [GH-144] Fix exception handling strategy by simply forcing the resource closure.
1 parent 70944ad commit 4be5660

File tree

1 file changed

+17
-18
lines changed

1 file changed

+17
-18
lines changed

src/Cardano/Shell/Lib.hs

Lines changed: 17 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ import Prelude (Show (..))
1919
import Control.Exception.Safe (throwM)
2020

2121
import Control.Concurrent.Classy hiding (catch)
22+
import qualified Control.Concurrent.Classy.Async as CA
2223
import Control.Concurrent.Classy.Async (async, cancel)
2324

2425
import GHC.IO.Handle.Lock (LockMode (..), hTryLock)
@@ -119,34 +120,32 @@ runCardanoApplicationWithFeatures
119120
-> [CardanoFeature]
120121
-> CardanoApplication
121122
-> m ()
122-
runCardanoApplicationWithFeatures applicationEnvironment cardanoFeatures cardanoApplication = do
123+
runCardanoApplicationWithFeatures _ cardanoFeatures cardanoApplication = do
124+
-- We still aren't sure if we are going to use the @ApplicationEnvironment@
125+
-- or not.
123126

124127
-- We start all the new features.
125-
asyncCardanoFeatures <- mapM (async . featureStart) cardanoFeatures
128+
asyncCardanoFeatures <- mapM (liftIO . async . featureStart) cardanoFeatures
126129

127130
-- Here we run the actual application.
128131
-- We presume that the control-flow is now in the hands of that function.
129132
-- An example of top-level-last-resort-error-handling-strategy.
130-
liftIO $ catchAny (runCardanoApplication cardanoApplication) $ \exception -> do
131-
-- For now simply rethrow, might be a good idea to have general exception handler.
132-
throwM exception
133+
liftIO $ runCardanoApplication cardanoApplication `finally`
134+
cancelShutdownFeatures asyncCardanoFeatures
133135

134-
-- When we reach this point, we cancel all the features.
135-
_ <- mapM cancel (reverse asyncCardanoFeatures)
136+
where
137+
-- | The cancel and shutdown of all the features.
138+
cancelShutdownFeatures :: [CA.Async IO a] -> IO ()
139+
cancelShutdownFeatures asyncCardanoFeatures = do
140+
-- When we reach this point, we cancel all the features.
141+
_ <- mapM cancel (reverse asyncCardanoFeatures)
136142

137-
-- Then we cleanup all the features if we need to do so.
138-
_ <- mapM featureShutdown (reverse cardanoFeatures)
143+
-- Then we cleanup all the features if we need to do so.
144+
_ <- mapM featureShutdown (reverse cardanoFeatures)
139145

140-
-- And we are done! Or are we? A simple idea is to restart the application if it's
141-
-- in production.
142-
-- Maybe the user would like to have more control then this, systemd?
143-
when (applicationProductionMode applicationEnvironment) $
144-
runCardanoApplicationWithFeatures applicationEnvironment cardanoFeatures cardanoApplication
146+
-- Closing
147+
pure ()
145148

146-
where
147-
-- | Util function. Yes, yes, we can import this.
148-
catchAny :: IO a -> (SomeException -> IO a) -> IO a
149-
catchAny = catch
150149

151150
type AllFeaturesInitFunction = CardanoConfiguration -> CardanoEnvironment -> IO [CardanoFeature]
152151

0 commit comments

Comments
 (0)