Merge #1315

1315: Add shutdown handler for new launcher r=KtorZ a=rvl Relates to #1314. # Overview This adds a simpler way of ensuring clean shutdown of the wallet on windows (and linux), which doesn't require DaedalusIPC. The mechanism will be used by cardano-launcher. - Adds the shutdown handler thread. - Needed to rearrange startup functions around a little bit. - Unit tests and an integration test. # Comments [Hydra jobset](https://hydra.iohk.io/jobset/Cardano/cardano-wallet-pr-1315) Co-authored-by: Rodney Lorrimar <rodney.lorrimar@iohk.io> Co-authored-by: KtorZ <matthias.benkort@gmail.com>
cardano-foundation · Feb 26, 2020 · 3314dca · 3314dca
2 parents 0fdf956 + 3003a3a
commit 3314dca
Show file tree

Hide file tree

Showing 30 changed files with 543 additions and 165 deletions.
diff --git a/.weeder.yaml b/.weeder.yaml
@@ -124,5 +124,4 @@
     - name: library
     - message:
       - name: Module not compiled
-      - module: Cardano.Launcher.Windows
-
+      - module: Cardano.Startup.Windows
diff --git a/default.nix b/default.nix
@@ -31,6 +31,8 @@ let
       haskellBuildUtils = haskellBuildUtils.package;
     };
 
+    inherit (haskellPackages.cardano-wallet-byron.components.exes) cardano-wallet-byron;
+
     # `tests` are the test suites which have been built.
     tests = collectComponents "tests" isCardanoWallet haskellPackages;
     # `checks` are the result of executing the tests.

diff --git a/lib/byron/cardano-wallet-byron.cabal b/lib/byron/cardano-wallet-byron.cabal
@@ -38,7 +38,6 @@ library
     , cardano-crypto-wrapper
     , cardano-ledger
     , cardano-wallet-core
-    , cardano-wallet-launcher
     , cborg
     , contra-tracer
     , cryptonite
@@ -88,6 +87,7 @@ executable cardano-wallet-byron
     , cardano-wallet-cli
     , cardano-wallet-core
     , cardano-wallet-launcher
+    , contra-tracer
     , iohk-monitoring
     , network
     , optparse-applicative

diff --git a/lib/byron/exe/cardano-wallet-byron.hs b/lib/byron/exe/cardano-wallet-byron.hs
@@ -27,7 +27,7 @@ import Prelude
 import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Trace
-    ( Trace, appendName, logDebug, logInfo )
+    ( Trace, appendName, logDebug, logInfo, logNotice )
 import Cardano.CLI
     ( LoggingOptions (..)
     , cli
@@ -50,8 +50,12 @@ import Cardano.CLI
     , syncToleranceOption
     , withLogging
     )
-import Cardano.Launcher
-    ( withUtf8Encoding )
+import Cardano.Startup
+    ( ShutdownHandlerLog
+    , installSignalHandlers
+    , withShutdownHandler
+    , withUtf8Encoding
+    )
 import Cardano.Wallet.Api.Server
     ( HostPreference, Listen (..) )
 import Cardano.Wallet.Byron
@@ -66,7 +70,7 @@ import Cardano.Wallet.Byron
 import Cardano.Wallet.Byron.Network
     ( localSocketAddrInfo )
 import Cardano.Wallet.Logging
-    ( transformTextTrace )
+    ( trMessage, transformTextTrace )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( NetworkDiscriminant (..) )
 import Cardano.Wallet.Primitive.Types
@@ -75,6 +79,10 @@ import Cardano.Wallet.Version
     ( GitRevision, Version, gitRevision, showFullVersion, version )
 import Control.Applicative
     ( Const (..), optional )
+import Control.Monad
+    ( void )
+import Control.Tracer
+    ( contramap )
 import Data.Text
     ( Text )
 import Data.Text.Class
@@ -160,16 +168,18 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
     exec args@(ServeArgs hostPreference listen nodeSocket databaseDir sTolerance logOpt) = do
         let addrInfo = localSocketAddrInfo nodeSocket
         withTracers logOpt $ \tr tracers -> do
-            logDebug tr $ MsgServeArgs args
-            whenJust databaseDir $ setupDirectory (logInfo tr . MsgSetupDatabases)
-            exitWith =<< serveWallet @'Mainnet
-                tracers
-                sTolerance
-                databaseDir
-                hostPreference
-                listen
-                addrInfo
-                (beforeMainLoop tr)
+            installSignalHandlers (logNotice tr MsgSigTerm)
+            void $ withShutdownHandler (trMessage (contramap (fmap MsgShutdownHandler) tr)) $ do
+                logDebug tr $ MsgServeArgs args
+                whenJust databaseDir $ setupDirectory (logInfo tr . MsgSetupDatabases)
+                exitWith =<< serveWallet @'Mainnet
+                    tracers
+                    sTolerance
+                    databaseDir
+                    hostPreference
+                    listen
+                    addrInfo
+                    (beforeMainLoop tr)
 
     whenJust m fn = case m of
        Nothing -> pure ()
@@ -212,6 +222,8 @@ data MainLog
     | MsgSetupDatabases Text
     | MsgServeArgs ServeArgs
     | MsgListenAddress SockAddr
+    | MsgSigTerm
+    | MsgShutdownHandler ShutdownHandlerLog
     deriving (Show, Eq)
 
 instance ToText MainLog where
@@ -228,6 +240,10 @@ instance ToText MainLog where
             T.pack $ show args
         MsgListenAddress addr ->
             "Wallet backend server listening on " <> T.pack (show addr)
+        MsgSigTerm ->
+            "Terminated by signal."
+        MsgShutdownHandler msg' ->
+            toText msg'
 
 withTracers
     :: LoggingOptions TracerSeverities

diff --git a/lib/byron/src/Cardano/Wallet/Byron.hs b/lib/byron/src/Cardano/Wallet/Byron.hs
@@ -50,8 +50,6 @@ import Cardano.BM.Trace
     ( Trace, appendName )
 import Cardano.DB.Sqlite
     ( DBLog )
-import Cardano.Launcher
-    ( installSignalHandlers )
 import Cardano.Wallet
     ( WalletLog )
 import Cardano.Wallet.Api
@@ -166,7 +164,6 @@ serveWallet
     -- ^ Callback to run before the main loop
     -> IO ExitCode
 serveWallet Tracers{..} sTolerance databaseDir hostPref listen addrInfo beforeMainLoop = do
-    installSignalHandlers (traceWith applicationTracer MsgSigTerm)
     traceWith applicationTracer $ MsgStarting addrInfo
     traceWith applicationTracer $ MsgNetworkName $ networkDiscriminantVal @n
     Server.withListeningSocket hostPref listen $ \case
@@ -245,7 +242,6 @@ exitCodeApiServer = \case
 data ApplicationLog
     = MsgStarting AddrInfo
     | MsgNetworkName NetworkDiscriminant
-    | MsgSigTerm
     | MsgServerStartupError ListenError
     | MsgDatabaseStartup DatabasesStartupLog
     deriving (Generic, Show, Eq)
@@ -256,8 +252,6 @@ instance ToText ApplicationLog where
             "Wallet backend server starting. " <> T.pack (show info) <> "..."
         MsgNetworkName n ->
             "Node is Haskell Node on " <> toText n
-        MsgSigTerm ->
-            "Terminated by signal."
         MsgDatabaseStartup dbMsg ->
             toText dbMsg
         MsgServerStartupError startupErr -> case startupErr of
@@ -281,7 +275,6 @@ instance DefinePrivacyAnnotation ApplicationLog
 instance DefineSeverity ApplicationLog where
     defineSeverity = \case
         MsgStarting _ -> Info
-        MsgSigTerm -> Notice
         MsgNetworkName _ -> Info
         MsgDatabaseStartup ev -> defineSeverity ev
         MsgServerStartupError _ -> Alert

diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs
@@ -109,7 +109,7 @@ import Cardano.BM.Data.Tracer
 import Cardano.BM.Setup
     ( setupTrace_, shutdown )
 import Cardano.BM.Trace
-    ( Trace, logDebug )
+    ( Trace, appendName, logDebug )
 import Cardano.Wallet.Api.Client
     ( WalletClient (..), walletClient )
 import Cardano.Wallet.Api.Server
@@ -1457,7 +1457,7 @@ withLogging configFile minSeverity action = bracket before after (action . snd)
   where
     before = initTracer configFile minSeverity
     after (sb, (_, tr)) = do
-        logDebug tr "Logging shutdown."
+        logDebug (appendName "main" tr) "Logging shutdown."
         shutdown sb
 
 data LoggingOptions tracers = LoggingOptions

diff --git a/lib/core/test/bench/db/Main.hs b/lib/core/test/bench/db/Main.hs
@@ -43,7 +43,7 @@ import Cardano.BM.Data.Tracer
     ( nullTracer )
 import Cardano.DB.Sqlite
     ( SqliteContext, destroyDBLayer )
-import Cardano.Launcher
+import Cardano.Startup
     ( withUtf8Encoding )
 import Cardano.Wallet.DB
     ( DBLayer (..), PrimaryKey (..), cleanDB )

diff --git a/lib/core/test/unit/Main.hs b/lib/core/test/unit/Main.hs
@@ -1,6 +1,6 @@
 module Main where
 
-import Cardano.Launcher
+import Cardano.Startup
     ( withUtf8Encoding )
 import Prelude
 import qualified Spec

diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal
@@ -99,6 +99,7 @@ executable cardano-wallet-jormungandr
     , cardano-wallet-core
     , cardano-wallet-jormungandr
     , cardano-wallet-launcher
+    , contra-tracer
     , filepath
     , iohk-monitoring
     , network

diff --git a/lib/jormungandr/exe/cardano-wallet-jormungandr.hs b/lib/jormungandr/exe/cardano-wallet-jormungandr.hs
@@ -27,7 +27,7 @@ import Prelude
 import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Trace
-    ( Trace, appendName, logDebug, logInfo )
+    ( Trace, appendName, logInfo, logNotice )
 import Cardano.CLI
     ( LoggingOptions (..)
     , Port (..)
@@ -59,7 +59,13 @@ import Cardano.CLI
     , withLogging
     )
 import Cardano.Launcher
-    ( StdStream (..), withUtf8Encoding )
+    ( StdStream (..) )
+import Cardano.Startup
+    ( ShutdownHandlerLog
+    , installSignalHandlers
+    , withShutdownHandler
+    , withUtf8Encoding
+    )
 import Cardano.Wallet.Api.Server
     ( HostPreference, Listen (..) )
 import Cardano.Wallet.Jormungandr
@@ -79,7 +85,7 @@ import Cardano.Wallet.Jormungandr.Network
     , JormungandrConnParams (..)
     )
 import Cardano.Wallet.Logging
-    ( transformTextTrace )
+    ( trMessage, transformTextTrace )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( NetworkDiscriminant (..) )
 import Cardano.Wallet.Primitive.Types
@@ -88,6 +94,10 @@ import Cardano.Wallet.Version
     ( GitRevision, Version, gitRevision, showFullVersion, version )
 import Control.Applicative
     ( Const (..), optional, (<|>) )
+import Control.Monad
+    ( void )
+import Control.Tracer
+    ( contramap )
 import Data.List
     ( isPrefixOf )
 import Data.Maybe
@@ -230,29 +240,32 @@ cmdLaunch dataDir = command "launch" $ info (helper <*> helper' <*> cmd) $ mempt
             <*> extraArguments)
     exec args@(LaunchArgs hostPreference listen nodePort mStateDir sTolerance logOpt jArgs) = do
         withTracers logOpt $ \tr tracers -> do
-            logDebug tr $ MsgLaunchArgs args
-            case genesisBlock jArgs of
-                Right block0File -> requireFilePath block0File
-                Left _ -> pure ()
-            let stateDir = fromMaybe (dataDir </> "testnet") mStateDir
-            let databaseDir = stateDir </> "wallets"
-            let cp = JormungandrConfig
-                    { _stateDir = stateDir
-                    , _genesisBlock = genesisBlock jArgs
-                    , _restApiPort = fromIntegral . getPort <$> nodePort
-                    , _outputStream = Inherit
-                    , _extraArgs = extraJormungandrArgs jArgs
-                    }
-            setupDirectory (logInfo tr . MsgSetupStateDir) stateDir
-            setupDirectory (logInfo tr . MsgSetupDatabases) databaseDir
-            exitWith =<< serveWallet @'Testnet
-                tracers
-                sTolerance
-                (Just databaseDir)
-                hostPreference
-                listen
-                (Launch cp)
-                (beforeMainLoop tr)
+            installSignalHandlers (logNotice tr MsgSigTerm)
+            let trShutdown = trMessage (contramap (fmap MsgShutdownHandler) tr)
+            void $ withShutdownHandler trShutdown $ do
+                logInfo tr $ MsgLaunchArgs args
+                case genesisBlock jArgs of
+                    Right block0File -> requireFilePath block0File
+                    Left _ -> pure ()
+                let stateDir = fromMaybe (dataDir </> "testnet") mStateDir
+                let databaseDir = stateDir </> "wallets"
+                let cp = JormungandrConfig
+                        { _stateDir = stateDir
+                        , _genesisBlock = genesisBlock jArgs
+                        , _restApiPort = fromIntegral . getPort <$> nodePort
+                        , _outputStream = Inherit
+                        , _extraArgs = extraJormungandrArgs jArgs
+                        }
+                setupDirectory (logInfo tr . MsgSetupStateDir) stateDir
+                setupDirectory (logInfo tr . MsgSetupDatabases) databaseDir
+                exitWith =<< serveWallet @'Testnet
+                    tracers
+                    sTolerance
+                    (Just databaseDir)
+                    hostPreference
+                    listen
+                    (Launch cp)
+                    (beforeMainLoop tr)
 
 {-------------------------------------------------------------------------------
                             Command - 'serve'
@@ -289,18 +302,21 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
         -> IO ()
     exec args@(ServeArgs hostPreference listen nodePort databaseDir sTolerance block0H logOpt) = do
         withTracers logOpt $ \tr tracers -> do
-            logDebug tr $ MsgServeArgs args
-            let baseUrl = localhostBaseUrl $ getPort nodePort
-            let cp = JormungandrConnParams block0H baseUrl
-            whenJust databaseDir $ setupDirectory (logInfo tr . MsgSetupDatabases)
-            exitWith =<< serveWallet @'Testnet
-                tracers
-                sTolerance
-                databaseDir
-                hostPreference
-                listen
-                (UseRunning cp)
-                (beforeMainLoop tr)
+            installSignalHandlers (logNotice tr MsgSigTerm)
+            let trShutdown = trMessage (contramap (fmap MsgShutdownHandler) tr)
+            void $ withShutdownHandler trShutdown $ do
+                logInfo tr $ MsgServeArgs args
+                let baseUrl = localhostBaseUrl $ getPort nodePort
+                let cp = JormungandrConnParams block0H baseUrl
+                whenJust databaseDir $ setupDirectory (logInfo tr . MsgSetupDatabases)
+                exitWith =<< serveWallet @'Testnet
+                    tracers
+                    sTolerance
+                    databaseDir
+                    hostPreference
+                    listen
+                    (UseRunning cp)
+                    (beforeMainLoop tr)
 
     whenJust m fn = case m of
        Nothing -> pure ()
@@ -381,6 +397,8 @@ data MainLog
     | MsgLaunchArgs LaunchArgs
     | MsgServeArgs ServeArgs
     | MsgListenAddress SockAddr
+    | MsgSigTerm
+    | MsgShutdownHandler ShutdownHandlerLog
     deriving (Show, Eq)
 
 instance ToText MainLog where
@@ -395,6 +413,8 @@ instance ToText MainLog where
         MsgServeArgs args -> T.pack $ show args
         MsgListenAddress addr ->
             "Wallet backend server listening on " <> T.pack (show addr)
+        MsgSigTerm -> "Terminated by signal."
+        MsgShutdownHandler msg' -> toText msg'
 
 withTracers
     :: LoggingOptions TracerSeverities