From 13151bb6fb4064fba1b8330557d49454d47cbbe0 Mon Sep 17 00:00:00 2001 From: Seungheon Oh Date: Sat, 4 Mar 2023 00:52:10 -0600 Subject: [PATCH] Update types so that ply envlope can be used in Purescript --- agora-scripts/Main.hs | 12 ++++++-- agora/Agora/AuthorityToken.hs | 4 +-- agora/Agora/Bootstrap.hs | 26 ++++++++++++++++- agora/Agora/Effect.hs | 5 ++-- agora/Agora/Effect/GovernorMutation.hs | 10 +++---- agora/Agora/Effect/NoOp.hs | 2 +- agora/Agora/Effect/TreasuryWithdrawal.hs | 2 +- agora/Agora/Governor/Scripts.hs | 24 ++++++++------- agora/Agora/Proposal/Scripts.hs | 20 ++++++------- agora/Agora/SafeMoney.hs | 12 ++++---- agora/Agora/Stake/Scripts.hs | 16 +++++----- agora/Agora/Treasury.hs | 4 +-- flake.lock | 37 ++++++++++++++++++------ flake.nix | 2 +- 14 files changed, 115 insertions(+), 61 deletions(-) diff --git a/agora-scripts/Main.hs b/agora-scripts/Main.hs index e0ebd70..ea44b79 100644 --- a/agora-scripts/Main.hs +++ b/agora-scripts/Main.hs @@ -13,21 +13,29 @@ import Agora.Bootstrap qualified as Bootstrap import Agora.Linker (linker) import Data.Aeson qualified as Aeson import Data.Default (def) -import Plutarch (Config (Config), TracingMode (DoTracing)) +import Plutarch (Config (Config), TracingMode (DoTracing, NoTracing)) +import Ply (TypedScriptEnvelope) import ScriptExport.Export (exportMain) import ScriptExport.Types ( Builders, insertBuilder, insertScriptExportWithLinker, + insertStaticBuilder, ) main :: IO () main = exportMain builders +rawScripts :: Config -> [TypedScriptEnvelope] +rawScripts conf = + either (error . show) id $ Bootstrap.agoraScripts' conf + builders :: Builders builders = mconcat - [ insertScriptExportWithLinker "agora" (Bootstrap.agoraScripts def) linker + [ insertStaticBuilder "raw" (rawScripts (Config NoTracing)) + , insertStaticBuilder "rawDebug" (rawScripts (Config DoTracing)) + , insertScriptExportWithLinker "agora" (Bootstrap.agoraScripts def) linker , insertScriptExportWithLinker "agoraDebug" ( Bootstrap.agoraScripts diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index cae2c12..8bee251 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -146,7 +146,7 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do @since 0.1.0 -} -authorityTokenPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy) +authorityTokenPolicy :: ClosedTerm (PAsData (PTagged GovernorSTTag PAssetClassData) :--> PMintingPolicy) authorityTokenPolicy = plam $ \gstAssetClass _redeemer ctx -> unTermCont $ do ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx @@ -176,7 +176,7 @@ authorityTokenPolicy = passertPJust # "GST should move" #$ presolveGovernorRedeemer - # (ptoScottEncodingT # gstAssetClass) + # (ptoScottEncodingT # pfromData gstAssetClass) # pfromData txInfoF.inputs # txInfoF.redeemers pguardC "Governor redeemr correct" $ diff --git a/agora/Agora/Bootstrap.hs b/agora/Agora/Bootstrap.hs index 4528412..3fdd3ff 100644 --- a/agora/Agora/Bootstrap.hs +++ b/agora/Agora/Bootstrap.hs @@ -4,7 +4,7 @@ Initialize a governance system -} -module Agora.Bootstrap (agoraScripts, alwaysSucceedsPolicyRoledScript) where +module Agora.Bootstrap (agoraScripts, agoraScripts', alwaysSucceedsPolicyRoledScript) where import Agora.AuthorityToken (authorityTokenPolicy) import Agora.Effect.GovernorMutation (mutateGovernorValidator) @@ -53,6 +53,30 @@ agoraScripts conf = (Text, TypedScriptEnvelope) envelope d t = (d, either (error . unpack) id $ mkEnvelope conf d t) +agoraScripts' :: Config -> Either Text [TypedScriptEnvelope] +agoraScripts' conf = + sequenceA + [ envelope "agora:governorPolicy" governorPolicy + , envelope "agora:governorValidator" governorValidator + , envelope "agora:stakePolicy" stakePolicy + , envelope "agora:stakeValidator" stakeValidator + , envelope "agora:proposalPolicy" proposalPolicy + , envelope "agora:proposalValidator" proposalValidator + , envelope "agora:treasuryValidator" treasuryValidator + , envelope "agora:authorityTokenPolicy" authorityTokenPolicy + , envelope "agora:noOpValidator" noOpValidator + , envelope "agora:treasuryWithdrawalValidator" treasuryWithdrawalValidator + , envelope "agora:mutateGovernorValidator" mutateGovernorValidator + ] + where + envelope :: + forall (pt :: S -> Type). + TypedWriter pt => + Text -> + ClosedTerm pt -> + Either Text TypedScriptEnvelope + envelope = mkEnvelope conf + {- | A minting policy that always succeeds. NOTE(Emily, Jan 3rd 2023): Adding this in here because it's useful for testnet GT. diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs index c81c9bf..e7fed4a 100644 --- a/agora/Agora/Effect.hs +++ b/agora/Agora/Effect.hs @@ -38,10 +38,11 @@ makeEffect :: Term s (PAsData PTxInfo) -> Term s POpaque ) -> - Term s (PTagged AuthorityTokenTag PCurrencySymbol) -> + Term s (PAsData (PTagged AuthorityTokenTag PCurrencySymbol)) -> Term s PValidator -makeEffect f atSymbol = +makeEffect f atSymbol' = plam $ \datum _redeemer ctx' -> unTermCont $ do + atSymbol <- pletC $ pfromData atSymbol' ctx <- pletFieldsC @'["txInfo", "purpose"] ctx' -- Convert input datum, PData, into desierable type diff --git a/agora/Agora/Effect/GovernorMutation.hs b/agora/Agora/Effect/GovernorMutation.hs index 82e7e2d..5674b8c 100644 --- a/agora/Agora/Effect/GovernorMutation.hs +++ b/agora/Agora/Effect/GovernorMutation.hs @@ -151,9 +151,9 @@ deriving anyclass instance PTryFrom PData PMutateGovernorDatum -} mutateGovernorValidator :: ClosedTerm - ( PScriptHash - :--> PTagged GovernorSTTag PCurrencySymbol - :--> PTagged AuthorityTokenTag PCurrencySymbol + ( PAsData PScriptHash + :--> PAsData (PTagged GovernorSTTag PCurrencySymbol) + :--> PAsData (PTagged AuthorityTokenTag PCurrencySymbol) :--> PValidator ) mutateGovernorValidator = @@ -189,7 +189,7 @@ mutateGovernorValidator = (#&&) [ ptraceIfFalse "Governor UTxO should carry GST" $ ptaggedSymbolValueOf - # gstSymbol + # pfromData gstSymbol # (pfield @"value" # inputF.resolved) #== 1 , ptraceIfFalse "Can only modify the pinned governor" $ @@ -200,7 +200,7 @@ mutateGovernorValidator = #$ pscriptHashFromAddress #$ pfield @"address" # inputF.resolved - in inputScriptHash #== govValidatorHash + in inputScriptHash #== pfromData govValidatorHash ] in isGovernorInput ) diff --git a/agora/Agora/Effect/NoOp.hs b/agora/Agora/Effect/NoOp.hs index 39f50c2..a927fea 100644 --- a/agora/Agora/Effect/NoOp.hs +++ b/agora/Agora/Effect/NoOp.hs @@ -40,7 +40,7 @@ instance PTryFrom PData (PAsData PNoOp) @since 1.0.0 -} -noOpValidator :: ClosedTerm (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator) +noOpValidator :: ClosedTerm (PAsData (PTagged AuthorityTokenTag PCurrencySymbol) :--> PValidator) noOpValidator = plam $ makeEffect $ \_ (_datum :: Term s (PAsData PNoOp)) _ _ -> popaque (pconstant ()) diff --git a/agora/Agora/Effect/TreasuryWithdrawal.hs b/agora/Agora/Effect/TreasuryWithdrawal.hs index de0a6a5..df2a9ef 100644 --- a/agora/Agora/Effect/TreasuryWithdrawal.hs +++ b/agora/Agora/Effect/TreasuryWithdrawal.hs @@ -134,7 +134,7 @@ instance PTryFrom PData PTreasuryWithdrawalDatum -} treasuryWithdrawalValidator :: forall (s :: S). - Term s (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator) + Term s (PAsData (PTagged AuthorityTokenTag PCurrencySymbol) :--> PValidator) treasuryWithdrawalValidator = plam $ makeEffect $ \_cs (datum :: Term _ PTreasuryWithdrawalDatum) effectInputRef txInfo -> unTermCont $ do diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 46f809e..79c22a6 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -102,7 +102,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont ( @since 1.0.0 -} -governorPolicy :: ClosedTerm (PTxOutRef :--> PMintingPolicy) +governorPolicy :: ClosedTerm (PAsData PTxOutRef :--> PMintingPolicy) governorPolicy = plam $ \initialSpend _ ctx -> unTermCont $ do PMinting ((pfield @"_0" #) -> gstSymbol) <- @@ -121,7 +121,7 @@ governorPolicy = txInfo pguardC "Referenced utxo should be spent" $ - pisUTXOSpent # initialSpend # txInfoF.inputs + pisUTXOSpent # pfromData initialSpend # txInfoF.inputs pguardC "Exactly one token should be minted" $ let vMap = pfromData $ pto txInfoF.mint @@ -257,15 +257,17 @@ governorPolicy = governorValidator :: -- | Lazy precompiled scripts. ClosedTerm - ( PScriptHash - :--> PTagged StakeSTTag PAssetClassData - :--> PTagged GovernorSTTag PCurrencySymbol - :--> PTagged ProposalSTTag PCurrencySymbol - :--> PTagged AuthorityTokenTag PCurrencySymbol + ( PAsData PScriptHash + :--> PAsData (PTagged StakeSTTag PAssetClassData) + :--> PAsData (PTagged GovernorSTTag PCurrencySymbol) + :--> PAsData (PTagged ProposalSTTag PCurrencySymbol) + :--> PAsData (PTagged AuthorityTokenTag PCurrencySymbol) :--> PValidator ) governorValidator = - plam $ \proposalScriptHash sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do + plam $ \proposalScriptHash sstClass gstSymbol pstSymbol' atSymbol' datum redeemer ctx -> unTermCont $ do + atSymbol <- pletC $ pfromData atSymbol' + pstSymbol <- pletC $ pfromData pstSymbol' ctxF <- pletAllC ctx txInfo <- pletC $ pfromData ctxF.txInfo txInfoF <- @@ -314,7 +316,7 @@ governorValidator = outputF.address governorInputF.address , ptraceIfFalse "Has governor ST" $ - ptaggedSymbolValueOf # gstSymbol # outputF.value #== 1 + ptaggedSymbolValueOf # pfromData gstSymbol # outputF.value #== 1 ] datum = @@ -339,7 +341,7 @@ governorValidator = flip (pletFields @'["value", "datum", "address"]) $ \txOutF -> let isProposalUTxO = (pfromJust #$ pscriptHashFromAddress # pfromData txOutF.address) - #== proposalScriptHash + #== pfromData proposalScriptHash #&& passetClassValueOf # pstClass # txOutF.value @@ -396,7 +398,7 @@ governorValidator = # "Stake input should present" #$ pfindJust # ( presolveStakeInputDatum - # (ptoScottEncodingT # sstClass) + # (ptoScottEncodingT # pfromData sstClass) # txInfoF.datums ) # pfromData txInfoF.inputs diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index ec8d73f..48d8f33 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -113,7 +113,7 @@ import "plutarch-extra" Plutarch.Extra.Map (pupdate) @since 1.0.0 -} -proposalPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy) +proposalPolicy :: ClosedTerm (PAsData (PTagged GovernorSTTag PAssetClassData) :--> PMintingPolicy) proposalPolicy = plam $ \gstAssetClass _redeemer ctx -> unTermCont $ do ctxF <- pletAllC ctx @@ -137,7 +137,7 @@ proposalPolicy = passertPJust # "GST should move" #$ presolveGovernorRedeemer - # (ptoScottEncodingT # gstAssetClass) + # (ptoScottEncodingT # pfromData gstAssetClass) # pfromData txInfoF.inputs # txInfoF.redeemers @@ -224,10 +224,10 @@ instance DerivePlutusType PStakeInputsContext where -} proposalValidator :: ClosedTerm - ( PTagged StakeSTTag PAssetClassData - :--> PTagged GovernorSTTag PCurrencySymbol - :--> PTagged ProposalSTTag PCurrencySymbol - :--> PInteger + ( PAsData (PTagged StakeSTTag PAssetClassData) + :--> PAsData (PTagged GovernorSTTag PCurrencySymbol) + :--> PAsData (PTagged ProposalSTTag PCurrencySymbol) + :--> PAsData PInteger :--> PValidator ) proposalValidator = @@ -289,7 +289,7 @@ proposalValidator = outputF.address proposalInputF.address , ptraceIfFalse "Has proposal ST" $ - ptaggedSymbolValueOf # pstSymbol # outputF.value #== 1 + ptaggedSymbolValueOf # pfromData pstSymbol # outputF.value #== 1 ] handleProposalUTxO = @@ -335,7 +335,7 @@ proposalValidator = resolveStakeInputDatum <- pletC $ presolveStakeInputDatum - # (ptoScottEncodingT # sstClass) + # (ptoScottEncodingT # pfromData sstClass) # txInfoF.datums spendStakes' :: Term _ ((PStakeInputsContext :--> PUnit) :--> PUnit) <- @@ -450,7 +450,7 @@ proposalValidator = # proposalInputDatumF.cosigners pguardC "Less cosigners than maximum limit" $ - plength # updatedSigs #<= maximumCosigners + plength # updatedSigs #<= pfromData maximumCosigners pguardC "Meet minimum GT requirement" $ pfromData thresholdsF.cosign #<= stakeF.stakedAmount @@ -741,7 +741,7 @@ proposalValidator = . (pfield @"resolved" #) -> value ) -> - ptaggedSymbolValueOf # gstSymbol # value #== 1 + ptaggedSymbolValueOf # pfromData gstSymbol # value #== 1 ) # pfromData txInfoF.inputs diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs index ffc5fc7..0310a8b 100644 --- a/agora/Agora/SafeMoney.hs +++ b/agora/Agora/SafeMoney.hs @@ -22,37 +22,37 @@ import PlutusLedgerApi.V1.Value (AssetClass (AssetClass)) @since 0.1.0 -} -data GTTag +type GTTag = "GTTag" {- | ADA. @since 0.1.0 -} -data ADATag +type ADATag = "ADATag" {- | Governor ST token. @since 0.1.0 -} -data GovernorSTTag +type GovernorSTTag = "GovernorSTTag" {- | Stake ST token. @since 0.1.0 -} -data StakeSTTag +type StakeSTTag = "StakeSTTag" {- | Proposal ST token. @since 0.1.0 -} -data ProposalSTTag +type ProposalSTTag = "ProposalSTTag" {- | Authority token. @since 1.0.0 -} -data AuthorityTokenTag +type AuthorityTokenTag = "AuthorityTokenTag" {- | Resolves ada tags. diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index c652e05..e549639 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -138,7 +138,7 @@ import Prelude hiding (Num ((+))) @since 1.0.0 -} stakePolicy :: - ClosedTerm (PTagged GTTag PAssetClassData :--> PMintingPolicy) + ClosedTerm (PAsData (PTagged GTTag PAssetClassData) :--> PMintingPolicy) stakePolicy = plam $ \gtClass _redeemer ctx' -> unTermCont $ do ctx <- pletFieldsC @'["txInfo", "purpose"] ctx' @@ -207,7 +207,7 @@ stakePolicy = (#&&) [ ptraceIfFalse "Stake ouput has expected amount of stake token" $ passetClassValueOfT - # (ptoScottEncodingT # gtClass) + # (ptoScottEncodingT # pfromData gtClass) # outputF.value #== pfromData datumF.stakedAmount , ptraceIfFalse "Stake Owner should sign the transaction" $ @@ -656,9 +656,9 @@ mkStakeValidator impl sstSymbol pstClass gtClass = -} stakeValidator :: ClosedTerm - ( PTagged StakeSTTag PCurrencySymbol - :--> PTagged ProposalSTTag PAssetClassData - :--> PTagged GTTag PAssetClassData + ( PAsData (PTagged StakeSTTag PCurrencySymbol) + :--> PAsData (PTagged ProposalSTTag PAssetClassData) + :--> PAsData (PTagged GTTag PAssetClassData) :--> PValidator ) stakeValidator = @@ -673,6 +673,6 @@ stakeValidator = , onClearDelegate = pclearDelegate } ) - sstSymbol - (ptoScottEncodingT # pstClass) - (ptoScottEncodingT # gstClass) + (pfromData sstSymbol) + (ptoScottEncodingT # pfromData pstClass) + (ptoScottEncodingT # pfromData gstClass) diff --git a/agora/Agora/Treasury.hs b/agora/Agora/Treasury.hs index a48793e..808e83b 100644 --- a/agora/Agora/Treasury.hs +++ b/agora/Agora/Treasury.hs @@ -30,7 +30,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletFieldsC, pm @since 1.0.0 -} treasuryValidator :: - ClosedTerm (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator) + ClosedTerm (PAsData (PTagged AuthorityTokenTag PCurrencySymbol) :--> PValidator) treasuryValidator = plam $ \atSymbol _ _ ctx' -> unTermCont $ do -- plet required fields from script context. ctx <- pletFieldsC @["txInfo", "purpose"] ctx' @@ -44,6 +44,6 @@ treasuryValidator = plam $ \atSymbol _ _ ctx' -> unTermCont $ do mint = txInfo.mint pguardC "A single authority token has been burned" $ - singleAuthorityTokenBurned atSymbol txInfo.inputs mint + singleAuthorityTokenBurned (pfromData atSymbol) txInfo.inputs mint pure . popaque $ pconstant () diff --git a/flake.lock b/flake.lock index 477bad4..741ec40 100644 --- a/flake.lock +++ b/flake.lock @@ -1437,6 +1437,23 @@ "type": "github" } }, + "easy-purescript-nix": { + "flake": false, + "locked": { + "lastModified": 1666686938, + "narHash": "sha256-/UOLRdnEhIOcxcm5ouOipOiSgHRzJde0ccAx4xB1dnU=", + "owner": "justinwoo", + "repo": "easy-purescript-nix", + "rev": "da7acb2662961fd355f0a01a25bd32bf33577fa8", + "type": "github" + }, + "original": { + "owner": "justinwoo", + "repo": "easy-purescript-nix", + "rev": "da7acb2662961fd355f0a01a25bd32bf33577fa8", + "type": "github" + } + }, "ema": { "flake": false, "locked": { @@ -3598,15 +3615,16 @@ "ply": "ply" }, "locked": { - "lastModified": 1674830336, - "narHash": "sha256-KIJH4kJzBIaDqV3N/f8Dolt//GBc4Cwam7+10HKGg18=", + "lastModified": 1677208361, + "narHash": "sha256-b+mflc7SI9Iwben5BGxJJZBLeCvIzc5s2zWTvgPIuzo=", "owner": "Liqwid-Labs", "repo": "liqwid-libs", - "rev": "45f591ddfbf6342f958c4ead6dc6175965f8ce1d", + "rev": "9d0ba961872c2691853ec5683fc3ee2c48b2cc6f", "type": "github" }, "original": { "owner": "Liqwid-Labs", + "ref": "seungheonoh/bumpPly", "repo": "liqwid-libs", "type": "github" } @@ -6279,6 +6297,7 @@ "ply": { "inputs": { "CHaP": "CHaP_2", + "easy-purescript-nix": "easy-purescript-nix", "flake-utils": "flake-utils_13", "haskellNix": "haskellNix", "nixpkgs": [ @@ -6290,16 +6309,16 @@ "pre-commit-hooks": "pre-commit-hooks" }, "locked": { - "lastModified": 1672869303, - "narHash": "sha256-hX2nxIpyJWTqQnllc9bLIqQH3LXtLxof56TYkMPSOZ0=", - "owner": "mlabs-haskell", + "lastModified": 1676952116, + "narHash": "sha256-BuiXDtCxOZQCs0hHhBtHGNBIxFTZxbSSp+f0U8kP/+c=", + "owner": "liqwid-labs", "repo": "ply", - "rev": "2cda3b44f87c659980bea2bc0b4a822d1e9eaef4", + "rev": "623c017d2867147022283c6d4f6886a77bced09e", "type": "github" }, "original": { - "owner": "mlabs-haskell", - "ref": "master", + "owner": "liqwid-labs", + "ref": "seungheonoh/purs", "repo": "ply", "type": "github" } diff --git a/flake.nix b/flake.nix index 207c0cf..373e8a9 100644 --- a/flake.nix +++ b/flake.nix @@ -19,7 +19,7 @@ inputs.nixpkgs-latest.follows = "nixpkgs-latest"; }; - liqwid-libs.url = "github:Liqwid-Labs/liqwid-libs"; + liqwid-libs.url = "github:Liqwid-Labs/liqwid-libs?ref=seungheonoh/bumpPly"; }; outputs = inputs@{ self, flake-parts, ... }: