add sample test && fix broken tests
This commit is contained in:
fanghr
parent
b4ca574757
commit
82201a6e1f
6 changed files with 238 additions and 25 deletions
|
|
@ -11,6 +11,7 @@ module Sample.Proposal (
|
|||
cosignProposal,
|
||||
proposalRef,
|
||||
stakeRef,
|
||||
voteOnProposal,
|
||||
) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -21,6 +22,7 @@ import Plutus.V1.Ledger.Api (
|
|||
Address (Address),
|
||||
Credential (ScriptCredential),
|
||||
Datum (Datum),
|
||||
POSIXTimeRange,
|
||||
PubKeyHash,
|
||||
ScriptContext (..),
|
||||
ScriptPurpose (..),
|
||||
|
|
@ -43,14 +45,16 @@ import Agora.Proposal (
|
|||
ProposalDatum (..),
|
||||
ProposalId (..),
|
||||
ProposalStatus (..),
|
||||
ProposalVotes (..),
|
||||
ResultTag (..),
|
||||
emptyVotesFor,
|
||||
)
|
||||
import Agora.Stake (Stake (..), StakeDatum (StakeDatum))
|
||||
import Agora.Proposal.Time (ProposalTimingConfig (..))
|
||||
import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..))
|
||||
import Plutarch.SafeMoney (Tagged (Tagged), untag)
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import Sample.Shared
|
||||
import Test.Util (datumPair, toDatumHash)
|
||||
import Test.Util (closedBoundedInterval, datumPair, toDatumHash, updateMap)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -176,6 +180,11 @@ cosignProposal newSigners =
|
|||
stakeDatum = StakeDatum (Tagged 50_000_000) signer2 []
|
||||
proposalAfter :: ProposalDatum
|
||||
proposalAfter = proposalBefore {cosigners = newSigners <> proposalBefore.cosigners}
|
||||
validTimeRange :: POSIXTimeRange
|
||||
validTimeRange =
|
||||
closedBoundedInterval
|
||||
10
|
||||
(proposalTimingConfig.draftTime - 10)
|
||||
in TxInfo
|
||||
{ txInfoInputs =
|
||||
[ TxInInfo
|
||||
|
|
@ -227,7 +236,7 @@ cosignProposal newSigners =
|
|||
, txInfoMint = st
|
||||
, txInfoDCert = []
|
||||
, txInfoWdrl = []
|
||||
, txInfoValidRange = Interval.always
|
||||
, txInfoValidRange = validTimeRange
|
||||
, txInfoSignatories = newSigners
|
||||
, txInfoData =
|
||||
[ datumPair . Datum $ toBuiltinData proposalBefore
|
||||
|
|
@ -236,3 +245,145 @@ cosignProposal newSigners =
|
|||
]
|
||||
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
|
||||
}
|
||||
|
||||
{- | A valid transaction of voting on a propsal.
|
||||
|
||||
-- TODO: docs
|
||||
-}
|
||||
voteOnProposal :: ResultTag -> Integer -> TxInfo
|
||||
voteOnProposal voteFor voteCount =
|
||||
let pst = Value.singleton proposalPolicySymbol "" 1
|
||||
sst = Value.assetClassValue stakeAssetClass 1
|
||||
|
||||
---
|
||||
|
||||
stakeOwner = signer
|
||||
|
||||
---
|
||||
|
||||
effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
|
||||
---
|
||||
|
||||
initialVotes :: AssocMap.Map ResultTag Integer
|
||||
initialVotes =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, 42)
|
||||
, (ResultTag 1, 4242)
|
||||
]
|
||||
|
||||
---
|
||||
|
||||
proposalInputDatum' :: ProposalDatum
|
||||
proposalInputDatum' =
|
||||
ProposalDatum
|
||||
{ proposalId = ProposalId 42
|
||||
, effects = effects
|
||||
, status = VotingReady
|
||||
, cosigners = [stakeOwner]
|
||||
, thresholds = defaultProposalThresholds
|
||||
, votes = ProposalVotes initialVotes
|
||||
, timingConfig = proposalTimingConfig
|
||||
, startingTime = tmpProposalStartingTime
|
||||
}
|
||||
proposalInputDatum :: Datum
|
||||
proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
|
||||
proposalInput :: TxOut
|
||||
proposalInput =
|
||||
TxOut
|
||||
{ txOutAddress = proposalValidatorAddress
|
||||
, txOutValue = pst
|
||||
, txOutDatumHash = Just $ toDatumHash proposalInputDatum
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
existingLocks :: [ProposalLock]
|
||||
existingLocks =
|
||||
[ ProposalLock (ResultTag 0) (ProposalId 0)
|
||||
, ProposalLock (ResultTag 2) (ProposalId 1)
|
||||
]
|
||||
|
||||
---
|
||||
|
||||
stakeInputDatum' :: StakeDatum
|
||||
stakeInputDatum' =
|
||||
StakeDatum
|
||||
{ stakedAmount = Tagged voteCount
|
||||
, owner = stakeOwner
|
||||
, lockedBy = existingLocks
|
||||
}
|
||||
stakeInputDatum :: Datum
|
||||
stakeInputDatum = Datum $ toBuiltinData stakeInputDatum'
|
||||
stakeInput :: TxOut
|
||||
stakeInput =
|
||||
TxOut
|
||||
{ txOutAddress = stakeAddress
|
||||
, txOutValue = sst <> Value.assetClassValue (untag stake.gtClassRef) voteCount
|
||||
, txOutDatumHash = Just $ toDatumHash stakeInputDatum
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
updatedVotes :: AssocMap.Map ResultTag Integer
|
||||
updatedVotes = updateMap (Just . (+ voteCount)) voteFor initialVotes
|
||||
|
||||
---
|
||||
|
||||
proposalOutputDatum' :: ProposalDatum
|
||||
proposalOutputDatum' =
|
||||
proposalInputDatum'
|
||||
{ votes = ProposalVotes updatedVotes
|
||||
}
|
||||
proposalOutputDatum :: Datum
|
||||
proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum'
|
||||
proposalOutput :: TxOut
|
||||
proposalOutput =
|
||||
proposalInput
|
||||
{ txOutDatumHash = Just $ toDatumHash proposalOutputDatum
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
-- Off-chain code should do exactly like this: prepend new lock to the list.
|
||||
updatedLocks :: [ProposalLock]
|
||||
updatedLocks = ProposalLock voteFor proposalInputDatum'.proposalId : existingLocks
|
||||
|
||||
---
|
||||
|
||||
stakeOutputDatum' :: StakeDatum
|
||||
stakeOutputDatum' =
|
||||
stakeInputDatum'
|
||||
{ lockedBy = updatedLocks
|
||||
}
|
||||
stakeOutputDatum :: Datum
|
||||
stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum'
|
||||
stakeOutput :: TxOut
|
||||
stakeOutput =
|
||||
stakeInput
|
||||
{ txOutDatumHash = Just $ toDatumHash stakeOutputDatum
|
||||
}
|
||||
|
||||
---
|
||||
|
||||
validTimeRange =
|
||||
closedBoundedInterval (proposalTimingConfig.draftTime + 1) (proposalTimingConfig.votingTime - 1)
|
||||
in TxInfo
|
||||
{ txInfoInputs =
|
||||
[ TxInInfo proposalRef proposalInput
|
||||
, TxInInfo stakeRef stakeInput
|
||||
]
|
||||
, txInfoOutputs = [proposalOutput, stakeOutput]
|
||||
, txInfoFee = Value.singleton "" "" 2
|
||||
, txInfoMint = mempty
|
||||
, txInfoDCert = []
|
||||
, txInfoWdrl = []
|
||||
, txInfoValidRange = validTimeRange
|
||||
, txInfoSignatories = [stakeOwner]
|
||||
, txInfoData = datumPair <$> [proposalInputDatum, proposalOutputDatum, stakeInputDatum, stakeOutputDatum]
|
||||
, txInfoId = "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c"
|
||||
}
|
||||
|
|
|
|||
|
|
@ -193,7 +193,7 @@ authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
|
|||
proposalTimingConfig :: ProposalTimingConfig
|
||||
proposalTimingConfig =
|
||||
ProposalTimingConfig
|
||||
{ draftTime = 0
|
||||
{ draftTime = 50
|
||||
, votingTime = 1000
|
||||
, lockingTime = 2000
|
||||
, executingTime = 3000
|
||||
|
|
|
|||
|
|
@ -15,8 +15,9 @@ import Agora.Proposal (
|
|||
Proposal (..),
|
||||
ProposalDatum (..),
|
||||
ProposalId (ProposalId),
|
||||
ProposalRedeemer (Cosign),
|
||||
ProposalStatus (Draft),
|
||||
ProposalRedeemer (Cosign, Vote),
|
||||
ProposalStatus (Draft, VotingReady),
|
||||
ProposalVotes (ProposalVotes),
|
||||
ResultTag (ResultTag),
|
||||
cosigners,
|
||||
effects,
|
||||
|
|
@ -30,7 +31,11 @@ import Agora.Proposal.Scripts (
|
|||
proposalPolicy,
|
||||
proposalValidator,
|
||||
)
|
||||
import Agora.Stake (StakeDatum (StakeDatum), StakeRedeemer (WitnessStake))
|
||||
import Agora.Stake (
|
||||
ProposalLock (ProposalLock),
|
||||
StakeDatum (StakeDatum),
|
||||
StakeRedeemer (PermitVote, WitnessStake),
|
||||
)
|
||||
import Agora.Stake.Scripts (stakeValidator)
|
||||
import Plutarch.SafeMoney (Tagged (Tagged))
|
||||
import Plutus.V1.Ledger.Api (ScriptContext (..), ScriptPurpose (..))
|
||||
|
|
@ -90,5 +95,46 @@ tests =
|
|||
WitnessStake
|
||||
(ScriptContext (Proposal.cosignProposal [signer2]) (Spending Proposal.stakeRef))
|
||||
]
|
||||
, testGroup
|
||||
"voting"
|
||||
[ validatorSucceedsWith
|
||||
"proposal"
|
||||
(proposalValidator Shared.proposal)
|
||||
( ProposalDatum
|
||||
{ proposalId = ProposalId 42
|
||||
, effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
, status = VotingReady
|
||||
, cosigners = [signer]
|
||||
, thresholds = Shared.defaultProposalThresholds
|
||||
, votes =
|
||||
ProposalVotes
|
||||
( AssocMap.fromList
|
||||
[ (ResultTag 0, 42)
|
||||
, (ResultTag 1, 4242)
|
||||
]
|
||||
)
|
||||
, timingConfig = Shared.proposalTimingConfig
|
||||
, startingTime = Shared.tmpProposalStartingTime
|
||||
}
|
||||
)
|
||||
(Vote (ResultTag 0))
|
||||
(ScriptContext (Proposal.voteOnProposal (ResultTag 0) 27) (Spending Proposal.proposalRef))
|
||||
, validatorSucceedsWith
|
||||
"stake"
|
||||
(stakeValidator Shared.stake)
|
||||
( StakeDatum
|
||||
(Tagged 27)
|
||||
signer
|
||||
[ ProposalLock (ResultTag 0) (ProposalId 0)
|
||||
, ProposalLock (ResultTag 2) (ProposalId 1)
|
||||
]
|
||||
)
|
||||
(PermitVote $ ProposalLock (ResultTag 0) (ProposalId 42))
|
||||
(ScriptContext (Proposal.voteOnProposal (ResultTag 0) 27) (Spending Proposal.stakeRef))
|
||||
]
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -38,6 +38,8 @@ module Test.Util (
|
|||
toDatum,
|
||||
toDatumHash,
|
||||
datumPair,
|
||||
closedBoundedInterval,
|
||||
updateMap,
|
||||
) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -62,9 +64,12 @@ import Plutarch.Crypto (pblake2b_256)
|
|||
import Plutarch.Evaluate (evalScript)
|
||||
import Plutarch.Lift (PUnsafeLiftDecl (PLifted))
|
||||
import Plutus.V1.Ledger.Contexts (ScriptContext)
|
||||
import Plutus.V1.Ledger.Interval as PlutusTx
|
||||
import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash (DatumHash), Script)
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import PlutusTx.Builtins qualified as PlutusTx
|
||||
import PlutusTx.IsData qualified as PlutusTx
|
||||
import PlutusTx.Ord qualified as PlutusTx
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -231,3 +236,20 @@ toDatumHash datum =
|
|||
plift $
|
||||
pblake2b_256
|
||||
# pconstant (ByteString.Lazy.toStrict $ serialise $ PlutusTx.toData datum)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Create a closed bounded `Interval`.
|
||||
closedBoundedInterval :: PlutusTx.Ord a => a -> a -> PlutusTx.Interval a
|
||||
closedBoundedInterval from to = PlutusTx.intersection (PlutusTx.from from) (PlutusTx.to to)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
updateMap :: Eq k => (v -> Maybe v) -> k -> AssocMap.Map k v -> AssocMap.Map k v
|
||||
updateMap f k =
|
||||
AssocMap.mapMaybeWithKey
|
||||
( \k' v ->
|
||||
if k' == k
|
||||
then f v
|
||||
else Just v
|
||||
)
|
||||
|
|
|
|||
|
|
@ -736,7 +736,7 @@ governorValidator gov =
|
|||
tmpTimingConfig :: ProposalTimingConfig
|
||||
tmpTimingConfig =
|
||||
ProposalTimingConfig
|
||||
{ draftTime = 0
|
||||
{ draftTime = 50
|
||||
, votingTime = 1000
|
||||
, lockingTime = 2000
|
||||
, executingTime = 3000
|
||||
|
|
|
|||
|
|
@ -230,24 +230,18 @@ proposalValidator proposal =
|
|||
|
||||
-- TODO: maybe we can move this outside of the pmatch block.
|
||||
-- Filter out own output with own address and PST.
|
||||
ownOutput <-
|
||||
tclet $
|
||||
mustBePJust # "Own output not found" #$ pfind
|
||||
# plam
|
||||
( \input -> unTermCont $ do
|
||||
inputF <- tcont $ pletFields @'["address", "value"] input
|
||||
pure $
|
||||
inputF.address #== ownAddress
|
||||
#&& psymbolValueOf # stCurrencySymbol # inputF.value #== 1
|
||||
)
|
||||
# pfromData txInfoF.outputs
|
||||
let ownOutput =
|
||||
mustBePJust # "Own output not found" #$ pfind
|
||||
# plam
|
||||
( \input -> unTermCont $ do
|
||||
inputF <- tcont $ pletFields @'["address", "value"] input
|
||||
pure $
|
||||
inputF.address #== ownAddress
|
||||
#&& psymbolValueOf # stCurrencySymbol # inputF.value #== 1
|
||||
)
|
||||
# pfromData txInfoF.outputs
|
||||
|
||||
ownOutputF <- tcont $ pletFields @'["datumHash", "value"] ownOutput
|
||||
|
||||
-- TODO: is this really necessary?
|
||||
tcassert "Own output value should be correct" $ ownOutputF.value #== pdata txOutF.value
|
||||
|
||||
let proposalOut :: Term _ PProposalDatum
|
||||
proposalOut :: Term _ PProposalDatum
|
||||
proposalOut = mustFindDatum' # (pfield @"datumHash" # ownOutput) # txInfoF.datums
|
||||
|
||||
let -- Update the vote counter of the proposal, and leave other stuff as is.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue