Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

PROTOTYPE: Babel Fees with EraFirstRule workaround #4477

Draft
wants to merge 19 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 18 additions & 0 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,8 @@ packages:
eras/alonzo/test-suite
eras/babbage/impl
eras/babbage/test-suite
eras/babel/impl
eras/babel/test-suite
eras/conway/impl
eras/conway/test-suite
eras/mary/impl
Expand Down Expand Up @@ -85,6 +87,9 @@ package cardano-ledger-mary
package cardano-ledger-conway
flags: +asserts

package cardano-ledger-babel
flags: +asserts

-- Always write GHC env files, because they are needed for repl and by the doctests.
write-ghc-environment-files: always

Expand All @@ -94,3 +99,16 @@ benchmarks: true

-- The only sensible test display option
test-show-details: streaming


source-repository-package
type: git
location: https://github.com/willjgould/plutus
tag: a5179ce32b3471399d35b621920901643544c200
--sha256: 0ksz9q2j07kqf1pl3lyccjfkvxs0dyd0y6pn4ish9mfcgh6afsph
subdir:
plutus-ledger-api
plutus-tx
plutus-tx-plugin
plutus-core
prettyprinter-configurable
2 changes: 2 additions & 0 deletions eras/allegra/impl/src/Cardano/Ledger/Allegra.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- CanStartFromGenesis
{-# OPTIONS_GHC -Wno-deprecations #-}
Expand Down
4 changes: 3 additions & 1 deletion eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ module Cardano.Ledger.Allegra.Era (

import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley (EraFirstRule, ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.Rules

Expand All @@ -27,6 +27,8 @@ instance Crypto c => Era (AllegraEra c) where

eraName = "Allegra"

type instance EraFirstRule (AllegraEra c) = "LEDGERS"

--------------------------------------------------------------------------------
-- Core instances
--------------------------------------------------------------------------------
Expand Down
11 changes: 7 additions & 4 deletions eras/allegra/impl/src/Cardano/Ledger/Allegra/TxSeq.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,11 +15,14 @@ import Cardano.Ledger.Allegra.Tx ()
import Cardano.Ledger.Core (EraSegWits (..))
import Cardano.Ledger.Crypto (Crypto, StandardCrypto)
import Cardano.Ledger.Shelley.BlockChain (ShelleyTxSeq (..), bbHash, txSeqTxns)
import qualified Data.Sequence.Strict as StrictSeq

instance Crypto c => EraSegWits (AllegraEra c) where
{-# SPECIALIZE instance EraSegWits (AllegraEra StandardCrypto) #-}
type TxSeq (AllegraEra c) = ShelleyTxSeq (AllegraEra c)
fromTxSeq = txSeqTxns
toTxSeq = ShelleyTxSeq
hashTxSeq = bbHash
type TxStructure (AllegraEra c) = StrictSeq.StrictSeq
type TxZones (AllegraEra c) = ShelleyTxSeq (AllegraEra c)
fromTxZones = txSeqTxns
toTxZones = ShelleyTxSeq
flatten = txSeqTxns
hashTxZones = bbHash
numSegComponents = 3
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.Allegra.Imp (spec) where

Expand All @@ -13,8 +14,8 @@ import qualified Test.Cardano.Ledger.Shelley.Imp as ShelleyImp
import Test.Cardano.Ledger.Shelley.ImpTest (ShelleyEraImp)

spec ::
forall era.
( ShelleyEraImp era
forall era ls.
( ShelleyEraImp ls era
, InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
) =>
Expand Down
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
Expand All @@ -18,6 +20,7 @@ import Cardano.Ledger.Allegra.Core
import Cardano.Ledger.Allegra.Scripts (Timelock (..))
import Cardano.Ledger.Crypto (Crypto (..))
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Cardano.Ledger.Shelley.LedgerState (LedgerState)
import Control.Monad.State.Strict (get)
import qualified Data.Map.Strict as Map
import Data.Sequence.Strict (StrictSeq (..))
Expand All @@ -35,7 +38,7 @@ instance
, DSIGN c ~ Ed25519DSIGN
, Signable (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
) =>
ShelleyEraImp (AllegraEra c)
ShelleyEraImp LedgerState (AllegraEra c)
where
initImpTestState = pure ()

Expand All @@ -44,7 +47,9 @@ instance
fixupTx = shelleyFixupTx

impAllegraSatisfyNativeScript ::
(ShelleyEraImp era, NativeScript era ~ Timelock era) =>
( ShelleyEraImp ls era
, NativeScript era ~ Timelock era
) =>
Set.Set (KeyHash 'Witness (EraCrypto era)) ->
NativeScript era ->
ImpTestM era (Maybe (Map.Map (KeyHash 'Witness (EraCrypto era)) (KeyPair 'Witness (EraCrypto era))))
Expand Down
2 changes: 1 addition & 1 deletion eras/alonzo/impl/cardano-ledger-alonzo.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ library
mtl,
microlens,
nothunks,
plutus-ledger-api ^>=1.26.0,
plutus-ledger-api ^>=1.30.0.0,
set-algebra >=1.0,
small-steps >=1.1,
text,
Expand Down
7 changes: 5 additions & 2 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,15 +47,18 @@ import Cardano.Ledger.Shelley.API.Mempool
import Control.Arrow (left)
import Control.Monad.Except (MonadError, liftEither)
import Control.Monad.Reader (runReader)
import Control.State.Transition.Extended (TRC (TRC))
import Control.State.Transition.Extended (STS (State), TRC (TRC))

type Alonzo = AlonzoEra StandardCrypto

-- =====================================================

reapplyAlonzoTx ::
forall era m.
(API.ApplyTx era, MonadError (ApplyTxError era) m) =>
( API.ApplyTx era
, MonadError (ApplyTxError era) m
, State (EraRule "LEDGER" era) ~ API.LedgerState era
) =>
Globals ->
MempoolEnv era ->
MempoolState era ->
Expand Down
3 changes: 3 additions & 0 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Era.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ where

import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Mary (MaryEra, MaryValue)
import Cardano.Ledger.Shelley (EraFirstRule)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.Rules

Expand All @@ -31,6 +32,8 @@ instance Crypto c => Era (AlonzoEra c) where

type instance Value (AlonzoEra c) = MaryValue c

type instance EraFirstRule (AlonzoEra c) = "LEDGERS"

-------------------------------------------------------------------------------
-- Era Mapping
-------------------------------------------------------------------------------
Expand Down
2 changes: 2 additions & 0 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs
Original file line number Diff line number Diff line change
Expand Up @@ -773,6 +773,7 @@ encodeCostModel cm =
-- we use the 'canonical' serialization with definite list length.
PlutusV2 -> encodeFoldableAsDefLenList encCBOR $ getCostModelParams cm
PlutusV3 -> encodeFoldableAsDefLenList encCBOR $ getCostModelParams cm
PlutusV4 -> encodeFoldableAsDefLenList encCBOR $ getCostModelParams cm

getLanguageView ::
AlonzoEraPParams era =>
Expand All @@ -787,6 +788,7 @@ getLanguageView pp lang =
(serialize' version costModelEncoding)
PlutusV2 -> latestLangDepView
PlutusV3 -> latestLangDepView
PlutusV4 -> latestLangDepView
where
-- LangDepView for PlutusV1 differs from the rest
latestLangDepView = LangDepView (serialize' version lang) costModelEncoding
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ import qualified PlutusLedgerApi.V1 as P (ToData, toData)
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2
import qualified PlutusLedgerApi.V3 as PV3
import qualified PlutusLedgerApi.V4 as PV4

class (PlutusLanguage l, EraPlutusContext era) => EraPlutusTxInfo (l :: Language) era where
toPlutusTxCert :: proxy l -> TxCert era -> Either (ContextError era) (PlutusTxCert l)
Expand Down Expand Up @@ -114,18 +115,22 @@ type family PlutusTxCert (l :: Language) where
PlutusTxCert 'PlutusV1 = PV1.DCert
PlutusTxCert 'PlutusV2 = PV2.DCert
PlutusTxCert 'PlutusV3 = PV3.TxCert
PlutusTxCert 'PlutusV4 = PV4.TxCert

type family PlutusScriptPurpose (l :: Language) where
PlutusScriptPurpose 'PlutusV1 = PV1.ScriptPurpose
PlutusScriptPurpose 'PlutusV2 = PV2.ScriptPurpose
PlutusScriptPurpose 'PlutusV3 = PV3.ScriptPurpose
PlutusScriptPurpose 'PlutusV4 = PV4.ScriptPurpose

type family PlutusScriptContext (l :: Language) where
PlutusScriptContext 'PlutusV1 = PV1.ScriptContext
PlutusScriptContext 'PlutusV2 = PV2.ScriptContext
PlutusScriptContext 'PlutusV3 = PV3.ScriptContext
PlutusScriptContext 'PlutusV4 = PV4.ScriptContext

type family PlutusTxInfo (l :: Language) where
PlutusTxInfo 'PlutusV1 = PV1.TxInfo
PlutusTxInfo 'PlutusV2 = PV2.TxInfo
PlutusTxInfo 'PlutusV3 = PV3.TxInfo
PlutusTxInfo 'PlutusV4 = PV4.TxInfo
9 changes: 6 additions & 3 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@ import Cardano.Ledger.Block (Block (..))
import Cardano.Ledger.Core
import qualified Cardano.Ledger.Era as Era
import Cardano.Ledger.Keys (DSignable, Hash, coerceKeyRole)
import Cardano.Ledger.Shelley (EraFirstRule)
import Cardano.Ledger.Shelley.BlockChain (incrBlocks)
import Cardano.Ledger.Shelley.LedgerState (LedgerState)
import Cardano.Ledger.Shelley.Rules (
Expand Down Expand Up @@ -186,10 +187,11 @@ bbodyTransition ::
, Embed (EraRule "LEDGERS" era) (someBBODY era)
, Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era
, State (EraRule "LEDGERS" era) ~ LedgerState era
, State (EraRule (EraFirstRule era) era) ~ LedgerState era
, Signal (EraRule "LEDGERS" era) ~ Seq (Tx era)
, EraSegWits era
, AlonzoEraTxWits era
, Era.TxSeq era ~ AlonzoTxSeq era
, Era.TxZones era ~ AlonzoTxSeq era
, Tx era ~ AlonzoTx era
, AlonzoEraPParams era
) =>
Expand All @@ -204,7 +206,7 @@ bbodyTransition =
) -> do
let txs = txSeqTxns txsSeq
actualBodySize = bBodySize (pp ^. ppProtocolVersionL) txsSeq
actualBodyHash = hashTxSeq @era txsSeq
actualBodyHash = hashTxZones @era txsSeq

actualBodySize
== fromIntegral (bhviewBSize bh)
Expand Down Expand Up @@ -257,10 +259,11 @@ instance
, Embed (EraRule "LEDGERS" era) (AlonzoBBODY era)
, Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era
, State (EraRule "LEDGERS" era) ~ LedgerState era
, State (EraRule (EraFirstRule era) era) ~ LedgerState era
, Signal (EraRule "LEDGERS" era) ~ Seq (AlonzoTx era)
, AlonzoEraTxWits era
, Tx era ~ AlonzoTx era
, Era.TxSeq era ~ AlonzoTxSeq era
, Era.TxZones era ~ AlonzoTxSeq era
, Tx era ~ AlonzoTx era
, EraSegWits era
, AlonzoEraPParams era
Expand Down
2 changes: 2 additions & 0 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs
Original file line number Diff line number Diff line change
Expand Up @@ -539,6 +539,7 @@ encodeScript = \case
SPlutusV1 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV1) 1 !> To pb
SPlutusV2 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV2) 2 !> To pb
SPlutusV3 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV3) 3 !> To pb
SPlutusV4 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV4) 4 !> To pb

instance AlonzoEraScript era => DecCBOR (Annotator (AlonzoScript era)) where
decCBOR = decode (Summands "AlonzoScript" decodeScript)
Expand All @@ -552,6 +553,7 @@ instance AlonzoEraScript era => DecCBOR (Annotator (AlonzoScript era)) where
1 -> decodeAnnPlutus SPlutusV1
2 -> decodeAnnPlutus SPlutusV2
3 -> decodeAnnPlutus SPlutusV3
4 -> decodeAnnPlutus SPlutusV4
n -> Invalid n
{-# INLINE decodeScript #-}
{-# INLINE decCBOR #-}
Expand Down
35 changes: 28 additions & 7 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
Expand All @@ -15,6 +16,7 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
Expand Down Expand Up @@ -128,7 +130,10 @@ import Cardano.Ledger.MemoBytes (EqRaw (..))
import Cardano.Ledger.Plutus.Data (Data, hashData)
import Cardano.Ledger.Plutus.Language (nonNativeLanguages)
import Cardano.Ledger.SafeHash (HashAnnotated, SafeToHash (..), hashAnnotated)
import Cardano.Ledger.Shelley.Tx (ShelleyTx (ShelleyTx), shelleyEqTxRaw)
import Cardano.Ledger.Shelley.Tx (
ShelleyTx (ShelleyTx),
shelleyEqTxRaw,
)
import qualified Cardano.Ledger.UTxO as Shelley
import Cardano.Ledger.Val (Val ((<+>), (<×>)))
import Control.Arrow (left)
Expand Down Expand Up @@ -215,7 +220,10 @@ instance Crypto c => AlonzoEraTx (AlonzoEra c) where
isValidTxL = isValidAlonzoTxL
{-# INLINE isValidTxL #-}

mkBasicAlonzoTx :: Monoid (TxWits era) => TxBody era -> AlonzoTx era
mkBasicAlonzoTx ::
Monoid (TxWits era) =>
TxBody era ->
AlonzoTx era
mkBasicAlonzoTx txBody = AlonzoTx txBody mempty (IsValid True) SNothing

-- | `TxBody` setter and getter for `AlonzoTx`.
Expand Down Expand Up @@ -248,10 +256,20 @@ isValidAlonzoTxL = lens isValid (\tx valid -> tx {isValid = valid})
{-# INLINEABLE isValidAlonzoTxL #-}

deriving instance
(Era era, Eq (TxBody era), Eq (TxWits era), Eq (TxAuxData era)) => Eq (AlonzoTx era)
( Era era
, Eq (TxBody era)
, Eq (TxWits era)
, Eq (TxAuxData era)
) =>
Eq (AlonzoTx era)

deriving instance
(Era era, Show (TxBody era), Show (TxAuxData era), Show (Script era), Show (TxWits era)) =>
( Era era
, Show (TxBody era)
, Show (TxAuxData era)
, Show (Script era)
, Show (TxWits era)
) =>
Show (AlonzoTx era)

instance
Expand Down Expand Up @@ -405,9 +423,12 @@ alonzoSegwitTx txBodyAnn txWitsAnn isValid auxDataAnn = Annotator $ \bytes ->
txWits = runAnnotator txWitsAnn bytes
txAuxData = maybeToStrictMaybe (flip runAnnotator bytes <$> auxDataAnn)
in mkBasicTx txBody
& witsTxL .~ txWits
& auxDataTxL .~ txAuxData
& isValidTxL .~ isValid
& witsTxL
.~ txWits
& auxDataTxL
.~ txAuxData
& isValidTxL
.~ isValid

--------------------------------------------------------------------------------
-- Mempool Serialisation
Expand Down
13 changes: 7 additions & 6 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxSeq.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,8 +38,7 @@ import Cardano.Ledger.Binary (
serialize,
withSlice,
)
import Cardano.Ledger.Core hiding (TxSeq, hashTxSeq)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto
import Cardano.Ledger.Keys (Hash)
import Cardano.Ledger.SafeHash (SafeToHash, originalBytes)
Expand Down Expand Up @@ -86,10 +85,12 @@ data AlonzoTxSeq era = AlonzoTxSeqRaw
deriving (Generic)

instance Crypto c => EraSegWits (AlonzoEra c) where
type TxSeq (AlonzoEra c) = AlonzoTxSeq (AlonzoEra c)
fromTxSeq = txSeqTxns
toTxSeq = AlonzoTxSeq
hashTxSeq = hashAlonzoTxSeq
type TxStructure (AlonzoEra c) = StrictSeq
type TxZones (AlonzoEra c) = AlonzoTxSeq (AlonzoEra c)
fromTxZones = txSeqTxns
toTxZones = AlonzoTxSeq
flatten = txSeqTxns
hashTxZones = hashAlonzoTxSeq
numSegComponents = 4

pattern AlonzoTxSeq ::
Expand Down
Loading