diff --git a/agora/Agora/Effect/GovernorMutation.hs b/agora/Agora/Effect/GovernorMutation.hs index 6cb0b42..7137186 100644 --- a/agora/Agora/Effect/GovernorMutation.hs +++ b/agora/Agora/Effect/GovernorMutation.hs @@ -40,13 +40,13 @@ import Plutarch.DataRepr ( ) import Plutarch.Extra.Field (pletAll, pletAllC) 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.ScriptContext ( - paddressFromValidatorHash, pisScriptAddress, ptryFromOutputDatum, ptryFromRedeemer, + pvalidatorHashFromAddress, ) import Plutarch.Extra.Tagged (PTagged) import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC) @@ -184,12 +184,7 @@ mutateGovernorValidator = pany # plam ( flip pletAll $ \inputF -> - let governorAddress = - paddressFromValidatorHash - # govValidatorHash - # pdnothing - - isGovernorInput = + let isGovernorInput = foldl1 (#&&) [ ptraceIfFalse "Governor UTxO should carry GST" $ @@ -200,9 +195,12 @@ mutateGovernorValidator = , ptraceIfFalse "Can only modify the pinned governor" $ inputF.outRef #== effectDatumF.governorRef , ptraceIfFalse "Governor validator run" $ - pfield @"address" - # inputF.resolved - #== governorAddress + let inputValidatorHash = + pfromJust + #$ pvalidatorHashFromAddress + #$ pfield @"address" + # inputF.resolved + in inputValidatorHash #== govValidatorHash ] in isGovernorInput ) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 6c5c0ab..c663244 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -42,11 +42,11 @@ import Agora.Stake ( presolveStakeInputDatum, ) 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 qualified as AssocMap import Plutarch.Api.V2 ( - PAddress, PMintingPolicy, PScriptPurpose (PMinting, PSpending), PTxOut, @@ -57,7 +57,7 @@ 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, pmaybeData, pnothing) +import Plutarch.Extra.Maybe (passertPJust, pfromJust, pjust, pmaybeData, pnothing) import Plutarch.Extra.Ord (POrdering (..), pcompareBy, pfromOrd, psort) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.ScriptContext ( @@ -67,6 +67,7 @@ import Plutarch.Extra.ScriptContext ( pscriptHashToTokenName, ptryFromDatumHash, ptryFromOutputDatum, + pvalidatorHashFromAddress, pvalueSpent, ) import Plutarch.Extra.Tagged (PTagged) @@ -263,7 +264,7 @@ governorPolicy = governorValidator :: -- | Lazy precompiled scripts. ClosedTerm - ( PAddress + ( PValidatorHash :--> PTagged StakeSTTag PAssetClassData :--> PTagged GovernorSTTag PCurrencySymbol :--> PTagged ProposalSTTag PCurrencySymbol @@ -271,7 +272,7 @@ governorValidator :: :--> PValidator ) 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 txInfo <- pletC $ pfromData ctxF.txInfo txInfoF <- @@ -316,7 +317,9 @@ governorValidator = foldl1 (#&&) [ ptraceIfFalse "Own by governor validator" $ - outputF.address #== governorInputF.address + ((#==) `on` (pvalidatorHashFromAddress #)) + outputF.address + governorInputF.address , ptraceIfFalse "Has governor ST" $ psymbolValueOfT # gstSymbol # outputF.value #== 1 ] @@ -342,8 +345,8 @@ governorValidator = plam $ flip (pletFields @'["value", "datum", "address"]) $ \txOutF -> let isProposalUTxO = - txOutF.address - #== pdata proposalValidatorAddress + (pfromJust #$ pvalidatorHashFromAddress # pfromData txOutF.address) + #== proposalValidatorHash #&& passetClassValueOf # pstClass # txOutF.value diff --git a/agora/Agora/Linker.hs b/agora/Agora/Linker.hs index 7817cdd..e4d7bf1 100644 --- a/agora/Agora/Linker.hs +++ b/agora/Agora/Linker.hs @@ -4,14 +4,13 @@ module Agora.Linker (linker, AgoraScriptInfo (..)) where import Agora.Governor (Governor (gstOutRef, gtClassRef, maximumCosigners)) import Agora.SafeMoney (AuthorityTokenTag, GTTag, GovernorSTTag, ProposalSTTag, StakeSTTag) -import Agora.Utils (validatorHashToAddress) import Data.Aeson qualified as Aeson import Data.Map (fromList) import Data.Tagged (Tagged (Tagged)) import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash) import Plutarch.Extra.AssetClass (AssetClass (AssetClass)) import Plutarch.Extra.ScriptContext (validatorHashToTokenName) -import PlutusLedgerApi.V1 (Address, CurrencySymbol, TxOutRef, ValidatorHash) +import PlutusLedgerApi.V1 (CurrencySymbol, TxOutRef, ValidatorHash) import Ply ( ScriptRole (MintingPolicyRole, ValidatorRole), toMintingPolicy, @@ -55,7 +54,7 @@ linker = do govVal <- fetchTS @ValidatorRole - @'[ Address + @'[ ValidatorHash , Tagged StakeSTTag AssetClass , Tagged GovernorSTTag CurrencySymbol , Tagged ProposalSTTag CurrencySymbol @@ -111,7 +110,10 @@ linker = do mutateGovVal <- fetchTS @ValidatorRole - @'[ValidatorHash, Tagged GovernorSTTag CurrencySymbol, Tagged AuthorityTokenTag CurrencySymbol] + @'[ ValidatorHash + , Tagged GovernorSTTag CurrencySymbol + , Tagged AuthorityTokenTag CurrencySymbol + ] "agora:mutateGovernorValidator" governor <- getParam @@ -119,7 +121,7 @@ linker = do let govPol' = govPol # governor.gstOutRef govVal' = govVal - # propValAddress + # propValHash # Tagged sstAssetClass # Tagged gstSymbol # Tagged pstSymbol @@ -142,8 +144,7 @@ linker = do # Tagged gstSymbol # Tagged pstSymbol # governor.maximumCosigners - propValAddress = - validatorHashToAddress $ validatorHash $ toValidator propVal' + propValHash = validatorHash $ toValidator propVal' pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol' pstAssetClass = AssetClass pstSymbol "" diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 0a10b6e..72cb906 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -37,6 +37,7 @@ import Agora.Stake ( presolveStakeInputDatum, ) import Agora.Utils (psymbolValueOfT, ptoScottEncodingT) +import Data.Function (on) import Plutarch.Api.V1 (PCredential, PCurrencySymbol) import Plutarch.Api.V1.AssocMap (plookup) import Plutarch.Api.V2 ( @@ -70,6 +71,7 @@ import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.ScriptContext ( pfindTxInByTxOutRef, ptryFromOutputDatum, + pvalidatorHashFromAddress, ) import Plutarch.Extra.Sum (PSum (PSum)) import Plutarch.Extra.Tagged (PTagged) @@ -281,7 +283,9 @@ proposalValidator = foldl1 (#&&) [ ptraceIfFalse "Own by proposal validator" $ - outputF.address #== proposalInputF.address + ((#==) `on` (pvalidatorHashFromAddress #)) + outputF.address + proposalInputF.address , ptraceIfFalse "Has proposal ST" $ psymbolValueOfT # pstSymbol # outputF.value #== 1 ] diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index 0be84e2..24d407d 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -90,6 +90,7 @@ import Plutarch.Extra.Ord (POrdering (PEQ, PGT, PLT), pcompareBy, pfromOrd) import Plutarch.Extra.ScriptContext ( pfindTxInByTxOutRef, ptryFromOutputDatum, + pvalidatorHashFromAddress, pvalidatorHashToTokenName, pvalueSpent, ) @@ -270,17 +271,14 @@ mkStakeValidator impl sstSymbol pstClass gtClass = # (pfield @"_0" # stakeInputRef) # txInfoF.inputs - stakeValidatorCredential <- + stakeValidatorHash <- pletC $ - pfield @"credential" + pfromJust + #$ pvalidatorHashFromAddress #$ pfield @"address" # validatedInput - let sstName = pvalidatorHashToTokenName $ - pmatch stakeValidatorCredential $ - \case - PScriptCredential r -> pfield @"_0" # r - _ -> perror + let sstName = pvalidatorHashToTokenName stakeValidatorHash sstClass <- pletC $ passetClass # puntag sstSymbol # sstName @@ -302,10 +300,13 @@ mkStakeValidator impl sstSymbol pstClass gtClass = PGT -> ptraceError "More than one SST in one UTxO" -- 1 PEQ -> - let ownerCredential = pfield @"credential" # txOutF.address + let ownerValidatoHash = + pfromJust + #$ pvalidatorHashFromAddress + # txOutF.address isOwnedByStakeValidator = - ownerCredential #== stakeValidatorCredential + ownerValidatoHash #== stakeValidatorHash datum = ptrace "Resolve stake datum" $