add 'isDraftRange' checking function.
This commit is contained in:
Emily Martins
parent
faf326f9c3
commit
12fc16390b
2 changed files with 113 additions and 77 deletions
|
|
@ -11,6 +11,7 @@ module Agora.Proposal (
|
|||
-- * Haskell-land
|
||||
Proposal (..),
|
||||
ProposalDatum (..),
|
||||
ProposalRedeemer (..),
|
||||
ProposalStatus (..),
|
||||
ProposalThresholds (..),
|
||||
ProposalVotes (..),
|
||||
|
|
@ -19,6 +20,7 @@ module Agora.Proposal (
|
|||
|
||||
-- * Plutarch-land
|
||||
PProposalDatum (..),
|
||||
PProposalRedeemer (..),
|
||||
PProposalStatus (..),
|
||||
PProposalThresholds (..),
|
||||
PProposalVotes (..),
|
||||
|
|
@ -182,12 +184,12 @@ PlutusTx.makeIsDataIndexed ''ProposalDatum [('ProposalDatum, 0)]
|
|||
data ProposalRedeemer
|
||||
= -- | Cast one or more votes towards a particular 'ResultTag'.
|
||||
Vote ResultTag
|
||||
| -- | Add one or more public keys to the cosignature list. Must be signed by
|
||||
-- those cosigning.
|
||||
| -- | Add one or more public keys to the cosignature list.
|
||||
-- Must be signed by those cosigning.
|
||||
--
|
||||
-- This is particularly used in the 'Draft' 'ProposalStatus'. Where matching
|
||||
-- 'Stake's can be called to advance the proposal, provided enough GT is shared
|
||||
-- among them.
|
||||
-- This is particularly used in the 'Draft' 'ProposalStatus',
|
||||
-- where matching 'Stake's can be called to advance the proposal,
|
||||
-- provided enough GT is shared among them.
|
||||
Cosign [PubKeyHash]
|
||||
| -- | Allow unlocking one or more stakes with votes towards particular 'ResultTag'.
|
||||
Unlock ResultTag
|
||||
|
|
@ -195,19 +197,23 @@ data ProposalRedeemer
|
|||
--
|
||||
-- These are roughly the checks for each possible transition:
|
||||
--
|
||||
-- @'Draft' -> 'VotingReady'@:
|
||||
-- === @'Draft' -> 'VotingReady'@:
|
||||
--
|
||||
-- 1. The sum of all of the cosigner's GT is larger than the 'vote' field of 'ProposalThresholds'.
|
||||
-- 2. The proposal hasn't been alive for longer than the review time.
|
||||
--
|
||||
-- @'VotingReady' -> 'Locked'@:
|
||||
-- === @'VotingReady' -> 'Locked'@:
|
||||
--
|
||||
-- 1. The sum of all votes is larger than 'countVoting'.
|
||||
-- 2. The winning 'ResultTag' has more votes than all other 'ResultTag's.
|
||||
-- 3. The proposal hasn't been alive for longer than the voting time.
|
||||
--
|
||||
-- @'Locked' -> 'Finished'@:
|
||||
-- === @'Locked' -> 'Finished'@:
|
||||
--
|
||||
-- Always valid provided the conditions for the transition are met.
|
||||
--
|
||||
-- @* -> 'Finished'@:
|
||||
-- === @* -> 'Finished'@:
|
||||
--
|
||||
-- If the proposal has run out of time for the current 'ProposalStatus', it will always be possible
|
||||
-- to transition into 'Finished' state, because it has expired (and failed).
|
||||
AdvanceProposal
|
||||
|
|
@ -221,10 +227,10 @@ PlutusTx.makeIsDataIndexed
|
|||
, ('AdvanceProposal, 3)
|
||||
]
|
||||
|
||||
{- | Identifies a Proposal, issued upon creation of a proposal.
|
||||
In practice, this number starts at zero, and increments by one
|
||||
for each proposal. The 100th proposal will be @'ProposalId' 99@.
|
||||
This counter lives in the 'Governor', see 'nextProposalId'.
|
||||
{- | Identifies a Proposal, issued upon creation of a proposal. In practice,
|
||||
this number starts at zero, and increments by one for each proposal.
|
||||
The 100th proposal will be @'ProposalId' 99@. This counter lives
|
||||
in the 'Agora.Governor.Governor', see 'Agora.Governor.nextProposalId'.
|
||||
-}
|
||||
newtype ProposalId = ProposalId {proposalTag :: Integer}
|
||||
deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
|
||||
|
|
|
|||
|
|
@ -20,35 +20,53 @@ module Agora.Proposal.Time (
|
|||
PProposalStartingTime (..),
|
||||
|
||||
-- * Compute ranges given config and starting time.
|
||||
proposalDraftRange,
|
||||
|
||||
-- * Upstreamables
|
||||
plowerBound,
|
||||
pupperBound,
|
||||
pstrictLowerBound,
|
||||
pstrictUpperBound,
|
||||
currentProposalTime,
|
||||
isDraftRange,
|
||||
) where
|
||||
|
||||
import Agora.Record (build, (.&), (.=))
|
||||
import GHC.Generics qualified as GHC
|
||||
import Generics.SOP (Generic, I (I))
|
||||
import Plutarch.Api.V1 (PExtended (PFinite), PInterval (PInterval), PLowerBound (PLowerBound), PPOSIXTime, PPOSIXTimeRange, PUpperBound (PUpperBound))
|
||||
import Plutarch.Api.V1 (PExtended (PFinite), PInterval (PInterval), PLowerBound (PLowerBound), PMaybeData (PDJust, PDNothing), PPOSIXTime, PPOSIXTimeRange, PUpperBound (PUpperBound))
|
||||
import Plutarch.DataRepr (PDataFields, PIsDataReprInstances (..))
|
||||
import Plutarch.Monadic qualified as P
|
||||
import Plutarch.Numeric (AdditiveSemigroup ((+)))
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import Plutus.V1.Ledger.Time (POSIXTime, POSIXTimeRange)
|
||||
import Plutus.V1.Ledger.Time (POSIXTime)
|
||||
import PlutusTx qualified
|
||||
import Prelude hiding ((+))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Represents the current time, as far as the proposal is concerned.
|
||||
newtype ProposalTime = ProposalTime
|
||||
{ getProposalTime :: POSIXTimeRange
|
||||
{- | == 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 got 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.txInfoValidRange' field
|
||||
of 'Plutus.V1.Ledger.Api.TxInfo'.
|
||||
|
||||
We avoid 'PPOSIXTimeRange' where we can in order to save on operations.
|
||||
-}
|
||||
data ProposalTime = ProposalTime
|
||||
{ lowerBound :: Maybe POSIXTime
|
||||
, upperBound :: Maybe POSIXTime
|
||||
}
|
||||
deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
|
||||
deriving stock (Eq, Show, GHC.Generic)
|
||||
|
||||
PlutusTx.makeIsDataIndexed ''ProposalTime [('ProposalTime, 0)]
|
||||
|
||||
-- | Represents the starting time of the proposal.
|
||||
newtype ProposalStartingTime = ProposalStartingTime
|
||||
{ getProposalStartingTime :: POSIXTime
|
||||
|
|
@ -74,8 +92,22 @@ PlutusTx.makeIsDataIndexed ''ProposalTimingConfig [('ProposalTimingConfig, 0)]
|
|||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Plutarch-level version of 'ProposalTime'.
|
||||
newtype PProposalTime (s :: S) = PProposalTime (Term s PPOSIXTime)
|
||||
deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PProposalTime PPOSIXTime)
|
||||
newtype PProposalTime (s :: S)
|
||||
= PProposalTime
|
||||
( Term
|
||||
s
|
||||
( PDataRecord
|
||||
'[ "lowerBound" ':= PMaybeData PPOSIXTime
|
||||
, "upperBound" ':= PMaybeData PPOSIXTime
|
||||
]
|
||||
)
|
||||
)
|
||||
deriving stock (GHC.Generic)
|
||||
deriving anyclass (Generic)
|
||||
deriving anyclass (PIsDataRepr)
|
||||
deriving
|
||||
(PlutusType, PIsData, PDataFields)
|
||||
via (PIsDataReprInstances PProposalTime)
|
||||
|
||||
-- | Plutarch-level version of 'ProposalStartingTime'.
|
||||
newtype PProposalStartingTime (s :: S) = PProposalStartingTime (Term s PPOSIXTime)
|
||||
|
|
@ -103,58 +135,56 @@ newtype PProposalTimingConfig (s :: S) = PProposalTimingConfig
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- -- Need to move these away from here
|
||||
pstrictLowerBound :: PIsData a => Term s (a :--> PLowerBound a)
|
||||
pstrictLowerBound = phoistAcyclic $
|
||||
plam $ \a ->
|
||||
pcon
|
||||
( PLowerBound $
|
||||
build $
|
||||
#_0 .= pdata (pcon (PFinite $ build $ #_0 .= pdata a))
|
||||
.& #_1 .= pdata (pcon PFalse)
|
||||
)
|
||||
|
||||
pstrictUpperBound :: PIsData a => Term s (a :--> PUpperBound a)
|
||||
pstrictUpperBound = phoistAcyclic $
|
||||
plam $ \a ->
|
||||
pcon
|
||||
( PUpperBound $
|
||||
build $
|
||||
#_0 .= pdata (pcon (PFinite $ build $ #_0 .= pdata a))
|
||||
.& #_1 .= pdata (pcon PFalse)
|
||||
)
|
||||
|
||||
plowerBound :: PIsData a => Term s (a :--> PLowerBound a)
|
||||
plowerBound = phoistAcyclic $
|
||||
plam $ \a ->
|
||||
pcon
|
||||
( PLowerBound $
|
||||
build $
|
||||
#_0 .= pdata (pcon (PFinite $ build $ #_0 .= pdata a))
|
||||
.& #_1 .= pdata (pcon PTrue)
|
||||
)
|
||||
|
||||
pupperBound :: PIsData a => Term s (a :--> PUpperBound a)
|
||||
pupperBound = phoistAcyclic $
|
||||
plam $ \a ->
|
||||
pcon
|
||||
( PUpperBound $
|
||||
build $
|
||||
#_0 .= pdata (pcon (PFinite $ build $ #_0 .= pdata a))
|
||||
.& #_1 .= pdata (pcon PTrue)
|
||||
)
|
||||
|
||||
-- Move this to plutarch-extra.
|
||||
-- FIXME: Orphan instance, move this to plutarch-extra.
|
||||
instance AdditiveSemigroup (Term s PPOSIXTime) where
|
||||
(punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y
|
||||
|
||||
-- | Compute the range of time during which cosigning is legal.
|
||||
proposalDraftRange :: Term s (PPOSIXTime :--> PProposalTimingConfig :--> PPOSIXTimeRange)
|
||||
proposalDraftRange = phoistAcyclic $
|
||||
plam $ \s config ->
|
||||
-- | Get the current proposal time, from the 'txInfoValidRange' field.
|
||||
currentProposalTime :: forall (s :: S). Term s (PPOSIXTimeRange :--> PProposalTime)
|
||||
currentProposalTime = phoistAcyclic $
|
||||
plam $ \iv -> P.do
|
||||
PInterval iv' <- pmatch iv
|
||||
ivf <- pletFields @'["from", "to"] iv'
|
||||
PLowerBound lb <- pmatch ivf.from
|
||||
PUpperBound ub <- pmatch ivf.to
|
||||
lbf <- pletFields @'["_0", "_1"] lb
|
||||
ubf <- pletFields @'["_0", "_1"] ub
|
||||
pcon
|
||||
( PInterval $
|
||||
( PProposalTime $
|
||||
build $
|
||||
#from .= pdata (pstrictLowerBound # s)
|
||||
.& #to .= pdata (pstrictUpperBound #$ s + pfield @"draftTime" # config)
|
||||
#lowerBound
|
||||
.= pdata
|
||||
( pmatch lbf._0 $
|
||||
\case
|
||||
PFinite d -> pcon (PDJust d)
|
||||
_ -> pcon (PDNothing pdnil)
|
||||
)
|
||||
.& #upperBound
|
||||
.= pdata
|
||||
( pmatch ubf._0 $ \case
|
||||
PFinite d -> pcon (PDJust d)
|
||||
_ -> pcon (PDNothing pdnil)
|
||||
)
|
||||
)
|
||||
|
||||
-- | Check if 'PProposalTime' is within two 'PPOSIXTime'. Inclusive.
|
||||
proposalTimeWithin :: Term s (PPOSIXTime :--> PPOSIXTime :--> PProposalTime :--> PBool)
|
||||
proposalTimeWithin = phoistAcyclic $
|
||||
plam $ \l h proposalTime' -> P.do
|
||||
PProposalTime proposalTime <- pmatch proposalTime'
|
||||
ptf <- pletFields @'["lowerBound", "upperBound"] proposalTime
|
||||
foldr1
|
||||
(#&&)
|
||||
[ pmatch ptf.lowerBound $ \case
|
||||
PDJust lb -> l #<= pfromData (pfield @"_0" # lb)
|
||||
_ -> pcon PFalse
|
||||
, pmatch ptf.upperBound $ \case
|
||||
PDJust lb -> pfromData (pfield @"_0" # lb) #<= h
|
||||
_ -> pcon PFalse
|
||||
]
|
||||
|
||||
-- | True if the 'PProposalTime' is in the draft period.
|
||||
isDraftRange :: forall (s :: S). Term s (PProposalTimingConfig :--> PProposalStartingTime :--> PProposalTime :--> PBool)
|
||||
isDraftRange = phoistAcyclic $
|
||||
plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
|
||||
proposalTimeWithin # s # (s + pfield @"draftTime" # config)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue