Merge pull request #4909 from input-output-hk/newhoggy/fix-qKesKesKey…

…Expiry Fix qKesKesKeyExpiry to not always be null
IntersectMBO · Mar 30, 2023 · 541e7b9 · 541e7b9
2 parents 7b249f6 + e5e4564
commit 541e7b9
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 5 deletions.
diff --git a/cardano-cli/ChangeLog.md b/cardano-cli/ChangeLog.md
@@ -27,6 +27,8 @@
 
 - Query protocol parameters from the node in the `transaction build` command ([PR 4431](https://github.com/input-output-hk/cardano-node/pull/4431))
 
+- Fix `qKesKesKeyExpiry` in `kes-period-info` ([PR 4909](https://github.com/input-output-hk/cardano-node/pull/4909))
+
 ## 1.35.3 -- August 2022
 
 - Update build and build-raw commands to accept simple reference minting scripts (#4087)

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -448,7 +448,7 @@ runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFil
       eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery)
         & onLeft (left . ShelleyQueryCmdAcquireFailure)
 
-      let eInfo = toEpochInfo eraHistory
+      let eInfo = toTentativeEpochInfo eraHistory
 
 
       -- We get the operational certificate counter from the protocol state and check that
@@ -515,13 +515,13 @@ runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFil
    opCertNodeAndOnDiskCounters o Nothing = OpCertNoBlocksMintedYet o
 
    opCertExpiryUtcTime
-     :: EpochInfo (Either Text)
+     :: Tentative (EpochInfo (Either Text))
      -> GenesisParameters
      -> OpCertEndingKesPeriod
      -> Maybe UTCTime
    opCertExpiryUtcTime eInfo gParams (OpCertEndingKesPeriod oCertExpiryKesPeriod) =
      let time = epochInfoSlotToUTCTime
-                  eInfo
+                  (tentative eInfo)
                   (SystemStart $ protocolParamSystemStart gParams)
                   (fromIntegral $ oCertExpiryKesPeriod * fromIntegral (protocolParamSlotsPerKESPeriod gParams))
      in case time of
@@ -576,7 +576,7 @@ runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFil
    createQueryKesPeriodInfoOutput
      :: OpCertIntervalInformation
      -> OpCertNodeAndOnDiskCounterInformation
-     -> EpochInfo (Either Text)
+     -> Tentative (EpochInfo (Either Text))
      -> GenesisParameters
      -> O.QueryKesPeriodInfoOutput
    createQueryKesPeriodInfoOutput oCertIntervalInfo oCertCounterInfo eInfo gParams  =
@@ -1415,9 +1415,25 @@ queryResult eAcq = pure eAcq
 
 toEpochInfo :: EraHistory CardanoMode -> EpochInfo (Either Text)
 toEpochInfo (EraHistory _ interpreter) =
-  hoistEpochInfo (first (Text.pack . show ) . runExcept)
+  hoistEpochInfo (first (Text.pack . show) . runExcept)
     $ Consensus.interpreterToEpochInfo interpreter
 
+-- | A value that is tentative or produces a tentative value if used.  These values
+-- are considered accurate only if some future event such as a hard fork does not
+-- render them invalid.
+newtype Tentative a = Tentative { tentative :: a } deriving (Eq, Show)
+
+-- | Get an Epoch Info that computes tentative values.  The values computed are
+-- tentative because it uses an interpreter that is extended past the horizon.
+-- This interpreter will compute accurate values into the future as long as a
+-- a hard fork does not happen in the intervening time.  Those values are thus
+-- "tentative" because they can change in the event of a hard fork.
+toTentativeEpochInfo :: EraHistory CardanoMode -> Tentative (EpochInfo (Either Text))
+toTentativeEpochInfo (EraHistory _ interpreter) =
+  Tentative
+    $ hoistEpochInfo (first (Text.pack . show) . runExcept)
+    $ Consensus.interpreterToEpochInfo (Consensus.unsafeExtendSafeZone interpreter)
+
 obtainLedgerEraClassConstraints
   :: ShelleyLedgerEra era ~ ledgerera
   => Api.ShelleyBasedEra era