apply Emily's suggestions

* add `PMaxTimeRangeWidth`
* several `Default` instances for testing
* a bunch of docstrings
* fix the tests/samples
This commit is contained in:
fanghr 2022-05-25 21:07:09 +08:00
parent c6c93f587a
commit 6f9de51541
12 changed files with 142 additions and 75 deletions

View file

@ -11,14 +11,22 @@ module Sample.Effect.GovernorMutation (
mkEffectDatum, mkEffectDatum,
) where ) where
--------------------------------------------------------------------------------
import Agora.Effect.GovernorMutation ( import Agora.Effect.GovernorMutation (
MutateGovernorDatum (..), MutateGovernorDatum (..),
mutateGovernorValidator, mutateGovernorValidator,
) )
import Agora.Governor (GovernorDatum (..)) import Agora.Governor (GovernorDatum (..))
import Agora.Proposal (ProposalId (..), ProposalThresholds (..)) import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (mkValidator, validatorHash) import Plutarch.Api.V1 (mkValidator, validatorHash)
import Plutarch.SafeMoney (Tagged (Tagged)) import Plutarch.SafeMoney (Tagged (Tagged))
--------------------------------------------------------------------------------
import Plutus.V1.Ledger.Address (scriptHashAddress) import Plutus.V1.Ledger.Address (scriptHashAddress)
import Plutus.V1.Ledger.Api ( import Plutus.V1.Ledger.Api (
Address, Address,
@ -35,11 +43,12 @@ import Plutus.V1.Ledger.Api (
import Plutus.V1.Ledger.Api qualified as Interval import Plutus.V1.Ledger.Api qualified as Interval
import Plutus.V1.Ledger.Value (AssetClass, assetClass) import Plutus.V1.Ledger.Value (AssetClass, assetClass)
import Plutus.V1.Ledger.Value qualified as Value import Plutus.V1.Ledger.Value qualified as Value
--------------------------------------------------------------------------------
import Sample.Shared ( import Sample.Shared (
authorityTokenSymbol, authorityTokenSymbol,
defaultCreateProposalTimeRangeMaxDuration,
defaultProposalThresholds, defaultProposalThresholds,
defaultProposalTimingConfig,
govAssetClass, govAssetClass,
govValidatorAddress, govValidatorAddress,
governor, governor,
@ -48,6 +57,12 @@ import Sample.Shared (
) )
import Test.Util (datumPair, toDatumHash) import Test.Util (datumPair, toDatumHash)
--------------------------------------------------------------------------------
import Data.Default.Class (Default (def))
--------------------------------------------------------------------------------
-- | The effect validator instance. -- | The effect validator instance.
effectValidator :: Validator effectValidator :: Validator
effectValidator = mkValidator $ mutateGovernorValidator governor effectValidator = mkValidator $ mutateGovernorValidator governor
@ -103,8 +118,8 @@ mkEffectTxInfo newGovDatum =
GovernorDatum GovernorDatum
{ proposalThresholds = defaultProposalThresholds { proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 0 , nextProposalId = ProposalId 0
, proposalTimings = defaultProposalTimingConfig , proposalTimings = def
, createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration , createProposalTimeRangeMaxWidth = def
} }
governorInputDatum :: Datum governorInputDatum :: Datum
governorInputDatum = Datum $ toBuiltinData governorInputDatum' governorInputDatum = Datum $ toBuiltinData governorInputDatum'
@ -165,8 +180,8 @@ validNewGovernorDatum =
GovernorDatum GovernorDatum
{ proposalThresholds = defaultProposalThresholds { proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 42 , nextProposalId = ProposalId 42
, proposalTimings = defaultProposalTimingConfig , proposalTimings = def
, createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration , createProposalTimeRangeMaxWidth = def
} }
invalidNewGovernorDatum :: GovernorDatum invalidNewGovernorDatum :: GovernorDatum
@ -177,6 +192,6 @@ invalidNewGovernorDatum =
{ countVoting = Tagged (-1) { countVoting = Tagged (-1)
} }
, nextProposalId = ProposalId 42 , nextProposalId = ProposalId 42
, proposalTimings = defaultProposalTimingConfig , proposalTimings = def
, createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration , createProposalTimeRangeMaxWidth = def
} }

View file

@ -56,6 +56,10 @@ import Agora.Proposal (
emptyVotesFor, emptyVotesFor,
) )
import Agora.Proposal qualified as P import Agora.Proposal qualified as P
import Agora.Proposal.Time (
ProposalStartingTime (ProposalStartingTime),
ProposalTimingConfig (..),
)
import Agora.Stake ( import Agora.Stake (
ProposalLock (..), ProposalLock (..),
Stake (..), Stake (..),
@ -64,15 +68,9 @@ import Agora.Stake (
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Agora.Proposal.Time (
ProposalStartingTime (ProposalStartingTime),
ProposalTimingConfig (..),
)
import Sample.Shared ( import Sample.Shared (
authorityTokenSymbol, authorityTokenSymbol,
defaultCreateProposalTimeRangeMaxDuration,
defaultProposalThresholds, defaultProposalThresholds,
defaultProposalTimingConfig,
govAssetClass, govAssetClass,
govSymbol, govSymbol,
govValidatorAddress, govValidatorAddress,
@ -91,6 +89,10 @@ import Test.Util (closedBoundedInterval, datumPair, toDatumHash)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Data.Default.Class (Default (def))
--------------------------------------------------------------------------------
{- | A valid 'ScriptContext' for minting GST. {- | A valid 'ScriptContext' for minting GST.
- Only the minting policy will be ran in the transaction. - Only the minting policy will be ran in the transaction.
@ -119,8 +121,8 @@ mintGST =
GovernorDatum GovernorDatum
{ proposalThresholds = defaultProposalThresholds { proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 0 , nextProposalId = ProposalId 0
, proposalTimings = defaultProposalTimingConfig , proposalTimings = def
, createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration , createProposalTimeRangeMaxWidth = def
} }
governorOutputDatum :: Datum governorOutputDatum :: Datum
governorOutputDatum = Datum $ toBuiltinData governorOutputDatum' governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
@ -214,8 +216,8 @@ createProposal =
GovernorDatum GovernorDatum
{ proposalThresholds = defaultProposalThresholds { proposalThresholds = defaultProposalThresholds
, nextProposalId = thisProposalId , nextProposalId = thisProposalId
, proposalTimings = defaultProposalTimingConfig , proposalTimings = def
, createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration , createProposalTimeRangeMaxWidth = def
} }
governorInputDatum :: Datum governorInputDatum :: Datum
governorInputDatum = Datum $ toBuiltinData governorInputDatum' governorInputDatum = Datum $ toBuiltinData governorInputDatum'
@ -245,7 +247,7 @@ createProposal =
, cosigners = [signer] , cosigners = [signer]
, thresholds = defaultProposalThresholds , thresholds = defaultProposalThresholds
, votes = emptyVotesFor effects , votes = emptyVotesFor effects
, timingConfig = defaultProposalTimingConfig , timingConfig = def
, startingTime = proposalStartingTimeFromTimeRange validTimeRange , startingTime = proposalStartingTimeFromTimeRange validTimeRange
} }
) )
@ -392,8 +394,8 @@ mintGATs =
GovernorDatum GovernorDatum
{ proposalThresholds = defaultProposalThresholds { proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 5 , nextProposalId = ProposalId 5
, proposalTimings = defaultProposalTimingConfig , proposalTimings = def
, createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration , createProposalTimeRangeMaxWidth = def
} }
governorInputDatum :: Datum governorInputDatum :: Datum
governorInputDatum = Datum $ toBuiltinData governorInputDatum' governorInputDatum = Datum $ toBuiltinData governorInputDatum'
@ -428,7 +430,7 @@ mintGATs =
, cosigners = [signer, signer2] , cosigners = [signer, signer2]
, thresholds = defaultProposalThresholds , thresholds = defaultProposalThresholds
, votes = proposalVotes , votes = proposalVotes
, timingConfig = defaultProposalTimingConfig , timingConfig = def
, startingTime = ProposalStartingTime 10 , startingTime = ProposalStartingTime 10
} }
proposalInputDatum :: Datum proposalInputDatum :: Datum
@ -485,8 +487,8 @@ mintGATs =
-- --
validTimeRange = validTimeRange =
closedBoundedInterval closedBoundedInterval
(defaultProposalTimingConfig.lockingTime + 11) ((def :: ProposalTimingConfig).lockingTime + 11)
(defaultProposalTimingConfig.executingTime - 11) ((def :: ProposalTimingConfig).executingTime - 11)
in ScriptContext in ScriptContext
{ scriptContextTxInfo = { scriptContextTxInfo =
TxInfo TxInfo
@ -587,8 +589,8 @@ mutateState =
GovernorDatum GovernorDatum
{ proposalThresholds = defaultProposalThresholds { proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 5 , nextProposalId = ProposalId 5
, proposalTimings = defaultProposalTimingConfig , proposalTimings = def
, createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration , createProposalTimeRangeMaxWidth = def
} }
governorInputDatum :: Datum governorInputDatum :: Datum
governorInputDatum = Datum $ toBuiltinData governorInputDatum' governorInputDatum = Datum $ toBuiltinData governorInputDatum'

View file

@ -16,9 +16,14 @@ module Sample.Proposal (
) where ) where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
validatorHash, validatorHash,
) )
import Plutarch.SafeMoney (Tagged (Tagged), untag)
--------------------------------------------------------------------------------
import Plutus.V1.Ledger.Api ( import Plutus.V1.Ledger.Api (
Address (Address), Address (Address),
Credential (ScriptCredential), Credential (ScriptCredential),
@ -34,6 +39,7 @@ import Plutus.V1.Ledger.Api (
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
) )
import Plutus.V1.Ledger.Value qualified as Value 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.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..))
import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..)) import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..))
import Plutarch.SafeMoney (Tagged (Tagged), untag)
import PlutusTx.AssocMap qualified as AssocMap --------------------------------------------------------------------------------
import Sample.Shared import Sample.Shared
import Test.Util (closedBoundedInterval, datumPair, toDatumHash, updateMap) import Test.Util (closedBoundedInterval, datumPair, toDatumHash, updateMap)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Data.Default.Class (Default (def))
--------------------------------------------------------------------------------
-- | This script context should be a valid transaction. -- | This script context should be a valid transaction.
proposalCreation :: ScriptContext proposalCreation :: ScriptContext
proposalCreation = proposalCreation =
@ -78,7 +89,7 @@ proposalCreation =
, cosigners = [signer] , cosigners = [signer]
, thresholds = defaultProposalThresholds , thresholds = defaultProposalThresholds
, votes = emptyVotesFor effects , votes = emptyVotesFor effects
, timingConfig = defaultProposalTimingConfig , timingConfig = def
, startingTime = proposalStartingTimeFromTimeRange validTimeRange , startingTime = proposalStartingTimeFromTimeRange validTimeRange
} }
) )
@ -90,8 +101,8 @@ proposalCreation =
GovernorDatum GovernorDatum
{ proposalThresholds = defaultProposalThresholds { proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 0 , nextProposalId = ProposalId 0
, proposalTimings = defaultProposalTimingConfig , proposalTimings = def
, createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration , createProposalTimeRangeMaxWidth = def
} }
) )
govAfter :: Datum govAfter :: Datum
@ -101,8 +112,8 @@ proposalCreation =
GovernorDatum GovernorDatum
{ proposalThresholds = defaultProposalThresholds { proposalThresholds = defaultProposalThresholds
, nextProposalId = ProposalId 1 , nextProposalId = ProposalId 1
, proposalTimings = defaultProposalTimingConfig , proposalTimings = def
, createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration , createProposalTimeRangeMaxWidth = def
} }
) )
@ -179,7 +190,7 @@ cosignProposal newSigners =
, cosigners = [signer] , cosigners = [signer]
, thresholds = defaultProposalThresholds , thresholds = defaultProposalThresholds
, votes = emptyVotesFor effects , votes = emptyVotesFor effects
, timingConfig = defaultProposalTimingConfig , timingConfig = def
, startingTime = ProposalStartingTime 0 , startingTime = ProposalStartingTime 0
} }
stakeDatum :: StakeDatum stakeDatum :: StakeDatum
@ -190,7 +201,7 @@ cosignProposal newSigners =
validTimeRange = validTimeRange =
closedBoundedInterval closedBoundedInterval
10 10
(defaultProposalTimingConfig.draftTime - 10) ((def :: ProposalTimingConfig).draftTime - 10)
in TxInfo in TxInfo
{ txInfoInputs = { txInfoInputs =
[ TxInInfo [ TxInInfo
@ -300,7 +311,7 @@ voteOnProposal params =
, cosigners = [stakeOwner] , cosigners = [stakeOwner]
, thresholds = defaultProposalThresholds , thresholds = defaultProposalThresholds
, votes = ProposalVotes initialVotes , votes = ProposalVotes initialVotes
, timingConfig = defaultProposalTimingConfig , timingConfig = def
, startingTime = ProposalStartingTime 0 , startingTime = ProposalStartingTime 0
} }
proposalInputDatum :: Datum proposalInputDatum :: Datum
@ -389,7 +400,9 @@ voteOnProposal params =
--- ---
validTimeRange = validTimeRange =
closedBoundedInterval (defaultProposalTimingConfig.draftTime + 1) (defaultProposalTimingConfig.votingTime - 1) closedBoundedInterval
((def :: ProposalTimingConfig).draftTime + 1)
((def :: ProposalTimingConfig).votingTime - 1)
in TxInfo in TxInfo
{ txInfoInputs = { txInfoInputs =
[ TxInInfo proposalRef proposalInput [ TxInInfo proposalRef proposalInput

View file

@ -1,3 +1,5 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{- | {- |
Module : Sample.Shared Module : Sample.Shared
Maintainer : emi@haskell.fyi Maintainer : emi@haskell.fyi
@ -36,8 +38,6 @@ module Sample.Shared (
proposalPolicySymbol, proposalPolicySymbol,
proposalValidatorHash, proposalValidatorHash,
proposalValidatorAddress, proposalValidatorAddress,
defaultProposalTimingConfig,
defaultCreateProposalTimeRangeMaxDuration,
proposalStartingTimeFromTimeRange, proposalStartingTimeFromTimeRange,
-- ** Authority -- ** Authority
@ -78,12 +78,14 @@ import Agora.Proposal (
ProposalThresholds (..), ProposalThresholds (..),
) )
import Agora.Proposal.Time ( import Agora.Proposal.Time (
MaxTimeRangeWidth (..),
ProposalStartingTime (ProposalStartingTime), ProposalStartingTime (ProposalStartingTime),
ProposalTimingConfig (..), ProposalTimingConfig (..),
) )
import Agora.Stake (Stake (..)) import Agora.Stake (Stake (..))
import Agora.Treasury (treasuryValidator) import Agora.Treasury (treasuryValidator)
import Agora.Utils (validatorHashToTokenName) import Agora.Utils (validatorHashToTokenName)
import Data.Default.Class (Default (..))
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
mintingPolicySymbol, mintingPolicySymbol,
mkMintingPolicy, mkMintingPolicy,
@ -100,7 +102,6 @@ import Plutus.V1.Ledger.Api (
Interval (..), Interval (..),
LowerBound (..), LowerBound (..),
MintingPolicy (..), MintingPolicy (..),
POSIXTime,
POSIXTimeRange, POSIXTimeRange,
PubKeyHash, PubKeyHash,
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
@ -197,18 +198,27 @@ authorityToken = authorityTokenFromGovernor governor
authorityTokenSymbol :: CurrencySymbol authorityTokenSymbol :: CurrencySymbol
authorityTokenSymbol = authorityTokenSymbolFromGovernor governor authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
defaultProposalTimingConfig :: ProposalTimingConfig {- | Default value of 'Agora.Governor.GovernorDatum.proposalTimings'.
defaultProposalTimingConfig = For testing purpose only.
ProposalTimingConfig -}
{ draftTime = 50 instance Default ProposalTimingConfig where
, votingTime = 1000 def =
, lockingTime = 2000 ProposalTimingConfig
, executingTime = 3000 { draftTime = 50
} , votingTime = 1000
, lockingTime = 2000
, executingTime = 3000
}
defaultCreateProposalTimeRangeMaxDuration :: POSIXTime {- | Default value of 'Agora.Governor.GovernorDatum.createProposalTimeRangeMaxWidth'.
defaultCreateProposalTimeRangeMaxDuration = 10 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 :: POSIXTimeRange -> ProposalStartingTime
proposalStartingTimeFromTimeRange proposalStartingTimeFromTimeRange
(Interval (LowerBound (Finite l) True) (UpperBound (Finite u) True)) = (Interval (LowerBound (Finite l) True) (UpperBound (Finite u) True)) =

View file

@ -4,6 +4,7 @@ import Agora.Effect.GovernorMutation (mutateGovernorValidator)
import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor)) import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
import Agora.Governor.Scripts (governorValidator) import Agora.Governor.Scripts (governorValidator)
import Agora.Proposal (ProposalId (..)) import Agora.Proposal (ProposalId (..))
import Data.Default.Class (Default (def))
import Plutus.V1.Ledger.Api (ScriptContext (ScriptContext), ScriptPurpose (Spending)) import Plutus.V1.Ledger.Api (ScriptContext (ScriptContext), ScriptPurpose (Spending))
import Sample.Effect.GovernorMutation ( import Sample.Effect.GovernorMutation (
effectRef, effectRef,
@ -29,8 +30,8 @@ tests =
( GovernorDatum ( GovernorDatum
Shared.defaultProposalThresholds Shared.defaultProposalThresholds
(ProposalId 0) (ProposalId 0)
Shared.defaultProposalTimingConfig def
Shared.defaultCreateProposalTimeRangeMaxDuration def
) )
MutateGovernor MutateGovernor
( ScriptContext ( ScriptContext
@ -51,8 +52,8 @@ tests =
( GovernorDatum ( GovernorDatum
Shared.defaultProposalThresholds Shared.defaultProposalThresholds
(ProposalId 0) (ProposalId 0)
Shared.defaultProposalTimingConfig def
Shared.defaultCreateProposalTimeRangeMaxDuration def
) )
MutateGovernor MutateGovernor
( ScriptContext ( ScriptContext

View file

@ -16,6 +16,7 @@ module Spec.Governor (tests) where
import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..)) import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..))
import Agora.Governor.Scripts (governorPolicy, governorValidator) import Agora.Governor.Scripts (governorPolicy, governorValidator)
import Agora.Proposal (ProposalId (..)) import Agora.Proposal (ProposalId (..))
import Data.Default.Class (Default (def))
import Sample.Governor (createProposal, mintGATs, mintGST, mutateState) import Sample.Governor (createProposal, mintGATs, mintGST, mutateState)
import Sample.Shared qualified as Shared import Sample.Shared qualified as Shared
import Test.Tasty (TestTree, testGroup) import Test.Tasty (TestTree, testGroup)
@ -41,8 +42,8 @@ tests =
( GovernorDatum ( GovernorDatum
Shared.defaultProposalThresholds Shared.defaultProposalThresholds
(ProposalId 0) (ProposalId 0)
Shared.defaultProposalTimingConfig def
Shared.defaultCreateProposalTimeRangeMaxDuration def
) )
CreateProposal CreateProposal
createProposal createProposal
@ -52,8 +53,8 @@ tests =
( GovernorDatum ( GovernorDatum
Shared.defaultProposalThresholds Shared.defaultProposalThresholds
(ProposalId 5) (ProposalId 5)
Shared.defaultProposalTimingConfig def
Shared.defaultCreateProposalTimeRangeMaxDuration def
) )
MintGATs MintGATs
mintGATs mintGATs
@ -63,8 +64,8 @@ tests =
( GovernorDatum ( GovernorDatum
Shared.defaultProposalThresholds Shared.defaultProposalThresholds
(ProposalId 5) (ProposalId 5)
Shared.defaultProposalTimingConfig def
Shared.defaultCreateProposalTimeRangeMaxDuration def
) )
MutateGovernor MutateGovernor
mutateState mutateState

View file

@ -38,6 +38,7 @@ import Agora.Stake (
StakeRedeemer (PermitVote, WitnessStake), StakeRedeemer (PermitVote, WitnessStake),
) )
import Agora.Stake.Scripts (stakeValidator) import Agora.Stake.Scripts (stakeValidator)
import Data.Default.Class (Default (def))
import Plutarch.SafeMoney (Tagged (Tagged)) import Plutarch.SafeMoney (Tagged (Tagged))
import Plutus.V1.Ledger.Api (ScriptContext (..), ScriptPurpose (..)) import Plutus.V1.Ledger.Api (ScriptContext (..), ScriptPurpose (..))
import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.AssocMap qualified as AssocMap
@ -83,7 +84,7 @@ tests =
[ (ResultTag 0, AssocMap.empty) [ (ResultTag 0, AssocMap.empty)
, (ResultTag 1, AssocMap.empty) , (ResultTag 1, AssocMap.empty)
] ]
, timingConfig = Shared.defaultProposalTimingConfig , timingConfig = def
, startingTime = ProposalStartingTime 0 , startingTime = ProposalStartingTime 0
} }
) )
@ -118,7 +119,7 @@ tests =
, (ResultTag 1, 4242) , (ResultTag 1, 4242)
] ]
) )
, timingConfig = Shared.defaultProposalTimingConfig , timingConfig = def
, startingTime = ProposalStartingTime 0 , startingTime = ProposalStartingTime 0
} }
) )

View file

@ -114,6 +114,7 @@ common test-deps
, agora , agora
, apropos , apropos
, apropos-tx , apropos-tx
, data-default-class
, mtl , mtl
, QuickCheck , QuickCheck
, quickcheck-instances , quickcheck-instances

View file

@ -37,13 +37,17 @@ import Agora.Proposal (
ProposalId (ProposalId), ProposalId (ProposalId),
ProposalThresholds, ProposalThresholds,
) )
import Agora.Proposal.Time (PProposalTimingConfig, ProposalTimingConfig) import Agora.Proposal.Time (
MaxTimeRangeWidth,
PMaxTimeRangeWidth,
PProposalTimingConfig,
ProposalTimingConfig,
)
import Agora.SafeMoney (GTTag) import Agora.SafeMoney (GTTag)
import Agora.Utils (tclet) import Agora.Utils (tclet)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Plutarch.Api.V1 (PPOSIXTime)
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (..), DerivePConstantViaData (..),
PDataFields, 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 Plutus.V1.Ledger.Value (AssetClass (..))
import PlutusTx qualified import PlutusTx qualified
@ -71,7 +75,7 @@ data GovernorDatum = GovernorDatum
, proposalTimings :: ProposalTimingConfig , proposalTimings :: ProposalTimingConfig
-- ^ The timing configuration for proposals. -- ^ The timing configuration for proposals.
-- Will get copied over upon the creation of 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. -- ^ The maximum valid duration of a transaction that creats a proposal.
} }
deriving stock (Show, GHC.Generic) deriving stock (Show, GHC.Generic)
@ -126,7 +130,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
'[ "proposalThresholds" ':= PProposalThresholds '[ "proposalThresholds" ':= PProposalThresholds
, "nextProposalId" ':= PProposalId , "nextProposalId" ':= PProposalId
, "proposalTimings" ':= PProposalTimingConfig , "proposalTimings" ':= PProposalTimingConfig
, "createProposalTimeRangeMaxDuration" ':= PPOSIXTime , "createProposalTimeRangeMaxWidth" ':= PMaxTimeRangeWidth
] ]
) )
} }

View file

@ -307,7 +307,7 @@ governorValidator gov =
@'[ "proposalThresholds" @'[ "proposalThresholds"
, "nextProposalId" , "nextProposalId"
, "proposalTimings" , "proposalTimings"
, "createProposalTimeRangeMaxDuration" , "createProposalTimeRangeMaxWidth"
] ]
oldGovernorDatum oldGovernorDatum
@ -347,8 +347,8 @@ governorValidator gov =
( #proposalThresholds .= oldGovernorDatumF.proposalThresholds ( #proposalThresholds .= oldGovernorDatumF.proposalThresholds
.& #nextProposalId .= pdata expectedNextProposalId .& #nextProposalId .= pdata expectedNextProposalId
.& #proposalTimings .= oldGovernorDatumF.proposalTimings .& #proposalTimings .= oldGovernorDatumF.proposalTimings
.& #createProposalTimeRangeMaxDuration .& #createProposalTimeRangeMaxWidth
.= oldGovernorDatumF.createProposalTimeRangeMaxDuration .= oldGovernorDatumF.createProposalTimeRangeMaxWidth
) )
tcassert "Unexpected governor state datum" $ tcassert "Unexpected governor state datum" $
newGovernorDatum #== expectedNewDatum newGovernorDatum #== expectedNewDatum
@ -436,7 +436,7 @@ governorValidator gov =
expectedVotes = pemptyVotesFor # pfromData proposalOutputDatum.effects expectedVotes = pemptyVotesFor # pfromData proposalOutputDatum.effects
expectedStartingTime = expectedStartingTime =
createProposalStartingTime createProposalStartingTime
# oldGovernorDatumF.createProposalTimeRangeMaxDuration # oldGovernorDatumF.createProposalTimeRangeMaxWidth
# txInfoF.validRange # txInfoF.validRange
-- Id, thresholds and timings should be copied from the old governor state datum. -- Id, thresholds and timings should be copied from the old governor state datum.
expectedProposalOut = expectedProposalOut =

View file

@ -349,7 +349,7 @@ deriving via
instance instance
(PConstantDecl ProposalVotes) (PConstantDecl ProposalVotes)
-- Plutarch version of 'pemptyVotesFor'. -- Plutarch-level version of 'emptyVotesFor'.
pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap PResultTag a :--> PProposalVotes) pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap PResultTag a :--> PProposalVotes)
pemptyVotesFor = pemptyVotesFor =
phoistAcyclic $ phoistAcyclic $

View file

@ -13,11 +13,13 @@ module Agora.Proposal.Time (
ProposalTime (..), ProposalTime (..),
ProposalTimingConfig (..), ProposalTimingConfig (..),
ProposalStartingTime (..), ProposalStartingTime (..),
MaxTimeRangeWidth (..),
-- * Plutarch-land -- * Plutarch-land
PProposalTime (..), PProposalTime (..),
PProposalTimingConfig (..), PProposalTimingConfig (..),
PProposalStartingTime (..), PProposalStartingTime (..),
PMaxTimeRangeWidth (..),
-- * Compute periods given config and starting time. -- * Compute periods given config and starting time.
createProposalStartingTime, createProposalStartingTime,
@ -108,6 +110,11 @@ data ProposalTimingConfig = ProposalTimingConfig
PlutusTx.makeIsDataIndexed ''ProposalTimingConfig [('ProposalTimingConfig, 0)] 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'. -- | Plutarch-level version of 'ProposalTime'.
@ -173,6 +180,17 @@ deriving via
instance instance
(PConstantDecl ProposalTimingConfig) (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. -- 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 (punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y
{- | Get the starting time of a proposal, from the 'Plutus.V1.Ledger.Api.txInfoValidPeriod' field. {- | 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 $ createProposalStartingTime = phoistAcyclic $
plam $ \maxDuration iv -> unTermCont $ do plam $ \(pto -> maxDuration) iv -> unTermCont $ do
currentTimeF <- currentTimeF <-
tcont $ tcont $
pletFields @'["lowerBound", "upperBound"] $ pletFields @'["lowerBound", "upperBound"] $