test slot to time translation (#2261)

Convert slots to UTC for Plutus scripts

Note that we are not actually passing UTC to Plutus yet, since Plutus needs to add support for this.

alonzo/impl/cardano-ledger-alonzo.cabal

@@ -69,6 +69,7 @@ library
     small-steps,
     strict-containers,
     text,
+    time,
     transformers
   hs-source-dirs:
     src

alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs

@@ -36,15 +36,18 @@ import Cardano.Ledger.Alonzo.Tx
     txdats',
   )
 import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo (TxBody (..), TxOut (..), vldt')
-import Cardano.Ledger.Alonzo.TxInfo (runPLCScript, transTx, valContext)
+import Cardano.Ledger.Alonzo.TxInfo (runPLCScript, txInfo, valContext)
 import Cardano.Ledger.Alonzo.TxWitness (TxWitness (txwitsVKey'), txscripts')
 import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.Era (Crypto, Era, ValidateScript (..))
 import Cardano.Ledger.Mary.Value (PolicyID (..))
 import qualified Cardano.Ledger.Mary.Value as Mary (Value (..))
 import Cardano.Ledger.ShelleyMA.Timelocks (evalTimelock)
+import Cardano.Slotting.EpochInfo (EpochInfo)
+import Cardano.Slotting.Time (SystemStart)
 import Data.Coders
+import Data.Functor.Identity (Identity)
 import Data.List (foldl')
 import qualified Data.Map as Map
 import Data.Maybe (isJust)
@@ -143,16 +146,18 @@ collectTwoPhaseScriptInputs ::
     HasField "body" tx (Core.TxBody era),
     HasField "wits" tx (TxWitness era)
   ) =>
+  EpochInfo Identity ->
+  SystemStart ->
   Core.PParams era ->
   tx ->
   UTxO era ->
   Either [CollectError (Crypto era)] [(AlonzoScript.Script era, [Data era], ExUnits, CostModel)]
-collectTwoPhaseScriptInputs pp tx utxo =
+collectTwoPhaseScriptInputs ei sysS pp tx utxo =
   case Map.lookup PlutusV1 (getField @"_costmdls" pp) of
     Nothing -> Left [NoCostModel PlutusV1]
     Just cost -> merge (apply cost) (map redeemer needed) (map getscript needed) (Right [])
   where
-    txinfo = transTx utxo tx
+    txinfo = txInfo ei sysS utxo tx
     needed = scriptsNeeded utxo tx
     redeemer (sp, _) =
       case indexedRdmrs tx sp of

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

@@ -47,6 +47,7 @@ import Cardano.Ledger.ShelleyMA.Rules.Utxo (consumed)
 import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..), inInterval)
 import qualified Cardano.Ledger.Val as Val
 import Cardano.Prelude (HeapWords (..))
+import Cardano.Slotting.EpochInfo.API (epochInfoSlotToUTCTime)
 import Cardano.Slotting.Slot (SlotNo)
 import Control.Iterate.SetAlgebra (dom, eval, (⊆), (◁), (➖))
 import Control.Monad.Trans.Reader (asks)
@@ -85,7 +86,9 @@ import Shelley.Spec.Ledger.BaseTypes
   ( Network,
     ShelleyBase,
     StrictMaybe (..),
+    epochInfoWithErr,
     networkId,
+    systemStart,
   )
 import qualified Shelley.Spec.Ledger.LedgerState as Shelley
 import qualified Shelley.Spec.Ledger.STS.Utxo as Shelley
@@ -106,7 +109,7 @@ utxoEntrySize txout
     -- no non-ada assets, no hash datum case
     case dh of
       SNothing -> adaOnlyUTxOSize
-      _ -> adaOnlyUTxOSize + dataHashSize dh
+      SJust _ -> adaOnlyUTxOSize + dataHashSize dh
   -- add the size of Value and the size of datum hash (if present) to base UTxO size
   -- max function is a safeguard (in case calculation returns a smaller size than an ada-only entry)
   | otherwise = max adaOnlyUTxOSize (utxoEntrySizeWithoutVal + Val.size v + dataHashSize dh)
@@ -202,6 +205,8 @@ data UtxoPredicateFailure era
     WrongNetworkInTxBody
       !Network -- Actual Network ID
       !Network -- Network ID in transaction body
+  | OutsideForecast
+      !SlotNo -- slot number outside consensus forecast range
   deriving (Generic)
 
 deriving stock instance
@@ -312,10 +317,19 @@ utxoTransition = do
   let Shelley.UTxOState utxo _deposits _fees _ppup = u
 
   let txb = txbody tx
+  let vi@(ValidityInterval _ i_f) = getField @"vldt" txb
 
-  inInterval slot (getField @"vldt" txb)
+  inInterval slot vi
     ?! OutsideValidityIntervalUTxO (getField @"vldt" txb) slot
 
+  sysSt <- liftSTS $ asks systemStart
+  ei <- liftSTS $ asks epochInfoWithErr
+  case i_f of
+    SNothing -> pure ()
+    SJust ifj -> case (epochInfoSlotToUTCTime ei sysSt ifj) of
+      Left _ -> failBecause (OutsideForecast ifj) -- error translating slot
+      Right _ -> pure ()
+
   not (Set.null (Alonzo.txins @era txb)) ?!# InputSetEmptyUTxO
 
   feesOK pp tx utxo -- Generalizes the fee to small from earlier Era's
@@ -513,6 +527,8 @@ encFail (FeeContainsNonADA a) =
   Sum FeeContainsNonADA 16 !> To a
 encFail (WrongNetworkInTxBody a b) =
   Sum WrongNetworkInTxBody 17 !> To a !> To b
+encFail (OutsideForecast a) =
+  Sum OutsideForecast 18 !> To a
 
 decFail ::
   ( Era era,
@@ -540,6 +556,7 @@ decFail 14 = SumD ScriptsNotPaidUTxO <! From
 decFail 15 = SumD ExUnitsTooBigUTxO <! From <! From
 decFail 16 = SumD FeeContainsNonADA <! From
 decFail 17 = SumD WrongNetworkInTxBody <! From <! From
+decFail 18 = SumD OutsideForecast <! From
 decFail n = Invalid n
 
 instance

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

@@ -40,7 +40,7 @@ import Cardano.Ledger.Shelley.Constraints (PParamsDelta)
 import qualified Cardano.Ledger.Val as Val
 import Control.Iterate.SetAlgebra (eval, (∪), (⋪), (◁))
 import Control.Monad.Except (MonadError (throwError))
-import Control.Monad.Trans.Reader (runReader)
+import Control.Monad.Trans.Reader (asks, runReader)
 import Control.State.Transition.Extended
 import Data.Coders
 import Data.Foldable (toList)
@@ -54,7 +54,9 @@ import Shelley.Spec.Ledger.BaseTypes
   ( Globals,
     ShelleyBase,
     StrictMaybe (..),
+    epochInfo,
     strictMaybeToMaybe,
+    systemStart,
   )
 import Shelley.Spec.Ledger.LedgerState (PPUPState (..), UTxOState (..), keyRefunds)
 import qualified Shelley.Spec.Ledger.LedgerState as Shelley
@@ -108,6 +110,10 @@ utxosTransition ::
     State (Core.EraRule "PPUP" era) ~ PPUPState era,
     Signal (Core.EraRule "PPUP" era) ~ Maybe (Update era),
     Embed (Core.EraRule "PPUP" era) (UTXOS era),
+    Eq (Core.PParams era),
+    Show (Core.PParams era),
+    Show (PParamsDelta era),
+    Eq (PParamsDelta era),
     Core.TxOut era ~ Alonzo.TxOut era,
     Core.Value era ~ Value (Crypto era),
     Core.TxBody era ~ Alonzo.TxBody era,
@@ -133,6 +139,10 @@ scriptsValidateTransition ::
     State (Core.EraRule "PPUP" era) ~ PPUPState era,
     Signal (Core.EraRule "PPUP" era) ~ Maybe (Update era),
     Embed (Core.EraRule "PPUP" era) (UTXOS era),
+    Eq (Core.PParams era),
+    Show (Core.PParams era),
+    Show (PParamsDelta era),
+    Eq (PParamsDelta era),
     Core.Script era ~ Script era,
     Core.TxBody era ~ Alonzo.TxBody era,
     Core.TxOut era ~ Alonzo.TxOut era,
@@ -161,7 +171,9 @@ scriptsValidateTransition = do
             (toList $ getField @"certs" txb)
         )
           Val.<-> refunded
-  case collectTwoPhaseScriptInputs pp tx utxo of
+  sysSt <- liftSTS $ asks systemStart
+  ei <- liftSTS $ asks epochInfo
+  case collectTwoPhaseScriptInputs ei sysSt pp tx utxo of
     Right sLst ->
       evalScripts @era tx sLst
         ?!# ValidationTagMismatch (getField @"isValidating" tx)
@@ -181,18 +193,30 @@ scriptsValidateTransition = do
 scriptsNotValidateTransition ::
   forall era.
   ( Era era,
+    Eq (Core.PParams era),
+    Show (Core.PParams era),
+    Show (PParamsDelta era),
+    Eq (PParamsDelta era),
+    Environment (Core.EraRule "PPUP" era) ~ PPUPEnv era,
+    State (Core.EraRule "PPUP" era) ~ PPUPState era,
+    Signal (Core.EraRule "PPUP" era) ~ Maybe (Update era),
+    Embed (Core.EraRule "PPUP" era) (UTXOS era),
     Core.Script era ~ Script era,
     Core.TxBody era ~ Alonzo.TxBody era,
     Core.TxOut era ~ Alonzo.TxOut era,
     Core.Value era ~ Value (Crypto era),
     HasField "txinputs_fee" (Core.TxBody era) (Set (TxIn (Crypto era))),
-    HasField "_costmdls" (Core.PParams era) (Map.Map Language CostModel)
+    HasField "_costmdls" (Core.PParams era) (Map.Map Language CostModel),
+    HasField "_keyDeposit" (Core.PParams era) Coin,
+    HasField "_poolDeposit" (Core.PParams era) Coin
   ) =>
   TransitionRule (UTXOS era)
 scriptsNotValidateTransition = do
   TRC (UtxoEnv _ pp _ _, us@(UTxOState utxo _ fees _), tx) <- judgmentContext
   let txb = txbody tx
-  case collectTwoPhaseScriptInputs pp tx utxo of
+  sysSt <- liftSTS $ asks systemStart
+  ei <- liftSTS $ asks epochInfo
+  case collectTwoPhaseScriptInputs ei sysSt pp tx utxo of
     Right sLst ->
       not (evalScripts @era tx sLst)
         ?!# ValidationTagMismatch (getField @"isValidating" tx)
@@ -306,7 +330,7 @@ constructValidated ::
   Core.Tx era ->
   m (UTxOState era, ValidatedTx era)
 constructValidated globals env@(UtxoEnv _ pp _ _) st tx =
-  case collectTwoPhaseScriptInputs pp tx utxo of
+  case collectTwoPhaseScriptInputs ei sysS pp tx utxo of
     Left errs -> throwError [ShouldNeverHappenScriptInputsNotFound errs]
     Right sLst ->
       let scriptEvalResult = evalScripts @era tx sLst
@@ -330,3 +354,5 @@ constructValidated globals env@(UtxoEnv _ pp _ _) st tx =
     runSTS :: STSInterpreter
     runSTS = applySTSInternal AssertionsOff runTransitionRule
     utxo = _utxo st
+    sysS = systemStart globals
+    ei = epochInfo globals

alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs

@@ -34,13 +34,17 @@ import qualified Cardano.Ledger.Mary.Value as Mary (AssetName (..), PolicyID (..
 import Cardano.Ledger.SafeHash
 import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..))
 import Cardano.Ledger.Val (Val (..))
+import Cardano.Slotting.EpochInfo (EpochInfo, epochInfoSlotToUTCTime)
 import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..))
+import Cardano.Slotting.Time (SystemStart)
 import Control.DeepSeq (deepseq)
 import Data.ByteString as BS (ByteString, length)
 import Data.ByteString.Short as SBS (ShortByteString, fromShort)
+import Data.Functor.Identity (Identity, runIdentity)
 import qualified Data.Map as Map
 import Data.Maybe (mapMaybe)
 import qualified Data.Set as Set
+import Data.Time.Clock (UTCTime (..))
 import Data.Typeable (Typeable)
 import GHC.Records (HasField (..))
 import qualified Plutus.V1.Ledger.Ada as P (adaSymbol, adaToken)
@@ -115,8 +119,8 @@ transSafeHash safe = case extractHash safe of UnsafeHash b -> fromShort b
 transHash :: Hash h a -> BS.ByteString
 transHash (UnsafeHash h) = fromShort h
 
-transTxId :: TxId era -> P.TxId
-transTxId (TxId safe) = P.TxId (transSafeHash safe)
+txInfoId :: TxId era -> P.TxId
+txInfoId (TxId safe) = P.TxId (transSafeHash safe)
 
 transStakeCred :: Credential keyrole crypto -> BS.ByteString
 transStakeCred (ScriptHashObj (ScriptHash (UnsafeHash kh))) = (fromShort kh)
@@ -137,34 +141,59 @@ transAddr (AddrBootstrap _bootaddr) = Nothing
 
 -- ===============================
 -- Translate ValidityIntervals
-
-transVI :: ValidityInterval -> P.SlotRange
-transVI (ValidityInterval SNothing SNothing) =
+-- TODO remove this function when we are using transVITime instead
+transVI ::
+  EpochInfo Identity ->
+  SystemStart ->
+  ValidityInterval ->
+  P.SlotRange
+transVI _ _ (ValidityInterval SNothing SNothing) =
   P.Interval
     (P.LowerBound P.NegInf True)
     (P.UpperBound P.PosInf False)
-transVI (ValidityInterval (SJust (SlotNo i)) SNothing) =
+transVI _ _ (ValidityInterval (SJust (SlotNo i)) SNothing) =
   P.Interval
     (P.LowerBound (P.Finite (fromIntegral i)) True)
     (P.UpperBound P.PosInf False)
-transVI (ValidityInterval SNothing (SJust (SlotNo i))) =
+transVI _ _ (ValidityInterval SNothing (SJust (SlotNo i))) =
   P.Interval
     (P.LowerBound P.NegInf True)
     (P.UpperBound (P.Finite (fromIntegral i)) False)
-transVI (ValidityInterval (SJust (SlotNo i)) (SJust (SlotNo j))) =
+transVI _ _ (ValidityInterval (SJust (SlotNo i)) (SJust (SlotNo j))) =
   P.Interval
     (P.LowerBound (P.Finite (fromIntegral i)) True)
     (P.UpperBound (P.Finite (fromIntegral j)) False)
 
+-- ===============================
+-- Translate ValidityIntervals to UTCTime
+
+data TimeInterval = TimeInterval (StrictMaybe UTCTime) (StrictMaybe UTCTime)
+
+-- | translate a validity interval to a UTCTime interval
+-- | TODO use this function instead of transVI
+transVITime ::
+  EpochInfo Identity ->
+  SystemStart ->
+  ValidityInterval ->
+  TimeInterval
+transVITime _ _ (ValidityInterval SNothing SNothing) =
+  TimeInterval SNothing SNothing
+transVITime ei sysS (ValidityInterval (SJust i) SNothing) =
+  TimeInterval (SJust (runIdentity $ epochInfoSlotToUTCTime ei sysS i)) SNothing
+transVITime ei sysS (ValidityInterval SNothing (SJust i)) =
+  TimeInterval SNothing (SJust (runIdentity $ epochInfoSlotToUTCTime ei sysS i))
+transVITime ei sysS (ValidityInterval (SJust i) (SJust j)) =
+  TimeInterval (SJust (runIdentity $ epochInfoSlotToUTCTime ei sysS i)) (SJust (runIdentity $ epochInfoSlotToUTCTime ei sysS j))
+
 -- ========================================
 -- translate TxIn and TxOut
 
-transTxIn' :: CC.Crypto c => TxIn c -> P.TxOutRef
-transTxIn' (TxIn txid nat) = P.TxOutRef (transTxId txid) (fromIntegral nat)
+txInfoIn' :: CC.Crypto c => TxIn c -> P.TxOutRef
+txInfoIn' (TxIn txid nat) = P.TxOutRef (txInfoId txid) (fromIntegral nat)
 
 -- | Given a TxIn, look it up in the UTxO. If it exists, translate it and return
 --   (Just translation). If does not exist in the UTxO, return Nothing.
-transTxIn ::
+txInfoIn ::
   forall era.
   ( Era era,
     Value era ~ Mary.Value (Crypto era),
@@ -173,11 +202,11 @@ transTxIn ::
   UTxO era ->
   TxIn (Crypto era) ->
   Maybe (P.TxInInfo)
-transTxIn (UTxO mp) txin =
+txInfoIn (UTxO mp) txin =
   case Map.lookup txin mp of
     Nothing -> Nothing
     Just txout -> case (transAddr addr) of
-      Just ad -> Just (P.TxInInfo (transTxIn' txin) (P.TxOut ad valout dhash))
+      Just ad -> Just (P.TxInInfo (txInfoIn' txin) (P.TxOut ad valout dhash))
       Nothing -> Nothing
       where
         valout = transValue (getField @"value" txout)
@@ -189,14 +218,14 @@ transTxIn (UTxO mp) txin =
 -- | Given a TxOut, translate it and return (Just transalation). It is
 --   possible the address part is a Bootstrap Address, in that case return Nothing
 --   I.e. don't include Bootstrap Addresses in the answer.
-transTxOut ::
+txInfoOut ::
   forall era.
   ( Era era,
     Value era ~ Mary.Value (Crypto era)
   ) =>
   Alonzo.TxOut era ->
   Maybe (P.TxOut)
-transTxOut (Alonzo.TxOut addr val datahash) =
+txInfoOut (Alonzo.TxOut addr val datahash) =
   case (transAddr addr) of
     Just ad -> Just (P.TxOut ad (transValue @(Crypto era) val) (transDataHash datahash))
     Nothing -> Nothing
@@ -260,15 +289,15 @@ transExUnits (ExUnits mem steps) = P.ExBudget (P.ExCPU (fromIntegral steps)) (P.
 
 transScriptPurpose :: CC.Crypto crypto => ScriptPurpose crypto -> P.ScriptPurpose
 transScriptPurpose (Minting policyid) = P.Minting (transPolicyID policyid)
-transScriptPurpose (Spending txin) = P.Spending (transTxIn' txin)
+transScriptPurpose (Spending txin) = P.Spending (txInfoIn' txin)
 transScriptPurpose (Rewarding (RewardAcnt _network cred)) = P.Rewarding (P.StakingHash (transStakeCred cred))
 transScriptPurpose (Certifying dcert) = P.Certifying (transDCert dcert)
 
 -- ===================================
 
 -- | Compute a Digest of the current transaction to pass to the script
 --   This is the major component of the valContext function.
-transTx ::
+txInfo ::
   forall era tx.
   ( Era era,
     Core.TxOut era ~ Alonzo.TxOut era,
@@ -277,19 +306,21 @@ transTx ::
     HasField "body" tx (Core.TxBody era),
     HasField "wits" tx (TxWitness era)
   ) =>
+  EpochInfo Identity ->
+  SystemStart ->
   UTxO era ->
   tx ->
   P.TxInfo
-transTx utxo tx =
+txInfo ei sysS utxo tx =
   P.TxInfo
-    { P.txInfoInputs = mapMaybe (transTxIn utxo) (Set.toList (inputs' tbody)),
-      P.txInfoInputsFees = mapMaybe (transTxIn utxo) (Set.toList (inputs_fee' tbody)),
-      P.txInfoOutputs = mapMaybe transTxOut (foldr (:) [] outs),
+    { P.txInfoInputs = mapMaybe (txInfoIn utxo) (Set.toList (inputs' tbody)),
+      P.txInfoInputsFees = mapMaybe (txInfoIn utxo) (Set.toList (inputs_fee' tbody)),
+      P.txInfoOutputs = mapMaybe txInfoOut (foldr (:) [] outs),
       P.txInfoFee = (transValue (inject @(Mary.Value (Crypto era)) fee)),
       P.txInfoForge = (transValue forge),
       P.txInfoDCert = (foldr (\c ans -> transDCert c : ans) [] (certs' tbody)),
       P.txInfoWdrl = Map.toList (transWdrl (wdrls' tbody)),
-      P.txInfoValidRange = (transVI interval),
+      P.txInfoValidRange = (transVI ei sysS interval), -- TODO replace with transVITime when possible
       P.txInfoSignatories = map transKeyHash (Set.toList (reqSignerHashes' tbody)),
       P.txInfoData = (map transDataPair datpairs),
       P.txInfoId = (P.TxId (transSafeHash (hashAnnotated @(Crypto era) tbody)))