test time translation

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

@@ -86,6 +86,8 @@ import Shelley.Spec.Ledger.BaseTypes
     ShelleyBase,
     StrictMaybe (..),
     networkId,
+    epochInfoActual,
+    systemStart
   )
 import qualified Shelley.Spec.Ledger.LedgerState as Shelley
 import qualified Shelley.Spec.Ledger.STS.Utxo as Shelley
@@ -97,6 +99,7 @@ import Shelley.Spec.Ledger.UTxO
     txouts,
     unUTxO,
   )
+import Cardano.Slotting.EpochInfo.API (epochInfoSlotToUTCTime)
 
 -- | Compute an estimate of the size of storing one UTxO entry.
 -- This function implements the UTxO entry size estimate done by scaledMinDeposit in the ShelleyMA era
@@ -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 epochInfoActual
+  case i_f of
+    SNothing -> pure ()
+    SJust ifj -> case (epochInfoSlotToUTCTime ei sysSt ifj) of
+      Right _ -> pure ()
+      Left _ -> False ?!# OutsideForecast ifj -- error translating slot
+
   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

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Wallet.hs

@@ -43,7 +43,7 @@ import GHC.Records (HasField, getField)
 import Numeric.Natural (Natural)
 import Shelley.Spec.Ledger.API.Protocol (ChainDepState (..))
 import Shelley.Spec.Ledger.Address (Addr (..))
-import Shelley.Spec.Ledger.BaseTypes (Globals (..), Seed, UnitInterval)
+import Shelley.Spec.Ledger.BaseTypes (Globals (..), Seed, UnitInterval, epochInfo)
 import Shelley.Spec.Ledger.BlockChain (checkLeaderValue, mkSeed, seedL)
 import Shelley.Spec.Ledger.CompactAddr (CompactAddr, compactAddr)
 import Shelley.Spec.Ledger.Credential (Credential (..))

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/BaseTypes.hs

@@ -11,6 +11,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -Wno-orphans #-} -- temporary, until Nick's cardano-base PR is in
 
 module Shelley.Spec.Ledger.BaseTypes
   ( FixedPoint,
@@ -50,6 +51,7 @@ module Shelley.Spec.Ledger.BaseTypes
 
     -- * STS Base
     Globals (..),
+    epochInfo,
     ShelleyBase,
   )
 where
@@ -67,6 +69,7 @@ import qualified Cardano.Crypto.VRF as VRF
 import Cardano.Prelude (NFData, cborError)
 import Cardano.Slotting.EpochInfo
 import Cardano.Slotting.Time (SystemStart)
+import Control.Exception (throw)
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Binary.Put as B
@@ -87,6 +90,7 @@ import NoThunks.Class (NoThunks (..))
 import Numeric.Natural (Natural)
 import Shelley.Spec.Ledger.Serialization (decodeRecordSum, ratioFromCBOR, ratioToCBOR)
 import Shelley.Spec.NonIntegral (ln')
+import GHC.Exception.Type (Exception)
 
 data E34
 
@@ -319,7 +323,7 @@ activeSlotLog f = (fromIntegral $ unActiveSlotLog f) / fpPrecision
 --------------------------------------------------------------------------------
 
 data Globals = Globals
-  { epochInfo :: !(EpochInfo Identity),
+  { epochInfoActual :: !(EpochInfo (Either Text)),
     slotsPerKESPeriod :: !Word64,
     -- | The window size in which our chosen chain growth property
     --   guarantees at least k blocks. From the paper
@@ -354,6 +358,18 @@ instance NoThunks Globals
 
 type ShelleyBase = ReaderT Globals Identity
 
+epochInfo :: Globals -> EpochInfo Identity
+epochInfo = (hoistEpochInfo (either throw pure)) . epochInfoActual
+
+-- TEMPORARY, until Nick's cardano-base PR is in
+-- | Unhelpful instance, but this type occurs in records (eg @Shelley.Globals@)
+-- that we want to be able to 'show'
+instance Show (EpochInfo f) where
+  showsPrec _ _ = undefined
+
+-- TEMPORARY, until Nick's cardano-base PR is in
+deriving instance Exception Text
+
 data Network
   = Testnet
   | Mainnet

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Genesis.hs

@@ -44,7 +44,6 @@ import Cardano.Slotting.Slot (EpochSize (..))
 import Cardano.Slotting.Time (SystemStart (SystemStart))
 import Data.Aeson (FromJSON (..), ToJSON (..), (.!=), (.:), (.:?), (.=))
 import qualified Data.Aeson as Aeson
-import Data.Functor.Identity (Identity)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (catMaybes)
@@ -428,13 +427,13 @@ validateGenesis
 
 mkShelleyGlobals ::
   ShelleyGenesis era ->
-  EpochInfo Identity ->
+  EpochInfo (Either Text) ->
   Natural ->
   Globals
-mkShelleyGlobals genesis epochInfo maxMajorPV =
+mkShelleyGlobals genesis epochInfoAc maxMajorPV =
   Globals
     { activeSlotCoeff = sgActiveSlotCoeff genesis,
-      epochInfo = epochInfo,
+      epochInfoActual = epochInfoAc,
       maxKESEvo = sgMaxKESEvolutions genesis,
       maxLovelaceSupply = sgMaxLovelaceSupply genesis,
       maxMajorPV = maxMajorPV,

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Deleg.hs

@@ -41,6 +41,7 @@ import Shelley.Spec.Ledger.BaseTypes
   ( Globals (..),
     ShelleyBase,
     invalidKey,
+    epochInfo
   )
 import Shelley.Spec.Ledger.Credential (Credential)
 import Shelley.Spec.Ledger.HardForks as HardForks

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Pool.hs

@@ -44,7 +44,7 @@ import Data.Word (Word64, Word8)
 import GHC.Generics (Generic)
 import GHC.Records (HasField (getField))
 import NoThunks.Class (NoThunks (..))
-import Shelley.Spec.Ledger.BaseTypes (Globals (..), Network, ShelleyBase, invalidKey, networkId)
+import Shelley.Spec.Ledger.BaseTypes (Globals (..), Network, ShelleyBase, invalidKey, networkId, epochInfo)
 import qualified Shelley.Spec.Ledger.HardForks as HardForks
 import Shelley.Spec.Ledger.Keys (KeyHash (..), KeyRole (..))
 import Shelley.Spec.Ledger.LedgerState (PState (..))

shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Utils.hs

@@ -124,6 +124,7 @@ import Shelley.Spec.Ledger.BaseTypes
     mkActiveSlotCoeff,
     mkNonceFromOutputVRF,
     mkUnitInterval,
+    epochInfo,
   )
 import Shelley.Spec.Ledger.BlockChain (BHBody (..), Block, TxSeq, bhbody, bheader)
 import Shelley.Spec.Ledger.Credential (Credential (..), StakeReference (..))
@@ -298,7 +299,7 @@ unsafeMkUnitInterval r =
 testGlobals :: Globals
 testGlobals =
   Globals
-    { epochInfo = fixedEpochInfo (EpochSize 100) (mkSlotLength 1),
+    { epochInfoActual = fixedEpochInfo (EpochSize 100) (mkSlotLength 1),
       slotsPerKESPeriod = 20,
       stabilityWindow = 33,
       randomnessStabilisationWindow = 33,

shelley/chain-and-ledger/shelley-spec-ledger-test/test/Test/Shelley/Spec/Ledger/Rules/ClassifyTraces.hs

@@ -56,7 +56,7 @@ import Shelley.Spec.Ledger.API
     Delegation (..),
     LEDGER,
   )
-import Shelley.Spec.Ledger.BaseTypes (Globals (epochInfo), StrictMaybe (..))
+import Shelley.Spec.Ledger.BaseTypes (epochInfo, StrictMaybe (..))
 import Shelley.Spec.Ledger.BlockChain
   ( Block (..),
     TxSeq (..),