Sulkta-OSS/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

improve performance of the governor validator

Browse source
This commit is contained in:
Hongrui Fang 2022-07-13 19:01:51 +08:00
parent a19bbce198
commit b6fb23975c
No known key found for this signature in database
GPG key ID: 1E0454204FC7D755
13 changed files with 166 additions and 319 deletions
Download patch file Download diff file Expand all files Collapse all files

10
agora/Agora/AuthorityToken.hs
View file

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

7
agora/Agora/Effect.hs
View file

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

2
agora/Agora/Governor.hs
View file

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

240
agora/Agora/Governor/Scripts.hs
View file

@ -47,10 +47,11 @@ import Agora.Governor (
import Agora.Proposal (
PProposalDatum (..),
Proposal (..),
ProposalStatus (Draft, Finished, Locked),
pemptyVotesFor,
ProposalStatus (Draft, Locked),
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 <-
pletFieldsC
@'[ "proposalThresholds"
, "nextProposalId"
, "proposalTimings"
, "createProposalTimeRangeMaxWidth"
, "maximumProposalsPerStake"
]
oldGovernorDatum
oldGovernorDatumF <- pletAllC 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
txOut <- pletFieldsC @'["address", "value"] txOut'
pure $
txOut.address #== pdata pstakeValidatorAddress
#&& psymbolValueOf # psstSymbol # txOut.value #== 1
\((pfield @"value" #) . (pfield @"resolved" #) -> value) ->
psymbolValueOf # psstSymbol # 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 <-
pletFieldsC @["stakedAmount", "owner", "lockedBy"] stakeInputDatum
stakeInputDatumF <- pletAllC 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" $
proposalDatumValid' # proposalOutputDatum'
proposalOutputDatum <- pletAllC proposalOutputDatum'
proposalOutputDatum <-
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 =
let 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 "Cosigner should be the stake owner" $
pdata stakeInputDatumF.owner #== cosigner
pguardC "Proposal datum correct" $
foldl1
(#&&)
[ 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 <-
pletC $
mustBePJust
# "Stake output not found"
#$ pfind
# phoistAcyclic
( plam $
\txOut' -> unTermCont $ do
txOut <- pletFieldsC @'["address", "value"] txOut'
pure $
txOut.address #== pdata pstakeValidatorAddress
#&& 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
pure $
pif
(psymbolValueOf # psstSymbol # txOutF.value #== 1)
( pcon $
PJust $
mustBePDJust # "Output stake datum should be presented"
# txOutF.datumHash
)
(pcon PNothing)
)
)
# pfromData txInfoF.outputs
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.
let newLock =
stakeOutputLocks =
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 =
pdata $
mkRecordConstr
PStakeDatum
( #stakedAmount .= stakeInputDatumF.stakedAmount
.& #owner .= stakeInputDatumF.owner
.& #lockedBy .= pdata expectedProposalLocks
)
pguardC "Unexpected stake output datum" $ expectedStakeOutputDatum #== stakeOutputDatum
pguardC "Stake output locks correct" $
plistEquals # stakeOutputLocks # expectedProposalLocks
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 =

83
agora/Agora/Proposal.hs
View file

@ -29,8 +29,9 @@ module Agora.Proposal (
PResultTag (..),
-- * Plutarch helpers
proposalDatumValid,
pemptyVotesFor,
phasNeutralEffect,
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 =
pany
# phoistAcyclic
(plam $ \m -> pnull #$ pto $ pfromData $ psndBuiltin # m)
#$ pto
$ pfromData datum.effects
{- | Return true if the effect list contains at least one neutral outcome.
pure $
foldr1
(#&&)
[ ptraceIfFalse "Proposal has at least one ResultTag has no effects" atLeastOneNegativeResult
, ptraceIfFalse "Proposal has at least one cosigner" $ pnotNull # pfromData datum.cosigners
, ptraceIfFalse "Proposal has fewer cosigners than the limit" $ plength # pfromData datum.cosigners #<= pconstant proposal.maximumCosigners
, ptraceIfFalse "Proposal votes and effects are compatible with each other" $ PUM.pkeysEqual # datum.effects # pto (pfromData datum.votes)
]
@since 0.2.0
-}
phasNeutralEffect ::
forall (s :: S).
Term
s
( 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.

3
agora/Agora/Proposal/Scripts.hs
View file

@ -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, (.&), (.=))

26
agora/Agora/Stake.hs
View file

@ -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
# phoistAcyclic
( plam
( \c (pfromData -> lock) ->
c
+ pmatch
lock
( \case
PCreated _ -> 1
_ -> 0
)
)
)
# 0
# l
pto $
pfoldMap
# plam
( \(pfromData -> lock) -> pmatch lock $ \case
PCreated _ -> pcon $ PSum 1
_ -> mempty
)
# l
{- | The role of a stake for a particular proposal. Scott-encoded.

5
agora/Agora/Treasury.hs
View file

@ -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"] txInfo'
txInfo <- pletFieldsC @'["mint", "inputs"] ctx.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 ()

35
agora/Agora/Utils.hs
View file

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