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

handle staking credential transparently

Browse source
This commit is contained in:
Hongrui Fang 2022-11-14 23:33:01 +08:00
parent 0d0e122bd2
commit 9e149c7561
5 changed files with 43 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

20
agora/Agora/Effect/GovernorMutation.hs
View file

@ -40,13 +40,13 @@ import Plutarch.DataRepr (
) )
import Plutarch.Extra.Field (pletAll, pletAllC) import Plutarch.Extra.Field (pletAll, pletAllC)
import "liqwid-plutarch-extra" Plutarch.Extra.List (ptryFromSingleton) import "liqwid-plutarch-extra" Plutarch.Extra.List (ptryFromSingleton)
import Plutarch.Extra.Maybe (passertPJust, pdnothing) import Plutarch.Extra.Maybe (passertPJust, pfromJust)
import Plutarch.Extra.Record (mkRecordConstr, (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.=))
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
paddressFromValidatorHash,
pisScriptAddress, pisScriptAddress,
ptryFromOutputDatum, ptryFromOutputDatum,
ptryFromRedeemer, ptryFromRedeemer,
pvalidatorHashFromAddress,
) )
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC) import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
@ -184,12 +184,7 @@ mutateGovernorValidator =
pany pany
# plam # plam
( flip pletAll $ \inputF -> ( flip pletAll $ \inputF ->
let governorAddress = let isGovernorInput =
paddressFromValidatorHash
# govValidatorHash
# pdnothing
isGovernorInput =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Governor UTxO should carry GST" $ [ ptraceIfFalse "Governor UTxO should carry GST" $
@ -200,9 +195,12 @@ mutateGovernorValidator =
, ptraceIfFalse "Can only modify the pinned governor" $ , ptraceIfFalse "Can only modify the pinned governor" $
inputF.outRef #== effectDatumF.governorRef inputF.outRef #== effectDatumF.governorRef
, ptraceIfFalse "Governor validator run" $ , ptraceIfFalse "Governor validator run" $
pfield @"address" let inputValidatorHash =
# inputF.resolved pfromJust
#== governorAddress #$ pvalidatorHashFromAddress
#$ pfield @"address"
# inputF.resolved
in inputValidatorHash #== govValidatorHash
] ]
in isGovernorInput in isGovernorInput
) )

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

@ -42,11 +42,11 @@ import Agora.Stake (
presolveStakeInputDatum, presolveStakeInputDatum,
) )
import Agora.Utils (psymbolValueOfT, ptoScottEncodingT, puntag) import Agora.Utils (psymbolValueOfT, ptoScottEncodingT, puntag)
import Plutarch.Api.V1 (PCurrencySymbol) import Data.Function (on)
import Plutarch.Api.V1 (PCurrencySymbol, PValidatorHash)
import Plutarch.Api.V1.AssocMap (plookup) import Plutarch.Api.V1.AssocMap (plookup)
import Plutarch.Api.V1.AssocMap qualified as AssocMap import Plutarch.Api.V1.AssocMap qualified as AssocMap
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
PAddress,
PMintingPolicy, PMintingPolicy,
PScriptPurpose (PMinting, PSpending), PScriptPurpose (PMinting, PSpending),
PTxOut, PTxOut,
@ -57,7 +57,7 @@ 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, pmaybeData, pnothing) import Plutarch.Extra.Maybe (passertPJust, pfromJust, pjust, pmaybeData, pnothing)
import Plutarch.Extra.Ord (POrdering (..), pcompareBy, pfromOrd, 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 (
@ -67,6 +67,7 @@ import Plutarch.Extra.ScriptContext (
pscriptHashToTokenName, pscriptHashToTokenName,
ptryFromDatumHash, ptryFromDatumHash,
ptryFromOutputDatum, ptryFromOutputDatum,
pvalidatorHashFromAddress,
pvalueSpent, pvalueSpent,
) )
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
@ -263,7 +264,7 @@ governorPolicy =
governorValidator :: governorValidator ::
-- | Lazy precompiled scripts. -- | Lazy precompiled scripts.
ClosedTerm ClosedTerm
( PAddress ( PValidatorHash
:--> PTagged StakeSTTag PAssetClassData :--> PTagged StakeSTTag PAssetClassData
:--> PTagged GovernorSTTag PCurrencySymbol :--> PTagged GovernorSTTag PCurrencySymbol
:--> PTagged ProposalSTTag PCurrencySymbol :--> PTagged ProposalSTTag PCurrencySymbol
@ -271,7 +272,7 @@ governorValidator ::
:--> PValidator :--> PValidator
) )
governorValidator = governorValidator =
plam $ \proposalValidatorAddress sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do plam $ \proposalValidatorHash sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do
ctxF <- pletAllC ctx ctxF <- pletAllC ctx
txInfo <- pletC $ pfromData ctxF.txInfo txInfo <- pletC $ pfromData ctxF.txInfo
txInfoF <- txInfoF <-
@ -316,7 +317,9 @@ governorValidator =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Own by governor validator" $ [ ptraceIfFalse "Own by governor validator" $
outputF.address #== governorInputF.address ((#==) `on` (pvalidatorHashFromAddress #))
outputF.address
governorInputF.address
, ptraceIfFalse "Has governor ST" $ , ptraceIfFalse "Has governor ST" $
psymbolValueOfT # gstSymbol # outputF.value #== 1 psymbolValueOfT # gstSymbol # outputF.value #== 1
] ]
@ -342,8 +345,8 @@ governorValidator =
plam $ plam $
flip (pletFields @'["value", "datum", "address"]) $ \txOutF -> flip (pletFields @'["value", "datum", "address"]) $ \txOutF ->
let isProposalUTxO = let isProposalUTxO =
txOutF.address (pfromJust #$ pvalidatorHashFromAddress # pfromData txOutF.address)
#== pdata proposalValidatorAddress #== proposalValidatorHash
#&& passetClassValueOf #&& passetClassValueOf
# pstClass # pstClass
# txOutF.value # txOutF.value

15
agora/Agora/Linker.hs
View file

@ -4,14 +4,13 @@ module Agora.Linker (linker, AgoraScriptInfo (..)) where
import Agora.Governor (Governor (gstOutRef, gtClassRef, maximumCosigners)) import Agora.Governor (Governor (gstOutRef, gtClassRef, maximumCosigners))
import Agora.SafeMoney (AuthorityTokenTag, GTTag, GovernorSTTag, ProposalSTTag, StakeSTTag) import Agora.SafeMoney (AuthorityTokenTag, GTTag, GovernorSTTag, ProposalSTTag, StakeSTTag)
import Agora.Utils (validatorHashToAddress)
import Data.Aeson qualified as Aeson import Data.Aeson qualified as Aeson
import Data.Map (fromList) import Data.Map (fromList)
import Data.Tagged (Tagged (Tagged)) import Data.Tagged (Tagged (Tagged))
import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash) import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash)
import Plutarch.Extra.AssetClass (AssetClass (AssetClass)) import Plutarch.Extra.AssetClass (AssetClass (AssetClass))
import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import Plutarch.Extra.ScriptContext (validatorHashToTokenName)
import PlutusLedgerApi.V1 (Address, CurrencySymbol, TxOutRef, ValidatorHash) import PlutusLedgerApi.V1 (CurrencySymbol, TxOutRef, ValidatorHash)
import Ply ( import Ply (
ScriptRole (MintingPolicyRole, ValidatorRole), ScriptRole (MintingPolicyRole, ValidatorRole),
toMintingPolicy, toMintingPolicy,
@ -55,7 +54,7 @@ linker = do
govVal <- govVal <-
fetchTS fetchTS
@ValidatorRole @ValidatorRole
@'[ Address @'[ ValidatorHash
, Tagged StakeSTTag AssetClass , Tagged StakeSTTag AssetClass
, Tagged GovernorSTTag CurrencySymbol , Tagged GovernorSTTag CurrencySymbol
, Tagged ProposalSTTag CurrencySymbol , Tagged ProposalSTTag CurrencySymbol
@ -111,7 +110,10 @@ linker = do
mutateGovVal <- mutateGovVal <-
fetchTS fetchTS
@ValidatorRole @ValidatorRole
@'[ValidatorHash, Tagged GovernorSTTag CurrencySymbol, Tagged AuthorityTokenTag CurrencySymbol] @'[ ValidatorHash
, Tagged GovernorSTTag CurrencySymbol
, Tagged AuthorityTokenTag CurrencySymbol
]
"agora:mutateGovernorValidator" "agora:mutateGovernorValidator"
governor <- getParam governor <- getParam
@ -119,7 +121,7 @@ linker = do
let govPol' = govPol # governor.gstOutRef let govPol' = govPol # governor.gstOutRef
govVal' = govVal' =
govVal govVal
# propValAddress # propValHash
# Tagged sstAssetClass # Tagged sstAssetClass
# Tagged gstSymbol # Tagged gstSymbol
# Tagged pstSymbol # Tagged pstSymbol
@ -142,8 +144,7 @@ linker = do
# Tagged gstSymbol # Tagged gstSymbol
# Tagged pstSymbol # Tagged pstSymbol
# governor.maximumCosigners # governor.maximumCosigners
propValAddress = propValHash = validatorHash $ toValidator propVal'
validatorHashToAddress $ validatorHash $ toValidator propVal'
pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol' pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol'
pstAssetClass = AssetClass pstSymbol "" pstAssetClass = AssetClass pstSymbol ""

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

@ -37,6 +37,7 @@ import Agora.Stake (
presolveStakeInputDatum, presolveStakeInputDatum,
) )
import Agora.Utils (psymbolValueOfT, ptoScottEncodingT) import Agora.Utils (psymbolValueOfT, ptoScottEncodingT)
import Data.Function (on)
import Plutarch.Api.V1 (PCredential, PCurrencySymbol) import Plutarch.Api.V1 (PCredential, PCurrencySymbol)
import Plutarch.Api.V1.AssocMap (plookup) import Plutarch.Api.V1.AssocMap (plookup)
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
@ -70,6 +71,7 @@ import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
ptryFromOutputDatum, ptryFromOutputDatum,
pvalidatorHashFromAddress,
) )
import Plutarch.Extra.Sum (PSum (PSum)) import Plutarch.Extra.Sum (PSum (PSum))
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
@ -281,7 +283,9 @@ proposalValidator =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Own by proposal validator" $ [ ptraceIfFalse "Own by proposal validator" $
outputF.address #== proposalInputF.address ((#==) `on` (pvalidatorHashFromAddress #))
outputF.address
proposalInputF.address
, ptraceIfFalse "Has proposal ST" $ , ptraceIfFalse "Has proposal ST" $
psymbolValueOfT # pstSymbol # outputF.value #== 1 psymbolValueOfT # pstSymbol # outputF.value #== 1
] ]

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

@ -90,6 +90,7 @@ import Plutarch.Extra.Ord (POrdering (PEQ, PGT, PLT), pcompareBy, pfromOrd)
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
ptryFromOutputDatum, ptryFromOutputDatum,
pvalidatorHashFromAddress,
pvalidatorHashToTokenName, pvalidatorHashToTokenName,
pvalueSpent, pvalueSpent,
) )
@ -270,17 +271,14 @@ mkStakeValidator impl sstSymbol pstClass gtClass =
# (pfield @"_0" # stakeInputRef) # (pfield @"_0" # stakeInputRef)
# txInfoF.inputs # txInfoF.inputs
stakeValidatorCredential <- stakeValidatorHash <-
pletC $ pletC $
pfield @"credential" pfromJust
#$ pvalidatorHashFromAddress
#$ pfield @"address" #$ pfield @"address"
# validatedInput # validatedInput
let sstName = pvalidatorHashToTokenName $ let sstName = pvalidatorHashToTokenName stakeValidatorHash
pmatch stakeValidatorCredential $
\case
PScriptCredential r -> pfield @"_0" # r
_ -> perror
sstClass <- pletC $ passetClass # puntag sstSymbol # sstName sstClass <- pletC $ passetClass # puntag sstSymbol # sstName
@ -302,10 +300,13 @@ mkStakeValidator impl sstSymbol pstClass gtClass =
PGT -> ptraceError "More than one SST in one UTxO" PGT -> ptraceError "More than one SST in one UTxO"
-- 1 -- 1
PEQ -> PEQ ->
let ownerCredential = pfield @"credential" # txOutF.address let ownerValidatoHash =
pfromJust
#$ pvalidatorHashFromAddress
# txOutF.address
isOwnedByStakeValidator = isOwnedByStakeValidator =
ownerCredential #== stakeValidatorCredential ownerValidatoHash #== stakeValidatorHash
datum = datum =
ptrace "Resolve stake datum" $ ptrace "Resolve stake datum" $