add missing range checks

This commit is contained in:
Emily Martins 2022-04-26 22:08:31 +02:00
parent 8cbdbeb2fe
commit 34827aeca6
2 changed files with 28 additions and 4 deletions

View file

@ -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

View file

@ -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)