remove infinities in ProposalTime, fix test build
This commit is contained in:
parent
c8f5c6af8f
commit
cf14d9edd8
5 changed files with 30 additions and 27 deletions
|
|
@ -16,10 +16,10 @@ import Agora.Proposal (
|
||||||
ProposalId (ProposalId),
|
ProposalId (ProposalId),
|
||||||
ProposalRedeemer (Cosign),
|
ProposalRedeemer (Cosign),
|
||||||
ProposalStatus (Draft),
|
ProposalStatus (Draft),
|
||||||
ProposalVotes (ProposalVotes),
|
|
||||||
ResultTag (ResultTag),
|
ResultTag (ResultTag),
|
||||||
cosigners,
|
cosigners,
|
||||||
effects,
|
effects,
|
||||||
|
emptyVotesFor,
|
||||||
proposalId,
|
proposalId,
|
||||||
status,
|
status,
|
||||||
thresholds,
|
thresholds,
|
||||||
|
|
@ -70,7 +70,12 @@ tests =
|
||||||
, status = Draft
|
, status = Draft
|
||||||
, cosigners = [signer]
|
, cosigners = [signer]
|
||||||
, thresholds = Shared.defaultProposalThresholds
|
, thresholds = Shared.defaultProposalThresholds
|
||||||
, votes = ProposalVotes AssocMap.empty
|
, votes =
|
||||||
|
emptyVotesFor $
|
||||||
|
AssocMap.fromList
|
||||||
|
[ (ResultTag 0, [])
|
||||||
|
, (ResultTag 1, [])
|
||||||
|
]
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Cosign [signer2])
|
(Cosign [signer2])
|
||||||
|
|
|
||||||
|
|
@ -43,7 +43,6 @@ import Agora.Proposal (
|
||||||
ProposalDatum (..),
|
ProposalDatum (..),
|
||||||
ProposalId (..),
|
ProposalId (..),
|
||||||
ProposalStatus (..),
|
ProposalStatus (..),
|
||||||
ProposalVotes (..),
|
|
||||||
ResultTag (..),
|
ResultTag (..),
|
||||||
emptyVotesFor,
|
emptyVotesFor,
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -129,5 +129,5 @@ defaultProposalThresholds =
|
||||||
ProposalThresholds
|
ProposalThresholds
|
||||||
{ countVoting = Tagged 1000
|
{ countVoting = Tagged 1000
|
||||||
, create = Tagged 1
|
, create = Tagged 1
|
||||||
, vote = Tagged 10
|
, startVoting = Tagged 10
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -212,8 +212,7 @@ proposalValidator proposal =
|
||||||
|
|
||||||
foldr1
|
foldr1
|
||||||
(#&&)
|
(#&&)
|
||||||
[ pcon PTrue
|
[ ptraceIfFalse "Datum must be correct" correctDatum
|
||||||
, ptraceIfFalse "Datum must be correct" correctDatum
|
|
||||||
, ptraceIfFalse "Value should be correct" $
|
, ptraceIfFalse "Value should be correct" $
|
||||||
pdata txOutF.value #== pdata newValue
|
pdata txOutF.value #== pdata newValue
|
||||||
, ptraceIfFalse "Must be sent to Proposal's address" $
|
, ptraceIfFalse "Must be sent to Proposal's address" $
|
||||||
|
|
|
||||||
|
|
@ -34,7 +34,6 @@ import Plutarch.Api.V1 (
|
||||||
PExtended (PFinite),
|
PExtended (PFinite),
|
||||||
PInterval (PInterval),
|
PInterval (PInterval),
|
||||||
PLowerBound (PLowerBound),
|
PLowerBound (PLowerBound),
|
||||||
PMaybeData (PDJust, PDNothing),
|
|
||||||
PPOSIXTime,
|
PPOSIXTime,
|
||||||
PPOSIXTimeRange,
|
PPOSIXTimeRange,
|
||||||
PUpperBound (PUpperBound),
|
PUpperBound (PUpperBound),
|
||||||
|
|
@ -71,8 +70,8 @@ import Prelude hiding ((+))
|
||||||
We avoid 'PPOSIXTimeRange' where we can in order to save on operations.
|
We avoid 'PPOSIXTimeRange' where we can in order to save on operations.
|
||||||
-}
|
-}
|
||||||
data ProposalTime = ProposalTime
|
data ProposalTime = ProposalTime
|
||||||
{ lowerBound :: Maybe POSIXTime
|
{ lowerBound :: POSIXTime
|
||||||
, upperBound :: Maybe POSIXTime
|
, upperBound :: POSIXTime
|
||||||
}
|
}
|
||||||
deriving stock (Eq, Show, GHC.Generic)
|
deriving stock (Eq, Show, GHC.Generic)
|
||||||
|
|
||||||
|
|
@ -111,8 +110,8 @@ newtype PProposalTime (s :: S)
|
||||||
( Term
|
( Term
|
||||||
s
|
s
|
||||||
( PDataRecord
|
( PDataRecord
|
||||||
'[ "lowerBound" ':= PMaybeData PPOSIXTime
|
'[ "lowerBound" ':= PPOSIXTime
|
||||||
, "upperBound" ':= PMaybeData PPOSIXTime
|
, "upperBound" ':= PPOSIXTime
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
@ -153,7 +152,11 @@ newtype PProposalTimingConfig (s :: S) = PProposalTimingConfig
|
||||||
instance AdditiveSemigroup (Term s PPOSIXTime) where
|
instance AdditiveSemigroup (Term s PPOSIXTime) where
|
||||||
(punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y
|
(punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y
|
||||||
|
|
||||||
-- | Get the current proposal time, from the 'Plutus.V1.Ledger.Api.txInfoValidPeriod' field.
|
{- | Get the current proposal time, from the 'Plutus.V1.Ledger.Api.txInfoValidPeriod' field.
|
||||||
|
|
||||||
|
If it's impossible to get a fully-bounded time, (e.g. either end of the 'PPOSIXTimeRange' is
|
||||||
|
an infinity) then we error out.
|
||||||
|
-}
|
||||||
currentProposalTime :: forall (s :: S). Term s (PPOSIXTimeRange :--> PProposalTime)
|
currentProposalTime :: forall (s :: S). Term s (PPOSIXTimeRange :--> PProposalTime)
|
||||||
currentProposalTime = phoistAcyclic $
|
currentProposalTime = phoistAcyclic $
|
||||||
plam $ \iv -> P.do
|
plam $ \iv -> P.do
|
||||||
|
|
@ -165,17 +168,18 @@ currentProposalTime = phoistAcyclic $
|
||||||
ubf <- pletFields @'["_0", "_1"] ub
|
ubf <- pletFields @'["_0", "_1"] ub
|
||||||
mkRecordConstr PProposalTime $
|
mkRecordConstr PProposalTime $
|
||||||
#lowerBound
|
#lowerBound
|
||||||
.= pdata
|
.= pmatch
|
||||||
( pmatch lbf._0 $
|
lbf._0
|
||||||
\case
|
( \case
|
||||||
PFinite d -> pcon (PDJust d)
|
PFinite ((pfield @"_0" #) -> d) -> d
|
||||||
_ -> pcon (PDNothing pdnil)
|
_ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time."
|
||||||
)
|
)
|
||||||
.& #upperBound
|
.& #upperBound
|
||||||
.= pdata
|
.= pmatch
|
||||||
( pmatch ubf._0 $ \case
|
ubf._0
|
||||||
PFinite d -> pcon (PDJust d)
|
( \case
|
||||||
_ -> pcon (PDNothing pdnil)
|
PFinite ((pfield @"_0" #) -> d) -> d
|
||||||
|
_ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time."
|
||||||
)
|
)
|
||||||
|
|
||||||
-- | Check if 'PProposalTime' is within two 'PPOSIXTime'. Inclusive.
|
-- | Check if 'PProposalTime' is within two 'PPOSIXTime'. Inclusive.
|
||||||
|
|
@ -193,12 +197,8 @@ proposalTimeWithin = phoistAcyclic $
|
||||||
ptf <- pletFields @'["lowerBound", "upperBound"] proposalTime
|
ptf <- pletFields @'["lowerBound", "upperBound"] proposalTime
|
||||||
foldr1
|
foldr1
|
||||||
(#&&)
|
(#&&)
|
||||||
[ pmatch ptf.lowerBound $ \case
|
[ l #<= pfromData ptf.lowerBound
|
||||||
PDJust lb -> l #<= pfromData (pfield @"_0" # lb)
|
, pfromData ptf.upperBound #<= h
|
||||||
_ -> pcon PFalse
|
|
||||||
, pmatch ptf.upperBound $ \case
|
|
||||||
PDJust lb -> pfromData (pfield @"_0" # lb) #<= h
|
|
||||||
_ -> pcon PFalse
|
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | True if the 'PProposalTime' is in the draft period.
|
-- | True if the 'PProposalTime' is in the draft period.
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue