Merge pull request #93 from Liqwid-Labs/connor/proposal-timing-conf
Proposal Timings
This commit is contained in:
Emily
GitHub
commit
547f5c6317
13 changed files with 344 additions and 175 deletions
|
|
@ -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,6 +43,9 @@ 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,
|
||||
defaultProposalThresholds,
|
||||
|
|
@ -46,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
|
||||
|
|
@ -101,6 +118,8 @@ mkEffectTxInfo newGovDatum =
|
|||
GovernorDatum
|
||||
{ proposalThresholds = defaultProposalThresholds
|
||||
, nextProposalId = ProposalId 0
|
||||
, proposalTimings = def
|
||||
, createProposalTimeRangeMaxWidth = def
|
||||
}
|
||||
governorInputDatum :: Datum
|
||||
governorInputDatum = Datum $ toBuiltinData governorInputDatum'
|
||||
|
|
@ -161,6 +180,8 @@ validNewGovernorDatum =
|
|||
GovernorDatum
|
||||
{ proposalThresholds = defaultProposalThresholds
|
||||
, nextProposalId = ProposalId 42
|
||||
, proposalTimings = def
|
||||
, createProposalTimeRangeMaxWidth = def
|
||||
}
|
||||
|
||||
invalidNewGovernorDatum :: GovernorDatum
|
||||
|
|
@ -171,4 +192,6 @@ invalidNewGovernorDatum =
|
|||
{ countVoting = Tagged (-1)
|
||||
}
|
||||
, nextProposalId = ProposalId 42
|
||||
, proposalTimings = def
|
||||
, createProposalTimeRangeMaxWidth = def
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 (..),
|
||||
|
|
@ -73,16 +77,19 @@ import Sample.Shared (
|
|||
gstUTXORef,
|
||||
minAda,
|
||||
proposalPolicySymbol,
|
||||
proposalTimingConfig,
|
||||
proposalStartingTimeFromTimeRange,
|
||||
proposalValidatorAddress,
|
||||
signer,
|
||||
signer2,
|
||||
stake,
|
||||
stakeAddress,
|
||||
stakeAssetClass,
|
||||
tmpProposalStartingTime,
|
||||
)
|
||||
import Test.Util (datumPair, toDatumHash)
|
||||
import Test.Util (closedBoundedInterval, datumPair, toDatumHash)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Default.Class (Default (def))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -114,6 +121,8 @@ mintGST =
|
|||
GovernorDatum
|
||||
{ proposalThresholds = defaultProposalThresholds
|
||||
, nextProposalId = ProposalId 0
|
||||
, proposalTimings = def
|
||||
, createProposalTimeRangeMaxWidth = def
|
||||
}
|
||||
governorOutputDatum :: Datum
|
||||
governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
|
||||
|
|
@ -207,6 +216,8 @@ createProposal =
|
|||
GovernorDatum
|
||||
{ proposalThresholds = defaultProposalThresholds
|
||||
, nextProposalId = thisProposalId
|
||||
, proposalTimings = def
|
||||
, createProposalTimeRangeMaxWidth = def
|
||||
}
|
||||
governorInputDatum :: Datum
|
||||
governorInputDatum = Datum $ toBuiltinData governorInputDatum'
|
||||
|
|
@ -236,8 +247,8 @@ createProposal =
|
|||
, cosigners = [signer]
|
||||
, thresholds = defaultProposalThresholds
|
||||
, votes = emptyVotesFor effects
|
||||
, timingConfig = proposalTimingConfig
|
||||
, startingTime = tmpProposalStartingTime
|
||||
, timingConfig = def
|
||||
, startingTime = proposalStartingTimeFromTimeRange validTimeRange
|
||||
}
|
||||
)
|
||||
proposalOutput :: TxOut
|
||||
|
|
@ -298,8 +309,13 @@ createProposal =
|
|||
}
|
||||
|
||||
---
|
||||
|
||||
ownInputRef :: TxOutRef
|
||||
ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1
|
||||
|
||||
---
|
||||
|
||||
validTimeRange = closedBoundedInterval 10 15
|
||||
in ScriptContext
|
||||
{ scriptContextTxInfo =
|
||||
TxInfo
|
||||
|
|
@ -316,7 +332,7 @@ createProposal =
|
|||
, txInfoMint = pst
|
||||
, txInfoDCert = []
|
||||
, txInfoWdrl = []
|
||||
, txInfoValidRange = Interval.always
|
||||
, txInfoValidRange = validTimeRange
|
||||
, txInfoSignatories = [signer]
|
||||
, txInfoData =
|
||||
datumPair
|
||||
|
|
@ -378,6 +394,8 @@ mintGATs =
|
|||
GovernorDatum
|
||||
{ proposalThresholds = defaultProposalThresholds
|
||||
, nextProposalId = ProposalId 5
|
||||
, proposalTimings = def
|
||||
, createProposalTimeRangeMaxWidth = def
|
||||
}
|
||||
governorInputDatum :: Datum
|
||||
governorInputDatum = Datum $ toBuiltinData governorInputDatum'
|
||||
|
|
@ -412,8 +430,8 @@ mintGATs =
|
|||
, cosigners = [signer, signer2]
|
||||
, thresholds = defaultProposalThresholds
|
||||
, votes = proposalVotes
|
||||
, timingConfig = proposalTimingConfig
|
||||
, startingTime = tmpProposalStartingTime
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 10
|
||||
}
|
||||
proposalInputDatum :: Datum
|
||||
proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
|
||||
|
|
@ -465,6 +483,12 @@ mintGATs =
|
|||
|
||||
ownInputRef :: TxOutRef
|
||||
ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1
|
||||
|
||||
--
|
||||
validTimeRange =
|
||||
closedBoundedInterval
|
||||
((def :: ProposalTimingConfig).lockingTime + 11)
|
||||
((def :: ProposalTimingConfig).executingTime - 11)
|
||||
in ScriptContext
|
||||
{ scriptContextTxInfo =
|
||||
TxInfo
|
||||
|
|
@ -483,7 +507,7 @@ mintGATs =
|
|||
, txInfoMint = gat
|
||||
, txInfoDCert = []
|
||||
, txInfoWdrl = []
|
||||
, txInfoValidRange = Interval.always
|
||||
, txInfoValidRange = validTimeRange
|
||||
, txInfoSignatories = [signer, signer2]
|
||||
, txInfoData =
|
||||
datumPair
|
||||
|
|
@ -565,6 +589,8 @@ mutateState =
|
|||
GovernorDatum
|
||||
{ proposalThresholds = defaultProposalThresholds
|
||||
, nextProposalId = ProposalId 5
|
||||
, proposalTimings = def
|
||||
, createProposalTimeRangeMaxWidth = def
|
||||
}
|
||||
governorInputDatum :: Datum
|
||||
governorInputDatum = Datum $ toBuiltinData governorInputDatum'
|
||||
|
|
|
|||
|
|
@ -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),
|
||||
|
|
@ -33,13 +38,13 @@ 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
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Agora.Governor (
|
||||
GovernorDatum (GovernorDatum, nextProposalId, proposalThresholds),
|
||||
GovernorDatum (..),
|
||||
)
|
||||
import Agora.Proposal (
|
||||
Proposal (..),
|
||||
|
|
@ -50,15 +55,20 @@ 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
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
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 =
|
||||
|
|
@ -79,8 +89,8 @@ proposalCreation =
|
|||
, cosigners = [signer]
|
||||
, thresholds = defaultProposalThresholds
|
||||
, votes = emptyVotesFor effects
|
||||
, timingConfig = proposalTimingConfig
|
||||
, startingTime = tmpProposalStartingTime
|
||||
, timingConfig = def
|
||||
, startingTime = proposalStartingTimeFromTimeRange validTimeRange
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -91,6 +101,8 @@ proposalCreation =
|
|||
GovernorDatum
|
||||
{ proposalThresholds = defaultProposalThresholds
|
||||
, nextProposalId = ProposalId 0
|
||||
, proposalTimings = def
|
||||
, createProposalTimeRangeMaxWidth = def
|
||||
}
|
||||
)
|
||||
govAfter :: Datum
|
||||
|
|
@ -100,8 +112,12 @@ proposalCreation =
|
|||
GovernorDatum
|
||||
{ proposalThresholds = defaultProposalThresholds
|
||||
, nextProposalId = ProposalId 1
|
||||
, proposalTimings = def
|
||||
, createProposalTimeRangeMaxWidth = def
|
||||
}
|
||||
)
|
||||
|
||||
validTimeRange = closedBoundedInterval 10 15
|
||||
in ScriptContext
|
||||
{ scriptContextTxInfo =
|
||||
TxInfo
|
||||
|
|
@ -138,7 +154,7 @@ proposalCreation =
|
|||
, txInfoMint = st
|
||||
, txInfoDCert = []
|
||||
, txInfoWdrl = []
|
||||
, txInfoValidRange = Interval.always
|
||||
, txInfoValidRange = validTimeRange
|
||||
, txInfoSignatories = [signer]
|
||||
, txInfoData =
|
||||
[ datumPair proposalDatum
|
||||
|
|
@ -174,8 +190,8 @@ cosignProposal newSigners =
|
|||
, cosigners = [signer]
|
||||
, thresholds = defaultProposalThresholds
|
||||
, votes = emptyVotesFor effects
|
||||
, timingConfig = proposalTimingConfig
|
||||
, startingTime = tmpProposalStartingTime
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
stakeDatum :: StakeDatum
|
||||
stakeDatum = StakeDatum (Tagged 50_000_000) signer2 []
|
||||
|
|
@ -185,7 +201,7 @@ cosignProposal newSigners =
|
|||
validTimeRange =
|
||||
closedBoundedInterval
|
||||
10
|
||||
(proposalTimingConfig.draftTime - 10)
|
||||
((def :: ProposalTimingConfig).draftTime - 10)
|
||||
in TxInfo
|
||||
{ txInfoInputs =
|
||||
[ TxInInfo
|
||||
|
|
@ -295,8 +311,8 @@ voteOnProposal params =
|
|||
, cosigners = [stakeOwner]
|
||||
, thresholds = defaultProposalThresholds
|
||||
, votes = ProposalVotes initialVotes
|
||||
, timingConfig = proposalTimingConfig
|
||||
, startingTime = tmpProposalStartingTime
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
proposalInputDatum :: Datum
|
||||
proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
|
||||
|
|
@ -384,7 +400,9 @@ voteOnProposal params =
|
|||
---
|
||||
|
||||
validTimeRange =
|
||||
closedBoundedInterval (proposalTimingConfig.draftTime + 1) (proposalTimingConfig.votingTime - 1)
|
||||
closedBoundedInterval
|
||||
((def :: ProposalTimingConfig).draftTime + 1)
|
||||
((def :: ProposalTimingConfig).votingTime - 1)
|
||||
in TxInfo
|
||||
{ txInfoInputs =
|
||||
[ TxInInfo proposalRef proposalInput
|
||||
|
|
|
|||
|
|
@ -1,3 +1,5 @@
|
|||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
{- |
|
||||
Module : Sample.Shared
|
||||
Maintainer : emi@haskell.fyi
|
||||
|
|
@ -36,8 +38,7 @@ module Sample.Shared (
|
|||
proposalPolicySymbol,
|
||||
proposalValidatorHash,
|
||||
proposalValidatorAddress,
|
||||
proposalTimingConfig,
|
||||
tmpProposalStartingTime,
|
||||
proposalStartingTimeFromTimeRange,
|
||||
|
||||
-- ** Authority
|
||||
authorityToken,
|
||||
|
|
@ -77,12 +78,14 @@ import Agora.Proposal (
|
|||
ProposalThresholds (..),
|
||||
)
|
||||
import Agora.Proposal.Time (
|
||||
ProposalStartingTime (..),
|
||||
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,
|
||||
|
|
@ -95,9 +98,14 @@ import Plutus.V1.Ledger.Api (
|
|||
Address (Address),
|
||||
Credential (ScriptCredential),
|
||||
CurrencySymbol,
|
||||
Extended (..),
|
||||
Interval (..),
|
||||
LowerBound (..),
|
||||
MintingPolicy (..),
|
||||
POSIXTimeRange,
|
||||
PubKeyHash,
|
||||
TxOutRef (TxOutRef),
|
||||
UpperBound (..),
|
||||
Value,
|
||||
)
|
||||
import Plutus.V1.Ledger.Contexts (
|
||||
|
|
@ -190,21 +198,32 @@ authorityToken = authorityTokenFromGovernor governor
|
|||
authorityTokenSymbol :: CurrencySymbol
|
||||
authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
|
||||
|
||||
proposalTimingConfig :: ProposalTimingConfig
|
||||
proposalTimingConfig =
|
||||
ProposalTimingConfig
|
||||
{ draftTime = 50
|
||||
, votingTime = 1000
|
||||
, lockingTime = 2000
|
||||
, executingTime = 3000
|
||||
}
|
||||
|
||||
{- | Hard coded starting time of every propoal.
|
||||
This will be calculated by the governor in the future.
|
||||
FIXME: Remove this.
|
||||
{- | Default value of 'Agora.Governor.GovernorDatum.proposalTimings'.
|
||||
For testing purpose only.
|
||||
-}
|
||||
tmpProposalStartingTime :: ProposalStartingTime
|
||||
tmpProposalStartingTime = ProposalStartingTime 0
|
||||
instance Default ProposalTimingConfig where
|
||||
def =
|
||||
ProposalTimingConfig
|
||||
{ draftTime = 50
|
||||
, votingTime = 1000
|
||||
, lockingTime = 2000
|
||||
, executingTime = 3000
|
||||
}
|
||||
|
||||
{- | 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)) =
|
||||
ProposalStartingTime $ (l + u) `div` 2
|
||||
proposalStartingTimeFromTimeRange _ = error "Given time range should be finite and closed"
|
||||
|
||||
------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
@ -27,9 +28,10 @@ tests =
|
|||
"governor validator should pass"
|
||||
(governorValidator Shared.governor)
|
||||
( GovernorDatum
|
||||
{ proposalThresholds = Shared.defaultProposalThresholds
|
||||
, nextProposalId = ProposalId 0
|
||||
}
|
||||
Shared.defaultProposalThresholds
|
||||
(ProposalId 0)
|
||||
def
|
||||
def
|
||||
)
|
||||
MutateGovernor
|
||||
( ScriptContext
|
||||
|
|
@ -48,9 +50,10 @@ tests =
|
|||
"governor validator should fail"
|
||||
(governorValidator Shared.governor)
|
||||
( GovernorDatum
|
||||
{ proposalThresholds = Shared.defaultProposalThresholds
|
||||
, nextProposalId = ProposalId 0
|
||||
}
|
||||
Shared.defaultProposalThresholds
|
||||
(ProposalId 0)
|
||||
def
|
||||
def
|
||||
)
|
||||
MutateGovernor
|
||||
( ScriptContext
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -38,19 +39,34 @@ tests =
|
|||
[ validatorSucceedsWith
|
||||
"proposal creation"
|
||||
(governorValidator Shared.governor)
|
||||
(GovernorDatum Shared.defaultProposalThresholds (ProposalId 0))
|
||||
( GovernorDatum
|
||||
Shared.defaultProposalThresholds
|
||||
(ProposalId 0)
|
||||
def
|
||||
def
|
||||
)
|
||||
CreateProposal
|
||||
createProposal
|
||||
, validatorSucceedsWith
|
||||
"GATs minting"
|
||||
(governorValidator Shared.governor)
|
||||
(GovernorDatum Shared.defaultProposalThresholds (ProposalId 5))
|
||||
( GovernorDatum
|
||||
Shared.defaultProposalThresholds
|
||||
(ProposalId 5)
|
||||
def
|
||||
def
|
||||
)
|
||||
MintGATs
|
||||
mintGATs
|
||||
, validatorSucceedsWith
|
||||
"mutate governor state"
|
||||
(governorValidator Shared.governor)
|
||||
(GovernorDatum Shared.defaultProposalThresholds (ProposalId 5))
|
||||
( GovernorDatum
|
||||
Shared.defaultProposalThresholds
|
||||
(ProposalId 5)
|
||||
def
|
||||
def
|
||||
)
|
||||
MutateGovernor
|
||||
mutateState
|
||||
]
|
||||
|
|
|
|||
|
|
@ -31,12 +31,14 @@ import Agora.Proposal.Scripts (
|
|||
proposalPolicy,
|
||||
proposalValidator,
|
||||
)
|
||||
import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime))
|
||||
import Agora.Stake (
|
||||
ProposalLock (ProposalLock),
|
||||
StakeDatum (StakeDatum),
|
||||
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
|
||||
|
|
@ -82,8 +84,8 @@ tests =
|
|||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
, timingConfig = Shared.proposalTimingConfig
|
||||
, startingTime = Shared.tmpProposalStartingTime
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
)
|
||||
(Cosign [signer2])
|
||||
|
|
@ -117,8 +119,8 @@ tests =
|
|||
, (ResultTag 1, 4242)
|
||||
]
|
||||
)
|
||||
, timingConfig = Shared.proposalTimingConfig
|
||||
, startingTime = Shared.tmpProposalStartingTime
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
)
|
||||
(Vote (ResultTag 0))
|
||||
|
|
|
|||
12
agora.cabal
12
agora.cabal
|
|
@ -114,6 +114,7 @@ common test-deps
|
|||
, agora
|
||||
, apropos
|
||||
, apropos-tx
|
||||
, data-default-class
|
||||
, mtl
|
||||
, QuickCheck
|
||||
, quickcheck-instances
|
||||
|
|
@ -141,22 +142,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 +175,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 +213,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
|
||||
|
|
|
|||
|
|
@ -37,6 +37,12 @@ import Agora.Proposal (
|
|||
ProposalId (ProposalId),
|
||||
ProposalThresholds,
|
||||
)
|
||||
import Agora.Proposal.Time (
|
||||
MaxTimeRangeWidth,
|
||||
PMaxTimeRangeWidth,
|
||||
PProposalTimingConfig,
|
||||
ProposalTimingConfig,
|
||||
)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Utils (tclet)
|
||||
|
||||
|
|
@ -66,6 +72,11 @@ 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.
|
||||
, createProposalTimeRangeMaxWidth :: MaxTimeRangeWidth
|
||||
-- ^ The maximum valid duration of a transaction that creats a proposal.
|
||||
}
|
||||
deriving stock (Show, GHC.Generic)
|
||||
|
||||
|
|
@ -118,6 +129,8 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
|
|||
( PDataRecord
|
||||
'[ "proposalThresholds" ':= PProposalThresholds
|
||||
, "nextProposalId" ':= PProposalId
|
||||
, "proposalTimings" ':= PProposalTimingConfig
|
||||
, "createProposalTimeRangeMaxWidth" ':= PMaxTimeRangeWidth
|
||||
]
|
||||
)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 (..), ProposalTimingConfig (..))
|
||||
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"] oldGovernorDatum
|
||||
oldGovernorDatumF <-
|
||||
tcont $
|
||||
pletFields
|
||||
@'[ "proposalThresholds"
|
||||
, "nextProposalId"
|
||||
, "proposalTimings"
|
||||
, "createProposalTimeRangeMaxWidth"
|
||||
]
|
||||
oldGovernorDatum
|
||||
|
||||
-- Check that GST will be returned to the governor.
|
||||
let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value
|
||||
|
|
@ -337,6 +346,9 @@ governorValidator gov =
|
|||
PGovernorDatum
|
||||
( #proposalThresholds .= oldGovernorDatumF.proposalThresholds
|
||||
.& #nextProposalId .= pdata expectedNextProposalId
|
||||
.& #proposalTimings .= oldGovernorDatumF.proposalTimings
|
||||
.& #createProposalTimeRangeMaxWidth
|
||||
.= oldGovernorDatumF.createProposalTimeRangeMaxWidth
|
||||
)
|
||||
tcassert "Unexpected governor state datum" $
|
||||
newGovernorDatum #== expectedNewDatum
|
||||
|
|
@ -402,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
|
||||
|
|
@ -417,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.createProposalTimeRangeMaxWidth
|
||||
# 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" $
|
||||
|
|
@ -560,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.
|
||||
|
|
@ -577,10 +597,8 @@ governorValidator gov =
|
|||
.& #cosigners .= proposalInputDatumF.cosigners
|
||||
.& #thresholds .= proposalInputDatumF.thresholds
|
||||
.& #votes .= proposalInputDatumF.votes
|
||||
-- FIXME: copy from the governor datum
|
||||
.& #timingConfig .= pdata (pconstant tmpTimingConfig)
|
||||
-- FIXME: calculate from 'txInfoValidRange'
|
||||
.& #startingTime .= pdata (pconstant tmpProposalStartingTime)
|
||||
.& #timingConfig .= proposalInputDatumF.timingConfig
|
||||
.& #startingTime .= proposalInputDatumF.startingTime
|
||||
)
|
||||
|
||||
tcassert "Unexpected output proposal datum" $
|
||||
|
|
@ -732,20 +750,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
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Get the 'CurrencySymbol' of GST.
|
||||
|
|
|
|||
|
|
@ -30,6 +30,7 @@ module Agora.Proposal (
|
|||
|
||||
-- * Plutarch helpers
|
||||
proposalDatumValid,
|
||||
pemptyVotesFor,
|
||||
) where
|
||||
|
||||
import GHC.Generics qualified as GHC
|
||||
|
|
@ -47,7 +48,7 @@ import PlutusTx.AssocMap qualified as AssocMap
|
|||
|
||||
import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, ProposalStartingTime, ProposalTimingConfig)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Utils (pkeysEqual, pnotNull)
|
||||
import Agora.Utils (pkeysEqual, pmapMap, pnotNull)
|
||||
import Control.Applicative (Const)
|
||||
import Control.Arrow (first)
|
||||
import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..))
|
||||
|
|
@ -348,6 +349,16 @@ deriving via
|
|||
instance
|
||||
(PConstantDecl ProposalVotes)
|
||||
|
||||
-- Plutarch-level version of 'emptyVotesFor'.
|
||||
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 ::
|
||||
|
|
|
|||
|
|
@ -10,16 +10,18 @@ Time functions for proposal phases.
|
|||
-}
|
||||
module Agora.Proposal.Time (
|
||||
-- * Haskell-land
|
||||
ProposalTime (..),
|
||||
ProposalTimingConfig (..),
|
||||
ProposalStartingTime (..),
|
||||
MaxTimeRangeWidth (..),
|
||||
|
||||
-- * Plutarch-land
|
||||
PProposalTime (..),
|
||||
PProposalTimingConfig (..),
|
||||
PProposalStartingTime (..),
|
||||
PMaxTimeRangeWidth (..),
|
||||
|
||||
-- * Compute periods given config and starting time.
|
||||
createProposalStartingTime,
|
||||
currentProposalTime,
|
||||
isDraftPeriod,
|
||||
isVotingPeriod,
|
||||
|
|
@ -27,10 +29,9 @@ module Agora.Proposal.Time (
|
|||
isExecutionPeriod,
|
||||
) 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 Generics.SOP (Generic, HasDatatypeInfo, I (I))
|
||||
import Plutarch.Api.V1 (
|
||||
PExtended (PFinite),
|
||||
PInterval (PInterval),
|
||||
|
|
@ -39,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,
|
||||
|
|
@ -53,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
|
||||
|
|
@ -107,32 +83,40 @@ 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'.
|
||||
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)
|
||||
|
|
@ -172,12 +156,45 @@ 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.
|
||||
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. 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 (PMaxTimeRangeWidth :--> PPOSIXTimeRange :--> PProposalStartingTime)
|
||||
createProposalStartingTime = phoistAcyclic $
|
||||
plam $ \(pto -> maxDuration) iv -> unTermCont $ do
|
||||
currentTimeF <- tcmatch $ 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 "createProposalStartingTime: 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
|
||||
|
|
@ -193,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 ::
|
||||
|
|
@ -220,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.
|
||||
|
|
|
|||
|
|
@ -41,6 +41,7 @@ module Agora.Utils (
|
|||
pmsort,
|
||||
pnubSort,
|
||||
pupdate,
|
||||
pmapMap,
|
||||
pmapMaybe,
|
||||
|
||||
-- * Functions which should (probably) not be upstreamed
|
||||
|
|
@ -322,6 +323,23 @@ pupdate = phoistAcyclic $
|
|||
)
|
||||
# ps
|
||||
|
||||
-- | / O(n) /. Map a function over all values in a 'PMap'.
|
||||
pmapMap :: forall s k a b. (PIsData k, PIsData a, PIsData b) => Term s ((a :--> b) :--> PMap k a :--> PMap k b)
|
||||
pmapMap = phoistAcyclic $
|
||||
plam $ \f (pto -> (ps :: Term _ (PBuiltinList _))) ->
|
||||
pcon $
|
||||
PMap $
|
||||
pmap
|
||||
# plam
|
||||
( \kv ->
|
||||
let k = pfstBuiltin # kv
|
||||
v = psndBuiltin # kv
|
||||
|
||||
nv = pdata $ f # pfromData v
|
||||
in ppairDataBuiltin # k # nv
|
||||
)
|
||||
# ps
|
||||
|
||||
-- | Add two 'PValue's together.
|
||||
paddValue :: forall s. Term s (PValue :--> PValue :--> PValue)
|
||||
paddValue = phoistAcyclic $
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue