Skip to content

Commit

Permalink
Stub code to make it compile with plutus 1.11
Browse files Browse the repository at this point in the history
  • Loading branch information
bezirg committed Sep 4, 2023
1 parent 63245ce commit 9951c05
Show file tree
Hide file tree
Showing 7 changed files with 112 additions and 47 deletions.
2 changes: 1 addition & 1 deletion eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
9 changes: 5 additions & 4 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -426,15 +426,15 @@ 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

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
Expand Down Expand Up @@ -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)
Expand Down
Binary file modified eras/alonzo/test-suite/golden/translations.cbor
Binary file not shown.
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand Down
Binary file modified eras/babbage/test-suite/golden/translations.cbor
Binary file not shown.
83 changes: 59 additions & 24 deletions eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))
Expand All @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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.
Expand All @@ -99,7 +103,6 @@ conwayTxInfoV3 ::
, BabbageEraTxBody era
, Value era ~ MaryValue (EraCrypto era)
, EraPlutusContext 'PlutusV3 era
, EraPlutusContext 'PlutusV1 era
) =>
PV3.POSIXTimeRange ->
Tx era ->
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Binary file modified eras/conway/test-suite/golden/translations.cbor
Binary file not shown.

0 comments on commit 9951c05

Please sign in to comment.