Merge pull request #2785 from input-output-hk/nc/forecast-2

Extend the EpochInfo window in the Alonzo era.

cabal.project

@@ -41,8 +41,8 @@ test-show-details: streaming
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: 8fe904d629194b1fbaaf2d0a4e0ccd17052e9103
-  --sha256: sha256-5B5lJFfUm4jbCBQtqTMvtiY2AWtnsN/1TYftAglT38A=
+  tag: b1eb0e678b834ef5a6eaea84e75b41a14123331a
+  --sha256: 0944wg2nqazmhlmsynwgdwxxj6ay0hb9qig9l128isb2cjia0hlp
   subdir:
     base-deriving-via
     binary

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs

@@ -28,6 +28,7 @@ import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo (TxSeq)
 import Cardano.Ledger.Alonzo.TxWitness (Redeemers, TxWitness (txrdmrs'), nullRedeemers)
 import Cardano.Ledger.BaseTypes
   ( Network,
+    ProtVer,
     ShelleyBase,
     StrictMaybe (..),
     epochInfoWithErr,
@@ -53,6 +54,7 @@ import Cardano.Ledger.Rules.ValidationMode
     runTest,
     runTestOnSignal,
   )
+import Cardano.Ledger.Shelley.HardForks (allowOutsideForecastTTL)
 import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
 import qualified Cardano.Ledger.Shelley.Rules.Utxo as Shelley
 import Cardano.Ledger.Shelley.Tx (TxIn)
@@ -62,6 +64,7 @@ import qualified Cardano.Ledger.ShelleyMA.Rules.Utxo as ShelleyMA
 import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..))
 import qualified Cardano.Ledger.Val as Val
 import Cardano.Slotting.EpochInfo.API (EpochInfo, epochInfoSlotToUTCTime)
+import Cardano.Slotting.EpochInfo.Extend (unsafeLinearExtendEpochInfo)
 import Cardano.Slotting.Slot (SlotNo)
 import Cardano.Slotting.Time (SystemStart)
 import Control.Monad (unless)
@@ -353,18 +356,27 @@ validateCollateralContainsNonADA bal =
 -- > (_,i_f) := txvldt tx
 -- > ◇ ∉ { txrdmrs tx, i_f } ⇒ epochInfoSlotToUTCTime epochInfo systemTime i_f ≠ ◇
 validateOutsideForecast ::
-  HasField "vldt" (Core.TxBody era) ValidityInterval =>
+  ( HasField "vldt" (Core.TxBody era) ValidityInterval,
+    HasField "_protocolVersion" (Core.PParams era) ProtVer
+  ) =>
+  Core.PParams era ->
   EpochInfo (Either a) ->
+  -- | Current slot number
+  SlotNo ->
   SystemStart ->
   ValidatedTx era ->
   Test (UtxoPredicateFailure era)
-validateOutsideForecast ei sysSt tx =
+validateOutsideForecast pp ei slotNo sysSt tx =
   {-   (_,i_f) := txvldt tx   -}
   case getField @"vldt" (body tx) of
     ValidityInterval _ (SJust ifj)
       | not (nullRedeemers (txrdmrs' $ wits tx)) ->
-          -- ◇ ∉ { txrdmrs tx, i_f } ⇒
-          failureUnless (isRight (epochInfoSlotToUTCTime ei sysSt ifj)) $ OutsideForecast ifj
+          let ei' =
+                if allowOutsideForecastTTL pp
+                  then unsafeLinearExtendEpochInfo slotNo ei
+                  else ei
+           in -- ◇ ∉ { txrdmrs tx, i_f } ⇒
+              failureUnless (isRight (epochInfoSlotToUTCTime ei' sysSt ifj)) $ OutsideForecast ifj
     _ -> pure ()
 
 -- | Ensure that there are no `Core.TxOut`s that have value less than the sized @coinsPerUTxOWord@
@@ -503,7 +515,7 @@ utxoTransition = do
   ei <- liftSTS $ asks epochInfoWithErr
 
   {- epochInfoSlotToUTCTime epochInfo systemTime i_f ≠ ◇ -}
-  runTest $ validateOutsideForecast ei sysSt tx
+  runTest $ validateOutsideForecast pp ei slot sysSt tx
 
   {-   txins txb ≠ ∅   -}
   runTestOnSignal $ Shelley.validateInputSetEmptyUTxO txb

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs

@@ -61,6 +61,7 @@ import Cardano.Ledger.Shelley.Rules.Ppup (PPUP, PPUPEnv (..), PpupPredicateFailu
 import Cardano.Ledger.Shelley.Rules.Utxo (UtxoEnv (..), updateUTxOState)
 import Cardano.Ledger.Shelley.UTxO (UTxO (..), balance, totalDeposits)
 import Cardano.Ledger.Val as Val
+import Cardano.Slotting.EpochInfo.Extend (unsafeLinearExtendEpochInfo)
 import Control.Monad.Trans.Reader (asks)
 import Control.State.Transition.Extended
 import Data.ByteString as BS (ByteString)
@@ -178,7 +179,7 @@ scriptsValidateTransition = do
 
   () <- pure $! traceEvent validBegin ()
 
-  case collectTwoPhaseScriptInputs ei sysSt pp tx utxo of
+  case collectTwoPhaseScriptInputs (unsafeLinearExtendEpochInfo slot ei) sysSt pp tx utxo of
     Right sLst ->
       when2Phase $ case evalScripts @era (getField @"_protocolVersion" pp) tx sLst of
         Fails _ps fs ->
@@ -207,14 +208,14 @@ scriptsNotValidateTransition ::
   ) =>
   TransitionRule (UTXOS era)
 scriptsNotValidateTransition = do
-  TRC (UtxoEnv _ pp _ _, us@(UTxOState utxo _ fees _ _), tx) <- judgmentContext
+  TRC (UtxoEnv slot pp _ _, us@(UTxOState utxo _ fees _ _), tx) <- judgmentContext
   let txb = body tx
   sysSt <- liftSTS $ asks systemStart
   ei <- liftSTS $ asks epochInfo
 
   let !_ = traceEvent invalidBegin ()
 
-  case collectTwoPhaseScriptInputs ei sysSt pp tx utxo of
+  case collectTwoPhaseScriptInputs (unsafeLinearExtendEpochInfo slot ei) sysSt pp tx utxo of
     Right sLst ->
       whenFailureFree $
         when2Phase $

eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs

@@ -347,7 +347,7 @@ utxoTransition = do
   ei <- liftSTS $ asks epochInfoWithErr
 
   {- epochInfoSlotToUTCTime epochInfo systemTime i_f ≠ ◇ -}
-  runTest $ validateOutsideForecast ei sysSt tx
+  runTest $ validateOutsideForecast pp ei slot sysSt tx
 
   {-   txins txb ≠ ∅   -}
   runTestOnSignal $ Shelley.validateInputSetEmptyUTxO txb

eras/shelley/impl/src/Cardano/Ledger/Shelley/HardForks.hs

@@ -10,6 +10,7 @@ module Cardano.Ledger.Shelley.HardForks
     translateTimeForPlutusScripts,
     missingScriptsSymmetricDifference,
     forgoRewardPrefilter,
+    allowOutsideForecastTTL,
   )
 where
 
@@ -75,3 +76,13 @@ forgoRewardPrefilter ::
   pp ->
   Bool
 forgoRewardPrefilter pp = pvMajor (getField @"_protocolVersion" pp) > 6
+
+-- | In versions 5 and 6, we allow the ttl field to lie outside the stability
+-- window.
+allowOutsideForecastTTL ::
+  (HasField "_protocolVersion" pp ProtVer) =>
+  pp ->
+  Bool
+allowOutsideForecastTTL pp =
+  let mv = pvMajor (getField @"_protocolVersion" pp)
+   in mv == 5 || mv == 6