diff --git a/auxx/Main.hs b/auxx/Main.hs index 881b7e85437..925e8993a4a 100644 --- a/auxx/Main.hs +++ b/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 diff --git a/default.nix b/default.nix index 0553aa7f79e..1f98eeda86a 100644 --- a/default.nix +++ b/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 diff --git a/explorer/src/explorer/Main.hs b/explorer/src/explorer/Main.hs index 133e2a0cb3b..3e8f34fc034 100644 --- a/explorer/src/explorer/Main.hs +++ b/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 diff --git a/lib/src/Pos/Launcher/Scenario.hs b/lib/src/Pos/Launcher/Scenario.hs index 33150b8a150..c88e7a28af6 100644 --- a/lib/src/Pos/Launcher/Scenario.hs +++ b/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 diff --git a/lib/src/Pos/Worker.hs b/lib/src/Pos/Worker.hs index d8ba214c830..d1b3038a0c4 100644 --- a/lib/src/Pos/Worker.hs +++ b/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 diff --git a/lib/src/Pos/Worker/Block.hs b/lib/src/Pos/Worker/Block.hs index 497d432227a..b78b70f6bb4 100644 --- a/lib/src/Pos/Worker/Block.hs +++ b/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 diff --git a/lib/src/Pos/Worker/Delegation.hs b/lib/src/Pos/Worker/Delegation.hs index c03be4ee0b0..6b0e10f4e34 100644 --- a/lib/src/Pos/Worker/Delegation.hs +++ b/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 () diff --git a/lib/src/Pos/Worker/Ssc.hs b/lib/src/Pos/Worker/Ssc.hs index 98fa9de09cd..36f6d7d3a63 100644 --- a/lib/src/Pos/Worker/Ssc.hs +++ b/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 diff --git a/lib/src/Pos/Worker/Update.hs b/lib/src/Pos/Worker/Update.hs index 10a2ade406e..7ba6baea204 100644 --- a/lib/src/Pos/Worker/Update.hs +++ b/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 diff --git a/node/Main.hs b/node/Main.hs index 63647a7e388..ad1fa674772 100644 --- a/node/Main.hs +++ b/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" diff --git a/scripts/launch/connect-to-cluster/default.nix b/scripts/launch/connect-to-cluster/default.nix index e2cdd2564a9..9bcea17f6f6 100755 --- a/scripts/launch/connect-to-cluster/default.nix +++ b/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: diff --git a/wallet-new/src/Cardano/Wallet/Action.hs b/wallet-new/src/Cardano/Wallet/Action.hs index 6962859cd80..3e38547604e 100644 --- a/wallet-new/src/Cardano/Wallet/Action.hs +++ b/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 diff --git a/wallet-new/src/Cardano/Wallet/Server/LegacyPlugins.hs b/wallet-new/src/Cardano/Wallet/Server/LegacyPlugins.hs index 614b90fcdfb..3ee0367a038 100644 --- a/wallet-new/src/Cardano/Wallet/Server/LegacyPlugins.hs +++ b/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) diff --git a/wallet-new/src/Cardano/Wallet/Server/Plugins.hs b/wallet-new/src/Cardano/Wallet/Server/Plugins.hs index a2e49fdb647..f148de1a1d7 100644 --- a/wallet-new/src/Cardano/Wallet/Server/Plugins.hs +++ b/wallet-new/src/Cardano/Wallet/Server/Plugins.hs @@ -63,7 +63,7 @@ import Pos.Wallet.Web () -- A @Plugin@ running in the monad @m@. -type Plugin m = [Diffusion m -> m ()] +type Plugin m = Diffusion m -> m () -- | A @Plugin@ to start the wallet REST server @@ -73,8 +73,7 @@ apiServer -> (PassiveWalletLayer IO, PassiveWallet) -> [Middleware] -> Plugin Kernel.WalletMode -apiServer protocolMagic (NewWalletBackendParams WalletBackendParams{..}) (passiveLayer, passiveWallet) middlewares = - pure $ \diffusion -> do +apiServer protocolMagic (NewWalletBackendParams WalletBackendParams{..}) (passiveLayer, passiveWallet) middlewares diffusion = do env <- ask let diffusion' = Kernel.fromDiffusion (lower env) diffusion WalletLayer.Kernel.bracketActiveWallet protocolMagic passiveLayer passiveWallet diffusion' $ \active _ -> do @@ -128,7 +127,7 @@ docServer :: (HasConfigurations, HasCompileInfo) => NewWalletBackendParams -> Plugin Kernel.WalletMode -docServer (NewWalletBackendParams WalletBackendParams{..}) = pure $ \_ -> +docServer (NewWalletBackendParams WalletBackendParams{..}) = const $ serveDocImpl application (BS8.unpack ip) @@ -146,34 +145,37 @@ docServer (NewWalletBackendParams WalletBackendParams{..}) = pure $ \_ -> -- | A @Plugin@ to serve the node monitoring API. monitoringServer :: HasConfigurations => NewWalletBackendParams - -> Plugin Kernel.WalletMode + -> [ (Text, Plugin Kernel.WalletMode) ] monitoringServer (NewWalletBackendParams WalletBackendParams{..}) = case enableMonitoringApi of - True -> pure $ \_ -> do - serveImpl Pos.Web.Server.application + True -> [ ("monitoring worker", const worker) ] + False -> [] + where + worker = serveImpl Pos.Web.Server.application "127.0.0.1" monitoringApiPort walletTLSParams Nothing Nothing - False -> [] -- | A @Plugin@ to periodically compact & snapshot the acid-state database. acidStateSnapshots :: AcidState db -> NewWalletBackendParams -> DatabaseMode -> Plugin Kernel.WalletMode -acidStateSnapshots dbRef params dbMode = pure $ \_diffusion -> do - let opts = getWalletDbOptions params - modifyLoggerName (const "acid-state-checkpoint-plugin") $ - createAndArchiveCheckpoints - dbRef - (walletAcidInterval opts) - dbMode +acidStateSnapshots dbRef params dbMode = const worker + where + worker = do + let opts = getWalletDbOptions params + modifyLoggerName (const "acid-state-checkpoint-plugin") $ + createAndArchiveCheckpoints + dbRef + (walletAcidInterval opts) + dbMode -- | A @Plugin@ to store updates proposal received from the blockchain updateWatcher :: Plugin Kernel.WalletMode -updateWatcher = pure $ \_diffusion -> do +updateWatcher = const $ do modifyLoggerName (const "update-watcher-plugin") $ do w <- Kernel.getWallet forever $ liftIO $ do