From e5dc29f98bb54bd307f86c193aaa9e41834151e7 Mon Sep 17 00:00:00 2001
From: Hongrui Fang <chfanghr@gmail.com>
Date: Tue, 6 Sep 2022 21:45:30 +0800
Subject: [PATCH] make use of LPE's time module

---
 agora/Agora/Governor/Scripts.hs |  18 +++---
 agora/Agora/Proposal/Time.hs    | 111 ++++++++++++--------------------
 agora/Agora/Utils.hs            |  17 ++++-
 3 files changed, 64 insertions(+), 82 deletions(-)

diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs
index 9ffcca3..28198d2 100644
--- a/agora/Agora/Governor/Scripts.hs
+++ b/agora/Agora/Governor/Scripts.hs
@@ -36,7 +36,7 @@ import Agora.Proposal (
   pneutralOption,
   pwinner,
  )
-import Agora.Proposal.Time (createProposalStartingTime)
+import Agora.Proposal.Time (validateProposalStartingTime)
 import Agora.Scripts (
   AgoraScripts,
   authorityTokenSymbol,
@@ -74,7 +74,7 @@ import Plutarch.Extra.AssetClass (passetClass, passetClassValueOf)
 import Plutarch.Extra.Field (pletAllC)
 import Plutarch.Extra.List (pfirstJust)
 import Plutarch.Extra.Map (ptryLookup)
-import Plutarch.Extra.Maybe (passertPJust, pfromJust, pmaybeData, pnothing)
+import Plutarch.Extra.Maybe (passertPJust, pmaybeData, pnothing)
 import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
 import Plutarch.Extra.ScriptContext (
   pfindOutputsToAddress,
@@ -367,12 +367,7 @@ governorValidator as =
 
           proposalOutputDatum <- pletAllC $ pto $ pfromData proposalOutputDatum'
 
-          let expectedStartingTime =
-                pfromJust #$ createProposalStartingTime
-                  # oldGovernorDatumF.createProposalTimeRangeMaxWidth
-                  # txInfoF.validRange
-
-              expectedCosigners = psingleton @PBuiltinList # stakeInputDatumF.owner
+          let expectedCosigners = psingleton @PBuiltinList # stakeInputDatumF.owner
 
           pguardC "Proposal datum correct" $
             foldl1
@@ -389,8 +384,11 @@ governorValidator as =
                   proposalOutputDatum.status #== pconstantData Draft
               , ptraceIfFalse "cosigners correct" $
                   plistEquals # pfromData proposalOutputDatum.cosigners # expectedCosigners
-              , ptraceIfFalse "starting time correct" $
-                  proposalOutputDatum.startingTime #== expectedStartingTime
+              , ptraceIfFalse "starting time valid" $
+                  validateProposalStartingTime
+                    # oldGovernorDatumF.createProposalTimeRangeMaxWidth
+                    # txInfoF.validRange
+                    # proposalOutputDatum.startingTime
               , ptraceIfFalse "copy over configurations" $
                   proposalOutputDatum.thresholds #== oldGovernorDatumF.proposalThresholds
                     #&& proposalOutputDatum.timingConfig #== oldGovernorDatumF.proposalTimings
diff --git a/agora/Agora/Proposal/Time.hs b/agora/Agora/Proposal/Time.hs
index eda80ed..90074c4 100644
--- a/agora/Agora/Proposal/Time.hs
+++ b/agora/Agora/Proposal/Time.hs
@@ -14,13 +14,13 @@ module Agora.Proposal.Time (
   MaxTimeRangeWidth (..),
 
   -- * Plutarch-land
-  PProposalTime (..),
+  PProposalTime,
   PProposalTimingConfig (..),
   PProposalStartingTime (..),
   PMaxTimeRangeWidth (..),
 
   -- * Compute periods given config and starting time.
-  createProposalStartingTime,
+  validateProposalStartingTime,
   currentProposalTime,
   isDraftPeriod,
   isVotingPeriod,
@@ -30,6 +30,7 @@ module Agora.Proposal.Time (
   pisMaxTimeRangeWidthValid,
 ) where
 
+import Agora.Utils (pcurrentTimeDuration)
 import Control.Composition ((.*))
 import Plutarch.Api.V1 (
   PExtended (PFinite),
@@ -44,10 +45,14 @@ import Plutarch.DataRepr (
   PDataFields,
  )
 import Plutarch.Extra.Applicative (PApply (pliftA2))
-import Plutarch.Extra.Bind ((#>>=))
 import Plutarch.Extra.Field (pletAll, pletAllC)
-import Plutarch.Extra.Maybe (pjust, pnothing)
+import Plutarch.Extra.Maybe (pjust, pmaybe, pnothing)
 import Plutarch.Extra.TermCont (pmatchC)
+import Plutarch.Extra.Time (
+  PCurrentTime (PCurrentTime),
+  pisCurrentTimeWithin,
+  pisWithinCurrentTime,
+ )
 import Plutarch.Lift (
   DerivePConstantViaNewtype (DerivePConstantViaNewtype),
   PConstantDecl,
@@ -160,23 +165,7 @@ newtype MaxTimeRangeWidth = MaxTimeRangeWidth {getMaxWidth :: POSIXTime}
 
      @since 0.1.0
 -}
-data PProposalTime (s :: S) = PProposalTime
-  { lowerBound :: Term s PPOSIXTime
-  , upperBound :: Term s PPOSIXTime
-  }
-  deriving stock
-    ( -- | @since 0.1.0
-      Generic
-    )
-  deriving anyclass
-    ( -- | @since 0.1.0
-      PlutusType
-    , -- | @since 0.1.0
-      PEq
-    )
-
-instance DerivePlutusType PProposalTime where
-  type DPTStrat _ = PlutusTypeScott
+type PProposalTime = PCurrentTime
 
 -- | Plutarch-level version of 'ProposalStartingTime'.
 newtype PProposalStartingTime (s :: S) = PProposalStartingTime (Term s PPOSIXTime)
@@ -327,38 +316,41 @@ pisMaxTimeRangeWidthValid =
       ptraceIfFalse "greater than 0"
         . (pconstant (MaxTimeRangeWidth 0) #<)
 
-{- | Get the starting time of a proposal, from the 'PlutusLedgerApi.V1.txInfoValidPeriod' field.
+{- | Validate starting time of a proposal, from the 'PlutusLedgerApi.V1.txInfoValidPeriod' field.
      For every proposal, this is only meant to run once upon creation. Given time range should be
      tight enough, meaning that the width of the time range should be less than the maximum value.
 
-     @since 0.1.0
+     @since 1.0.0
 -}
-createProposalStartingTime ::
+validateProposalStartingTime ::
   forall (s :: S).
   Term
     s
     ( PMaxTimeRangeWidth
         :--> PPOSIXTimeRange
-        :--> PMaybe PProposalStartingTime
+        :--> PProposalStartingTime
+        :--> PBool
     )
-createProposalStartingTime = phoistAcyclic $
-  plam $ \(pto -> maxDuration) iv ->
-    let ct = currentProposalTime # iv
-
-        f :: Term _ (PProposalTime :--> PMaybe PProposalStartingTime)
-        f = plam $
-          flip pmatch $ \(PProposalTime lb ub) ->
-            let duration = ub - lb
-
-                startingTime = pdiv # (lb + ub) # 2
-             in pif
-                  (duration #<= maxDuration)
-                  (pjust #$ pcon $ PProposalStartingTime startingTime)
-                  ( ptrace
-                      "createProposalStartingTime: given time range should be tight enough"
-                      pnothing
-                  )
-     in ct #>>= f
+validateProposalStartingTime = phoistAcyclic $
+  plam $ \(pto -> maxDuration) iv (pto -> st) ->
+    pmaybe
+      # ptrace
+        "validateProposalStartingTime: unable to get current time"
+        (pconstant False)
+      # plam
+        ( \ct ->
+            let duration = pcurrentTimeDuration # ct
+                isTightEnough =
+                  ptraceIfFalse
+                    "createProposalStartingTime: given time range should be tight enough"
+                    $ duration #<= maxDuration
+                isInCurrentTimeRange =
+                  ptraceIfFalse
+                    "createProposalStartingTime: starting time should be in current time range"
+                    $ pisWithinCurrentTime # st # ct
+             in isTightEnough #&& isInCurrentTimeRange
+        )
+      # (currentProposalTime # iv)
 
 {- | Get the current proposal time, from the 'PlutusLedgerApi.V1.txInfoValidPeriod' field.
 
@@ -389,32 +381,9 @@ currentProposalTime = phoistAcyclic $
         lowerBound = getBound # lb
         upperBound = getBound # ub
 
-        mkTime = phoistAcyclic $ plam $ pcon .* PProposalTime
+        mkTime = phoistAcyclic $ plam $ pcon .* PCurrentTime
     pure $ pliftA2 # mkTime # lowerBound # upperBound
 
-{- | Check if 'PProposalTime' is within two 'PPOSIXTime'. Inclusive.
-
-     @since 0.1.0
--}
-proposalTimeWithin ::
-  forall (s :: S).
-  Term
-    s
-    ( PPOSIXTime
-        :--> PPOSIXTime
-        :--> PProposalTime
-        :--> PBool
-    )
-proposalTimeWithin = phoistAcyclic $
-  plam $ \l h proposalTime' -> unTermCont $ do
-    PProposalTime ut lt <- pmatchC proposalTime'
-    pure $
-      foldr1
-        (#&&)
-        [ l #<= lt
-        , ut #<= h
-        ]
-
 {- | True if the 'PProposalTime' is in the draft period.
 
      @since 0.1.0
@@ -430,7 +399,7 @@ isDraftPeriod ::
     )
 isDraftPeriod = phoistAcyclic $
   plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
-    proposalTimeWithin # s # (s + (pfield @"draftTime" # config))
+    pisCurrentTimeWithin # s # (s + (pfield @"draftTime" # config))
 
 {- | True if the 'PProposalTime' is in the voting period.
 
@@ -448,7 +417,7 @@ isVotingPeriod ::
 isVotingPeriod = phoistAcyclic $
   plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
     pletFields @'["draftTime", "votingTime"] config $ \f ->
-      proposalTimeWithin # s # (s + f.draftTime + f.votingTime)
+      pisCurrentTimeWithin # s # (s + f.draftTime + f.votingTime)
 
 {- | True if the 'PProposalTime' is in the locking period.
 
@@ -466,7 +435,7 @@ isLockingPeriod ::
 isLockingPeriod = phoistAcyclic $
   plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
     pletFields @'["draftTime", "votingTime", "lockingTime"] config $ \f ->
-      proposalTimeWithin # s # (s + f.draftTime + f.votingTime + f.lockingTime)
+      pisCurrentTimeWithin # s # (s + f.draftTime + f.votingTime + f.lockingTime)
 
 {- | True if the 'PProposalTime' is in the execution period.
 
@@ -484,5 +453,5 @@ isExecutionPeriod ::
 isExecutionPeriod = phoistAcyclic $
   plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
     pletFields @'["draftTime", "votingTime", "lockingTime", "executingTime"] config $ \f ->
-      proposalTimeWithin # s
+      pisCurrentTimeWithin # s
         # (s + f.draftTime + f.votingTime + f.lockingTime + f.executingTime)
diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs
index 043508f..70fc3d0 100644
--- a/agora/Agora/Utils.hs
+++ b/agora/Agora/Utils.hs
@@ -21,11 +21,13 @@ module Agora.Utils (
   plistEqualsBy,
   pstringIntercalate,
   punwords,
+  pcurrentTimeDuration,
 ) where
 
-import Plutarch.Api.V1 (PTokenName, PValidatorHash)
+import Plutarch.Api.V1 (PPOSIXTime, PTokenName, PValidatorHash)
 import Plutarch.Api.V2 (PScriptHash)
 import Plutarch.Extra.TermCont (pmatchC)
+import Plutarch.Extra.Time (PCurrentTime (PCurrentTime))
 import Plutarch.List (puncons)
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V2 (
@@ -175,3 +177,16 @@ punwords ::
   [Term s PString] ->
   Term s PString
 punwords = pstringIntercalate " "
+
+-- | @since 1.0.0
+pcurrentTimeDuration ::
+  forall (s :: S).
+  Term
+    s
+    ( PCurrentTime
+        :--> PPOSIXTime
+    )
+pcurrentTimeDuration = phoistAcyclic $
+  plam $
+    flip pmatch $
+      \(PCurrentTime lb ub) -> ub - lb