Alonzo Tx/TxInBlock separation.

This commit updates Alonzo to reflect the separation between Tx and TxInBlock, and to implement 'SupportsSegWit'. - Introduce a new Alonzo 'TxSeq' type along with the relevant serialisation, hashing, and functions to convert to a sequence of 'ValidatedTx'. - Modify existing code to make use of this. Note that this commit requires dropping some of the API instances for Alonzo; this is understandable, since those interfaces are now incorrect (they do not reflect the difference between Tx and TxInBlock). A subsequent PR will update the API to reflect the new view on the world.
IntersectMBO · Apr 8, 2021 · c61240b · c61240b
1 parent 7c6ee66
commit c61240b
Show file tree

Hide file tree

Showing 14 changed files with 478 additions and 145 deletions.
diff --git a/alonzo/impl/cardano-ledger-alonzo.cabal b/alonzo/impl/cardano-ledger-alonzo.cabal
@@ -46,6 +46,7 @@ library
     Cardano.Ledger.Alonzo.Tx
     Cardano.Ledger.Alonzo.TxBody
     Cardano.Ledger.Alonzo.TxInfo
+    Cardano.Ledger.Alonzo.TxSeq
     Cardano.Ledger.Alonzo.TxWitness
     Cardano.Ledger.DescribeEras
   build-depends:

diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo.hs
@@ -17,19 +17,30 @@ module Cardano.Ledger.Alonzo
     AuxiliaryData,
     PParams,
     PParamsDelta,
-    Tx,
   )
 where
 
 import Cardano.Ledger.Alonzo.Data (AuxiliaryData (..), getPlutusData)
-import Cardano.Ledger.Alonzo.PParams (PParams, PParams' (..), PParamsUpdate, updatePParams)
+import Cardano.Ledger.Alonzo.PParams
+  ( PParams,
+    PParams' (..),
+    PParamsUpdate,
+    updatePParams,
+  )
+import qualified Cardano.Ledger.Alonzo.Rules.Bbody as Alonzo (AlonzoBBODY)
+import qualified Cardano.Ledger.Alonzo.Rules.Ledger as Alonzo (AlonzoLEDGER)
 import qualified Cardano.Ledger.Alonzo.Rules.Utxo as Alonzo (AlonzoUTXO)
 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 (IsValidating (..), Tx, alonzoSeqTx, body', isValidating', wits')
+import Cardano.Ledger.Alonzo.Tx
+  ( ValidatedTx,
+    body',
+    wits',
+  )
 import Cardano.Ledger.Alonzo.TxBody (TxBody, TxOut (..), vldt')
 import Cardano.Ledger.Alonzo.TxInfo (validPlutusdata, validScript)
+import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo (TxSeq (..), hashTxSeq)
 import Cardano.Ledger.Alonzo.TxWitness (TxWitness (txwitsVKey'))
 import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..), ValidateAuxiliaryData (..))
 import qualified Cardano.Ledger.Core as Core
@@ -44,15 +55,10 @@ import Cardano.Ledger.Shelley.Constraints
     UsesValue,
   )
 import Cardano.Ledger.ShelleyMA.Timelocks (evalTimelock)
-import Control.State.Transition.Extended (STUB)
-import qualified Control.State.Transition.Extended as STS
 import qualified Data.Set as Set
-import Data.Typeable (Typeable)
 import qualified Shelley.Spec.Ledger.API as API
 import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
 import Shelley.Spec.Ledger.Metadata (validMetadatum)
-import qualified Shelley.Spec.Ledger.STS.Bbody as STS
-import qualified Shelley.Spec.Ledger.STS.Bbody as Shelley
 import qualified Shelley.Spec.Ledger.STS.Epoch as Shelley
 import qualified Shelley.Spec.Ledger.STS.Mir as Shelley
 import qualified Shelley.Spec.Ledger.STS.Newpp as Shelley
@@ -68,9 +74,20 @@ import Shelley.Spec.Ledger.TxBody (witKeyHash)
 -- | The Alonzo era
 data AlonzoEra c
 
-instance API.PraosCrypto c => API.ApplyTx (AlonzoEra c)
+instance
+  ( CC.Crypto c,
+    era ~ AlonzoEra c
+  ) =>
+  EraModule.Era (AlonzoEra c)
+  where
+  type Crypto (AlonzoEra c) = c
+
+-- TODO we cannot have this instance until we rewrite the mempool API to reflect
+-- the difference between Tx and TxInBlock
+
+-- instance API.PraosCrypto c => API.ApplyTx (AlonzoEra c)
 
-instance API.PraosCrypto c => API.ApplyBlock (AlonzoEra c)
+-- instance API.PraosCrypto c => API.ApplyBlock (AlonzoEra c)
 
 instance API.PraosCrypto c => API.GetLedgerView (AlonzoEra c)
 
@@ -80,7 +97,11 @@ instance (CC.Crypto c) => Shelley.ValidateScript (AlonzoEra c) where
     if isPlutusScript script
       then "\x01"
       else nativeMultiSigTag -- "\x00"
-  validateScript (TimelockScript timelock) tx = evalTimelock vhks (vldt' (body' tx)) timelock
+  validateScript (TimelockScript timelock) tx =
+    evalTimelock
+      vhks
+      (vldt' (body' tx))
+      timelock
     where
       vhks = Set.map witKeyHash (txwitsVKey' (wits' tx))
   validateScript (PlutusScript _) _tx = True -- Plutus scripts are stripped out an run in function evalScripts
@@ -99,12 +120,6 @@ instance CC.Crypto c => UsesTxOut (AlonzoEra c) where
   -- makeTxOut :: Proxy era -> Addr (Crypto era) -> Value era -> TxOut era
   makeTxOut _proxy addr val = TxOut addr val Shelley.SNothing
 
-instance
-  (CC.Crypto c) =>
-  EraModule.Era (AlonzoEra c)
-  where
-  type Crypto (AlonzoEra c) = c
-
 type instance Core.TxOut (AlonzoEra c) = TxOut (AlonzoEra c)
 
 type instance Core.TxBody (AlonzoEra c) = TxBody (AlonzoEra c)
@@ -119,8 +134,6 @@ type instance Core.AuxiliaryData (AlonzoEra c) = AuxiliaryData (AlonzoEra c)
 
 type instance Core.PParams (AlonzoEra c) = PParams (AlonzoEra c)
 
-type instance Core.Tx (AlonzoEra c) = Tx (AlonzoEra c)
-
 type instance Core.Witnesses (AlonzoEra c) = TxWitness (AlonzoEra c)
 
 instance CC.Crypto c => UsesValue (AlonzoEra c)
@@ -142,12 +155,14 @@ instance CC.Crypto c => ValidateAuxiliaryData (AlonzoEra c) c where
       && all validScript scrips
       && all (validPlutusdata . getPlutusData) plutusdata
 
-instance CC.Crypto c => EraModule.BlockDecoding (AlonzoEra c) where
-  seqTx body wit isval aux = alonzoSeqTx body wit isval aux
-  seqIsValidating tx = case isValidating' tx of IsValidating b -> b
-  seqHasValidating = True -- Tx in AlonzoEra has an IsValidating field
+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
 
-instance API.PraosCrypto c => API.ShelleyBasedEra (AlonzoEra c)
+-- instance API.PraosCrypto c => API.ShelleyBasedEra (AlonzoEra c)
 
 -------------------------------------------------------------------------------
 -- Era Mapping
@@ -161,27 +176,9 @@ type instance Core.EraRule "UTXO" (AlonzoEra c) = Alonzo.AlonzoUTXO (AlonzoEra c
 
 type instance Core.EraRule "UTXOW" (AlonzoEra c) = Alonzo.AlonzoUTXOW (AlonzoEra c)
 
-type LEDGERSTUB c =
-  STUB
-    (API.LedgerEnv (AlonzoEra c))
-    (API.UTxOState (AlonzoEra c), API.DPState c)
-    (API.Tx (AlonzoEra c))
-    ()
-    Shelley.ShelleyBase
-
-instance Typeable c => STS.Embed (LEDGERSTUB c) (API.LEDGERS (AlonzoEra c)) where
-  wrapFailed = error "TODO: implement LEDGER rule"
-
-type instance Core.EraRule "LEDGER" (AlonzoEra c) = LEDGERSTUB c
-
-type instance
-  Core.EraRule "BBODY" (AlonzoEra c) =
-    STUB
-      (Shelley.BbodyEnv (AlonzoEra c))
-      (STS.BbodyState (AlonzoEra c))
-      (API.Block (AlonzoEra c))
-      ()
-      Shelley.ShelleyBase
+type instance Core.EraRule "LEDGER" (AlonzoEra c) = Alonzo.AlonzoLEDGER (AlonzoEra c)
+
+type instance Core.EraRule "BBODY" (AlonzoEra c) = Alonzo.AlonzoBBODY (AlonzoEra c)
 
 -- Rules inherited from Shelley
 

diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs
@@ -26,7 +26,7 @@ import Cardano.Ledger.Alonzo.Tx
   ( Data,
     DataHash,
     ScriptPurpose (..),
-    Tx (..),
+    ValidatedTx (..),
     body',
     getValidatorHash,
     indexedRdmrs,

diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs
@@ -20,9 +20,12 @@ where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..))
 import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), pointWiseExUnits)
-import qualified Cardano.Ledger.Alonzo.Tx as Alonzo (Tx)
+import qualified Cardano.Ledger.Alonzo.Tx as Alonzo (ValidatedTx)
+import Cardano.Ledger.Alonzo.TxSeq (txSeqTxns)
+import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo (TxSeq)
 import qualified Cardano.Ledger.Core as Core
-import Cardano.Ledger.Era (BlockDecoding, Era (Crypto))
+import Cardano.Ledger.Era (Era (Crypto), SupportsSegWit (..), TxInBlock)
+import qualified Cardano.Ledger.Era as Era
 import Control.Monad.Trans.Reader (asks)
 import Control.State.Transition
   ( Embed (..),
@@ -48,11 +51,9 @@ import Shelley.Spec.Ledger.BlockChain
     BHeader (..),
     Block (..),
     bBodySize,
-    bbHash,
     hBbsize,
     incrBlocks,
     issuerIDfromBHBody,
-    txSeqTxns,
   )
 import Shelley.Spec.Ledger.Keys (DSignable, Hash, coerceKeyRole)
 import Shelley.Spec.Ledger.LedgerState (LedgerState)
@@ -130,12 +131,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 (Core.Tx era),
+    Signal (Core.EraRule "LEDGERS" era) ~ Seq (TxInBlock era),
     -- Conditions to define the rule in this Era
     HasField "_d" (Core.PParams era) UnitInterval,
     HasField "_maxBlockExUnits" (Core.PParams era) ExUnits,
-    HasField "totExunits" (Core.Tx era) ExUnits,
-    Era era -- supplies WellFormed HasField, and Crypto constraints
+    Era era, -- supplies WellFormed HasField, and Crypto constraints
+    Era.TxSeq era ~ Alonzo.TxSeq era,
+    Era.TxInBlock era ~ Alonzo.ValidatedTx era
   ) =>
   TransitionRule (someBBODY era)
 bbodyTransition =
@@ -148,23 +150,30 @@ bbodyTransition =
            ) -> do
         let txs = txSeqTxns txsSeq
             actualBodySize = bBodySize txsSeq
-            actualBodyHash = bbHash txsSeq
+            actualBodyHash = hashTxSeq @era txsSeq
 
         actualBodySize == fromIntegral (hBbsize bhb)
-          ?! (ShelleyInAlonzoPredFail $ WrongBlockBodySizeBBODY actualBodySize (fromIntegral $ hBbsize bhb))
+          ?! ShelleyInAlonzoPredFail
+            ( WrongBlockBodySizeBBODY actualBodySize (fromIntegral $ hBbsize bhb)
+            )
 
         actualBodyHash == bhash bhb
-          ?! (ShelleyInAlonzoPredFail $ InvalidBodyHashBBODY @era actualBodyHash (bhash bhb))
+          ?! ShelleyInAlonzoPredFail
+            ( InvalidBodyHashBBODY @era actualBodyHash (bhash bhb)
+            )
 
         ls' <-
           trans @(Core.EraRule "LEDGERS" era) $
             TRC (LedgersEnv (bheaderSlotNo bhb) pp account, ls, StrictSeq.fromStrict txs)
 
-        -- Note that this may not actually be a stake pool - it could be a genesis key
-        -- delegate. However, this would only entail an overhead of 7 counts, and it's
-        -- easier than differentiating here. -- TODO move this computation inside 'incrBlocks' where it belongs.
-        -- Here we make an assumption that 'incrBlocks' must enforce, better for it to be done in 'incrBlocks'
-        -- where we can see that the assumption is enforced.
+        -- Note that this may not actually be a stake pool - it could be a
+        -- genesis key delegate. However, this would only entail an overhead of
+        -- 7 counts, and it's easier than differentiating here.
+        --
+        -- TODO move this computation inside 'incrBlocks' where it belongs. Here
+        -- we make an assumption that 'incrBlocks' must enforce, better for it
+        -- to be done in 'incrBlocks' where we can see that the assumption is
+        -- enforced.
         let hkAsStakePool = coerceKeyRole . issuerIDfromBHBody $ bhb
             slot = bheaderSlotNo bhb
         firstSlotNo <- liftSTS $ do
@@ -193,10 +202,12 @@ instance
     State (Core.EraRule "LEDGERS" era) ~ LedgerState era,
     Signal (Core.EraRule "LEDGERS" era) ~ Seq (Alonzo.ValidatedTx era),
     Era era,
-    Core.Tx era ~ Alonzo.ValidatedTx era,
+    TxInBlock era ~ Alonzo.ValidatedTx era,
     HasField "_d" (Core.PParams era) UnitInterval,
     HasField "_maxBlockExUnits" (Core.PParams era) ExUnits,
-    BlockDecoding era
+    Era.TxSeq era ~ Alonzo.TxSeq era,
+    Era.TxInBlock era ~ Alonzo.ValidatedTx era,
+    SupportsSegWit era
   ) =>
   STS (AlonzoBBODY era)
   where

diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs
@@ -22,10 +22,10 @@ module Cardano.Ledger.Alonzo.Rules.Ledger
 where
 
 import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoPredFail, AlonzoUTXOW)
-import Cardano.Ledger.Alonzo.Tx (IsValidating (..), Tx (..))
+import Cardano.Ledger.Alonzo.Tx (IsValidating (..), ValidatedTx (..))
 import Cardano.Ledger.Coin (Coin)
 import qualified Cardano.Ledger.Core as Core
-import Cardano.Ledger.Era (Crypto, Era)
+import Cardano.Ledger.Era (Crypto, Era, TxInBlock)
 import Cardano.Ledger.Shelley.Constraints (PParamsDelta)
 import Control.State.Transition
   ( Assertion (..),
@@ -53,6 +53,7 @@ import Shelley.Spec.Ledger.LedgerState
   )
 import Shelley.Spec.Ledger.STS.Delegs (DELEGS, DelegsEnv (..), DelegsPredicateFailure)
 import Shelley.Spec.Ledger.STS.Ledger (LedgerEnv (..), LedgerPredicateFailure (..))
+import qualified Shelley.Spec.Ledger.STS.Ledgers as Shelley
 import Shelley.Spec.Ledger.STS.Utxo
   ( UtxoEnv (..),
   )
@@ -67,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) ~ Core.Tx era,
+  ( Signal (someLEDGER era) ~ TxInBlock era,
     State (someLEDGER era) ~ (UTxOState era, DPState (Crypto era)),
     Environment (someLEDGER era) ~ LedgerEnv era,
     Embed (Core.EraRule "UTXOW" era) (someLEDGER era),
@@ -77,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) ~ Core.Tx era,
+    Signal (Core.EraRule "UTXOW" era) ~ TxInBlock era,
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
-    HasField "isValidating" (Core.Tx era) IsValidating,
+    HasField "isValidating" (TxInBlock era) IsValidating,
     Era era
   ) =>
   TransitionRule (someLEDGER era)
@@ -118,9 +119,9 @@ instance
     Show (Core.PParams era),
     Show (Core.Value era),
     Show (PParamsDelta era),
-    Core.Tx era ~ ValidatedTx era,
     DSignable (Crypto era) (Hash (Crypto era) EraIndependentTxBody),
     Era era,
+    TxInBlock era ~ ValidatedTx era,
     Embed (Core.EraRule "DELEGS" era) (AlonzoLEDGER era),
     Embed (Core.EraRule "UTXOW" era) (AlonzoLEDGER era),
     Environment (Core.EraRule "UTXOW" era) ~ UtxoEnv era,
@@ -181,3 +182,12 @@ instance
   Embed (AlonzoUTXOW era) (AlonzoLEDGER era)
   where
   wrapFailed = UtxowFailure
+
+instance
+  ( Era era,
+    STS (AlonzoLEDGER era),
+    PredicateFailure (Core.EraRule "LEDGER" era) ~ LedgerPredicateFailure era
+  ) =>
+  Embed (AlonzoLEDGER era) (Shelley.LEDGERS era)
+  where
+  wrapFailed = Shelley.LedgerFailure