JSON format for leadership schedule

IntersectMBO · Mar 31, 2022 · 16e0db3 · 16e0db3
1 parent 78675fb
commit 16e0db3
Show file tree

Hide file tree

Showing 5 changed files with 56 additions and 7 deletions.
diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -51,6 +51,7 @@ library
   hs-source-dirs:       src
 
   exposed-modules:      Cardano.CLI.Helpers
+                        Cardano.CLI.Output
                         Cardano.CLI.Parsers
                         Cardano.CLI.Render
                         Cardano.CLI.Run

diff --git a/cardano-cli/src/Cardano/CLI/Output.hs b/cardano-cli/src/Cardano/CLI/Output.hs
@@ -0,0 +1,8 @@
+module Cardano.CLI.Output
+  ( OutputAs(..)
+  ) where
+
+import Data.Eq
+import Text.Show
+
+data OutputAs = OutputAsJson | OutputAsText deriving (Eq, Show)
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs
@@ -48,6 +48,7 @@ module Cardano.CLI.Shelley.Commands
 import           Prelude
 
 import           Cardano.Api.Shelley
+import           Cardano.CLI.Output
 
 import           Data.Text (Text)
 
@@ -345,6 +346,7 @@ data QueryCmd =
       (VerificationKeyOrHashOrFile StakePoolKey)
       SigningKeyFile
       EpochLeadershipSchedule
+      OutputAs
   | QueryProtocolParameters' AnyConsensusModeParams NetworkId (Maybe OutputFile)
   | QueryTip AnyConsensusModeParams NetworkId (Maybe OutputFile)
   | QueryStakePools' AnyConsensusModeParams NetworkId (Maybe OutputFile)

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
@@ -20,6 +20,7 @@ import           Prelude (String)
 import           Cardano.Api
 import           Cardano.Api.Shelley
 
+import           Cardano.CLI.Output
 import           Cardano.CLI.Shelley.Commands
 import           Cardano.CLI.Shelley.Key (InputFormat (..), PaymentVerifier (..),
                    StakeVerifier (..), VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..),
@@ -981,6 +982,7 @@ pQueryCmd =
       <*> pStakePoolVerificationKeyOrHashOrFile
       <*> pVrfSigningKeyFile
       <*> pWhichLeadershipSchedule
+      <*> pOutputAs
 
     pKesPeriodInfo :: Parser QueryCmd
     pKesPeriodInfo = QueryKesPeriodInfo
@@ -989,6 +991,18 @@ pQueryCmd =
       <*> pOperationalCertificateFile
       <*> pMaybeOutputFile
 
+pOutputAs :: Parser OutputAs
+pOutputAs = pOutputAsJson <|> pOutputAsText <|> pure OutputAsText
+  where
+    pOutputAsText = Opt.flag' OutputAsText
+      (  Opt.long "output-as-text"
+      <> Opt.help "Output as text (default)"
+      )
+    pOutputAsJson = Opt.flag' OutputAsJson
+      (  Opt.long "output-as-json"
+      <> Opt.help "Output as JSON"
+      )
+
 pGovernanceCmd :: Parser GovernanceCmd
 pGovernanceCmd =
  asum

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -33,6 +33,7 @@ import           Cardano.Api.Byron
 import           Cardano.Api.Shelley
 import           Cardano.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
 import           Cardano.CLI.Helpers (HelpersError (..), hushM, pPrintCBOR, renderHelpersError)
+import           Cardano.CLI.Output
 import           Cardano.CLI.Shelley.Commands
 import           Cardano.CLI.Shelley.Key
 import           Cardano.CLI.Shelley.Orphans ()
@@ -163,8 +164,8 @@ renderShelleyQueryCmdError err =
 runQueryCmd :: QueryCmd -> ExceptT ShelleyQueryCmdError IO ()
 runQueryCmd cmd =
   case cmd of
-    QueryLeadershipSchedule consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule ->
-      runQueryLeadershipSchedule consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule
+    QueryLeadershipSchedule consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule outputAs ->
+      runQueryLeadershipSchedule consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule outputAs
     QueryProtocolParameters' consensusModeParams network mOutFile ->
       runQueryProtocolParameters consensusModeParams network mOutFile
     QueryTip consensusModeParams network mOutFile ->
@@ -1172,10 +1173,11 @@ runQueryLeadershipSchedule
   -> VerificationKeyOrHashOrFile StakePoolKey
   -> SigningKeyFile -- ^ VRF signing key
   -> EpochLeadershipSchedule
+  -> OutputAs
   -> ExceptT ShelleyQueryCmdError IO ()
 runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network
                            (GenesisFile genFile) coldVerKeyFile (SigningKeyFile vrfSkeyFp)
-                           whichSchedule = do
+                           whichSchedule outputAs = do
   SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr readEnvSocketPath
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
@@ -1239,15 +1241,17 @@ runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network
                      serCurrentEpochState ptclState poolid vrkSkey pparams
                      eInfo (tip, curentEpoch)
 
-      liftIO $ printLeadershipSchedule schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis)
+      case outputAs of
+        OutputAsText -> liftIO $ printLeadershipScheduleAsText schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis)
+        OutputAsJson -> liftIO $ printLeadershipScheduleAsJson schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis)
     mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode
  where
-  printLeadershipSchedule
+  printLeadershipScheduleAsText
     :: Set SlotNo
     -> EpochInfo (Either Text)
     -> SystemStart
     -> IO ()
-  printLeadershipSchedule leadershipSlots eInfo sStart = do
+  printLeadershipScheduleAsText leadershipSlots eInfo sStart = do
     Text.putStrLn title
     putStrLn $ replicate (Text.length title + 2) '-'
     sequence_
@@ -1279,7 +1283,27 @@ runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network
            , "                   "
            , Text.unpack err
            ]
-
+  printLeadershipScheduleAsJson
+    :: Set SlotNo
+    -> EpochInfo (Either Text)
+    -> SystemStart
+    -> IO ()
+  printLeadershipScheduleAsJson leadershipSlots eInfo sStart = do
+    LBS.putStrLn $ encodePretty $ showLeadershipSlot <$> sort (Set.toList leadershipSlots)
+    where
+      showLeadershipSlot :: SlotNo -> Aeson.Value
+      showLeadershipSlot lSlot@(SlotNo sn) =
+        case epochInfoSlotToUTCTime eInfo sStart lSlot of
+          Right slotTime ->
+            Aeson.object
+              [ "slotNumber" Aeson..= sn
+              , "slotTime" Aeson..= slotTime
+              ]
+          Left err ->
+            Aeson.object
+              [ "slotNumber" Aeson..= sn
+              , "error" Aeson..= Text.unpack err
+              ]
 
 
 -- Helpers