New debug log-epoch-state command

.github/workflows/actionlint.yml

@@ -1,6 +1,7 @@
 name: Actionlint
 
 on:
+  merge_group:
   pull_request:
 
 jobs:

.github/workflows/shellcheck.yml

@@ -7,6 +7,7 @@ name: Shellcheck
 # is consistent with the one of developers.
 
 on:
+  merge_group:
   pull_request:
 
 jobs:

cardano-cli/cardano-cli.cabal

@@ -55,6 +55,10 @@ library
                         Cardano.CLI.Byron.Tx
                         Cardano.CLI.Byron.UpdateProposal
                         Cardano.CLI.Byron.Vote
+                        Cardano.CLI.Commands
+                        Cardano.CLI.Commands.Ping
+                        Cardano.CLI.Commands.Debug
+                        Cardano.CLI.Commands.Debug.LogEpochState
                         Cardano.CLI.Environment
                         Cardano.CLI.EraBased.Commands
                         Cardano.CLI.EraBased.Commands.Address
@@ -138,12 +142,17 @@ library
                         Cardano.CLI.Legacy.Run.TextView
                         Cardano.CLI.Legacy.Run.Transaction
                         Cardano.CLI.Options
+                        Cardano.CLI.Options.Debug
+                        Cardano.CLI.Options.Ping
+                        Cardano.CLI.Orphans
                         Cardano.CLI.OS.Posix
                         Cardano.CLI.Parser
                         Cardano.CLI.Pretty
                         Cardano.CLI.Read
                         Cardano.CLI.Render
                         Cardano.CLI.Run
+                        Cardano.CLI.Run.Debug
+                        Cardano.CLI.Run.Debug.LogEpochState
                         Cardano.CLI.Run.Ping
                         Cardano.CLI.TopHandler
                         Cardano.CLI.Types.Common
@@ -205,6 +214,7 @@ library
                       , cardano-git-rev ^>= 0.2.2
                       , cardano-ledger-api
                       , cardano-ledger-byron >= 1.0.1.0
+                      , cardano-ledger-shelley
                       , cardano-ping ^>= 0.2.0.13
                       , cardano-prelude
                       , cardano-slotting ^>= 0.2.0.0

cardano-cli/src/Cardano/CLI/Commands.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE GADTs #-}
+
+module Cardano.CLI.Commands
+  ( ClientCommand(..)
+  ) where
+
+import           Cardano.CLI.Byron.Commands (ByronCommand)
+import           Cardano.CLI.Commands.Debug
+import           Cardano.CLI.Commands.Ping (PingCmd (..))
+import           Cardano.CLI.EraBased.Commands
+import           Cardano.CLI.Legacy.Commands
+
+import           Options.Applicative.Types (ParserInfo (..), ParserPrefs (..))
+
+-- | Sub-commands of 'cardano-cli'.
+data ClientCommand =
+    AnyEraCommand AnyEraCommand
+
+    -- | Byron Related Commands
+  | ByronCommand ByronCommand
+
+    -- | Legacy shelley-based Commands
+  | LegacyCmds LegacyCmds
+
+  | CliPingCommand PingCmd
+  | CliDebugCmds DebugCmds
+
+  | forall a. Help ParserPrefs (ParserInfo a)
+  | DisplayVersion

cardano-cli/src/Cardano/CLI/Commands/Debug.hs

@@ -0,0 +1,8 @@
+module Cardano.CLI.Commands.Debug
+  ( DebugCmds (..)
+  ) where
+
+import           Cardano.CLI.Commands.Debug.LogEpochState
+
+newtype DebugCmds =
+  DebugLogEpochStateCmd LogEpochStateCmdArgs

cardano-cli/src/Cardano/CLI/Commands/Debug/LogEpochState.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE DataKinds #-}
+
+module Cardano.CLI.Commands.Debug.LogEpochState
+  ( LogEpochStateCmdArgs(..)
+  , Configuration
+  ) where
+
+import           Cardano.Api
+
+import           Cardano.CLI.Orphans ()
+
+-- | A phantom type to represent the configuration file.
+data Configuration
+
+-- | The arguments for the 'debug log-epoch-state' command.
+--
+-- This command will connect to a local node and log the epoch state.
+data LogEpochStateCmdArgs = LogEpochStateCmdArgs
+  { nodeSocketPath    :: !SocketPath
+  , configurationFile :: !(NodeConfigFile 'In)
+  , outputFilePath    :: !(File Configuration 'Out)
+  } deriving Show

cardano-cli/src/Cardano/CLI/Commands/Ping.hs

@@ -0,0 +1,21 @@
+module Cardano.CLI.Commands.Ping
+  ( EndPoint(..)
+  , PingCmd(..)
+  ) where
+
+import           Data.Word
+
+data EndPoint =
+      HostEndPoint String
+    | UnixSockEndPoint String
+  deriving (Eq, Show)
+
+data PingCmd = PingCmd
+  { pingCmdCount           :: !Word32
+  , pingCmdEndPoint        :: !EndPoint
+  , pingCmdPort            :: !String
+  , pingCmdMagic           :: !Word32
+  , pingCmdJson            :: !Bool
+  , pingCmdQuiet           :: !Bool
+  , pingOptsHandshakeQuery :: !Bool
+  } deriving (Eq, Show)

cardano-cli/src/Cardano/CLI/Options.hs

@@ -15,9 +15,10 @@ import           Cardano.CLI.Environment (EnvCli)
 import           Cardano.CLI.EraBased.Commands
 import           Cardano.CLI.EraBased.Options.Common
 import           Cardano.CLI.Legacy.Options (parseLegacyCmds)
+import           Cardano.CLI.Options.Debug
+import           Cardano.CLI.Options.Ping (parsePingCmd)
 import           Cardano.CLI.Render (customRenderHelp)
 import           Cardano.CLI.Run (ClientCommand (..))
-import           Cardano.CLI.Run.Ping (parsePingCmd)
 
 import           Data.Foldable
 import           Options.Applicative
@@ -55,6 +56,7 @@ parseClientCommand envCli =
     , parseTopLevelLegacy envCli
     , parseByron envCli
     , parsePing
+    , parseDebug envCli
     , backwardsCompatibilityCommands envCli
     , parseDisplayVersion (opts envCli)
     ]
@@ -71,6 +73,9 @@ parseByron mNetworkId =
 parsePing :: Parser ClientCommand
 parsePing = CliPingCommand <$> parsePingCmd
 
+parseDebug :: EnvCli -> Parser ClientCommand
+parseDebug envCli = CliDebugCmds <$> parseDebugCmds envCli
+
 parseAnyEra :: EnvCli -> Parser ClientCommand
 parseAnyEra envCli = AnyEraCommand <$> pAnyEraCommand envCli
 

cardano-cli/src/Cardano/CLI/Options/Debug.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{- HLINT ignore "Use <$>" -}
+{- HLINT ignore "Move brackets to avoid $" -}
+
+module Cardano.CLI.Options.Debug
+  ( parseDebugCmds
+  ) where
+
+import           Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))
+
+import           Cardano.CLI.Commands.Debug
+import           Cardano.CLI.Commands.Debug.LogEpochState
+import           Cardano.CLI.Environment
+import           Cardano.CLI.EraBased.Options.Common
+
+import           Data.Foldable
+import           Options.Applicative hiding (help, str)
+import qualified Options.Applicative as Opt
+
+parseDebugCmds :: EnvCli -> Parser DebugCmds
+parseDebugCmds envCli =
+  Opt.hsubparser $ mconcat
+    [ Opt.metavar "debug commands"
+    , Opt.commandGroup "debug commands"
+    , Opt.command "debug"
+        $ Opt.info (pDebugCmds envCli)
+        $ Opt.progDesc "Debug commands"
+    ]
+
+pDebugCmds :: EnvCli -> Parser DebugCmds
+pDebugCmds envCli =
+   asum
+     [ subParser "log-epoch-state"
+         $ Opt.info pLogEpochStateCmdArgs
+         $ Opt.progDesc
+         $ mconcat
+            [ "Log epoch state of a running node."
+            , " This command will connect to a local node and log the epoch state to a file."
+            , " The log file format is line delimited JSON."
+            , " The command will not terminate."
+            ]
+     ]
+  where
+    pLogEpochStateCmdArgs :: Parser DebugCmds
+    pLogEpochStateCmdArgs =
+      fmap DebugLogEpochStateCmd $
+        LogEpochStateCmdArgs
+          <$> pSocketPath envCli
+          <*> pNodeConfigurationFileIn
+          <*> pFileOutDirection "out-file" "Output filepath of the log file.  The log file format is line delimited JSON."
+
+pNodeConfigurationFileIn :: Parser (NodeConfigFile In)
+pNodeConfigurationFileIn =
+  fmap File $ Opt.strOption $ mconcat
+    [ Opt.long "node-configuration-file"
+    , Opt.metavar "FILE"
+    , Opt.help "Input filepath of the node configuration file."
+    , Opt.completer (Opt.bashCompleter "file")
+    ]

cardano-cli/src/Cardano/CLI/Options/Ping.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE TypeApplications #-}
+
+{- HLINT ignore "Move brackets to avoid $" -}
+
+module Cardano.CLI.Options.Ping
+  ( parsePingCmd
+  ) where
+
+import           Cardano.CLI.Commands.Ping
+import qualified Cardano.Network.Ping as CNP
+
+import           Control.Applicative ((<|>))
+import qualified Options.Applicative as Opt
+import qualified Prettyprinter as PP
+
+parsePingCmd :: Opt.Parser PingCmd
+parsePingCmd = Opt.hsubparser $ mconcat
+  [ Opt.metavar "ping"
+  , Opt.command "ping" $ Opt.info pPing $ Opt.progDescDoc $ Just $ mconcat
+    [ PP.pretty @String "Ping a cardano node either using node-to-node or node-to-client protocol. "
+    , PP.pretty @String "It negotiates a handshake and keeps sending keep alive messages."
+    ]
+  ]
+
+pHost :: Opt.Parser String
+pHost =
+  Opt.strOption $ mconcat
+    [ Opt.long "host"
+    , Opt.short 'h'
+    , Opt.metavar "HOST"
+    , Opt.help "Hostname/IP, e.g. relay.iohk.example."
+    ]
+
+pUnixSocket :: Opt.Parser String
+pUnixSocket =
+  Opt.strOption $ mconcat
+    [ Opt.long "unixsock"
+    , Opt.short 'u'
+    , Opt.metavar "SOCKET"
+    , Opt.help "Unix socket, e.g. file.socket."
+    ]
+
+pEndPoint :: Opt.Parser EndPoint
+pEndPoint = fmap HostEndPoint pHost <|> fmap UnixSockEndPoint pUnixSocket
+
+pPing :: Opt.Parser PingCmd
+pPing = PingCmd
+  <$> ( Opt.option Opt.auto $ mconcat
+        [ Opt.long "count"
+        , Opt.short 'c'
+        , Opt.metavar "COUNT"
+        , Opt.help $ mconcat
+          [ "Stop after sending count requests and receiving count responses.  "
+          , "If this option is not specified, ping will operate until interrupted.  "
+          ]
+        , Opt.value maxBound
+        ]
+      )
+  <*> pEndPoint
+  <*> ( Opt.strOption $ mconcat
+        [ Opt.long "port"
+        , Opt.short 'p'
+        , Opt.metavar "PORT"
+        , Opt.help "Port number, e.g. 1234."
+        , Opt.value "3001"
+        ]
+      )
+  <*> ( Opt.option Opt.auto $ mconcat
+        [ Opt.long "magic"
+        , Opt.short 'm'
+        , Opt.metavar "MAGIC"
+        , Opt.help "Network magic."
+        , Opt.value CNP.mainnetMagic
+        ]
+      )
+  <*> ( Opt.switch $ mconcat
+        [ Opt.long "json"
+        , Opt.short 'j'
+        , Opt.help "JSON output flag."
+        ]
+      )
+  <*> ( Opt.switch $ mconcat
+        [ Opt.long "quiet"
+        , Opt.short 'q'
+        , Opt.help "Quiet flag, CSV/JSON only output"
+        ]
+      )
+  <*> ( Opt.switch $ mconcat
+        [ Opt.long "query-versions"
+        , Opt.short 'Q'
+        , Opt.help "Query the supported protocol versions using the handshake protocol and terminate the connection."
+        ]
+      )

cardano-cli/src/Cardano/CLI/Orphans.hs

@@ -0,0 +1,24 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Cardano.CLI.Orphans
+  (
+  ) where
+
+import           Cardano.Api
+
+import qualified Cardano.Ledger.Api as L
+import qualified Cardano.Ledger.Shelley.LedgerState as L
+
+import           Data.Aeson
+
+-- TODO upstream this orphaned instance to the ledger
+instance (L.EraTxOut ledgerera, L.EraGov ledgerera) => ToJSON (L.NewEpochState ledgerera) where
+  toJSON (L.NewEpochState nesEL nesBprev nesBCur nesEs nesRu nesPd _stashedAvvm)=
+    object
+      [ "currentEpoch" .= nesEL
+      , "priorBlocks" .= nesBprev
+      , "currentEpochBlocks" .= nesBCur
+      , "currentEpochState" .= nesEs
+      , "rewardUpdate" .= nesRu
+      , "currentStakeDistribution" .= nesPd
+      ]