add missing range checks
This commit is contained in:
parent
8cbdbeb2fe
commit
34827aeca6
2 changed files with 28 additions and 4 deletions
|
|
@ -252,8 +252,8 @@ instance PTryFrom PData (PAsData PResultTag) where
|
|||
ptryFrom' d k =
|
||||
ptryFrom' @_ @(PAsData PInteger) d $
|
||||
-- JUSTIFICATION:
|
||||
-- We are coercing from @PAsData underlying@ to @PAsData (PTagged tag underlying)@.
|
||||
-- Since 'PTagged' is a simple newtype, their shape is the same.
|
||||
-- We are coercing from @PAsData PInteger@ to @PAsData PResultTag@.
|
||||
-- Since 'PResultTag' is a simple newtype, their shape is the same.
|
||||
k . first punsafeCoerce
|
||||
|
||||
-- | Plutarch-level version of 'PProposalId'.
|
||||
|
|
@ -265,8 +265,8 @@ instance PTryFrom PData (PAsData PProposalId) where
|
|||
ptryFrom' d k =
|
||||
ptryFrom' @_ @(PAsData PInteger) d $
|
||||
-- JUSTIFICATION:
|
||||
-- We are coercing from @PAsData underlying@ to @PAsData (PTagged tag underlying)@.
|
||||
-- Since 'PTagged' is a simple newtype, their shape is the same.
|
||||
-- We are coercing from @PAsData PInteger@ to @PAsData PProposalId@.
|
||||
-- Since 'PProposalId' is a simple newtype, their shape is the same.
|
||||
k . first punsafeCoerce
|
||||
|
||||
instance PUnsafeLiftDecl PProposalId where type PLifted PProposalId = ProposalId
|
||||
|
|
|
|||
|
|
@ -22,6 +22,9 @@ module Agora.Proposal.Time (
|
|||
-- * Compute ranges given config and starting time.
|
||||
currentProposalTime,
|
||||
isDraftRange,
|
||||
isVotingRange,
|
||||
isLockingRange,
|
||||
isExecutionRange,
|
||||
) where
|
||||
|
||||
import Agora.Record (mkRecordConstr, (.&), (.=))
|
||||
|
|
@ -196,3 +199,24 @@ isDraftRange :: forall (s :: S). Term s (PProposalTimingConfig :--> PProposalSta
|
|||
isDraftRange = phoistAcyclic $
|
||||
plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
|
||||
proposalTimeWithin # s # (s + pfield @"draftTime" # config)
|
||||
|
||||
-- | True if the 'PProposalTime' is in the voting period.
|
||||
isVotingRange :: forall (s :: S). Term s (PProposalTimingConfig :--> PProposalStartingTime :--> PProposalTime :--> PBool)
|
||||
isVotingRange = phoistAcyclic $
|
||||
plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
|
||||
pletFields @'["draftTime", "votingTime"] config $ \f ->
|
||||
proposalTimeWithin # s # (s + f.draftTime + f.votingTime)
|
||||
|
||||
-- | True if the 'PProposalTime' is in the locking period.
|
||||
isLockingRange :: forall (s :: S). Term s (PProposalTimingConfig :--> PProposalStartingTime :--> PProposalTime :--> PBool)
|
||||
isLockingRange = phoistAcyclic $
|
||||
plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
|
||||
pletFields @'["draftTime", "votingTime", "lockingTime"] config $ \f ->
|
||||
proposalTimeWithin # s # (s + f.draftTime + f.votingTime + f.lockingTime)
|
||||
|
||||
-- | True if the 'PProposalTime' is in the execution period.
|
||||
isExecutionRange :: forall (s :: S). Term s (PProposalTimingConfig :--> PProposalStartingTime :--> PProposalTime :--> PBool)
|
||||
isExecutionRange = phoistAcyclic $
|
||||
plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
|
||||
pletFields @'["draftTime", "votingTime", "lockingTime", "executingTime"] config $ \f ->
|
||||
proposalTimeWithin # s # (s + f.draftTime + f.votingTime + f.lockingTime + f.executingTime)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue