From fbe3edc45abf21f4b9da800a87b6192a60699bf4 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 20 May 2022 19:58:29 +0800 Subject: [PATCH 1/6] store proposal timing conf in the governor datum --- agora-sample/Sample/Governor.hs | 10 +++++++--- agora-sample/Sample/Proposal.hs | 14 ++++++++------ agora-sample/Sample/Shared.hs | 6 +++--- agora-test/Spec/Governor.hs | 6 +++--- agora-test/Spec/Proposal.hs | 4 ++-- agora/Agora/Governor.hs | 5 +++++ agora/Agora/Governor/Scripts.hs | 17 ++++------------- 7 files changed, 32 insertions(+), 30 deletions(-) diff --git a/agora-sample/Sample/Governor.hs b/agora-sample/Sample/Governor.hs index 8d0cab5..29fcd2d 100644 --- a/agora-sample/Sample/Governor.hs +++ b/agora-sample/Sample/Governor.hs @@ -67,13 +67,13 @@ import Agora.Stake ( import Sample.Shared ( authorityTokenSymbol, defaultProposalThresholds, + defaultProposalTimingConfig, govAssetClass, govSymbol, govValidatorAddress, gstUTXORef, minAda, proposalPolicySymbol, - proposalTimingConfig, proposalValidatorAddress, signer, signer2, @@ -114,6 +114,7 @@ mintGST = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 + , proposalTimings = defaultProposalTimingConfig } governorOutputDatum :: Datum governorOutputDatum = Datum $ toBuiltinData governorOutputDatum' @@ -207,6 +208,7 @@ createProposal = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = thisProposalId + , proposalTimings = defaultProposalTimingConfig } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -236,7 +238,7 @@ createProposal = , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects - , timingConfig = proposalTimingConfig + , timingConfig = defaultProposalTimingConfig , startingTime = tmpProposalStartingTime } ) @@ -378,6 +380,7 @@ mintGATs = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 5 + , proposalTimings = defaultProposalTimingConfig } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -412,7 +415,7 @@ mintGATs = , cosigners = [signer, signer2] , thresholds = defaultProposalThresholds , votes = proposalVotes - , timingConfig = proposalTimingConfig + , timingConfig = defaultProposalTimingConfig , startingTime = tmpProposalStartingTime } proposalInputDatum :: Datum @@ -565,6 +568,7 @@ mutateState = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 5 + , proposalTimings = defaultProposalTimingConfig } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' diff --git a/agora-sample/Sample/Proposal.hs b/agora-sample/Sample/Proposal.hs index de52379..2338939 100644 --- a/agora-sample/Sample/Proposal.hs +++ b/agora-sample/Sample/Proposal.hs @@ -39,7 +39,7 @@ import Plutus.V1.Ledger.Value qualified as Value -------------------------------------------------------------------------------- import Agora.Governor ( - GovernorDatum (GovernorDatum, nextProposalId, proposalThresholds), + GovernorDatum (..), ) import Agora.Proposal ( Proposal (..), @@ -79,7 +79,7 @@ proposalCreation = , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects - , timingConfig = proposalTimingConfig + , timingConfig = defaultProposalTimingConfig , startingTime = tmpProposalStartingTime } ) @@ -91,6 +91,7 @@ proposalCreation = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 + , proposalTimings = defaultProposalTimingConfig } ) govAfter :: Datum @@ -100,6 +101,7 @@ proposalCreation = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 1 + , proposalTimings = defaultProposalTimingConfig } ) in ScriptContext @@ -174,7 +176,7 @@ cosignProposal newSigners = , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects - , timingConfig = proposalTimingConfig + , timingConfig = defaultProposalTimingConfig , startingTime = tmpProposalStartingTime } stakeDatum :: StakeDatum @@ -185,7 +187,7 @@ cosignProposal newSigners = validTimeRange = closedBoundedInterval 10 - (proposalTimingConfig.draftTime - 10) + (defaultProposalTimingConfig.draftTime - 10) in TxInfo { txInfoInputs = [ TxInInfo @@ -295,7 +297,7 @@ voteOnProposal params = , cosigners = [stakeOwner] , thresholds = defaultProposalThresholds , votes = ProposalVotes initialVotes - , timingConfig = proposalTimingConfig + , timingConfig = defaultProposalTimingConfig , startingTime = tmpProposalStartingTime } proposalInputDatum :: Datum @@ -384,7 +386,7 @@ voteOnProposal params = --- validTimeRange = - closedBoundedInterval (proposalTimingConfig.draftTime + 1) (proposalTimingConfig.votingTime - 1) + closedBoundedInterval (defaultProposalTimingConfig.draftTime + 1) (defaultProposalTimingConfig.votingTime - 1) in TxInfo { txInfoInputs = [ TxInInfo proposalRef proposalInput diff --git a/agora-sample/Sample/Shared.hs b/agora-sample/Sample/Shared.hs index adaed30..c100378 100644 --- a/agora-sample/Sample/Shared.hs +++ b/agora-sample/Sample/Shared.hs @@ -36,7 +36,7 @@ module Sample.Shared ( proposalPolicySymbol, proposalValidatorHash, proposalValidatorAddress, - proposalTimingConfig, + defaultProposalTimingConfig, tmpProposalStartingTime, -- ** Authority @@ -190,8 +190,8 @@ authorityToken = authorityTokenFromGovernor governor authorityTokenSymbol :: CurrencySymbol authorityTokenSymbol = authorityTokenSymbolFromGovernor governor -proposalTimingConfig :: ProposalTimingConfig -proposalTimingConfig = +defaultProposalTimingConfig :: ProposalTimingConfig +defaultProposalTimingConfig = ProposalTimingConfig { draftTime = 50 , votingTime = 1000 diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 89c43f8..0d7d827 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -38,19 +38,19 @@ tests = [ validatorSucceedsWith "proposal creation" (governorValidator Shared.governor) - (GovernorDatum Shared.defaultProposalThresholds (ProposalId 0)) + (GovernorDatum Shared.defaultProposalThresholds (ProposalId 0) Shared.defaultProposalTimingConfig) CreateProposal createProposal , validatorSucceedsWith "GATs minting" (governorValidator Shared.governor) - (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5)) + (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5) Shared.defaultProposalTimingConfig) MintGATs mintGATs , validatorSucceedsWith "mutate governor state" (governorValidator Shared.governor) - (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5)) + (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5) Shared.defaultProposalTimingConfig) MutateGovernor mutateState ] diff --git a/agora-test/Spec/Proposal.hs b/agora-test/Spec/Proposal.hs index a78d693..5eab61d 100644 --- a/agora-test/Spec/Proposal.hs +++ b/agora-test/Spec/Proposal.hs @@ -82,7 +82,7 @@ tests = [ (ResultTag 0, AssocMap.empty) , (ResultTag 1, AssocMap.empty) ] - , timingConfig = Shared.proposalTimingConfig + , timingConfig = Shared.defaultProposalTimingConfig , startingTime = Shared.tmpProposalStartingTime } ) @@ -117,7 +117,7 @@ tests = , (ResultTag 1, 4242) ] ) - , timingConfig = Shared.proposalTimingConfig + , timingConfig = Shared.defaultProposalTimingConfig , startingTime = Shared.tmpProposalStartingTime } ) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 4f64a76..606fde6 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -37,6 +37,7 @@ import Agora.Proposal ( ProposalId (ProposalId), ProposalThresholds, ) +import Agora.Proposal.Time (PProposalTimingConfig, ProposalTimingConfig) import Agora.SafeMoney (GTTag) import Agora.Utils (tclet) @@ -66,6 +67,9 @@ data GovernorDatum = GovernorDatum -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'. , nextProposalId :: ProposalId -- ^ What tag the next proposal will get upon creating. + , proposalTimings :: ProposalTimingConfig + -- ^ The timing configuration for proposals. + -- Will get copied over upon the creation of proposals. } deriving stock (Show, GHC.Generic) @@ -118,6 +122,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum ( PDataRecord '[ "proposalThresholds" ':= PProposalThresholds , "nextProposalId" ':= PProposalId + , "proposalTimings" ':= PProposalTimingConfig ] ) } diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 0b41352..a9bfc21 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -126,7 +126,7 @@ import Plutarch.TryFrom (ptryFrom) -------------------------------------------------------------------------------- -import Agora.Proposal.Time (ProposalStartingTime (..), ProposalTimingConfig (..)) +import Agora.Proposal.Time (ProposalStartingTime (..)) import Plutus.V1.Ledger.Api ( CurrencySymbol (..), MintingPolicy, @@ -300,7 +300,7 @@ governorValidator gov = let ownAddress = pfromData $ ownInputF.address (pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- tcont $ ptryFrom datum' - oldGovernorDatumF <- tcont $ pletFields @'["proposalThresholds", "nextProposalId"] oldGovernorDatum + oldGovernorDatumF <- tcont $ pletFields @'["proposalThresholds", "nextProposalId", "proposalTimings"] oldGovernorDatum -- Check that GST will be returned to the governor. let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value @@ -337,6 +337,7 @@ governorValidator gov = PGovernorDatum ( #proposalThresholds .= oldGovernorDatumF.proposalThresholds .& #nextProposalId .= pdata expectedNextProposalId + .& #proposalTimings .= oldGovernorDatumF.proposalTimings ) tcassert "Unexpected governor state datum" $ newGovernorDatum #== expectedNewDatum @@ -578,7 +579,7 @@ governorValidator gov = .& #thresholds .= proposalInputDatumF.thresholds .& #votes .= proposalInputDatumF.votes -- FIXME: copy from the governor datum - .& #timingConfig .= pdata (pconstant tmpTimingConfig) + .& #timingConfig .= oldGovernorDatumF.proposalTimings -- FIXME: calculate from 'txInfoValidRange' .& #startingTime .= pdata (pconstant tmpProposalStartingTime) ) @@ -732,16 +733,6 @@ governorValidator gov = let sym = governorSTSymbolFromGovernor gov in phoistAcyclic $ pconstant sym - -- TODO: remove this. This is temperary. - tmpTimingConfig :: ProposalTimingConfig - tmpTimingConfig = - ProposalTimingConfig - { draftTime = 50 - , votingTime = 1000 - , lockingTime = 2000 - , executingTime = 3000 - } - -- TODO: remove this. tmpProposalStartingTime :: ProposalStartingTime tmpProposalStartingTime = ProposalStartingTime 0 From d9732fe814d2aa4081e3b3b7ef98240fe9922e9f Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 24 May 2022 22:10:19 +0800 Subject: [PATCH 2/6] add `createProposalStartingTime` to compute the starting time of proposals --- agora/Agora/Proposal/Time.hs | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/agora/Agora/Proposal/Time.hs b/agora/Agora/Proposal/Time.hs index 54fed1a..c2619eb 100644 --- a/agora/Agora/Proposal/Time.hs +++ b/agora/Agora/Proposal/Time.hs @@ -20,6 +20,7 @@ module Agora.Proposal.Time ( PProposalStartingTime (..), -- * Compute periods given config and starting time. + createProposalStartingTime, currentProposalTime, isDraftPeriod, isVotingPeriod, @@ -28,7 +29,7 @@ module Agora.Proposal.Time ( ) where import Agora.Record (mkRecordConstr, (.&), (.=)) -import Agora.Utils (tcmatch) +import Agora.Utils (tcassert, tcmatch) import GHC.Generics qualified as GHC import Generics.SOP (Generic, I (I)) import Plutarch.Api.V1 ( @@ -178,6 +179,30 @@ deriving via instance AdditiveSemigroup (Term s PPOSIXTime) where (punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y +{- | Get the starting time of a proposal, from the 'Plutus.V1.Ledger.Api.txInfoValidPeriod' field. + For every proposal, this is only meant to run once upon creation. +-} +createProposalStartingTime :: forall (s :: S). Term s (PPOSIXTime :--> PPOSIXTimeRange :--> PProposalStartingTime) +createProposalStartingTime = phoistAcyclic $ + plam $ \maxDuration iv -> unTermCont $ do + currentTimeF <- + tcont $ + pletFields @'["lowerBound", "upperBound"] $ + currentProposalTime # iv + + -- Use the middle of the current time range as the starting time. + let duration = currentTimeF.upperBound - currentTimeF.lowerBound + + startingTime = + pdiv + # (currentTimeF.lowerBound + currentTimeF.upperBound) + # 2 + + tcassert "Given time range should be tight enough" $ + duration #<= maxDuration + + pure $ pcon $ PProposalStartingTime startingTime + {- | Get the current proposal time, from the 'Plutus.V1.Ledger.Api.txInfoValidPeriod' field. If it's impossible to get a fully-bounded time, (e.g. either end of the 'PPOSIXTimeRange' is From 355f838417ec701313ac2490e27138fc3409b10b Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 24 May 2022 23:31:26 +0800 Subject: [PATCH 3/6] 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 $ From 55435d601f88416ec04248452a03ccf94fe06484 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 25 May 2022 17:52:05 +0800 Subject: [PATCH 4/6] fix broken tests/samples --- .../Sample/Effect/GovernorMutation.hs | 8 +++++ agora-sample/Sample/Governor.hs | 32 +++++++++++++++---- agora-sample/Sample/Proposal.hs | 15 +++++---- agora-sample/Sample/Shared.hs | 25 ++++++++++----- agora-test/Spec/Effect/GovernorMutation.hs | 14 ++++---- agora-test/Spec/Governor.hs | 21 ++++++++++-- agora-test/Spec/Proposal.hs | 5 +-- agora.cabal | 11 +++---- 8 files changed, 93 insertions(+), 38 deletions(-) diff --git a/agora-sample/Sample/Effect/GovernorMutation.hs b/agora-sample/Sample/Effect/GovernorMutation.hs index 7d41cb7..e8c7b79 100644 --- a/agora-sample/Sample/Effect/GovernorMutation.hs +++ b/agora-sample/Sample/Effect/GovernorMutation.hs @@ -37,7 +37,9 @@ import Plutus.V1.Ledger.Value (AssetClass, assetClass) import Plutus.V1.Ledger.Value qualified as Value import Sample.Shared ( authorityTokenSymbol, + defaultCreateProposalTimeRangeMaxDuration, defaultProposalThresholds, + defaultProposalTimingConfig, govAssetClass, govValidatorAddress, governor, @@ -101,6 +103,8 @@ mkEffectTxInfo newGovDatum = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 + , proposalTimings = defaultProposalTimingConfig + , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -161,6 +165,8 @@ validNewGovernorDatum = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 42 + , proposalTimings = defaultProposalTimingConfig + , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration } invalidNewGovernorDatum :: GovernorDatum @@ -171,4 +177,6 @@ invalidNewGovernorDatum = { countVoting = Tagged (-1) } , nextProposalId = ProposalId 42 + , proposalTimings = defaultProposalTimingConfig + , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration } diff --git a/agora-sample/Sample/Governor.hs b/agora-sample/Sample/Governor.hs index 29fcd2d..dcc53e2 100644 --- a/agora-sample/Sample/Governor.hs +++ b/agora-sample/Sample/Governor.hs @@ -64,8 +64,13 @@ import Agora.Stake ( -------------------------------------------------------------------------------- +import Agora.Proposal.Time ( + ProposalStartingTime (ProposalStartingTime), + ProposalTimingConfig (..), + ) import Sample.Shared ( authorityTokenSymbol, + defaultCreateProposalTimeRangeMaxDuration, defaultProposalThresholds, defaultProposalTimingConfig, govAssetClass, @@ -74,15 +79,15 @@ import Sample.Shared ( gstUTXORef, minAda, proposalPolicySymbol, + proposalStartingTimeFromTimeRange, proposalValidatorAddress, signer, signer2, stake, stakeAddress, stakeAssetClass, - tmpProposalStartingTime, ) -import Test.Util (datumPair, toDatumHash) +import Test.Util (closedBoundedInterval, datumPair, toDatumHash) -------------------------------------------------------------------------------- @@ -115,6 +120,7 @@ mintGST = { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 , proposalTimings = defaultProposalTimingConfig + , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration } governorOutputDatum :: Datum governorOutputDatum = Datum $ toBuiltinData governorOutputDatum' @@ -209,6 +215,7 @@ createProposal = { proposalThresholds = defaultProposalThresholds , nextProposalId = thisProposalId , proposalTimings = defaultProposalTimingConfig + , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -239,7 +246,7 @@ createProposal = , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects , timingConfig = defaultProposalTimingConfig - , startingTime = tmpProposalStartingTime + , startingTime = proposalStartingTimeFromTimeRange validTimeRange } ) proposalOutput :: TxOut @@ -300,8 +307,13 @@ createProposal = } --- + ownInputRef :: TxOutRef ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1 + + --- + + validTimeRange = closedBoundedInterval 10 15 in ScriptContext { scriptContextTxInfo = TxInfo @@ -318,7 +330,7 @@ createProposal = , txInfoMint = pst , txInfoDCert = [] , txInfoWdrl = [] - , txInfoValidRange = Interval.always + , txInfoValidRange = validTimeRange , txInfoSignatories = [signer] , txInfoData = datumPair @@ -381,6 +393,7 @@ mintGATs = { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 5 , proposalTimings = defaultProposalTimingConfig + , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -416,7 +429,7 @@ mintGATs = , thresholds = defaultProposalThresholds , votes = proposalVotes , timingConfig = defaultProposalTimingConfig - , startingTime = tmpProposalStartingTime + , startingTime = ProposalStartingTime 10 } proposalInputDatum :: Datum proposalInputDatum = Datum $ toBuiltinData proposalInputDatum' @@ -468,6 +481,12 @@ mintGATs = ownInputRef :: TxOutRef ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1 + + -- + validTimeRange = + closedBoundedInterval + (defaultProposalTimingConfig.lockingTime + 11) + (defaultProposalTimingConfig.executingTime - 11) in ScriptContext { scriptContextTxInfo = TxInfo @@ -486,7 +505,7 @@ mintGATs = , txInfoMint = gat , txInfoDCert = [] , txInfoWdrl = [] - , txInfoValidRange = Interval.always + , txInfoValidRange = validTimeRange , txInfoSignatories = [signer, signer2] , txInfoData = datumPair @@ -569,6 +588,7 @@ mutateState = { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 5 , proposalTimings = defaultProposalTimingConfig + , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' diff --git a/agora-sample/Sample/Proposal.hs b/agora-sample/Sample/Proposal.hs index 2338939..cea8be0 100644 --- a/agora-sample/Sample/Proposal.hs +++ b/agora-sample/Sample/Proposal.hs @@ -33,7 +33,6 @@ import Plutus.V1.Ledger.Api ( TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue), TxOutRef (TxOutRef), ) -import Plutus.V1.Ledger.Interval qualified as Interval import Plutus.V1.Ledger.Value qualified as Value -------------------------------------------------------------------------------- @@ -50,7 +49,7 @@ import Agora.Proposal ( ResultTag (..), emptyVotesFor, ) -import Agora.Proposal.Time (ProposalTimingConfig (..)) +import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..)) import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..)) import Plutarch.SafeMoney (Tagged (Tagged), untag) import PlutusTx.AssocMap qualified as AssocMap @@ -80,7 +79,7 @@ proposalCreation = , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects , timingConfig = defaultProposalTimingConfig - , startingTime = tmpProposalStartingTime + , startingTime = proposalStartingTimeFromTimeRange validTimeRange } ) @@ -92,6 +91,7 @@ proposalCreation = { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 , proposalTimings = defaultProposalTimingConfig + , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration } ) govAfter :: Datum @@ -102,8 +102,11 @@ proposalCreation = { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 1 , proposalTimings = defaultProposalTimingConfig + , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration } ) + + validTimeRange = closedBoundedInterval 10 15 in ScriptContext { scriptContextTxInfo = TxInfo @@ -140,7 +143,7 @@ proposalCreation = , txInfoMint = st , txInfoDCert = [] , txInfoWdrl = [] - , txInfoValidRange = Interval.always + , txInfoValidRange = validTimeRange , txInfoSignatories = [signer] , txInfoData = [ datumPair proposalDatum @@ -177,7 +180,7 @@ cosignProposal newSigners = , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects , timingConfig = defaultProposalTimingConfig - , startingTime = tmpProposalStartingTime + , startingTime = ProposalStartingTime 0 } stakeDatum :: StakeDatum stakeDatum = StakeDatum (Tagged 50_000_000) signer2 [] @@ -298,7 +301,7 @@ voteOnProposal params = , thresholds = defaultProposalThresholds , votes = ProposalVotes initialVotes , timingConfig = defaultProposalTimingConfig - , startingTime = tmpProposalStartingTime + , startingTime = ProposalStartingTime 0 } proposalInputDatum :: Datum proposalInputDatum = Datum $ toBuiltinData proposalInputDatum' diff --git a/agora-sample/Sample/Shared.hs b/agora-sample/Sample/Shared.hs index c100378..8d44130 100644 --- a/agora-sample/Sample/Shared.hs +++ b/agora-sample/Sample/Shared.hs @@ -37,7 +37,8 @@ module Sample.Shared ( proposalValidatorHash, proposalValidatorAddress, defaultProposalTimingConfig, - tmpProposalStartingTime, + defaultCreateProposalTimeRangeMaxDuration, + proposalStartingTimeFromTimeRange, -- ** Authority authorityToken, @@ -77,7 +78,7 @@ import Agora.Proposal ( ProposalThresholds (..), ) import Agora.Proposal.Time ( - ProposalStartingTime (..), + ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..), ) import Agora.Stake (Stake (..)) @@ -95,9 +96,15 @@ import Plutus.V1.Ledger.Api ( Address (Address), Credential (ScriptCredential), CurrencySymbol, + Extended (..), + Interval (..), + LowerBound (..), MintingPolicy (..), + POSIXTime, + POSIXTimeRange, PubKeyHash, TxOutRef (TxOutRef), + UpperBound (..), Value, ) import Plutus.V1.Ledger.Contexts ( @@ -199,12 +206,14 @@ defaultProposalTimingConfig = , executingTime = 3000 } -{- | Hard coded starting time of every propoal. - This will be calculated by the governor in the future. - FIXME: Remove this. --} -tmpProposalStartingTime :: ProposalStartingTime -tmpProposalStartingTime = ProposalStartingTime 0 +defaultCreateProposalTimeRangeMaxDuration :: POSIXTime +defaultCreateProposalTimeRangeMaxDuration = 10 + +proposalStartingTimeFromTimeRange :: POSIXTimeRange -> ProposalStartingTime +proposalStartingTimeFromTimeRange + (Interval (LowerBound (Finite l) True) (UpperBound (Finite u) True)) = + ProposalStartingTime $ (l + u) `div` 2 +proposalStartingTimeFromTimeRange _ = error "Given time range should be finite and closed" ------------------------------------------------------------------ diff --git a/agora-test/Spec/Effect/GovernorMutation.hs b/agora-test/Spec/Effect/GovernorMutation.hs index 1436b5a..fd70f34 100644 --- a/agora-test/Spec/Effect/GovernorMutation.hs +++ b/agora-test/Spec/Effect/GovernorMutation.hs @@ -27,9 +27,10 @@ tests = "governor validator should pass" (governorValidator Shared.governor) ( GovernorDatum - { proposalThresholds = Shared.defaultProposalThresholds - , nextProposalId = ProposalId 0 - } + Shared.defaultProposalThresholds + (ProposalId 0) + Shared.defaultProposalTimingConfig + Shared.defaultCreateProposalTimeRangeMaxDuration ) MutateGovernor ( ScriptContext @@ -48,9 +49,10 @@ tests = "governor validator should fail" (governorValidator Shared.governor) ( GovernorDatum - { proposalThresholds = Shared.defaultProposalThresholds - , nextProposalId = ProposalId 0 - } + Shared.defaultProposalThresholds + (ProposalId 0) + Shared.defaultProposalTimingConfig + Shared.defaultCreateProposalTimeRangeMaxDuration ) MutateGovernor ( ScriptContext diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 0d7d827..7d324fb 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -38,19 +38,34 @@ tests = [ validatorSucceedsWith "proposal creation" (governorValidator Shared.governor) - (GovernorDatum Shared.defaultProposalThresholds (ProposalId 0) Shared.defaultProposalTimingConfig) + ( GovernorDatum + Shared.defaultProposalThresholds + (ProposalId 0) + Shared.defaultProposalTimingConfig + Shared.defaultCreateProposalTimeRangeMaxDuration + ) CreateProposal createProposal , validatorSucceedsWith "GATs minting" (governorValidator Shared.governor) - (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5) Shared.defaultProposalTimingConfig) + ( GovernorDatum + Shared.defaultProposalThresholds + (ProposalId 5) + Shared.defaultProposalTimingConfig + Shared.defaultCreateProposalTimeRangeMaxDuration + ) MintGATs mintGATs , validatorSucceedsWith "mutate governor state" (governorValidator Shared.governor) - (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5) Shared.defaultProposalTimingConfig) + ( GovernorDatum + Shared.defaultProposalThresholds + (ProposalId 5) + Shared.defaultProposalTimingConfig + Shared.defaultCreateProposalTimeRangeMaxDuration + ) MutateGovernor mutateState ] diff --git a/agora-test/Spec/Proposal.hs b/agora-test/Spec/Proposal.hs index 5eab61d..dc0f1cc 100644 --- a/agora-test/Spec/Proposal.hs +++ b/agora-test/Spec/Proposal.hs @@ -31,6 +31,7 @@ import Agora.Proposal.Scripts ( proposalPolicy, proposalValidator, ) +import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime)) import Agora.Stake ( ProposalLock (ProposalLock), StakeDatum (StakeDatum), @@ -83,7 +84,7 @@ tests = , (ResultTag 1, AssocMap.empty) ] , timingConfig = Shared.defaultProposalTimingConfig - , startingTime = Shared.tmpProposalStartingTime + , startingTime = ProposalStartingTime 0 } ) (Cosign [signer2]) @@ -118,7 +119,7 @@ tests = ] ) , timingConfig = Shared.defaultProposalTimingConfig - , startingTime = Shared.tmpProposalStartingTime + , startingTime = ProposalStartingTime 0 } ) (Vote (ResultTag 0)) diff --git a/agora.cabal b/agora.cabal index 9014c21..95189c6 100644 --- a/agora.cabal +++ b/agora.cabal @@ -141,22 +141,20 @@ library Agora.Proposal.Time Agora.Record Agora.SafeMoney + Agora.ScriptInfo Agora.Stake Agora.Stake.Scripts Agora.Treasury Agora.Utils Agora.Utils.Value - Agora.ScriptInfo - other-modules: - Agora.Aeson.Orphans + other-modules: Agora.Aeson.Orphans hs-source-dirs: agora library pprelude default-language: Haskell2010 exposed-modules: PPrelude hs-source-dirs: agora - build-depends: , base , plutarch @@ -176,8 +174,8 @@ library agora-sample Sample.Shared Sample.Stake Sample.Treasury - hs-source-dirs: agora-sample + hs-source-dirs: agora-sample build-depends: agora-testlib test-suite agora-test @@ -214,8 +212,7 @@ executable agora-scripts import: lang, deps, exe-opts main-is: Scripts.hs hs-source-dirs: agora-scripts - other-modules: - Options + other-modules: Options build-depends: , agora , optparse-applicative From a85b066a05423139f010e0e2028814c7da4ed126 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 25 May 2022 21:07:09 +0800 Subject: [PATCH 5/6] apply Emily's suggestions * add `PMaxTimeRangeWidth` * several `Default` instances for testing * a bunch of docstrings * fix the tests/samples --- .../Sample/Effect/GovernorMutation.hs | 31 +++++++++++---- agora-sample/Sample/Governor.hs | 38 ++++++++++--------- agora-sample/Sample/Proposal.hs | 35 +++++++++++------ agora-sample/Sample/Shared.hs | 36 +++++++++++------- agora-test/Spec/Effect/GovernorMutation.hs | 9 +++-- agora-test/Spec/Governor.hs | 13 ++++--- agora-test/Spec/Proposal.hs | 5 ++- agora.cabal | 1 + agora/Agora/Governor.hs | 14 ++++--- agora/Agora/Governor/Scripts.hs | 8 ++-- agora/Agora/Proposal.hs | 2 +- agora/Agora/Proposal/Time.hs | 25 ++++++++++-- 12 files changed, 142 insertions(+), 75 deletions(-) diff --git a/agora-sample/Sample/Effect/GovernorMutation.hs b/agora-sample/Sample/Effect/GovernorMutation.hs index e8c7b79..737783a 100644 --- a/agora-sample/Sample/Effect/GovernorMutation.hs +++ b/agora-sample/Sample/Effect/GovernorMutation.hs @@ -11,14 +11,22 @@ module Sample.Effect.GovernorMutation ( mkEffectDatum, ) where +-------------------------------------------------------------------------------- + import Agora.Effect.GovernorMutation ( MutateGovernorDatum (..), mutateGovernorValidator, ) import Agora.Governor (GovernorDatum (..)) import Agora.Proposal (ProposalId (..), ProposalThresholds (..)) + +-------------------------------------------------------------------------------- + import Plutarch.Api.V1 (mkValidator, validatorHash) import Plutarch.SafeMoney (Tagged (Tagged)) + +-------------------------------------------------------------------------------- + import Plutus.V1.Ledger.Address (scriptHashAddress) import Plutus.V1.Ledger.Api ( Address, @@ -35,11 +43,12 @@ import Plutus.V1.Ledger.Api ( import Plutus.V1.Ledger.Api qualified as Interval import Plutus.V1.Ledger.Value (AssetClass, assetClass) import Plutus.V1.Ledger.Value qualified as Value + +-------------------------------------------------------------------------------- + import Sample.Shared ( authorityTokenSymbol, - defaultCreateProposalTimeRangeMaxDuration, defaultProposalThresholds, - defaultProposalTimingConfig, govAssetClass, govValidatorAddress, governor, @@ -48,6 +57,12 @@ import Sample.Shared ( ) import Test.Util (datumPair, toDatumHash) +-------------------------------------------------------------------------------- + +import Data.Default.Class (Default (def)) + +-------------------------------------------------------------------------------- + -- | The effect validator instance. effectValidator :: Validator effectValidator = mkValidator $ mutateGovernorValidator governor @@ -103,8 +118,8 @@ mkEffectTxInfo newGovDatum = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -165,8 +180,8 @@ validNewGovernorDatum = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 42 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } invalidNewGovernorDatum :: GovernorDatum @@ -177,6 +192,6 @@ invalidNewGovernorDatum = { countVoting = Tagged (-1) } , nextProposalId = ProposalId 42 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } diff --git a/agora-sample/Sample/Governor.hs b/agora-sample/Sample/Governor.hs index dcc53e2..48329c0 100644 --- a/agora-sample/Sample/Governor.hs +++ b/agora-sample/Sample/Governor.hs @@ -56,6 +56,10 @@ import Agora.Proposal ( emptyVotesFor, ) import Agora.Proposal qualified as P +import Agora.Proposal.Time ( + ProposalStartingTime (ProposalStartingTime), + ProposalTimingConfig (..), + ) import Agora.Stake ( ProposalLock (..), Stake (..), @@ -64,15 +68,9 @@ import Agora.Stake ( -------------------------------------------------------------------------------- -import Agora.Proposal.Time ( - ProposalStartingTime (ProposalStartingTime), - ProposalTimingConfig (..), - ) import Sample.Shared ( authorityTokenSymbol, - defaultCreateProposalTimeRangeMaxDuration, defaultProposalThresholds, - defaultProposalTimingConfig, govAssetClass, govSymbol, govValidatorAddress, @@ -91,6 +89,10 @@ import Test.Util (closedBoundedInterval, datumPair, toDatumHash) -------------------------------------------------------------------------------- +import Data.Default.Class (Default (def)) + +-------------------------------------------------------------------------------- + {- | A valid 'ScriptContext' for minting GST. - Only the minting policy will be ran in the transaction. @@ -119,8 +121,8 @@ mintGST = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } governorOutputDatum :: Datum governorOutputDatum = Datum $ toBuiltinData governorOutputDatum' @@ -214,8 +216,8 @@ createProposal = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = thisProposalId - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -245,7 +247,7 @@ createProposal = , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects - , timingConfig = defaultProposalTimingConfig + , timingConfig = def , startingTime = proposalStartingTimeFromTimeRange validTimeRange } ) @@ -392,8 +394,8 @@ mintGATs = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 5 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -428,7 +430,7 @@ mintGATs = , cosigners = [signer, signer2] , thresholds = defaultProposalThresholds , votes = proposalVotes - , timingConfig = defaultProposalTimingConfig + , timingConfig = def , startingTime = ProposalStartingTime 10 } proposalInputDatum :: Datum @@ -485,8 +487,8 @@ mintGATs = -- validTimeRange = closedBoundedInterval - (defaultProposalTimingConfig.lockingTime + 11) - (defaultProposalTimingConfig.executingTime - 11) + ((def :: ProposalTimingConfig).lockingTime + 11) + ((def :: ProposalTimingConfig).executingTime - 11) in ScriptContext { scriptContextTxInfo = TxInfo @@ -587,8 +589,8 @@ mutateState = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 5 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' diff --git a/agora-sample/Sample/Proposal.hs b/agora-sample/Sample/Proposal.hs index cea8be0..631dc9f 100644 --- a/agora-sample/Sample/Proposal.hs +++ b/agora-sample/Sample/Proposal.hs @@ -16,9 +16,14 @@ module Sample.Proposal ( ) where -------------------------------------------------------------------------------- + import Plutarch.Api.V1 ( validatorHash, ) +import Plutarch.SafeMoney (Tagged (Tagged), untag) + +-------------------------------------------------------------------------------- + import Plutus.V1.Ledger.Api ( Address (Address), Credential (ScriptCredential), @@ -34,6 +39,7 @@ import Plutus.V1.Ledger.Api ( TxOutRef (TxOutRef), ) import Plutus.V1.Ledger.Value qualified as Value +import PlutusTx.AssocMap qualified as AssocMap -------------------------------------------------------------------------------- @@ -51,13 +57,18 @@ import Agora.Proposal ( ) import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), 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 (closedBoundedInterval, datumPair, toDatumHash, updateMap) -------------------------------------------------------------------------------- +import Data.Default.Class (Default (def)) + +-------------------------------------------------------------------------------- + -- | This script context should be a valid transaction. proposalCreation :: ScriptContext proposalCreation = @@ -78,7 +89,7 @@ proposalCreation = , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects - , timingConfig = defaultProposalTimingConfig + , timingConfig = def , startingTime = proposalStartingTimeFromTimeRange validTimeRange } ) @@ -90,8 +101,8 @@ proposalCreation = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } ) govAfter :: Datum @@ -101,8 +112,8 @@ proposalCreation = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 1 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } ) @@ -179,7 +190,7 @@ cosignProposal newSigners = , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects - , timingConfig = defaultProposalTimingConfig + , timingConfig = def , startingTime = ProposalStartingTime 0 } stakeDatum :: StakeDatum @@ -190,7 +201,7 @@ cosignProposal newSigners = validTimeRange = closedBoundedInterval 10 - (defaultProposalTimingConfig.draftTime - 10) + ((def :: ProposalTimingConfig).draftTime - 10) in TxInfo { txInfoInputs = [ TxInInfo @@ -300,7 +311,7 @@ voteOnProposal params = , cosigners = [stakeOwner] , thresholds = defaultProposalThresholds , votes = ProposalVotes initialVotes - , timingConfig = defaultProposalTimingConfig + , timingConfig = def , startingTime = ProposalStartingTime 0 } proposalInputDatum :: Datum @@ -389,7 +400,9 @@ voteOnProposal params = --- validTimeRange = - closedBoundedInterval (defaultProposalTimingConfig.draftTime + 1) (defaultProposalTimingConfig.votingTime - 1) + closedBoundedInterval + ((def :: ProposalTimingConfig).draftTime + 1) + ((def :: ProposalTimingConfig).votingTime - 1) in TxInfo { txInfoInputs = [ TxInInfo proposalRef proposalInput diff --git a/agora-sample/Sample/Shared.hs b/agora-sample/Sample/Shared.hs index 8d44130..94801bf 100644 --- a/agora-sample/Sample/Shared.hs +++ b/agora-sample/Sample/Shared.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + {- | Module : Sample.Shared Maintainer : emi@haskell.fyi @@ -36,8 +38,6 @@ module Sample.Shared ( proposalPolicySymbol, proposalValidatorHash, proposalValidatorAddress, - defaultProposalTimingConfig, - defaultCreateProposalTimeRangeMaxDuration, proposalStartingTimeFromTimeRange, -- ** Authority @@ -78,12 +78,14 @@ import Agora.Proposal ( ProposalThresholds (..), ) import Agora.Proposal.Time ( + MaxTimeRangeWidth (..), ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..), ) import Agora.Stake (Stake (..)) import Agora.Treasury (treasuryValidator) import Agora.Utils (validatorHashToTokenName) +import Data.Default.Class (Default (..)) import Plutarch.Api.V1 ( mintingPolicySymbol, mkMintingPolicy, @@ -100,7 +102,6 @@ import Plutus.V1.Ledger.Api ( Interval (..), LowerBound (..), MintingPolicy (..), - POSIXTime, POSIXTimeRange, PubKeyHash, TxOutRef (TxOutRef), @@ -197,18 +198,27 @@ authorityToken = authorityTokenFromGovernor governor authorityTokenSymbol :: CurrencySymbol authorityTokenSymbol = authorityTokenSymbolFromGovernor governor -defaultProposalTimingConfig :: ProposalTimingConfig -defaultProposalTimingConfig = - ProposalTimingConfig - { draftTime = 50 - , votingTime = 1000 - , lockingTime = 2000 - , executingTime = 3000 - } +{- | Default value of 'Agora.Governor.GovernorDatum.proposalTimings'. + For testing purpose only. +-} +instance Default ProposalTimingConfig where + def = + ProposalTimingConfig + { draftTime = 50 + , votingTime = 1000 + , lockingTime = 2000 + , executingTime = 3000 + } -defaultCreateProposalTimeRangeMaxDuration :: POSIXTime -defaultCreateProposalTimeRangeMaxDuration = 10 +{- | Default value of 'Agora.Governor.GovernorDatum.createProposalTimeRangeMaxWidth'. + For testing purpose only. +-} +instance Default MaxTimeRangeWidth where + def = MaxTimeRangeWidth 10 +{- | Get the starting time of a proposal, given a closed finite time range. + Tightness of the time range is not checked. See 'Agora.Proposal.Time.createProposalStartingTime'. +-} proposalStartingTimeFromTimeRange :: POSIXTimeRange -> ProposalStartingTime proposalStartingTimeFromTimeRange (Interval (LowerBound (Finite l) True) (UpperBound (Finite u) True)) = diff --git a/agora-test/Spec/Effect/GovernorMutation.hs b/agora-test/Spec/Effect/GovernorMutation.hs index fd70f34..18ed995 100644 --- a/agora-test/Spec/Effect/GovernorMutation.hs +++ b/agora-test/Spec/Effect/GovernorMutation.hs @@ -4,6 +4,7 @@ import Agora.Effect.GovernorMutation (mutateGovernorValidator) import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor)) import Agora.Governor.Scripts (governorValidator) import Agora.Proposal (ProposalId (..)) +import Data.Default.Class (Default (def)) import Plutus.V1.Ledger.Api (ScriptContext (ScriptContext), ScriptPurpose (Spending)) import Sample.Effect.GovernorMutation ( effectRef, @@ -29,8 +30,8 @@ tests = ( GovernorDatum Shared.defaultProposalThresholds (ProposalId 0) - Shared.defaultProposalTimingConfig - Shared.defaultCreateProposalTimeRangeMaxDuration + def + def ) MutateGovernor ( ScriptContext @@ -51,8 +52,8 @@ tests = ( GovernorDatum Shared.defaultProposalThresholds (ProposalId 0) - Shared.defaultProposalTimingConfig - Shared.defaultCreateProposalTimeRangeMaxDuration + def + def ) MutateGovernor ( ScriptContext diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 7d324fb..3ac39a2 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -16,6 +16,7 @@ module Spec.Governor (tests) where import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..)) import Agora.Governor.Scripts (governorPolicy, governorValidator) import Agora.Proposal (ProposalId (..)) +import Data.Default.Class (Default (def)) import Sample.Governor (createProposal, mintGATs, mintGST, mutateState) import Sample.Shared qualified as Shared import Test.Tasty (TestTree, testGroup) @@ -41,8 +42,8 @@ tests = ( GovernorDatum Shared.defaultProposalThresholds (ProposalId 0) - Shared.defaultProposalTimingConfig - Shared.defaultCreateProposalTimeRangeMaxDuration + def + def ) CreateProposal createProposal @@ -52,8 +53,8 @@ tests = ( GovernorDatum Shared.defaultProposalThresholds (ProposalId 5) - Shared.defaultProposalTimingConfig - Shared.defaultCreateProposalTimeRangeMaxDuration + def + def ) MintGATs mintGATs @@ -63,8 +64,8 @@ tests = ( GovernorDatum Shared.defaultProposalThresholds (ProposalId 5) - Shared.defaultProposalTimingConfig - Shared.defaultCreateProposalTimeRangeMaxDuration + def + def ) MutateGovernor mutateState diff --git a/agora-test/Spec/Proposal.hs b/agora-test/Spec/Proposal.hs index dc0f1cc..c381126 100644 --- a/agora-test/Spec/Proposal.hs +++ b/agora-test/Spec/Proposal.hs @@ -38,6 +38,7 @@ import Agora.Stake ( StakeRedeemer (PermitVote, WitnessStake), ) import Agora.Stake.Scripts (stakeValidator) +import Data.Default.Class (Default (def)) import Plutarch.SafeMoney (Tagged (Tagged)) import Plutus.V1.Ledger.Api (ScriptContext (..), ScriptPurpose (..)) import PlutusTx.AssocMap qualified as AssocMap @@ -83,7 +84,7 @@ tests = [ (ResultTag 0, AssocMap.empty) , (ResultTag 1, AssocMap.empty) ] - , timingConfig = Shared.defaultProposalTimingConfig + , timingConfig = def , startingTime = ProposalStartingTime 0 } ) @@ -118,7 +119,7 @@ tests = , (ResultTag 1, 4242) ] ) - , timingConfig = Shared.defaultProposalTimingConfig + , timingConfig = def , startingTime = ProposalStartingTime 0 } ) diff --git a/agora.cabal b/agora.cabal index 95189c6..256e025 100644 --- a/agora.cabal +++ b/agora.cabal @@ -114,6 +114,7 @@ common test-deps , agora , apropos , apropos-tx + , data-default-class , mtl , QuickCheck , quickcheck-instances diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 7bd4805..a2d5940 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -37,13 +37,17 @@ import Agora.Proposal ( ProposalId (ProposalId), ProposalThresholds, ) -import Agora.Proposal.Time (PProposalTimingConfig, ProposalTimingConfig) +import Agora.Proposal.Time ( + MaxTimeRangeWidth, + PMaxTimeRangeWidth, + PProposalTimingConfig, + ProposalTimingConfig, + ) import Agora.SafeMoney (GTTag) import Agora.Utils (tclet) -------------------------------------------------------------------------------- -import Plutarch.Api.V1 (PPOSIXTime) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, @@ -56,7 +60,7 @@ import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- -import Plutus.V1.Ledger.Api (POSIXTime, TxOutRef) +import Plutus.V1.Ledger.Api (TxOutRef) import Plutus.V1.Ledger.Value (AssetClass (..)) import PlutusTx qualified @@ -71,7 +75,7 @@ data GovernorDatum = GovernorDatum , proposalTimings :: ProposalTimingConfig -- ^ The timing configuration for proposals. -- Will get copied over upon the creation of proposals. - , createProposalTimeRangeMaxDuration :: POSIXTime + , createProposalTimeRangeMaxWidth :: MaxTimeRangeWidth -- ^ The maximum valid duration of a transaction that creats a proposal. } deriving stock (Show, GHC.Generic) @@ -126,7 +130,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum '[ "proposalThresholds" ':= PProposalThresholds , "nextProposalId" ':= PProposalId , "proposalTimings" ':= PProposalTimingConfig - , "createProposalTimeRangeMaxDuration" ':= PPOSIXTime + , "createProposalTimeRangeMaxWidth" ':= PMaxTimeRangeWidth ] ) } diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 9f474f6..fc4987d 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -307,7 +307,7 @@ governorValidator gov = @'[ "proposalThresholds" , "nextProposalId" , "proposalTimings" - , "createProposalTimeRangeMaxDuration" + , "createProposalTimeRangeMaxWidth" ] oldGovernorDatum @@ -347,8 +347,8 @@ governorValidator gov = ( #proposalThresholds .= oldGovernorDatumF.proposalThresholds .& #nextProposalId .= pdata expectedNextProposalId .& #proposalTimings .= oldGovernorDatumF.proposalTimings - .& #createProposalTimeRangeMaxDuration - .= oldGovernorDatumF.createProposalTimeRangeMaxDuration + .& #createProposalTimeRangeMaxWidth + .= oldGovernorDatumF.createProposalTimeRangeMaxWidth ) tcassert "Unexpected governor state datum" $ newGovernorDatum #== expectedNewDatum @@ -436,7 +436,7 @@ governorValidator gov = expectedVotes = pemptyVotesFor # pfromData proposalOutputDatum.effects expectedStartingTime = createProposalStartingTime - # oldGovernorDatumF.createProposalTimeRangeMaxDuration + # oldGovernorDatumF.createProposalTimeRangeMaxWidth # txInfoF.validRange -- Id, thresholds and timings should be copied from the old governor state datum. expectedProposalOut = diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 0cd1452..b120216 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -349,7 +349,7 @@ deriving via instance (PConstantDecl ProposalVotes) --- Plutarch version of 'pemptyVotesFor'. +-- Plutarch-level version of 'emptyVotesFor'. pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap PResultTag a :--> PProposalVotes) pemptyVotesFor = phoistAcyclic $ diff --git a/agora/Agora/Proposal/Time.hs b/agora/Agora/Proposal/Time.hs index 2f6509c..f1e05fc 100644 --- a/agora/Agora/Proposal/Time.hs +++ b/agora/Agora/Proposal/Time.hs @@ -13,11 +13,13 @@ module Agora.Proposal.Time ( ProposalTime (..), ProposalTimingConfig (..), ProposalStartingTime (..), + MaxTimeRangeWidth (..), -- * Plutarch-land PProposalTime (..), PProposalTimingConfig (..), PProposalStartingTime (..), + PMaxTimeRangeWidth (..), -- * Compute periods given config and starting time. createProposalStartingTime, @@ -108,6 +110,11 @@ data ProposalTimingConfig = ProposalTimingConfig PlutusTx.makeIsDataIndexed ''ProposalTimingConfig [('ProposalTimingConfig, 0)] +-- | Represents the maximum width of a 'POSIXTimeRange'. +newtype MaxTimeRangeWidth = MaxTimeRangeWidth {getMaxWidth :: POSIXTime} + deriving stock (Eq, Show, Ord, GHC.Generic) + deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) + -------------------------------------------------------------------------------- -- | Plutarch-level version of 'ProposalTime'. @@ -173,6 +180,17 @@ deriving via instance (PConstantDecl ProposalTimingConfig) +-- | Plutarch-level version of 'MaxTimeRangeWidth'. +newtype PMaxTimeRangeWidth (s :: S) + = PMaxTimeRangeWidth (Term s PPOSIXTime) + deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PMaxTimeRangeWidth PPOSIXTime) + +instance PUnsafeLiftDecl PMaxTimeRangeWidth where type PLifted PMaxTimeRangeWidth = MaxTimeRangeWidth +deriving via + (DerivePConstantViaNewtype MaxTimeRangeWidth PMaxTimeRangeWidth PPOSIXTime) + instance + (PConstantDecl MaxTimeRangeWidth) + -------------------------------------------------------------------------------- -- FIXME: Orphan instance, move this to plutarch-extra. @@ -180,11 +198,12 @@ instance AdditiveSemigroup (Term s PPOSIXTime) where (punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y {- | Get the starting time of a proposal, from the 'Plutus.V1.Ledger.Api.txInfoValidPeriod' field. - For every proposal, this is only meant to run once upon creation. + For every proposal, this is only meant to run once upon creation. Given time range should be + tight enough, meaning that the width of the time range should be less than the maximum value. -} -createProposalStartingTime :: forall (s :: S). Term s (PPOSIXTime :--> PPOSIXTimeRange :--> PProposalStartingTime) +createProposalStartingTime :: forall (s :: S). Term s (PMaxTimeRangeWidth :--> PPOSIXTimeRange :--> PProposalStartingTime) createProposalStartingTime = phoistAcyclic $ - plam $ \maxDuration iv -> unTermCont $ do + plam $ \(pto -> maxDuration) iv -> unTermCont $ do currentTimeF <- tcont $ pletFields @'["lowerBound", "upperBound"] $ From ff4eb9cf27d84f81455fb11dfc0d5d4d9d179156 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 25 May 2022 21:36:56 +0800 Subject: [PATCH 6/6] make 'PProposalTime' scott-encoded --- agora/Agora/Proposal/Time.hs | 132 ++++++++++++++--------------------- 1 file changed, 53 insertions(+), 79 deletions(-) diff --git a/agora/Agora/Proposal/Time.hs b/agora/Agora/Proposal/Time.hs index f1e05fc..e8d11a0 100644 --- a/agora/Agora/Proposal/Time.hs +++ b/agora/Agora/Proposal/Time.hs @@ -10,7 +10,6 @@ Time functions for proposal phases. -} module Agora.Proposal.Time ( -- * Haskell-land - ProposalTime (..), ProposalTimingConfig (..), ProposalStartingTime (..), MaxTimeRangeWidth (..), @@ -30,10 +29,9 @@ module Agora.Proposal.Time ( isExecutionPeriod, ) where -import Agora.Record (mkRecordConstr, (.&), (.=)) import Agora.Utils (tcassert, tcmatch) import GHC.Generics qualified as GHC -import Generics.SOP (Generic, I (I)) +import Generics.SOP (Generic, HasDatatypeInfo, I (I)) import Plutarch.Api.V1 ( PExtended (PFinite), PInterval (PInterval), @@ -42,7 +40,11 @@ import Plutarch.Api.V1 ( PPOSIXTimeRange, PUpperBound (PUpperBound), ) -import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..)) +import Plutarch.DataRepr ( + DerivePConstantViaData (..), + PDataFields, + PIsDataReprInstances (..), + ) import Plutarch.Lift ( DerivePConstantViaNewtype (..), PConstantDecl, @@ -56,35 +58,6 @@ import Prelude hiding ((+)) -------------------------------------------------------------------------------- -{- | == Establishing timing in Proposal interactions. - - In Plutus, it's impossible to determine time exactly. It's also impossible - to get a single point in time, yet often we need to check - various constraints on time. - - For the purposes of proposals, there's a single most important feature: - The ability to determine if we can perform an action. In order to correctly - determine if we are able to perform certain actions, we need to know what - time it roughly is, compared to when the proposal was created. - - 'ProposalTime' represents "the time according to the proposal". - Its representation is opaque, and doesn't matter. - - Various functions work simply on 'ProposalTime' and 'ProposalTimingConfig'. - In particular, 'currentProposalTime' is useful for extracting the time - from the 'Plutus.V1.Ledger.Api.txInfoValidPeriod' field - of 'Plutus.V1.Ledger.Api.TxInfo'. - - We avoid 'PPOSIXTimeRange' where we can in order to save on operations. --} -data ProposalTime = ProposalTime - { lowerBound :: POSIXTime - , upperBound :: POSIXTime - } - deriving stock (Eq, Show, GHC.Generic) - -PlutusTx.makeIsDataIndexed ''ProposalTime [('ProposalTime, 0)] - -- | Represents the starting time of the proposal. newtype ProposalStartingTime = ProposalStartingTime { getProposalStartingTime :: POSIXTime @@ -117,30 +90,33 @@ newtype MaxTimeRangeWidth = MaxTimeRangeWidth {getMaxWidth :: POSIXTime} -------------------------------------------------------------------------------- --- | Plutarch-level version of 'ProposalTime'. -newtype PProposalTime (s :: S) - = PProposalTime - ( Term - s - ( PDataRecord - '[ "lowerBound" ':= PPOSIXTime - , "upperBound" ':= PPOSIXTime - ] - ) - ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via (PIsDataReprInstances PProposalTime) +{- | == Establishing timing in Proposal interactions. -instance PUnsafeLiftDecl PProposalTime where - type PLifted PProposalTime = ProposalTime -deriving via - (DerivePConstantViaData ProposalTime PProposalTime) - instance - (PConstantDecl ProposalTime) + In Plutus, it's impossible to determine time exactly. It's also impossible + to get a single point in time, yet often we need to check + various constraints on time. + + For the purposes of proposals, there's a single most important feature: + The ability to determine if we can perform an action. In order to correctly + determine if we are able to perform certain actions, we need to know what + time it roughly is, compared to when the proposal was created. + + 'ProposalTime' represents "the time according to the proposal". + Its representation is opaque, and doesn't matter. + + Various functions work simply on 'ProposalTime' and 'ProposalTimingConfig'. + In particular, 'currentProposalTime' is useful for extracting the time + from the 'Plutus.V1.Ledger.Api.txInfoValidPeriod' field + of 'Plutus.V1.Ledger.Api.TxInfo'. + + We avoid 'PPOSIXTimeRange' where we can in order to save on operations. +-} +data PProposalTime (s :: S) = PProposalTime + { lowerBound :: Term s PPOSIXTime + , upperBound :: Term s PPOSIXTime + } + deriving stock (GHC.Generic) + deriving anyclass (Generic, PlutusType, HasDatatypeInfo, PEq) -- | Plutarch-level version of 'ProposalStartingTime'. newtype PProposalStartingTime (s :: S) = PProposalStartingTime (Term s PPOSIXTime) @@ -204,10 +180,7 @@ instance AdditiveSemigroup (Term s PPOSIXTime) where createProposalStartingTime :: forall (s :: S). Term s (PMaxTimeRangeWidth :--> PPOSIXTimeRange :--> PProposalStartingTime) createProposalStartingTime = phoistAcyclic $ plam $ \(pto -> maxDuration) iv -> unTermCont $ do - currentTimeF <- - tcont $ - pletFields @'["lowerBound", "upperBound"] $ - currentProposalTime # iv + currentTimeF <- tcmatch $ currentProposalTime # iv -- Use the middle of the current time range as the starting time. let duration = currentTimeF.upperBound - currentTimeF.lowerBound @@ -237,21 +210,23 @@ currentProposalTime = phoistAcyclic $ lbf <- tcont $ pletFields @'["_0", "_1"] lb ubf <- tcont $ pletFields @'["_0", "_1"] ub pure $ - mkRecordConstr PProposalTime $ - #lowerBound - .= pmatch - lbf._0 - ( \case - PFinite ((pfield @"_0" #) -> d) -> d - _ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time." - ) - .& #upperBound - .= pmatch - ubf._0 - ( \case - PFinite ((pfield @"_0" #) -> d) -> d - _ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time." - ) + pcon $ + PProposalTime + { lowerBound = + pmatch + lbf._0 + ( \case + PFinite ((pfield @"_0" #) -> d) -> d + _ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time." + ) + , upperBound = + pmatch + ubf._0 + ( \case + PFinite ((pfield @"_0" #) -> d) -> d + _ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time." + ) + } -- | Check if 'PProposalTime' is within two 'PPOSIXTime'. Inclusive. proposalTimeWithin :: @@ -264,13 +239,12 @@ proposalTimeWithin :: ) proposalTimeWithin = phoistAcyclic $ plam $ \l h proposalTime' -> unTermCont $ do - PProposalTime proposalTime <- tcmatch proposalTime' - ptf <- tcont $ pletFields @'["lowerBound", "upperBound"] proposalTime + PProposalTime ut lt <- tcmatch proposalTime' pure $ foldr1 (#&&) - [ l #<= pfromData ptf.lowerBound - , pfromData ptf.upperBound #<= h + [ l #<= lt + , ut #<= h ] -- | True if the 'PProposalTime' is in the draft period.