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

prevent minting multiple into one UTxO; regression tests

Browse source
This commit is contained in:
Hongrui Fang 2022-11-09 17:42:18 +08:00
parent 0eacf1f6f2
commit 287054d95e
8 changed files with 215 additions and 123 deletions
Download patch file Download diff file Expand all files Collapse all files

59
agora-specs/Sample/Proposal/Advance.hs
View file

@ -36,12 +36,13 @@ module Sample.Proposal.Advance (
mkBadGovernorOutputDatumBundle, mkBadGovernorOutputDatumBundle,
mkUnexpectedOutputStakeBundles, mkUnexpectedOutputStakeBundles,
mkFastforwardToFinishBundles, mkFastforwardToFinishBundles,
mkBadGovernorRedeemerBundle,
) where ) where
import Agora.Governor ( import Agora.Governor (
Governor (..), Governor (..),
GovernorDatum (..), GovernorDatum (..),
GovernorRedeemer (MintGATs), GovernorRedeemer (CreateProposal, MintGATs),
) )
import Agora.Proposal ( import Agora.Proposal (
ProposalDatum (..), ProposalDatum (..),
@ -85,6 +86,7 @@ import Plutarch.Context (
timeRange, timeRange,
withDatum, withDatum,
withInlineDatum, withInlineDatum,
withRedeemer,
withRef, withRef,
withValue, withValue,
) )
@ -101,6 +103,7 @@ import PlutusLedgerApi.V2 (
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
ValidatorHash, ValidatorHash,
) )
import PlutusTx qualified
import Sample.Proposal.Shared ( import Sample.Proposal.Shared (
governorTxRef, governorTxRef,
proposalTxRef, proposalTxRef,
@ -165,9 +168,18 @@ data ParameterBundle = ParameterBundle
} }
-- | Everything about the generated governor stuff. -- | 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 { invalidGovernorOutputDatum :: Bool
-- ^ The output governor datum will be changed. -- ^ The output governor datum will be changed.
, governorRedeemer :: redeemer
} }
-- | Everything about the generated authority token stuff. -- | Everything about the generated authority token stuff.
@ -432,7 +444,7 @@ governorRef = TxOutRef governorTxRef 2
governor validator. governor validator.
-} -}
mkGovernorBuilder :: forall b. CombinableBuilder b => GovernorParameters -> b mkGovernorBuilder :: forall b. CombinableBuilder b => GovernorParameters -> b
mkGovernorBuilder ps = mkGovernorBuilder ps@(GovernorParameters _ redeemer) =
let gst = assetClassValue governorAssetClass 1 let gst = assetClassValue governorAssetClass 1
value = sortValue $ gst <> minAda value = sortValue $ gst <> minAda
in mconcat in mconcat
@ -442,6 +454,7 @@ mkGovernorBuilder ps =
, withValue value , withValue value
, withRef governorRef , withRef governorRef
, withDatum governorInputDatum , withDatum governorInputDatum
, withRedeemer redeemer
] ]
, output $ , output $
mconcat 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 -- * Authority Token
@ -538,16 +545,19 @@ mkTestTree name pb val =
proposalInputDatum proposalInputDatum
proposalRedeemer proposalRedeemer
(spend proposalRef) (spend proposalRef)
governor = governor =
maybe [] singleton $ maybe [] singleton $
testValidator ( \(GovernorParameters _ governorRedeemer) ->
(fromJust val.forGovernorValidator) testValidator
"governor" (fromJust val.forGovernorValidator)
governorValidator "governor"
governorInputDatum governorValidator
governorRedeemer governorInputDatum
(spend governorRef) governorRedeemer
<$ pb.governorParameters (spend governorRef)
)
<$> pb.governorParameters
authority = case pb.authorityTokenParameters of authority = case pb.authorityTokenParameters of
[] -> [] [] -> []
@ -827,6 +837,7 @@ mkValidToNextStateBundle nCosigners nEffects authScript from =
gov = gov =
GovernorParameters GovernorParameters
{ invalidGovernorOutputDatum = False { invalidGovernorOutputDatum = False
, governorRedeemer = MintGATs
} }
in b in b
{ governorParameters = Just gov { governorParameters = Just gov
@ -1066,7 +1077,19 @@ mkBadGovernorOutputDatumBundle nCosigners nEffects =
} }
where where
template = mkValidFromLockedBundle nCosigners nEffects 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 :: mkFastforwardToFinishBundles ::
Word -> Word ->

34
agora-specs/Sample/Proposal/Create.hs
View file

@ -19,12 +19,17 @@ module Sample.Proposal.Create (
invalidProposalStatusParameters, invalidProposalStatusParameters,
fakeSSTParameters, fakeSSTParameters,
wrongGovernorRedeemer, wrongGovernorRedeemer,
wrongGovernorRedeemer1,
) where ) where
import Agora.Governor ( import Agora.Governor (
Governor (..), Governor (..),
GovernorDatum (..), GovernorDatum (..),
GovernorRedeemer (CreateProposal, MutateGovernor), GovernorRedeemer (
CreateProposal,
MintGATs,
MutateGovernor
),
) )
import Agora.Proposal ( import Agora.Proposal (
ProposalDatum (..), ProposalDatum (..),
@ -71,6 +76,8 @@ import PlutusLedgerApi.V2 (
Credential (PubKeyCredential), Credential (PubKeyCredential),
POSIXTime (POSIXTime), POSIXTime (POSIXTime),
POSIXTimeRange, POSIXTimeRange,
Redeemer (Redeemer),
ToData (toBuiltinData),
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
always, always,
) )
@ -123,8 +130,8 @@ data Parameters = Parameters
-- ^ The status of the newly created proposal. -- ^ The status of the newly created proposal.
, fakeSST :: Bool , fakeSST :: Bool
-- ^ Whether to use SST that doesn't belong to the stake validator. -- ^ Whether to use SST that doesn't belong to the stake validator.
, wrongGovernorRedeemer :: Bool , governorRedeemer :: Redeemer
-- ^ Use 'MutateGovernor' as the governor redeemer -- ^ The redeemer used to spend the governor.
} }
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -358,7 +365,7 @@ createProposal ps = builder
[ script governorValidatorHash [ script governorValidatorHash
, withValue governorValue , withValue governorValue
, withDatum governorInputDatum , withDatum governorInputDatum
, withRedeemer $ mkGovernorRedeemer ps , withRedeemer ps.governorRedeemer
, withRef governorRef , withRef governorRef
] ]
, output $ , output $
@ -418,13 +425,6 @@ createProposal ps = builder
stakeRedeemer :: StakeRedeemer stakeRedeemer :: StakeRedeemer
stakeRedeemer = PermitVote 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. -- | Mint the PST with an arbitrary redeemer. Doesn't really matter.
proposalPolicyRedeemer :: () proposalPolicyRedeemer :: ()
proposalPolicyRedeemer = () proposalPolicyRedeemer = ()
@ -443,7 +443,7 @@ totallyValidParameters =
, timeRangeClosed = True , timeRangeClosed = True
, proposalStatus = Draft , proposalStatus = Draft
, fakeSST = False , fakeSST = False
, wrongGovernorRedeemer = False , governorRedeemer = Redeemer $ toBuiltinData CreateProposal
} }
invalidOutputGovernorDatumParameters :: Parameters invalidOutputGovernorDatumParameters :: Parameters
@ -505,7 +505,13 @@ fakeSSTParameters =
wrongGovernorRedeemer :: Parameters wrongGovernorRedeemer :: Parameters
wrongGovernorRedeemer = wrongGovernorRedeemer =
totallyValidParameters totallyValidParameters
{ wrongGovernorRedeemer = True { governorRedeemer = Redeemer $ toBuiltinData MintGATs
}
wrongGovernorRedeemer1 :: Parameters
wrongGovernorRedeemer1 =
totallyValidParameters
{ governorRedeemer = Redeemer $ toBuiltinData MutateGovernor
} }
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -540,7 +546,7 @@ mkTestTree
"governor" "governor"
governorValidator governorValidator
governorInputDatum governorInputDatum
(mkGovernorRedeemer ps) ps.governorRedeemer
(spend governorRef) (spend governorRef)
stakeTest = stakeTest =

15
agora-specs/Spec/Proposal.hs
View file

@ -97,6 +97,12 @@ specs =
False False
False False
True True
, Create.mkTestTree
"wrong governor redeemer"
Create.wrongGovernorRedeemer1
False
False
True
] ]
] ]
, group , group
@ -353,6 +359,15 @@ specs =
, forGovernorValidator = Just False , forGovernorValidator = Just False
, forAuthorityTokenPolicy = Just True , 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" $ , group "unlocking" $

69
agora/Agora/AuthorityToken.hs
View file

@ -11,6 +11,7 @@ module Agora.AuthorityToken (
singleAuthorityTokenBurned, singleAuthorityTokenBurned,
) where ) where
import Agora.Governor (PGovernorRedeemer (PMintGATs), presolveGovernorRedeemer)
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag) import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
import Agora.Utils (psymbolValueOfT, ptag, ptoScottEncodingT, puntag) import Agora.Utils (psymbolValueOfT, ptag, ptoScottEncodingT, puntag)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
@ -24,17 +25,14 @@ import Plutarch.Api.V2 (
KeyGuarantees, KeyGuarantees,
PAddress (PAddress), PAddress (PAddress),
PMintingPolicy, PMintingPolicy,
PScriptContext (PScriptContext),
PScriptPurpose (PMinting), PScriptPurpose (PMinting),
PTxInInfo (PTxInInfo), PTxInInfo (PTxInInfo),
PTxInfo (PTxInfo),
PTxOut (PTxOut), PTxOut (PTxOut),
) )
import Plutarch.Extra.AssetClass (PAssetClassData) import Plutarch.Extra.AssetClass (PAssetClassData)
import Plutarch.Extra.Bool (passert) import Plutarch.Extra.Bool (passert)
import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc) import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc)
import Plutarch.Extra.Maybe (pfromJust) import Plutarch.Extra.Maybe (passertPJust, pfromJust)
import Plutarch.Extra.ScriptContext (pisTokenSpent)
import Plutarch.Extra.Sum (PSum (PSum)) import Plutarch.Extra.Sum (PSum (PSum))
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont ( import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
@ -149,33 +147,44 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
-} -}
authorityTokenPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy) authorityTokenPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy)
authorityTokenPolicy = authorityTokenPolicy =
plam $ \gstAssetClass _redeemer ctx' -> plam $ \gstAssetClass _redeemer ctx -> unTermCont $ do
pmatch ctx' $ \(PScriptContext ctx') -> unTermCont $ do ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx' txInfoF <-
PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo pletFieldsC
txInfo <- pletFieldsC @'["inputs", "mint", "outputs"] txInfo' @'[ "inputs"
let inputs = txInfo.inputs , "mint"
govTokenSpent = pisTokenSpent # puntag (ptoScottEncodingT # gstAssetClass) # inputs , "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 <- PPair mintedATs burntATs <-
pmatchC $ pfromJust #$ psymbolValueOf' # ownSymbol # txInfo.mint pmatchC $ pfromJust #$ psymbolValueOf' # ownSymbol # txInfoF.mint
pure $ pure $
popaque $ popaque $
pif pif
(0 #< mintedATs) (0 #< mintedATs)
( unTermCont $ do ( unTermCont $ do
pguardC "No GAT burnt" $ 0 #== burntATs pguardC "No GAT burnt" $ 0 #== burntATs
pguardC "Parent token did not move in minting GATs" govTokenSpent let governorRedeemer =
pguardC "All outputs only emit valid GATs" $ passertPJust
pall # "GST should move"
# plam #$ presolveGovernorRedeemer
(authorityTokensValidIn # ptag ownSymbol #) # (ptoScottEncodingT # gstAssetClass)
# txInfo.outputs # pfromData txInfoF.inputs
pure $ pconstant () # txInfoF.redeemers
) pguardC "Governor redeemr correct" $
(passert "No GAT minted" (0 #== mintedATs) (pconstant ())) 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 ()))

63
agora/Agora/Governor.hs
View file

@ -21,6 +21,7 @@ module Agora.Governor (
pgetNextProposalId, pgetNextProposalId,
getNextProposalId, getNextProposalId,
pisGovernorDatumValid, pisGovernorDatumValid,
presolveGovernorRedeemer,
) where ) where
import Agora.Aeson.Orphans () import Agora.Aeson.Orphans ()
@ -39,21 +40,33 @@ import Agora.Proposal.Time (
pisMaxTimeRangeWidthValid, pisMaxTimeRangeWidthValid,
pisProposalTimingConfigValid, pisProposalTimingConfigValid,
) )
import Agora.SafeMoney (GTTag) import Agora.SafeMoney (GTTag, GovernorSTTag)
import Data.Aeson qualified as Aeson import Data.Aeson qualified as Aeson
import Data.Tagged (Tagged) import Data.Tagged (Tagged)
import Optics.TH (makeFieldLabelsNoPrefix) import Optics.TH (makeFieldLabelsNoPrefix)
import Plutarch.Api.V1.Scripts (PRedeemer)
import Plutarch.Api.V2 (KeyGuarantees (Unsorted), PMap, PScriptPurpose (PSpending), PTxInInfo)
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (DerivePConstantViaData), DerivePConstantViaData (DerivePConstantViaData),
PDataFields, 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 ( import Plutarch.Extra.IsData (
DerivePConstantViaEnum (DerivePConstantEnum), DerivePConstantViaEnum (DerivePConstantEnum),
EnumIsData (EnumIsData), EnumIsData (EnumIsData),
PlutusTypeEnumData, 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 "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pletFieldsC)
import Plutarch.Extra.Value (passetClassValueOfT)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
import PlutusLedgerApi.V1 (TxOutRef) import PlutusLedgerApi.V1 (TxOutRef)
import PlutusTx qualified import PlutusTx qualified
@ -285,3 +298,49 @@ pisGovernorDatumValid = phoistAcyclic $
, ptraceIfFalse "time range valid" $ , ptraceIfFalse "time range valid" $
pisMaxTimeRangeWidthValid # datumF.createProposalTimeRangeMaxWidth 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

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

@ -57,8 +57,8 @@ import Plutarch.Extra.AssetClass (PAssetClassData, passetClass)
import Plutarch.Extra.Field (pletAll, pletAllC) import Plutarch.Extra.Field (pletAll, pletAllC)
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust, plistEqualsBy, pmapMaybe) import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust, plistEqualsBy, pmapMaybe)
import "liqwid-plutarch-extra" Plutarch.Extra.Map (pkeys, ptryLookup) import "liqwid-plutarch-extra" Plutarch.Extra.Map (pkeys, ptryLookup)
import Plutarch.Extra.Maybe (passertPJust, pjust, pmaybe, pmaybeData, pnothing) import Plutarch.Extra.Maybe (passertPJust, pjust, pmaybeData, pnothing)
import Plutarch.Extra.Ord (psort) import Plutarch.Extra.Ord (POrdering (..), pcompareBy, pfromOrd, psort)
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
@ -335,6 +335,8 @@ governorValidator =
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
pstClass <- pletC $ passetClass # pto pstSymbol # pconstant ""
getProposalDatum :: Term _ (PTxOut :--> PMaybe PProposalDatum) <- getProposalDatum :: Term _ (PTxOut :--> PMaybe PProposalDatum) <-
pletC $ pletC $
plam $ plam $
@ -342,8 +344,8 @@ governorValidator =
let isProposalUTxO = let isProposalUTxO =
txOutF.address txOutF.address
#== pdata proposalValidatorAddress #== pdata proposalValidatorAddress
#&& psymbolValueOfT #&& passetClassValueOf
# pstSymbol # pstClass
# txOutF.value # txOutF.value
#== 1 #== 1
@ -388,16 +390,7 @@ governorValidator =
-- Check that exactly one proposal token is being minted. -- Check that exactly one proposal token is being minted.
pguardC "Exactly one proposal token must be minted" $ pguardC "Exactly one proposal token must be minted" $
let vMap = pfromData $ pto txInfoF.mint passetClassValueOf # pstClass # txInfoF.mint #== 1
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
-- Check that a stake is spent to create the propsal, -- Check that a stake is spent to create the propsal,
-- and the value it contains meets the requirement. -- and the value it contains meets the requirement.
@ -510,14 +503,13 @@ governorValidator =
( \output -> unTermCont $ do ( \output -> unTermCont $ do
outputF <- pletFieldsC @'["address", "datum", "value"] output outputF <- pletFieldsC @'["address", "datum", "value"] output
let isAuthorityUTxO = let atAmount =
psymbolValueOfT psymbolValueOfT
# atSymbol # atSymbol
# outputF.value # outputF.value
#== 1
handleAuthorityUTxO = handleAuthorityUTxO =
unTermCont $ do do
receiverScriptHash <- receiverScriptHash <-
pletC $ pletC $
passertPJust passertPJust
@ -556,13 +548,21 @@ governorValidator =
, ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect , ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect
] ]
pure receiverScriptHash pure $ pjust # receiverScriptHash
pure $ pmatchC
pif ( pcompareBy
isAuthorityUTxO # pfromOrd
(pjust # handleAuthorityUTxO) # atAmount
pnothing # 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. -- The sorted hashes of all the GAT receivers.

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

@ -10,7 +10,7 @@ module Agora.Proposal.Scripts (
proposalPolicy, proposalPolicy,
) where ) where
import Agora.Governor (PGovernorRedeemer (PCreateProposal)) import Agora.Governor (PGovernorRedeemer (PCreateProposal), presolveGovernorRedeemer)
import Agora.Proposal ( import Agora.Proposal (
PProposalDatum (PProposalDatum), PProposalDatum (PProposalDatum),
PProposalRedeemer (PAdvanceProposal, PCosign, PUnlockStake, PVote), PProposalRedeemer (PAdvanceProposal, PCosign, PUnlockStake, PVote),
@ -70,7 +70,6 @@ import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
ptryFromOutputDatum, ptryFromOutputDatum,
ptryFromRedeemer,
) )
import Plutarch.Extra.Sum (PSum (PSum)) import Plutarch.Extra.Sum (PSum (PSum))
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
@ -82,7 +81,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
ptryFromC, ptryFromC,
) )
import Plutarch.Extra.Traversable (pfoldMap) import Plutarch.Extra.Traversable (pfoldMap)
import Plutarch.Extra.Value (passetClassValueOfT, psymbolValueOf) import Plutarch.Extra.Value (psymbolValueOf')
import Plutarch.Unsafe (punsafeCoerce) import Plutarch.Unsafe (punsafeCoerce)
{- | Policy for Proposals. {- | Policy for Proposals.
@ -118,44 +117,25 @@ proposalPolicy =
PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatchC $ pfromData ctxF.purpose PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatchC $ pfromData ctxF.purpose
let mintedProposalST = pguardC "Minted exactly one proposal ST"
psymbolValueOf $ pmatch
( pfromJust
#$ psymbolValueOf'
# ownSymbol # ownSymbol
# txInfoF.mint # txInfoF.mint
)
$ \(PPair minted burnt) ->
minted
#== 1
#&& ptraceIfFalse "Burning a proposal is not supported" (burnt #== 0)
pguardC "Minted exactly one proposal ST" $ let governorRedeemer =
mintedProposalST #== 1
let governorInputRef =
passertPJust passertPJust
# "GST should move" # "GST should move"
#$ pfindJust #$ presolveGovernorRedeemer
# plam # (ptoScottEncodingT # gstAssetClass)
( flip pletAll $ \inputF ->
let value = pfield @"value" # inputF.resolved
isGovernorInput =
passetClassValueOfT
# (ptoScottEncodingT # gstAssetClass)
# value
#== 1
in pif
isGovernorInput
(pjust # inputF.outRef)
pnothing
)
# pfromData txInfoF.inputs # pfromData txInfoF.inputs
# txInfoF.redeemers
governorScriptPurpose =
mkRecordConstr
PSpending
(#_0 .= governorInputRef)
governorRedeemer =
pfromData $
pfromJust
#$ ptryFromRedeemer @(PAsData PGovernorRedeemer)
# governorScriptPurpose
# txInfoF.redeemers
pguardC "Govenor redeemer correct" $ pguardC "Govenor redeemer correct" $
pcon PCreateProposal #== governorRedeemer pcon PCreateProposal #== governorRedeemer

2
agora/Agora/Stake/Scripts.hs
View file

@ -207,7 +207,7 @@ stakePolicy =
passetClassValueOfT passetClassValueOfT
# (ptoScottEncodingT # gtClass) # (ptoScottEncodingT # gtClass)
# outputF.value # outputF.value
#== (pfromData datumF.stakedAmount) #== pfromData datumF.stakedAmount
, ptraceIfFalse "Stake Owner should sign the transaction" $ , ptraceIfFalse "Stake Owner should sign the transaction" $
pauthorizedBy pauthorizedBy
# authorizationContext txInfoF # authorizationContext txInfoF