diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs index ceb0084cffd..362bd462f4b 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs @@ -476,7 +476,7 @@ decodeCostModels = legacyCostModelLength :: Language -> Int legacyCostModelLength PlutusV1 = 166 legacyCostModelLength PlutusV2 = 175 -legacyCostModelLength PlutusV3 = 217 +legacyCostModelLength PlutusV3 = 223 -- | See the note for 'legacyCostModelLength'. legacyDecodeCostModel :: Language -> Decoder s CostModel diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs index 4211cb387c0..99b8a80eeb6 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs @@ -426,7 +426,7 @@ transValue (MaryValue n m) = justAda <> transMultiAsset m data PlutusTxCert (l :: Language) where TxCertPlutusV1 :: PV1.DCert -> PlutusTxCert 'PlutusV1 TxCertPlutusV2 :: PV2.DCert -> PlutusTxCert 'PlutusV2 - TxCertPlutusV3 :: PV3.DCert -> PlutusTxCert 'PlutusV3 + TxCertPlutusV3 :: PV3.TxCert -> PlutusTxCert 'PlutusV3 unTxCertV1 :: PlutusTxCert 'PlutusV1 -> PV1.DCert unTxCertV1 (TxCertPlutusV1 x) = x @@ -434,7 +434,7 @@ unTxCertV1 (TxCertPlutusV1 x) = x unTxCertV2 :: PlutusTxCert 'PlutusV2 -> PV2.DCert unTxCertV2 (TxCertPlutusV2 x) = x -unTxCertV3 :: PlutusTxCert 'PlutusV3 -> PV3.DCert +unTxCertV3 :: PlutusTxCert 'PlutusV3 -> PV3.TxCert unTxCertV3 (TxCertPlutusV3 x) = x class Era era => EraPlutusContext (l :: Language) era where @@ -613,8 +613,9 @@ valContext (TxInfoPV1 txinfo) sp = Data (PV1.toData (PV1.ScriptContext txinfo (transScriptPurpose sp))) valContext (TxInfoPV2 txinfo) sp = Data (PV2.toData (PV2.ScriptContext txinfo (transScriptPurpose sp))) -valContext (TxInfoPV3 txinfo) sp = - Data (PV3.toData (PV3.ScriptContext txinfo (transScriptPurpose sp))) +valContext (TxInfoPV3 txinfo) _sp = + -- FIXME: add support for PlutusV3 + Data (PV3.toData (PV3.ScriptContext txinfo (error "Unimplemented"))) data ScriptFailure = PlutusSF Text PlutusDebug deriving (Show, Generic) diff --git a/eras/alonzo/test-suite/golden/translations.cbor b/eras/alonzo/test-suite/golden/translations.cbor index 38e8490ac0e..66768711295 100644 Binary files a/eras/alonzo/test-suite/golden/translations.cbor and b/eras/alonzo/test-suite/golden/translations.cbor differ diff --git a/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs b/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs index 3ab194862d4..901a8ca755a 100644 --- a/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs +++ b/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs @@ -44,8 +44,11 @@ import qualified Codec.Serialise as Cborg (Serialise (..)) import qualified Data.ByteString.Lazy as BSL import GHC.Generics (Generic) import qualified PlutusLedgerApi.V1 as PV1 +import qualified PlutusLedgerApi.V2 as PV2 import qualified PlutusLedgerApi.V3 as PV3 - +-- FIXME: remove following line after plutus patch +import qualified PlutusLedgerApi.V3.Contexts as PV3 +import PlutusTx.Ratio as PlutusTx import Cardano.Ledger.Alonzo.TxInfo (VersionedTxInfo) import Data.Typeable (Typeable) @@ -63,32 +66,58 @@ data TranslationInstance era = TranslationInstance deriving instance (Era era, Eq (PParams era), Eq (UTxO era), Eq (Core.Tx era)) => Eq (TranslationInstance era) deriving instance (Era era, Show (PParams era), Show (UTxO era), Show (Core.Tx era)) => Show (TranslationInstance era) -instance Cborg.Serialise PV1.TxInfo +instance Cborg.Serialise PV1.DCert instance Cborg.Serialise PV1.TxInInfo +instance Cborg.Serialise PV1.TxInfo instance Cborg.Serialise PV1.TxOut -instance Cborg.Serialise PV3.POSIXTime -instance Cborg.Serialise a => Cborg.Serialise (PV3.Extended a) -instance Cborg.Serialise a => Cborg.Serialise (PV3.LowerBound a) -instance Cborg.Serialise a => Cborg.Serialise (PV3.UpperBound a) -instance Cborg.Serialise a => Cborg.Serialise (PV3.Interval a) +instance Cborg.Serialise PV2.ScriptPurpose +instance Cborg.Serialise PV2.TxInfo instance Cborg.Serialise PV3.Address +instance Cborg.Serialise PV3.BuiltinData +instance Cborg.Serialise PV3.ChangedParameters +instance Cborg.Serialise PV3.ColdCommitteeCredential +instance Cborg.Serialise PV3.Committee +instance Cborg.Serialise PV3.Constitution instance Cborg.Serialise PV3.Credential instance Cborg.Serialise PV3.CurrencySymbol -instance Cborg.Serialise PV3.DCert -instance Cborg.Serialise PV3.TxOutRef -instance Cborg.Serialise PV3.TxId -instance Cborg.Serialise PV3.Value -instance Cborg.Serialise PV3.PubKeyHash -instance (Cborg.Serialise k, Cborg.Serialise v) => Cborg.Serialise (PV3.Map k v) -instance Cborg.Serialise PV3.TokenName -instance Cborg.Serialise PV3.TxInInfo +instance Cborg.Serialise PV3.DRep +instance Cborg.Serialise PV3.DRepCredential instance Cborg.Serialise PV3.DatumHash -instance Cborg.Serialise PV3.StakingCredential -instance Cborg.Serialise PV3.ScriptHash -instance Cborg.Serialise PV3.TxOut +instance Cborg.Serialise PV3.Delegatee +instance Cborg.Serialise PV3.GovernanceAction +instance Cborg.Serialise PV3.GovernanceActionId +instance Cborg.Serialise PV3.HotCommitteeCredential instance Cborg.Serialise PV3.OutputDatum +instance Cborg.Serialise PV3.POSIXTime +instance Cborg.Serialise PV3.ProposalProcedure +instance Cborg.Serialise PV3.ProtocolVersion +instance Cborg.Serialise PV3.PubKeyHash +instance Cborg.Serialise PV3.ScriptHash instance Cborg.Serialise PV3.ScriptPurpose +instance Cborg.Serialise PV3.StakingCredential +instance Cborg.Serialise PV3.TokenName +instance Cborg.Serialise PV3.TxCert +instance Cborg.Serialise PV3.TxId +instance Cborg.Serialise PV3.TxInInfo instance Cborg.Serialise PV3.TxInfo +instance Cborg.Serialise PV3.TxOut +instance Cborg.Serialise PV3.TxOutRef +instance Cborg.Serialise PV3.Value +instance Cborg.Serialise PV3.Vote +instance Cborg.Serialise PV3.Voter +instance (Cborg.Serialise k, Cborg.Serialise v) => Cborg.Serialise (PV3.Map k v) +instance Cborg.Serialise a => Cborg.Serialise (PV3.Extended a) +instance Cborg.Serialise a => Cborg.Serialise (PV3.Interval a) +instance Cborg.Serialise a => Cborg.Serialise (PV3.LowerBound a) +instance Cborg.Serialise a => Cborg.Serialise (PV3.UpperBound a) + +-- FIXME: remove following line after plutus patch +deriving instance Generic PV3.BuiltinData +-- FIXME: fix following after plutus patch +instance Cborg.Serialise PlutusTx.Rational where + encode = error "fixme rational" + decode = error "fixme rational" + instance Cborg.Serialise VersionedTxInfo instance EncCBOR VersionedTxInfo where diff --git a/eras/babbage/test-suite/golden/translations.cbor b/eras/babbage/test-suite/golden/translations.cbor index ffb37aa6d0d..80479c75ff9 100644 Binary files a/eras/babbage/test-suite/golden/translations.cbor and b/eras/babbage/test-suite/golden/translations.cbor differ diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs index 1a3a248043b..e7bdbd86d10 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs @@ -9,7 +9,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-orphans #-} - module Cardano.Ledger.Conway.TxInfo (conwayTxInfo) where import Cardano.Ledger.Alonzo.Language (Language (..)) @@ -25,19 +24,23 @@ import Cardano.Ledger.Alonzo.TxWits ( unRedeemers, unTxDats, ) +import Cardano.Ledger.Alonzo.Tx +import Cardano.Ledger.Alonzo.TxWits (RdmrPtr) +import Cardano.Ledger.Alonzo.Scripts +import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Cardano.Ledger.Babbage.TxInfo (babbageTxInfoV1, babbageTxInfoV2) import qualified Cardano.Ledger.Babbage.TxInfo as B -import Cardano.Ledger.BaseTypes (EpochNo (..)) import Cardano.Ledger.Conway.Core hiding (TranslationError) import Cardano.Ledger.Conway.Era (ConwayEra) import Cardano.Ledger.Conway.TxCert () import Cardano.Ledger.Crypto (Crypto) import Cardano.Ledger.Mary.Value (MaryValue (..)) -import Cardano.Ledger.PoolParams (PoolParams (..)) import Cardano.Ledger.SafeHash (hashAnnotated) import Cardano.Ledger.Shelley.TxCert import Cardano.Ledger.UTxO (UTxO (..)) import Cardano.Ledger.Val (Val (..)) +import Cardano.Ledger.Address (RewardAcnt (..)) +import Cardano.Ledger.Coin (Coin (..)) import Cardano.Slotting.EpochInfo (EpochInfo) import Cardano.Slotting.Time (SystemStart) import Control.Arrow (left) @@ -47,14 +50,15 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Data.Text (Text) import Lens.Micro -import qualified PlutusLedgerApi.V1 as PV1 import qualified PlutusLedgerApi.V3 as PV3 instance Crypto c => EraPlutusContext 'PlutusV1 (ConwayEra c) where - transTxCert = Alonzo.TxCertPlutusV1 . conwayTransTxCert + -- FIXME: implement for conway era + transTxCert = Alonzo.TxCertPlutusV1 . error "Unimplemented" instance Crypto c => EraPlutusContext 'PlutusV2 (ConwayEra c) where - transTxCert = Alonzo.TxCertPlutusV2 . conwayTransTxCert + -- FIXME: implement for conway era + transTxCert = Alonzo.TxCertPlutusV2 . error "Unimplemented" instance Crypto c => EraPlutusContext 'PlutusV3 (ConwayEra c) where transTxCert = Alonzo.TxCertPlutusV3 . conwayTransTxCert @@ -90,7 +94,7 @@ conwayTxInfo pp lang ei sysS utxo tx = do -- * `txInfoFee` no longer gets a zero ADA inserted into the field, since minting ADA is -- not possible. -- --- * `txInfoDCert` is renamed to `txInfoCert`. Certificates are no longer just +-- * `txInfoDCert` is renamed to `txInfoTxCerts`. Certificates are no longer just -- about delegation, so @D@ prefix no longer make sense. conwayTxInfoV3 :: forall era. @@ -99,7 +103,6 @@ conwayTxInfoV3 :: , BabbageEraTxBody era , Value era ~ MaryValue (EraCrypto era) , EraPlutusContext 'PlutusV3 era - , EraPlutusContext 'PlutusV1 era ) => PV3.POSIXTimeRange -> Tx era -> @@ -113,7 +116,7 @@ conwayTxInfoV3 timeRange tx utxo = do (B.txInfoOutV2 . Alonzo.TxOutFromOutput) [minBound ..] (foldr (:) [] outs) - rdmrs' <- mapM (B.transRedeemerPtr txBody) rdmrs + rdmrs' <- mapM (transRedeemerPtr txBody) rdmrs pure . TxInfoPV3 $ PV3.TxInfo -- TODO Add relevant CIP-1694 data to PV3.TxInfo { PV3.txInfoInputs = inputs @@ -123,14 +126,22 @@ conwayTxInfoV3 timeRange tx utxo = do , -- Note that this translation is different from previous Plutus versions, since we no -- longer add a zero ADA value to the mint field during translation: PV3.txInfoMint = Alonzo.transMultiAsset (txBody ^. mintTxBodyL) - , PV3.txInfoDCert = toList $ fmap (unTxCertV3 . Alonzo.transTxCert) (txBody ^. certsTxBodyL) - , PV3.txInfoWdrl = PV3.fromList $ Map.toList (Alonzo.transWithdrawals (txBody ^. withdrawalsTxBodyL)) + , PV3.txInfoTxCerts = toList $ fmap (unTxCertV3 . Alonzo.transTxCert) (txBody ^. certsTxBodyL) + , PV3.txInfoWdrl = PV3.fromList $ Map.toList (transWithdrawals (txBody ^. withdrawalsTxBodyL)) , PV3.txInfoValidRange = timeRange , PV3.txInfoSignatories = map Alonzo.transKeyHash (Set.toList (txBody ^. reqSignerHashesTxBodyL)) , PV3.txInfoRedeemers = PV3.fromList rdmrs' , PV3.txInfoData = PV3.fromList $ map Alonzo.transDataPair datpairs , PV3.txInfoId = PV3.TxId (Alonzo.transSafeHash (hashAnnotated txBody)) + -- FIXME: implement for plutus v3 + , PV3.txInfoVotes = error "Unimplemented" + -- FIXME: implement for plutus v3 + , PV3.txInfoProposalProcedures = error "Unimplemented" + -- FIXME: implement for plutus v3 + , PV3.txInfoCurrentTreasuryAmount = error "Unimplemented" + -- FIXME: implement for plutus v3 + , PV3.txInfoTreasuryDonation = error "Unimplemented" } where txBody = tx ^. bodyTxL @@ -142,20 +153,44 @@ conwayTxInfoV3 timeRange tx utxo = do -- | This is a temporary version that only translates certificates from previous eras, -- none of them are Conway specific. -conwayTransTxCert :: ShelleyEraTxCert era => TxCert era -> PV1.DCert +conwayTransTxCert :: ShelleyEraTxCert era => TxCert era -> PV3.TxCert conwayTransTxCert = \case RegTxCert stakeCred -> - PV1.DCertDelegRegKey (PV1.StakingHash (Alonzo.transCred stakeCred)) + PV3.TxCertRegStaking (Alonzo.transCred stakeCred) (error "unimplemented") UnRegTxCert stakeCred -> - PV1.DCertDelegDeRegKey (PV1.StakingHash (Alonzo.transCred stakeCred)) - DelegStakeTxCert stakeCred keyHash -> - PV1.DCertDelegDelegate - (PV1.StakingHash (Alonzo.transCred stakeCred)) - (Alonzo.transKeyHash keyHash) - RegPoolTxCert (PoolParams {ppId, ppVrf}) -> - PV1.DCertPoolRegister - (Alonzo.transKeyHash ppId) - (PV1.PubKeyHash (PV1.toBuiltin (Alonzo.transHash ppVrf))) - RetirePoolTxCert poolId (EpochNo i) -> - PV1.DCertPoolRetire (Alonzo.transKeyHash poolId) (fromIntegral i) + PV3.TxCertUnRegStaking (Alonzo.transCred stakeCred) (error "unimplemented") + DelegStakeTxCert stakeCred _keyHash -> + PV3.TxCertDelegStaking + (Alonzo.transCred stakeCred) + (error "unimplemented") _ -> error "Translation of Conway Certificate is not implemented yet" + +-- adapted from Alonzo.TxInfo so as to drop the 'StakingCredential' constructor. +transWithdrawals :: Withdrawals c -> Map.Map PV3.Credential Integer +transWithdrawals (Withdrawals mp) = Map.foldlWithKey' accum Map.empty mp + where + accum ans (RewardAcnt _network cred) (Coin n) = + Map.insert (Alonzo.transCred cred) n ans + +transRedeemerPtr :: + ( MaryEraTxBody era + , EraPlutusContext 'PlutusV3 era + ) => + TxBody era -> + (RdmrPtr, (Data era, ExUnits)) -> + Either (TranslationError (EraCrypto era)) (PV3.ScriptPurpose, PV3.Redeemer) +transRedeemerPtr txb (ptr, (d, _)) = + case rdptrInv txb ptr of + SNothing -> Left (RdmrPtrPointsToNothing ptr) + SJust sp -> Right (transScriptPurpose sp, B.transRedeemer d) + +transScriptPurpose :: + EraPlutusContext 'PlutusV3 era => + ScriptPurpose era -> + PV3.ScriptPurpose +transScriptPurpose (Minting policyid) = PV3.Minting (Alonzo.transPolicyID policyid) +transScriptPurpose (Spending txin) = PV3.Spending (Alonzo.txInfoIn' txin) +transScriptPurpose (Rewarding (RewardAcnt _network cred)) = + PV3.Rewarding (Alonzo.transCred cred) +transScriptPurpose (Certifying dcert) = PV3.Certifying $ unTxCertV3 $ Alonzo.transTxCert dcert +-- FIXME: Add support for PV3, add voting , proposing diff --git a/eras/conway/test-suite/golden/translations.cbor b/eras/conway/test-suite/golden/translations.cbor index 235d2aa7e41..b7854d16260 100644 Binary files a/eras/conway/test-suite/golden/translations.cbor and b/eras/conway/test-suite/golden/translations.cbor differ