diff --git a/agora-specs/Property/Governor.hs b/agora-specs/Property/Governor.hs index 7925e80..5bd5097 100644 --- a/agora-specs/Property/Governor.hs +++ b/agora-specs/Property/Governor.hs @@ -30,6 +30,7 @@ import Plutarch.Context ( output, script, withDatum, + withMinting, withOutRef, withValue, ) @@ -43,6 +44,7 @@ import PlutusLedgerApi.V1.Value (assetClassValue) import Property.Generator (genInput, genOutput) import Sample.Shared ( govAssetClass, + govSymbol, govValidatorHash, governor, gstUTXORef, @@ -181,7 +183,7 @@ governorMintingProperty = GovernorOutputNotFound -> referencedInput <> mintAmount 1 GovernorPolicyCorrect -> referencedInput <> outputToGov <> mintAmount 1 - return . buildMintingUnsafe $ inputs <> outputs <> comp + return . buildMintingUnsafe $ inputs <> outputs <> comp <> withMinting govSymbol expected :: ScriptContext -> Maybe () expected sc = diff --git a/agora-specs/Sample/Governor/Initialize.hs b/agora-specs/Sample/Governor/Initialize.hs index db7f1d7..4bdc0e3 100644 --- a/agora-specs/Sample/Governor/Initialize.hs +++ b/agora-specs/Sample/Governor/Initialize.hs @@ -30,8 +30,6 @@ import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalTimin import Data.Default (Default (..)) import Plutarch.Api.V1 (mintingPolicySymbol, mkMintingPolicy) import Plutarch.Context ( - BaseBuilder, - buildTxInfoUnsafe, input, mint, output, @@ -46,9 +44,6 @@ import Plutarch.Context ( import PlutusLedgerApi.V1 ( CurrencySymbol, MintingPolicy, - ScriptContext (..), - ScriptPurpose (Minting), - TxInfo, TxOutRef (TxOutRef), ValidatorHash, ) @@ -59,7 +54,7 @@ import Sample.Shared ( ) import Sample.Shared qualified as Shared import Test.Specification (SpecificationTree, testPolicy) -import Test.Util (pubKeyHashes, sortValue) +import Test.Util (CombinableBuilder, mkMinting, pubKeyHashes, sortValue) data Parameters = Parameters { datumThresholdsValid :: Bool @@ -115,8 +110,8 @@ govSymbol = mintingPolicySymbol govPolicy -------------------------------------------------------------------------------- -mintGST :: Parameters -> TxInfo -mintGST ps = buildTxInfoUnsafe builder +mintGST :: forall b. CombinableBuilder b => Parameters -> b +mintGST ps = builder where gstAC = if ps.mintStateTokenWithName @@ -149,7 +144,6 @@ mintGST ps = buildTxInfoUnsafe builder --- - witnessBuilder :: BaseBuilder witnessBuilder = if ps.presentWitness then @@ -166,7 +160,6 @@ mintGST ps = buildTxInfoUnsafe builder --- - govBuilder :: BaseBuilder govBuilder = let datum = if ps.withGovernorDatum @@ -177,8 +170,6 @@ mintGST ps = buildTxInfoUnsafe builder . withValue governorValue . datum -- - - builder :: BaseBuilder builder = mconcat [ txId "986b756ffb1c9839fc8d0b22a308ac91d5b5d0ebbfa683a47588c8a5cf70b5af" @@ -247,17 +238,10 @@ mintGSTWithNoneEmptyNameParameters = -------------------------------------------------------------------------------- mkTestCase :: String -> Parameters -> Bool -> SpecificationTree -mkTestCase - name - ps - valid = policyTest - where - txInfo = mintGST ps - - policyTest = - testPolicy - valid - name - (governorPolicy governor) - () - (ScriptContext txInfo (Minting govSymbol)) +mkTestCase name ps valid = + testPolicy + valid + name + (governorPolicy governor) + () + (mkMinting mintGST ps govSymbol) diff --git a/agora-specs/Sample/Governor/Mutate.hs b/agora-specs/Sample/Governor/Mutate.hs index 8b789b0..fa818e4 100644 --- a/agora-specs/Sample/Governor/Mutate.hs +++ b/agora-specs/Sample/Governor/Mutate.hs @@ -24,8 +24,6 @@ import Agora.Utils (validatorHashToTokenName) import Data.Default (def) import Plutarch.Api.V1 (PValidator, mkValidator, validatorHash) import Plutarch.Context ( - BaseBuilder, - buildTxInfoUnsafe, input, mint, output, @@ -37,9 +35,6 @@ import Plutarch.Context ( ) import PlutusLedgerApi.V1 ( Data, - ScriptContext (ScriptContext), - ScriptPurpose (Spending), - TxInfo, TxOutRef (TxOutRef), ValidatorHash, Value, @@ -54,7 +49,7 @@ import Sample.Shared ( minAda, ) import Test.Specification (SpecificationTree, testValidator) -import Test.Util (pubKeyHashes, sortValue, validatorHashes, withOptional) +import Test.Util (CombinableBuilder, mkSpending, pubKeyHashes, sortValue, validatorHashes, withOptional) -------------------------------------------------------------------------------- @@ -131,13 +126,10 @@ governorRef = "6cce6dfbb697f9e2c4fe9786bb576eb7bd6cbcf7801a4ba13d596006c2d5b957" 1 -governorScriptPurpose :: ScriptPurpose -governorScriptPurpose = Spending governorRef - governorRedeemer :: GovernorRedeemer governorRedeemer = MutateGovernor -mkGovernorBuilder :: GovernorParameters -> BaseBuilder +mkGovernorBuilder :: forall b. CombinableBuilder b => GovernorParameters -> b mkGovernorBuilder ps = let gst = Value.assetClassValue govAssetClass 1 value = sortValue $ gst <> minAda @@ -179,7 +171,7 @@ mkGATValue v q = (validatorHashToTokenName gatOwner) q -mkMockEffectBuilder :: MockEffectParameters -> BaseBuilder +mkMockEffectBuilder :: forall b. CombinableBuilder b => MockEffectParameters -> b mkMockEffectBuilder ps = let mkGATValue' = mkGATValue ps.gatValidity inputValue = mkGATValue' 1 @@ -200,13 +192,12 @@ mkMockEffectBuilder ps = -------------------------------------------------------------------------------- -mutate :: ParameterBundle -> TxInfo +mutate :: forall b. CombinableBuilder b => ParameterBundle -> b mutate pb = - buildTxInfoUnsafe $ - mconcat - [ mkGovernorBuilder pb.governorParameters - , mkMockEffectBuilder pb.mockEffectParameters - ] + mconcat + [ mkGovernorBuilder pb.governorParameters + , mkMockEffectBuilder pb.mockEffectParameters + ] -------------------------------------------------------------------------------- @@ -218,10 +209,7 @@ mkTestCase name pb (Validity forGov) = (governorValidator governor) governorInputDatum governorRedeemer - ( ScriptContext - (mutate pb) - governorScriptPurpose - ) + (mkSpending mutate pb governorRef) -------------------------------------------------------------------------------- diff --git a/agora-specs/Sample/Proposal/Advance.hs b/agora-specs/Sample/Proposal/Advance.hs index 28ec0e9..8c2665c 100644 --- a/agora-specs/Sample/Proposal/Advance.hs +++ b/agora-specs/Sample/Proposal/Advance.hs @@ -79,8 +79,6 @@ import Data.List (sort) import Data.Maybe (catMaybes, fromJust) import Data.Tagged (Tagged (..), untag) import Plutarch.Context ( - BaseBuilder, - buildTxInfoUnsafe, input, mint, output, @@ -97,9 +95,6 @@ import PlutusLedgerApi.V1 ( POSIXTime, POSIXTimeRange, PubKeyHash, - ScriptContext (ScriptContext), - ScriptPurpose (Minting, Spending), - TxInfo, TxOutRef (TxOutRef), ValidatorHash, ) @@ -131,9 +126,12 @@ import Test.Specification ( testValidator, ) import Test.Util ( + CombinableBuilder, closedBoundedInterval, datumHash, groupsOfN, + mkMinting, + mkSpending, pubKeyHashes, sortValue, toDatum, @@ -264,7 +262,7 @@ mkProposalOutputDatum ps = proposalRef :: TxOutRef proposalRef = TxOutRef proposalTxRef 1 -mkProposalBuilder :: ProposalParameters -> BaseBuilder +mkProposalBuilder :: forall b. CombinableBuilder b => ProposalParameters -> b mkProposalBuilder ps = let pst = Value.singleton proposalPolicySymbol "" 1 value = sortValue $ minAda <> pst @@ -280,10 +278,6 @@ mkProposalBuilder ps = . withValue value ] --- | Script purpose of the proposal validator. -proposalScriptPurpose :: ScriptPurpose -proposalScriptPurpose = Spending proposalRef - {- | The proposal redeemer used to spend the proposal UTXO, which is always 'AdvanceProposal' in this case. -} @@ -327,7 +321,7 @@ getStakeInputDatumAt ps = (!!) (mkStakeInputDatums ps) mkStakeRef :: Index -> TxOutRef mkStakeRef = TxOutRef stakeTxRef . (+ 3) . fromIntegral -mkStakeBuilder :: StakeParameters -> BaseBuilder +mkStakeBuilder :: forall b. CombinableBuilder b => StakeParameters -> b mkStakeBuilder ps = let perStakeValue = sortValue $ @@ -360,10 +354,6 @@ mkStakeBuilder ps = (mkStakeInputDatums ps) (mkStakeOutputDatums ps) --- | Script purpose of the stake validator, given which stake we want to spend. -getStakeScriptPurposeAt :: Index -> ScriptPurpose -getStakeScriptPurposeAt = Spending . mkStakeRef - {- | The proposal redeemer used to spend the stake UTXO, which is always 'WitnessStake' in this case. -} @@ -394,7 +384,7 @@ mkGovernorOutputDatum ps = governorRef :: TxOutRef governorRef = TxOutRef governorTxRef 2 -mkGovernorBuilder :: GovernorParameters -> BaseBuilder +mkGovernorBuilder :: forall b. CombinableBuilder b => GovernorParameters -> b mkGovernorBuilder ps = let gst = Value.assetClassValue govAssetClass 1 value = sortValue $ gst <> minAda @@ -411,9 +401,6 @@ mkGovernorBuilder ps = . withDatum (mkGovernorOutputDatum ps) ] -governorScriptPurpose :: ScriptPurpose -governorScriptPurpose = Spending governorRef - {- | The proposal redeemer used to spend the governor UTXO, which is always 'MintGATs' in this case. -} @@ -424,11 +411,11 @@ governorRedeemer = MintGATs -- * Authority Token -mkAuthorityTokenBuilder :: AuthorityTokenParameters -> BaseBuilder +mkAuthorityTokenBuilder :: forall b. CombinableBuilder b => AuthorityTokenParameters -> b mkAuthorityTokenBuilder (AuthorityTokenParameters es mdt invalidTokenName) = foldMap perEffect es where - perEffect :: ValidatorHash -> BaseBuilder + perEffect :: ValidatorHash -> b perEffect vh = let tn = if invalidTokenName @@ -445,9 +432,6 @@ mkAuthorityTokenBuilder (AuthorityTokenParameters es mdt invalidTokenName) = . withValue value ] -authorityTokenScriptPurepose :: ScriptPurpose -authorityTokenScriptPurepose = Minting authorityTokenSymbol - authorityTokenRedeemer :: () authorityTokenRedeemer = () @@ -455,19 +439,20 @@ authorityTokenRedeemer = () -- | Create a 'TxInfo' that update the status of a proposal. advance :: + forall b. + CombinableBuilder b => ParameterBundle -> - TxInfo + b advance pb = let mkBuilderMaybe = maybe mempty - in buildTxInfoUnsafe $ - mconcat - [ mkProposalBuilder pb.proposalParameters - , mkStakeBuilder pb.stakeParameters - , mkBuilderMaybe mkGovernorBuilder pb.governorParameters - , mkBuilderMaybe mkAuthorityTokenBuilder pb.authorityTokenParameters - , timeRange pb.transactionTimeRange - , maybe mempty signedWith pb.extraSignature - ] + in mconcat + [ mkProposalBuilder pb.proposalParameters + , mkStakeBuilder pb.stakeParameters + , mkBuilderMaybe mkGovernorBuilder pb.governorParameters + , mkBuilderMaybe mkAuthorityTokenBuilder pb.authorityTokenParameters + , timeRange pb.transactionTimeRange + , maybe mempty signedWith pb.extraSignature + ] -------------------------------------------------------------------------------- @@ -479,13 +464,14 @@ mkTestTree :: ParameterBundle -> Validity -> SpecificationTree -mkTestTree name params val = +mkTestTree name pb val = group name $ catMaybes [proposal, stake, governor, authority] where - txInfo = advance params + spend = mkSpending advance pb + mint = mkMinting advance pb proposal = - let proposalInputDatum = mkProposalInputDatum params.proposalParameters + let proposalInputDatum = mkProposalInputDatum pb.proposalParameters in Just $ testValidator val.forProposalValidator @@ -493,10 +479,7 @@ mkTestTree name params val = (proposalValidator Shared.proposal) proposalInputDatum proposalRedeemer - ( ScriptContext - txInfo - proposalScriptPurpose - ) + (spend proposalRef) stake = let idx = 0 @@ -505,11 +488,9 @@ mkTestTree name params val = val.forStakeValidator "stake" (stakeValidator Shared.stake) - (getStakeInputDatumAt params.stakeParameters idx) + (getStakeInputDatumAt pb.stakeParameters idx) stakeRedeemer - ( ScriptContext - txInfo - (getStakeScriptPurposeAt idx) + ( spend (mkStakeRef idx) ) governor = @@ -519,11 +500,8 @@ mkTestTree name params val = (governorValidator Shared.governor) governorInputDatum governorRedeemer - ( ScriptContext - txInfo - governorScriptPurpose - ) - <$ params.governorParameters + (spend governorRef) + <$ pb.governorParameters authority = testPolicy @@ -531,11 +509,8 @@ mkTestTree name params val = "authority" (authorityTokenPolicy $ AuthorityToken Shared.govAssetClass) authorityTokenRedeemer - ( ScriptContext - txInfo - authorityTokenScriptPurepose - ) - <$ (params.authorityTokenParameters) + (mint authorityTokenSymbol) + <$ (pb.authorityTokenParameters) mkTestTree' :: String -> diff --git a/agora-specs/Sample/Proposal/Cosign.hs b/agora-specs/Sample/Proposal/Cosign.hs index a344af3..4922c04 100644 --- a/agora-specs/Sample/Proposal/Cosign.hs +++ b/agora-specs/Sample/Proposal/Cosign.hs @@ -40,8 +40,6 @@ import Data.Default (def) import Data.List (sort) import Data.Tagged (Tagged, untag) import Plutarch.Context ( - BaseBuilder, - buildTxInfoUnsafe, input, output, script, @@ -49,16 +47,13 @@ import Plutarch.Context ( timeRange, txId, withDatum, - withRefIndex, + withOutRef, withTxId, withValue, ) import PlutusLedgerApi.V1 ( POSIXTimeRange, PubKeyHash, - ScriptContext (ScriptContext), - ScriptPurpose (Spending), - TxInfo, TxOutRef (..), Value, ) @@ -80,7 +75,7 @@ import Test.Specification ( group, testValidator, ) -import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue) +import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes, sortValue) -- | Parameters for cosigning a proposal. data Parameters = Parameters @@ -138,8 +133,8 @@ mkStakeInputDatums :: Parameters -> [StakeDatum] mkStakeInputDatums = fmap (\pk -> StakeDatum perStakedGTs pk []) . newCosigners -- | Create a 'TxInfo' that tries to cosign a proposal with new cosigners. -cosign :: Parameters -> TxInfo -cosign ps = buildTxInfoUnsafe builder +cosign :: forall b. CombinableBuilder b => Parameters -> b +cosign ps = builder where pst = Value.singleton proposalPolicySymbol "" 1 sst = Value.assetClassValue stakeAssetClass 1 @@ -158,7 +153,6 @@ cosign ps = buildTxInfoUnsafe builder (untag perStakedGTs) <> sst - stakeBuilder :: BaseBuilder stakeBuilder = foldMap ( \(stakeDatum, refIdx) -> @@ -166,13 +160,13 @@ cosign ps = buildTxInfoUnsafe builder if ps.alterOutputStakes then stakeDatum {stakedAmount = 0} else stakeDatum - in mconcat @BaseBuilder + in mconcat [ input $ script stakeValidatorHash . withValue stakeValue . withDatum stakeDatum . withTxId stakeTxRef - . withRefIndex refIdx + . withOutRef (mkStakeRef refIdx) , output $ script stakeValidatorHash . withValue stakeValue @@ -182,7 +176,7 @@ cosign ps = buildTxInfoUnsafe builder ) $ zip stakeInputDatums - [2 ..] + [0 ..] --- @@ -192,7 +186,6 @@ cosign ps = buildTxInfoUnsafe builder proposalOutputDatum :: ProposalDatum proposalOutputDatum = mkProposalOutputDatum ps - proposalBuilder :: BaseBuilder proposalBuilder = mconcat [ input $ @@ -200,7 +193,7 @@ cosign ps = buildTxInfoUnsafe builder . withValue pst . withDatum proposalInputDatum . withTxId proposalTxRef - . withRefIndex proposalRefIdx + . withOutRef proposalRef , output $ script proposalValidatorHash . withValue (sortValue (pst <> minAda)) @@ -217,7 +210,6 @@ cosign ps = buildTxInfoUnsafe builder --- - builder :: BaseBuilder builder = mconcat [ txId "05c67819fc3381a2052b929ab439244b7b5fe3b3bd07f2134055bbbb21bd9e52" @@ -231,21 +223,15 @@ proposalRefIdx :: Integer proposalRefIdx = 1 -- | Spend the proposal ST. -proposalScriptPurpose :: ScriptPurpose -proposalScriptPurpose = - Spending - ( TxOutRef - proposalTxRef - proposalRefIdx - ) +proposalRef :: TxOutRef +proposalRef = TxOutRef proposalTxRef proposalRefIdx -- | Consume the given stake. -mkStakeScriptPurpose :: Int -> ScriptPurpose -mkStakeScriptPurpose idx = - Spending $ - TxOutRef - stakeTxRef - $ proposalRefIdx + 1 + fromIntegral idx +mkStakeRef :: Int -> TxOutRef +mkStakeRef idx = + TxOutRef + stakeTxRef + $ proposalRefIdx + 1 + fromIntegral idx -- | Create a proposal redeemer which cosigns with the new cosginers. mkProposalRedeemer :: Parameters -> ProposalRedeemer @@ -321,7 +307,7 @@ mkTestTree :: SpecificationTree mkTestTree name ps isValid = group name [proposal, stake] where - txInfo = cosign ps + spend = mkSpending cosign ps proposal = let proposalInputDatum = mkProposalInputDatum ps @@ -331,10 +317,7 @@ mkTestTree name ps isValid = group name [proposal, stake] (proposalValidator Shared.proposal) proposalInputDatum (mkProposalRedeemer ps) - ( ScriptContext - txInfo - proposalScriptPurpose - ) + (spend proposalRef) stake = let idx = 0 @@ -346,7 +329,4 @@ mkTestTree name ps isValid = group name [proposal, stake] (stakeValidator Shared.stake) stakeInputDatum stakeRedeemer - ( ScriptContext - txInfo - (mkStakeScriptPurpose idx) - ) + (spend $ mkStakeRef idx) diff --git a/agora-specs/Sample/Proposal/Create.hs b/agora-specs/Sample/Proposal/Create.hs index 8374920..6ec1fac 100644 --- a/agora-specs/Sample/Proposal/Create.hs +++ b/agora-specs/Sample/Proposal/Create.hs @@ -45,8 +45,6 @@ import Data.Coerce (coerce) import Data.Default (Default (def)) import Data.Tagged (Tagged, untag) import Plutarch.Context ( - BaseBuilder, - buildTxInfoUnsafe, input, mint, output, @@ -63,9 +61,6 @@ import PlutusLedgerApi.V1 ( POSIXTime (POSIXTime), POSIXTimeRange, PubKeyHash, - ScriptContext (ScriptContext), - ScriptPurpose (Minting, Spending), - TxInfo, TxOutRef (TxOutRef), ValidatorHash, always, @@ -88,7 +83,7 @@ import Sample.Shared ( ) import Sample.Shared qualified as Shared import Test.Specification (SpecificationTree, group, testPolicy, testValidator) -import Test.Util (closedBoundedInterval, sortValue) +import Test.Util (CombinableBuilder, closedBoundedInterval, mkMinting, mkSpending, sortValue) -- | Parameters for creating a proposal. data Parameters = Parameters @@ -269,8 +264,8 @@ governorRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be -------------------------------------------------------------------------------- -- | Create a 'TxInfo' that spends a stake to create a new proposal. -createProposal :: Parameters -> TxInfo -createProposal ps = buildTxInfoUnsafe builder +createProposal :: forall b. CombinableBuilder b => Parameters -> b +createProposal ps = builder where pst = Value.singleton proposalPolicySymbol "" 1 sst = Value.assetClassValue stakeAssetClass 1 @@ -296,7 +291,6 @@ createProposal ps = buildTxInfoUnsafe builder --- - builder :: BaseBuilder builder = mconcat [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" @@ -426,7 +420,8 @@ mkTestTree validForStakeValidator = group name [proposalTest, governorTest, stakeTest] where - txInfo = createProposal ps + mint = mkMinting createProposal ps + spend = mkSpending createProposal ps proposalTest = testPolicy @@ -434,7 +429,7 @@ mkTestTree "proposal" (proposalPolicy Shared.proposal.governorSTAssetClass) proposalPolicyRedeemer - (ScriptContext txInfo (Minting proposalPolicySymbol)) + (mint proposalPolicySymbol) governorTest = testValidator @@ -443,11 +438,7 @@ mkTestTree (governorValidator Shared.governor) governorInputDatum governorRedeemer - ( ScriptContext - txInfo - (Spending governorRef) - ) - + (spend governorRef) stakeTest = testValidator validForStakeValidator @@ -455,7 +446,4 @@ mkTestTree (stakeValidator Shared.stake) (mkStakeInputDatum ps) stakeRedeemer - ( ScriptContext - txInfo - (Spending stakeRef) - ) + (spend stakeRef) diff --git a/agora-specs/Sample/Proposal/UnlockStake.hs b/agora-specs/Sample/Proposal/UnlockStake.hs index 3165a5e..e5b47d6 100644 --- a/agora-specs/Sample/Proposal/UnlockStake.hs +++ b/agora-specs/Sample/Proposal/UnlockStake.hs @@ -40,8 +40,6 @@ import Agora.Stake.Scripts (stakeValidator) import Data.Default.Class (Default (def)) import Data.Tagged (Tagged (..), untag) import Plutarch.Context ( - BaseBuilder, - buildTxInfoUnsafe, input, output, script, @@ -54,9 +52,6 @@ import Plutarch.Context ( import PlutusLedgerApi.V1 ( DatumHash, PubKeyHash, - ScriptContext (..), - ScriptPurpose (Spending), - TxInfo (..), TxOutRef (..), ValidatorHash, ) @@ -74,7 +69,7 @@ import Sample.Shared ( ) import Sample.Shared qualified as Shared import Test.Specification (SpecificationTree, group, testValidator) -import Test.Util (sortValue, updateMap) +import Test.Util (CombinableBuilder, mkSpending, sortValue, updateMap) -------------------------------------------------------------------------------- @@ -249,7 +244,7 @@ mkProposalDatumPair params pid = getProposalVotes votesTemplate -- | Create a 'TxInfo' that tries to unlock a stake. -unlockStake :: Parameters -> TxInfo +unlockStake :: forall b. CombinableBuilder b => Parameters -> b unlockStake ps = let pst = Value.singleton proposalPolicySymbol "" 1 sst = Value.assetClassValue stakeAssetClass 1 @@ -260,7 +255,6 @@ unlockStake ps = foldMap ( \((i, o), idx) -> mconcat - @BaseBuilder [ input $ script proposalValidatorHash . withValue pst @@ -288,7 +282,7 @@ unlockStake ps = sOutDatum = mkStakeOutputDatum ps stakes = - mconcat @BaseBuilder + mconcat [ input $ script stakeValidatorHash . withValue stakeValue @@ -301,13 +295,13 @@ unlockStake ps = ] builder = - mconcat @BaseBuilder + mconcat [ txId "388bc0b897b3dadcd479da4c88291de4113a50b72ddbed001faf7fc03f11bc52" , proposals , stakes , signedWith defOwner ] - in buildTxInfoUnsafe builder + in builder -- | Reference to the stake UTXO. stakeRef :: TxOutRef @@ -523,7 +517,7 @@ mkAlterStakeParameters nProposals = do mkTestTree :: String -> Parameters -> Bool -> SpecificationTree mkTestTree name ps isValid = group name [stake, proposal] where - txInfo = unlockStake ps + spend = mkSpending unlockStake ps stake = testValidator @@ -532,7 +526,7 @@ mkTestTree name ps isValid = group name [stake, proposal] (stakeValidator Shared.stake) (mkStakeInputDatum ps) stakeRedeemer - (ScriptContext txInfo (Spending stakeRef)) + (spend stakeRef) proposal = let idx = 0 @@ -544,4 +538,4 @@ mkTestTree name ps isValid = group name [stake, proposal] (proposalValidator Shared.proposal) (mkProposalInputDatum ps pid) proposalRedeemer - (ScriptContext txInfo (Spending ref)) + (spend ref) diff --git a/agora-specs/Sample/Proposal/Vote.hs b/agora-specs/Sample/Proposal/Vote.hs index f841dd2..765cd82 100644 --- a/agora-specs/Sample/Proposal/Vote.hs +++ b/agora-specs/Sample/Proposal/Vote.hs @@ -33,8 +33,6 @@ import Agora.Stake.Scripts (stakeValidator) import Data.Default (Default (def)) import Data.Tagged (Tagged (Tagged), untag) import Plutarch.Context ( - BaseBuilder, - buildTxInfoUnsafe, input, output, script, @@ -47,9 +45,6 @@ import Plutarch.Context ( ) import PlutusLedgerApi.V1 ( PubKeyHash, - ScriptContext (..), - ScriptPurpose (Spending), - TxInfo, TxOutRef (TxOutRef), ) import PlutusLedgerApi.V1.Value qualified as Value @@ -71,7 +66,7 @@ import Test.Specification ( testValidator, validatorSucceedsWith, ) -import Test.Util (closedBoundedInterval, sortValue, updateMap) +import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, sortValue, updateMap) -- | Reference to the proposal UTXO. proposalRef :: TxOutRef @@ -152,7 +147,7 @@ stakeRedeemer :: StakeRedeemer stakeRedeemer = PermitVote -- | Create a valid transaction that votes on a propsal, given the parameters. -vote :: Parameters -> TxInfo +vote :: forall b. CombinableBuilder b => Parameters -> b vote params = let pst = Value.singleton proposalPolicySymbol "" 1 sst = Value.assetClassValue stakeAssetClass 1 @@ -203,7 +198,6 @@ vote params = <> Value.assetClassValue (untag stake.gtClassRef) params.voteCount <> minAda - builder :: BaseBuilder builder = mconcat [ txId "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c" @@ -228,7 +222,7 @@ vote params = . withValue stakeValue . withDatum stakeOutputDatum ] - in buildTxInfoUnsafe builder + in builder --- @@ -248,7 +242,7 @@ validVoteParameters = mkTestTree :: String -> Parameters -> Bool -> SpecificationTree mkTestTree name ps isValid = group name [proposal, stake] where - txInfo = vote ps + spend = mkSpending vote ps proposal = testValidator @@ -257,10 +251,7 @@ mkTestTree name ps isValid = group name [proposal, stake] (proposalValidator Shared.proposal) proposalInputDatum (mkProposalRedeemer ps) - ( ScriptContext - txInfo - (Spending proposalRef) - ) + (spend proposalRef) stake = let stakeInputDatum = mkStakeInputDatum ps @@ -269,7 +260,4 @@ mkTestTree name ps isValid = group name [proposal, stake] (stakeValidator Shared.stake) stakeInputDatum stakeRedeemer - ( ScriptContext - txInfo - (Spending stakeRef) - ) + (spend stakeRef) diff --git a/agora-specs/Sample/Stake.hs b/agora-specs/Sample/Stake.hs index 88e5dc7..ba1a835 100644 --- a/agora-specs/Sample/Stake.hs +++ b/agora-specs/Sample/Stake.hs @@ -40,8 +40,9 @@ import Plutarch.Context ( signedWith, txId, withDatum, - withSpending, - withTxId, + withMinting, + withOutRef, + withSpendingOutRef, withValue, ) import PlutusLedgerApi.V1 ( @@ -53,6 +54,7 @@ import PlutusLedgerApi.V1 ( TxInfo (txInfoData, txInfoSignatories), ValidatorHash (ValidatorHash), ) +import PlutusLedgerApi.V1.Contexts (TxOutRef (..)) import PlutusLedgerApi.V1.Value qualified as Value ( assetClassValue, singleton, @@ -86,6 +88,7 @@ stakeCreation = script stakeValidatorHash . withValue (st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242) . withDatum datum + , withMinting stakeSymbol ] in buildMintingUnsafe builder @@ -130,6 +133,9 @@ stakeDepositWithdraw config = stakeAfter :: StakeDatum stakeAfter = stakeBefore {stakedAmount = stakeBefore.stakedAmount + config.delta} + stakeRef :: TxOutRef + stakeRef = TxOutRef "0ffef57e30cc604342c738e31e0451593837b313e7bfb94b0922b142782f98e6" 1 + builder :: SpendingBuilder builder = mconcat @@ -140,14 +146,11 @@ stakeDepositWithdraw config = script stakeValidatorHash . withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount)) . withDatum stakeAfter - . withTxId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" + . withOutRef stakeRef , output $ script stakeValidatorHash . withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount)) . withDatum stakeAfter - , withSpending $ - script stakeValidatorHash - . withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount)) - . withDatum stakeAfter + , withSpendingOutRef stakeRef ] in buildSpendingUnsafe builder diff --git a/agora-specs/Sample/Treasury.hs b/agora-specs/Sample/Treasury.hs index 632f559..2c3c902 100644 --- a/agora-specs/Sample/Treasury.hs +++ b/agora-specs/Sample/Treasury.hs @@ -28,6 +28,7 @@ import Plutarch.Context ( script, signedWith, txId, + withMinting, withTxId, withValue, ) @@ -67,6 +68,7 @@ baseCtxBuilder = , mint (Value.singleton gatCs gatTn (-1)) , input treasury , output treasury + , withMinting gatCs ] {- | A `ScriptContext` that should be compatible with treasury diff --git a/agora-testlib/Test/Util.hs b/agora-testlib/Test/Util.hs index e7914b7..dff8990 100644 --- a/agora-testlib/Test/Util.hs +++ b/agora-testlib/Test/Util.hs @@ -20,6 +20,9 @@ module Test.Util ( validatorHashes, groupsOfN, withOptional, + mkSpending, + mkMinting, + CombinableBuilder, ) where -------------------------------------------------------------------------------- @@ -32,9 +35,26 @@ import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as C import Data.ByteString.Lazy qualified as ByteString.Lazy import Data.List (sortOn) -import Plutarch.Context (UTXO) +import Plutarch.Context ( + Builder, + UTXO, + buildMintingUnsafe, + buildSpendingUnsafe, + withMinting, + withSpendingOutRef, + ) import Plutarch.Crypto (pblake2b_256) -import PlutusLedgerApi.V1 (Credential (PubKeyCredential, ScriptCredential), PubKeyHash (..), ValidatorHash (ValidatorHash)) +import PlutusLedgerApi.V1 ( + Credential ( + PubKeyCredential, + ScriptCredential + ), + CurrencySymbol, + PubKeyHash (..), + ScriptContext, + TxOutRef, + ValidatorHash (ValidatorHash), + ) import PlutusLedgerApi.V1.Interval qualified as PlutusTx import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash)) import PlutusLedgerApi.V1.Value (Value (..)) @@ -168,3 +188,25 @@ withOptional :: UTXO withOptional f (Just b) = f b withOptional _ _ = id + +mkSpending :: + forall ps. + (forall b. (Monoid b, Builder b) => ps -> b) -> + ps -> + TxOutRef -> + ScriptContext +mkSpending mkBuilder ps oref = + buildSpendingUnsafe $ + mkBuilder ps <> withSpendingOutRef oref + +mkMinting :: + forall ps. + (forall b. (Monoid b, Builder b) => ps -> b) -> + ps -> + CurrencySymbol -> + ScriptContext +mkMinting mkBuilder ps cs = + buildMintingUnsafe $ + mkBuilder ps <> withMinting cs + +type CombinableBuilder b = (Monoid b, Builder b) diff --git a/bench.csv b/bench.csv index e5c5b9b..58ff462 100644 --- a/bench.csv +++ b/bench.csv @@ -5,8 +5,8 @@ Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,455817227,1103968,3 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,93089688,256879,8290 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,112671240,312571,3751 Agora/Stake/policy/stakeCreation,51008580,149029,2522 -Agora/Stake/validator/stakeDepositWithdraw deposit,183506412,498838,4745 -Agora/Stake/validator/stakeDepositWithdraw withdraw,183506412,498838,4733 +Agora/Stake/validator/stakeDepositWithdraw deposit,183506412,498838,4753 +Agora/Stake/validator/stakeDepositWithdraw withdraw,183506412,498838,4741 Agora/Proposal/policy (proposal creation)/legal/proposal,33689644,100286,2005 Agora/Proposal/policy (proposal creation)/legal/governor,324511293,861435,8769 Agora/Proposal/policy (proposal creation)/legal/stake,153960499,403133,5407