Merge pull request #2379 from input-output-hk/nc/alonzo-tx

Redesign of Tx/TxInBlock

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

@@ -32,10 +32,9 @@ import Cardano.Ledger.Alonzo.PParams
   )
 import qualified Cardano.Ledger.Alonzo.Rules.Bbody as Alonzo (AlonzoBBODY)
 import qualified Cardano.Ledger.Alonzo.Rules.Ledger as Alonzo (AlonzoLEDGER)
-import Cardano.Ledger.Alonzo.Rules.Utxo (UtxoPredicateFailure (UtxosFailure), utxoEntrySize)
+import Cardano.Ledger.Alonzo.Rules.Utxo (utxoEntrySize)
 import qualified Cardano.Ledger.Alonzo.Rules.Utxo as Alonzo (AlonzoUTXO)
-import qualified Cardano.Ledger.Alonzo.Rules.Utxos as Alonzo (UTXOS, constructValidated, lbl2Phase)
-import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoPredFail (WrappedShelleyEraFailure))
+import qualified Cardano.Ledger.Alonzo.Rules.Utxos as Alonzo (UTXOS)
 import qualified Cardano.Ledger.Alonzo.Rules.Utxow as Alonzo (AlonzoUTXOW)
 import Cardano.Ledger.Alonzo.Scripts (Script (..), isPlutusScript)
 import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..), minfee)
@@ -53,7 +52,6 @@ import Cardano.Ledger.Keys (GenDelegs (GenDelegs))
 import qualified Cardano.Ledger.Mary.Value as V (Value)
 import Cardano.Ledger.Rules.ValidationMode
   ( applySTSNonStatic,
-    applySTSValidateSuchThat,
   )
 import Cardano.Ledger.SafeHash (hashAnnotated)
 import Cardano.Ledger.Shelley (nativeMultiSigTag)
@@ -64,10 +62,9 @@ import Cardano.Ledger.Shelley.Constraints
   )
 import Cardano.Ledger.ShelleyMA.Rules.Utxo (consumed)
 import Cardano.Ledger.ShelleyMA.Timelocks (validateTimelock)
-import Cardano.Ledger.Tx (Tx (Tx))
 import Cardano.Ledger.Val (Val (inject), coin, (<->))
 import Control.Arrow (left)
-import Control.Monad.Except (liftEither, runExcept)
+import Control.Monad.Except (liftEither)
 import Control.Monad.Reader (runReader)
 import Control.State.Transition.Extended (TRC (TRC))
 import Data.Default (def)
@@ -85,17 +82,10 @@ import Shelley.Spec.Ledger.LedgerState
     LedgerState (..),
     NewEpochState (..),
     UTxOState (..),
-    _dstate,
     _genDelegs,
-    _pParams,
-    _pstate,
   )
 import Shelley.Spec.Ledger.Metadata (validMetadatum)
 import qualified Shelley.Spec.Ledger.STS.Epoch as Shelley
-import Shelley.Spec.Ledger.STS.Ledger
-  ( LedgerEnv (..),
-    LedgerPredicateFailure (UtxowFailure),
-  )
 import qualified Shelley.Spec.Ledger.STS.Mir as Shelley
 import qualified Shelley.Spec.Ledger.STS.Newpp as Shelley
 import qualified Shelley.Spec.Ledger.STS.Ocert as Shelley
@@ -104,7 +94,6 @@ import qualified Shelley.Spec.Ledger.STS.Rupd as Shelley
 import qualified Shelley.Spec.Ledger.STS.Snap as Shelley
 import qualified Shelley.Spec.Ledger.STS.Tick as Shelley
 import qualified Shelley.Spec.Ledger.STS.Upec as Shelley
-import Shelley.Spec.Ledger.STS.Utxow (UtxowPredicateFailure (UtxoFailure))
 import qualified Shelley.Spec.Ledger.Tx as Shelley
 import Shelley.Spec.Ledger.UTxO (balance)
 
@@ -122,49 +111,14 @@ instance
   type Crypto (AlonzoEra c) = c
 
 instance API.PraosCrypto c => API.ApplyTx (AlonzoEra c) where
-  applyTx globals env@(LedgerEnv slot _ix pp _accnt) st@(utxostate, dpstate) tx =
-    do
-      vtx <-
-        liftEither
-          . left
-            ( API.ApplyTxError
-                . fmap
-                  ( UtxowFailure
-                      . WrappedShelleyEraFailure
-                      . UtxoFailure
-                      . UtxosFailure
-                  )
-            )
-          . runExcept
-          $ Alonzo.constructValidated globals utxoenv utxostate tx
-      -- Note here that we exclude checks of 2-phase validation, since we have
-      -- just constructed our own validating flag and can hence trust it! Other
-      -- static checks must be run, however, since we haven't computed them
-      -- before.
-      state' <-
-        liftEither
-          . left API.ApplyTxError
-          . flip runReader globals
-          . applySTSValidateSuchThat
-            @(Core.EraRule "LEDGER" (AlonzoEra c))
-            (notElem Alonzo.lbl2Phase)
-          $ TRC (env, st, vtx)
-      pure (state', vtx)
-    where
-      delegs = (_genDelegs . _dstate) dpstate
-      stake = (_pParams . _pstate) dpstate
-      utxoenv = API.UtxoEnv slot pp stake delegs
-
-  applyTxInBlock globals env state tx =
+  reapplyTx globals env state vtx =
     let res =
           flip runReader globals
             . applySTSNonStatic
               @(Core.EraRule "LEDGER" (AlonzoEra c))
-            $ TRC (env, state, tx)
+            $ TRC (env, state, API.extractTx vtx)
      in liftEither . left API.ApplyTxError $ res
 
-  extractTx ValidatedTx {body = b, wits = w, auxiliaryData = a} = Tx b w a
-
 instance API.PraosCrypto c => API.ApplyBlock (AlonzoEra c)
 
 instance (API.PraosCrypto c) => API.GetLedgerView (AlonzoEra c)
@@ -230,13 +184,15 @@ instance CC.Crypto c => API.CLI (AlonzoEra c) where
 
   evaluateConsumed = consumed
 
-  addKeyWitnesses (Tx b ws aux) newWits = Tx b ws' aux
+  addKeyWitnesses (ValidatedTx b ws aux iv) newWits = ValidatedTx b ws' aux iv
     where
       ws' = ws {txwitsVKey = Set.union newWits (txwitsVKey ws)}
 
   evaluateMinLovelaceOutput pp out =
     Coin $ utxoEntrySize out * unCoin (_coinsPerUTxOWord pp)
 
+type instance Core.Tx (AlonzoEra c) = ValidatedTx (AlonzoEra c)
+
 type instance Core.TxOut (AlonzoEra c) = TxOut (AlonzoEra c)
 
 type instance Core.TxBody (AlonzoEra c) = TxBody (AlonzoEra c)
@@ -266,7 +222,6 @@ instance CC.Crypto c => ValidateAuxiliaryData (AlonzoEra c) c where
 
 instance CC.Crypto c => EraModule.SupportsSegWit (AlonzoEra c) where
   type TxSeq (AlonzoEra c) = Alonzo.TxSeq (AlonzoEra c)
-  type TxInBlock (AlonzoEra c) = ValidatedTx (AlonzoEra c)
   fromTxSeq = Alonzo.txSeqTxns
   toTxSeq = Alonzo.TxSeq
   hashTxSeq = Alonzo.hashTxSeq

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

@@ -28,7 +28,7 @@ import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo (TxSeq)
 import Cardano.Ledger.Alonzo.TxWitness (TxWitness)
 import Cardano.Ledger.BaseTypes (ShelleyBase, UnitInterval, epochInfo)
 import qualified Cardano.Ledger.Core as Core
-import Cardano.Ledger.Era (Era (Crypto), SupportsSegWit (..), TxInBlock)
+import Cardano.Ledger.Era (Era (Crypto), SupportsSegWit (..))
 import qualified Cardano.Ledger.Era as Era
 import Cardano.Ledger.Keys (DSignable, Hash, coerceKeyRole)
 import Cardano.Ledger.Slot (epochInfoEpoch, epochInfoFirst)
@@ -139,13 +139,13 @@ bbodyTransition ::
     Embed (Core.EraRule "LEDGERS" era) (someBBODY era),
     Environment (Core.EraRule "LEDGERS" era) ~ LedgersEnv era,
     State (Core.EraRule "LEDGERS" era) ~ LedgerState era,
-    Signal (Core.EraRule "LEDGERS" era) ~ Seq (TxInBlock era),
+    Signal (Core.EraRule "LEDGERS" era) ~ Seq (Core.Tx era),
     -- Conditions to define the rule in this Era
     HasField "_d" (Core.PParams era) UnitInterval,
     HasField "_maxBlockExUnits" (Core.PParams era) ExUnits,
     Era era, -- supplies WellFormed HasField, and Crypto constraints
     Era.TxSeq era ~ Alonzo.TxSeq era,
-    Era.TxInBlock era ~ Alonzo.ValidatedTx era,
+    Core.Tx era ~ Alonzo.ValidatedTx era,
     Core.Witnesses era ~ TxWitness era
   ) =>
   TransitionRule (someBBODY era)
@@ -212,11 +212,11 @@ instance
     State (Core.EraRule "LEDGERS" era) ~ LedgerState era,
     Signal (Core.EraRule "LEDGERS" era) ~ Seq (Alonzo.ValidatedTx era),
     Era era,
-    TxInBlock era ~ Alonzo.ValidatedTx era,
+    Core.Tx era ~ Alonzo.ValidatedTx era,
     HasField "_d" (Core.PParams era) UnitInterval,
     HasField "_maxBlockExUnits" (Core.PParams era) ExUnits,
     Era.TxSeq era ~ Alonzo.TxSeq era,
-    Era.TxInBlock era ~ Alonzo.ValidatedTx era,
+    Core.Tx era ~ Alonzo.ValidatedTx era,
     Core.Witnesses era ~ TxWitness era,
     SupportsSegWit era
   ) =>

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

@@ -26,7 +26,7 @@ import Cardano.Ledger.Alonzo.Tx (IsValidating (..), ValidatedTx (..))
 import Cardano.Ledger.BaseTypes (ShelleyBase)
 import Cardano.Ledger.Coin (Coin)
 import qualified Cardano.Ledger.Core as Core
-import Cardano.Ledger.Era (Crypto, Era, TxInBlock)
+import Cardano.Ledger.Era (Crypto, Era)
 import Cardano.Ledger.Keys (DSignable, Hash)
 import Control.State.Transition
   ( Assertion (..),
@@ -68,7 +68,7 @@ data AlonzoLEDGER era
 --   make it concrete. Depends only on the "certs" and "isValidating" HasField instances.
 ledgerTransition ::
   forall (someLEDGER :: Type -> Type) era.
-  ( Signal (someLEDGER era) ~ TxInBlock era,
+  ( Signal (someLEDGER era) ~ Core.Tx era,
     State (someLEDGER era) ~ (UTxOState era, DPState (Crypto era)),
     Environment (someLEDGER era) ~ LedgerEnv era,
     Embed (Core.EraRule "UTXOW" era) (someLEDGER era),
@@ -78,9 +78,9 @@ ledgerTransition ::
     Signal (Core.EraRule "DELEGS" era) ~ Seq (DCert (Crypto era)),
     Environment (Core.EraRule "UTXOW" era) ~ UtxoEnv era,
     State (Core.EraRule "UTXOW" era) ~ UTxOState era,
-    Signal (Core.EraRule "UTXOW" era) ~ TxInBlock era,
+    Signal (Core.EraRule "UTXOW" era) ~ Core.Tx era,
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
-    HasField "isValidating" (TxInBlock era) IsValidating,
+    HasField "isValidating" (Core.Tx era) IsValidating,
     Era era
   ) =>
   TransitionRule (someLEDGER era)
@@ -121,7 +121,7 @@ instance
     Show (Core.PParamsDelta era),
     DSignable (Crypto era) (Hash (Crypto era) EraIndependentTxBody),
     Era era,
-    TxInBlock era ~ ValidatedTx era,
+    Core.Tx era ~ ValidatedTx era,
     Embed (Core.EraRule "DELEGS" era) (AlonzoLEDGER era),
     Embed (Core.EraRule "UTXOW" era) (AlonzoLEDGER era),
     Environment (Core.EraRule "UTXOW" era) ~ UtxoEnv era,

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

@@ -46,7 +46,7 @@ import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Coin
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Credential (Credential (..))
-import Cardano.Ledger.Era (Crypto, Era, TxInBlock, ValidateScript (..))
+import Cardano.Ledger.Era (Crypto, Era, ValidateScript (..))
 import qualified Cardano.Ledger.Era as Era
 import qualified Cardano.Ledger.Mary.Value as Alonzo (Value)
 import Cardano.Ledger.Rules.ValidationMode ((?!#))
@@ -257,7 +257,7 @@ feesOK ::
   ( Era era,
     ValidateScript era, -- isTwoPhaseScriptAddress
     Core.TxOut era ~ Alonzo.TxOut era, -- balance requires this,
-    Era.TxInBlock era ~ Alonzo.ValidatedTx era,
+    Core.Tx era ~ Alonzo.ValidatedTx era,
     Core.Witnesses era ~ TxWitness era,
     HasField
       "collateral" -- to get inputs to pay the fees
@@ -269,7 +269,7 @@ feesOK ::
     HasField "_collateralPercentage" (Core.PParams era) Natural
   ) =>
   Core.PParams era ->
-  TxInBlock era ->
+  Core.Tx era ->
   UTxO era ->
   Rule (AlonzoUTXO era) 'Transition ()
 feesOK pp tx (UTxO m) = do
@@ -310,7 +310,7 @@ utxoTransition ::
     Embed (Core.EraRule "UTXOS" era) (AlonzoUTXO era),
     Environment (Core.EraRule "UTXOS" era) ~ Shelley.UtxoEnv era,
     State (Core.EraRule "UTXOS" era) ~ Shelley.UTxOState era,
-    Signal (Core.EraRule "UTXOS" era) ~ TxInBlock era,
+    Signal (Core.EraRule "UTXOS" era) ~ Core.Tx era,
     -- We leave Core.PParams abstract
     UsesPParams era,
     HasField "_minfeeA" (Core.PParams era) Natural,
@@ -325,11 +325,11 @@ utxoTransition ::
     HasField "_collateralPercentage" (Core.PParams era) Natural,
     HasField "_maxCollateralInputs" (Core.PParams era) Natural,
     -- We fix Core.Tx, Core.Value, Core.TxBody, and Core.TxOut
+    Core.Tx era ~ Alonzo.ValidatedTx era,
     Core.TxOut era ~ Alonzo.TxOut era,
     Core.Value era ~ Alonzo.Value (Crypto era),
     Core.TxBody era ~ Alonzo.TxBody era,
     Core.Witnesses era ~ TxWitness era,
-    TxInBlock era ~ Alonzo.ValidatedTx era,
     Era.TxSeq era ~ Alonzo.TxSeq era
   ) =>
   TransitionRule (AlonzoUTXO era)
@@ -493,7 +493,7 @@ instance
     Core.Witnesses era ~ TxWitness era,
     Core.TxOut era ~ Alonzo.TxOut era,
     Era.TxSeq era ~ Alonzo.TxSeq era,
-    Era.TxInBlock era ~ Alonzo.ValidatedTx era
+    Core.Tx era ~ Alonzo.ValidatedTx era
   ) =>
   STS (AlonzoUTXO era)
   where

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

@@ -41,7 +41,7 @@ import Cardano.Ledger.BaseTypes
   )
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Credential (Credential (KeyHashObj))
-import Cardano.Ledger.Era (Crypto, Era, SupportsSegWit (..), ValidateScript (..))
+import Cardano.Ledger.Era (Crypto, Era, ValidateScript (..))
 import Cardano.Ledger.Keys (GenDelegs, KeyHash, KeyRole (..), asWitness)
 import Cardano.Ledger.Rules.ValidationMode ((?!#))
 import Control.DeepSeq (NFData (..))
@@ -220,7 +220,7 @@ alonzoStyleWitness ::
   forall era utxow.
   ( Era era,
     -- Fix some Core types to the Alonzo Era
-    TxInBlock era ~ ValidatedTx era, -- scriptsNeeded, checkScriptData etc. are fixed at Alonzo.Tx
+    Core.Tx era ~ ValidatedTx era, -- scriptsNeeded, checkScriptData etc. are fixed at Alonzo.Tx
     Core.PParams era ~ PParams era,
     Core.Script era ~ Script era,
     -- Allow UTXOW to call UTXO
@@ -251,7 +251,7 @@ alonzoStyleWitness = do
   {-  txw := txwits tx  -}
   {-  witsKeyHashes := { hashKey vk | vk ∈ dom(txwitsVKey txw) }  -}
   let utxo = _utxo u'
-      txbody = getField @"body" (tx :: TxInBlock era)
+      txbody = getField @"body" (tx :: Core.Tx era)
       witsKeyHashes = unWitHashes $ witsFromTxWitnesses @era tx
 
   {-  { h | (_ → (a,_,h)) ∈ txins tx ◁ utxo, isNonNativeScriptAddress tx a} = dom(txdats txw)   -}
@@ -418,7 +418,7 @@ data AlonzoUTXOW era
 instance
   forall era.
   ( -- Fix some Core types to the Alonzo Era
-    TxInBlock era ~ ValidatedTx era,
+    Core.Tx era ~ ValidatedTx era,
     Core.PParams era ~ PParams era,
     Core.Script era ~ Script era,
     -- Allow UTXOW to call UTXO

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

@@ -20,7 +20,7 @@ import Cardano.Ledger.Alonzo.Scripts
     ExUnits (..),
     Script (..),
   )
-import Cardano.Ledger.Alonzo.Tx (DataHash, ScriptPurpose (Spending), rdptr)
+import Cardano.Ledger.Alonzo.Tx (DataHash, ScriptPurpose (Spending), ValidatedTx (..), rdptr)
 import Cardano.Ledger.Alonzo.TxBody (TxOut (..))
 import Cardano.Ledger.Alonzo.TxInfo (txInfo, valContext)
 import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr (..), unRedeemers, unTxDats)

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

@@ -36,9 +36,7 @@ import Cardano.Ledger.Era
     TranslationContext,
     translateEra',
   )
-import qualified Cardano.Ledger.Era as Era
 import Cardano.Ledger.Mary (MaryEra)
-import qualified Cardano.Ledger.Tx as LTX
 import Control.Monad.Except (Except, throwError)
 import Data.Coders
 import Data.Text (Text)
@@ -50,6 +48,7 @@ import Shelley.Spec.Ledger.API
   )
 import qualified Shelley.Spec.Ledger.API as API
 import qualified Shelley.Spec.Ledger.PParams as Shelley
+import qualified Shelley.Spec.Ledger.Tx as LTX
 import qualified Shelley.Spec.Ledger.TxBody as Shelley
 
 --------------------------------------------------------------------------------
@@ -86,13 +85,6 @@ instance
           nesPd = nesPd nes
         }
 
-instance Crypto c => TranslateEra (AlonzoEra c) Core.Tx where
-  type TranslationError (AlonzoEra c) Core.Tx = DecoderError
-  translateEra _ctx tx =
-    case decodeAnnotator "tx" fromCBOR (serialize tx) of
-      Right newTx -> pure newTx
-      Left decoderError -> throwError decoderError
-
 instance Crypto c => TranslateEra (AlonzoEra c) ShelleyGenesis where
   translateEra ctxt genesis =
     return
@@ -114,16 +106,16 @@ instance Crypto c => TranslateEra (AlonzoEra c) ShelleyGenesis where
           API.sgStaking = API.sgStaking genesis
         }
 
-newtype TxInBlock era = TxInBlock {unTxInBlock :: (Era.TxInBlock era)}
+newtype Tx era = Tx {unTx :: Core.Tx era}
 
 instance
   ( Crypto c,
-    Era.TxInBlock (AlonzoEra c) ~ ValidatedTx (AlonzoEra c)
+    Core.Tx (AlonzoEra c) ~ ValidatedTx (AlonzoEra c)
   ) =>
-  TranslateEra (AlonzoEra c) TxInBlock
+  TranslateEra (AlonzoEra c) Tx
   where
-  type TranslationError (AlonzoEra c) TxInBlock = DecoderError
-  translateEra _ctxt (TxInBlock tx) = do
+  type TranslationError (AlonzoEra c) Tx = DecoderError
+  translateEra _ctxt (Tx tx) = do
     -- Note that this does not preserve the hidden bytes field of the transaction.
     -- This is under the premise that this is irrelevant for TxInBlocks, which are
     -- not transmitted as contiguous chunks.
@@ -134,7 +126,7 @@ instance
       SNothing -> pure SNothing
       SJust axd -> SJust <$> translateViaCBORAnn "auxiliarydata" axd
     let validating = IsValidating True
-    pure $ TxInBlock $ ValidatedTx bdy txwits validating aux
+    pure $ Tx $ ValidatedTx bdy txwits validating aux
 
 --------------------------------------------------------------------------------
 -- Auxiliary instances and functions