From b7902c0cf80c24c7c83486667b8f15eec2c9b6b1 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Mon, 15 Aug 2022 21:27:57 +0800 Subject: [PATCH] use v2 types --- agora-bench/Bench.hs | 2 +- agora-specs/Property/Generator.hs | 14 +- agora-specs/Property/Governor.hs | 14 +- agora-specs/Sample/Effect/GovernorMutation.hs | 43 +++-- .../Sample/Effect/TreasuryWithdrawal.hs | 90 +++++----- agora-specs/Sample/Governor/Initialize.hs | 10 +- agora-specs/Sample/Governor/Mutate.hs | 18 +- agora-specs/Sample/Proposal/Advance.hs | 16 +- agora-specs/Sample/Proposal/Cosign.hs | 13 +- agora-specs/Sample/Proposal/Create.hs | 17 +- agora-specs/Sample/Proposal/Shared.hs | 2 +- agora-specs/Sample/Proposal/UnlockStake.hs | 10 +- agora-specs/Sample/Proposal/Vote.hs | 10 +- agora-specs/Sample/Shared.hs | 26 +-- agora-specs/Sample/Stake.hs | 29 +-- agora-specs/Sample/Stake/SetDelegate.hs | 12 +- agora-specs/Sample/Treasury.hs | 32 ++-- agora-specs/Spec/Effect/GovernorMutation.hs | 2 +- agora-specs/Spec/Treasury.hs | 14 +- agora-testlib/Test/Specification.hs | 14 +- agora-testlib/Test/Util.hs | 16 +- agora/Agora/AuthorityToken.hs | 16 +- agora/Agora/Bootstrap.hs | 2 +- agora/Agora/Effect.hs | 4 +- agora/Agora/Effect/GovernorMutation.hs | 20 +-- agora/Agora/Effect/NoOp.hs | 2 +- agora/Agora/Effect/TreasuryWithdrawal.hs | 14 +- agora/Agora/Governor/Scripts.hs | 132 ++++++-------- agora/Agora/Proposal.hs | 7 +- agora/Agora/Proposal/Scripts.hs | 35 ++-- agora/Agora/Proposal/Time.hs | 2 +- agora/Agora/Scripts.hs | 11 +- agora/Agora/Stake.hs | 2 +- agora/Agora/Stake/Scripts.hs | 43 +++-- agora/Agora/Treasury.hs | 5 +- agora/Agora/Utils.hs | 165 ++++++++++++++---- 36 files changed, 504 insertions(+), 360 deletions(-) diff --git a/agora-bench/Bench.hs b/agora-bench/Bench.hs index d8cdafb..80b970f 100644 --- a/agora-bench/Bench.hs +++ b/agora-bench/Bench.hs @@ -9,7 +9,7 @@ import Data.Csv (DefaultOrdered, ToNamedRecord, header, headerOrder, namedRecord import Data.List (intercalate) import Data.Text (Text, pack) import Plutarch.Evaluate (evalScript) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V2 ( ExBudget (ExBudget), ExCPU (..), ExMemory (..), diff --git a/agora-specs/Property/Generator.hs b/agora-specs/Property/Generator.hs index a1a26fc..ec76191 100644 --- a/agora-specs/Property/Generator.hs +++ b/agora-specs/Property/Generator.hs @@ -32,7 +32,13 @@ import Plutarch.Context ( output, withValue, ) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Value ( + AssetClass (AssetClass), + assetClassValue, + currencySymbol, + tokenName, + ) +import PlutusLedgerApi.V2 ( Address (Address), Credential (..), PubKeyHash (PubKeyHash), @@ -42,12 +48,6 @@ import PlutusLedgerApi.V1 ( Value, toBuiltin, ) -import PlutusLedgerApi.V1.Value ( - AssetClass (AssetClass), - assetClassValue, - currencySymbol, - tokenName, - ) import Test.QuickCheck ( Arbitrary (arbitrary), Gen, diff --git a/agora-specs/Property/Governor.hs b/agora-specs/Property/Governor.hs index 1da91d8..511e099 100644 --- a/agora-specs/Property/Governor.hs +++ b/agora-specs/Property/Governor.hs @@ -20,27 +20,27 @@ import Agora.Proposal.Time ( import Data.Default.Class (Default (def)) import Data.Tagged (Tagged (Tagged), untag) import Data.Universe (Finite (..), Universe (..)) -import Plutarch.Api.V1 (PScriptContext) +import Plutarch.Api.V2 (PScriptContext) import Plutarch.Builtin (pforgetData) import Plutarch.Context ( MintingBuilder, - buildMintingUnsafe, + buildMinting', input, mint, output, script, withDatum, withMinting, - withOutRef, + withRef, withValue, ) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Value (assetClassValue) +import PlutusLedgerApi.V2 ( ScriptContext (scriptContextTxInfo), TxInInfo (txInInfoOutRef), TxInfo (txInfoInputs, txInfoMint, txInfoOutputs), TxOut (txOutValue), ) -import PlutusLedgerApi.V1.Value (assetClassValue) import Property.Generator (genInput, genOutput) import Sample.Shared ( govAssetClass, @@ -164,7 +164,7 @@ governorMintingProperty = , withValue gst , withDatum govDatum ] - referencedInput = input $ withOutRef gstUTXORef + referencedInput = input $ withRef gstUTXORef govDatum :: GovernorDatum govDatum = @@ -189,7 +189,7 @@ governorMintingProperty = GovernorOutputNotFound -> referencedInput <> mintAmount 1 GovernorPolicyCorrect -> referencedInput <> outputToGov <> mintAmount 1 - return . buildMintingUnsafe $ inputs <> outputs <> comp <> withMinting govSymbol + return . buildMinting' $ inputs <> outputs <> comp <> withMinting govSymbol expected :: ScriptContext -> Maybe () expected sc = diff --git a/agora-specs/Sample/Effect/GovernorMutation.hs b/agora-specs/Sample/Effect/GovernorMutation.hs index 75a7a56..633398c 100644 --- a/agora-specs/Sample/Effect/GovernorMutation.hs +++ b/agora-specs/Sample/Effect/GovernorMutation.hs @@ -15,15 +15,24 @@ import Agora.Effect.GovernorMutation ( MutateGovernorDatum (..), mutateGovernorValidator, ) -import Agora.Governor (GovernorDatum (..)) +import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor)) import Agora.Proposal (ProposalId (..), ProposalThresholds (..)) import Agora.Utils (validatorHashToTokenName) import Data.Default.Class (Default (def)) import Data.Tagged (Tagged (..)) -import Plutarch.Api.V1 (mkValidator, validatorHash) -import PlutusLedgerApi.V1 ( +import Plutarch.Api.V2 (mkValidator, validatorHash) +import PlutusLedgerApi.V1 qualified as Interval (always) +import PlutusLedgerApi.V1.Address (scriptHashAddress) +import PlutusLedgerApi.V1.Value (AssetClass, assetClass) +import PlutusLedgerApi.V1.Value qualified as Value ( + assetClassValue, + singleton, + ) +import PlutusLedgerApi.V2 ( Address, Datum (..), + OutputDatum (OutputDatumHash), + ScriptPurpose (Spending), ToData (..), TxInInfo (..), TxInfo (..), @@ -32,13 +41,7 @@ import PlutusLedgerApi.V1 ( Validator, ValidatorHash (..), ) -import PlutusLedgerApi.V1 qualified as Interval (always) -import PlutusLedgerApi.V1.Address (scriptHashAddress) -import PlutusLedgerApi.V1.Value (AssetClass, assetClass) -import PlutusLedgerApi.V1.Value qualified as Value ( - assetClassValue, - singleton, - ) +import PlutusTx.AssocMap qualified as AssocMap import Sample.Shared ( agoraScripts, authorityTokenSymbol, @@ -46,6 +49,7 @@ import Sample.Shared ( govAssetClass, govValidatorAddress, minAda, + mkRedeemer, signer, ) import Test.Util (datumPair, toDatumHash) @@ -114,7 +118,8 @@ mkEffectTxInfo newGovDatum = TxOut { txOutAddress = govValidatorAddress , txOutValue = gst - , txOutDatumHash = Just $ toDatumHash governorInputDatum + , txOutDatum = OutputDatumHash $ toDatumHash governorInputDatum + , txOutReferenceScript = Nothing } -- @@ -129,7 +134,8 @@ mkEffectTxInfo newGovDatum = TxOut { txOutAddress = effectValidatorAddress , txOutValue = at -- The effect carry an authotity token. - , txOutDatumHash = Just $ toDatumHash effectInputDatum + , txOutDatum = OutputDatumHash $ toDatumHash effectInputDatum + , txOutReferenceScript = Nothing } -- @@ -143,21 +149,28 @@ mkEffectTxInfo newGovDatum = TxOut { txOutAddress = govValidatorAddress , txOutValue = mconcat [gst, minAda] - , txOutDatumHash = Just $ toDatumHash governorOutputDatum + , txOutDatum = OutputDatumHash $ toDatumHash governorOutputDatum + , txOutReferenceScript = Nothing } in TxInfo { txInfoInputs = [ TxInInfo effectRef effectInput , TxInInfo govRef governorInput ] + , txInfoReferenceInputs = [] , txInfoOutputs = [governorOutput] , txInfoFee = Value.singleton "" "" 2 , txInfoMint = burnt , txInfoDCert = [] - , txInfoWdrl = [] + , txInfoWdrl = AssocMap.empty , txInfoValidRange = Interval.always , txInfoSignatories = [signer] - , txInfoData = datumPair <$> [governorInputDatum, governorOutputDatum, effectInputDatum] + , txInfoData = AssocMap.fromList $ datumPair <$> [governorInputDatum, governorOutputDatum, effectInputDatum] + , txInfoRedeemers = + AssocMap.fromList + [ (Spending effectRef, mkRedeemer ()) + , (Spending govRef, mkRedeemer MutateGovernor) + ] , txInfoId = "74c75505691e7baa981fa80e50b9b7e88dbe1eda67d4f062d89d203b" } diff --git a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs index 3070e79..49c0d9e 100644 --- a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs +++ b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs @@ -23,39 +23,31 @@ import Agora.Effect.TreasuryWithdrawal ( TreasuryWithdrawalDatum (TreasuryWithdrawalDatum), treasuryWithdrawalValidator, ) -import Data.Default (def) -import Plutarch.Api.V1 (mkValidator, validatorHash) -import PlutusLedgerApi.V1 ( +import Plutarch.Api.V2 (mkValidator, validatorHash) +import PlutusLedgerApi.V1.Interval qualified as Interval (always) +import PlutusLedgerApi.V1.Value qualified as Value (singleton) +import PlutusLedgerApi.V2 ( Address (Address), Credential (..), CurrencySymbol, DatumHash (DatumHash), + OutputDatum (OutputDatumHash), PubKeyHash, + Redeemer (Redeemer), ScriptContext (..), ScriptPurpose (Spending), TokenName (TokenName), TxInInfo (TxInInfo), - TxInfo ( - TxInfo, - txInfoDCert, - txInfoData, - txInfoFee, - txInfoId, - txInfoInputs, - txInfoMint, - txInfoOutputs, - txInfoSignatories, - txInfoValidRange, - txInfoWdrl - ), + TxInfo (..), TxOut (..), TxOutRef (TxOutRef), Validator, ValidatorHash (ValidatorHash), Value, + toBuiltinData, ) -import PlutusLedgerApi.V1.Interval qualified as Interval (always) -import PlutusLedgerApi.V1.Value qualified as Value (singleton) +import PlutusTx.AssocMap qualified as AssocMap +import Sample.Shared (deterministicTracingConfing) import Test.Util (scriptCredentials, userCredentials) -- | A sample Currency Symbol. @@ -81,7 +73,8 @@ inputGAT = TxOut { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing , txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST - , txOutDatumHash = Just (DatumHash "") + , txOutDatum = OutputDatumHash (DatumHash "") + , txOutReferenceScript = Nothing } -- | Create an input given the index of the treasury and the 'Value' at this input. @@ -92,7 +85,8 @@ inputTreasury indx val = TxOut { txOutAddress = Address (treasuries !! indx) Nothing , txOutValue = val - , txOutDatumHash = Just (DatumHash "") + , txOutDatum = OutputDatumHash (DatumHash "") + , txOutReferenceScript = Nothing } -- | Create a input given the index of the user and the 'Value' at this input. @@ -103,7 +97,8 @@ inputUser indx val = TxOut { txOutAddress = Address (users !! indx) Nothing , txOutValue = val - , txOutDatumHash = Just (DatumHash "") + , txOutDatum = OutputDatumHash (DatumHash "") + , txOutReferenceScript = Nothing } -- | Create a input representing the collateral given by a user. @@ -114,7 +109,8 @@ inputCollateral indx = TxOut { txOutAddress = Address (users !! indx) Nothing , txOutValue = Value.singleton "" "" 2000000 - , txOutDatumHash = Just (DatumHash "") + , txOutDatum = OutputDatumHash (DatumHash "") + , txOutReferenceScript = Nothing } -- | Create an output at the nth treasury with the given 'Value'. @@ -123,7 +119,8 @@ outputTreasury indx val = TxOut { txOutAddress = Address (treasuries !! indx) Nothing , txOutValue = val - , txOutDatumHash = Nothing + , txOutDatum = OutputDatumHash (DatumHash "") + , txOutReferenceScript = Nothing } -- | Create an output at the nth user with the given 'Value'. @@ -132,7 +129,8 @@ outputUser indx val = TxOut { txOutAddress = Address (users !! indx) Nothing , txOutValue = val - , txOutDatumHash = Nothing + , txOutDatum = OutputDatumHash (DatumHash "") + , txOutReferenceScript = Nothing } -- | Create a list of the outputs that are required as encoded in 'TreasuryWithdrawalDatum'. @@ -143,12 +141,13 @@ buildReceiversOutputFromDatum (TreasuryWithdrawalDatum xs _) = f <$> xs TxOut { txOutAddress = Address (fst x) Nothing , txOutValue = snd x - , txOutDatumHash = Nothing + , txOutDatum = OutputDatumHash (DatumHash "") + , txOutReferenceScript = Nothing } -- | Effect validator instance. validator :: Validator -validator = mkValidator def $ treasuryWithdrawalValidator currSymbol +validator = mkValidator deterministicTracingConfing $ treasuryWithdrawalValidator currSymbol -- | 'TokenName' that represents the hash of the 'Agora.Stake.Stake' validator. validatorHashTN :: TokenName @@ -156,20 +155,25 @@ validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh buildScriptContext :: [TxInInfo] -> [TxOut] -> ScriptContext buildScriptContext inputs outputs = - ScriptContext - { scriptContextTxInfo = - TxInfo - { txInfoInputs = inputs - , txInfoOutputs = outputs - , txInfoFee = Value.singleton "" "" 2 - , txInfoMint = Value.singleton currSymbol validatorHashTN (-1) - , txInfoDCert = [] - , txInfoWdrl = [] - , txInfoValidRange = Interval.always - , txInfoSignatories = [signer] - , txInfoData = [] - , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" - } - , scriptContextPurpose = - Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) - } + let spending = Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) + in ScriptContext + { scriptContextTxInfo = + TxInfo + { txInfoInputs = inputs + , txInfoReferenceInputs = [] + , txInfoOutputs = outputs + , txInfoFee = Value.singleton "" "" 2 + , txInfoMint = Value.singleton currSymbol validatorHashTN (-1) + , txInfoDCert = [] + , txInfoWdrl = AssocMap.empty + , txInfoValidRange = Interval.always + , txInfoSignatories = [signer] + , txInfoData = AssocMap.empty + , txInfoRedeemers = + AssocMap.fromList + [ (spending, Redeemer $ toBuiltinData ()) + ] + , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" + } + , scriptContextPurpose = spending + } diff --git a/agora-specs/Sample/Governor/Initialize.hs b/agora-specs/Sample/Governor/Initialize.hs index 167cb5a..319b34e 100644 --- a/agora-specs/Sample/Governor/Initialize.hs +++ b/agora-specs/Sample/Governor/Initialize.hs @@ -42,16 +42,16 @@ import Plutarch.Context ( signedWith, txId, withDatum, - withOutRef, + withRef, withValue, ) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Value (AssetClass (..)) +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 ( CurrencySymbol, TxOutRef (TxOutRef), ValidatorHash, ) -import PlutusLedgerApi.V1.Value (AssetClass (..)) -import PlutusLedgerApi.V1.Value qualified as Value import Sample.Shared ( minAda, ) @@ -175,7 +175,7 @@ mintGST ps = builder mconcat [ pubKey witnessPubKey , withValue witnessValue - , withOutRef witnessRef + , withRef witnessRef ] , output $ mconcat diff --git a/agora-specs/Sample/Governor/Mutate.hs b/agora-specs/Sample/Governor/Mutate.hs index df8a70c..0fe12e5 100644 --- a/agora-specs/Sample/Governor/Mutate.hs +++ b/agora-specs/Sample/Governor/Mutate.hs @@ -22,7 +22,7 @@ import Agora.Proposal (ProposalId (ProposalId), ProposalThresholds (..)) import Agora.Scripts (AgoraScripts (..)) import Agora.Utils (validatorHashToTokenName) import Data.Default (def) -import Plutarch.Api.V1 (PValidator, mkValidator, validatorHash) +import Plutarch.Api.V2 (PValidator, mkValidator, validatorHash) import Plutarch.Context ( input, mint, @@ -30,17 +30,17 @@ import Plutarch.Context ( pubKey, script, withDatum, - withOutRef, + withRef, withValue, ) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 ( Data, TxOutRef (TxOutRef), ValidatorHash, Value, toData, ) -import PlutusLedgerApi.V1.Value qualified as Value import Sample.Shared ( agoraScripts, authorityTokenSymbol, @@ -49,7 +49,13 @@ import Sample.Shared ( minAda, ) import Test.Specification (SpecificationTree, testValidator) -import Test.Util (CombinableBuilder, mkSpending, pubKeyHashes, sortValue, validatorHashes) +import Test.Util ( + CombinableBuilder, + mkSpending, + pubKeyHashes, + sortValue, + validatorHashes, + ) -------------------------------------------------------------------------------- @@ -150,7 +156,7 @@ mkGovernorBuilder ps = [ script govValidatorHash , withDatum governorInputDatum , withValue value - , withOutRef governorRef + , withRef governorRef ] , output $ mconcat diff --git a/agora-specs/Sample/Proposal/Advance.hs b/agora-specs/Sample/Proposal/Advance.hs index 6e7a3f1..003c535 100644 --- a/agora-specs/Sample/Proposal/Advance.hs +++ b/agora-specs/Sample/Proposal/Advance.hs @@ -80,11 +80,13 @@ import Plutarch.Context ( signedWith, timeRange, withDatum, - withOutRef, + withRef, withValue, ) import Plutarch.Lift (PLifted, PUnsafeLiftDecl) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Value (AssetClass (..)) +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 ( DatumHash, POSIXTime, POSIXTimeRange, @@ -92,8 +94,6 @@ import PlutusLedgerApi.V1 ( TxOutRef (TxOutRef), ValidatorHash, ) -import PlutusLedgerApi.V1.Value (AssetClass (..)) -import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap import Sample.Proposal.Shared ( governorTxRef, @@ -317,7 +317,7 @@ mkProposalBuilder ps = [ input $ mconcat [ script proposalValidatorHash - , withOutRef proposalRef + , withRef proposalRef , withDatum (mkProposalInputDatum ps) , withValue value ] @@ -400,7 +400,7 @@ mkStakeBuilder ps = , input $ mconcat [ script stakeValidatorHash - , withOutRef (mkStakeRef idx) + , withRef (mkStakeRef idx) , withValue perStakeValue , withDatum i ] @@ -462,14 +462,14 @@ mkGovernorBuilder ps = mconcat [ script govValidatorHash , withValue value - , withOutRef governorRef + , withRef governorRef , withDatum governorInputDatum ] , output $ mconcat [ script govValidatorHash , withValue value - , withOutRef governorRef + , withRef governorRef , withDatum (mkGovernorOutputDatum ps) ] ] diff --git a/agora-specs/Sample/Proposal/Cosign.hs b/agora-specs/Sample/Proposal/Cosign.hs index 09f0b67..8bd9c0d 100644 --- a/agora-specs/Sample/Proposal/Cosign.hs +++ b/agora-specs/Sample/Proposal/Cosign.hs @@ -46,17 +46,16 @@ import Plutarch.Context ( timeRange, txId, withDatum, - withOutRef, - withTxId, + withRef, withValue, ) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 ( POSIXTimeRange, PubKeyHash, TxOutRef (..), Value, ) -import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap import Sample.Proposal.Shared (proposalTxRef, stakeTxRef) import Sample.Shared ( @@ -165,8 +164,7 @@ cosign ps = builder [ script stakeValidatorHash , withValue stakeValue , withDatum stakeDatum - , withTxId stakeTxRef - , withOutRef (mkStakeRef refIdx) + , withRef (mkStakeRef refIdx) ] , output $ mconcat @@ -196,8 +194,7 @@ cosign ps = builder [ script proposalValidatorHash , withValue pst , withDatum proposalInputDatum - , withTxId proposalTxRef - , withOutRef proposalRef + , withRef proposalRef ] , output $ mconcat diff --git a/agora-specs/Sample/Proposal/Create.hs b/agora-specs/Sample/Proposal/Create.hs index af356fb..2b23571 100644 --- a/agora-specs/Sample/Proposal/Create.hs +++ b/agora-specs/Sample/Proposal/Create.hs @@ -31,7 +31,12 @@ import Agora.Proposal ( ResultTag (ResultTag), emptyVotesFor, ) -import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalStartingTime (..)) +import Agora.Proposal.Time ( + MaxTimeRangeWidth ( + MaxTimeRangeWidth + ), + ProposalStartingTime (..), + ) import Agora.Scripts (AgoraScripts (..)) import Agora.Stake ( ProposalLock (..), @@ -50,10 +55,11 @@ import Plutarch.Context ( timeRange, txId, withDatum, - withOutRef, + withRef, withValue, ) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 ( DatumHash, POSIXTime (POSIXTime), POSIXTimeRange, @@ -62,7 +68,6 @@ import PlutusLedgerApi.V1 ( ValidatorHash, always, ) -import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap import Sample.Proposal.Shared (stakeTxRef) import Sample.Shared ( @@ -303,7 +308,7 @@ createProposal ps = builder [ script govValidatorHash , withValue governorValue , withDatum governorInputDatum - , withOutRef governorRef + , withRef governorRef ] , output $ mconcat @@ -317,7 +322,7 @@ createProposal ps = builder [ script stakeValidatorHash , withValue stakeValue , withDatum (mkStakeInputDatum ps) - , withOutRef stakeRef + , withRef stakeRef ] , output $ mconcat diff --git a/agora-specs/Sample/Proposal/Shared.hs b/agora-specs/Sample/Proposal/Shared.hs index c73f1c9..8677718 100644 --- a/agora-specs/Sample/Proposal/Shared.hs +++ b/agora-specs/Sample/Proposal/Shared.hs @@ -7,7 +7,7 @@ Shared constants for proposal samples. -} module Sample.Proposal.Shared (proposalTxRef, stakeTxRef, governorTxRef) where -import PlutusLedgerApi.V1 (TxId) +import PlutusLedgerApi.V2 (TxId) -- | 'TxId' of all the proposal inputs in the samples. proposalTxRef :: TxId diff --git a/agora-specs/Sample/Proposal/UnlockStake.hs b/agora-specs/Sample/Proposal/UnlockStake.hs index 5e72125..64f9a74 100644 --- a/agora-specs/Sample/Proposal/UnlockStake.hs +++ b/agora-specs/Sample/Proposal/UnlockStake.hs @@ -46,16 +46,16 @@ import Plutarch.Context ( signedWith, txId, withDatum, - withOutRef, + withRef, withValue, ) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 ( DatumHash, PubKeyHash, TxOutRef (..), ValidatorHash, ) -import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap import Sample.Proposal.Shared (stakeTxRef) import Sample.Shared ( @@ -261,7 +261,7 @@ unlockStake ps = [ script proposalValidatorHash , withValue pst , withDatum i - , withOutRef (mkProposalRef idx) + , withRef (mkProposalRef idx) ] , output $ mconcat @@ -293,7 +293,7 @@ unlockStake ps = [ script stakeValidatorHash , withValue stakeValue , withDatum sInDatum - , withOutRef stakeRef + , withRef stakeRef ] , output $ mconcat diff --git a/agora-specs/Sample/Proposal/Vote.hs b/agora-specs/Sample/Proposal/Vote.hs index 937a152..aa22d1d 100644 --- a/agora-specs/Sample/Proposal/Vote.hs +++ b/agora-specs/Sample/Proposal/Vote.hs @@ -40,14 +40,14 @@ import Plutarch.Context ( timeRange, txId, withDatum, - withOutRef, + withRef, withValue, ) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 ( PubKeyHash, TxOutRef (TxOutRef), ) -import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap import Sample.Proposal.Shared (proposalTxRef, stakeTxRef) import Sample.Shared ( @@ -222,14 +222,14 @@ vote params = [ script proposalValidatorHash , withValue pst , withDatum proposalInputDatum - , withOutRef proposalRef + , withRef proposalRef ] , input $ mconcat [ script stakeValidatorHash , withValue stakeValue , withDatum stakeInputDatum - , withOutRef stakeRef + , withRef stakeRef ] , output $ mconcat diff --git a/agora-specs/Sample/Shared.hs b/agora-specs/Sample/Shared.hs index 01039db..659e202 100644 --- a/agora-specs/Sample/Shared.hs +++ b/agora-specs/Sample/Shared.hs @@ -14,6 +14,7 @@ module Sample.Shared ( minAda, deterministicTracingConfing, mkEffect, + mkRedeemer, -- * Agora Scripts agoraScripts, @@ -75,13 +76,21 @@ import Agora.Utils ( import Data.Default.Class (Default (..)) import Data.Tagged (Tagged (..)) import Plutarch (Config (..), TracingMode (DetTracing)) -import Plutarch.Api.V1 ( +import Plutarch.Api.V2 ( PValidator, mintingPolicySymbol, mkValidator, validatorHash, ) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Address (scriptHashAddress) +import PlutusLedgerApi.V1.Contexts (TxOut (..)) +import PlutusLedgerApi.V1.Scripts (Validator, ValidatorHash (..)) +import PlutusLedgerApi.V1.Value (AssetClass, TokenName) +import PlutusLedgerApi.V1.Value qualified as Value ( + assetClass, + singleton, + ) +import PlutusLedgerApi.V2 ( Address (Address), Credential (ScriptCredential), CurrencySymbol, @@ -91,18 +100,12 @@ import PlutusLedgerApi.V1 ( MintingPolicy (..), POSIXTimeRange, PubKeyHash, + Redeemer (..), + ToData (toBuiltinData), TxOutRef (TxOutRef), UpperBound (..), Value, ) -import PlutusLedgerApi.V1.Address (scriptHashAddress) -import PlutusLedgerApi.V1.Contexts (TxOut (..)) -import PlutusLedgerApi.V1.Scripts (Validator, ValidatorHash (..)) -import PlutusLedgerApi.V1.Value (AssetClass, TokenName) -import PlutusLedgerApi.V1.Value qualified as Value ( - assetClass, - singleton, - ) import PlutusTx qualified -- Plutarch compiler configauration. @@ -219,6 +222,9 @@ proposalStartingTimeFromTimeRange _ = error "Given time range should be finite a mkEffect :: (PlutusTx.ToData datum) => ClosedTerm PValidator -> CompiledEffect datum mkEffect v = CompiledEffect $ mkValidator deterministicTracingConfing v +mkRedeemer :: forall redeemer. PlutusTx.ToData redeemer => redeemer -> Redeemer +mkRedeemer = Redeemer . toBuiltinData + ------------------------------------------------------------------ treasuryOut :: TxOut diff --git a/agora-specs/Sample/Stake.hs b/agora-specs/Sample/Stake.hs index 1d0f2c1..1f5dac2 100644 --- a/agora-specs/Sample/Stake.hs +++ b/agora-specs/Sample/Stake.hs @@ -27,8 +27,8 @@ import Data.Tagged (Tagged, untag) import Plutarch.Context ( MintingBuilder, SpendingBuilder, - buildMintingUnsafe, - buildSpendingUnsafe, + buildMinting', + buildSpending', input, mint, output, @@ -37,22 +37,23 @@ import Plutarch.Context ( txId, withDatum, withMinting, - withOutRef, + withRef, withSpendingOutRef, withValue, ) -import PlutusLedgerApi.V1 ( - Datum (Datum), - ScriptContext (..), - ScriptPurpose (Minting), - ToData (toBuiltinData), - TxInfo (txInfoData, txInfoSignatories), - ) import PlutusLedgerApi.V1.Contexts (TxOutRef (..)) import PlutusLedgerApi.V1.Value qualified as Value ( assetClassValue, singleton, ) +import PlutusLedgerApi.V2 ( + Datum (Datum), + ScriptContext (..), + ScriptPurpose (Minting), + ToData (toBuiltinData), + TxInfo (txInfoData, txInfoSignatories), + ) +import PlutusTx.AssocMap qualified as AssocMap import Sample.Shared ( governor, signer, @@ -83,7 +84,7 @@ stakeCreation = ] , withMinting stakeSymbol ] - in buildMintingUnsafe builder + in buildMinting' builder -- | This ScriptContext should fail because the datum has too much GT. stakeCreationWrongDatum :: ScriptContext @@ -91,7 +92,7 @@ stakeCreationWrongDatum = let datum :: Datum datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer Nothing []) -- Too much GT in ScriptContext - { scriptContextTxInfo = stakeCreation.scriptContextTxInfo {txInfoData = [("", datum)]} + { scriptContextTxInfo = stakeCreation.scriptContextTxInfo {txInfoData = AssocMap.fromList [("", datum)]} , scriptContextPurpose = Minting stakeSymbol } @@ -144,7 +145,7 @@ stakeDepositWithdraw config = <> Value.assetClassValue (untag governor.gtClassRef) (untag stakeBefore.stakedAmount) ) , withDatum stakeAfter - , withOutRef stakeRef + , withRef stakeRef ] , output $ mconcat @@ -158,4 +159,4 @@ stakeDepositWithdraw config = ] , withSpendingOutRef stakeRef ] - in buildSpendingUnsafe builder + in buildSpending' builder diff --git a/agora-specs/Sample/Stake/SetDelegate.hs b/agora-specs/Sample/Stake/SetDelegate.hs index 9f9f25e..510a110 100644 --- a/agora-specs/Sample/Stake/SetDelegate.hs +++ b/agora-specs/Sample/Stake/SetDelegate.hs @@ -28,23 +28,23 @@ import Agora.Stake ( import Data.Tagged (untag) import Plutarch.Context ( SpendingBuilder, - buildSpendingUnsafe, + buildSpending', input, output, script, signedWith, txId, withDatum, - withOutRef, + withRef, withSpendingOutRef, withValue, ) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 ( PubKeyHash, ScriptContext, TxOutRef (TxOutRef), ) -import PlutusLedgerApi.V1.Value qualified as Value import Sample.Shared ( agoraScripts, governor, @@ -91,7 +91,7 @@ mkStakeInputDatum ps = -- | Generate a 'ScriptContext' that tries to change the delegate of a stake. setDelegate :: Parameters -> ScriptContext -setDelegate ps = buildSpendingUnsafe builder +setDelegate ps = buildSpending' builder where stakeRef :: TxOutRef stakeRef = TxOutRef "0ffef57e30cc604342c738e31e0451593837b313e7bfb94b0922b142782f98e6" 1 @@ -134,7 +134,7 @@ setDelegate ps = buildSpendingUnsafe builder [ script stakeValidatorHash , withValue stakeValue , withDatum stakeInput - , withOutRef stakeRef + , withRef stakeRef ] , output $ mconcat diff --git a/agora-specs/Sample/Treasury.hs b/agora-specs/Sample/Treasury.hs index f314509..d206b0c 100644 --- a/agora-specs/Sample/Treasury.hs +++ b/agora-specs/Sample/Treasury.hs @@ -19,7 +19,7 @@ module Sample.Treasury ( import Plutarch.Context ( MintingBuilder, - buildMintingUnsafe, + buildMinting', credential, input, mint, @@ -28,22 +28,23 @@ import Plutarch.Context ( signedWith, txId, withMinting, - withTxId, + withRefTxId, withValue, ) -import PlutusLedgerApi.V1 ( - Credential (PubKeyCredential), - PubKeyHash (PubKeyHash), - ) import PlutusLedgerApi.V1.Address (Address (..)) -import PlutusLedgerApi.V1.Contexts ( +import PlutusLedgerApi.V1.Value qualified as Value (singleton) +import PlutusLedgerApi.V2 ( + Credential (PubKeyCredential), + OutputDatum (NoOutputDatum), + PubKeyHash (PubKeyHash), + ValidatorHash (ValidatorHash), + ) +import PlutusLedgerApi.V2.Contexts ( ScriptContext (..), TxInInfo (..), TxOut (..), TxOutRef (..), ) -import PlutusLedgerApi.V1.Scripts (ValidatorHash (ValidatorHash)) -import PlutusLedgerApi.V1.Value qualified as Value (singleton) import Sample.Shared ( gatCs, gatTn, @@ -60,7 +61,7 @@ baseCtxBuilder = mconcat [ credential trCredential , withValue minAda - , withTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049" + , withRefTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049" ] in mconcat [ txId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049" @@ -84,10 +85,10 @@ validCtx = mconcat [ script mockTrEffectHash , withValue (Value.singleton gatCs gatTn 1 <> minAda) - , withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3" + , withRefTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3" ] ] - in buildMintingUnsafe builder + in buildMinting' builder treasuryRef :: TxOutRef treasuryRef = @@ -108,7 +109,8 @@ walletIn = 0 , txInInfoResolved = TxOut - { txOutDatumHash = Nothing + { txOutDatum = NoOutputDatum + , txOutReferenceScript = Nothing , txOutValue = Value.singleton gatCs gatTn 1 , txOutAddress = Address @@ -127,7 +129,7 @@ trCtxGATNameNotAddress = mconcat [ script wrongEffHash , withValue (Value.singleton gatCs gatTn 1 <> minAda) - , withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3" + , withRefTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3" ] ] - in buildMintingUnsafe builder + in buildMinting' builder diff --git a/agora-specs/Spec/Effect/GovernorMutation.hs b/agora-specs/Spec/Effect/GovernorMutation.hs index 72a17e6..27645ee 100644 --- a/agora-specs/Spec/Effect/GovernorMutation.hs +++ b/agora-specs/Spec/Effect/GovernorMutation.hs @@ -5,7 +5,7 @@ import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor)) import Agora.Proposal (ProposalId (..)) import Agora.Scripts (AgoraScripts (..)) import Data.Default.Class (Default (def)) -import PlutusLedgerApi.V1 (ScriptContext (ScriptContext), ScriptPurpose (Spending)) +import PlutusLedgerApi.V2 (ScriptContext (ScriptContext), ScriptPurpose (Spending)) import Sample.Effect.GovernorMutation ( effectRef, govRef, diff --git a/agora-specs/Spec/Treasury.hs b/agora-specs/Spec/Treasury.hs index 03d60fb..ac0bf19 100644 --- a/agora-specs/Spec/Treasury.hs +++ b/agora-specs/Spec/Treasury.hs @@ -26,17 +26,17 @@ import Agora.Treasury ( treasuryValidator, ) import Agora.Utils (CompiledValidator (CompiledValidator)) -import Plutarch.Api.V1 (mkValidator) -import PlutusLedgerApi.V1 (DCert (DCertDelegRegKey)) -import PlutusLedgerApi.V1.Contexts ( - ScriptContext (scriptContextPurpose, scriptContextTxInfo), - ScriptPurpose (Certifying, Rewarding, Spending), - TxInfo (txInfoInputs, txInfoMint), - ) +import Plutarch.Api.V2 (mkValidator) import PlutusLedgerApi.V1.Credential ( StakingCredential (StakingHash), ) import PlutusLedgerApi.V1.Value qualified as Value (singleton) +import PlutusLedgerApi.V2 (DCert (DCertDelegRegKey)) +import PlutusLedgerApi.V2.Contexts ( + ScriptContext (scriptContextPurpose, scriptContextTxInfo), + ScriptPurpose (Certifying, Rewarding, Spending), + TxInfo (txInfoInputs, txInfoMint), + ) import Sample.Shared (deterministicTracingConfing, trCredential) import Sample.Treasury ( gatCs, diff --git a/agora-testlib/Test/Specification.hs b/agora-testlib/Test/Specification.hs index 2280af9..10ee3ec 100644 --- a/agora-testlib/Test/Specification.hs +++ b/agora-testlib/Test/Specification.hs @@ -49,18 +49,26 @@ module Test.Specification ( toTestTree, ) where -import Agora.Utils (CompiledEffect (..), CompiledMintingPolicy (..), CompiledValidator (..)) +import Agora.Utils ( + CompiledEffect (..), + CompiledMintingPolicy (..), + CompiledValidator (..), + ) import Control.Composition ((.**), (.***)) import Data.Coerce (coerce) import Plutarch.Evaluate (evalScript) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Scripts ( + Context (..), + applyMintingPolicyScript, + applyValidator, + ) +import PlutusLedgerApi.V2 ( Datum (..), Redeemer (Redeemer), Script, ScriptContext, ToData (toBuiltinData), ) -import PlutusLedgerApi.V1.Scripts (Context (..), applyMintingPolicyScript, applyValidator) import PlutusTx.IsData qualified as PlutusTx (ToData) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertFailure, testCase) diff --git a/agora-testlib/Test/Util.hs b/agora-testlib/Test/Util.hs index d0b0a7b..721f692 100644 --- a/agora-testlib/Test/Util.hs +++ b/agora-testlib/Test/Util.hs @@ -36,13 +36,16 @@ import Data.ByteString.Lazy qualified as ByteString.Lazy import Data.List (sortOn) import Plutarch.Context ( Builder, - buildMintingUnsafe, - buildSpendingUnsafe, + buildMinting', + buildSpending', withMinting, withSpendingOutRef, ) import Plutarch.Crypto (pblake2b_256) -import PlutusLedgerApi.V1 ( +import PlutusLedgerApi.V1.Interval qualified as PlutusTx +import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash)) +import PlutusLedgerApi.V1.Value (Value (..)) +import PlutusLedgerApi.V2 ( Credential ( PubKeyCredential, ScriptCredential @@ -53,9 +56,6 @@ import PlutusLedgerApi.V1 ( TxOutRef, ValidatorHash (ValidatorHash), ) -import PlutusLedgerApi.V1.Interval qualified as PlutusTx -import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash)) -import PlutusLedgerApi.V1.Value (Value (..)) import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.Builtins qualified as PlutusTx import PlutusTx.IsData qualified as PlutusTx @@ -190,7 +190,7 @@ mkSpending :: TxOutRef -> ScriptContext mkSpending mkBuilder ps oref = - buildSpendingUnsafe $ + buildSpending' $ mkBuilder ps <> withSpendingOutRef oref {- | Given the builder generator and the parameters, create a 'ScriptContext' @@ -203,7 +203,7 @@ mkMinting :: CurrencySymbol -> ScriptContext mkMinting mkBuilder ps cs = - buildMintingUnsafe $ + buildMinting' $ mkBuilder ps <> withMinting cs type CombinableBuilder b = (Monoid b, Builder b) diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index 630c07d..0642cbe 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -13,11 +13,15 @@ module Agora.AuthorityToken ( ) where import Plutarch.Api.V1 ( + PCredential (..), + PCurrencySymbol (..), + ) +import Plutarch.Api.V1.AssocMap (PMap (PMap)) +import Plutarch.Api.V1.Value (PValue (PValue)) +import Plutarch.Api.V2 ( AmountGuarantees, KeyGuarantees, PAddress (..), - PCredential (..), - PCurrencySymbol (..), PMintingPolicy, PScriptContext (..), PScriptPurpose (..), @@ -25,14 +29,12 @@ import Plutarch.Api.V1 ( PTxInfo (..), PTxOut (..), ) -import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf) -import Plutarch.Api.V1.AssocMap (PMap (PMap)) -import Plutarch.Api.V1.ScriptContext (pisTokenSpent) -import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf) -import "plutarch" Plutarch.Api.V1.Value (PValue (PValue)) import Plutarch.Builtin (pforgetData) +import Plutarch.Extra.AssetClass (passetClass, passetClassValueOf) import Plutarch.Extra.List (plookup) +import Plutarch.Extra.ScriptContext (pisTokenSpent) import Plutarch.Extra.TermCont (pguardC, pletFieldsC, pmatchC) +import Plutarch.Extra.Value (psymbolValueOf) import PlutusLedgerApi.V1.Value (AssetClass (AssetClass)) -------------------------------------------------------------------------------- diff --git a/agora/Agora/Bootstrap.hs b/agora/Agora/Bootstrap.hs index 17d97d3..8d0c157 100644 --- a/agora/Agora/Bootstrap.hs +++ b/agora/Agora/Bootstrap.hs @@ -19,7 +19,7 @@ import Agora.Utils ( CompiledValidator (..), ) import Plutarch (Config) -import Plutarch.Api.V1 ( +import Plutarch.Api.V2 ( mintingPolicySymbol, mkMintingPolicy, mkValidator, diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs index 4f94426..94636a6 100644 --- a/agora/Agora/Effect.hs +++ b/agora/Agora/Effect.hs @@ -10,11 +10,13 @@ module Agora.Effect (makeEffect) where import Agora.AuthorityToken (singleAuthorityTokenBurned) import Plutarch.Api.V1 ( PCurrencySymbol, + PValue, + ) +import Plutarch.Api.V2 ( PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator, - PValue, ) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) import Plutarch.TryFrom () diff --git a/agora/Agora/Effect/GovernorMutation.hs b/agora/Agora/Effect/GovernorMutation.hs index 22f539c..26a1c16 100644 --- a/agora/Agora/Effect/GovernorMutation.hs +++ b/agora/Agora/Effect/GovernorMutation.hs @@ -26,22 +26,22 @@ import Agora.Governor ( ) import Agora.Plutarch.Orphans () import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTAssetClass) -import Plutarch.Api.V1 ( +import Agora.Utils (pmustFindDatum) +import Plutarch.Api.V1 (PValue) +import Plutarch.Api.V2 ( PTxOutRef, PValidator, - PValue, ) -import Plutarch.Api.V1.ScriptContext (pisScriptAddress, ptryFindDatum) -import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pvalueOf) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, ) import Plutarch.Extra.Maybe ( - passertPDJust, passertPJust, ) +import Plutarch.Extra.ScriptContext (pisScriptAddress) import Plutarch.Extra.TermCont (pguardC, pletFieldsC) +import Plutarch.Extra.Value (pvalueOf) import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl) import PlutusLedgerApi.V1 (TxOutRef) import PlutusLedgerApi.V1.Value (AssetClass (..)) @@ -191,7 +191,7 @@ mutateGovernorValidator as = makeEffect (authorityTokenSymbol as) $ let govAddress = pfield @"address" #$ govInInfo.resolved govOutput' = phead # pfromData txInfoF.outputs - govOutput <- pletFieldsC @'["address", "value", "datumHash"] govOutput' + govOutput <- pletFieldsC @'["address", "value", "datum"] govOutput' pguardC "No output to the governor" $ govOutput.address #== govAddress @@ -199,11 +199,9 @@ mutateGovernorValidator as = makeEffect (authorityTokenSymbol as) $ pguardC "Governor output doesn't carry the GST" $ gstValueOf # govOutput.value #== 1 - let governorOutputDatumHash = - passertPDJust # "Governor output doesn't have datum" # govOutput.datumHash - governorOutputDatum = - passertPJust @PGovernorDatum # "Governor output datum not found" - #$ ptryFindDatum # governorOutputDatumHash # txInfoF.datums + let governorOutputDatum = + ptrace "Governor output datum not found" $ + pmustFindDatum @PGovernorDatum # govOutput.datum # txInfoF.datums -- Ensure the output governor datum is what we want. pguardC "Unexpected governor datum" $ datumF.newDatum #== governorOutputDatum diff --git a/agora/Agora/Effect/NoOp.hs b/agora/Agora/Effect/NoOp.hs index 4027a6c..f5db8a5 100644 --- a/agora/Agora/Effect/NoOp.hs +++ b/agora/Agora/Effect/NoOp.hs @@ -9,7 +9,7 @@ module Agora.Effect.NoOp (noOpValidator, PNoOp) where import Agora.Effect (makeEffect) import Agora.Plutarch.Orphans () -import Plutarch.Api.V1 (PValidator) +import Plutarch.Api.V2 (PValidator) import PlutusLedgerApi.V1.Value (CurrencySymbol) {- | Dummy datum for NoOp effect. diff --git a/agora/Agora/Effect/TreasuryWithdrawal.hs b/agora/Agora/Effect/TreasuryWithdrawal.hs index 3bb058b..1dc0080 100644 --- a/agora/Agora/Effect/TreasuryWithdrawal.hs +++ b/agora/Agora/Effect/TreasuryWithdrawal.hs @@ -16,20 +16,22 @@ module Agora.Effect.TreasuryWithdrawal ( import Agora.Effect (makeEffect) import Agora.Plutarch.Orphans () import Plutarch.Api.V1 ( - AmountGuarantees (Positive), - KeyGuarantees (Sorted), PCredential (..), - PTuple, - PValidator, PValue, ptuple, ) -import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisPubKey) -import "plutarch" Plutarch.Api.V1.Value (pnormalize) +import Plutarch.Api.V1.Value (pnormalize) +import Plutarch.Api.V2 ( + AmountGuarantees (Positive), + KeyGuarantees (Sorted), + PTuple, + PValidator, + ) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, ) +import Plutarch.Extra.ScriptContext (pfindTxInByTxOutRef, pisPubKey) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) import PlutusLedgerApi.V1.Credential (Credential) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 683815e..1525f90 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -43,33 +43,25 @@ import Agora.Stake ( pnumCreatedProposals, ) import Agora.Utils ( - mustFindDatum', + pfindDatum, + pfromDatumHash, + pmustFindDatum, validatorHashToAddress, ) import Plutarch.Api.V1 ( - PAddress, PCurrencySymbol, - PDatumHash, PMap, + PValidatorHash, + ) +import Plutarch.Api.V2 ( + PAddress, + PDatumHash, PMintingPolicy, PScriptPurpose (PMinting, PSpending), PTxOut, PValidator, - PValidatorHash, ) -import Plutarch.Api.V1.AssetClass ( - passetClass, - passetClassValueOf, - ) -import Plutarch.Api.V1.ScriptContext ( - pfindOutputsToAddress, - pfindTxInByTxOutRef, - pisUTXOSpent, - pscriptHashFromAddress, - ptryFindDatum, - pvalueSpent, - ) -import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf) +import Plutarch.Extra.AssetClass (passetClass, passetClassValueOf) import Plutarch.Extra.Field (pletAllC) import Plutarch.Extra.IsData (pmatchEnumFromData) import Plutarch.Extra.List (pfirstJust) @@ -77,9 +69,17 @@ import Plutarch.Extra.Map ( plookup, plookup', ) -import Plutarch.Extra.Maybe (passertPDJust, passertPJust, pfromJust, pisDJust) +import Plutarch.Extra.Maybe (passertPJust, pfromJust, pnothing) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) +import Plutarch.Extra.ScriptContext ( + pfindOutputsToAddress, + pfindTxInByTxOutRef, + pisUTXOSpent, + pscriptHashFromAddress, + pvalueSpent, + ) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) +import Plutarch.Extra.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf) import PlutusLedgerApi.V1 (TxOutRef) -------------------------------------------------------------------------------- @@ -140,8 +140,8 @@ governorPolicy initialSpend = ) # pfromData txInfoF.outputs - let datumHash = pfield @"datumHash" # govOutput - datum = mustFindDatum' @PGovernorDatum # datumHash # txInfoF.datums + let outputDatum = pfield @"datum" # govOutput + datum = pmustFindDatum @PGovernorDatum # outputDatum # txInfoF.datums pguardC "Governor output datum valid" $ pisGovernorDatumValid # datum @@ -265,18 +265,14 @@ governorValidator as = pguardC "Exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 - ownOutput <- pletFieldsC @'["value", "datumHash"] $ phead # ownOutputs + ownOutput <- pletFieldsC @'["value", "datum"] $ phead # ownOutputs let ownOuputGSTAmount = psymbolValueOf # pgstSymbol # ownOutput.value pguardC "State token should stay at governor's address" $ ownOuputGSTAmount #== 1 -- Check that own output have datum of type 'GovernorDatum'. - let outputGovernorStateDatumHash = - passertPDJust # "Governor output doesn't have datum" # ownOutput.datumHash newGovernorDatum <- - pletC $ - passertPJust # "Ouput governor state datum not found" - #$ ptryFindDatum # outputGovernorStateDatumHash # txInfoF.datums + pletC $ pmustFindDatum @PGovernorDatum # ownOutput.datum # txInfoF.datums pguardC "New datum is valid" $ pisGovernorDatumValid # newGovernorDatum @@ -323,12 +319,9 @@ governorValidator as = stakeInput <- pletC $ phead # stakeInputs - stakeInputF <- pletFieldsC @'["datumHash", "value"] $ pfield @"resolved" # stakeInput + stakeInputF <- pletFieldsC @'["datum", "value"] $ pfield @"resolved" # stakeInput - pguardC "Stake input doesn't have datum" $ - pisDJust # stakeInputF.datumHash - - let stakeInputDatum = mustFindDatum' @(PAsData PStakeDatum) # stakeInputF.datumHash # txInfoF.datums + let stakeInputDatum = pmustFindDatum @(PAsData PStakeDatum) # stakeInputF.datum # txInfoF.datums stakeInputDatumF <- pletAllC $ pto $ pfromData stakeInputDatum @@ -356,12 +349,10 @@ governorValidator as = pguardC "Exactly one UTXO with proposal state token should be sent to the proposal validator" $ plength # outputsToProposalValidatorWithStateToken #== 1 - outputDatumHash <- pletC $ pfield @"datumHash" #$ phead # outputsToProposalValidatorWithStateToken - proposalOutputDatum' <- pletC $ - mustFindDatum' @(PAsData PProposalDatum) - # outputDatumHash + pmustFindDatum @(PAsData PProposalDatum) + # (pfield @"datum" #$ phead # outputsToProposalValidatorWithStateToken) # txInfoF.datums proposalOutputDatum <- pletAllC $ pto $ pfromData proposalOutputDatum' @@ -396,31 +387,21 @@ governorValidator as = ] -- Check the output stake has been proposly updated. - let stakeOutputDatumHash = + let stakeOutputDatum = passertPJust # "Output stake should be presented" #$ pfirstJust - # phoistAcyclic - ( plam - ( \txOut -> unTermCont $ do - txOutF <- pletFieldsC @'["datumHash", "value"] txOut + # plam + ( \txOut -> unTermCont $ do + txOutF <- pletFieldsC @'["datum", "value"] txOut - pure $ - pif - (psymbolValueOf # psstSymbol # txOutF.value #== 1) - ( pcon $ - PJust $ - passertPDJust # "Output stake datum should be presented" - # txOutF.datumHash - ) - (pcon PNothing) - ) + pure $ + pif + (psymbolValueOf # psstSymbol # txOutF.value #== 1) + (pfindDatum @(PAsData PStakeDatum) # txOutF.datum # txInfoF.datums) + (pcon PNothing) ) # pfromData txInfoF.outputs - stakeOutputDatum = - passertPJust @(PAsData PStakeDatum) # "Stake output datum presented" - #$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums - stakeOutputLocks = pfromData $ pfield @"lockedBy" #$ pto $ pfromData stakeOutputDatum @@ -450,27 +431,24 @@ governorValidator as = pguardC "The governor can only process one proposal at a time" $ (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1 - proposalInputF <- - pletFieldsC @'["datumHash"] $ - pfield @"resolved" - #$ passertPJust - # "Proposal input not found" - #$ pfind - # plam - ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do - txOutF <- pletFieldsC @'["address", "value"] txOut - - pure $ - psymbolValueOf # ppstSymbol # txOutF.value #== 1 - #&& txOutF.address #== pdata pproposalValidatorAddress - ) - # pfromData txInfoF.inputs - proposalInputDatum <- pletC $ - mustFindDatum' @(PAsData PProposalDatum) - # proposalInputF.datumHash - # txInfoF.datums + passertPJust + # "Proposal input not found" + #$ pfirstJust + # plam + ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do + txOutF <- pletFieldsC @'["address", "value", "datum"] txOut + + pure $ + pif + ( psymbolValueOf # ppstSymbol # txOutF.value #== 1 + #&& txOutF.address #== pdata pproposalValidatorAddress + ) + (pfindDatum @(PAsData PProposalDatum) # txOutF.datum # txInfoF.datums) + pnothing + ) + # pfromData txInfoF.inputs proposalInputDatumF <- pletFieldsC @'["effects", "status", "thresholds", "votes"] $ @@ -516,14 +494,16 @@ governorValidator as = phoistAcyclic $ plam ( \effects output' -> unTermCont $ do - output <- pletFieldsC @'["address", "datumHash"] output' + output <- pletFieldsC @'["address", "datum"] output' let scriptHash = passertPJust # "GAT receiver is not a script" #$ pscriptHashFromAddress # output.address datumHash = - passertPDJust # "Output to effect should have datum" - #$ output.datumHash + ptrace + "Output to effect should have datum" + pfromDatumHash + # output.datum expectedDatumHash = passertPJust # "Receiver is not in the effect list" diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 8bc70af..2cccdb3 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -45,14 +45,13 @@ import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, Propos import Agora.SafeMoney (GTTag) import Data.Tagged (Tagged) import Generics.SOP qualified as SOP -import Plutarch.Api.V1 ( +import Plutarch.Api.V1 (PMap, PValidatorHash) +import Plutarch.Api.V1.AssocMap qualified as PAssocMap +import Plutarch.Api.V2 ( KeyGuarantees (Unsorted), PDatumHash, - PMap, PPubKeyHash, - PValidatorHash, ) -import Plutarch.Api.V1.AssocMap qualified as PAssocMap import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields) import Plutarch.Extra.Comonad (pextract) import Plutarch.Extra.Field (pletAllC) diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 1da4178..24fc520 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -37,10 +37,12 @@ import Agora.Stake ( pisVoter, ) import Agora.Utils ( - mustFindDatum', + pfromDatumHash, pltAsData, + pmustFindDatum, + ptryFindDatum, ) -import Plutarch.Api.V1 ( +import Plutarch.Api.V2 ( PDatumHash, PMintingPolicy, PPubKeyHash, @@ -50,21 +52,19 @@ import Plutarch.Api.V1 ( PTxOut, PValidator, ) -import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf) -import Plutarch.Api.V1.ScriptContext ( - pfindTxInByTxOutRef, - pisTokenSpent, - ptryFindDatum, - ptxSignedBy, - ) -import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf) +import Plutarch.Extra.AssetClass (passetClass, passetClassValueOf) import Plutarch.Extra.Comonad (pextract) import Plutarch.Extra.Field (pletAllC) import Plutarch.Extra.IsData (pmatchEnum) import Plutarch.Extra.List (pisUniq', pmapMaybe, pmergeBy, pmsortBy) import Plutarch.Extra.Map (plookup, pupdate) -import Plutarch.Extra.Maybe (passertPJust, pfromDJust, pfromJust, pisJust) +import Plutarch.Extra.Maybe (passertPJust, pfromJust, pisJust) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) +import Plutarch.Extra.ScriptContext ( + pfindTxInByTxOutRef, + pisTokenSpent, + ptxSignedBy, + ) import Plutarch.Extra.TermCont ( pguardC, pletC, @@ -72,6 +72,7 @@ import Plutarch.Extra.TermCont ( pmatchC, ptryFromC, ) +import Plutarch.Extra.Value (psymbolValueOf) import Plutarch.SafeMoney (PDiscrete (..)) import Plutarch.Unsafe (punsafeCoerce) import PlutusLedgerApi.V1.Value (AssetClass (AssetClass)) @@ -213,8 +214,8 @@ proposalValidator as maximumCosigners = -- Maybe we can cache the sorted datum map? let datum = pfromData $ - mustFindDatum' @(PAsData PProposalDatum) - # inputF.datumHash + pmustFindDatum @(PAsData PProposalDatum) + # inputF.datum # txInfoF.datums proposalId = pfield @"proposalId" # pto datum @@ -229,8 +230,8 @@ proposalValidator as maximumCosigners = proposalOut <- pletC $ pfromData $ - mustFindDatum' @(PAsData PProposalDatum) - # (pfield @"datumHash" # ownOutput) + pmustFindDatum @(PAsData PProposalDatum) + # (pfield @"datum" # ownOutput) # txInfoF.datums proposalUnchanged <- pletC $ proposalOut #== proposalDatum @@ -267,11 +268,11 @@ proposalValidator as maximumCosigners = filterStakeDatumHash :: Term _ (PTxOut :--> PMaybe (PAsData PDatumHash)) <- pletC $ plam $ \txOut -> unTermCont $ do - txOutF <- pletFieldsC @'["value", "datumHash"] txOut + txOutF <- pletFieldsC @'["value", "datum"] txOut pure $ pif (passetClassValueOf # txOutF.value # stakeSTAssetClass #== 1) - ( let datumHash = pfromDJust # txOutF.datumHash + ( let datumHash = pfromDatumHash # txOutF.datum in pcon $ PJust $ pdata datumHash ) (pcon PNothing) diff --git a/agora/Agora/Proposal/Time.hs b/agora/Agora/Proposal/Time.hs index 97d6196..4929370 100644 --- a/agora/Agora/Proposal/Time.hs +++ b/agora/Agora/Proposal/Time.hs @@ -36,9 +36,9 @@ import Plutarch.Api.V1 ( PInterval (PInterval), PLowerBound (PLowerBound), PPOSIXTime, - PPOSIXTimeRange, PUpperBound (PUpperBound), ) +import Plutarch.Api.V2 (PPOSIXTimeRange) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, diff --git a/agora/Agora/Scripts.hs b/agora/Agora/Scripts.hs index 9a76167..2548eb1 100644 --- a/agora/Agora/Scripts.hs +++ b/agora/Agora/Scripts.hs @@ -23,11 +23,14 @@ import Agora.Governor (GovernorDatum, GovernorRedeemer) import Agora.Proposal (ProposalDatum, ProposalRedeemer) import Agora.Stake (StakeDatum, StakeRedeemer) import Agora.Treasury (TreasuryRedeemer) -import Agora.Utils (CompiledMintingPolicy (..), CompiledValidator (..), validatorHashToTokenName) -import Plutarch.Api.V1 (mintingPolicySymbol, validatorHash) -import PlutusLedgerApi.V1 (CurrencySymbol) -import PlutusLedgerApi.V1.Scripts (ValidatorHash) +import Agora.Utils ( + CompiledMintingPolicy (..), + CompiledValidator (..), + validatorHashToTokenName, + ) +import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash) import PlutusLedgerApi.V1.Value (AssetClass (..)) +import PlutusLedgerApi.V2 (CurrencySymbol, ValidatorHash) {- | Precompiled core scripts. diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 423f347..ece3c7f 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -34,7 +34,7 @@ import Agora.Proposal (PProposalId, PResultTag, ProposalId (..), ResultTag (..)) import Agora.SafeMoney (GTTag) import Data.Tagged (Tagged (..)) import Generics.SOP qualified as SOP -import Plutarch.Api.V1 ( +import Plutarch.Api.V2 ( PMaybeData, PPubKeyHash, ) diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index f76deb4..8b40adf 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -16,30 +16,41 @@ import Agora.Stake ( pstakeLocked, ) import Agora.Utils ( - mustFindDatum', + pfromDatumHash, + pmustFindDatum, ) import Data.Function (on) import Data.Tagged (Tagged (..), untag) import Plutarch.Api.V1 ( - AmountGuarantees (Positive), PCredential (PPubKeyCredential, PScriptCredential), + PTokenName, + PValue, + ) +import Plutarch.Api.V2 ( + AmountGuarantees (Positive), PDatumHash, PMintingPolicy, PScriptPurpose (PMinting, PSpending), - PTokenName, PTxInfo, PTxOut, PValidator, - PValue, ) -import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf) -import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, ptxSignedBy, pvalueSpent) -import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pgeqByClass', pgeqBySymbol, psymbolValueOf) +import Plutarch.Extra.AssetClass ( + passetClass, + passetClassValueOf, + pvalueOf, + ) import Plutarch.Extra.Field (pletAllC) import Plutarch.Extra.List (pmapMaybe, pmsortBy) -import Plutarch.Extra.Maybe (passertPJust, pdjust, pdnothing, pfromDJust, pmaybeData) +import Plutarch.Extra.Maybe (passertPJust, pdjust, pdnothing, pmaybeData) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) +import Plutarch.Extra.ScriptContext (pfindTxInByTxOutRef, ptxSignedBy, pvalueSpent) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) +import Plutarch.Extra.Value ( + pgeqByClass', + pgeqBySymbol, + psymbolValueOf, + ) import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+))) import Plutarch.SafeMoney ( pdiscreteValue', @@ -96,14 +107,14 @@ stakePolicy gtClassRef = pany # plam ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do - txOutF <- pletFieldsC @'["value", "datumHash"] txOut + txOutF <- pletFieldsC @'["value", "datum"] txOut pure $ pif (psymbolValueOf # ownSymbol # txOutF.value #== 1) ( let datum = pfromData $ - mustFindDatum' @(PAsData PStakeDatum) - # txOutF.datumHash + pmustFindDatum @(PAsData PStakeDatum) + # txOutF.datum # txInfoF.datums in pnot # (pstakeLocked # datum) ) @@ -141,12 +152,12 @@ stakePolicy gtClassRef = # pfromData txInfoF.outputs outputF <- - pletFieldsC @'["value", "address", "datumHash"] scriptOutputWithStakeST + pletFieldsC @'["value", "address", "datum"] scriptOutputWithStakeST datumF <- pletFieldsC @'["owner", "stakedAmount"] $ pto $ pfromData $ - mustFindDatum' @(PAsData PStakeDatum) # outputF.datumHash # txInfoF.datums + pmustFindDatum @(PAsData PStakeDatum) # outputF.datum # txInfoF.datums let hasExpectedStake = ptraceIfFalse "Stake ouput has expected amount of stake token" $ @@ -344,7 +355,7 @@ stakeValidator as gtClassRef = sortTxOuts = phoistAcyclic $ plam (pmsortBy # plam ((#<) `on` (getDatumHash #)) #) where getDatumHash :: Term _ (PTxOut :--> PDatumHash) - getDatumHash = phoistAcyclic $ plam ((pfromDJust #) . pfromData . (pfield @"datumHash" #)) + getDatumHash = phoistAcyclic $ plam ((pfromDatumHash #) . (pfield @"datum" #)) sortedOwnInputs = sortTxOuts # ownInputs sortedOwnOutputs = sortTxOuts # ownOutputs @@ -365,8 +376,8 @@ stakeValidator as gtClassRef = stakeOut <- pletC $ pfromData $ - mustFindDatum' @(PAsData PStakeDatum) - # (pfield @"datumHash" # ownOutput) + pmustFindDatum @(PAsData PStakeDatum) + # (pfield @"datum" # ownOutput) # txInfoF.datums ownOutputValue <- diff --git a/agora/Agora/Treasury.hs b/agora/Agora/Treasury.hs index e5b3733..b411efe 100644 --- a/agora/Agora/Treasury.hs +++ b/agora/Agora/Treasury.hs @@ -12,9 +12,8 @@ module Agora.Treasury (module Agora.Treasury) where import Agora.AuthorityToken (singleAuthorityTokenBurned) import Generics.SOP qualified as SOP -import Plutarch.Api.V1 (PValidator) -import Plutarch.Api.V1.Contexts (PScriptPurpose (PMinting)) -import "plutarch" Plutarch.Api.V1.Value (PValue) +import Plutarch.Api.V1.Value (PValue) +import Plutarch.Api.V2 (PScriptPurpose (PMinting), PValidator) import Plutarch.Builtin (pforgetData) import Plutarch.Extra.IsData ( DerivePConstantViaEnum (..), diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 97a7cd0..61f36eb 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -10,26 +10,32 @@ Plutarch utility functions that should be upstreamed or don't belong anywhere el -} module Agora.Utils ( validatorHashToTokenName, - mustFindDatum', validatorHashToAddress, pltAsData, withBuiltinPairAsData, CompiledValidator (..), CompiledMintingPolicy (..), CompiledEffect (..), + presolveOutputDatum, + pfindDatum, + pmustFindDatum, + (#.*), + (#.**), + pfromDatumHash, + pfromInlineDatum, + ptryFindDatum, ) where -import Plutarch.Api.V1 ( +import Plutarch.Api.V1.AssocMap (KeyGuarantees (Unsorted), PMap) +import Plutarch.Api.V1.AssocMap qualified as PAssocMap +import Plutarch.Api.V2 ( PDatum, PDatumHash, - PMaybeData, - PTuple, + POutputDatum (..), ) -import Plutarch.Builtin (pforgetData) -import Plutarch.Extra.List (plookupTuple) -import Plutarch.Extra.Maybe (passertPDJust, passertPJust) -import Plutarch.Extra.TermCont (ptryFromC) -import PlutusLedgerApi.V1 ( +import Plutarch.Extra.Functor (pfmap) +import Plutarch.Extra.Maybe (passertPJust, pjust, pnothing) +import PlutusLedgerApi.V2 ( Address (..), Credential (..), MintingPolicy, @@ -50,27 +56,6 @@ import PlutusLedgerApi.V1 ( validatorHashToTokenName :: ValidatorHash -> TokenName validatorHashToTokenName (ValidatorHash hash) = TokenName hash -{- | Find datum given a maybe datum hash - - @since 0.1.0 --} -mustFindDatum' :: - forall (datum :: PType). - (PIsData datum, PTryFrom PData datum) => - forall s. - Term - s - ( PMaybeData PDatumHash - :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum)) - :--> datum - ) -mustFindDatum' = phoistAcyclic $ - plam $ \mdh datums -> unTermCont $ do - let dh = passertPDJust # "Given TxOut dones't have a datum" # mdh - dt = passertPJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums - (d, _) <- ptryFromC $ pforgetData $ pdata dt - pure d - {- | Create an 'Address' from a given 'ValidatorHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'. @since 0.1.0 @@ -130,3 +115,123 @@ newtype CompiledMintingPolicy (redeemer :: Type) = CompiledMintingPolicy newtype CompiledEffect (datum :: Type) = CompiledEffect { getCompiledEffect :: Validator } + +-- @since 0.3.0 +presolveOutputDatum :: + forall s. + Term + s + ( POutputDatum + :--> PMap 'Unsorted PDatumHash PDatum + :--> PMaybe PDatum + ) +presolveOutputDatum = phoistAcyclic $ + plam $ \od m -> pmatch od $ \case + PNoOutputDatum _ -> + ptrace "no datum" pnothing + POutputDatum ((pfield @"outputDatum" #) -> datum) -> + ptrace "datum hash" pjust # datum + POutputDatumHash ((pfield @"datumHash" #) -> hash) -> + PAssocMap.plookup + # hash + # m + +-- | @since 0.3.0 +pfindDatum :: + forall datum s. + PTryFrom PData datum => + Term + s + ( POutputDatum + :--> PMap 'Unsorted PDatumHash PDatum + :--> PMaybe datum + ) +pfindDatum = phoistAcyclic $ + plam $ \od m -> + pfmap + # phoistAcyclic (plam $ flip ptryFrom fst . pto) + # (presolveOutputDatum # od # m) + +-- | @since 0.3.0 +pmustFindDatum :: + forall datum s. + (PIsData datum, PTryFrom PData datum) => + Term + s + ( POutputDatum + :--> PMap 'Unsorted PDatumHash PDatum + :--> datum + ) +pmustFindDatum = + phoistAcyclic $ + plam $ + (passertPJust # "datum not found") #.* pfindDatum + +-- | @since 0.3.0 +pfromDatumHash :: forall s. Term s (POutputDatum :--> PDatumHash) +pfromDatumHash = phoistAcyclic $ + plam $ + flip pmatch $ \case + POutputDatumHash ((pfield @"datumHash" #) -> hash) -> hash + _ -> ptraceError "not a datum hash" + +-- | @since 0.3.0 +pfromInlineDatum :: forall s. Term s (POutputDatum :--> PDatum) +pfromInlineDatum = phoistAcyclic $ + plam $ + flip pmatch $ \case + POutputDatum ((pfield @"outputDatum" #) -> datum) -> datum + _ -> ptraceError "not an inline datum" + +{- | Find a datum with the given hash, and 'ptryFrom' it. + + @since 0.3.0 +-} +ptryFindDatum :: + forall datum (s :: S). + PTryFrom PData datum => + Term + s + ( PDatumHash + :--> PMap 'Unsorted PDatumHash PDatum + :--> PMaybe datum + ) +ptryFindDatum = + phoistAcyclic $ + plam $ + (pfmap # ptryFromDatum) + #.* PAssocMap.plookup + +{- | Convert a 'PDatum' to the given datum type. + + @since 0.3.0 +-} +ptryFromDatum :: + forall datum s. + (PTryFrom PData datum) => + Term s (PDatum :--> datum) +ptryFromDatum = phoistAcyclic $ plam $ flip ptryFrom fst . pto + +infixr 8 #.* +infixr 8 #.** + +-- | @since 0.3.0 +(#.*) :: + forall d c b a s. + Term s (c :--> d) -> + Term s (a :--> b :--> c) -> + Term s a -> + Term s b -> + Term s d +(#.*) f g x y = f #$ g # x # y + +-- | @since 0.3.0 +(#.**) :: + forall e d c b a s. + Term s (d :--> e) -> + Term s (a :--> b :--> c :--> d) -> + Term s a -> + Term s b -> + Term s c -> + Term s e +(#.**) f g x y z = f #$ g # x # y # z