From 45d91b5aeb2ad189736fa8d0be9012a2d0d4c0ad Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 29 Apr 2022 21:27:31 +0800 Subject: [PATCH] fix compilation errors introduced by new util functions ... and export a bunch of bridge functions from the governor --- agora/Agora/AuthorityToken.hs | 2 +- agora/Agora/Governor.hs | 21 ++- agora/Agora/Governor/Scripts.hs | 266 ++++++++++++++++++-------------- agora/Agora/Utils.hs | 27 ++-- 4 files changed, 188 insertions(+), 128 deletions(-) diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index d18321d..38f45f4 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -24,11 +24,11 @@ import Plutarch.Api.V1 ( PTxOut (..), ) import Plutarch.Api.V1.AssocMap (PMap (PMap)) +import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf) import Plutarch.Api.V1.Value (PValue (PValue)) import Plutarch.Builtin (pforgetData) import Plutarch.Monadic qualified as P import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) -import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf) import Prelude diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index bd3b375..57e40f1 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -16,6 +16,9 @@ module Agora.Governor ( -- * Plutarch-land PGovernorDatum (..), PGovernorRedeemer (..), + + -- * Plutus Utilities + pgetNextProposalId, ) where -------------------------------------------------------------------------------- @@ -27,7 +30,7 @@ import Generics.SOP (Generic, I (I)) -------------------------------------------------------------------------------- import Agora.Proposal ( - PProposalId , + PProposalId (..), PProposalThresholds, ProposalId, ProposalThresholds, @@ -41,7 +44,7 @@ import Plutarch.DataRepr ( PDataFields, PIsDataReprInstances (PIsDataReprInstances), ) -import Plutarch.Lift (PUnsafeLiftDecl (..)) +import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) import Plutarch.SafeMoney (Tagged (..)) import Plutarch.TryFrom (PTryFrom (..)) import Plutarch.Unsafe (punsafeCoerce) @@ -95,6 +98,10 @@ data Governor = Governor { gstOutRef :: TxOutRef -- ^ Referenced utxo will be spent to mint the GST. , gtClassRef :: Tagged GTTag AssetClass + -- ^ Governance token of the system. + , maximumCosigners :: Integer + -- ^ Arbitrary limit for maximum amount of cosigners on a proposal. + -- See `Agora.Proposal.proposalDatumValid`. } -------------------------------------------------------------------------------- @@ -118,7 +125,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum via PIsDataReprInstances PGovernorDatum instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum -deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstant GovernorDatum) +deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstantDecl GovernorDatum) -- FIXME: derive this via 'PIsDataReprInstances' -- Blocked by: PProposalThresholds @@ -140,6 +147,12 @@ data PGovernorRedeemer (s :: S) via PIsDataReprInstances PGovernorRedeemer instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer -deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstant GovernorRedeemer) +deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstantDecl GovernorRedeemer) deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom PData (PAsData PGovernorRedeemer) + +-------------------------------------------------------------------------------- + +-- | Get next proposal id. +pgetNextProposalId :: Term s (PProposalId :--> PProposalId) +pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 91cd640..ee4a052 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -13,17 +13,21 @@ module Agora.Governor.Scripts ( governorPolicy, governorValidator, - -- * Utilities - gstAssetClass, - gatSymbol, - pgetNextProposalId, + -- * Bridges + governorSTSymbolFromGovernor, + governorSTAssetClassFromGovernor, + atSymbolFromGovernor, + proposalSTAssetClassFromGovernor, + stakeSTSymbolFromGovernor, + stakeFromGovernor, + stakeValidatorHashFromGovernor, + proposalFromGovernor, + proposalValidatorHashFromGovernor, ) where -import Agora.Governor ( - Governor (gstOutRef, gtClassRef), - PGovernorDatum (PGovernorDatum), - PGovernorRedeemer (PCreateProposal, PMintGATs, PMutateGovernor), - ) +-------------------------------------------------------------------------------- + +import Data.Coerce (coerce) -------------------------------------------------------------------------------- @@ -33,6 +37,12 @@ import Agora.AuthorityToken ( authorityTokensValidIn, singleAuthorityTokenBurned, ) +import Agora.Governor ( + Governor (gstOutRef, gtClassRef, maximumCosigners), + PGovernorDatum (PGovernorDatum), + PGovernorRedeemer (PCreateProposal, PMintGATs, PMutateGovernor), + pgetNextProposalId, + ) import Agora.Proposal ( PProposalDatum (..), PProposalId (..), @@ -41,6 +51,8 @@ import Agora.Proposal ( Proposal (..), ProposalStatus (Draft, Locked), proposalDatumValid, + ) +import Agora.Proposal.Scripts ( proposalPolicy, proposalValidator, ) @@ -49,6 +61,8 @@ import Agora.Stake ( PProposalLock (..), PStakeDatum (..), Stake (..), + ) +import Agora.Stake.Scripts ( stakePolicy, stakeValidator, ) @@ -59,8 +73,6 @@ import Agora.Utils ( mustBePJust, mustFindDatum', passert, - passetClassValueOf, - passetClassValueOf', pfindDatum, pfindTxInByTxOutRef, pisDJust, @@ -70,11 +82,11 @@ import Agora.Utils ( ptxSignedBy, pvalueSpent, scriptHashFromAddress, + validatorHashToAddress, ) -------------------------------------------------------------------------------- -import Plutarch (popaque) import Plutarch.Api.V1 ( PAddress, PCurrencySymbol, @@ -92,7 +104,8 @@ import Plutarch.Api.V1 ( validatorHash, ) import Plutarch.Api.V1.Extra ( - pownMintValue, + passetClass, + passetClassValueOf, ) import Plutarch.Builtin (pforgetData) import Plutarch.Map.Extra ( @@ -104,18 +117,18 @@ import Plutarch.Monadic qualified as P import Plutarch.SafeMoney ( PDiscrete, puntag, - pvalueDiscrete, + pvalueDiscrete', ) import Plutarch.TryFrom (ptryFrom) -------------------------------------------------------------------------------- import Plutus.V1.Ledger.Api ( - Address (Address), - Credential (ScriptCredential), CurrencySymbol (..), MintingPolicy, + TokenName (..), ) +import Plutus.V1.Ledger.Scripts (ValidatorHash (..)) import Plutus.V1.Ledger.Value ( AssetClass (..), ) @@ -123,13 +136,13 @@ import Plutus.V1.Ledger.Value ( -------------------------------------------------------------------------------- {- $gst - Governance state token, aka. GST, is an NFT that identifies a UTXO that + Governance state token, aka. GST, is an NFT that identifies a UTXO that carries the state datum of the Governance script. - This token is minted by a one-shot monetary policy 'governorPolicy', + This token is minted by a one-shot monetary policy 'governorPolicy', meaning that the token has guaranteed uniqueness. - The 'governorValidator' ensures that exactly one GST stays + The 'governorValidator' ensures that exactly one GST stays at the address of itself forever. -} @@ -152,15 +165,17 @@ governorPolicy gov = let oref = pconstant gov.gstOutRef PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatch (pfromData $ pfield @"purpose" # ctx') + let ownAssetClass = passetClass # ownSymbol # pconstant "" + txInfo = pfromData $ pfield @"txInfo" # ctx' - mintValue <- plet $ pownMintValue # ctx' + txInfoF <- pletFields @'["mint", "inputs"] txInfo passert "Referenced utxo should be spent" $ - pisUTXOSpent # oref #$ pfield @"txInfo" # ctx' + pisUTXOSpent # oref # txInfoF.inputs passert "Exactly one token should be minted" $ - psymbolValueOf # ownSymbol # mintValue #== 1 - #&& passetClassValueOf # ownSymbol # pconstant "" # mintValue #== 1 + psymbolValueOf # ownSymbol # txInfoF.mint #== 1 + #&& passetClassValueOf # txInfoF.mint # ownAssetClass #== 1 popaque (pconstant ()) @@ -255,32 +270,30 @@ governorValidator gov = ctx <- pletFields @'["txInfo", "purpose"] ctx' txInfo' <- plet $ pfromData $ ctx.txInfo - txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo' + txInfo <- pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo' - datums <- plet $ pfromData $ pfield @"data" # txInfo' - - valueSpent <- plet $ pvalueSpent # txInfo' + valueSpent <- plet $ pvalueSpent # txInfo.inputs PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose let txOutRef = pfromData txOutRef' - PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo' + PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo.inputs ownInput <- pletFields @'["address", "value"] ownInput' let selfAddress = pfromData $ ownInput.address (pfromData -> (oldParams' :: Term _ PGovernorDatum), _) <- ptryFrom datum' oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' - let ownInputGSTAmount = stateTokenValueOf # ownInput.value + let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInput.value passert "Own input should have exactly one state token" $ ownInputGSTAmount #== 1 - ownOutputs <- plet $ findOutputsToAddress # txInfo' # selfAddress + ownOutputs <- plet $ findOutputsToAddress # txInfo.outputs # selfAddress passert "Exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs - let ownOuputGSTAmount = stateTokenValueOf # ownOutput.value + let ownOuputGSTAmount = psymbolValueOf # pgstSymbol # ownOutput.value passert "State token should stay at governor's address" $ ownOuputGSTAmount #== 1 passert "Output utxo to governor should have datum" $ @@ -293,7 +306,7 @@ governorValidator gov = pforgetData $ pdata $ mustBePJust # "Ouput governor state datum not found" - #$ pfindDatum # outputGovernorStateDatumHash # txInfo' + #$ pfindDatum # outputGovernorStateDatumHash # txInfo.datums pmatch redeemer $ \case PCreateProposal _ -> P.do @@ -308,7 +321,7 @@ governorValidator gov = newDatumData #== pforgetData (pdata expectedNewDatum) passert "Exactly one proposal token must be minted" $ - hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint + hasOnlyOneTokenOfCurrencySymbol # ppstSymbol # txInfo.mint -- @@ -321,7 +334,7 @@ governorValidator gov = txOut <- pletFields @'["address", "value"] txOut' txOut.address #== pdata pstakeValidatorAddress - #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 + #&& psymbolValueOf # psstSymbol # txOut.value #== 1 ) # pfromData txInfo.inputs @@ -337,7 +350,7 @@ governorValidator gov = passert "Stake input must have datum" $ pisDJust # stakeInputDatumHash - let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInputDatumHash # datums + let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInputDatumHash # txInfo.datums stakeInputDatum <- pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum' @@ -346,7 +359,7 @@ governorValidator gov = stakeInputDatum.stakedAmount #< (pgtValueOf # valueSpent) passert "Tx should be signed by the stake owner" $ - ptxSignedBy # txInfo' # stakeInputDatum.owner + ptxSignedBy # txInfo.signatories # stakeInputDatum.owner -- @@ -359,7 +372,7 @@ governorValidator gov = txOut <- pletFields @'["address", "value"] txOut' txOut.address #== pdata pproposalValidatorAddress - #&& psymbolValueOf # pproposalSymbol # txOut.value #== 1 + #&& psymbolValueOf # ppstSymbol # txOut.value #== 1 ) # pfromData txInfo.outputs @@ -375,18 +388,18 @@ governorValidator gov = plet $ mustFindDatum' @PProposalDatum # outputDatumHash - # datums + # txInfo.datums passert "Proposal datum must be valid" $ - proposalDatumValid # outputProposalDatum' + proposalDatumValid' # outputProposalDatum' outputProposalDatum <- pletFields - @'["id", "status", "cosigners", "thresholds", "votes"] + @'["proposalId", "status", "cosigners", "thresholds", "votes"] outputProposalDatum' passert "Invalid proposal id in proposal datum" $ - outputProposalDatum.id #== oldParams.nextProposalId + outputProposalDatum.proposalId #== oldParams.nextProposalId passert "Invalid thresholds in proposal datum" $ outputProposalDatum.thresholds #== oldParams.proposalThresholds @@ -416,7 +429,7 @@ governorValidator gov = txOut <- pletFields @'["address", "value"] txOut' txOut.address #== pdata pstakeValidatorAddress - #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 + #&& psymbolValueOf # psstSymbol # txOut.value #== 1 ) # pfromData txInfo.outputs @@ -433,7 +446,7 @@ governorValidator gov = stakeOutputDatum = pforgetData $ pdata $ - mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo' + mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo.datums let possibleVoteResults = pkeys #$ pto $ pfromData outputProposalDatum.votes @@ -450,7 +463,7 @@ governorValidator gov = expectedProposalLocks = pconcat # stakeInputDatum.lockedBy - #$ pmap # (mkProposalLock # outputProposalDatum.id) # possibleVoteResults + #$ pmap # (mkProposalLock # outputProposalDatum.proposalId) # possibleVoteResults expectedOutputDatum = pforgetData $ @@ -472,7 +485,7 @@ governorValidator gov = pfilter # plam ( \((pfield @"value" #) . (pfield @"resolved" #) -> value) -> - psymbolValueOf # pproposalSymbol # value #== 1 + psymbolValueOf # ppstSymbol # value #== 1 ) #$ pfromData txInfo.inputs @@ -481,13 +494,13 @@ governorValidator gov = pfilter # plam ( \((pfield @"value" #) -> value) -> - psymbolValueOf # pproposalSymbol # value #== 1 + psymbolValueOf # ppstSymbol # value #== 1 ) #$ pfromData txInfo.outputs passert "The governor can only process one proposal at a time" $ plength # inputsWithProposalStateToken #== 1 - #&& (psymbolValueOf # pproposalSymbol #$ pvalueSpent # txInfo') #== 1 + #&& (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfo.inputs) #== 1 proposalInputTxOut <- pletFields @'["address", "value", "datumHash"] $ @@ -503,19 +516,19 @@ governorValidator gov = plet $ mustFindDatum' @PProposalDatum # proposalInputTxOut.datumHash - # datums + # txInfo.datums outputProposalDatum' <- plet $ mustFindDatum' @PProposalDatum # proposalOutputTxOut.datumHash - # datums + # txInfo.datums passert "Proposal datum must be valid" $ - proposalDatumValid # inputProposalDatum' - #&& proposalDatumValid # outputProposalDatum' + proposalDatumValid' # inputProposalDatum' + #&& proposalDatumValid' # outputProposalDatum' inputProposalDatum <- - pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] + pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes"] inputProposalDatum' passert "Proposal must be in locked(executable) state in order to execute effects" $ @@ -526,7 +539,7 @@ governorValidator gov = pdata $ pcon $ PProposalDatum $ - pdcons @"id" # inputProposalDatum.id + pdcons @"proposalId" # inputProposalDatum.proposalId #$ pdcons @"effects" # inputProposalDatum.effects #$ pdcons @"status" # pdata (pcon $ PFinished pdnil) #$ pdcons @"cosigners" # inputProposalDatum.cosigners @@ -572,7 +585,7 @@ governorValidator gov = gatCount <- plet $ plength #$ pto $ pto effectGroup passert "Required amount of GATs should be minted" $ - psymbolValueOf # pproposalSymbol # txInfo.mint #== gatCount + psymbolValueOf # ppstSymbol # txInfo.mint #== gatCount outputsWithGAT <- plet $ @@ -580,7 +593,7 @@ governorValidator gov = # phoistAcyclic ( plam ( \((pfield @"value" #) -> value) -> - 0 #< psymbolValueOf # pgatSymbol # value + 0 #< psymbolValueOf # patSymbol # value ) ) # pfromData txInfo.outputs @@ -606,7 +619,7 @@ governorValidator gov = mustBePJust # "Receiver is not in the effect list" #$ plookup # scriptHash # effects - passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSymbol # output' + passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # patSymbol # output' passert "Unexpected datum" $ datumHash #== expectedDatumHash pconstant () ) @@ -619,82 +632,111 @@ governorValidator gov = # pconstant () # outputsWithGAT PMutateGovernor _ -> P.do - popaque $ singleAuthorityTokenBurned pgatSymbol ctx.txInfo txInfo.mint + popaque $ singleAuthorityTokenBurned patSymbol ctx.txInfo txInfo.mint where - stateTokenAssetClass :: AssetClass - stateTokenAssetClass = gstAssetClass gov + pgtValueOf :: Term s (PValue :--> PDiscrete GTTag) + pgtValueOf = phoistAcyclic $ pvalueDiscrete' gov.gtClassRef - outputProposalDatum :: Proposal - outputProposalDatum = - Proposal - { governorSTAssetClass = stateTokenAssetClass - } + patSymbol :: Term s PCurrencySymbol + patSymbol = phoistAcyclic $ pconstant $ atSymbolFromGovernor gov - proposalSymbol :: CurrencySymbol - proposalSymbol = mintingPolicySymbol policy - where - policy = mkMintingPolicy $ proposalPolicy outputProposalDatum + ppstSymbol :: Term s PCurrencySymbol + ppstSymbol = + let AssetClass (sym, _) = proposalSTAssetClassFromGovernor gov + in phoistAcyclic $ pconstant sym - pproposalSymbol :: Term s PCurrencySymbol - pproposalSymbol = phoistAcyclic $ pconstant proposalSymbol - - proposalValidatorAddress :: Address - proposalValidatorAddress = Address (ScriptCredential hash) Nothing - where - hash = validatorHash validator - validator = mkValidator $ proposalValidator outputProposalDatum + proposalDatumValid' :: Term s (PProposalDatum :--> PBool) + proposalDatumValid' = + let params = proposalFromGovernor gov + in phoistAcyclic $ proposalDatumValid params pproposalValidatorAddress :: Term s PAddress - pproposalValidatorAddress = phoistAcyclic $ pconstant proposalValidatorAddress - - stateTokenValueOf :: Term s (PValue :--> PInteger) - stateTokenValueOf = passetClassValueOf' stateTokenAssetClass - - pgatSymbol :: Term s PCurrencySymbol - pgatSymbol = phoistAcyclic $ pconstant $ gatSymbol gov - - stakeParameters :: Stake - stakeParameters = Stake gov.gtClassRef - - stakeValidatorAddress :: Address - stakeValidatorAddress = Address (ScriptCredential hash) Nothing - where - validator = mkValidator $ stakeValidator stakeParameters - hash = validatorHash validator - - stakeStateSymbol :: CurrencySymbol - stakeStateSymbol = mintingPolicySymbol policy - where - policy = mkMintingPolicy $ stakePolicy stakeParameters + pproposalValidatorAddress = + let vh = proposalValidatorHashFromGovernor gov + in phoistAcyclic $ pconstant $ validatorHashToAddress vh pstakeValidatorAddress :: Term s PAddress - pstakeValidatorAddress = phoistAcyclic $ pconstant stakeValidatorAddress + pstakeValidatorAddress = + let vh = stakeValidatorHashFromGovernor gov + in phoistAcyclic $ pconstant $ validatorHashToAddress vh - pstakeStateSymbol :: Term s PCurrencySymbol - pstakeStateSymbol = phoistAcyclic $ pconstant stakeStateSymbol + psstSymbol :: Term s PCurrencySymbol + psstSymbol = + let sym = stakeSTSymbolFromGovernor gov + in phoistAcyclic $ pconstant sym - pgtValueOf :: Term s (PValue :--> PDiscrete GTTag) - pgtValueOf = pvalueDiscrete gov.gtClassRef + pgstSymbol :: Term s PCurrencySymbol + pgstSymbol = + let sym = governorSTSymbolFromGovernor gov + in phoistAcyclic $ pconstant sym -------------------------------------------------------------------------------- --- | Get the 'AssetClass' of GST from 'Governor'. -gstAssetClass :: Governor -> AssetClass -gstAssetClass gov = AssetClass (symbol, "") +governorSTSymbolFromGovernor :: Governor -> CurrencySymbol +governorSTSymbolFromGovernor gov = mintingPolicySymbol policy where policy :: MintingPolicy policy = mkMintingPolicy $ governorPolicy gov +{- | Get the 'AssetClass' of GST from 'Governor'. + TODO: tag GST? +-} +governorSTAssetClassFromGovernor :: Governor -> AssetClass +governorSTAssetClassFromGovernor gov = AssetClass (symbol, "") + where symbol :: CurrencySymbol - symbol = mintingPolicySymbol policy + symbol = governorSTSymbolFromGovernor gov -- | Get the `CurrencySymbol` of GAT from 'Governor'. -gatSymbol :: Governor -> CurrencySymbol -gatSymbol gov = mintingPolicySymbol policy +atSymbolFromGovernor :: Governor -> CurrencySymbol +atSymbolFromGovernor gov = mintingPolicySymbol policy where - at = AuthorityToken $ gstAssetClass gov + at = AuthorityToken $ governorSTAssetClassFromGovernor gov policy = mkMintingPolicy $ authorityTokenPolicy at --- | Get next proposal id. -pgetNextProposalId :: Term s (PProposalId :--> PProposalId) -pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 +proposalSTAssetClassFromGovernor :: Governor -> AssetClass +proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "") + where + gstAC = governorSTAssetClassFromGovernor gov + -- JUSTIFICATIONL: the PST policy doesn't care about the following two fields at all. + -- FIXME: refactor PST policy, parameterize it only with GST assetclass or something. + sstAC = AssetClass ("", "") + mc = -1 + params = Proposal gstAC sstAC mc + + policy = mkMintingPolicy $ proposalPolicy params + symbol = mintingPolicySymbol policy + +stakeSTSymbolFromGovernor :: Governor -> CurrencySymbol +stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy + where + policy = mkMintingPolicy $ stakePolicy gov.gtClassRef + +stakeFromGovernor :: Governor -> Stake +stakeFromGovernor gov = + Stake gov.gtClassRef $ + proposalSTAssetClassFromGovernor gov + +stakeValidatorHashFromGovernor :: Governor -> ValidatorHash +stakeValidatorHashFromGovernor gov = validatorHash validator + where + params = stakeFromGovernor gov + validator = mkValidator $ stakeValidator params + +proposalFromGovernor :: Governor -> Proposal +proposalFromGovernor gov = Proposal gstAC sstAC mc + where + gstAC = governorSTAssetClassFromGovernor gov + mc = gov.maximumCosigners + + sstS = stakeSTSymbolFromGovernor gov + -- The stake state token is tagged with the address which it's sent to. + sstTN :: TokenName + sstTN = coerce $ stakeValidatorHashFromGovernor gov + sstAC = AssetClass (sstS, sstTN) + +proposalValidatorHashFromGovernor :: Governor -> ValidatorHash +proposalValidatorHashFromGovernor gov = validatorHash validator + where + params = proposalFromGovernor gov + validator = mkValidator $ proposalValidator params diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 34a47fc..5e34b55 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -47,6 +47,7 @@ module Agora.Utils ( mustFindDatum', mustBePJust, mustBePDJust, + validatorHashToAddress, ) where -------------------------------------------------------------------------------- @@ -55,6 +56,8 @@ import Plutus.V1.Ledger.Api ( CurrencySymbol, TokenName (..), ValidatorHash (..), + Credential(..), + Address(..), ) import Plutus.V1.Ledger.Value (AssetClass (..)) @@ -71,8 +74,6 @@ import Plutarch.Api.V1 ( PMintingPolicy, PPubKeyHash, PTokenName (PTokenName), - PScriptContext, - PScriptPurpose (PMinting), PTuple, PTxInInfo (PTxInInfo), PTxInfo, @@ -86,7 +87,7 @@ import Plutarch.Api.V1 ( import Plutarch.Api.V1.AssocMap (PMap (PMap)) import Plutarch.Api.V1.Extra (PAssetClass, passetClassValueOf, pvalueOf) import Plutarch.Api.V1.Value (PValue (PValue)) -import Plutarch.Builtin (ppairDataBuiltin) +import Plutarch.Builtin (pforgetData, ppairDataBuiltin) import Plutarch.Map.Extra (pkeys) import Plutarch.Monadic qualified as P import Plutarch.TryFrom (PTryFrom, ptryFrom) @@ -365,7 +366,7 @@ pisUniq = #&& (self # xs) ) (const $ pcon PTrue) - + -- | Yield True if a given PMaybeData is of form PDJust _. pisDJust :: Term s (PMaybeData a :--> PBool) pisDJust = phoistAcyclic $ @@ -377,12 +378,13 @@ pisDJust = phoistAcyclic $ _ -> pconstant False ) --- | Determines if a given UTXO is spent. --- TODO: no need to pass the whole TxInfo here. -pisUTXOSpent :: Term s (PTxOutRef :--> PTxInfo :--> PBool) +{- | Determines if a given UTXO is spent. + TODO: no need to pass the whole TxInfo here. +-} +pisUTXOSpent :: Term s (PTxOutRef :--> PBuiltinList (PAsData PTxInInfo) :--> PBool) pisUTXOSpent = phoistAcyclic $ - plam $ \oref info -> P.do - pisJust #$ pfindTxInByTxOutRef # oref # info + plam $ \oref inputs -> P.do + pisJust #$ pfindTxInByTxOutRef # oref # inputs -------------------------------------------------------------------------------- {- Functions which should (probably) not be upstreamed @@ -526,7 +528,7 @@ hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $ -- | Find datum given a maybe datum hash mustFindDatum' :: forall (datum :: PType). - (PIsData datum, PTryFrom PData (PAsData datum))=> + (PIsData datum, PTryFrom PData (PAsData datum)) => forall s. Term s @@ -538,7 +540,7 @@ mustFindDatum' = phoistAcyclic $ plam $ \mdh datums -> P.do let dh = mustBePDJust # "Given TxOut dones't have a datum" # mdh dt = mustBePJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums - (d, _ ) <- ptryFrom $ pforgetData $ pdata dt + (d, _) <- ptryFrom $ pforgetData $ pdata dt pfromData d {- | Extract the value stored in a PMaybe container. @@ -558,3 +560,6 @@ mustBePDJust = phoistAcyclic $ plam $ \emsg mv' -> pmatch mv' $ \case PDJust ((pfield @"_0" #) -> v) -> v _ -> ptraceError emsg + +validatorHashToAddress :: ValidatorHash -> Address +validatorHashToAddress vh = Address (ScriptCredential vh) Nothing