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 55435d601f
commit a85b066a05
No known key found for this signature in database
GPG key ID: 35CD9A71CD5D5870
12 changed files with 142 additions and 75 deletions

View file

@ -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
}

View file

@ -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'

View file

@ -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

View file

@ -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)) =

View file

@ -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

View file

@ -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

View file

@ -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
}
)

View file

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

View file

@ -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
]
)
}

View file

@ -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 =

View file

@ -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 $

View file

@ -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"] $