From a85b066a05423139f010e0e2028814c7da4ed126 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 25 May 2022 21:07:09 +0800 Subject: [PATCH] apply Emily's suggestions * add `PMaxTimeRangeWidth` * several `Default` instances for testing * a bunch of docstrings * fix the tests/samples --- .../Sample/Effect/GovernorMutation.hs | 31 +++++++++++---- agora-sample/Sample/Governor.hs | 38 ++++++++++--------- agora-sample/Sample/Proposal.hs | 35 +++++++++++------ agora-sample/Sample/Shared.hs | 36 +++++++++++------- agora-test/Spec/Effect/GovernorMutation.hs | 9 +++-- agora-test/Spec/Governor.hs | 13 ++++--- agora-test/Spec/Proposal.hs | 5 ++- agora.cabal | 1 + agora/Agora/Governor.hs | 14 ++++--- agora/Agora/Governor/Scripts.hs | 8 ++-- agora/Agora/Proposal.hs | 2 +- agora/Agora/Proposal/Time.hs | 25 ++++++++++-- 12 files changed, 142 insertions(+), 75 deletions(-) diff --git a/agora-sample/Sample/Effect/GovernorMutation.hs b/agora-sample/Sample/Effect/GovernorMutation.hs index e8c7b79..737783a 100644 --- a/agora-sample/Sample/Effect/GovernorMutation.hs +++ b/agora-sample/Sample/Effect/GovernorMutation.hs @@ -11,14 +11,22 @@ module Sample.Effect.GovernorMutation ( mkEffectDatum, ) where +-------------------------------------------------------------------------------- + import Agora.Effect.GovernorMutation ( MutateGovernorDatum (..), mutateGovernorValidator, ) import Agora.Governor (GovernorDatum (..)) import Agora.Proposal (ProposalId (..), ProposalThresholds (..)) + +-------------------------------------------------------------------------------- + import Plutarch.Api.V1 (mkValidator, validatorHash) import Plutarch.SafeMoney (Tagged (Tagged)) + +-------------------------------------------------------------------------------- + import Plutus.V1.Ledger.Address (scriptHashAddress) import Plutus.V1.Ledger.Api ( Address, @@ -35,11 +43,12 @@ import Plutus.V1.Ledger.Api ( import Plutus.V1.Ledger.Api qualified as Interval import Plutus.V1.Ledger.Value (AssetClass, assetClass) import Plutus.V1.Ledger.Value qualified as Value + +-------------------------------------------------------------------------------- + import Sample.Shared ( authorityTokenSymbol, - defaultCreateProposalTimeRangeMaxDuration, defaultProposalThresholds, - defaultProposalTimingConfig, govAssetClass, govValidatorAddress, governor, @@ -48,6 +57,12 @@ import Sample.Shared ( ) import Test.Util (datumPair, toDatumHash) +-------------------------------------------------------------------------------- + +import Data.Default.Class (Default (def)) + +-------------------------------------------------------------------------------- + -- | The effect validator instance. effectValidator :: Validator effectValidator = mkValidator $ mutateGovernorValidator governor @@ -103,8 +118,8 @@ mkEffectTxInfo newGovDatum = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -165,8 +180,8 @@ validNewGovernorDatum = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 42 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } invalidNewGovernorDatum :: GovernorDatum @@ -177,6 +192,6 @@ invalidNewGovernorDatum = { countVoting = Tagged (-1) } , nextProposalId = ProposalId 42 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } diff --git a/agora-sample/Sample/Governor.hs b/agora-sample/Sample/Governor.hs index dcc53e2..48329c0 100644 --- a/agora-sample/Sample/Governor.hs +++ b/agora-sample/Sample/Governor.hs @@ -56,6 +56,10 @@ import Agora.Proposal ( emptyVotesFor, ) import Agora.Proposal qualified as P +import Agora.Proposal.Time ( + ProposalStartingTime (ProposalStartingTime), + ProposalTimingConfig (..), + ) import Agora.Stake ( ProposalLock (..), Stake (..), @@ -64,15 +68,9 @@ import Agora.Stake ( -------------------------------------------------------------------------------- -import Agora.Proposal.Time ( - ProposalStartingTime (ProposalStartingTime), - ProposalTimingConfig (..), - ) import Sample.Shared ( authorityTokenSymbol, - defaultCreateProposalTimeRangeMaxDuration, defaultProposalThresholds, - defaultProposalTimingConfig, govAssetClass, govSymbol, govValidatorAddress, @@ -91,6 +89,10 @@ import Test.Util (closedBoundedInterval, datumPair, toDatumHash) -------------------------------------------------------------------------------- +import Data.Default.Class (Default (def)) + +-------------------------------------------------------------------------------- + {- | A valid 'ScriptContext' for minting GST. - Only the minting policy will be ran in the transaction. @@ -119,8 +121,8 @@ mintGST = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } governorOutputDatum :: Datum governorOutputDatum = Datum $ toBuiltinData governorOutputDatum' @@ -214,8 +216,8 @@ createProposal = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = thisProposalId - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -245,7 +247,7 @@ createProposal = , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects - , timingConfig = defaultProposalTimingConfig + , timingConfig = def , startingTime = proposalStartingTimeFromTimeRange validTimeRange } ) @@ -392,8 +394,8 @@ mintGATs = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 5 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' @@ -428,7 +430,7 @@ mintGATs = , cosigners = [signer, signer2] , thresholds = defaultProposalThresholds , votes = proposalVotes - , timingConfig = defaultProposalTimingConfig + , timingConfig = def , startingTime = ProposalStartingTime 10 } proposalInputDatum :: Datum @@ -485,8 +487,8 @@ mintGATs = -- validTimeRange = closedBoundedInterval - (defaultProposalTimingConfig.lockingTime + 11) - (defaultProposalTimingConfig.executingTime - 11) + ((def :: ProposalTimingConfig).lockingTime + 11) + ((def :: ProposalTimingConfig).executingTime - 11) in ScriptContext { scriptContextTxInfo = TxInfo @@ -587,8 +589,8 @@ mutateState = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 5 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } governorInputDatum :: Datum governorInputDatum = Datum $ toBuiltinData governorInputDatum' diff --git a/agora-sample/Sample/Proposal.hs b/agora-sample/Sample/Proposal.hs index cea8be0..631dc9f 100644 --- a/agora-sample/Sample/Proposal.hs +++ b/agora-sample/Sample/Proposal.hs @@ -16,9 +16,14 @@ module Sample.Proposal ( ) where -------------------------------------------------------------------------------- + import Plutarch.Api.V1 ( validatorHash, ) +import Plutarch.SafeMoney (Tagged (Tagged), untag) + +-------------------------------------------------------------------------------- + import Plutus.V1.Ledger.Api ( Address (Address), Credential (ScriptCredential), @@ -34,6 +39,7 @@ import Plutus.V1.Ledger.Api ( TxOutRef (TxOutRef), ) import Plutus.V1.Ledger.Value qualified as Value +import PlutusTx.AssocMap qualified as AssocMap -------------------------------------------------------------------------------- @@ -51,13 +57,18 @@ import Agora.Proposal ( ) import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..)) import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..)) -import Plutarch.SafeMoney (Tagged (Tagged), untag) -import PlutusTx.AssocMap qualified as AssocMap + +-------------------------------------------------------------------------------- + import Sample.Shared import Test.Util (closedBoundedInterval, datumPair, toDatumHash, updateMap) -------------------------------------------------------------------------------- +import Data.Default.Class (Default (def)) + +-------------------------------------------------------------------------------- + -- | This script context should be a valid transaction. proposalCreation :: ScriptContext proposalCreation = @@ -78,7 +89,7 @@ proposalCreation = , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects - , timingConfig = defaultProposalTimingConfig + , timingConfig = def , startingTime = proposalStartingTimeFromTimeRange validTimeRange } ) @@ -90,8 +101,8 @@ proposalCreation = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 0 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } ) govAfter :: Datum @@ -101,8 +112,8 @@ proposalCreation = GovernorDatum { proposalThresholds = defaultProposalThresholds , nextProposalId = ProposalId 1 - , proposalTimings = defaultProposalTimingConfig - , createProposalTimeRangeMaxDuration = defaultCreateProposalTimeRangeMaxDuration + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def } ) @@ -179,7 +190,7 @@ cosignProposal newSigners = , cosigners = [signer] , thresholds = defaultProposalThresholds , votes = emptyVotesFor effects - , timingConfig = defaultProposalTimingConfig + , timingConfig = def , startingTime = ProposalStartingTime 0 } stakeDatum :: StakeDatum @@ -190,7 +201,7 @@ cosignProposal newSigners = validTimeRange = closedBoundedInterval 10 - (defaultProposalTimingConfig.draftTime - 10) + ((def :: ProposalTimingConfig).draftTime - 10) in TxInfo { txInfoInputs = [ TxInInfo @@ -300,7 +311,7 @@ voteOnProposal params = , cosigners = [stakeOwner] , thresholds = defaultProposalThresholds , votes = ProposalVotes initialVotes - , timingConfig = defaultProposalTimingConfig + , timingConfig = def , startingTime = ProposalStartingTime 0 } proposalInputDatum :: Datum @@ -389,7 +400,9 @@ voteOnProposal params = --- validTimeRange = - closedBoundedInterval (defaultProposalTimingConfig.draftTime + 1) (defaultProposalTimingConfig.votingTime - 1) + closedBoundedInterval + ((def :: ProposalTimingConfig).draftTime + 1) + ((def :: ProposalTimingConfig).votingTime - 1) in TxInfo { txInfoInputs = [ TxInInfo proposalRef proposalInput diff --git a/agora-sample/Sample/Shared.hs b/agora-sample/Sample/Shared.hs index 8d44130..94801bf 100644 --- a/agora-sample/Sample/Shared.hs +++ b/agora-sample/Sample/Shared.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + {- | Module : Sample.Shared Maintainer : emi@haskell.fyi @@ -36,8 +38,6 @@ module Sample.Shared ( proposalPolicySymbol, proposalValidatorHash, proposalValidatorAddress, - defaultProposalTimingConfig, - defaultCreateProposalTimeRangeMaxDuration, proposalStartingTimeFromTimeRange, -- ** Authority @@ -78,12 +78,14 @@ import Agora.Proposal ( ProposalThresholds (..), ) import Agora.Proposal.Time ( + MaxTimeRangeWidth (..), ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..), ) import Agora.Stake (Stake (..)) import Agora.Treasury (treasuryValidator) import Agora.Utils (validatorHashToTokenName) +import Data.Default.Class (Default (..)) import Plutarch.Api.V1 ( mintingPolicySymbol, mkMintingPolicy, @@ -100,7 +102,6 @@ import Plutus.V1.Ledger.Api ( Interval (..), LowerBound (..), MintingPolicy (..), - POSIXTime, POSIXTimeRange, PubKeyHash, TxOutRef (TxOutRef), @@ -197,18 +198,27 @@ authorityToken = authorityTokenFromGovernor governor authorityTokenSymbol :: CurrencySymbol authorityTokenSymbol = authorityTokenSymbolFromGovernor governor -defaultProposalTimingConfig :: ProposalTimingConfig -defaultProposalTimingConfig = - ProposalTimingConfig - { draftTime = 50 - , votingTime = 1000 - , lockingTime = 2000 - , executingTime = 3000 - } +{- | Default value of 'Agora.Governor.GovernorDatum.proposalTimings'. + For testing purpose only. +-} +instance Default ProposalTimingConfig where + def = + ProposalTimingConfig + { draftTime = 50 + , votingTime = 1000 + , lockingTime = 2000 + , executingTime = 3000 + } -defaultCreateProposalTimeRangeMaxDuration :: POSIXTime -defaultCreateProposalTimeRangeMaxDuration = 10 +{- | Default value of 'Agora.Governor.GovernorDatum.createProposalTimeRangeMaxWidth'. + For testing purpose only. +-} +instance Default MaxTimeRangeWidth where + def = MaxTimeRangeWidth 10 +{- | Get the starting time of a proposal, given a closed finite time range. + Tightness of the time range is not checked. See 'Agora.Proposal.Time.createProposalStartingTime'. +-} proposalStartingTimeFromTimeRange :: POSIXTimeRange -> ProposalStartingTime proposalStartingTimeFromTimeRange (Interval (LowerBound (Finite l) True) (UpperBound (Finite u) True)) = diff --git a/agora-test/Spec/Effect/GovernorMutation.hs b/agora-test/Spec/Effect/GovernorMutation.hs index fd70f34..18ed995 100644 --- a/agora-test/Spec/Effect/GovernorMutation.hs +++ b/agora-test/Spec/Effect/GovernorMutation.hs @@ -4,6 +4,7 @@ import Agora.Effect.GovernorMutation (mutateGovernorValidator) import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor)) import Agora.Governor.Scripts (governorValidator) import Agora.Proposal (ProposalId (..)) +import Data.Default.Class (Default (def)) import Plutus.V1.Ledger.Api (ScriptContext (ScriptContext), ScriptPurpose (Spending)) import Sample.Effect.GovernorMutation ( effectRef, @@ -29,8 +30,8 @@ tests = ( GovernorDatum Shared.defaultProposalThresholds (ProposalId 0) - Shared.defaultProposalTimingConfig - Shared.defaultCreateProposalTimeRangeMaxDuration + def + def ) MutateGovernor ( ScriptContext @@ -51,8 +52,8 @@ tests = ( GovernorDatum Shared.defaultProposalThresholds (ProposalId 0) - Shared.defaultProposalTimingConfig - Shared.defaultCreateProposalTimeRangeMaxDuration + def + def ) MutateGovernor ( ScriptContext diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 7d324fb..3ac39a2 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -16,6 +16,7 @@ module Spec.Governor (tests) where import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..)) import Agora.Governor.Scripts (governorPolicy, governorValidator) import Agora.Proposal (ProposalId (..)) +import Data.Default.Class (Default (def)) import Sample.Governor (createProposal, mintGATs, mintGST, mutateState) import Sample.Shared qualified as Shared import Test.Tasty (TestTree, testGroup) @@ -41,8 +42,8 @@ tests = ( GovernorDatum Shared.defaultProposalThresholds (ProposalId 0) - Shared.defaultProposalTimingConfig - Shared.defaultCreateProposalTimeRangeMaxDuration + def + def ) CreateProposal createProposal @@ -52,8 +53,8 @@ tests = ( GovernorDatum Shared.defaultProposalThresholds (ProposalId 5) - Shared.defaultProposalTimingConfig - Shared.defaultCreateProposalTimeRangeMaxDuration + def + def ) MintGATs mintGATs @@ -63,8 +64,8 @@ tests = ( GovernorDatum Shared.defaultProposalThresholds (ProposalId 5) - Shared.defaultProposalTimingConfig - Shared.defaultCreateProposalTimeRangeMaxDuration + def + def ) MutateGovernor mutateState diff --git a/agora-test/Spec/Proposal.hs b/agora-test/Spec/Proposal.hs index dc0f1cc..c381126 100644 --- a/agora-test/Spec/Proposal.hs +++ b/agora-test/Spec/Proposal.hs @@ -38,6 +38,7 @@ import Agora.Stake ( StakeRedeemer (PermitVote, WitnessStake), ) import Agora.Stake.Scripts (stakeValidator) +import Data.Default.Class (Default (def)) import Plutarch.SafeMoney (Tagged (Tagged)) import Plutus.V1.Ledger.Api (ScriptContext (..), ScriptPurpose (..)) import PlutusTx.AssocMap qualified as AssocMap @@ -83,7 +84,7 @@ tests = [ (ResultTag 0, AssocMap.empty) , (ResultTag 1, AssocMap.empty) ] - , timingConfig = Shared.defaultProposalTimingConfig + , timingConfig = def , startingTime = ProposalStartingTime 0 } ) @@ -118,7 +119,7 @@ tests = , (ResultTag 1, 4242) ] ) - , timingConfig = Shared.defaultProposalTimingConfig + , timingConfig = def , startingTime = ProposalStartingTime 0 } ) diff --git a/agora.cabal b/agora.cabal index 95189c6..256e025 100644 --- a/agora.cabal +++ b/agora.cabal @@ -114,6 +114,7 @@ common test-deps , agora , apropos , apropos-tx + , data-default-class , mtl , QuickCheck , quickcheck-instances diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 7bd4805..a2d5940 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -37,13 +37,17 @@ import Agora.Proposal ( ProposalId (ProposalId), ProposalThresholds, ) -import Agora.Proposal.Time (PProposalTimingConfig, ProposalTimingConfig) +import Agora.Proposal.Time ( + MaxTimeRangeWidth, + PMaxTimeRangeWidth, + PProposalTimingConfig, + ProposalTimingConfig, + ) import Agora.SafeMoney (GTTag) import Agora.Utils (tclet) -------------------------------------------------------------------------------- -import Plutarch.Api.V1 (PPOSIXTime) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, @@ -56,7 +60,7 @@ import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- -import Plutus.V1.Ledger.Api (POSIXTime, TxOutRef) +import Plutus.V1.Ledger.Api (TxOutRef) import Plutus.V1.Ledger.Value (AssetClass (..)) import PlutusTx qualified @@ -71,7 +75,7 @@ data GovernorDatum = GovernorDatum , proposalTimings :: ProposalTimingConfig -- ^ The timing configuration for proposals. -- Will get copied over upon the creation of proposals. - , createProposalTimeRangeMaxDuration :: POSIXTime + , createProposalTimeRangeMaxWidth :: MaxTimeRangeWidth -- ^ The maximum valid duration of a transaction that creats a proposal. } deriving stock (Show, GHC.Generic) @@ -126,7 +130,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum '[ "proposalThresholds" ':= PProposalThresholds , "nextProposalId" ':= PProposalId , "proposalTimings" ':= PProposalTimingConfig - , "createProposalTimeRangeMaxDuration" ':= PPOSIXTime + , "createProposalTimeRangeMaxWidth" ':= PMaxTimeRangeWidth ] ) } diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 9f474f6..fc4987d 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -307,7 +307,7 @@ governorValidator gov = @'[ "proposalThresholds" , "nextProposalId" , "proposalTimings" - , "createProposalTimeRangeMaxDuration" + , "createProposalTimeRangeMaxWidth" ] oldGovernorDatum @@ -347,8 +347,8 @@ governorValidator gov = ( #proposalThresholds .= oldGovernorDatumF.proposalThresholds .& #nextProposalId .= pdata expectedNextProposalId .& #proposalTimings .= oldGovernorDatumF.proposalTimings - .& #createProposalTimeRangeMaxDuration - .= oldGovernorDatumF.createProposalTimeRangeMaxDuration + .& #createProposalTimeRangeMaxWidth + .= oldGovernorDatumF.createProposalTimeRangeMaxWidth ) tcassert "Unexpected governor state datum" $ newGovernorDatum #== expectedNewDatum @@ -436,7 +436,7 @@ governorValidator gov = expectedVotes = pemptyVotesFor # pfromData proposalOutputDatum.effects expectedStartingTime = createProposalStartingTime - # oldGovernorDatumF.createProposalTimeRangeMaxDuration + # oldGovernorDatumF.createProposalTimeRangeMaxWidth # txInfoF.validRange -- Id, thresholds and timings should be copied from the old governor state datum. expectedProposalOut = diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 0cd1452..b120216 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -349,7 +349,7 @@ deriving via instance (PConstantDecl ProposalVotes) --- Plutarch version of 'pemptyVotesFor'. +-- Plutarch-level version of 'emptyVotesFor'. pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap PResultTag a :--> PProposalVotes) pemptyVotesFor = phoistAcyclic $ diff --git a/agora/Agora/Proposal/Time.hs b/agora/Agora/Proposal/Time.hs index 2f6509c..f1e05fc 100644 --- a/agora/Agora/Proposal/Time.hs +++ b/agora/Agora/Proposal/Time.hs @@ -13,11 +13,13 @@ module Agora.Proposal.Time ( ProposalTime (..), ProposalTimingConfig (..), ProposalStartingTime (..), + MaxTimeRangeWidth (..), -- * Plutarch-land PProposalTime (..), PProposalTimingConfig (..), PProposalStartingTime (..), + PMaxTimeRangeWidth (..), -- * Compute periods given config and starting time. createProposalStartingTime, @@ -108,6 +110,11 @@ data ProposalTimingConfig = ProposalTimingConfig PlutusTx.makeIsDataIndexed ''ProposalTimingConfig [('ProposalTimingConfig, 0)] +-- | Represents the maximum width of a 'POSIXTimeRange'. +newtype MaxTimeRangeWidth = MaxTimeRangeWidth {getMaxWidth :: POSIXTime} + deriving stock (Eq, Show, Ord, GHC.Generic) + deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) + -------------------------------------------------------------------------------- -- | Plutarch-level version of 'ProposalTime'. @@ -173,6 +180,17 @@ deriving via instance (PConstantDecl ProposalTimingConfig) +-- | Plutarch-level version of 'MaxTimeRangeWidth'. +newtype PMaxTimeRangeWidth (s :: S) + = PMaxTimeRangeWidth (Term s PPOSIXTime) + deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PMaxTimeRangeWidth PPOSIXTime) + +instance PUnsafeLiftDecl PMaxTimeRangeWidth where type PLifted PMaxTimeRangeWidth = MaxTimeRangeWidth +deriving via + (DerivePConstantViaNewtype MaxTimeRangeWidth PMaxTimeRangeWidth PPOSIXTime) + instance + (PConstantDecl MaxTimeRangeWidth) + -------------------------------------------------------------------------------- -- FIXME: Orphan instance, move this to plutarch-extra. @@ -180,11 +198,12 @@ instance AdditiveSemigroup (Term s PPOSIXTime) where (punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y {- | Get the starting time of a proposal, from the 'Plutus.V1.Ledger.Api.txInfoValidPeriod' field. - For every proposal, this is only meant to run once upon creation. + For every proposal, this is only meant to run once upon creation. Given time range should be + tight enough, meaning that the width of the time range should be less than the maximum value. -} -createProposalStartingTime :: forall (s :: S). Term s (PPOSIXTime :--> PPOSIXTimeRange :--> PProposalStartingTime) +createProposalStartingTime :: forall (s :: S). Term s (PMaxTimeRangeWidth :--> PPOSIXTimeRange :--> PProposalStartingTime) createProposalStartingTime = phoistAcyclic $ - plam $ \maxDuration iv -> unTermCont $ do + plam $ \(pto -> maxDuration) iv -> unTermCont $ do currentTimeF <- tcont $ pletFields @'["lowerBound", "upperBound"] $