Sulkta-Coop/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fix broken tests; utilizing new PCB APIs

Browse source
This commit is contained in:
Hongrui Fang 2022-07-21 18:28:12 +08:00
parent 43db5ee2ce
commit 23cc230968
No known key found for this signature in database
GPG key ID: 1E0454204FC7D755
12 changed files with 150 additions and 204 deletions
Download patch file Download diff file Expand all files Collapse all files

36
agora-specs/Sample/Governor/Initialize.hs
View file

@ -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)

30
agora-specs/Sample/Governor/Mutate.hs
View file

@ -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)
--------------------------------------------------------------------------------

85
agora-specs/Sample/Proposal/Advance.hs
View file

@ -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 ->

56
agora-specs/Sample/Proposal/Cosign.hs
View file

@ -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)

28
agora-specs/Sample/Proposal/Create.hs
View file

@ -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)

22
agora-specs/Sample/Proposal/UnlockStake.hs
View file

@ -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)

24
agora-specs/Sample/Proposal/Vote.hs
View file

@ -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)

17
agora-specs/Sample/Stake.hs
View file

@ -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

2
agora-specs/Sample/Treasury.hs
View file

@ -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