diff --git a/agora-sample/Sample/Proposal.hs b/agora-sample/Sample/Proposal.hs index 329d862..7763f42 100644 --- a/agora-sample/Sample/Proposal.hs +++ b/agora-sample/Sample/Proposal.hs @@ -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" + } diff --git a/agora-sample/Sample/Shared.hs b/agora-sample/Sample/Shared.hs index 1f30fb0..46cc0d3 100644 --- a/agora-sample/Sample/Shared.hs +++ b/agora-sample/Sample/Shared.hs @@ -193,7 +193,7 @@ authorityTokenSymbol = authorityTokenSymbolFromGovernor governor proposalTimingConfig :: ProposalTimingConfig proposalTimingConfig = ProposalTimingConfig - { draftTime = 0 + { draftTime = 50 , votingTime = 1000 , lockingTime = 2000 , executingTime = 3000 diff --git a/agora-test/Spec/Proposal.hs b/agora-test/Spec/Proposal.hs index 646d96e..3ed1e4e 100644 --- a/agora-test/Spec/Proposal.hs +++ b/agora-test/Spec/Proposal.hs @@ -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)) + ] ] ] diff --git a/agora-testlib/Test/Util.hs b/agora-testlib/Test/Util.hs index 74e8ac6..4d6f733 100644 --- a/agora-testlib/Test/Util.hs +++ b/agora-testlib/Test/Util.hs @@ -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 + ) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index d1b176e..0b41352 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -736,7 +736,7 @@ governorValidator gov = tmpTimingConfig :: ProposalTimingConfig tmpTimingConfig = ProposalTimingConfig - { draftTime = 0 + { draftTime = 50 , votingTime = 1000 , lockingTime = 2000 , executingTime = 3000 diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 7656303..73de60b 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -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.