[DEVOPS-1063] improve error message when a worker throws

auxx/Main.hs

@@ -83,7 +83,7 @@ runNodeWithSinglePlugin ::
     -> (Diffusion AuxxMode -> AuxxMode ())
     -> Diffusion AuxxMode -> AuxxMode ()
 runNodeWithSinglePlugin genesisConfig txpConfig nr plugin =
-    runNode genesisConfig txpConfig nr [plugin]
+    runNode genesisConfig txpConfig nr [ ("runNodeWithSinglePlugin", plugin) ]
 
 action :: HasCompileInfo => AuxxOptions -> Either WithCommandAction Text -> IO ()
 action opts@AuxxOptions {..} command = do

default.nix

@@ -14,8 +14,8 @@ in
 , gitrev ? localLib.commitIdFromGitRepo ./.git
 , buildId ? null
 , pkgs ? (import (localLib.fetchNixPkgs) { inherit system config; overlays = [ jemallocOverlay ]; })
-# profiling slows down performance by 50% so we don't enable it by default
 , forceDontCheck ? false
+# profiling slows down performance by 50% so we don't enable it by default
 , enableProfiling ? false
 , enableDebugging ? false
 , enableBenchmarks ? true

explorer/src/explorer/Main.hs

@@ -64,11 +64,11 @@ action (ExplorerNodeArgs (cArgs@CommonNodeArgs{..}) ExplorerArgs{..}) =
             nodeArgs
             (configGeneratedSecrets genesisConfig)
 
-        let plugins :: [Diffusion ExplorerProd -> ExplorerProd ()]
+        let plugins :: [ (Text, Diffusion ExplorerProd -> ExplorerProd ()) ]
             plugins =
-                [ explorerPlugin genesisConfig webPort
-                , notifierPlugin genesisConfig NotifierSettings {nsPort = notifierPort}
-                , updateTriggerWorker
+                [ ("explorer plugin", explorerPlugin genesisConfig webPort)
+                , ("explorer notifier", notifierPlugin genesisConfig NotifierSettings {nsPort = notifierPort})
+                , ("explorer update trigger", updateTriggerWorker)
                 ]
         bracketNodeResources
             genesisConfig

lib/src/Pos/Launcher/Scenario.hs

@@ -49,8 +49,8 @@ runNode'
        )
     => Genesis.Config
     -> NodeResources ext
-    -> [Diffusion m -> m ()]
-    -> [Diffusion m -> m ()]
+    -> [ (Text, Diffusion m -> m ()) ]
+    -> [ (Text, Diffusion m -> m ()) ]
     -> Diffusion m -> m ()
 runNode' genesisConfig NodeResources {..} workers' plugins' = \diffusion -> do
     logInfo $ "Built with: " <> pretty compileInfo
@@ -87,17 +87,19 @@ runNode' genesisConfig NodeResources {..} workers' plugins' = \diffusion -> do
     logInfo $ sformat ("Current tip header: "%build) tipHeader
 
     waitSystemStart
-    let runWithReportHandler action =
-            action diffusion `catch` reportHandler
+    let
+      runWithReportHandler :: (Text, Diffusion m -> m ()) -> m ()
+      runWithReportHandler (workerName, action) = action diffusion `catch` (reportHandler workerName)
 
     void (mapConcurrently runWithReportHandler (workers' ++ plugins'))
 
     exitFailure
   where
-    reportHandler (SomeException e) = do
+    reportHandler :: Text -> SomeException -> m b
+    reportHandler action (SomeException e) = do
         loggerName <- askLoggerName
-        let msg = "Worker/plugin with logger name "%shown%" failed with exception: "%shown
-        reportError $ sformat msg loggerName e
+        let msg = "Worker/plugin with work name "%shown%" and logger name "%shown%" failed with exception: "%shown
+        reportError $ sformat msg action loggerName e
         exitFailure
 
 -- | Entry point of full node.
@@ -109,7 +111,7 @@ runNode
     => Genesis.Config
     -> TxpConfiguration
     -> NodeResources ext
-    -> [Diffusion m -> m ()]
+    -> [ (Text, Diffusion m -> m ()) ]
     -> Diffusion m -> m ()
 runNode genesisConfig txpConfig nr plugins =
     runNode' genesisConfig nr workers' plugins

lib/src/Pos/Worker.hs

@@ -31,13 +31,13 @@ allWorkers
     => Genesis.Config
     -> TxpConfiguration
     -> NodeResources ext
-    -> [Diffusion m -> m ()]
+    -> [ (Text, Diffusion m -> m ()) ]
 allWorkers genesisConfig txpConfig NodeResources {..} = mconcat
     [ sscWorkers genesisConfig
     , usWorkers genesisConfig
     , blkWorkers genesisConfig txpConfig
     , dlgWorkers
-    , [properSlottingWorker, staticConfigMonitoringWorker]
+    , [ ("proper slotting", properSlottingWorker), ("static config", staticConfigMonitoringWorker) ]
     ]
   where
     topology = ncTopology ncNetworkConfig

lib/src/Pos/Worker/Block.hs

@@ -83,12 +83,12 @@ blkWorkers
        )
     => Genesis.Config
     -> TxpConfiguration
-    -> [Diffusion m -> m ()]
+    -> [ (Text, Diffusion m -> m ()) ]
 blkWorkers genesisConfig txpConfig =
-    [ blkCreatorWorker genesisConfig txpConfig
-    , informerWorker $ configBlkSecurityParam genesisConfig
-    , retrievalWorker genesisConfig txpConfig
-    , recoveryTriggerWorker genesisConfig
+    [ ("block creator", blkCreatorWorker genesisConfig txpConfig)
+    , ("block informer", informerWorker $ configBlkSecurityParam genesisConfig)
+    , ("block retrieval", retrievalWorker genesisConfig txpConfig)
+    , ("block recovery trigger", recoveryTriggerWorker genesisConfig)
     ]
 
 informerWorker

lib/src/Pos/Worker/Delegation.hs

@@ -36,8 +36,8 @@ type DlgWorkerConstraint ctx m
 
 
 -- | All workers specific to proxy sertificates processing.
-dlgWorkers :: (DlgWorkerConstraint ctx m) => [Diffusion m -> m ()]
-dlgWorkers = [\_ -> dlgInvalidateCaches]
+dlgWorkers :: (DlgWorkerConstraint ctx m) => [ (Text, Diffusion m -> m ()) ]
+dlgWorkers = [ ("delegation worker", \_ -> dlgInvalidateCaches) ]
 
 -- | Runs proxy caches invalidating action every second.
 dlgInvalidateCaches :: DlgWorkerConstraint ctx m => m ()

lib/src/Pos/Worker/Ssc.hs

@@ -97,10 +97,10 @@ sscWorkers
      , HasMisbehaviorMetrics ctx
      )
   => Genesis.Config
-  -> [Diffusion m -> m ()]
+  -> [ (Text, Diffusion m -> m ()) ]
 sscWorkers genesisConfig =
-    [ onNewSlotSsc genesisConfig
-    , checkForIgnoredCommitmentsWorker genesisConfig
+    [ ("ssc on new slot", onNewSlotSsc genesisConfig)
+    , ("ssc check for ignored", checkForIgnoredCommitmentsWorker genesisConfig)
     ]
 
 shouldParticipate :: SscMode ctx m => BlockVersionData -> EpochIndex -> m Bool

lib/src/Pos/Worker/Update.hs

@@ -31,8 +31,8 @@ import           Pos.Util.Wlog (logDebug, logInfo)
 
 -- | Update System related workers.
 usWorkers
-    :: forall ctx m . UpdateMode ctx m => Genesis.Config -> [Diffusion m -> m ()]
-usWorkers genesisConfig = [processNewSlotWorker, checkForUpdateWorker]
+    :: forall ctx m . UpdateMode ctx m => Genesis.Config -> [ (Text, Diffusion m -> m ()) ]
+usWorkers genesisConfig = [ ("us new slot", processNewSlotWorker), ("us check updates", checkForUpdateWorker) ]
   where
     epochSlots = configEpochSlots genesisConfig
     k = configBlkSecurityParam genesisConfig

node/Main.hs

@@ -18,7 +18,7 @@ main = withCompileInfo $ do
     let lArgs = loggingParams "node" cArgs
 
     launchNode nArgs cArgs lArgs $ \genesisConfig _ txpConfig _ _ _ nodeRes -> do
-        let plugins = [ updateTriggerWorker ]
+        let plugins = [ ("update trigger", updateTriggerWorker) ]
 
         logInfo "Wallet is disabled, because software is built w/o it"
 

scripts/launch/connect-to-cluster/default.nix

@@ -19,6 +19,7 @@
 , disableClientAuth ? false
 , extraParams ? ""
 , useStackBinaries ? false
+, forceDontCheck ? false
 }:
 
 with localLib;
@@ -39,7 +40,7 @@ let
     x509gen = if useStackBinaries then "stack exec -- cardano-x509-certificates" else "${iohkPkgs.cardano-sl-tools-static}/bin/cardano-x509-certificates";
   };
   ifWallet = localLib.optionalString (executable == "wallet");
-  iohkPkgs = import ./../../../default.nix { inherit config system pkgs gitrev; };
+  iohkPkgs = import ./../../../default.nix { inherit config system pkgs gitrev forceDontCheck; };
   src = ./../../../.;
   topologyFileDefault = pkgs.writeText "topology-${environment}" ''
     wallet:

wallet-new/src/Cardano/Wallet/Action.hs

@@ -80,28 +80,29 @@ actionWithWallet params genesisConfig walletConfig txpConfig ntpConfig nodeParam
 
     plugins :: (PassiveWalletLayer IO, PassiveWallet)
             -> Kernel.DatabaseMode
-            -> Plugins.Plugin Kernel.Mode.WalletMode
-    plugins w dbMode = mconcat
-        -- The actual wallet backend server.
-        [ Plugins.apiServer pm params w
-            -- Throttle requests.
-            [ throttleMiddleware (ccThrottle walletConfig)
-            , withDefaultHeader Headers.applicationJson
-            ]
+            -> [ (Text, Plugins.Plugin Kernel.Mode.WalletMode) ]
+    plugins w dbMode = concat [
+            -- The actual wallet backend server.
+            [
+                ("wallet-new api worker", Plugins.apiServer pm params w
+                -- Throttle requests.
+                [ throttleMiddleware (ccThrottle walletConfig)
+                , withDefaultHeader Headers.applicationJson
+                ])
+
+            -- The corresponding wallet documention, served as a different
+            -- server which doesn't require client x509 certificates to
+            -- connect, but still serves the doc through TLS
+            , ("doc worker", Plugins.docServer params)
 
-        -- The corresponding wallet documention, served as a different
-        -- server which doesn't require client x509 certificates to
-        -- connect, but still serves the doc through TLS
-        , Plugins.docServer params
+            -- Periodically compact & snapshot the acid-state database.
+            , ("acid state cleanup", Plugins.acidStateSnapshots (view Kernel.Internal.wallets (snd w)) params dbMode)
 
+            -- A @Plugin@ to watch and store incoming update proposals
+            , ("update watcher", Plugins.updateWatcher)
+            ]
         -- The monitoring API for the Core node.
         , Plugins.monitoringServer params
-
-        -- Periodically compact & snapshot the acid-state database.
-        , Plugins.acidStateSnapshots (view Kernel.Internal.wallets (snd w)) params dbMode
-
-        -- A @Plugin@ to watch and store incoming update proposals
-        , Plugins.updateWatcher
         ]
 
     -- Extract the logger name from node parameters

wallet-new/src/Cardano/Wallet/Server/LegacyPlugins.hs

@@ -66,38 +66,39 @@ import           Pos.WorkMode (WorkMode)
 
 
 -- A @Plugin@ running in the monad @m@.
-type Plugin m = [Diffusion m -> m ()]
+type Plugin m = [ (Text, Diffusion m -> m ()) ]
 
 -- | A @Plugin@ to periodically compact & snapshot the acid-state database.
 acidCleanupWorker :: WalletBackendParams
                   -> Plugin WalletWebMode
-acidCleanupWorker WalletBackendParams{..} = pure $ const $
-    modifyLoggerName (const "acidcleanup") $
-    askWalletDB >>= \db -> cleanupAcidStatePeriodically db (walletAcidInterval walletDbOptions)
+acidCleanupWorker WalletBackendParams{..} = pure ("acid state cleanup", const worker)
+  where
+    worker =  modifyLoggerName (const "acidcleanup") $
+      askWalletDB >>= \db -> cleanupAcidStatePeriodically db (walletAcidInterval walletDbOptions)
 
 -- | The @Plugin@ which defines part of the conversation protocol for this node.
 conversation :: HasConfigurations => WalletBackendParams -> Plugin WalletWebMode
-conversation wArgs = map const (pluginsMonitoringApi wArgs)
+conversation wArgs = pluginsMonitoringApi wArgs
   where
     pluginsMonitoringApi :: (WorkMode ctx m , HasNodeContext ctx)
                          => WalletBackendParams
-                         -> [m ()]
+                         -> Plugin m
     pluginsMonitoringApi WalletBackendParams {..}
-        | enableMonitoringApi = [serveWeb monitoringApiPort walletTLSParams]
+        | enableMonitoringApi = [ ("legacy conversation", const $ serveWeb monitoringApiPort walletTLSParams) ]
         | otherwise = []
 
 walletDocumentation
     :: (HasConfigurations, HasCompileInfo)
     => WalletBackendParams
     -> Plugin WalletWebMode
-walletDocumentation WalletBackendParams {..} = pure $ \_ ->
-    walletDocumentationImpl
+walletDocumentation WalletBackendParams {..} = pure ("wallet doc worker", const worker)
+  where
+    worker = walletDocumentationImpl
         application
         walletDocAddress
         tls
         (Just defaultSettings)
         Nothing
-  where
     application :: WalletWebMode Application
     application = do
         let app = Servant.serve API.walletDocAPI LegacyServer.walletDocServer
@@ -113,26 +114,27 @@ legacyWalletBackend :: (HasConfigurations, HasCompileInfo)
                     -> TVar NtpStatus
                     -> [Middleware]
                     -> Plugin WalletWebMode
-legacyWalletBackend genesisConfig txpConfig WalletBackendParams {..} ntpStatus middlewares = pure $ \diffusion -> do
-    modifyLoggerName (const "legacyServantBackend") $ do
-      logWarning $ sformat "RUNNING THE OLD LEGACY DATA LAYER IS NOT RECOMMENDED!"
-      logInfo $ sformat ("Production mode for API: "%build)
-        walletProductionApi
-      logInfo $ sformat ("Transaction submission disabled: "%build)
-        walletTxCreationDisabled
-
-      ctx <- view shutdownContext
-      let
-        portCallback :: Word16 -> IO ()
-        portCallback port = usingLoggerName "NodeIPC" $ flip runReaderT ctx $ startNodeJsIPC port
-      walletServeImpl
-        (getApplication diffusion)
-        walletAddress
-        -- Disable TLS if in debug mode.
-        (if isDebugMode walletRunMode then Nothing else walletTLSParams)
-        (Just $ setOnExceptionResponse exceptionHandler defaultSettings)
-        (Just portCallback)
+legacyWalletBackend genesisConfig txpConfig WalletBackendParams {..} ntpStatus middlewares = pure ("legacy api", worker)
   where
+    worker diffusion = do
+      modifyLoggerName (const "legacyServantBackend") $ do
+        logWarning $ sformat "RUNNING THE OLD LEGACY DATA LAYER IS NOT RECOMMENDED!"
+        logInfo $ sformat ("Production mode for API: "%build)
+          walletProductionApi
+        logInfo $ sformat ("Transaction submission disabled: "%build)
+          walletTxCreationDisabled
+
+        ctx <- view shutdownContext
+        let
+          portCallback :: Word16 -> IO ()
+          portCallback port = usingLoggerName "NodeIPC" $ flip runReaderT ctx $ startNodeJsIPC port
+        walletServeImpl
+          (getApplication diffusion)
+          walletAddress
+          -- Disable TLS if in debug mode.
+          (if isDebugMode walletRunMode then Nothing else walletTLSParams)
+          (Just $ setOnExceptionResponse exceptionHandler defaultSettings)
+          (Just portCallback)
     -- Gets the Wai `Application` to run.
     getApplication :: Diffusion WalletWebMode -> WalletWebMode Application
     getApplication diffusion = do
@@ -197,15 +199,18 @@ resubmitterPlugin :: HasConfigurations
                   => Genesis.Config
                   -> TxpConfiguration
                   -> Plugin WalletWebMode
-resubmitterPlugin genesisConfig txpConfig = [\diffusion -> askWalletDB >>= \db ->
-                        startPendingTxsResubmitter genesisConfig txpConfig db (sendTx diffusion)]
+resubmitterPlugin genesisConfig txpConfig = [ ("resubmitter worker", worker) ]
+  where
+    worker diffusion = askWalletDB >>= \db ->
+                        startPendingTxsResubmitter genesisConfig txpConfig db (sendTx diffusion)
 
 -- | A @Plugin@ to notify frontend via websockets.
 notifierPlugin :: Plugin WalletWebMode
-notifierPlugin = [const V0.notifierPlugin]
+notifierPlugin = [ ("notifier worker", const V0.notifierPlugin) ]
 
 -- | The @Plugin@ responsible for the restoration & syncing of a wallet.
 syncWalletWorker :: Genesis.Config -> Plugin WalletWebMode
-syncWalletWorker genesisConfig = pure $ const $
-    modifyLoggerName (const "syncWalletWorker") $
-    (view (lensOf @SyncQueue) >>= processSyncRequest genesisConfig)
+syncWalletWorker genesisConfig = pure ("sync wallet worker", const worker)
+  where
+    worker = modifyLoggerName (const "syncWalletWorker") $
+      (view (lensOf @SyncQueue) >>= processSyncRequest genesisConfig)