From 355f838417ec701313ac2490e27138fc3409b10b Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 24 May 2022 23:31:26 +0800 Subject: [PATCH] calculate the starting time of a proposal upon creation --- agora/Agora/Governor.hs | 6 ++- agora/Agora/Governor/Scripts.hs | 69 ++++++++++++++++++++------------- agora/Agora/Proposal.hs | 13 ++++++- agora/Agora/Proposal/Time.hs | 2 +- agora/Agora/Utils.hs | 18 +++++++++ 5 files changed, 77 insertions(+), 31 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 606fde6..7bd4805 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -43,6 +43,7 @@ import Agora.Utils (tclet) -------------------------------------------------------------------------------- +import Plutarch.Api.V1 (PPOSIXTime) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, @@ -55,7 +56,7 @@ import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- -import Plutus.V1.Ledger.Api (TxOutRef) +import Plutus.V1.Ledger.Api (POSIXTime, TxOutRef) import Plutus.V1.Ledger.Value (AssetClass (..)) import PlutusTx qualified @@ -70,6 +71,8 @@ data GovernorDatum = GovernorDatum , proposalTimings :: ProposalTimingConfig -- ^ The timing configuration for proposals. -- Will get copied over upon the creation of proposals. + , createProposalTimeRangeMaxDuration :: POSIXTime + -- ^ The maximum valid duration of a transaction that creats a proposal. } deriving stock (Show, GHC.Generic) @@ -123,6 +126,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum '[ "proposalThresholds" ':= PProposalThresholds , "nextProposalId" ':= PProposalId , "proposalTimings" ':= PProposalTimingConfig + , "createProposalTimeRangeMaxDuration" ':= PPOSIXTime ] ) } diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index a9bfc21..9f474f6 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -51,12 +51,14 @@ import Agora.Proposal ( PResultTag, Proposal (..), ProposalStatus (Draft, Locked), + pemptyVotesFor, proposalDatumValid, ) import Agora.Proposal.Scripts ( proposalPolicy, proposalValidator, ) +import Agora.Proposal.Time (createProposalStartingTime) import Agora.Record import Agora.SafeMoney (GTTag) import Agora.Stake ( @@ -126,7 +128,6 @@ import Plutarch.TryFrom (ptryFrom) -------------------------------------------------------------------------------- -import Agora.Proposal.Time (ProposalStartingTime (..)) import Plutus.V1.Ledger.Api ( CurrencySymbol (..), MintingPolicy, @@ -172,7 +173,7 @@ governorPolicy gov = let ownAssetClass = passetClass # ownSymbol # pconstant "" txInfo = pfromData $ pfield @"txInfo" # ctx' - txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums"] txInfo + txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums", "validRange"] txInfo tcassert "Referenced utxo should be spent" $ pisUTXOSpent # oref # txInfoF.inputs @@ -288,7 +289,7 @@ governorValidator gov = ctxF <- tcont $ pletFields @'["txInfo", "purpose"] ctx' txInfo' <- tclet $ pfromData $ ctxF.txInfo - txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo' + txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums", "signatories", "validRange"] txInfo' PSpending (pfromData . (pfield @"_0" #) -> ownInputRef) <- tcmatch $ pfromData ctxF.purpose @@ -300,7 +301,15 @@ governorValidator gov = let ownAddress = pfromData $ ownInputF.address (pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- tcont $ ptryFrom datum' - oldGovernorDatumF <- tcont $ pletFields @'["proposalThresholds", "nextProposalId", "proposalTimings"] oldGovernorDatum + oldGovernorDatumF <- + tcont $ + pletFields + @'[ "proposalThresholds" + , "nextProposalId" + , "proposalTimings" + , "createProposalTimeRangeMaxDuration" + ] + oldGovernorDatum -- Check that GST will be returned to the governor. let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value @@ -338,6 +347,8 @@ governorValidator gov = ( #proposalThresholds .= oldGovernorDatumF.proposalThresholds .& #nextProposalId .= pdata expectedNextProposalId .& #proposalTimings .= oldGovernorDatumF.proposalTimings + .& #createProposalTimeRangeMaxDuration + .= oldGovernorDatumF.createProposalTimeRangeMaxDuration ) tcassert "Unexpected governor state datum" $ newGovernorDatum #== expectedNewDatum @@ -403,9 +414,6 @@ governorValidator gov = outputDatumHash <- tclet $ pfield @"datumHash" #$ phead # outputsToProposalValidatorWithStateToken - tcassert "The utxo paid to the proposal validator must have datum" $ - pisDJust # outputDatumHash - proposalOutputDatum' <- tclet $ mustFindDatum' @PProposalDatum @@ -418,23 +426,34 @@ governorValidator gov = proposalOutputDatum <- tcont $ pletFields - @'["proposalId", "status", "cosigners", "thresholds", "votes"] + @'["effects", "cosigners", "proposalId", "votes"] proposalOutputDatum' - -- Id and thresholds should be copied from the old governor state datum. - tcassert "Invalid proposal id in proposal datum" $ - proposalOutputDatum.proposalId #== oldGovernorDatumF.nextProposalId - - tcassert "Invalid thresholds in proposal datum" $ - proposalOutputDatum.thresholds #== oldGovernorDatumF.proposalThresholds - - -- The proposal at this point should be in draft state. - tcassert "Proposal state should be draft" $ - proposalOutputDatum.status #== pconstantData Draft - tcassert "Proposal should have only one cosigner" $ plength # pfromData proposalOutputDatum.cosigners #== 1 + let -- Votes should be empty at this point + expectedVotes = pemptyVotesFor # pfromData proposalOutputDatum.effects + expectedStartingTime = + createProposalStartingTime + # oldGovernorDatumF.createProposalTimeRangeMaxDuration + # txInfoF.validRange + -- Id, thresholds and timings should be copied from the old governor state datum. + expectedProposalOut = + mkRecordConstr + PProposalDatum + ( #proposalId .= oldGovernorDatumF.nextProposalId + .& #effects .= proposalOutputDatum.effects + .& #status .= pconstantData Draft + .& #cosigners .= proposalOutputDatum.cosigners + .& #thresholds .= oldGovernorDatumF.proposalThresholds + .& #votes .= pdata expectedVotes + .& #timingConfig .= oldGovernorDatumF.proposalTimings + .& #startingTime .= pdata expectedStartingTime + ) + + tcassert "Datum correct" $ expectedProposalOut #== proposalOutputDatum' + let cosigner = phead # pfromData proposalOutputDatum.cosigners tcassert "Cosigner should be the stake owner" $ @@ -561,7 +580,7 @@ governorValidator gov = proposalInputDatumF <- tcont $ - pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes"] + pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes", "timingConfig", "startingTime"] proposalInputDatum -- Check that the proposal state is advanced so that a proposal cannot be executed twice. @@ -578,10 +597,8 @@ governorValidator gov = .& #cosigners .= proposalInputDatumF.cosigners .& #thresholds .= proposalInputDatumF.thresholds .& #votes .= proposalInputDatumF.votes - -- FIXME: copy from the governor datum - .& #timingConfig .= oldGovernorDatumF.proposalTimings - -- FIXME: calculate from 'txInfoValidRange' - .& #startingTime .= pdata (pconstant tmpProposalStartingTime) + .& #timingConfig .= proposalInputDatumF.timingConfig + .& #startingTime .= proposalInputDatumF.startingTime ) tcassert "Unexpected output proposal datum" $ @@ -733,10 +750,6 @@ governorValidator gov = let sym = governorSTSymbolFromGovernor gov in phoistAcyclic $ pconstant sym - -- TODO: remove this. - tmpProposalStartingTime :: ProposalStartingTime - tmpProposalStartingTime = ProposalStartingTime 0 - -------------------------------------------------------------------------------- -- | Get the 'CurrencySymbol' of GST. diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 0da7627..0cd1452 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -30,6 +30,7 @@ module Agora.Proposal ( -- * Plutarch helpers proposalDatumValid, + pemptyVotesFor, ) where import GHC.Generics qualified as GHC @@ -47,7 +48,7 @@ import PlutusTx.AssocMap qualified as AssocMap import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, ProposalStartingTime, ProposalTimingConfig) import Agora.SafeMoney (GTTag) -import Agora.Utils (pkeysEqual, pnotNull) +import Agora.Utils (pkeysEqual, pmapMap, pnotNull) import Control.Applicative (Const) import Control.Arrow (first) import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..)) @@ -348,6 +349,16 @@ deriving via instance (PConstantDecl ProposalVotes) +-- Plutarch version of 'pemptyVotesFor'. +pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap PResultTag a :--> PProposalVotes) +pemptyVotesFor = + phoistAcyclic $ + plam + ( \m -> + pcon $ + PProposalVotes $ pmapMap # plam (const $ pconstant 0) # m + ) + -- | Plutarch-level version of 'ProposalDatum'. newtype PProposalDatum (s :: S) = PProposalDatum { getProposalDatum :: diff --git a/agora/Agora/Proposal/Time.hs b/agora/Agora/Proposal/Time.hs index c2619eb..2f6509c 100644 --- a/agora/Agora/Proposal/Time.hs +++ b/agora/Agora/Proposal/Time.hs @@ -198,7 +198,7 @@ createProposalStartingTime = phoistAcyclic $ # (currentTimeF.lowerBound + currentTimeF.upperBound) # 2 - tcassert "Given time range should be tight enough" $ + tcassert "createProposalStartingTime: given time range should be tight enough" $ duration #<= maxDuration pure $ pcon $ PProposalStartingTime startingTime diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 62ce8f3..a3faa17 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -41,6 +41,7 @@ module Agora.Utils ( pmsort, pnubSort, pupdate, + pmapMap, pmapMaybe, -- * Functions which should (probably) not be upstreamed @@ -322,6 +323,23 @@ pupdate = phoistAcyclic $ ) # ps +-- | / O(n) /. Map a function over all values in a 'PMap'. +pmapMap :: forall s k a b. (PIsData k, PIsData a, PIsData b) => Term s ((a :--> b) :--> PMap k a :--> PMap k b) +pmapMap = phoistAcyclic $ + plam $ \f (pto -> (ps :: Term _ (PBuiltinList _))) -> + pcon $ + PMap $ + pmap + # plam + ( \kv -> + let k = pfstBuiltin # kv + v = psndBuiltin # kv + + nv = pdata $ f # pfromData v + in ppairDataBuiltin # k # nv + ) + # ps + -- | Add two 'PValue's together. paddValue :: forall s. Term s (PValue :--> PValue :--> PValue) paddValue = phoistAcyclic $