From ff76b5b12c6b32da70281e121937f6b15347c6fb Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 3 Jun 2022 03:12:57 +0300 Subject: [PATCH] cardano-node: review suggestions by Jordan Millar --- .../src/Cardano/Node/Handlers/Shutdown.hs | 57 ++++++++++--------- cardano-node/src/Cardano/Node/Parsers.hs | 5 +- 2 files changed, 33 insertions(+), 29 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Handlers/Shutdown.hs b/cardano-node/src/Cardano/Node/Handlers/Shutdown.hs index 39f028deba3..01568c6e1f1 100644 --- a/cardano-node/src/Cardano/Node/Handlers/Shutdown.hs +++ b/cardano-node/src/Cardano/Node/Handlers/Shutdown.hs @@ -26,9 +26,9 @@ module Cardano.Node.Handlers.Shutdown ) where +import Cardano.Prelude import Data.Aeson (FromJSON, ToJSON) import Generic.Data.Orphans () -import Cardano.Prelude import Data.Text (pack) import qualified GHC.IO.Handle.FD as IO (fdToHandle) @@ -43,34 +43,34 @@ import Ouroboros.Consensus.Block (Header) import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry) import Ouroboros.Consensus.Util.STM (Watcher (..), forkLinkedWatcher) -import Ouroboros.Network.Block (HasHeader, BlockNo (..), SlotNo (..), pointSlot) +import Ouroboros.Network.Block (BlockNo (..), HasHeader, SlotNo (..), pointSlot) -data SlotOrBlock f - = ASlot !(f SlotNo) - | ABlock !(f BlockNo) - deriving (Generic) +data SlotOrBlock + = ASlot !SlotNo + | ABlock !BlockNo + | NoShutdownOnSlotOrBlock + deriving (Generic, Eq, Show) -deriving instance Eq (SlotOrBlock Identity) -deriving instance Show (SlotOrBlock Identity) -deriving instance FromJSON (SlotOrBlock Identity) -deriving instance ToJSON (SlotOrBlock Identity) +deriving instance FromJSON SlotOrBlock +deriving instance ToJSON SlotOrBlock -parseShutdownOnLimit :: Opt.Parser (Maybe (SlotOrBlock Identity)) +parseShutdownOnLimit :: Opt.Parser SlotOrBlock parseShutdownOnLimit = - optional (Opt.option (ASlot . Identity . SlotNo <$> Opt.auto) ( + Opt.option (ASlot . SlotNo <$> Opt.auto) ( Opt.long "shutdown-on-slot-synced" <> Opt.metavar "SLOT" <> Opt.help "Shut down the process after ChainDB is synced up to the specified slot" <> Opt.hidden - )) + ) <|> - optional (Opt.option (ABlock . Identity . BlockNo <$> Opt.auto) ( + Opt.option (ABlock . BlockNo <$> Opt.auto) ( Opt.long "shutdown-on-block-synced" <> Opt.metavar "BLOCK" <> Opt.help "Shut down the process after ChainDB is synced up to the specified block" <> Opt.hidden - )) + ) + <|> pure NoShutdownOnSlotOrBlock data ShutdownTrace = ShutdownRequested @@ -81,21 +81,24 @@ data ShutdownTrace -- ^ Received shutdown request but found unexpected input in --shutdown-ipc FD: | RequestingShutdown Text -- ^ Ringing the node shutdown doorbell for reason - | ShutdownArmedAt (SlotOrBlock Identity) + | ShutdownArmedAt SlotOrBlock -- ^ Will terminate upon reaching a ChainDB sync limit deriving (Generic, FromJSON, ToJSON) deriving instance FromJSON BlockNo deriving instance ToJSON BlockNo -newtype AndWithOrigin a = AndWithOrigin (a, WithOrigin a) deriving (Eq) +data AndWithOrigin + = AndWithOriginBlock (BlockNo, WithOrigin BlockNo) + | AndWithOriginSlot (SlotNo, WithOrigin SlotNo) + | WithoutOrigin -deriving instance Eq (SlotOrBlock AndWithOrigin) +deriving instance Eq AndWithOrigin data ShutdownConfig = ShutdownConfig { scIPC :: !(Maybe Fd) - , scOnSyncLimit :: !(Maybe (SlotOrBlock Identity)) + , scOnSyncLimit :: !(Maybe SlotOrBlock) } deriving (Eq, Show) @@ -142,27 +145,27 @@ maybeSpawnOnSlotSyncedShutdownHandler sc tr registry chaindb = traceWith tr (ShutdownArmedAt lim) spawnLimitTerminator lim where - spawnLimitTerminator :: SlotOrBlock Identity -> IO () + spawnLimitTerminator :: SlotOrBlock -> IO () spawnLimitTerminator limit = void $ forkLinkedWatcher registry "slotLimitTerminator" Watcher { - wFingerprint = identity + wFingerprint = id , wInitial = Nothing , wReader = case limit of - ASlot (Identity x) -> ASlot . AndWithOrigin . (x,) <$> - (pointSlot <$> ChainDB.getTipPoint chaindb) - ABlock (Identity x) -> ABlock . AndWithOrigin . (x,) <$> - ChainDB.getTipBlockNo chaindb + ASlot x -> AndWithOriginSlot . (x,) . pointSlot <$> ChainDB.getTipPoint chaindb + ABlock x -> AndWithOriginBlock . (x,) <$> ChainDB.getTipBlockNo chaindb + NoShutdownOnSlotOrBlock -> return WithoutOrigin , wNotify = \case - ASlot (AndWithOrigin (lim, At cur)) -> + (AndWithOriginSlot (lim, At cur)) -> when (cur >= lim) $ do traceWith tr (RequestingShutdown $ "spawnLimitTerminator: reached target slot " <> (pack . show) cur) throwIO ExitSuccess - ABlock (AndWithOrigin (lim, At cur)) -> + (AndWithOriginBlock (lim, At cur)) -> when (cur >= lim) $ do traceWith tr (RequestingShutdown $ "spawnLimitTerminator: reached target block " <> (pack . show) cur) throwIO ExitSuccess + WithoutOrigin -> pure () _ -> pure () } diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index a7cdbfb6592..dd3389b4361 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -23,7 +23,8 @@ import Ouroboros.Consensus.Mempool.API (MempoolCapacityBytes (..), MempoolCapacityBytesOverride (..)) import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (SnapshotInterval (..)) -import Cardano.Node.Configuration.NodeAddress +import Cardano.Node.Configuration.NodeAddress (NodeHostIPv4Address (NodeHostIPv4Address), + NodeHostIPv6Address (NodeHostIPv6Address), PortNumber, SocketPath (SocketPath)) import Cardano.Node.Configuration.POM (PartialNodeConfiguration (..), lastOption) import Cardano.Node.Configuration.Socket import Cardano.Node.Handlers.Shutdown @@ -91,7 +92,7 @@ nodeRunParser = do } , pncValidateDB = validate , pncShutdownConfig = - Last . Just $ ShutdownConfig (getLast shutdownIPC) (join $ getLast shutdownOnLimit) + Last . Just $ ShutdownConfig (getLast shutdownIPC) (getLast shutdownOnLimit) , pncProtocolConfig = mempty , pncMaxConcurrencyBulkSync = mempty , pncMaxConcurrencyDeadline = mempty