calculate the starting time of a proposal upon creation
This commit is contained in:
fanghr
parent
d9732fe814
commit
355f838417
5 changed files with 77 additions and 31 deletions
|
|
@ -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
|
||||
]
|
||||
)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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 ::
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 $
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue