improve performance of the governor validator

agora-specs/Property/Governor.hs

@@ -62,8 +62,6 @@ data GovernorDatumCases
   = ExecuteLE0
   | CreateLE0
   | VoteLE0
-  | CreateLEVote
-  | ExecuteLVote
   | Correct
   deriving stock (Eq, Show)
 
@@ -72,8 +70,6 @@ instance Universe GovernorDatumCases where
     [ ExecuteLE0
     , CreateLE0
     , VoteLE0
-    , CreateLEVote
-    , ExecuteLVote
     , Correct
     ]
 
@@ -94,8 +90,6 @@ governorDatumValidProperty =
       | e < 0 = ExecuteLE0
       | c < 0 = CreateLE0
       | v < 0 = VoteLE0
-      | c > v = CreateLEVote
-      | v >= e = ExecuteLVote
       | otherwise = Correct
 
     expected :: GovernorDatum -> Maybe Bool
@@ -127,16 +121,6 @@ governorDatumValidProperty =
             VoteLE0 ->
               -- vote < 0
               return $ ProposalThresholds execute create le0
-            CreateLEVote -> do
-              -- c > vote
-              nv <- taggedInteger (0, untag create - 1)
-              ne <- taggedInteger (untag nv + 1, 1000000000)
-              return $ ProposalThresholds ne create nv
-            ExecuteLVote -> do
-              -- vote >= execute
-              ne <- taggedInteger (0, untag vote)
-              nc <- taggedInteger (0, untag vote)
-              return $ ProposalThresholds ne nc vote
             Correct -> do
               -- c <= vote < execute
               nv <- taggedInteger (0, untag execute - 1)

agora-specs/Spec/AuthorityToken.hs

@@ -11,19 +11,18 @@ module Spec.AuthorityToken (specs) where
 
 import Agora.AuthorityToken (singleAuthorityTokenBurned)
 import Plutarch (ClosedTerm, POpaque, compile, perror, popaque)
+import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V1 (
   Address (Address),
   Credential (PubKeyCredential, ScriptCredential),
   CurrencySymbol,
   Script,
   TxInInfo (TxInInfo),
-  TxInfo (..),
   TxOut (TxOut),
   TxOutRef (TxOutRef),
   ValidatorHash (ValidatorHash),
   Value,
  )
-import PlutusLedgerApi.V1.Interval qualified as Interval (always)
 import PlutusLedgerApi.V1.Value qualified as Value (
   Value (Value),
   singleton,
@@ -36,37 +35,25 @@ import Test.Specification (
   scriptSucceeds,
  )
 import Prelude (
-  Functor (fmap),
   Maybe (Nothing),
   PBool,
   Semigroup ((<>)),
+  fmap,
   pconstant,
-  pconstantData,
   pif,
+  ($),
  )
 
 currencySymbol :: CurrencySymbol
 currencySymbol = "deadbeef"
 
-mkTxInfo :: Value -> [TxOut] -> TxInfo
+mkInputs :: [TxOut] -> [TxInInfo]
-mkTxInfo mint outs =
+mkInputs = fmap (TxInInfo (TxOutRef "" 0))
-  TxInfo
-    { txInfoInputs = fmap (TxInInfo (TxOutRef "" 0)) outs
-    , txInfoOutputs = []
-    , txInfoFee = Value.singleton "" "" 1000
-    , txInfoMint = mint
-    , txInfoDCert = []
-    , txInfoWdrl = []
-    , txInfoValidRange = Interval.always
-    , txInfoSignatories = []
-    , txInfoData = []
-    , txInfoId = ""
-    }
 
 singleAuthorityTokenBurnedTest :: Value -> [TxOut] -> Script
 singleAuthorityTokenBurnedTest mint outs =
   let actual :: ClosedTerm PBool
-      actual = singleAuthorityTokenBurned (pconstant currencySymbol) (pconstantData (mkTxInfo mint outs)) (pconstant mint)
+      actual = singleAuthorityTokenBurned (pconstant currencySymbol) (punsafeCoerce $ pconstant $ mkInputs outs) (pconstant mint)
       s :: ClosedTerm POpaque
       s =
         pif

agora-specs/Spec/Proposal.hs

@@ -40,7 +40,7 @@ specs =
               "use other's stake"
               Create.useStakeOwnBySomeoneElseParameters
               True
-              False
+              True
               False
           , Create.mkTestTree
               "altered stake"

agora/Agora/AuthorityToken.hs

@@ -100,20 +100,18 @@ authorityTokensValidIn = phoistAcyclic $
 
 {- | Assert that a single authority token has been burned.
 
-     @since 0.1.0
+     @since 0.2.0
 -}
 singleAuthorityTokenBurned ::
   forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S).
   Term s PCurrencySymbol ->
-  Term s (PAsData PTxInfo) ->
+  Term s (PBuiltinList (PAsData PTxInInfo)) ->
   Term s (PValue keys amounts) ->
   Term s PBool
-singleAuthorityTokenBurned gatCs txInfo mint = unTermCont $ do
+singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
   let gatAmountMinted :: Term _ PInteger
       gatAmountMinted = psymbolValueOf # gatCs # mint
 
-  txInfoF <- pletFieldsC @'["inputs"] $ txInfo
-
   pure $
     foldr1
       (#&&)
@@ -126,7 +124,7 @@ singleAuthorityTokenBurned gatCs txInfo mint = unTermCont $ do
                   let txOut' = pfield @"resolved" # txInInfo
                   pure $ authorityTokensValidIn # gatCs # pfromData txOut'
               )
-            # txInfoF.inputs
+            # inputs
       ]
 
 {- | Policy given 'AuthorityToken' params.

agora/Agora/Effect.hs

@@ -30,7 +30,6 @@ makeEffect ::
 makeEffect gatCs' f =
   plam $ \datum _redeemer ctx' -> unTermCont $ do
     ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
-    txInfo' <- pletC ctx.txInfo
 
     -- convert input datum, PData, into desierable type
     -- the way this conversion is performed should be defined
@@ -42,14 +41,14 @@ makeEffect gatCs' f =
     txOutRef' <- pletC (pfield @"_0" # txOutRef)
 
     -- fetch minted values to ensure single GAT is burned
-    txInfo <- pletFieldsC @'["mint"] txInfo'
+    txInfo <- pletFieldsC @'["mint", "inputs"] ctx.txInfo
     let mint :: Term _ (PValue _ _)
         mint = txInfo.mint
 
     -- fetch script context
     gatCs <- pletC $ pconstant gatCs'
 
-    pguardC "A single authority token has been burned" $ singleAuthorityTokenBurned gatCs txInfo' mint
+    pguardC "A single authority token has been burned" $ singleAuthorityTokenBurned gatCs txInfo.inputs mint
 
     -- run effect function
-    pure $ f gatCs datum' txOutRef' txInfo'
+    pure $ f gatCs datum' txOutRef' ctx.txInfo

agora/Agora/Governor.hs

@@ -260,6 +260,4 @@ governorDatumValid = phoistAcyclic $
         [ ptraceIfFalse "Execute threshold is less than or equal to" $ 0 #<= execute
         , ptraceIfFalse "Draft threshold is less than or equal to " $ 0 #<= draft
         , ptraceIfFalse "Vote threshold is less than or equal to " $ 0 #<= vote
-        , ptraceIfFalse "Draft threshold is less than vote threshold" $ draft #<= vote
-        , ptraceIfFalse "Execute threshold is less than vote threshold" $ vote #< execute
         ]

agora/Agora/Governor/Scripts.hs

@@ -47,10 +47,11 @@ import Agora.Governor (
 import Agora.Proposal (
   PProposalDatum (..),
   Proposal (..),
-  ProposalStatus (Draft, Finished, Locked),
+  ProposalStatus (Draft, Locked),
-  pemptyVotesFor,
+  phasNeutralEffect,
+  pisEffectsVotesCompatible,
+  pisVotesEmpty,
   pneutralOption,
-  proposalDatumValid,
   pwinner,
  )
 import Agora.Proposal.Scripts (
@@ -58,7 +59,6 @@ import Agora.Proposal.Scripts (
   proposalValidator,
  )
 import Agora.Proposal.Time (createProposalStartingTime)
-import Agora.SafeMoney (GTTag)
 import Agora.Stake (
   PProposalLock (..),
   PStakeDatum (..),
@@ -79,10 +79,6 @@ import Agora.Utils (
   validatorHashToAddress,
   validatorHashToTokenName,
  )
-import Plutarch.Extra.Record
-
---------------------------------------------------------------------------------
-
 import Plutarch.Api.V1 (
   PAddress,
   PCurrencySymbol,
@@ -93,7 +89,6 @@ import Plutarch.Api.V1 (
   PTxOut,
   PValidator,
   PValidatorHash,
-  PValue,
   mintingPolicySymbol,
   mkMintingPolicy,
   mkValidator,
@@ -103,19 +98,18 @@ import Plutarch.Api.V1.AssetClass (
   passetClass,
   passetClassValueOf,
  )
-import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisUTXOSpent, ptryFindDatum, ptxSignedBy, pvalueSpent)
+import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisUTXOSpent, ptryFindDatum, pvalueSpent)
 import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
+import Plutarch.Extra.Field (pletAllC)
 import Plutarch.Extra.IsData (pmatchEnumFromData)
+import Plutarch.Extra.List (pfirstJust)
 import Plutarch.Extra.Map (
   plookup,
   plookup',
  )
 import Plutarch.Extra.Maybe (pisDJust)
+import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
 import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
-import Plutarch.SafeMoney (PDiscrete (..), pvalueDiscrete')
-
---------------------------------------------------------------------------------
-
 import PlutusLedgerApi.V1 (
   CurrencySymbol (..),
   MintingPolicy,
@@ -277,7 +271,7 @@ governorPolicy gov =
 governorValidator :: Governor -> ClosedTerm PValidator
 governorValidator gov =
   plam $ \datum' redeemer' ctx' -> unTermCont $ do
-    ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx'
+    ctxF <- pletAllC ctx'
 
     txInfo' <- pletC $ pfromData $ ctxF.txInfo
     txInfoF <- pletFieldsC @'["mint", "inputs", "outputs", "datums", "signatories", "validRange"] txInfo'
@@ -292,15 +286,7 @@ governorValidator gov =
     let ownAddress = pfromData $ ownInputF.address
 
     (pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- ptryFromC datum'
-    oldGovernorDatumF <-
+    oldGovernorDatumF <- pletAllC oldGovernorDatum
-      pletFieldsC
-        @'[ "proposalThresholds"
-          , "nextProposalId"
-          , "proposalTimings"
-          , "createProposalTimeRangeMaxWidth"
-          , "maximumProposalsPerStake"
-          ]
-        oldGovernorDatum
 
     -- Check that GST will be returned to the governor.
     let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value
@@ -354,20 +340,21 @@ governorValidator gov =
           -- Check that a stake is spent to create the propsal,
           --   and the value it contains meets the requirement.
 
-          stakeInput <-
+          stakeInputs <-
             pletC $
-              mustBePJust # "Stake input not found" #$ pfind
+              pfilter
                 # phoistAcyclic
                   ( plam $
-                      \((pfield @"resolved" #) -> txOut') -> unTermCont $ do
+                      \((pfield @"value" #) . (pfield @"resolved" #) -> value) ->
-                        txOut <- pletFieldsC @'["address", "value"] txOut'
+                        psymbolValueOf # psstSymbol # value #== 1
-
-                        pure $
-                          txOut.address #== pdata pstakeValidatorAddress
-                            #&& psymbolValueOf # psstSymbol # txOut.value #== 1
                   )
                 # pfromData txInfoF.inputs
 
+          pguardC "Can process only one stake" $
+            plength # stakeInputs #== 1
+
+          stakeInput <- pletC $ phead # stakeInputs
+
           stakeInputF <- pletFieldsC @'["datumHash", "value"] $ pfield @"resolved" # stakeInput
 
           pguardC "Stake input doesn't have datum" $
@@ -375,20 +362,12 @@ governorValidator gov =
 
           let stakeInputDatum = mustFindDatum' @PStakeDatum # stakeInputF.datumHash # txInfoF.datums
 
-          stakeInputDatumF <-
+          stakeInputDatumF <- pletAllC stakeInputDatum
-            pletFieldsC @["stakedAmount", "owner", "lockedBy"] stakeInputDatum
 
           pguardC "Proposals created by the stake must not exceed the number stored in the governor." $
             pnumCreatedProposals # stakeInputDatumF.lockedBy
               #< oldGovernorDatumF.maximumProposalsPerStake
 
-          pguardC "Required amount of stake GTs should be presented" $
-            stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeInputF.value)
-
-          -- TODO: Is this required?
-          pguardC "Tx should be signed by the stake owner" $
-            ptxSignedBy # txInfoF.signatories # stakeInputDatumF.owner
-
           -- Check that the newly minted PST is sent to the proposal validator,
           --   and the datum it carries is legal.
 
@@ -417,92 +396,79 @@ governorValidator gov =
                 # outputDatumHash
                 # txInfoF.datums
 
-          pguardC "Proposal datum must be valid" $
+          proposalOutputDatum <- pletAllC proposalOutputDatum'
-            proposalDatumValid' # proposalOutputDatum'
 
-          proposalOutputDatum <-
+          let expectedStartingTime =
-            pletFieldsC
-              @'["effects", "cosigners", "proposalId", "votes"]
-              proposalOutputDatum'
-
-          pguardC "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
-                  )
 
-          pguardC "Datum correct" $ expectedProposalOut #== proposalOutputDatum'
+              expectedCosigners = psingleton @PBuiltinList # stakeInputDatumF.owner
 
-          let cosigner = phead # pfromData proposalOutputDatum.cosigners
+          pguardC "Proposal datum correct" $
-
+            foldl1
-          pguardC "Cosigner should be the stake owner" $
+              (#&&)
-            pdata stakeInputDatumF.owner #== cosigner
+              [ ptraceIfFalse "has neutral effect" $
+                  phasNeutralEffect # proposalOutputDatum.effects
+              , ptraceIfFalse "votes have valid shape" $
+                  pisEffectsVotesCompatible # proposalOutputDatum.effects # proposalOutputDatum.votes
+              , ptraceIfFalse "votes are empty" $
+                  pisVotesEmpty # proposalOutputDatum.votes
+              , ptraceIfFalse "id correct" $
+                  proposalOutputDatum.proposalId #== oldGovernorDatumF.nextProposalId
+              , ptraceIfFalse "status is Draft" $
+                  proposalOutputDatum.status #== pconstantData Draft
+              , ptraceIfFalse "cosigners correct" $
+                  plistEquals # pfromData proposalOutputDatum.cosigners # expectedCosigners
+              , ptraceIfFalse "starting time correct" $
+                  proposalOutputDatum.startingTime #== expectedStartingTime
+              , ptraceIfFalse "copy over configurations" $
+                  proposalOutputDatum.thresholds #== oldGovernorDatumF.proposalThresholds
+                    #&& proposalOutputDatum.timingConfig #== oldGovernorDatumF.proposalTimings
+              ]
 
           -- Check the output stake has been proposly updated.
+          let stakeOutputDatumHash =
+                mustBePJust # "Output stake should be presented"
+                  #$ pfirstJust
+                    # phoistAcyclic
+                      ( plam
+                          ( \txOut -> unTermCont $ do
+                              txOutF <- pletFieldsC @'["datumHash", "value"] txOut
 
-          stakeOutput <-
+                              pure $
-            pletC $
+                                pif
-              mustBePJust
+                                  (psymbolValueOf # psstSymbol # txOutF.value #== 1)
-                # "Stake output not found"
+                                  ( pcon $
-                  #$ pfind
+                                      PJust $
-                # phoistAcyclic
+                                        mustBePDJust # "Output stake datum should be presented"
-                  ( plam $
+                                          # txOutF.datumHash
-                      \txOut' -> unTermCont $ do
+                                  )
-                        txOut <- pletFieldsC @'["address", "value"] txOut'
+                                  (pcon PNothing)
-
+                          )
-                        pure $
+                      )
-                          txOut.address #== pdata pstakeValidatorAddress
+                    # pfromData txInfoF.outputs
-                            #&& psymbolValueOf # psstSymbol # txOut.value #== 1
-                  )
-                # pfromData txInfoF.outputs
-
-          stakeOutputF <- pletFieldsC @'["datumHash", "value"] $ stakeOutput
-
-          pguardC "Staked GTs should be sent back to stake validator" $
-            stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeOutputF.value)
-
-          let stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutputF.datumHash
 
               stakeOutputDatum =
-                mustBePJust # "Stake output not found" #$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums
+                mustBePJust @(PAsData PStakeDatum) # "Stake output datum presented"
+                  #$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums
 
-          -- The stake should be locked by the newly created proposal.
+              stakeOutputLocks =
-          let newLock =
+                pfromData $ pfield @"lockedBy" # stakeOutputDatum
+
+              -- The stake should be locked by the newly created proposal.
+              newLock =
                 mkRecordConstr
                   PCreated
                   ( #created .= oldGovernorDatumF.nextProposalId
                   )
 
               -- Append new locks to existing locks
-              expectedProposalLocks = pcons # pdata newLock # stakeInputDatumF.lockedBy
+              expectedProposalLocks =
+                pcons # pdata newLock # stakeInputDatumF.lockedBy
 
-              expectedStakeOutputDatum =
+          pguardC "Stake output locks correct" $
-                pdata $
+            plistEquals # stakeOutputLocks # expectedProposalLocks
-                  mkRecordConstr
-                    PStakeDatum
-                    ( #stakedAmount .= stakeInputDatumF.stakedAmount
-                        .& #owner .= stakeInputDatumF.owner
-                        .& #lockedBy .= pdata expectedProposalLocks
-                    )
-
-          pguardC "Unexpected stake output datum" $ expectedStakeOutputDatum #== stakeOutputDatum
 
           pure $ popaque $ pconstant ()
 
@@ -533,36 +499,14 @@ governorValidator gov =
                     )
                   # pfromData txInfoF.inputs
 
-          proposalOutputF <-
-            pletFieldsC @'["datumHash"] $
-              mustBePJust # "Proposal output not found"
-                #$ pfind
-                  # plam
-                    ( \txOut -> unTermCont $ do
-                        txOutF <- pletFieldsC @'["address", "value"] txOut
-                        pure $
-                          psymbolValueOf # ppstSymbol # txOutF.value #== 1
-                            #&& txOutF.address #== pdata pproposalValidatorAddress
-                    )
-                  # pfromData txInfoF.outputs
-
           proposalInputDatum <-
             pletC $
               mustFindDatum' @PProposalDatum
                 # proposalInputF.datumHash
                 # txInfoF.datums
-          proposalOutputDatum <-
-            pletC $
-              mustFindDatum' @PProposalDatum
-                # proposalOutputF.datumHash
-                # txInfoF.datums
-
-          pguardC "Proposal datum must be valid" $
-            proposalDatumValid' # proposalInputDatum
-              #&& proposalDatumValid' # proposalOutputDatum
 
           proposalInputDatumF <-
-            pletFieldsC @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes", "timingConfig", "startingTime"]
+            pletFieldsC @'["effects", "status", "thresholds", "votes"]
               proposalInputDatum
 
           -- Check that the proposal state is advanced so that a proposal cannot be executed twice.
@@ -570,22 +514,6 @@ governorValidator gov =
           pguardC "Proposal must be in locked(executable) state in order to execute effects" $
             proposalInputDatumF.status #== pconstantData Locked
 
-          let expectedOutputProposalDatum =
-                mkRecordConstr
-                  PProposalDatum
-                  ( #proposalId .= proposalInputDatumF.proposalId
-                      .& #effects .= proposalInputDatumF.effects
-                      .& #status .= pconstantData Finished
-                      .& #cosigners .= proposalInputDatumF.cosigners
-                      .& #thresholds .= proposalInputDatumF.thresholds
-                      .& #votes .= proposalInputDatumF.votes
-                      .& #timingConfig .= proposalInputDatumF.timingConfig
-                      .& #startingTime .= proposalInputDatumF.startingTime
-                  )
-
-          pguardC "Unexpected output proposal datum" $
-            pdata proposalOutputDatum #== pdata expectedOutputProposalDatum
-
           -- TODO: anything else to check here?
 
           -- Find the highest votes and the corresponding tag.
@@ -661,15 +589,11 @@ governorValidator gov =
 
         Just MutateGovernor -> unTermCont $ do
           -- Check that a GAT is burnt.
-          pure $ popaque $ singleAuthorityTokenBurned patSymbol ctxF.txInfo txInfoF.mint
+          pure $ popaque $ singleAuthorityTokenBurned patSymbol txInfoF.inputs txInfoF.mint
 
         --------------------------------------------------------------------------
         Nothing -> ptraceError "Unknown redeemer"
   where
-    -- Get th amount of governance tokens in a value.
-    pgtValueOf :: Term s (PValue _ _ :--> PDiscrete GTTag)
-    pgtValueOf = phoistAcyclic $ pvalueDiscrete' gov.gtClassRef
-
     -- The currency symbol of authority token.
     patSymbol :: Term s PCurrencySymbol
     patSymbol = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor gov
@@ -680,24 +604,12 @@ governorValidator gov =
       let AssetClass (sym, _) = proposalSTAssetClassFromGovernor gov
        in phoistAcyclic $ pconstant sym
 
-    -- Is a proposal state datum valid?
-    proposalDatumValid' :: Term s (PProposalDatum :--> PBool)
-    proposalDatumValid' =
-      let params = proposalFromGovernor gov
-       in phoistAcyclic $ proposalDatumValid params
-
     -- The address of the proposal validator.
     pproposalValidatorAddress :: Term s PAddress
     pproposalValidatorAddress =
       let vh = proposalValidatorHashFromGovernor gov
        in phoistAcyclic $ pconstant $ validatorHashToAddress vh
 
-    -- The address of the stake validator.
-    pstakeValidatorAddress :: Term s PAddress
-    pstakeValidatorAddress =
-      let vh = stakeValidatorHashFromGovernor gov
-       in phoistAcyclic $ pconstant $ validatorHashToAddress vh
-
     -- The currency symbol of the stake state token.
     psstSymbol :: Term s PCurrencySymbol
     psstSymbol =

agora/Agora/Proposal.hs

@@ -29,8 +29,9 @@ module Agora.Proposal (
   PResultTag (..),
 
   -- * Plutarch helpers
-  proposalDatumValid,
+  phasNeutralEffect,
-  pemptyVotesFor,
+  pisEffectsVotesCompatible,
+  pisVotesEmpty,
   pwinner,
   pwinner',
   pneutralOption,
@@ -50,6 +51,7 @@ import Plutarch.Api.V1 (
   PPubKeyHash,
   PValidatorHash,
  )
+import Plutarch.Api.V1.AssocMap qualified as PAssocMap
 import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..))
 import Plutarch.Extra.IsData (
   DerivePConstantViaDataList (..),
@@ -57,11 +59,10 @@ import Plutarch.Extra.IsData (
   EnumIsData (..),
   ProductIsData (ProductIsData),
  )
-import Plutarch.Extra.List (pnotNull)
 import Plutarch.Extra.Map qualified as PM
 import Plutarch.Extra.Map.Unsorted qualified as PUM
 import Plutarch.Extra.Other (DerivePNewtype' (..))
-import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
+import Plutarch.Extra.TermCont (pguardC, pletC)
 import Plutarch.Lift (
   DerivePConstantViaNewtype (..),
   PConstantDecl,
@@ -597,19 +598,6 @@ deriving via
   instance
     (PConstantDecl ProposalVotes)
 
-{- | Plutarch-level version of 'emptyVotesFor'.
-
-     @since 0.1.0
--}
-pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap 'Unsorted PResultTag a :--> PProposalVotes)
-pemptyVotesFor =
-  phoistAcyclic $
-    plam
-      ( \m ->
-          pcon $
-            PProposalVotes $ PM.pmap # plam (const $ pconstant 0) # m
-      )
-
 {- | Plutarch-level version of 'ProposalDatum'.
 
      @since 0.1.0
@@ -712,27 +700,50 @@ deriving via (DerivePConstantViaData ProposalRedeemer PProposalRedeemer) instanc
 
      @since 0.1.0
 -}
-proposalDatumValid :: Proposal -> Term s (Agora.Proposal.PProposalDatum :--> PBool)
-proposalDatumValid proposal =
-  phoistAcyclic $
-    plam $ \datum' -> unTermCont $ do
-      datum <- pletFieldsC @'["effects", "cosigners", "votes"] $ datum'
 
-      let atLeastOneNegativeResult =
+{- | Return true if the effect list contains at least one neutral outcome.
-            pany
-              # phoistAcyclic
-                (plam $ \m -> pnull #$ pto $ pfromData $ psndBuiltin # m)
-              #$ pto
-              $ pfromData datum.effects
 
-      pure $
+     @since 0.2.0
-        foldr1
+-}
-          (#&&)
+phasNeutralEffect ::
-          [ ptraceIfFalse "Proposal has at least one ResultTag has no effects" atLeastOneNegativeResult
+  forall (s :: S).
-          , ptraceIfFalse "Proposal has at least one cosigner" $ pnotNull # pfromData datum.cosigners
+  Term
-          , ptraceIfFalse "Proposal has fewer cosigners than the limit" $ plength # pfromData datum.cosigners #<= pconstant proposal.maximumCosigners
+    s
-          , ptraceIfFalse "Proposal votes and effects are compatible with each other" $ PUM.pkeysEqual # datum.effects # pto (pfromData datum.votes)
+    ( PMap 'Unsorted PResultTag (PMap 'Unsorted PValidatorHash PDatumHash)
-          ]
+        :--> PBool
+    )
+phasNeutralEffect = phoistAcyclic $ PAssocMap.pany # PAssocMap.pnull
+
+{- | Return true if votes and effects of the proposal have the same key set.
+
+     @since 0.2.0
+-}
+pisEffectsVotesCompatible ::
+  forall (s :: S).
+  Term
+    s
+    ( PMap 'Unsorted PResultTag (PMap 'Unsorted PValidatorHash PDatumHash)
+        :--> PProposalVotes
+        :--> PBool
+    )
+pisEffectsVotesCompatible = phoistAcyclic $
+  plam $ \m (pto -> v :: Term _ (PMap _ _ _)) ->
+    PUM.pkeysEqual # m # v
+
+{- | Retutns true if vote counts of /all/ the options are zero.
+
+   @since 0.2.0
+-}
+pisVotesEmpty ::
+  forall (s :: S).
+  Term
+    s
+    ( PProposalVotes
+        :--> PBool
+    )
+pisVotesEmpty = phoistAcyclic $
+  plam $ \(pto -> m :: Term _ (PMap _ _ _)) ->
+    PAssocMap.pall # plam (#== 0) # m
 
 {- | Wrapper for 'pwinner''. When the winner cannot be found,
       the 'neutral' option will be returned.

agora/Agora/Proposal/Scripts.hs

@@ -40,7 +40,6 @@ import Agora.Utils (
   getMintingPolicySymbol,
   mustBePJust,
   mustFindDatum',
-  pisUniq',
   pltAsData,
  )
 import Plutarch.Api.V1 (
@@ -63,7 +62,7 @@ import Plutarch.Api.V1.ScriptContext (
 import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
 import Plutarch.Extra.Comonad (pextract)
 import Plutarch.Extra.IsData (pmatchEnum)
-import Plutarch.Extra.List (pmapMaybe, pmergeBy, pmsortBy)
+import Plutarch.Extra.List (pisUniq', pmapMaybe, pmergeBy, pmsortBy)
 import Plutarch.Extra.Map (plookup, pupdate)
 import Plutarch.Extra.Maybe (pfromDJust, pfromJust, pisJust)
 import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))

agora/Agora/Stake.hs

@@ -51,13 +51,14 @@ import Plutarch.Extra.IsData (
  )
 import Plutarch.Extra.List (pnotNull)
 import Plutarch.Extra.Other (DerivePNewtype' (..))
+import Plutarch.Extra.Sum (PSum (..))
+import Plutarch.Extra.Traversable (pfoldMap)
 import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
 import Plutarch.SafeMoney (PDiscrete)
 import Plutarch.Show (PShow (..))
 import PlutusLedgerApi.V1 (PubKeyHash)
 import PlutusLedgerApi.V1.Value (AssetClass)
 import PlutusTx qualified
-import Prelude ((+))
 import Prelude hiding (Num (..))
 
 --------------------------------------------------------------------------------
@@ -396,21 +397,14 @@ pnumCreatedProposals :: Term s (PBuiltinList (PAsData PProposalLock) :--> PInteg
 pnumCreatedProposals =
   phoistAcyclic $
     plam $ \l ->
-      pfoldl
+      pto $
-        # phoistAcyclic
+        pfoldMap
-          ( plam
+          # plam
-              ( \c (pfromData -> lock) ->
+            ( \(pfromData -> lock) -> pmatch lock $ \case
-                  c
+                PCreated _ -> pcon $ PSum 1
-                    + pmatch
+                _ -> mempty
-                      lock
+            )
-                      ( \case
+          # l
-                          PCreated _ -> 1
-                          _ -> 0
-                      )
-              )
-          )
-        # 0
-        # l
 
 {- | The role of a stake for a particular proposal. Scott-encoded.
 

agora/Agora/Treasury.hs

@@ -114,14 +114,13 @@ treasuryValidator gatCs' = plam $ \_datum redeemer ctx' -> unTermCont $ do
     redeemer #== pforgetData (pconstantData SpendTreasuryGAT)
 
   -- Get the minted value from txInfo.
-  txInfo' <- pletC ctx.txInfo
+  txInfo <- pletFieldsC @'["mint", "inputs"] ctx.txInfo
-  txInfo <- pletFieldsC @'["mint"] txInfo'
   let mint :: Term _ (PValue _ _)
       mint = txInfo.mint
 
   gatCs <- pletC $ pconstant gatCs'
 
   pguardC "A single authority token has been burned" $
-    singleAuthorityTokenBurned gatCs txInfo' mint
+    singleAuthorityTokenBurned gatCs txInfo.inputs mint
 
   pure . popaque $ pconstant ()

agora/Agora/Utils.hs

@@ -20,8 +20,6 @@ module Agora.Utils (
   isScriptAddress,
   isPubKey,
   pltAsData,
-  pisUniqBy',
-  pisUniq',
 ) where
 
 import Plutarch.Api.V1 (
@@ -208,36 +206,3 @@ pltAsData ::
 pltAsData = phoistAcyclic $
   plam $
     \(pfromData -> l) (pfromData -> r) -> l #< r
-
-{- | Special version of 'pisUniq'', the list elements should have 'PEq' instance.
-
- @since 0.2.0
--}
-pisUniq' ::
-  forall (l :: PType -> PType) (a :: PType) (s :: S).
-  (PEq a, PIsListLike l a) =>
-  Term s (l a :--> PBool)
-pisUniq' = phoistAcyclic $ pisUniqBy' # phoistAcyclic (plam (#==))
-
-{- | Return true if all the elements in the given list are unique, given the equalator function.
-   The list is assumed to be ordered.
-
- @since 0.2.0
--}
-pisUniqBy' ::
-  forall (l :: PType -> PType) (a :: PType) (s :: S).
-  (PIsListLike l a) =>
-  Term s ((a :--> a :--> PBool) :--> l a :--> PBool)
-pisUniqBy' = phoistAcyclic $
-  plam $ \eq l ->
-    pif (pnull # l) (pconstant True) $
-      go # eq # (phead # l) # (ptail # l)
-  where
-    go :: Term _ ((a :--> a :--> PBool) :--> a :--> l a :--> PBool)
-    go = phoistAcyclic $
-      pfix #$ plam $ \self' eq x xs ->
-        plet (self' # eq) $ \self ->
-          pif (pnull # xs) (pconstant True) $
-            plet (phead # xs) $ \x' ->
-              pif (eq # x # x') (pconstant False) $
-                self # x' #$ ptail # xs

bench.csv

@@ -1,18 +1,19 @@
 name,cpu,mem,size
-Agora/Effects/Treasury Withdrawal Effect/effect/Simple,333327612,830203,3674
+Agora/Effects/Treasury Withdrawal Effect/effect/Simple,333137234,829671,3674
-Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,492387542,1197315,3986
+Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,492197164,1196783,3986
-Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,456007605,1104500,3859
+Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,455817227,1103968,3859
-Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,88940927,246756,8891
+Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,84914023,233054,7949
-Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,107090537,296185,3627
+Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,104760131,289547,3491
 Agora/Stake/policy/stakeCreation,51008580,149029,2522
 Agora/Stake/validator/stakeDepositWithdraw deposit,183506412,498838,4745
 Agora/Stake/validator/stakeDepositWithdraw withdraw,183506412,498838,4733
 Agora/Proposal/policy (proposal creation)/legal/proposal,34975627,103548,2117
-Agora/Proposal/policy (proposal creation)/legal/governor,327971301,871386,9370
+Agora/Proposal/policy (proposal creation)/legal/governor,316600184,838411,8429
 Agora/Proposal/policy (proposal creation)/legal/stake,152415805,398403,5404
 Agora/Proposal/policy (proposal creation)/illegal/invalid next proposal id/proposal,34975627,103548,2117
 Agora/Proposal/policy (proposal creation)/illegal/invalid next proposal id/stake,152415805,398403,5404
 Agora/Proposal/policy (proposal creation)/illegal/use other's stake/proposal,34975627,103548,2086
+Agora/Proposal/policy (proposal creation)/illegal/use other's stake/governor,316600184,838411,8398
 Agora/Proposal/policy (proposal creation)/illegal/altered stake/proposal,34975627,103548,2117
 Agora/Proposal/policy (proposal creation)/illegal/invalid stake locks/proposal,34975627,103548,2125
 Agora/Proposal/policy (proposal creation)/illegal/invalid stake locks/stake,157849465,413053,5412
@@ -223,12 +224,12 @@ Agora/Proposal/validator/unlocking/illegal/with 42 proposals/remove creator too
 Agora/Proposal/validator/unlocking/illegal/with 42 proposals/remove creator too early/status: VotingReady/stake,1674013803,4194887,26590
 Agora/Proposal/validator/unlocking/illegal/with 42 proposals/remove creator too early/status: Locked/stake,1674013803,4194887,26590
 Agora/Proposal/validator/unlocking/illegal/with 42 proposals/creator: retract votes/stake,1674013803,4194887,26506
-Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
+Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,20570665,54655,725
-Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
+Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,32757063,87013,825
-Agora/Treasury/Validator/Positive/Allows for effect changes,31556709,81546,1452
+Agora/Treasury/Validator/Positive/Allows for effect changes,31277082,80782,1450
-Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
+Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,20570665,54655,725
-Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
+Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,32757063,87013,825
-Agora/Governor/policy/GST minting,51480023,145787,2048
+Agora/Governor/policy/GST minting,49408995,139981,1910
-Agora/Governor/validator/proposal creation,303114849,813451,9390
+Agora/Governor/validator/proposal creation,294638205,791763,8449
-Agora/Governor/validator/GATs minting,422654153,1147158,9516
+Agora/Governor/validator/GATs minting,249873031,663031,8575
-Agora/Governor/validator/mutate governor state,90087778,252215,8991
+Agora/Governor/validator/mutate governor state,86060874,238513,8049