Merge pull request #93 from Liqwid-Labs/connor/proposal-timing-conf

Proposal Timings

agora-sample/Sample/Effect/GovernorMutation.hs

@@ -11,14 +11,22 @@ module Sample.Effect.GovernorMutation (
   mkEffectDatum,
 ) where
 
+--------------------------------------------------------------------------------
+
 import Agora.Effect.GovernorMutation (
   MutateGovernorDatum (..),
   mutateGovernorValidator,
  )
 import Agora.Governor (GovernorDatum (..))
 import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
+
+--------------------------------------------------------------------------------
+
 import Plutarch.Api.V1 (mkValidator, validatorHash)
 import Plutarch.SafeMoney (Tagged (Tagged))
+
+--------------------------------------------------------------------------------
+
 import Plutus.V1.Ledger.Address (scriptHashAddress)
 import Plutus.V1.Ledger.Api (
   Address,
@@ -35,6 +43,9 @@ import Plutus.V1.Ledger.Api (
 import Plutus.V1.Ledger.Api qualified as Interval
 import Plutus.V1.Ledger.Value (AssetClass, assetClass)
 import Plutus.V1.Ledger.Value qualified as Value
+
+--------------------------------------------------------------------------------
+
 import Sample.Shared (
   authorityTokenSymbol,
   defaultProposalThresholds,
@@ -46,6 +57,12 @@ import Sample.Shared (
  )
 import Test.Util (datumPair, toDatumHash)
 
+--------------------------------------------------------------------------------
+
+import Data.Default.Class (Default (def))
+
+--------------------------------------------------------------------------------
+
 -- | The effect validator instance.
 effectValidator :: Validator
 effectValidator = mkValidator $ mutateGovernorValidator governor
@@ -101,6 +118,8 @@ mkEffectTxInfo newGovDatum =
         GovernorDatum
           { proposalThresholds = defaultProposalThresholds
           , nextProposalId = ProposalId 0
+          , proposalTimings = def
+          , createProposalTimeRangeMaxWidth = def
           }
       governorInputDatum :: Datum
       governorInputDatum = Datum $ toBuiltinData governorInputDatum'
@@ -161,6 +180,8 @@ validNewGovernorDatum =
   GovernorDatum
     { proposalThresholds = defaultProposalThresholds
     , nextProposalId = ProposalId 42
+    , proposalTimings = def
+    , createProposalTimeRangeMaxWidth = def
     }
 
 invalidNewGovernorDatum :: GovernorDatum
@@ -171,4 +192,6 @@ invalidNewGovernorDatum =
           { countVoting = Tagged (-1)
           }
     , nextProposalId = ProposalId 42
+    , proposalTimings = def
+    , createProposalTimeRangeMaxWidth = def
     }

agora-sample/Sample/Governor.hs

@@ -56,6 +56,10 @@ import Agora.Proposal (
   emptyVotesFor,
  )
 import Agora.Proposal qualified as P
+import Agora.Proposal.Time (
+  ProposalStartingTime (ProposalStartingTime),
+  ProposalTimingConfig (..),
+ )
 import Agora.Stake (
   ProposalLock (..),
   Stake (..),
@@ -73,16 +77,19 @@ import Sample.Shared (
   gstUTXORef,
   minAda,
   proposalPolicySymbol,
-  proposalTimingConfig,
+  proposalStartingTimeFromTimeRange,
   proposalValidatorAddress,
   signer,
   signer2,
   stake,
   stakeAddress,
   stakeAssetClass,
-  tmpProposalStartingTime,
  )
-import Test.Util (datumPair, toDatumHash)
+import Test.Util (closedBoundedInterval, datumPair, toDatumHash)
+
+--------------------------------------------------------------------------------
+
+import Data.Default.Class (Default (def))
 
 --------------------------------------------------------------------------------
 
@@ -114,6 +121,8 @@ mintGST =
         GovernorDatum
           { proposalThresholds = defaultProposalThresholds
           , nextProposalId = ProposalId 0
+          , proposalTimings = def
+          , createProposalTimeRangeMaxWidth = def
           }
       governorOutputDatum :: Datum
       governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
@@ -207,6 +216,8 @@ createProposal =
         GovernorDatum
           { proposalThresholds = defaultProposalThresholds
           , nextProposalId = thisProposalId
+          , proposalTimings = def
+          , createProposalTimeRangeMaxWidth = def
           }
       governorInputDatum :: Datum
       governorInputDatum = Datum $ toBuiltinData governorInputDatum'
@@ -236,8 +247,8 @@ createProposal =
                 , cosigners = [signer]
                 , thresholds = defaultProposalThresholds
                 , votes = emptyVotesFor effects
-                , timingConfig = proposalTimingConfig
+                , timingConfig = def
-                , startingTime = tmpProposalStartingTime
+                , startingTime = proposalStartingTimeFromTimeRange validTimeRange
                 }
           )
       proposalOutput :: TxOut
@@ -298,8 +309,13 @@ createProposal =
           }
 
       ---
+
       ownInputRef :: TxOutRef
       ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1
+
+      ---
+
+      validTimeRange = closedBoundedInterval 10 15
    in ScriptContext
         { scriptContextTxInfo =
             TxInfo
@@ -316,7 +332,7 @@ createProposal =
               , txInfoMint = pst
               , txInfoDCert = []
               , txInfoWdrl = []
-              , txInfoValidRange = Interval.always
+              , txInfoValidRange = validTimeRange
               , txInfoSignatories = [signer]
               , txInfoData =
                   datumPair
@@ -378,6 +394,8 @@ mintGATs =
         GovernorDatum
           { proposalThresholds = defaultProposalThresholds
           , nextProposalId = ProposalId 5
+          , proposalTimings = def
+          , createProposalTimeRangeMaxWidth = def
           }
       governorInputDatum :: Datum
       governorInputDatum = Datum $ toBuiltinData governorInputDatum'
@@ -412,8 +430,8 @@ mintGATs =
           , cosigners = [signer, signer2]
           , thresholds = defaultProposalThresholds
           , votes = proposalVotes
-          , timingConfig = proposalTimingConfig
+          , timingConfig = def
-          , startingTime = tmpProposalStartingTime
+          , startingTime = ProposalStartingTime 10
           }
       proposalInputDatum :: Datum
       proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
@@ -465,6 +483,12 @@ mintGATs =
 
       ownInputRef :: TxOutRef
       ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1
+
+      --
+      validTimeRange =
+        closedBoundedInterval
+          ((def :: ProposalTimingConfig).lockingTime + 11)
+          ((def :: ProposalTimingConfig).executingTime - 11)
    in ScriptContext
         { scriptContextTxInfo =
             TxInfo
@@ -483,7 +507,7 @@ mintGATs =
               , txInfoMint = gat
               , txInfoDCert = []
               , txInfoWdrl = []
-              , txInfoValidRange = Interval.always
+              , txInfoValidRange = validTimeRange
               , txInfoSignatories = [signer, signer2]
               , txInfoData =
                   datumPair
@@ -565,6 +589,8 @@ mutateState =
         GovernorDatum
           { proposalThresholds = defaultProposalThresholds
           , nextProposalId = ProposalId 5
+          , proposalTimings = def
+          , createProposalTimeRangeMaxWidth = def
           }
       governorInputDatum :: Datum
       governorInputDatum = Datum $ toBuiltinData governorInputDatum'

agora-sample/Sample/Proposal.hs

@@ -16,9 +16,14 @@ module Sample.Proposal (
 ) where
 
 --------------------------------------------------------------------------------
+
 import Plutarch.Api.V1 (
   validatorHash,
  )
+import Plutarch.SafeMoney (Tagged (Tagged), untag)
+
+--------------------------------------------------------------------------------
+
 import Plutus.V1.Ledger.Api (
   Address (Address),
   Credential (ScriptCredential),
@@ -33,13 +38,13 @@ import Plutus.V1.Ledger.Api (
   TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
   TxOutRef (TxOutRef),
  )
-import Plutus.V1.Ledger.Interval qualified as Interval
 import Plutus.V1.Ledger.Value qualified as Value
+import PlutusTx.AssocMap qualified as AssocMap
 
 --------------------------------------------------------------------------------
 
 import Agora.Governor (
-  GovernorDatum (GovernorDatum, nextProposalId, proposalThresholds),
+  GovernorDatum (..),
  )
 import Agora.Proposal (
   Proposal (..),
@@ -50,15 +55,20 @@ import Agora.Proposal (
   ResultTag (..),
   emptyVotesFor,
  )
-import Agora.Proposal.Time (ProposalTimingConfig (..))
+import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..))
 import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..))
-import Plutarch.SafeMoney (Tagged (Tagged), untag)
+
-import PlutusTx.AssocMap qualified as AssocMap
+--------------------------------------------------------------------------------
+
 import Sample.Shared
 import Test.Util (closedBoundedInterval, datumPair, toDatumHash, updateMap)
 
 --------------------------------------------------------------------------------
 
+import Data.Default.Class (Default (def))
+
+--------------------------------------------------------------------------------
+
 -- | This script context should be a valid transaction.
 proposalCreation :: ScriptContext
 proposalCreation =
@@ -79,8 +89,8 @@ proposalCreation =
                 , cosigners = [signer]
                 , thresholds = defaultProposalThresholds
                 , votes = emptyVotesFor effects
-                , timingConfig = proposalTimingConfig
+                , timingConfig = def
-                , startingTime = tmpProposalStartingTime
+                , startingTime = proposalStartingTimeFromTimeRange validTimeRange
                 }
           )
 
@@ -91,6 +101,8 @@ proposalCreation =
               GovernorDatum
                 { proposalThresholds = defaultProposalThresholds
                 , nextProposalId = ProposalId 0
+                , proposalTimings = def
+                , createProposalTimeRangeMaxWidth = def
                 }
           )
       govAfter :: Datum
@@ -100,8 +112,12 @@ proposalCreation =
               GovernorDatum
                 { proposalThresholds = defaultProposalThresholds
                 , nextProposalId = ProposalId 1
+                , proposalTimings = def
+                , createProposalTimeRangeMaxWidth = def
                 }
           )
+
+      validTimeRange = closedBoundedInterval 10 15
    in ScriptContext
         { scriptContextTxInfo =
             TxInfo
@@ -138,7 +154,7 @@ proposalCreation =
               , txInfoMint = st
               , txInfoDCert = []
               , txInfoWdrl = []
-              , txInfoValidRange = Interval.always
+              , txInfoValidRange = validTimeRange
               , txInfoSignatories = [signer]
               , txInfoData =
                   [ datumPair proposalDatum
@@ -174,8 +190,8 @@ cosignProposal newSigners =
           , cosigners = [signer]
           , thresholds = defaultProposalThresholds
           , votes = emptyVotesFor effects
-          , timingConfig = proposalTimingConfig
+          , timingConfig = def
-          , startingTime = tmpProposalStartingTime
+          , startingTime = ProposalStartingTime 0
           }
       stakeDatum :: StakeDatum
       stakeDatum = StakeDatum (Tagged 50_000_000) signer2 []
@@ -185,7 +201,7 @@ cosignProposal newSigners =
       validTimeRange =
         closedBoundedInterval
           10
-          (proposalTimingConfig.draftTime - 10)
+          ((def :: ProposalTimingConfig).draftTime - 10)
    in TxInfo
         { txInfoInputs =
             [ TxInInfo
@@ -295,8 +311,8 @@ voteOnProposal params =
           , cosigners = [stakeOwner]
           , thresholds = defaultProposalThresholds
           , votes = ProposalVotes initialVotes
-          , timingConfig = proposalTimingConfig
+          , timingConfig = def
-          , startingTime = tmpProposalStartingTime
+          , startingTime = ProposalStartingTime 0
           }
       proposalInputDatum :: Datum
       proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
@@ -384,7 +400,9 @@ voteOnProposal params =
       ---
 
       validTimeRange =
-        closedBoundedInterval (proposalTimingConfig.draftTime + 1) (proposalTimingConfig.votingTime - 1)
+        closedBoundedInterval
+          ((def :: ProposalTimingConfig).draftTime + 1)
+          ((def :: ProposalTimingConfig).votingTime - 1)
    in TxInfo
         { txInfoInputs =
             [ TxInInfo proposalRef proposalInput

agora-sample/Sample/Shared.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 {- |
 Module     : Sample.Shared
 Maintainer : emi@haskell.fyi
@@ -36,8 +38,7 @@ module Sample.Shared (
   proposalPolicySymbol,
   proposalValidatorHash,
   proposalValidatorAddress,
-  proposalTimingConfig,
+  proposalStartingTimeFromTimeRange,
-  tmpProposalStartingTime,
 
   -- ** Authority
   authorityToken,
@@ -77,12 +78,14 @@ import Agora.Proposal (
   ProposalThresholds (..),
  )
 import Agora.Proposal.Time (
-  ProposalStartingTime (..),
+  MaxTimeRangeWidth (..),
+  ProposalStartingTime (ProposalStartingTime),
   ProposalTimingConfig (..),
  )
 import Agora.Stake (Stake (..))
 import Agora.Treasury (treasuryValidator)
 import Agora.Utils (validatorHashToTokenName)
+import Data.Default.Class (Default (..))
 import Plutarch.Api.V1 (
   mintingPolicySymbol,
   mkMintingPolicy,
@@ -95,9 +98,14 @@ import Plutus.V1.Ledger.Api (
   Address (Address),
   Credential (ScriptCredential),
   CurrencySymbol,
+  Extended (..),
+  Interval (..),
+  LowerBound (..),
   MintingPolicy (..),
+  POSIXTimeRange,
   PubKeyHash,
   TxOutRef (TxOutRef),
+  UpperBound (..),
   Value,
  )
 import Plutus.V1.Ledger.Contexts (
@@ -190,21 +198,32 @@ authorityToken = authorityTokenFromGovernor governor
 authorityTokenSymbol :: CurrencySymbol
 authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
 
-proposalTimingConfig :: ProposalTimingConfig
+{- | Default value of 'Agora.Governor.GovernorDatum.proposalTimings'.
-proposalTimingConfig =
+     For testing purpose only.
-  ProposalTimingConfig
-    { draftTime = 50
-    , votingTime = 1000
-    , lockingTime = 2000
-    , executingTime = 3000
-    }
-
-{- | Hard coded starting time of every propoal.
-    This will be calculated by the governor in the future.
-    FIXME: Remove this.
 -}
-tmpProposalStartingTime :: ProposalStartingTime
+instance Default ProposalTimingConfig where
-tmpProposalStartingTime = ProposalStartingTime 0
+  def =
+    ProposalTimingConfig
+      { draftTime = 50
+      , votingTime = 1000
+      , lockingTime = 2000
+      , executingTime = 3000
+      }
+
+{- | Default value of 'Agora.Governor.GovernorDatum.createProposalTimeRangeMaxWidth'.
+     For testing purpose only.
+-}
+instance Default MaxTimeRangeWidth where
+  def = MaxTimeRangeWidth 10
+
+{- | Get the starting time of a proposal, given a closed finite time range.
+     Tightness of the time range is not checked. See 'Agora.Proposal.Time.createProposalStartingTime'.
+-}
+proposalStartingTimeFromTimeRange :: POSIXTimeRange -> ProposalStartingTime
+proposalStartingTimeFromTimeRange
+  (Interval (LowerBound (Finite l) True) (UpperBound (Finite u) True)) =
+    ProposalStartingTime $ (l + u) `div` 2
+proposalStartingTimeFromTimeRange _ = error "Given time range should be finite and closed"
 
 ------------------------------------------------------------------
 

agora-test/Spec/Effect/GovernorMutation.hs

@@ -4,6 +4,7 @@ import Agora.Effect.GovernorMutation (mutateGovernorValidator)
 import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
 import Agora.Governor.Scripts (governorValidator)
 import Agora.Proposal (ProposalId (..))
+import Data.Default.Class (Default (def))
 import Plutus.V1.Ledger.Api (ScriptContext (ScriptContext), ScriptPurpose (Spending))
 import Sample.Effect.GovernorMutation (
   effectRef,
@@ -27,9 +28,10 @@ tests =
               "governor validator should pass"
               (governorValidator Shared.governor)
               ( GovernorDatum
-                  { proposalThresholds = Shared.defaultProposalThresholds
+                  Shared.defaultProposalThresholds
-                  , nextProposalId = ProposalId 0
+                  (ProposalId 0)
-                  }
+                  def
+                  def
               )
               MutateGovernor
               ( ScriptContext
@@ -48,9 +50,10 @@ tests =
               "governor validator should fail"
               (governorValidator Shared.governor)
               ( GovernorDatum
-                  { proposalThresholds = Shared.defaultProposalThresholds
+                  Shared.defaultProposalThresholds
-                  , nextProposalId = ProposalId 0
+                  (ProposalId 0)
-                  }
+                  def
+                  def
               )
               MutateGovernor
               ( ScriptContext

agora-test/Spec/Governor.hs

@@ -16,6 +16,7 @@ module Spec.Governor (tests) where
 import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..))
 import Agora.Governor.Scripts (governorPolicy, governorValidator)
 import Agora.Proposal (ProposalId (..))
+import Data.Default.Class (Default (def))
 import Sample.Governor (createProposal, mintGATs, mintGST, mutateState)
 import Sample.Shared qualified as Shared
 import Test.Tasty (TestTree, testGroup)
@@ -38,19 +39,34 @@ tests =
       [ validatorSucceedsWith
           "proposal creation"
           (governorValidator Shared.governor)
-          (GovernorDatum Shared.defaultProposalThresholds (ProposalId 0))
+          ( GovernorDatum
+              Shared.defaultProposalThresholds
+              (ProposalId 0)
+              def
+              def
+          )
           CreateProposal
           createProposal
       , validatorSucceedsWith
           "GATs minting"
           (governorValidator Shared.governor)
-          (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5))
+          ( GovernorDatum
+              Shared.defaultProposalThresholds
+              (ProposalId 5)
+              def
+              def
+          )
           MintGATs
           mintGATs
       , validatorSucceedsWith
           "mutate governor state"
           (governorValidator Shared.governor)
-          (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5))
+          ( GovernorDatum
+              Shared.defaultProposalThresholds
+              (ProposalId 5)
+              def
+              def
+          )
           MutateGovernor
           mutateState
       ]

agora-test/Spec/Proposal.hs

@@ -31,12 +31,14 @@ import Agora.Proposal.Scripts (
   proposalPolicy,
   proposalValidator,
  )
+import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime))
 import Agora.Stake (
   ProposalLock (ProposalLock),
   StakeDatum (StakeDatum),
   StakeRedeemer (PermitVote, WitnessStake),
  )
 import Agora.Stake.Scripts (stakeValidator)
+import Data.Default.Class (Default (def))
 import Plutarch.SafeMoney (Tagged (Tagged))
 import Plutus.V1.Ledger.Api (ScriptContext (..), ScriptPurpose (..))
 import PlutusTx.AssocMap qualified as AssocMap
@@ -82,8 +84,8 @@ tests =
                           [ (ResultTag 0, AssocMap.empty)
                           , (ResultTag 1, AssocMap.empty)
                           ]
-                  , timingConfig = Shared.proposalTimingConfig
+                  , timingConfig = def
-                  , startingTime = Shared.tmpProposalStartingTime
+                  , startingTime = ProposalStartingTime 0
                   }
               )
               (Cosign [signer2])
@@ -117,8 +119,8 @@ tests =
                             , (ResultTag 1, 4242)
                             ]
                         )
-                  , timingConfig = Shared.proposalTimingConfig
+                  , timingConfig = def
-                  , startingTime = Shared.tmpProposalStartingTime
+                  , startingTime = ProposalStartingTime 0
                   }
               )
               (Vote (ResultTag 0))

agora.cabal

@@ -114,6 +114,7 @@ common test-deps
     , agora
     , apropos
     , apropos-tx
+    , data-default-class
     , mtl
     , QuickCheck
     , quickcheck-instances
@@ -141,22 +142,20 @@ library
     Agora.Proposal.Time
     Agora.Record
     Agora.SafeMoney
+    Agora.ScriptInfo
     Agora.Stake
     Agora.Stake.Scripts
     Agora.Treasury
     Agora.Utils
     Agora.Utils.Value
-    Agora.ScriptInfo
 
-  other-modules:
+  other-modules:   Agora.Aeson.Orphans
-    Agora.Aeson.Orphans
   hs-source-dirs:  agora
 
 library pprelude
   default-language: Haskell2010
   exposed-modules:  PPrelude
   hs-source-dirs:   agora
-
   build-depends:
     , base
     , plutarch
@@ -176,8 +175,8 @@ library agora-sample
     Sample.Shared
     Sample.Stake
     Sample.Treasury
-  hs-source-dirs:  agora-sample
 
+  hs-source-dirs:  agora-sample
   build-depends:   agora-testlib
 
 test-suite agora-test
@@ -214,8 +213,7 @@ executable agora-scripts
   import:         lang, deps, exe-opts
   main-is:        Scripts.hs
   hs-source-dirs: agora-scripts
-  other-modules:
+  other-modules:  Options
-    Options
   build-depends:
     , agora
     , optparse-applicative

agora/Agora/Governor.hs

@@ -37,6 +37,12 @@ import Agora.Proposal (
   ProposalId (ProposalId),
   ProposalThresholds,
  )
+import Agora.Proposal.Time (
+  MaxTimeRangeWidth,
+  PMaxTimeRangeWidth,
+  PProposalTimingConfig,
+  ProposalTimingConfig,
+ )
 import Agora.SafeMoney (GTTag)
 import Agora.Utils (tclet)
 
@@ -66,6 +72,11 @@ data GovernorDatum = GovernorDatum
   -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'.
   , nextProposalId :: ProposalId
   -- ^ What tag the next proposal will get upon creating.
+  , proposalTimings :: ProposalTimingConfig
+  -- ^ The timing configuration for proposals.
+  --   Will get copied over upon the creation of proposals.
+  , createProposalTimeRangeMaxWidth :: MaxTimeRangeWidth
+  -- ^ The maximum valid duration of a transaction that creats a proposal.
   }
   deriving stock (Show, GHC.Generic)
 
@@ -118,6 +129,8 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
       ( PDataRecord
           '[ "proposalThresholds" ':= PProposalThresholds
            , "nextProposalId" ':= PProposalId
+           , "proposalTimings" ':= PProposalTimingConfig
+           , "createProposalTimeRangeMaxWidth" ':= PMaxTimeRangeWidth
            ]
       )
   }

agora/Agora/Governor/Scripts.hs

@@ -51,12 +51,14 @@ import Agora.Proposal (
   PResultTag,
   Proposal (..),
   ProposalStatus (Draft, Locked),
+  pemptyVotesFor,
   proposalDatumValid,
  )
 import Agora.Proposal.Scripts (
   proposalPolicy,
   proposalValidator,
  )
+import Agora.Proposal.Time (createProposalStartingTime)
 import Agora.Record
 import Agora.SafeMoney (GTTag)
 import Agora.Stake (
@@ -126,7 +128,6 @@ import Plutarch.TryFrom (ptryFrom)
 
 --------------------------------------------------------------------------------
 
-import Agora.Proposal.Time (ProposalStartingTime (..), ProposalTimingConfig (..))
 import Plutus.V1.Ledger.Api (
   CurrencySymbol (..),
   MintingPolicy,
@@ -172,7 +173,7 @@ governorPolicy gov =
     let ownAssetClass = passetClass # ownSymbol # pconstant ""
         txInfo = pfromData $ pfield @"txInfo" # ctx'
 
-    txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums"] txInfo
+    txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums", "validRange"] txInfo
 
     tcassert "Referenced utxo should be spent" $
       pisUTXOSpent # oref # txInfoF.inputs
@@ -288,7 +289,7 @@ governorValidator gov =
     ctxF <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
 
     txInfo' <- tclet $ pfromData $ ctxF.txInfo
-    txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo'
+    txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums", "signatories", "validRange"] txInfo'
 
     PSpending (pfromData . (pfield @"_0" #) -> ownInputRef) <- tcmatch $ pfromData ctxF.purpose
 
@@ -300,7 +301,15 @@ governorValidator gov =
     let ownAddress = pfromData $ ownInputF.address
 
     (pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- tcont $ ptryFrom datum'
-    oldGovernorDatumF <- tcont $ pletFields @'["proposalThresholds", "nextProposalId"] oldGovernorDatum
+    oldGovernorDatumF <-
+      tcont $
+        pletFields
+          @'[ "proposalThresholds"
+            , "nextProposalId"
+            , "proposalTimings"
+            , "createProposalTimeRangeMaxWidth"
+            ]
+          oldGovernorDatum
 
     -- Check that GST will be returned to the governor.
     let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value
@@ -337,6 +346,9 @@ governorValidator gov =
                   PGovernorDatum
                   ( #proposalThresholds .= oldGovernorDatumF.proposalThresholds
                       .& #nextProposalId .= pdata expectedNextProposalId
+                      .& #proposalTimings .= oldGovernorDatumF.proposalTimings
+                      .& #createProposalTimeRangeMaxWidth
+                        .= oldGovernorDatumF.createProposalTimeRangeMaxWidth
                   )
           tcassert "Unexpected governor state datum" $
             newGovernorDatum #== expectedNewDatum
@@ -402,9 +414,6 @@ governorValidator gov =
 
           outputDatumHash <- tclet $ pfield @"datumHash" #$ phead # outputsToProposalValidatorWithStateToken
 
-          tcassert "The utxo paid to the proposal validator must have datum" $
-            pisDJust # outputDatumHash
-
           proposalOutputDatum' <-
             tclet $
               mustFindDatum' @PProposalDatum
@@ -417,23 +426,34 @@ governorValidator gov =
           proposalOutputDatum <-
             tcont $
               pletFields
-                @'["proposalId", "status", "cosigners", "thresholds", "votes"]
+                @'["effects", "cosigners", "proposalId", "votes"]
                 proposalOutputDatum'
 
-          -- Id and thresholds should be copied from the old governor state datum.
-          tcassert "Invalid proposal id in proposal datum" $
-            proposalOutputDatum.proposalId #== oldGovernorDatumF.nextProposalId
-
-          tcassert "Invalid thresholds in proposal datum" $
-            proposalOutputDatum.thresholds #== oldGovernorDatumF.proposalThresholds
-
-          -- The proposal at this point should be in draft state.
-          tcassert "Proposal state should be draft" $
-            proposalOutputDatum.status #== pconstantData Draft
-
           tcassert "Proposal should have only one cosigner" $
             plength # pfromData proposalOutputDatum.cosigners #== 1
 
+          let -- Votes should be empty at this point
+              expectedVotes = pemptyVotesFor # pfromData proposalOutputDatum.effects
+              expectedStartingTime =
+                createProposalStartingTime
+                  # oldGovernorDatumF.createProposalTimeRangeMaxWidth
+                  # txInfoF.validRange
+              -- Id, thresholds and timings should be copied from the old governor state datum.
+              expectedProposalOut =
+                mkRecordConstr
+                  PProposalDatum
+                  ( #proposalId .= oldGovernorDatumF.nextProposalId
+                      .& #effects .= proposalOutputDatum.effects
+                      .& #status .= pconstantData Draft
+                      .& #cosigners .= proposalOutputDatum.cosigners
+                      .& #thresholds .= oldGovernorDatumF.proposalThresholds
+                      .& #votes .= pdata expectedVotes
+                      .& #timingConfig .= oldGovernorDatumF.proposalTimings
+                      .& #startingTime .= pdata expectedStartingTime
+                  )
+
+          tcassert "Datum correct" $ expectedProposalOut #== proposalOutputDatum'
+
           let cosigner = phead # pfromData proposalOutputDatum.cosigners
 
           tcassert "Cosigner should be the stake owner" $
@@ -560,7 +580,7 @@ governorValidator gov =
 
           proposalInputDatumF <-
             tcont $
-              pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes"]
+              pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes", "timingConfig", "startingTime"]
                 proposalInputDatum
 
           -- Check that the proposal state is advanced so that a proposal cannot be executed twice.
@@ -577,10 +597,8 @@ governorValidator gov =
                       .& #cosigners .= proposalInputDatumF.cosigners
                       .& #thresholds .= proposalInputDatumF.thresholds
                       .& #votes .= proposalInputDatumF.votes
-                      -- FIXME: copy from the governor datum
+                      .& #timingConfig .= proposalInputDatumF.timingConfig
-                      .& #timingConfig .= pdata (pconstant tmpTimingConfig)
+                      .& #startingTime .= proposalInputDatumF.startingTime
-                      -- FIXME: calculate from 'txInfoValidRange'
-                      .& #startingTime .= pdata (pconstant tmpProposalStartingTime)
                   )
 
           tcassert "Unexpected output proposal datum" $
@@ -732,20 +750,6 @@ governorValidator gov =
       let sym = governorSTSymbolFromGovernor gov
        in phoistAcyclic $ pconstant sym
 
-    -- TODO: remove this. This is temperary.
-    tmpTimingConfig :: ProposalTimingConfig
-    tmpTimingConfig =
-      ProposalTimingConfig
-        { draftTime = 50
-        , votingTime = 1000
-        , lockingTime = 2000
-        , executingTime = 3000
-        }
-
-    -- TODO: remove this.
-    tmpProposalStartingTime :: ProposalStartingTime
-    tmpProposalStartingTime = ProposalStartingTime 0
-
 --------------------------------------------------------------------------------
 
 -- | Get the 'CurrencySymbol' of GST.

agora/Agora/Proposal.hs

@@ -30,6 +30,7 @@ module Agora.Proposal (
 
   -- * Plutarch helpers
   proposalDatumValid,
+  pemptyVotesFor,
 ) where
 
 import GHC.Generics qualified as GHC
@@ -47,7 +48,7 @@ import PlutusTx.AssocMap qualified as AssocMap
 
 import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, ProposalStartingTime, ProposalTimingConfig)
 import Agora.SafeMoney (GTTag)
-import Agora.Utils (pkeysEqual, pnotNull)
+import Agora.Utils (pkeysEqual, pmapMap, pnotNull)
 import Control.Applicative (Const)
 import Control.Arrow (first)
 import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..))
@@ -348,6 +349,16 @@ deriving via
   instance
     (PConstantDecl ProposalVotes)
 
+-- Plutarch-level version of 'emptyVotesFor'.
+pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap PResultTag a :--> PProposalVotes)
+pemptyVotesFor =
+  phoistAcyclic $
+    plam
+      ( \m ->
+          pcon $
+            PProposalVotes $ pmapMap # plam (const $ pconstant 0) # m
+      )
+
 -- | Plutarch-level version of 'ProposalDatum'.
 newtype PProposalDatum (s :: S) = PProposalDatum
   { getProposalDatum ::

agora/Agora/Proposal/Time.hs

@@ -10,16 +10,18 @@ Time functions for proposal phases.
 -}
 module Agora.Proposal.Time (
   -- * Haskell-land
-  ProposalTime (..),
   ProposalTimingConfig (..),
   ProposalStartingTime (..),
+  MaxTimeRangeWidth (..),
 
   -- * Plutarch-land
   PProposalTime (..),
   PProposalTimingConfig (..),
   PProposalStartingTime (..),
+  PMaxTimeRangeWidth (..),
 
   -- * Compute periods given config and starting time.
+  createProposalStartingTime,
   currentProposalTime,
   isDraftPeriod,
   isVotingPeriod,
@@ -27,10 +29,9 @@ module Agora.Proposal.Time (
   isExecutionPeriod,
 ) where
 
-import Agora.Record (mkRecordConstr, (.&), (.=))
+import Agora.Utils (tcassert, tcmatch)
-import Agora.Utils (tcmatch)
 import GHC.Generics qualified as GHC
-import Generics.SOP (Generic, I (I))
+import Generics.SOP (Generic, HasDatatypeInfo, I (I))
 import Plutarch.Api.V1 (
   PExtended (PFinite),
   PInterval (PInterval),
@@ -39,7 +40,11 @@ import Plutarch.Api.V1 (
   PPOSIXTimeRange,
   PUpperBound (PUpperBound),
  )
-import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..))
+import Plutarch.DataRepr (
+  DerivePConstantViaData (..),
+  PDataFields,
+  PIsDataReprInstances (..),
+ )
 import Plutarch.Lift (
   DerivePConstantViaNewtype (..),
   PConstantDecl,
@@ -53,35 +58,6 @@ import Prelude hiding ((+))
 
 --------------------------------------------------------------------------------
 
-{- | == 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 was 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.txInfoValidPeriod' field
-   of 'Plutus.V1.Ledger.Api.TxInfo'.
-
-   We avoid 'PPOSIXTimeRange' where we can in order to save on operations.
--}
-data ProposalTime = ProposalTime
-  { lowerBound :: POSIXTime
-  , upperBound :: POSIXTime
-  }
-  deriving stock (Eq, Show, GHC.Generic)
-
-PlutusTx.makeIsDataIndexed ''ProposalTime [('ProposalTime, 0)]
-
 -- | Represents the starting time of the proposal.
 newtype ProposalStartingTime = ProposalStartingTime
   { getProposalStartingTime :: POSIXTime
@@ -107,32 +83,40 @@ data ProposalTimingConfig = ProposalTimingConfig
 
 PlutusTx.makeIsDataIndexed ''ProposalTimingConfig [('ProposalTimingConfig, 0)]
 
+-- | Represents the maximum width of a 'POSIXTimeRange'.
+newtype MaxTimeRangeWidth = MaxTimeRangeWidth {getMaxWidth :: POSIXTime}
+  deriving stock (Eq, Show, Ord, GHC.Generic)
+  deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
+
 --------------------------------------------------------------------------------
 
--- | Plutarch-level version of 'ProposalTime'.
+{- | == Establishing timing in Proposal interactions.
-newtype PProposalTime (s :: S)
-  = PProposalTime
-      ( Term
-          s
-          ( PDataRecord
-              '[ "lowerBound" ':= PPOSIXTime
-               , "upperBound" ':= PPOSIXTime
-               ]
-          )
-      )
-  deriving stock (GHC.Generic)
-  deriving anyclass (Generic)
-  deriving anyclass (PIsDataRepr)
-  deriving
-    (PlutusType, PIsData, PDataFields)
-    via (PIsDataReprInstances PProposalTime)
 
-instance PUnsafeLiftDecl PProposalTime where
+   In Plutus, it's impossible to determine time exactly. It's also impossible
-  type PLifted PProposalTime = ProposalTime
+   to get a single point in time, yet often we need to check
-deriving via
+   various constraints on time.
-  (DerivePConstantViaData ProposalTime PProposalTime)
+
-  instance
+   For the purposes of proposals, there's a single most important feature:
-    (PConstantDecl ProposalTime)
+   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 was 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.txInfoValidPeriod' field
+   of 'Plutus.V1.Ledger.Api.TxInfo'.
+
+   We avoid 'PPOSIXTimeRange' where we can in order to save on operations.
+-}
+data PProposalTime (s :: S) = PProposalTime
+  { lowerBound :: Term s PPOSIXTime
+  , upperBound :: Term s PPOSIXTime
+  }
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic, PlutusType, HasDatatypeInfo, PEq)
 
 -- | Plutarch-level version of 'ProposalStartingTime'.
 newtype PProposalStartingTime (s :: S) = PProposalStartingTime (Term s PPOSIXTime)
@@ -172,12 +156,45 @@ deriving via
   instance
     (PConstantDecl ProposalTimingConfig)
 
+-- | Plutarch-level version of 'MaxTimeRangeWidth'.
+newtype PMaxTimeRangeWidth (s :: S)
+  = PMaxTimeRangeWidth (Term s PPOSIXTime)
+  deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PMaxTimeRangeWidth PPOSIXTime)
+
+instance PUnsafeLiftDecl PMaxTimeRangeWidth where type PLifted PMaxTimeRangeWidth = MaxTimeRangeWidth
+deriving via
+  (DerivePConstantViaNewtype MaxTimeRangeWidth PMaxTimeRangeWidth PPOSIXTime)
+  instance
+    (PConstantDecl MaxTimeRangeWidth)
+
 --------------------------------------------------------------------------------
 
 -- FIXME: Orphan instance, move this to plutarch-extra.
 instance AdditiveSemigroup (Term s PPOSIXTime) where
   (punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y
 
+{- | Get the starting time of a proposal, from the 'Plutus.V1.Ledger.Api.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.
+-}
+createProposalStartingTime :: forall (s :: S). Term s (PMaxTimeRangeWidth :--> PPOSIXTimeRange :--> PProposalStartingTime)
+createProposalStartingTime = phoistAcyclic $
+  plam $ \(pto -> maxDuration) iv -> unTermCont $ do
+    currentTimeF <- tcmatch $ currentProposalTime # iv
+
+    -- Use the middle of the current time range as the starting time.
+    let duration = currentTimeF.upperBound - currentTimeF.lowerBound
+
+        startingTime =
+          pdiv
+            # (currentTimeF.lowerBound + currentTimeF.upperBound)
+            # 2
+
+    tcassert "createProposalStartingTime: given time range should be tight enough" $
+      duration #<= maxDuration
+
+    pure $ pcon $ PProposalStartingTime startingTime
+
 {- | 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
@@ -193,21 +210,23 @@ currentProposalTime = phoistAcyclic $
     lbf <- tcont $ pletFields @'["_0", "_1"] lb
     ubf <- tcont $ pletFields @'["_0", "_1"] ub
     pure $
-      mkRecordConstr PProposalTime $
+      pcon $
-        #lowerBound
+        PProposalTime
-          .= pmatch
+          { lowerBound =
-            lbf._0
+              pmatch
-            ( \case
+                lbf._0
-                PFinite ((pfield @"_0" #) -> d) -> d
+                ( \case
-                _ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time."
+                    PFinite ((pfield @"_0" #) -> d) -> d
-            )
+                    _ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time."
-          .& #upperBound
+                )
-          .= pmatch
+          , upperBound =
-            ubf._0
+              pmatch
-            ( \case
+                ubf._0
-                PFinite ((pfield @"_0" #) -> d) -> d
+                ( \case
-                _ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time."
+                    PFinite ((pfield @"_0" #) -> d) -> d
-            )
+                    _ -> ptraceError "currentProposalTime: Can't get fully-bounded proposal time."
+                )
+          }
 
 -- | Check if 'PProposalTime' is within two 'PPOSIXTime'. Inclusive.
 proposalTimeWithin ::
@@ -220,13 +239,12 @@ proposalTimeWithin ::
     )
 proposalTimeWithin = phoistAcyclic $
   plam $ \l h proposalTime' -> unTermCont $ do
-    PProposalTime proposalTime <- tcmatch proposalTime'
+    PProposalTime ut lt <- tcmatch proposalTime'
-    ptf <- tcont $ pletFields @'["lowerBound", "upperBound"] proposalTime
     pure $
       foldr1
         (#&&)
-        [ l #<= pfromData ptf.lowerBound
+        [ l #<= lt
-        , pfromData ptf.upperBound #<= h
+        , ut #<= h
         ]
 
 -- | True if the 'PProposalTime' is in the draft period.

agora/Agora/Utils.hs

@@ -41,6 +41,7 @@ module Agora.Utils (
   pmsort,
   pnubSort,
   pupdate,
+  pmapMap,
   pmapMaybe,
 
   -- * Functions which should (probably) not be upstreamed
@@ -322,6 +323,23 @@ pupdate = phoistAcyclic $
             )
           # ps
 
+-- | / O(n) /. Map a function over all values in a 'PMap'.
+pmapMap :: forall s k a b. (PIsData k, PIsData a, PIsData b) => Term s ((a :--> b) :--> PMap k a :--> PMap k b)
+pmapMap = phoistAcyclic $
+  plam $ \f (pto -> (ps :: Term _ (PBuiltinList _))) ->
+    pcon $
+      PMap $
+        pmap
+          # plam
+            ( \kv ->
+                let k = pfstBuiltin # kv
+                    v = psndBuiltin # kv
+
+                    nv = pdata $ f # pfromData v
+                 in ppairDataBuiltin # k # nv
+            )
+          # ps
+
 -- | Add two 'PValue's together.
 paddValue :: forall s. Term s (PValue :--> PValue :--> PValue)
 paddValue = phoistAcyclic $