prevent minting multiple into one UTxO; regression tests
This commit is contained in:
Hongrui Fang
parent
86bcc78553
commit
1a7d704497
8 changed files with 215 additions and 123 deletions
|
|
@ -36,12 +36,13 @@ module Sample.Proposal.Advance (
|
|||
mkBadGovernorOutputDatumBundle,
|
||||
mkUnexpectedOutputStakeBundles,
|
||||
mkFastforwardToFinishBundles,
|
||||
mkBadGovernorRedeemerBundle,
|
||||
) where
|
||||
|
||||
import Agora.Governor (
|
||||
Governor (..),
|
||||
GovernorDatum (..),
|
||||
GovernorRedeemer (MintGATs),
|
||||
GovernorRedeemer (CreateProposal, MintGATs),
|
||||
)
|
||||
import Agora.Proposal (
|
||||
ProposalDatum (..),
|
||||
|
|
@ -85,6 +86,7 @@ import Plutarch.Context (
|
|||
timeRange,
|
||||
withDatum,
|
||||
withInlineDatum,
|
||||
withRedeemer,
|
||||
withRef,
|
||||
withValue,
|
||||
)
|
||||
|
|
@ -101,6 +103,7 @@ import PlutusLedgerApi.V2 (
|
|||
TxOutRef (TxOutRef),
|
||||
ValidatorHash,
|
||||
)
|
||||
import PlutusTx qualified
|
||||
import Sample.Proposal.Shared (
|
||||
governorTxRef,
|
||||
proposalTxRef,
|
||||
|
|
@ -165,9 +168,18 @@ data ParameterBundle = ParameterBundle
|
|||
}
|
||||
|
||||
-- | Everything about the generated governor stuff.
|
||||
newtype GovernorParameters = GovernorParameters
|
||||
data GovernorParameters = forall
|
||||
(redeemer :: Type)
|
||||
(predeemer :: PType).
|
||||
( PUnsafeLiftDecl predeemer
|
||||
, PLifted predeemer ~ redeemer
|
||||
, PIsData predeemer
|
||||
, PlutusTx.ToData redeemer
|
||||
) =>
|
||||
GovernorParameters
|
||||
{ invalidGovernorOutputDatum :: Bool
|
||||
-- ^ The output governor datum will be changed.
|
||||
, governorRedeemer :: redeemer
|
||||
}
|
||||
|
||||
-- | Everything about the generated authority token stuff.
|
||||
|
|
@ -432,7 +444,7 @@ governorRef = TxOutRef governorTxRef 2
|
|||
governor validator.
|
||||
-}
|
||||
mkGovernorBuilder :: forall b. CombinableBuilder b => GovernorParameters -> b
|
||||
mkGovernorBuilder ps =
|
||||
mkGovernorBuilder ps@(GovernorParameters _ redeemer) =
|
||||
let gst = assetClassValue governorAssetClass 1
|
||||
value = sortValue $ gst <> minAda
|
||||
in mconcat
|
||||
|
|
@ -442,6 +454,7 @@ mkGovernorBuilder ps =
|
|||
, withValue value
|
||||
, withRef governorRef
|
||||
, withDatum governorInputDatum
|
||||
, withRedeemer redeemer
|
||||
]
|
||||
, output $
|
||||
mconcat
|
||||
|
|
@ -452,12 +465,6 @@ mkGovernorBuilder ps =
|
|||
]
|
||||
]
|
||||
|
||||
{- | The proposal redeemer used to spend the governor UTXO, which is always
|
||||
'MintGATs' in this case.
|
||||
-}
|
||||
governorRedeemer :: GovernorRedeemer
|
||||
governorRedeemer = MintGATs
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- * Authority Token
|
||||
|
|
@ -538,16 +545,19 @@ mkTestTree name pb val =
|
|||
proposalInputDatum
|
||||
proposalRedeemer
|
||||
(spend proposalRef)
|
||||
|
||||
governor =
|
||||
maybe [] singleton $
|
||||
testValidator
|
||||
(fromJust val.forGovernorValidator)
|
||||
"governor"
|
||||
governorValidator
|
||||
governorInputDatum
|
||||
governorRedeemer
|
||||
(spend governorRef)
|
||||
<$ pb.governorParameters
|
||||
( \(GovernorParameters _ governorRedeemer) ->
|
||||
testValidator
|
||||
(fromJust val.forGovernorValidator)
|
||||
"governor"
|
||||
governorValidator
|
||||
governorInputDatum
|
||||
governorRedeemer
|
||||
(spend governorRef)
|
||||
)
|
||||
<$> pb.governorParameters
|
||||
|
||||
authority = case pb.authorityTokenParameters of
|
||||
[] -> []
|
||||
|
|
@ -827,6 +837,7 @@ mkValidToNextStateBundle nCosigners nEffects authScript from =
|
|||
gov =
|
||||
GovernorParameters
|
||||
{ invalidGovernorOutputDatum = False
|
||||
, governorRedeemer = MintGATs
|
||||
}
|
||||
in b
|
||||
{ governorParameters = Just gov
|
||||
|
|
@ -1066,7 +1077,19 @@ mkBadGovernorOutputDatumBundle nCosigners nEffects =
|
|||
}
|
||||
where
|
||||
template = mkValidFromLockedBundle nCosigners nEffects
|
||||
gov = GovernorParameters True
|
||||
gov = GovernorParameters True MintGATs
|
||||
|
||||
mkBadGovernorRedeemerBundle ::
|
||||
Word ->
|
||||
Word ->
|
||||
ParameterBundle
|
||||
mkBadGovernorRedeemerBundle nCosigners nEffects =
|
||||
template
|
||||
{ governorParameters = Just gov
|
||||
}
|
||||
where
|
||||
template = mkValidFromLockedBundle nCosigners nEffects
|
||||
gov = GovernorParameters False CreateProposal
|
||||
|
||||
mkFastforwardToFinishBundles ::
|
||||
Word ->
|
||||
|
|
|
|||
|
|
@ -19,12 +19,17 @@ module Sample.Proposal.Create (
|
|||
invalidProposalStatusParameters,
|
||||
fakeSSTParameters,
|
||||
wrongGovernorRedeemer,
|
||||
wrongGovernorRedeemer1,
|
||||
) where
|
||||
|
||||
import Agora.Governor (
|
||||
Governor (..),
|
||||
GovernorDatum (..),
|
||||
GovernorRedeemer (CreateProposal, MutateGovernor),
|
||||
GovernorRedeemer (
|
||||
CreateProposal,
|
||||
MintGATs,
|
||||
MutateGovernor
|
||||
),
|
||||
)
|
||||
import Agora.Proposal (
|
||||
ProposalDatum (..),
|
||||
|
|
@ -71,6 +76,8 @@ import PlutusLedgerApi.V2 (
|
|||
Credential (PubKeyCredential),
|
||||
POSIXTime (POSIXTime),
|
||||
POSIXTimeRange,
|
||||
Redeemer (Redeemer),
|
||||
ToData (toBuiltinData),
|
||||
TxOutRef (TxOutRef),
|
||||
always,
|
||||
)
|
||||
|
|
@ -123,8 +130,8 @@ data Parameters = Parameters
|
|||
-- ^ The status of the newly created proposal.
|
||||
, fakeSST :: Bool
|
||||
-- ^ Whether to use SST that doesn't belong to the stake validator.
|
||||
, wrongGovernorRedeemer :: Bool
|
||||
-- ^ Use 'MutateGovernor' as the governor redeemer
|
||||
, governorRedeemer :: Redeemer
|
||||
-- ^ The redeemer used to spend the governor.
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -358,7 +365,7 @@ createProposal ps = builder
|
|||
[ script governorValidatorHash
|
||||
, withValue governorValue
|
||||
, withDatum governorInputDatum
|
||||
, withRedeemer $ mkGovernorRedeemer ps
|
||||
, withRedeemer ps.governorRedeemer
|
||||
, withRef governorRef
|
||||
]
|
||||
, output $
|
||||
|
|
@ -418,13 +425,6 @@ createProposal ps = builder
|
|||
stakeRedeemer :: StakeRedeemer
|
||||
stakeRedeemer = PermitVote
|
||||
|
||||
-- | Spend the governor with the 'CreateProposal' redeemer.
|
||||
mkGovernorRedeemer :: Parameters -> GovernorRedeemer
|
||||
mkGovernorRedeemer ps =
|
||||
if ps.wrongGovernorRedeemer
|
||||
then MutateGovernor
|
||||
else CreateProposal
|
||||
|
||||
-- | Mint the PST with an arbitrary redeemer. Doesn't really matter.
|
||||
proposalPolicyRedeemer :: ()
|
||||
proposalPolicyRedeemer = ()
|
||||
|
|
@ -443,7 +443,7 @@ totallyValidParameters =
|
|||
, timeRangeClosed = True
|
||||
, proposalStatus = Draft
|
||||
, fakeSST = False
|
||||
, wrongGovernorRedeemer = False
|
||||
, governorRedeemer = Redeemer $ toBuiltinData CreateProposal
|
||||
}
|
||||
|
||||
invalidOutputGovernorDatumParameters :: Parameters
|
||||
|
|
@ -505,7 +505,13 @@ fakeSSTParameters =
|
|||
wrongGovernorRedeemer :: Parameters
|
||||
wrongGovernorRedeemer =
|
||||
totallyValidParameters
|
||||
{ wrongGovernorRedeemer = True
|
||||
{ governorRedeemer = Redeemer $ toBuiltinData MintGATs
|
||||
}
|
||||
|
||||
wrongGovernorRedeemer1 :: Parameters
|
||||
wrongGovernorRedeemer1 =
|
||||
totallyValidParameters
|
||||
{ governorRedeemer = Redeemer $ toBuiltinData MutateGovernor
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -540,7 +546,7 @@ mkTestTree
|
|||
"governor"
|
||||
governorValidator
|
||||
governorInputDatum
|
||||
(mkGovernorRedeemer ps)
|
||||
ps.governorRedeemer
|
||||
(spend governorRef)
|
||||
|
||||
stakeTest =
|
||||
|
|
|
|||
|
|
@ -97,6 +97,12 @@ specs =
|
|||
False
|
||||
False
|
||||
True
|
||||
, Create.mkTestTree
|
||||
"wrong governor redeemer"
|
||||
Create.wrongGovernorRedeemer1
|
||||
False
|
||||
False
|
||||
True
|
||||
]
|
||||
]
|
||||
, group
|
||||
|
|
@ -353,6 +359,15 @@ specs =
|
|||
, forGovernorValidator = Just False
|
||||
, forAuthorityTokenPolicy = Just True
|
||||
}
|
||||
, Advance.mkTestTree
|
||||
"wrong governor redeemer"
|
||||
(Advance.mkBadGovernorRedeemerBundle cs es)
|
||||
Advance.Validity
|
||||
{ forProposalValidator = True
|
||||
, forStakeValidator = True
|
||||
, forGovernorValidator = Just False
|
||||
, forAuthorityTokenPolicy = Just False
|
||||
}
|
||||
]
|
||||
]
|
||||
, group "unlocking" $
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@ module Agora.AuthorityToken (
|
|||
singleAuthorityTokenBurned,
|
||||
) where
|
||||
|
||||
import Agora.Governor (PGovernorRedeemer (PMintGATs), presolveGovernorRedeemer)
|
||||
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
|
||||
import Agora.Utils (psymbolValueOfT, ptag, ptoScottEncodingT, puntag)
|
||||
import Plutarch.Api.V1 (
|
||||
|
|
@ -24,17 +25,14 @@ import Plutarch.Api.V2 (
|
|||
KeyGuarantees,
|
||||
PAddress (PAddress),
|
||||
PMintingPolicy,
|
||||
PScriptContext (PScriptContext),
|
||||
PScriptPurpose (PMinting),
|
||||
PTxInInfo (PTxInInfo),
|
||||
PTxInfo (PTxInfo),
|
||||
PTxOut (PTxOut),
|
||||
)
|
||||
import Plutarch.Extra.AssetClass (PAssetClassData)
|
||||
import Plutarch.Extra.Bool (passert)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc)
|
||||
import Plutarch.Extra.Maybe (pfromJust)
|
||||
import Plutarch.Extra.ScriptContext (pisTokenSpent)
|
||||
import Plutarch.Extra.Maybe (passertPJust, pfromJust)
|
||||
import Plutarch.Extra.Sum (PSum (PSum))
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
||||
|
|
@ -149,33 +147,44 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
|
|||
-}
|
||||
authorityTokenPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy)
|
||||
authorityTokenPolicy =
|
||||
plam $ \gstAssetClass _redeemer ctx' ->
|
||||
pmatch ctx' $ \(PScriptContext ctx') -> unTermCont $ do
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo
|
||||
txInfo <- pletFieldsC @'["inputs", "mint", "outputs"] txInfo'
|
||||
let inputs = txInfo.inputs
|
||||
govTokenSpent = pisTokenSpent # puntag (ptoScottEncodingT # gstAssetClass) # inputs
|
||||
plam $ \gstAssetClass _redeemer ctx -> unTermCont $ do
|
||||
ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx
|
||||
txInfoF <-
|
||||
pletFieldsC
|
||||
@'[ "inputs"
|
||||
, "mint"
|
||||
, "outputs"
|
||||
, "redeemers"
|
||||
]
|
||||
ctxF.txInfo
|
||||
|
||||
PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose
|
||||
PMinting ownSymbol' <- pmatchC $ pfromData ctxF.purpose
|
||||
|
||||
let ownSymbol = pfromData $ pfield @"_0" # ownSymbol'
|
||||
let ownSymbol = pfromData $ pfield @"_0" # ownSymbol'
|
||||
|
||||
PPair mintedATs burntATs <-
|
||||
pmatchC $ pfromJust #$ psymbolValueOf' # ownSymbol # txInfo.mint
|
||||
PPair mintedATs burntATs <-
|
||||
pmatchC $ pfromJust #$ psymbolValueOf' # ownSymbol # txInfoF.mint
|
||||
|
||||
pure $
|
||||
popaque $
|
||||
pif
|
||||
(0 #< mintedATs)
|
||||
( unTermCont $ do
|
||||
pguardC "No GAT burnt" $ 0 #== burntATs
|
||||
pguardC "Parent token did not move in minting GATs" govTokenSpent
|
||||
pguardC "All outputs only emit valid GATs" $
|
||||
pall
|
||||
# plam
|
||||
(authorityTokensValidIn # ptag ownSymbol #)
|
||||
# txInfo.outputs
|
||||
pure $ pconstant ()
|
||||
)
|
||||
(passert "No GAT minted" (0 #== mintedATs) (pconstant ()))
|
||||
pure $
|
||||
popaque $
|
||||
pif
|
||||
(0 #< mintedATs)
|
||||
( unTermCont $ do
|
||||
pguardC "No GAT burnt" $ 0 #== burntATs
|
||||
let governorRedeemer =
|
||||
passertPJust
|
||||
# "GST should move"
|
||||
#$ presolveGovernorRedeemer
|
||||
# (ptoScottEncodingT # gstAssetClass)
|
||||
# pfromData txInfoF.inputs
|
||||
# txInfoF.redeemers
|
||||
pguardC "Governor redeemr correct" $
|
||||
pcon PMintGATs #== governorRedeemer
|
||||
pguardC "All outputs only emit valid GATs" $
|
||||
pall
|
||||
# plam
|
||||
(authorityTokensValidIn # ptag ownSymbol #)
|
||||
# txInfoF.outputs
|
||||
pure $ pconstant ()
|
||||
)
|
||||
(passert "No GAT minted" (0 #== mintedATs) (pconstant ()))
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ module Agora.Governor (
|
|||
pgetNextProposalId,
|
||||
getNextProposalId,
|
||||
pisGovernorDatumValid,
|
||||
presolveGovernorRedeemer,
|
||||
) where
|
||||
|
||||
import Agora.Aeson.Orphans ()
|
||||
|
|
@ -39,21 +40,33 @@ import Agora.Proposal.Time (
|
|||
pisMaxTimeRangeWidthValid,
|
||||
pisProposalTimingConfigValid,
|
||||
)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.SafeMoney (GTTag, GovernorSTTag)
|
||||
import Data.Aeson qualified as Aeson
|
||||
import Data.Tagged (Tagged)
|
||||
import Optics.TH (makeFieldLabelsNoPrefix)
|
||||
import Plutarch.Api.V1.Scripts (PRedeemer)
|
||||
import Plutarch.Api.V2 (KeyGuarantees (Unsorted), PMap, PScriptPurpose (PSpending), PTxInInfo)
|
||||
import Plutarch.DataRepr (
|
||||
DerivePConstantViaData (DerivePConstantViaData),
|
||||
PDataFields,
|
||||
)
|
||||
import Plutarch.Extra.AssetClass (AssetClass)
|
||||
import Plutarch.Extra.AssetClass (AssetClass, PAssetClass)
|
||||
import Plutarch.Extra.Bind (PBind ((#>>=)))
|
||||
import Plutarch.Extra.Field (pletAll)
|
||||
import Plutarch.Extra.Function (pflip)
|
||||
import Plutarch.Extra.Functor (PFunctor (pfmap))
|
||||
import Plutarch.Extra.IsData (
|
||||
DerivePConstantViaEnum (DerivePConstantEnum),
|
||||
EnumIsData (EnumIsData),
|
||||
PlutusTypeEnumData,
|
||||
)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust)
|
||||
import Plutarch.Extra.Maybe (pjust, pnothing)
|
||||
import Plutarch.Extra.Record (mkRecordConstr, (.=))
|
||||
import Plutarch.Extra.ScriptContext (ptryFromRedeemer)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pletFieldsC)
|
||||
import Plutarch.Extra.Value (passetClassValueOfT)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
|
||||
import PlutusLedgerApi.V1 (TxOutRef)
|
||||
import PlutusTx qualified
|
||||
|
|
@ -285,3 +298,49 @@ pisGovernorDatumValid = phoistAcyclic $
|
|||
, ptraceIfFalse "time range valid" $
|
||||
pisMaxTimeRangeWidthValid # datumF.createProposalTimeRangeMaxWidth
|
||||
]
|
||||
|
||||
-- | @since 1.0.0
|
||||
presolveGovernorRedeemer ::
|
||||
forall (s :: S).
|
||||
Term
|
||||
s
|
||||
( PTagged GovernorSTTag PAssetClass
|
||||
:--> PBuiltinList PTxInInfo
|
||||
:--> PMap 'Unsorted PScriptPurpose PRedeemer
|
||||
:--> PMaybe PGovernorRedeemer
|
||||
)
|
||||
presolveGovernorRedeemer = phoistAcyclic $
|
||||
plam $ \gstClass inputs redeemers ->
|
||||
let governorInputRef =
|
||||
pfindJust
|
||||
# plam
|
||||
( flip pletAll $ \inputF ->
|
||||
let value = pfield @"value" # inputF.resolved
|
||||
isGovernorInput =
|
||||
passetClassValueOfT
|
||||
# gstClass
|
||||
# value
|
||||
#== 1
|
||||
in pif
|
||||
isGovernorInput
|
||||
(pjust # inputF.outRef)
|
||||
pnothing
|
||||
)
|
||||
# inputs
|
||||
|
||||
governorScriptPurpose =
|
||||
pfmap
|
||||
# plam
|
||||
( \ref ->
|
||||
mkRecordConstr
|
||||
PSpending
|
||||
(#_0 .= ref)
|
||||
)
|
||||
# governorInputRef
|
||||
|
||||
governorRedeemer =
|
||||
governorScriptPurpose
|
||||
#>>= pflip
|
||||
# ptryFromRedeemer @(PAsData PGovernorRedeemer)
|
||||
# redeemers
|
||||
in pfmap # plam pfromData # governorRedeemer
|
||||
|
|
|
|||
|
|
@ -57,8 +57,8 @@ import Plutarch.Extra.AssetClass (PAssetClassData, passetClass)
|
|||
import Plutarch.Extra.Field (pletAll, pletAllC)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust, plistEqualsBy, pmapMaybe)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.Map (pkeys, ptryLookup)
|
||||
import Plutarch.Extra.Maybe (passertPJust, pjust, pmaybe, pmaybeData, pnothing)
|
||||
import Plutarch.Extra.Ord (psort)
|
||||
import Plutarch.Extra.Maybe (passertPJust, pjust, pmaybeData, pnothing)
|
||||
import Plutarch.Extra.Ord (POrdering (..), pcompareBy, pfromOrd, psort)
|
||||
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
||||
import Plutarch.Extra.ScriptContext (
|
||||
pfindTxInByTxOutRef,
|
||||
|
|
@ -335,6 +335,8 @@ governorValidator =
|
|||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
pstClass <- pletC $ passetClass # pto pstSymbol # pconstant ""
|
||||
|
||||
getProposalDatum :: Term _ (PTxOut :--> PMaybe PProposalDatum) <-
|
||||
pletC $
|
||||
plam $
|
||||
|
|
@ -342,8 +344,8 @@ governorValidator =
|
|||
let isProposalUTxO =
|
||||
txOutF.address
|
||||
#== pdata proposalValidatorAddress
|
||||
#&& psymbolValueOfT
|
||||
# pstSymbol
|
||||
#&& passetClassValueOf
|
||||
# pstClass
|
||||
# txOutF.value
|
||||
#== 1
|
||||
|
||||
|
|
@ -388,16 +390,7 @@ governorValidator =
|
|||
-- Check that exactly one proposal token is being minted.
|
||||
|
||||
pguardC "Exactly one proposal token must be minted" $
|
||||
let vMap = pfromData $ pto txInfoF.mint
|
||||
tnMap = plookup # puntag pstSymbol # vMap
|
||||
-- Ada and PST
|
||||
onlyPST = plength # pto vMap #== 2
|
||||
onePST =
|
||||
pmaybe
|
||||
# pconstant False
|
||||
# plam (#== AssocMap.psingleton # pconstant "" # 1)
|
||||
# tnMap
|
||||
in onlyPST #&& onePST
|
||||
passetClassValueOf # pstClass # txInfoF.mint #== 1
|
||||
|
||||
-- Check that a stake is spent to create the propsal,
|
||||
-- and the value it contains meets the requirement.
|
||||
|
|
@ -510,14 +503,13 @@ governorValidator =
|
|||
( \output -> unTermCont $ do
|
||||
outputF <- pletFieldsC @'["address", "datum", "value"] output
|
||||
|
||||
let isAuthorityUTxO =
|
||||
let atAmount =
|
||||
psymbolValueOfT
|
||||
# atSymbol
|
||||
# outputF.value
|
||||
#== 1
|
||||
|
||||
handleAuthorityUTxO =
|
||||
unTermCont $ do
|
||||
do
|
||||
receiverScriptHash <-
|
||||
pletC $
|
||||
passertPJust
|
||||
|
|
@ -556,13 +548,21 @@ governorValidator =
|
|||
, ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect
|
||||
]
|
||||
|
||||
pure receiverScriptHash
|
||||
pure $ pjust # receiverScriptHash
|
||||
|
||||
pure $
|
||||
pif
|
||||
isAuthorityUTxO
|
||||
(pjust # handleAuthorityUTxO)
|
||||
pnothing
|
||||
pmatchC
|
||||
( pcompareBy
|
||||
# pfromOrd
|
||||
# atAmount
|
||||
# 1
|
||||
)
|
||||
>>= \case
|
||||
-- atAmount == 1
|
||||
PEQ -> handleAuthorityUTxO
|
||||
-- atAmount < 1
|
||||
PLT -> pure pnothing
|
||||
-- atAmount > 1
|
||||
PGT -> pure $ ptraceError "More than one GAT in one UTxO"
|
||||
)
|
||||
|
||||
-- The sorted hashes of all the GAT receivers.
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ module Agora.Proposal.Scripts (
|
|||
proposalPolicy,
|
||||
) where
|
||||
|
||||
import Agora.Governor (PGovernorRedeemer (PCreateProposal))
|
||||
import Agora.Governor (PGovernorRedeemer (PCreateProposal), presolveGovernorRedeemer)
|
||||
import Agora.Proposal (
|
||||
PProposalDatum (PProposalDatum),
|
||||
PProposalRedeemer (PAdvanceProposal, PCosign, PUnlockStake, PVote),
|
||||
|
|
@ -70,7 +70,6 @@ import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
|||
import Plutarch.Extra.ScriptContext (
|
||||
pfindTxInByTxOutRef,
|
||||
ptryFromOutputDatum,
|
||||
ptryFromRedeemer,
|
||||
)
|
||||
import Plutarch.Extra.Sum (PSum (PSum))
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
|
|
@ -82,7 +81,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
|||
ptryFromC,
|
||||
)
|
||||
import Plutarch.Extra.Traversable (pfoldMap)
|
||||
import Plutarch.Extra.Value (passetClassValueOfT, psymbolValueOf)
|
||||
import Plutarch.Extra.Value (psymbolValueOf')
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
|
||||
{- | Policy for Proposals.
|
||||
|
|
@ -118,44 +117,25 @@ proposalPolicy =
|
|||
|
||||
PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatchC $ pfromData ctxF.purpose
|
||||
|
||||
let mintedProposalST =
|
||||
psymbolValueOf
|
||||
pguardC "Minted exactly one proposal ST"
|
||||
$ pmatch
|
||||
( pfromJust
|
||||
#$ psymbolValueOf'
|
||||
# ownSymbol
|
||||
# txInfoF.mint
|
||||
)
|
||||
$ \(PPair minted burnt) ->
|
||||
minted
|
||||
#== 1
|
||||
#&& ptraceIfFalse "Burning a proposal is not supported" (burnt #== 0)
|
||||
|
||||
pguardC "Minted exactly one proposal ST" $
|
||||
mintedProposalST #== 1
|
||||
|
||||
let governorInputRef =
|
||||
let governorRedeemer =
|
||||
passertPJust
|
||||
# "GST should move"
|
||||
#$ pfindJust
|
||||
# plam
|
||||
( flip pletAll $ \inputF ->
|
||||
let value = pfield @"value" # inputF.resolved
|
||||
isGovernorInput =
|
||||
passetClassValueOfT
|
||||
# (ptoScottEncodingT # gstAssetClass)
|
||||
# value
|
||||
#== 1
|
||||
in pif
|
||||
isGovernorInput
|
||||
(pjust # inputF.outRef)
|
||||
pnothing
|
||||
)
|
||||
#$ presolveGovernorRedeemer
|
||||
# (ptoScottEncodingT # gstAssetClass)
|
||||
# pfromData txInfoF.inputs
|
||||
|
||||
governorScriptPurpose =
|
||||
mkRecordConstr
|
||||
PSpending
|
||||
(#_0 .= governorInputRef)
|
||||
|
||||
governorRedeemer =
|
||||
pfromData $
|
||||
pfromJust
|
||||
#$ ptryFromRedeemer @(PAsData PGovernorRedeemer)
|
||||
# governorScriptPurpose
|
||||
# txInfoF.redeemers
|
||||
# txInfoF.redeemers
|
||||
|
||||
pguardC "Govenor redeemer correct" $
|
||||
pcon PCreateProposal #== governorRedeemer
|
||||
|
|
|
|||
|
|
@ -207,7 +207,7 @@ stakePolicy =
|
|||
passetClassValueOfT
|
||||
# (ptoScottEncodingT # gtClass)
|
||||
# outputF.value
|
||||
#== (pfromData datumF.stakedAmount)
|
||||
#== pfromData datumF.stakedAmount
|
||||
, ptraceIfFalse "Stake Owner should sign the transaction" $
|
||||
pauthorizedBy
|
||||
# authorizationContext txInfoF
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue