Sulkta-Coop/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

store timing config in the proposal datum

Browse source 
.... and mock the value upon creation for now
This commit is contained in:
fanghr 2022-05-18 20:34:56 +08:00
parent cf51d47a0d
commit 92c64f8d7a
No known key found for this signature in database
GPG key ID: 35CD9A71CD5D5870
8 changed files with 68 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

3
agora-sample/Sample/Governor.hs
View file

@ -73,6 +73,7 @@ import Sample.Shared (
gstUTXORef,
minAda,
proposalPolicySymbol,
proposalTimingConfig,
proposalValidatorAddress,
signer,
signer2,
@ -234,6 +235,7 @@ createProposal =
, cosigners = [signer]
, thresholds = defaultProposalThresholds
, votes = emptyVotesFor effects
, timingConfig = proposalTimingConfig
}
)
proposalOutput :: TxOut
@ -408,6 +410,7 @@ mintGATs =
, cosigners = [signer, signer2]
, thresholds = defaultProposalThresholds
, votes = proposalVotes
, timingConfig = proposalTimingConfig
}
proposalInputDatum :: Datum
proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'

2
agora-sample/Sample/Proposal.hs
View file

@ -74,6 +74,7 @@ proposalCreation =
, cosigners = [signer]
, thresholds = defaultProposalThresholds
, votes = emptyVotesFor effects
, timingConfig = proposalTimingConfig
}
)
@ -167,6 +168,7 @@ cosignProposal newSigners =
, cosigners = [signer]
, thresholds = defaultProposalThresholds
, votes = emptyVotesFor effects
, timingConfig = proposalTimingConfig
}
stakeDatum :: StakeDatum
stakeDatum = StakeDatum (Tagged 50_000_000) signer2 []

13
agora-sample/Sample/Shared.hs
View file

@ -36,6 +36,7 @@ module Sample.Shared (
proposalPolicySymbol,
proposalValidatorHash,
proposalValidatorAddress,
proposalTimingConfig,
-- ** Authority
authorityToken,
@ -74,6 +75,9 @@ import Agora.Proposal (
Proposal (..),
ProposalThresholds (..),
)
import Agora.Proposal.Time (
ProposalTimingConfig (..),
)
import Agora.Stake (Stake (..))
import Agora.Treasury (treasuryValidator)
import Agora.Utils (validatorHashToTokenName)
@ -184,6 +188,15 @@ authorityToken = authorityTokenFromGovernor governor
authorityTokenSymbol :: CurrencySymbol
authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
proposalTimingConfig :: ProposalTimingConfig
proposalTimingConfig =
ProposalTimingConfig
{ draftTime = 0
, votingTime = 1000
, lockingTime = 2000
, executingTime = 3000
}
------------------------------------------------------------------
treasuryOut :: TxOut

3
agora-test/Spec/Proposal.hs
View file

@ -13,7 +13,7 @@ module Spec.Proposal (tests) where
import Agora.Proposal (
Proposal (..),
ProposalDatum (ProposalDatum),
ProposalDatum (..),
ProposalId (ProposalId),
ProposalRedeemer (Cosign),
ProposalStatus (Draft),
@ -77,6 +77,7 @@ tests =
[ (ResultTag 0, AssocMap.empty)
, (ResultTag 1, AssocMap.empty)
]
, timingConfig = Shared.proposalTimingConfig
}
)
(Cosign [signer2])

13
agora/Agora/Governor/Scripts.hs
View file

@ -126,6 +126,7 @@ import Plutarch.TryFrom (ptryFrom)
--------------------------------------------------------------------------------
import Agora.Proposal.Time (ProposalTimingConfig (..))
import Plutus.V1.Ledger.Api (
CurrencySymbol (..),
MintingPolicy,
@ -576,6 +577,8 @@ governorValidator gov =
.& #cosigners .= proposalInputDatumF.cosigners
.& #thresholds .= proposalInputDatumF.thresholds
.& #votes .= proposalInputDatumF.votes
-- FIXME: copy from the governor datum
.& #timingConfig .= pdata (pconstant tmpTimingConfig)
)
tcassert "Unexpected output proposal datum" $
@ -727,6 +730,16 @@ governorValidator gov =
let sym = governorSTSymbolFromGovernor gov
in phoistAcyclic $ pconstant sym
-- TODO: remove this. This is temperary.
tmpTimingConfig :: ProposalTimingConfig
tmpTimingConfig =
ProposalTimingConfig
{ draftTime = 0
, votingTime = 1000
, lockingTime = 2000
, executingTime = 3000
}
--------------------------------------------------------------------------------
-- | Get the 'CurrencySymbol' of GST.

5
agora/Agora/Proposal.hs
View file

@ -44,6 +44,8 @@ import PlutusTx qualified
import PlutusTx.AssocMap qualified as AssocMap
--------------------------------------------------------------------------------
import Agora.Proposal.Time (PProposalTimingConfig, ProposalTimingConfig)
import Agora.SafeMoney (GTTag)
import Agora.Utils (pkeysEqual, pnotNull)
import Control.Applicative (Const)
@ -186,6 +188,8 @@ data ProposalDatum = ProposalDatum
-- ^ Thresholds copied over on initialization.
, votes :: ProposalVotes
-- ^ Vote tally on the proposal
, timingConfig :: ProposalTimingConfig
-- ^ Timing configuration copied over on initialization.
}
deriving stock (Eq, Show, GHC.Generic)
@ -354,6 +358,7 @@ newtype PProposalDatum (s :: S) = PProposalDatum
, "cosigners" ':= PBuiltinList (PAsData PPubKeyHash)
, "thresholds" ':= PProposalThresholds
, "votes" ':= PProposalVotes
, "timingConfig" ':= PProposalTimingConfig
]
)
}

3
agora/Agora/Proposal/Scripts.hs
View file

@ -151,6 +151,7 @@ proposalValidator proposal =
, "cosigners"
, "thresholds"
, "votes"
, "timingConfig"
]
proposalDatum
@ -253,6 +254,7 @@ proposalValidator proposal =
.& #cosigners .= proposalF.cosigners
.& #thresholds .= proposalF.thresholds
.& #votes .= pdata expectedNewVotes
.& #timingConfig .= proposalF.timingConfig
)
tcassert "Invalid output proposal" $ proposalOut #== expectedProposalOut
@ -342,6 +344,7 @@ proposalValidator proposal =
.& #cosigners .= pdata updatedSigs
.& #thresholds .= proposalF.thresholds
.& #votes .= proposalF.votes
.& #timingConfig .= proposalF.timingConfig
)
)
in foldr1

28
agora/Agora/Proposal/Time.hs
View file

@ -39,7 +39,12 @@ import Plutarch.Api.V1 (
PPOSIXTimeRange,
PUpperBound (PUpperBound),
)
import Plutarch.DataRepr (PDataFields, PIsDataReprInstances (..))
import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..))
import Plutarch.Lift (
DerivePConstantViaNewtype (..),
PConstantDecl,
PUnsafeLiftDecl (..),
)
import Plutarch.Numeric (AdditiveSemigroup ((+)))
import Plutarch.Unsafe (punsafeCoerce)
import Plutus.V1.Ledger.Time (POSIXTime)
@ -122,10 +127,24 @@ newtype PProposalTime (s :: S)
(PlutusType, PIsData, PDataFields)
via (PIsDataReprInstances PProposalTime)
instance PUnsafeLiftDecl PProposalTime where
type PLifted PProposalTime = ProposalTime
deriving via
(DerivePConstantViaData ProposalTime PProposalTime)
instance
(PConstantDecl ProposalTime)
-- | Plutarch-level version of 'ProposalStartingTime'.
newtype PProposalStartingTime (s :: S) = PProposalStartingTime (Term s PPOSIXTime)
deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PProposalStartingTime PPOSIXTime)
instance PUnsafeLiftDecl PProposalStartingTime where
type PLifted PProposalStartingTime = ProposalStartingTime
deriving via
(DerivePConstantViaNewtype ProposalStartingTime PProposalStartingTime PPOSIXTime)
instance
(PConstantDecl ProposalStartingTime)
-- | Plutarch-level version of 'ProposalTimingConfig'.
newtype PProposalTimingConfig (s :: S) = PProposalTimingConfig
{ getProposalTimingConfig ::
@ -146,6 +165,13 @@ newtype PProposalTimingConfig (s :: S) = PProposalTimingConfig
(PlutusType, PIsData, PDataFields)
via (PIsDataReprInstances PProposalTimingConfig)
instance PUnsafeLiftDecl PProposalTimingConfig where
type PLifted PProposalTimingConfig = ProposalTimingConfig
deriving via
(DerivePConstantViaData ProposalTimingConfig PProposalTimingConfig)
instance
(PConstantDecl ProposalTimingConfig)
--------------------------------------------------------------------------------
-- FIXME: Orphan instance, move this to plutarch-extra.