From a16644478fb01c2570b72339c016eff0215f0f9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Thu, 2 Jan 2025 14:48:11 +0100 Subject: [PATCH 01/22] Add ScriptTarget flag --- src/lib/SmartTokens/Core/Scripts.hs | 36 ++++++++++++++++++++++--- src/lib/Wst/Offchain/Scripts.hs | 41 ++++++++++++----------------- 2 files changed, 49 insertions(+), 28 deletions(-) diff --git a/src/lib/SmartTokens/Core/Scripts.hs b/src/lib/SmartTokens/Core/Scripts.hs index 6fcad66..96202af 100644 --- a/src/lib/SmartTokens/Core/Scripts.hs +++ b/src/lib/SmartTokens/Core/Scripts.hs @@ -1,18 +1,46 @@ module SmartTokens.Core.Scripts ( + -- * Build targets + ScriptTarget(..), + targetConfig, + + -- * Compile functions tryCompile, tryCompileTracingAndBinds, tryCompileNoTracing, ) where +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) import Plutarch -tryCompile :: Config -> ClosedTerm a -> Script -tryCompile cfg x = case compile cfg x of +{-| Script target environment +-} +data ScriptTarget + = Debug -- ^ Include debug symbols + | Production -- ^ No debug symbols + deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +{-| The plutarch 'Config' for the target +-} +targetConfig :: ScriptTarget -> Config +targetConfig = \case + Debug -> tracingAndBindsConfig + Production -> prodConfig + +tryCompile :: ScriptTarget -> ClosedTerm a -> Script +tryCompile tgt x = case compile (targetConfig tgt) x of Left e -> error $ "Compilation failed: " <> show e Right s -> s tryCompileTracingAndBinds :: ClosedTerm a -> Script -tryCompileTracingAndBinds = tryCompile (Tracing LogInfo DoTracingAndBinds) +tryCompileTracingAndBinds = tryCompile Debug tryCompileNoTracing :: ClosedTerm a -> Script -tryCompileNoTracing = tryCompile NoTracing +tryCompileNoTracing = tryCompile Production + +tracingAndBindsConfig :: Config +tracingAndBindsConfig = Tracing LogInfo DoTracingAndBinds + +prodConfig :: Config +prodConfig = NoTracing diff --git a/src/lib/Wst/Offchain/Scripts.hs b/src/lib/Wst/Offchain/Scripts.hs index 995911e..b7d1f1d 100644 --- a/src/lib/Wst/Offchain/Scripts.hs +++ b/src/lib/Wst/Offchain/Scripts.hs @@ -3,6 +3,7 @@ {-# OPTIONS_GHC -Wno-unused-top-binds #-} module Wst.Offchain.Scripts ( + -- * Core scripts protocolParamsMintingScript, protocolParamsSpendingScript, directoryNodeMintingScript, @@ -11,7 +12,7 @@ module Wst.Offchain.Scripts ( programmableLogicBaseScript, programmableLogicGlobalScript, - -- Transfer logic + -- * Transfer logic permissionedTransferScript, freezeTransferScript, blacklistMintingScript, @@ -30,7 +31,7 @@ import Cardano.Api.Shelley qualified as C import Convex.PlutusLedger.V1 (transCredential, transPolicyId, transPubKeyHash, transStakeCredential) import Convex.PlutusLedger.V3 (transTxOutRef) -import Plutarch (ClosedTerm, Config (..), LogLevel (..), TracingMode (..), (#)) +import Plutarch (ClosedTerm, (#)) import Plutarch.Builtin (pdata, pforgetData) import Plutarch.ByteString (PByteString) import Plutarch.Lift (pconstant) @@ -44,53 +45,45 @@ import SmartTokens.Contracts.ProgrammableLogicBase (mkProgrammableLogicBase, import SmartTokens.Contracts.ProtocolParams (alwaysFailScript, mkPermissionedMinting, mkProtocolParametersMinting) -import SmartTokens.Core.Scripts (tryCompile) +import SmartTokens.Core.Scripts (ScriptTarget (..)) +import SmartTokens.Core.Scripts qualified as Scripts import SmartTokens.LinkedList.MintDirectory (mkDirectoryNodeMP) import SmartTokens.LinkedList.SpendDirectory (pmkDirectorySpending) -tracingConfig :: Config -tracingConfig = Tracing LogInfo DoTracing - -tracingAndBindsConfig :: Config -tracingAndBindsConfig = Tracing LogInfo DoTracingAndBinds - -prodConfig :: Config -prodConfig = NoTracing - -- Protocol params -- | The minting script for the protocol parameters NFT, takes initial TxIn for -- one shot mint protocolParamsMintingScript :: C.TxIn -> C.PlutusScript C.PlutusScriptV3 protocolParamsMintingScript txIn = - let script = tryCompile tracingConfig $ mkProtocolParametersMinting # pdata (pconstant $ transTxOutRef txIn) + let script = Scripts.tryCompile Production $ mkProtocolParametersMinting # pdata (pconstant $ transTxOutRef txIn) in C.PlutusScriptSerialised $ serialiseScript script -- | The spending script for the protocol parameters NFT parameterized by "" -- nonce protocolParamsSpendingScript :: C.PlutusScript C.PlutusScriptV3 protocolParamsSpendingScript = - let script = tryCompile tracingConfig $ alwaysFailScript # pforgetData (pdata (pconstant "" :: ClosedTerm PByteString)) + let script = Scripts.tryCompile Debug $ alwaysFailScript # pforgetData (pdata (pconstant "" :: ClosedTerm PByteString)) in C.PlutusScriptSerialised $ serialiseScript script -- | The minting script for the directory node tokens, takes initial TxIn for -- symbol uniqueness across instances directoryNodeMintingScript :: C.TxIn -> C.PlutusScript C.PlutusScriptV3 directoryNodeMintingScript txIn = - let script = tryCompile tracingConfig $ mkDirectoryNodeMP # pdata (pconstant $ transTxOutRef txIn) + let script = Scripts.tryCompile Debug $ mkDirectoryNodeMP # pdata (pconstant $ transTxOutRef txIn) in C.PlutusScriptSerialised $ serialiseScript script -- | The spending script for the directory node tokens, parameterized by the -- policy id of the protocol parameters NFT. directoryNodeSpendingScript :: C.PolicyId -> C.PlutusScript C.PlutusScriptV3 directoryNodeSpendingScript paramsPolId = - let script = tryCompile tracingConfig $ pmkDirectorySpending # pdata (pconstant $ transPolicyId paramsPolId) + let script = Scripts.tryCompile Debug $ pmkDirectorySpending # pdata (pconstant $ transPolicyId paramsPolId) in C.PlutusScriptSerialised $ serialiseScript script -- TODO: can we change the signature to just take the param policy id? programmableLogicMintingScript :: C.PaymentCredential -> C.StakeCredential -> C.PolicyId -> C.PlutusScript C.PlutusScriptV3 programmableLogicMintingScript progLogicBaseSpndingCred mintingCred nodePolId = - let script = tryCompile tracingConfig + let script = Scripts.tryCompile Debug $ mkProgrammableLogicMinting # pdata (pconstant $ transCredential progLogicBaseSpndingCred) # pdata (pconstant $ transPolicyId nodePolId) @@ -99,39 +92,39 @@ programmableLogicMintingScript progLogicBaseSpndingCred mintingCred nodePolId = programmableLogicBaseScript :: C.StakeCredential -> C.PlutusScript C.PlutusScriptV3 -- Parameterized by the stake cred of the global script programmableLogicBaseScript globalCred = - let script = tryCompile tracingConfig $ mkProgrammableLogicBase # pdata (pconstant $ transStakeCredential globalCred) + let script = Scripts.tryCompile Debug $ mkProgrammableLogicBase # pdata (pconstant $ transStakeCredential globalCred) in C.PlutusScriptSerialised $ serialiseScript script programmableLogicGlobalScript :: C.PolicyId -> C.PlutusScript C.PlutusScriptV3 -- Parameterized by the CS holding protocol params datum programmableLogicGlobalScript paramsPolId = - let script = tryCompile tracingConfig $ mkProgrammableLogicGlobal # pdata (pconstant $ transPolicyId paramsPolId) + let script = Scripts.tryCompile Debug $ mkProgrammableLogicGlobal # pdata (pconstant $ transPolicyId paramsPolId) in C.PlutusScriptSerialised $ serialiseScript script permissionedTransferScript :: C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 permissionedTransferScript cred = - let script = tryCompile tracingConfig $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred) + let script = Scripts.tryCompile Debug $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred) in C.PlutusScriptSerialised $ serialiseScript script freezeTransferScript :: C.PaymentCredential -> C.PolicyId -> C.PlutusScript C.PlutusScriptV3 freezeTransferScript progLogicBaseSpndingCred blacklistPolicyId = - let script = tryCompile tracingConfig $ mkFreezeAndSeizeTransfer # pdata (pconstant $ transCredential progLogicBaseSpndingCred) # pdata (pconstant $ transPolicyId blacklistPolicyId) + let script = Scripts.tryCompile Debug $ mkFreezeAndSeizeTransfer # pdata (pconstant $ transCredential progLogicBaseSpndingCred) # pdata (pconstant $ transPolicyId blacklistPolicyId) in C.PlutusScriptSerialised $ serialiseScript script blacklistMintingScript :: C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 blacklistMintingScript cred = - let script = tryCompile tracingConfig $ mkPermissionedMinting # pdata (pconstant $ transPubKeyHash cred) + let script = Scripts.tryCompile Debug $ mkPermissionedMinting # pdata (pconstant $ transPubKeyHash cred) in C.PlutusScriptSerialised $ serialiseScript script blacklistSpendingScript :: C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 blacklistSpendingScript cred = - let script = tryCompile tracingConfig $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred) + let script = Scripts.tryCompile Debug $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred) in C.PlutusScriptSerialised $ serialiseScript script {-| 'C.PlutusScript C.PlutusScriptV3' that always succeeds. Can be used for minting, withdrawal, spending, etc. -} alwaysSucceedsScript :: C.PlutusScript C.PlutusScriptV3 alwaysSucceedsScript = - C.PlutusScriptSerialised $ serialiseScript $ tryCompile tracingConfig palwaysSucceed + C.PlutusScriptSerialised $ serialiseScript $ Scripts.tryCompile Debug palwaysSucceed -- Utilities scriptPolicyIdV3 :: C.PlutusScript C.PlutusScriptV3 -> C.PolicyId From 7450aff4c0eaa6fbb1b43a3183acb9b162e908d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Thu, 2 Jan 2025 15:01:26 +0100 Subject: [PATCH 02/22] Add build target in one place --- src/lib/Wst/Cli.hs | 3 +- .../Wst/Offchain/BuildTx/ProtocolParams.hs | 10 +++--- src/lib/Wst/Offchain/Endpoints/Deployment.hs | 3 +- src/lib/Wst/Offchain/Env.hs | 15 ++++---- src/lib/Wst/Offchain/Scripts.hs | 6 ++-- src/test/unit/Wst/Test/UnitTest.hs | 36 ++++++++++--------- 6 files changed, 39 insertions(+), 34 deletions(-) diff --git a/src/lib/Wst/Cli.hs b/src/lib/Wst/Cli.hs index 81070cf..31f4659 100644 --- a/src/lib/Wst/Cli.hs +++ b/src/lib/Wst/Cli.hs @@ -12,6 +12,7 @@ import Data.Proxy (Proxy) import Data.String (IsString (..)) import Options.Applicative (customExecParser, disambiguate, helper, idm, info, prefs, showHelpOnEmpty, showHelpOnError) +import SmartTokens.Core.Scripts (ScriptTarget (Production)) import Wst.App (runWstApp) import Wst.Cli.Command (Command (..), ManageCommand (StartServer, Status), parseCommand) @@ -32,7 +33,7 @@ runCommand com = do result <- case com of Deploy config -> runWstApp env (deploy config) Manage txIn com_ -> do - let env' = Env.addDirectoryEnvFor txIn env + let env' = Env.addDirectoryEnvFor Production txIn env runWstApp env' $ case com_ of Status -> do -- TODO: status check (call the query endpoints and print out a summary of the results) diff --git a/src/lib/Wst/Offchain/BuildTx/ProtocolParams.hs b/src/lib/Wst/Offchain/BuildTx/ProtocolParams.hs index 79efd70..fedf4ac 100644 --- a/src/lib/Wst/Offchain/BuildTx/ProtocolParams.hs +++ b/src/lib/Wst/Offchain/BuildTx/ProtocolParams.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} module Wst.Offchain.BuildTx.ProtocolParams ( mintProtocolParams, getProtocolParamsGlobalInline @@ -15,6 +16,7 @@ import Convex.Utils qualified as Utils import GHC.Exts (IsList (..)) import SmartTokens.Types.Constants (protocolParamsToken) import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams) +import Wst.Offchain.Env (DirectoryEnv (..)) import Wst.Offchain.Env qualified as Env import Wst.Offchain.Scripts (protocolParamsMintingScript, protocolParamsSpendingScript, scriptPolicyIdV3) @@ -29,10 +31,8 @@ mintProtocolParams = Utils.inBabbage @era $ do txIn <- asks (Env.dsTxIn . Env.directoryEnv) params <- asks (Env.globalParams . Env.directoryEnv) netId <- queryNetworkId - let - mintingScript = protocolParamsMintingScript txIn - - policyId = scriptPolicyIdV3 mintingScript + DirectoryEnv{dsProtocolParamsMintingScript} <- asks Env.directoryEnv + let policyId = scriptPolicyIdV3 dsProtocolParamsMintingScript val = C.TxOutValueShelleyBased C.shelleyBasedEra $ C.toLedgerValue @era C.maryBasedEra $ fromList [(C.AssetId policyId protocolParamsTokenC, 1)] @@ -51,7 +51,7 @@ mintProtocolParams = Utils.inBabbage @era $ do output = C.TxOut addr val dat C.ReferenceScriptNone spendPublicKeyOutput txIn - mintPlutus mintingScript () protocolParamsTokenC 1 + mintPlutus dsProtocolParamsMintingScript () protocolParamsTokenC 1 prependTxOut output getProtocolParamsGlobalInline :: C.InAnyCardanoEra (C.TxOut C.CtxTx) -> Maybe ProgrammableLogicGlobalParams diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index 58c7c91..5204460 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -22,6 +22,7 @@ import Convex.Class (MonadBlockchain, MonadUtxoQuery) import Convex.CoinSelection qualified import Data.Foldable (maximumBy) import Data.Function (on) +import SmartTokens.Core.Scripts (ScriptTarget (..)) import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..)) import Wst.AppError (AppError) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (inaNewKey)) @@ -40,7 +41,7 @@ deployTx :: (MonadReader env m, Env.HasOperatorEnv era env, MonadBlockchain era deployTx = do (txi, _) <- Env.selectOperatorOutput opEnv <- asks Env.operatorEnv - (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withDirectoryFor txi + (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withDirectoryFor Production txi $ Env.balanceTxEnv_ $ BuildTx.mintProtocolParams >> BuildTx.initDirectorySet pure (Convex.CoinSelection.signBalancedTxBody [] tx, txi) diff --git a/src/lib/Wst/Offchain/Env.hs b/src/lib/Wst/Offchain/Env.hs index 2555a6e..e3153eb 100644 --- a/src/lib/Wst/Offchain/Env.hs +++ b/src/lib/Wst/Offchain/Env.hs @@ -86,6 +86,7 @@ import Data.Map qualified as Map import Data.Maybe (listToMaybe) import Data.Proxy (Proxy (..)) import Data.Text qualified as Text +import SmartTokens.Core.Scripts (ScriptTarget) import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams (..)) import System.Environment qualified import Wst.AppError (AppError (..)) @@ -184,10 +185,10 @@ data DirectoryEnv = , dsProgrammableLogicGlobalScript :: PlutusScript PlutusScriptV3 } -mkDirectoryEnv :: C.TxIn -> DirectoryEnv -mkDirectoryEnv dsTxIn = +mkDirectoryEnv :: ScriptTarget -> C.TxIn -> DirectoryEnv +mkDirectoryEnv target dsTxIn = let dsDirectoryMintingScript = directoryNodeMintingScript dsTxIn - dsProtocolParamsMintingScript = protocolParamsMintingScript dsTxIn + dsProtocolParamsMintingScript = protocolParamsMintingScript target dsTxIn dsDirectorySpendingScript = directoryNodeSpendingScript (protocolParamsPolicyId result) dsProgrammableLogicBaseScript = programmableLogicBaseScript (programmableLogicStakeCredential result) -- Parameterized by the stake cred of the global script dsProgrammableLogicGlobalScript = programmableLogicGlobalScript (protocolParamsPolicyId result) -- Parameterized by the CS holding protocol params datum @@ -333,8 +334,8 @@ instance HasLogger (CombinedEnv o d t Identity era) where {-| Add a 'DirectoryEnv' for the 'C.TxIn' in to the environment -} -addDirectoryEnvFor :: C.TxIn -> CombinedEnv o d t r era -> CombinedEnv o Identity t r era -addDirectoryEnvFor txi = addDirectoryEnv (mkDirectoryEnv txi) +addDirectoryEnvFor :: ScriptTarget -> C.TxIn -> CombinedEnv o d t r era -> CombinedEnv o Identity t r era +addDirectoryEnvFor target txi = addDirectoryEnv (mkDirectoryEnv target txi) {-| Add a 'DirectoryEnv' for the 'C.TxIn' in to the environment -} @@ -347,8 +348,8 @@ withDirectory dir action = do asks (addDirectoryEnv dir) >>= runReaderT action -withDirectoryFor :: MonadReader (CombinedEnv o d t r era) m => C.TxIn -> ReaderT (CombinedEnv o Identity t r era) m a -> m a -withDirectoryFor txi = withDirectory (mkDirectoryEnv txi) +withDirectoryFor :: MonadReader (CombinedEnv o d t r era) m => ScriptTarget -> C.TxIn -> ReaderT (CombinedEnv o Identity t r era) m a -> m a +withDirectoryFor target txi = withDirectory (mkDirectoryEnv target txi) {-| Add a 'TransferLogicEnv' for the 'C.Hash C.PaymentKey' corresponding to the admin hash diff --git a/src/lib/Wst/Offchain/Scripts.hs b/src/lib/Wst/Offchain/Scripts.hs index b7d1f1d..43a75cc 100644 --- a/src/lib/Wst/Offchain/Scripts.hs +++ b/src/lib/Wst/Offchain/Scripts.hs @@ -54,9 +54,9 @@ import SmartTokens.LinkedList.SpendDirectory (pmkDirectorySpending) -- | The minting script for the protocol parameters NFT, takes initial TxIn for -- one shot mint -protocolParamsMintingScript :: C.TxIn -> C.PlutusScript C.PlutusScriptV3 -protocolParamsMintingScript txIn = - let script = Scripts.tryCompile Production $ mkProtocolParametersMinting # pdata (pconstant $ transTxOutRef txIn) +protocolParamsMintingScript :: ScriptTarget -> C.TxIn -> C.PlutusScript C.PlutusScriptV3 +protocolParamsMintingScript target txIn = + let script = Scripts.tryCompile target $ mkProtocolParametersMinting # pdata (pconstant $ transTxOutRef txIn) in C.PlutusScriptSerialised $ serialiseScript script -- | The spending script for the protocol parameters NFT parameterized by "" diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index 73a5f2c..6469251 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -30,6 +30,7 @@ import Convex.Wallet.Operator (signTxOperator) import Data.List (isPrefixOf) import Data.Word (Word32) import GHC.Exception (SomeException, throw) +import SmartTokens.Core.Scripts (ScriptTarget (Production)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, testCase) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..)) @@ -77,7 +78,7 @@ deployDirectorySet :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFai deployDirectorySet = failOnError $ Env.withEnv $ asAdmin @C.ConwayEra $ do (tx, txI) <- Endpoints.deployTx void $ sendTx $ signTxOperator admin tx - Env.withDirectoryFor txI $ do + Env.withDirectoryFor Production txI $ do Query.registryNodes @C.ConwayEra >>= void . expectSingleton "registry output" void $ Query.globalParamsNode @C.ConwayEra @@ -86,7 +87,7 @@ deployDirectorySet = failOnError $ Env.withEnv $ asAdmin @C.ConwayEra $ do insertDirectoryNode :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m () insertDirectoryNode = failOnError $ Env.withEnv $ do txI <- deployDirectorySet - asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ do Endpoints.insertNodeTx dummyNodeArgs >>= void . sendTx . signTxOperator admin Query.registryNodes @C.ConwayEra >>= void . expectN 2 "registry outputs" @@ -102,7 +103,7 @@ issueAlwaysSucceedsValidator = failOnError $ Env.withEnv $ do registerAlwaysSucceedsStakingCert txI <- deployDirectorySet - asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ do Endpoints.issueProgrammableTokenTx alwaysSucceedsArgs "dummy asset" 100 >>= void . sendTx . signTxOperator admin Query.registryNodes @C.ConwayEra @@ -118,12 +119,12 @@ issueSmartTokensScenario = deployDirectorySet >>= issueTransferLogicProgrammable issueTransferLogicProgrammableToken :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => C.TxIn -> m C.AssetId issueTransferLogicProgrammableToken txI = failOnError $ Env.withEnv $ do - asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) -- register programmable global stake script void $ registerTransferScripts opPkh - asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) (balTx, aid) <- Endpoints.issueSmartTokensTx "dummy asset" 100 (C.PaymentCredentialByKey opPkh) @@ -142,7 +143,7 @@ transferSmartTokens = failOnError $ Env.withEnv $ do userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv) txI <- deployDirectorySet - asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ Env.withTransferFromOperator $ do Endpoints.deployBlacklistTx >>= void . sendTx . signTxOperator admin Query.blacklistNodes @C.ConwayEra @@ -150,7 +151,7 @@ transferSmartTokens = failOnError $ Env.withEnv $ do aid <- issueTransferLogicProgrammableToken txI - asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) Endpoints.transferSmartTokensTx aid 80 (C.PaymentCredentialByKey userPkh) @@ -170,13 +171,13 @@ blacklistCredential = failOnError $ Env.withEnv $ do txIn <- deployDirectorySet - asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do Endpoints.deployBlacklistTx >>= void . sendTx . signTxOperator admin Query.blacklistNodes @C.ConwayEra >>= void . expectSingleton "blacklist output" - asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do Endpoints.blacklistCredentialTx paymentCred >>= void . sendTx . signTxOperator admin @@ -193,25 +194,25 @@ blacklistTransfer = failOnError $ Env.withEnv $ do txIn <- deployDirectorySet aid <- issueTransferLogicProgrammableToken txIn - asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do Endpoints.deployBlacklistTx >>= void . sendTx . signTxOperator admin - opPkh <- asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do + opPkh <- asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) Endpoints.transferSmartTokensTx aid 50 (C.PaymentCredentialByKey userPkh) >>= void . sendTx . signTxOperator admin pure opPkh - progLogicCred <- asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do + progLogicCred <- asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do cred <- asks Env.directoryEnv pure $ Env.programmableLogicBaseCredential cred - asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do Endpoints.blacklistCredentialTx userPaymentCred >>= void . sendTx . signTxOperator admin - asWallet Wallet.w2 $ Env.withDirectoryFor txIn $ Env.withTransferFor progLogicCred opPkh $ do + asWallet Wallet.w2 $ Env.withDirectoryFor Production txIn $ Env.withTransferFor progLogicCred opPkh $ do Endpoints.transferSmartTokensTx aid 30 (C.PaymentCredentialByKey opPkh) >>= void . sendTx . signTxOperator (user Wallet.w2) @@ -223,11 +224,12 @@ seizeUserOutput = failOnError $ Env.withEnv $ do txIn <- deployDirectorySet aid <- issueTransferLogicProgrammableToken txIn - asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do Endpoints.deployBlacklistTx >>= void . sendTx . signTxOperator admin - asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do + opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) Endpoints.transferSmartTokensTx aid 50 (C.PaymentCredentialByKey userPkh) >>= void . sendTx . signTxOperator admin Query.programmableLogicOutputs @C.ConwayEra @@ -235,7 +237,7 @@ seizeUserOutput = failOnError $ Env.withEnv $ do Query.userProgrammableOutputs (C.PaymentCredentialByKey userPkh) >>= void . expectN 1 "user programmable outputs" - asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) Endpoints.seizeCredentialAssetsTx userPaymentCred >>= void . sendTx . signTxOperator admin From b2418d6d4cadaf2aa6467101d48fe2004cf9afb4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Thu, 2 Jan 2025 15:45:10 +0100 Subject: [PATCH 03/22] WIP - script dependencies --- src/lib/Wst/Cli.hs | 2 +- src/lib/Wst/Offchain/BuildTx/DirectorySet.hs | 17 ++--- .../Wst/Offchain/BuildTx/ProgrammableLogic.hs | 28 +++++-- .../Wst/Offchain/BuildTx/ProtocolParams.hs | 9 +-- src/lib/Wst/Offchain/BuildTx/TransferLogic.hs | 18 +---- src/lib/Wst/Offchain/Endpoints/Deployment.hs | 15 ++-- src/lib/Wst/Offchain/Env.hs | 74 ++++++++++++------- src/lib/Wst/Offchain/Query.hs | 9 +-- src/lib/Wst/Offchain/Scripts.hs | 66 ++++++++--------- src/lib/Wst/Server.hs | 14 ++-- src/lib/Wst/Server/Endpoints.hs | 31 -------- src/wst-poc.cabal | 1 - 12 files changed, 134 insertions(+), 150 deletions(-) delete mode 100644 src/lib/Wst/Server/Endpoints.hs diff --git a/src/lib/Wst/Cli.hs b/src/lib/Wst/Cli.hs index 31f4659..aa7db85 100644 --- a/src/lib/Wst/Cli.hs +++ b/src/lib/Wst/Cli.hs @@ -33,7 +33,7 @@ runCommand com = do result <- case com of Deploy config -> runWstApp env (deploy config) Manage txIn com_ -> do - let env' = Env.addDirectoryEnvFor Production txIn env + let env' = Env.addDirectoryEnvFor (Env.DirectoryScriptRoot txIn Production) env runWstApp env' $ case com_ of Status -> do -- TODO: status check (call the query endpoints and print out a summary of the results) diff --git a/src/lib/Wst/Offchain/BuildTx/DirectorySet.hs b/src/lib/Wst/Offchain/BuildTx/DirectorySet.hs index 17c6923..39dab87 100644 --- a/src/lib/Wst/Offchain/BuildTx/DirectorySet.hs +++ b/src/lib/Wst/Offchain/BuildTx/DirectorySet.hs @@ -36,8 +36,7 @@ import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams) import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..)) import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (..)) -import Wst.Offchain.Scripts (directoryNodeMintingScript, - directoryNodeSpendingScript, scriptPolicyIdV3) +import Wst.Offchain.Scripts (scriptPolicyIdV3) _unused :: String _unused = _printTerm $ unsafeEvalTerm NoTracing (pconstantData initialNode) @@ -57,22 +56,21 @@ initialNode = DirectorySetNode initDirectorySet :: forall era env m. (MonadReader env m, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => m () initDirectorySet = Utils.inBabbage @era $ do - txIn <- asks (Env.dsTxIn . Env.directoryEnv) - paramsPolicyId <- asks (Env.protocolParamsPolicyId . Env.directoryEnv) netId <- queryNetworkId - let mintingScript = directoryNodeMintingScript txIn + directoryMintingScript <- asks (Env.dsDirectoryMintingScript . Env.directoryEnv) + directorySpendingScript <- asks (Env.dsDirectorySpendingScript . Env.directoryEnv) - mintPlutus mintingScript InitDirectory (unTransAssetName directoryNodeToken) 1 + mintPlutus directoryMintingScript InitDirectory (unTransAssetName directoryNodeToken) 1 let val = C.TxOutValueShelleyBased C.shelleyBasedEra $ C.toLedgerValue @era C.maryBasedEra - $ fromList [(C.AssetId (scriptPolicyIdV3 mintingScript) (unTransAssetName directoryNodeToken), 1)] + $ fromList [(C.AssetId (scriptPolicyIdV3 directoryMintingScript) (unTransAssetName directoryNodeToken), 1)] addr = C.makeShelleyAddressInEra C.shelleyBasedEra netId - (C.PaymentCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 $ directoryNodeSpendingScript paramsPolicyId) + (C.PaymentCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 directorySpendingScript) C.NoStakeAddress dat = C.TxOutDatumInline C.babbageBasedEra $ toHashableScriptData initialNode @@ -95,7 +93,6 @@ data InsertNodeArgs = insertDirectoryNode :: forall era env m. (MonadReader env m, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBuildTx era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBlockchain era m) => UTxODat era ProgrammableLogicGlobalParams -> UTxODat era DirectorySetNode -> InsertNodeArgs -> m () insertDirectoryNode UTxODat{uIn=paramsRef} UTxODat{uIn, uOut=firstTxOut, uDatum=firstTxData} InsertNodeArgs{inaNewKey, inaTransferLogic, inaIssuerLogic} = Utils.inBabbage @era $ do netId <- queryNetworkId - paramsPolicyId <- asks (Env.protocolParamsPolicyId . Env.directoryEnv) directorySpendingScript <- asks (Env.dsDirectorySpendingScript . Env.directoryEnv) directoryMintingScript <- asks (Env.dsDirectoryMintingScript . Env.directoryEnv) let @@ -115,7 +112,7 @@ insertDirectoryNode UTxODat{uIn=paramsRef} UTxODat{uIn, uOut=firstTxOut, uDatum= C.makeShelleyAddressInEra C.shelleyBasedEra netId - (C.PaymentCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 $ directoryNodeSpendingScript paramsPolicyId ) + (C.PaymentCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 directorySpendingScript) C.NoStakeAddress dsn = DirectorySetNode diff --git a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs index 0eae8de..81fc5e7 100644 --- a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs +++ b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs @@ -21,6 +21,7 @@ where import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C import Control.Lens ((^.)) +import Control.Monad (unless) import Control.Monad.Reader (MonadReader, asks) import Convex.BuildTx (MonadBuildTx, addReference, addWithdrawalWithTxBody, buildScriptWitness, findIndexReference, @@ -41,6 +42,7 @@ import PlutusLedgerApi.V3 (CurrencySymbol (..)) import SmartTokens.Contracts.Issuance (SmartTokenMintingAction (MintPToken, RegisterPToken)) import SmartTokens.Contracts.ProgrammableLogicBase (ProgrammableLogicGlobalRedeemer (..), TokenProof (..)) +import SmartTokens.Core.Scripts (ScriptTarget) import SmartTokens.Types.ProtocolParams import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..)) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..), @@ -59,12 +61,12 @@ data IssueNewTokenArgs = IssueNewTokenArgs {-| 'IssueNewTokenArgs' for the policy that always succeeds (no checks) -} -alwaysSucceedsArgs :: IssueNewTokenArgs -alwaysSucceedsArgs = +alwaysSucceedsArgs :: ScriptTarget -> IssueNewTokenArgs +alwaysSucceedsArgs target = IssueNewTokenArgs - { intaMintingLogic = alwaysSucceedsScript - , intaTransferLogic = alwaysSucceedsScript - , intaIssuerLogic = alwaysSucceedsScript + { intaMintingLogic = alwaysSucceedsScript target + , intaTransferLogic = alwaysSucceedsScript target + , intaIssuerLogic = alwaysSucceedsScript target } {-| 'IssueNewTokenArgs' for the transfer logic @@ -83,7 +85,7 @@ programmableTokenMintingScript :: ProgrammableLogicGlobalParams -> IssueNewToken programmableTokenMintingScript ProgrammableLogicGlobalParams {progLogicCred, directoryNodeCS} IssueNewTokenArgs{intaMintingLogic} = let progLogicScriptCredential = fromRight (error "could not parse protocol params") $ unTransCredential progLogicCred directoryNodeSymbol = fromRight (error "could not parse protocol params") $ unTransPolicyId directoryNodeCS - in programmableLogicMintingScript progLogicScriptCredential (C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion intaMintingLogic) directoryNodeSymbol + in programmableLogicMintingScript (error "programmableTokenMintingScript: scriptTarget") progLogicScriptCredential (C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion intaMintingLogic) directoryNodeSymbol {-| 'C.AssetId' of the programmable tokens -} @@ -98,8 +100,18 @@ programmableTokenAssetId params inta = - If the programmable token is not in the directory, then it is registered - If the programmable token is in the directory, then it is minted -} -issueProgrammableToken :: forall era env m. (MonadReader env m, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => UTxODat era ProgrammableLogicGlobalParams -> (C.AssetName, C.Quantity) -> IssueNewTokenArgs -> [UTxODat era DirectorySetNode] -> m C.PolicyId -issueProgrammableToken paramsTxOut (an, q) inta@IssueNewTokenArgs{intaTransferLogic, intaIssuerLogic} directoryList = Utils.inBabbage @era $ do +issueProgrammableToken :: forall era env m. (MonadReader env m, Env.HasDirectoryEnv env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => UTxODat era ProgrammableLogicGlobalParams -> (C.AssetName, C.Quantity) -> [UTxODat era DirectorySetNode] -> m C.PolicyId +issueProgrammableToken paramsTxOut (an, q) directoryList = Utils.inBabbage @era $ do + inta@IssueNewTokenArgs{intaTransferLogic, intaIssuerLogic} <- asks (fromTransferEnv . Env.transferLogicEnv) + glParams <- asks (Env.globalParams . Env.directoryEnv) + + -- The global params in the UTxO need to match those in our 'DirectoryEnv'. + -- If they don't, we get a script error when trying to balance the transaction. + -- To avoid this we check for equality here and fail early. + unless (glParams == uDatum paramsTxOut) $ + -- FIXME: Error handling + error "Global params do not match" + let mintingScript = programmableTokenMintingScript (uDatum paramsTxOut) inta issuedPolicyId = C.scriptPolicyId $ C.PlutusScript C.PlutusScriptV3 mintingScript issuedSymbol = transPolicyId issuedPolicyId diff --git a/src/lib/Wst/Offchain/BuildTx/ProtocolParams.hs b/src/lib/Wst/Offchain/BuildTx/ProtocolParams.hs index fedf4ac..a66254d 100644 --- a/src/lib/Wst/Offchain/BuildTx/ProtocolParams.hs +++ b/src/lib/Wst/Offchain/BuildTx/ProtocolParams.hs @@ -18,8 +18,7 @@ import SmartTokens.Types.Constants (protocolParamsToken) import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams) import Wst.Offchain.Env (DirectoryEnv (..)) import Wst.Offchain.Env qualified as Env -import Wst.Offchain.Scripts (protocolParamsMintingScript, - protocolParamsSpendingScript, scriptPolicyIdV3) +import Wst.Offchain.Scripts (scriptPolicyIdV3) protocolParamsTokenC :: C.AssetName protocolParamsTokenC = unTransAssetName protocolParamsToken @@ -28,10 +27,10 @@ protocolParamsTokenC = unTransAssetName protocolParamsToken -} mintProtocolParams :: forall era env m. (MonadReader env m, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBuildTx era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBlockchain era m) => m () mintProtocolParams = Utils.inBabbage @era $ do - txIn <- asks (Env.dsTxIn . Env.directoryEnv) + txIn <- asks (Env.srTxIn . Env.dsScriptRoot . Env.directoryEnv) params <- asks (Env.globalParams . Env.directoryEnv) netId <- queryNetworkId - DirectoryEnv{dsProtocolParamsMintingScript} <- asks Env.directoryEnv + DirectoryEnv{dsProtocolParamsMintingScript, dsProtocolParamsSpendingScript} <- asks Env.directoryEnv let policyId = scriptPolicyIdV3 dsProtocolParamsMintingScript val = C.TxOutValueShelleyBased C.shelleyBasedEra $ C.toLedgerValue @era C.maryBasedEra @@ -41,7 +40,7 @@ mintProtocolParams = Utils.inBabbage @era $ do C.makeShelleyAddressInEra C.shelleyBasedEra netId - (C.PaymentCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 protocolParamsSpendingScript) + (C.PaymentCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 dsProtocolParamsSpendingScript) C.NoStakeAddress -- Should contain directoryNodeCS and progLogicCred fields diff --git a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs index bf080f8..6455c53 100644 --- a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs +++ b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs @@ -44,24 +44,13 @@ import SmartTokens.Types.ProtocolParams import SmartTokens.Types.PTokenDirectory (BlacklistNode (..), DirectorySetNode (..)) import Wst.AppError (AppError (TransferBlacklistedCredential)) -import Wst.Offchain.BuildTx.ProgrammableLogic (IssueNewTokenArgs (..), - issueProgrammableToken, +import Wst.Offchain.BuildTx.ProgrammableLogic (issueProgrammableToken, seizeProgrammableToken, transferProgrammableToken) import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (..)) import Wst.Offchain.Scripts (scriptPolicyIdV3) -intaFromEnv :: forall env m. (MonadReader env m, Env.HasTransferLogicEnv env)=> m IssueNewTokenArgs -intaFromEnv = do - Env.TransferLogicEnv{Env.tleIssuerScript, Env.tleMintingScript, Env.tleTransferScript} <- asks Env.transferLogicEnv - pure $ IssueNewTokenArgs - { intaTransferLogic= tleTransferScript - , intaMintingLogic= tleMintingScript - , intaIssuerLogic= tleIssuerScript - } - - {- >>> _printTerm $ unsafeEvalTerm NoTracing (pconstant blacklistInitialNode) "program\n 1.0.0\n (List [B #, B #ffffffffffffffffffffffffffffffffffffffffffffffffffffffff])" @@ -157,10 +146,7 @@ paySmartTokensToDestination (an, q) issuedPolicyId destinationCred = Utils.inBab issueSmartTokens :: forall era env m. (MonadReader env m, Env.HasTransferLogicEnv env, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m, Env.HasOperatorEnv era env) => UTxODat era ProgrammableLogicGlobalParams -> (C.AssetName, C.Quantity) -> [UTxODat era DirectorySetNode] -> C.PaymentCredential -> m C.AssetId issueSmartTokens paramsTxOut (an, q) directoryList destinationCred = Utils.inBabbage @era $ do - inta <- intaFromEnv - issuedPolicyId <- issueProgrammableToken paramsTxOut (an, q) inta directoryList - - + issuedPolicyId <- issueProgrammableToken paramsTxOut (an, q) directoryList addIssueWitness -- payToAddress addr value paySmartTokensToDestination (an, q) issuedPolicyId destinationCred diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index 5204460..0969864 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -30,6 +30,7 @@ import Wst.Offchain.BuildTx.DirectorySet qualified as BuildTx import Wst.Offchain.BuildTx.ProgrammableLogic qualified as BuildTx import Wst.Offchain.BuildTx.ProtocolParams qualified as BuildTx import Wst.Offchain.BuildTx.TransferLogic qualified as BuildTx +import Wst.Offchain.Env (DirectoryScriptRoot (..)) import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (..)) import Wst.Offchain.Query qualified as Query @@ -37,14 +38,15 @@ import Wst.Offchain.Query qualified as Query {-| Build a transaction that deploys the directory and global params. Returns the transaction and the 'TxIn' that was selected for the one-shot NFTs. -} -deployTx :: (MonadReader env m, Env.HasOperatorEnv era env, MonadBlockchain era m, MonadError (AppError era) m, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era) => m (C.Tx era, C.TxIn) -deployTx = do +deployTx :: (MonadReader env m, Env.HasOperatorEnv era env, MonadBlockchain era m, MonadError (AppError era) m, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era) => ScriptTarget -> m (C.Tx era, DirectoryScriptRoot) +deployTx target = do (txi, _) <- Env.selectOperatorOutput opEnv <- asks Env.operatorEnv - (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withDirectoryFor Production txi + let root = DirectoryScriptRoot txi target + (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withDirectoryFor root $ Env.balanceTxEnv_ $ BuildTx.mintProtocolParams >> BuildTx.initDirectorySet - pure (Convex.CoinSelection.signBalancedTxBody [] tx, txi) + pure (Convex.CoinSelection.signBalancedTxBody [] tx, root) {-| Build a transaction that inserts a node into the directory -} @@ -69,6 +71,7 @@ issueProgrammableTokenTx :: forall era env m. ( MonadReader env m , Env.HasOperatorEnv era env , Env.HasDirectoryEnv env + , Env.HasTransferLogicEnv env , MonadBlockchain era m , MonadError (AppError era) m , C.IsBabbageBasedEra era @@ -83,7 +86,7 @@ issueProgrammableTokenTx issueTokenArgs assetName quantity = do directory <- Query.registryNodes @era paramsNode <- Query.globalParamsNode @era (tx, _) <- Env.balanceTxEnv_ $ do - polId <- BuildTx.issueProgrammableToken paramsNode (assetName, quantity) issueTokenArgs directory + polId <- BuildTx.issueProgrammableToken paramsNode (assetName, quantity) directory Env.operatorPaymentCredential >>= BuildTx.paySmartTokensToDestination (assetName, quantity) polId let hsh = C.hashScript (C.PlutusScript C.plutusScriptVersion $ BuildTx.intaMintingLogic issueTokenArgs) @@ -94,7 +97,7 @@ deployBlacklistTx :: (MonadReader env m, Env.HasOperatorEnv era env, MonadBlockc deployBlacklistTx = do opEnv <- asks Env.operatorEnv dirEnv <- asks Env.directoryEnv - (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withDirectory dirEnv $ Env.withTransferFromOperator + (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withDirectory dirEnv $ Env.withTransferFromOperator (error "issueProgramableTokenTx: target") $ Env.balanceTxEnv_ BuildTx.initBlacklist pure (Convex.CoinSelection.signBalancedTxBody [] tx) diff --git a/src/lib/Wst/Offchain/Env.hs b/src/lib/Wst/Offchain/Env.hs index e3153eb..b007498 100644 --- a/src/lib/Wst/Offchain/Env.hs +++ b/src/lib/Wst/Offchain/Env.hs @@ -19,7 +19,10 @@ module Wst.Offchain.Env( balanceTxEnv, balanceTxEnv_, - -- * Directory environment + -- * On-chain scripts + + -- ** Directory environment + DirectoryScriptRoot(..), HasDirectoryEnv(..), DirectoryEnv(..), mkDirectoryEnv, @@ -30,7 +33,7 @@ module Wst.Offchain.Env( globalParams, getGlobalParams, - -- * Transfer logic environment + -- ** Transfer logic environment TransferLogicEnv(..), HasTransferLogicEnv(..), mkTransferLogicEnv, @@ -96,7 +99,8 @@ import Wst.Offchain.Scripts (blacklistMintingScript, blacklistSpendingScript, permissionedTransferScript, programmableLogicBaseScript, programmableLogicGlobalScript, - protocolParamsMintingScript, scriptPolicyIdV3) + protocolParamsMintingScript, + protocolParamsSpendingScript, scriptPolicyIdV3) {-| Environments that have an 'OperatorEnv' -} @@ -165,6 +169,16 @@ balanceTxEnv btx = do (balBody, balChanges) <- mapError BalancingError (CoinSelection.balanceTx mempty output (Utxos.fromApiUtxo bteOperatorUtxos) txBuilder CoinSelection.TrailingChange) pure ((balBody, balChanges), r) +{-| Data that completely determines the on-chain scripts and their hashes. +Any information that results in different script hashes should go in here. +We should be able to write a function 'ScriptRoot -> script' for all of +our scripts. +-} +data DirectoryScriptRoot = + DirectoryScriptRoot + { srTxIn :: C.TxIn + , srTarget :: ScriptTarget + } class HasDirectoryEnv e where directoryEnv :: e -> DirectoryEnv @@ -177,25 +191,28 @@ All of the scripts and their hashes are determined by the 'TxIn'. -} data DirectoryEnv = DirectoryEnv - { dsTxIn :: C.TxIn -- ^ The 'txIn' that we spend when deploying the protocol params and directory set + { dsScriptRoot :: DirectoryScriptRoot , dsDirectoryMintingScript :: PlutusScript PlutusScriptV3 , dsDirectorySpendingScript :: PlutusScript PlutusScriptV3 , dsProtocolParamsMintingScript :: PlutusScript PlutusScriptV3 + , dsProtocolParamsSpendingScript :: PlutusScript PlutusScriptV3 , dsProgrammableLogicBaseScript :: PlutusScript PlutusScriptV3 , dsProgrammableLogicGlobalScript :: PlutusScript PlutusScriptV3 } -mkDirectoryEnv :: ScriptTarget -> C.TxIn -> DirectoryEnv -mkDirectoryEnv target dsTxIn = - let dsDirectoryMintingScript = directoryNodeMintingScript dsTxIn - dsProtocolParamsMintingScript = protocolParamsMintingScript target dsTxIn - dsDirectorySpendingScript = directoryNodeSpendingScript (protocolParamsPolicyId result) - dsProgrammableLogicBaseScript = programmableLogicBaseScript (programmableLogicStakeCredential result) -- Parameterized by the stake cred of the global script - dsProgrammableLogicGlobalScript = programmableLogicGlobalScript (protocolParamsPolicyId result) -- Parameterized by the CS holding protocol params datum +mkDirectoryEnv :: DirectoryScriptRoot -> DirectoryEnv +mkDirectoryEnv dsScriptRoot@DirectoryScriptRoot{srTxIn, srTarget} = + let dsDirectoryMintingScript = directoryNodeMintingScript srTarget srTxIn + dsProtocolParamsMintingScript = protocolParamsMintingScript srTarget srTxIn + dsProtocolParamsSpendingScript = protocolParamsSpendingScript srTarget + dsDirectorySpendingScript = directoryNodeSpendingScript srTarget (protocolParamsPolicyId result) + dsProgrammableLogicBaseScript = programmableLogicBaseScript srTarget (programmableLogicStakeCredential result) -- Parameterized by the stake cred of the global script + dsProgrammableLogicGlobalScript = programmableLogicGlobalScript srTarget (protocolParamsPolicyId result) -- Parameterized by the CS holding protocol params datum result = DirectoryEnv - { dsTxIn + { dsScriptRoot , dsDirectoryMintingScript , dsProtocolParamsMintingScript + , dsProtocolParamsSpendingScript , dsProgrammableLogicBaseScript , dsProgrammableLogicGlobalScript , dsDirectorySpendingScript @@ -244,20 +261,21 @@ class HasTransferLogicEnv e where instance HasTransferLogicEnv TransferLogicEnv where transferLogicEnv = id +-- FIXME (jm): replace arguments with transferLogicEnvRoot? {-| The 'TransferLogicEnv' with scripts that allow the given payment credential to manage the blacklist and issue / burn tokens -} -mkTransferLogicEnv :: C.PaymentCredential -> C.Hash C.PaymentKey -> TransferLogicEnv -mkTransferLogicEnv progLogicBaseCred cred = - let blacklistMinting = blacklistMintingScript cred +mkTransferLogicEnv :: ScriptTarget -> C.PaymentCredential -> C.Hash C.PaymentKey -> TransferLogicEnv +mkTransferLogicEnv target progLogicBaseCred cred = + let blacklistMinting = blacklistMintingScript target cred blacklistPolicy = scriptPolicyIdV3 blacklistMinting in TransferLogicEnv { tleBlacklistMintingScript = blacklistMinting - , tleBlacklistSpendingScript = blacklistSpendingScript cred - , tleMintingScript = permissionedTransferScript cred - , tleTransferScript = freezeTransferScript progLogicBaseCred blacklistPolicy - , tleIssuerScript = permissionedTransferScript cred + , tleBlacklistSpendingScript = blacklistSpendingScript target cred + , tleMintingScript = permissionedTransferScript target cred + , tleTransferScript = freezeTransferScript target progLogicBaseCred blacklistPolicy + , tleIssuerScript = permissionedTransferScript target cred } blacklistNodePolicyId :: TransferLogicEnv -> C.PolicyId @@ -334,8 +352,8 @@ instance HasLogger (CombinedEnv o d t Identity era) where {-| Add a 'DirectoryEnv' for the 'C.TxIn' in to the environment -} -addDirectoryEnvFor :: ScriptTarget -> C.TxIn -> CombinedEnv o d t r era -> CombinedEnv o Identity t r era -addDirectoryEnvFor target txi = addDirectoryEnv (mkDirectoryEnv target txi) +addDirectoryEnvFor :: DirectoryScriptRoot -> CombinedEnv o d t r era -> CombinedEnv o Identity t r era +addDirectoryEnvFor = addDirectoryEnv . mkDirectoryEnv {-| Add a 'DirectoryEnv' for the 'C.TxIn' in to the environment -} @@ -348,8 +366,8 @@ withDirectory dir action = do asks (addDirectoryEnv dir) >>= runReaderT action -withDirectoryFor :: MonadReader (CombinedEnv o d t r era) m => ScriptTarget -> C.TxIn -> ReaderT (CombinedEnv o Identity t r era) m a -> m a -withDirectoryFor target txi = withDirectory (mkDirectoryEnv target txi) +withDirectoryFor :: MonadReader (CombinedEnv o d t r era) m => DirectoryScriptRoot -> ReaderT (CombinedEnv o Identity t r era) m a -> m a +withDirectoryFor = withDirectory . mkDirectoryEnv {-| Add a 'TransferLogicEnv' for the 'C.Hash C.PaymentKey' corresponding to the admin hash @@ -363,15 +381,15 @@ withTransfer dir action = do asks (addTransferEnv dir) >>= runReaderT action -withTransferFor :: MonadReader (CombinedEnv o Identity t r era) m => C.PaymentCredential -> C.Hash C.PaymentKey -> ReaderT (CombinedEnv o Identity Identity r era) m a -> m a -withTransferFor plbBaseCred opPKH = withTransfer $ mkTransferLogicEnv plbBaseCred opPKH +withTransferFor :: MonadReader (CombinedEnv o Identity t r era) m => ScriptTarget -> C.PaymentCredential -> C.Hash C.PaymentKey -> ReaderT (CombinedEnv o Identity Identity r era) m a -> m a +withTransferFor target plbBaseCred opPKH = withTransfer $ mkTransferLogicEnv target plbBaseCred opPKH -withTransferFromOperator :: (MonadReader (CombinedEnv Identity Identity t r era) m) => ReaderT (CombinedEnv Identity Identity Identity r era) m a -> m a -withTransferFromOperator action = do +withTransferFromOperator :: (MonadReader (CombinedEnv Identity Identity t r era) m) => ScriptTarget -> ReaderT (CombinedEnv Identity Identity Identity r era) m a -> m a +withTransferFromOperator target action = do env <- ask let opPkh = fst . bteOperator . operatorEnv $ env programmableBaseLogicCred = programmableLogicBaseCredential . directoryEnv $ env - runReaderT action (addTransferEnv (mkTransferLogicEnv programmableBaseLogicCred opPkh) env) + runReaderT action (addTransferEnv (mkTransferLogicEnv target programmableBaseLogicCred opPkh) env) {-| Add a 'DirectoryEnv' for the 'C.TxIn' in to the environment and run the action with the modified environment diff --git a/src/lib/Wst/Offchain/Query.hs b/src/lib/Wst/Offchain/Query.hs index 788cab9..4f1eaae 100644 --- a/src/lib/Wst/Offchain/Query.hs +++ b/src/lib/Wst/Offchain/Query.hs @@ -34,12 +34,10 @@ import PlutusTx qualified import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams) import SmartTokens.Types.PTokenDirectory (BlacklistNode, DirectorySetNode (..)) import Wst.AppError (AppError (GlobalParamsNodeNotFound)) -import Wst.Offchain.Env (DirectoryEnv (dsDirectorySpendingScript, dsProgrammableLogicBaseScript), - HasDirectoryEnv (directoryEnv), +import Wst.Offchain.Env (DirectoryEnv (..), HasDirectoryEnv (directoryEnv), HasTransferLogicEnv (transferLogicEnv), TransferLogicEnv (tleBlacklistSpendingScript), blacklistNodePolicyId, directoryNodePolicyId) -import Wst.Offchain.Scripts (protocolParamsSpendingScript) -- TODO: We should probably filter the UTxOs to check that they have the correct NFTs @@ -83,9 +81,10 @@ userProgrammableOutputs userCred = do {-| Find the UTxO with the global params -} -globalParamsNode :: forall era m. (MonadUtxoQuery m, C.IsBabbageBasedEra era, MonadError (AppError era) m) => m (UTxODat era ProgrammableLogicGlobalParams) +globalParamsNode :: forall era env m. (MonadReader env m, HasDirectoryEnv env, MonadUtxoQuery m, C.IsBabbageBasedEra era, MonadError (AppError era) m) => m (UTxODat era ProgrammableLogicGlobalParams) globalParamsNode = do - let cred = C.PaymentCredentialByScript . C.hashScript . C.PlutusScript C.PlutusScriptV3 $ protocolParamsSpendingScript + DirectoryEnv{dsProtocolParamsSpendingScript} <- asks directoryEnv + let cred = C.PaymentCredentialByScript . C.hashScript $ C.PlutusScript C.PlutusScriptV3 dsProtocolParamsSpendingScript utxosByPaymentCredential cred >>= maybe (throwError GlobalParamsNodeNotFound) pure . listToMaybe . extractUTxO @era diff --git a/src/lib/Wst/Offchain/Scripts.hs b/src/lib/Wst/Offchain/Scripts.hs index 43a75cc..a815cd0 100644 --- a/src/lib/Wst/Offchain/Scripts.hs +++ b/src/lib/Wst/Offchain/Scripts.hs @@ -61,70 +61,70 @@ protocolParamsMintingScript target txIn = -- | The spending script for the protocol parameters NFT parameterized by "" -- nonce -protocolParamsSpendingScript :: C.PlutusScript C.PlutusScriptV3 -protocolParamsSpendingScript = - let script = Scripts.tryCompile Debug $ alwaysFailScript # pforgetData (pdata (pconstant "" :: ClosedTerm PByteString)) +protocolParamsSpendingScript :: ScriptTarget -> C.PlutusScript C.PlutusScriptV3 +protocolParamsSpendingScript target = + let script = Scripts.tryCompile target $ alwaysFailScript # pforgetData (pdata (pconstant "" :: ClosedTerm PByteString)) in C.PlutusScriptSerialised $ serialiseScript script -- | The minting script for the directory node tokens, takes initial TxIn for -- symbol uniqueness across instances -directoryNodeMintingScript :: C.TxIn -> C.PlutusScript C.PlutusScriptV3 -directoryNodeMintingScript txIn = - let script = Scripts.tryCompile Debug $ mkDirectoryNodeMP # pdata (pconstant $ transTxOutRef txIn) +directoryNodeMintingScript :: ScriptTarget -> C.TxIn -> C.PlutusScript C.PlutusScriptV3 +directoryNodeMintingScript target txIn = + let script = Scripts.tryCompile target $ mkDirectoryNodeMP # pdata (pconstant $ transTxOutRef txIn) in C.PlutusScriptSerialised $ serialiseScript script -- | The spending script for the directory node tokens, parameterized by the -- policy id of the protocol parameters NFT. -directoryNodeSpendingScript :: C.PolicyId -> C.PlutusScript C.PlutusScriptV3 -directoryNodeSpendingScript paramsPolId = - let script = Scripts.tryCompile Debug $ pmkDirectorySpending # pdata (pconstant $ transPolicyId paramsPolId) +directoryNodeSpendingScript :: ScriptTarget -> C.PolicyId -> C.PlutusScript C.PlutusScriptV3 +directoryNodeSpendingScript target paramsPolId = + let script = Scripts.tryCompile target $ pmkDirectorySpending # pdata (pconstant $ transPolicyId paramsPolId) in C.PlutusScriptSerialised $ serialiseScript script -- TODO: can we change the signature to just take the param policy id? -programmableLogicMintingScript :: C.PaymentCredential -> C.StakeCredential -> C.PolicyId -> C.PlutusScript C.PlutusScriptV3 -programmableLogicMintingScript progLogicBaseSpndingCred mintingCred nodePolId = - let script = Scripts.tryCompile Debug +programmableLogicMintingScript :: ScriptTarget -> C.PaymentCredential -> C.StakeCredential -> C.PolicyId -> C.PlutusScript C.PlutusScriptV3 +programmableLogicMintingScript target progLogicBaseSpndingCred mintingCred nodePolId = + let script = Scripts.tryCompile target $ mkProgrammableLogicMinting # pdata (pconstant $ transCredential progLogicBaseSpndingCred) # pdata (pconstant $ transPolicyId nodePolId) # pdata (pconstant $ transStakeCredential mintingCred) in C.PlutusScriptSerialised $ serialiseScript script -programmableLogicBaseScript :: C.StakeCredential -> C.PlutusScript C.PlutusScriptV3 -- Parameterized by the stake cred of the global script -programmableLogicBaseScript globalCred = - let script = Scripts.tryCompile Debug $ mkProgrammableLogicBase # pdata (pconstant $ transStakeCredential globalCred) +programmableLogicBaseScript :: ScriptTarget -> C.StakeCredential -> C.PlutusScript C.PlutusScriptV3 -- Parameterized by the stake cred of the global script +programmableLogicBaseScript target globalCred = + let script = Scripts.tryCompile target $ mkProgrammableLogicBase # pdata (pconstant $ transStakeCredential globalCred) in C.PlutusScriptSerialised $ serialiseScript script -programmableLogicGlobalScript :: C.PolicyId -> C.PlutusScript C.PlutusScriptV3 -- Parameterized by the CS holding protocol params datum -programmableLogicGlobalScript paramsPolId = - let script = Scripts.tryCompile Debug $ mkProgrammableLogicGlobal # pdata (pconstant $ transPolicyId paramsPolId) +programmableLogicGlobalScript :: ScriptTarget -> C.PolicyId -> C.PlutusScript C.PlutusScriptV3 -- Parameterized by the CS holding protocol params datum +programmableLogicGlobalScript target paramsPolId = + let script = Scripts.tryCompile target $ mkProgrammableLogicGlobal # pdata (pconstant $ transPolicyId paramsPolId) in C.PlutusScriptSerialised $ serialiseScript script -permissionedTransferScript :: C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 -permissionedTransferScript cred = - let script = Scripts.tryCompile Debug $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred) +permissionedTransferScript :: ScriptTarget -> C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 +permissionedTransferScript target cred = + let script = Scripts.tryCompile target $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred) in C.PlutusScriptSerialised $ serialiseScript script -freezeTransferScript :: C.PaymentCredential -> C.PolicyId -> C.PlutusScript C.PlutusScriptV3 -freezeTransferScript progLogicBaseSpndingCred blacklistPolicyId = - let script = Scripts.tryCompile Debug $ mkFreezeAndSeizeTransfer # pdata (pconstant $ transCredential progLogicBaseSpndingCred) # pdata (pconstant $ transPolicyId blacklistPolicyId) +freezeTransferScript :: ScriptTarget -> C.PaymentCredential -> C.PolicyId -> C.PlutusScript C.PlutusScriptV3 +freezeTransferScript target progLogicBaseSpndingCred blacklistPolicyId = + let script = Scripts.tryCompile target $ mkFreezeAndSeizeTransfer # pdata (pconstant $ transCredential progLogicBaseSpndingCred) # pdata (pconstant $ transPolicyId blacklistPolicyId) in C.PlutusScriptSerialised $ serialiseScript script -blacklistMintingScript :: C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 -blacklistMintingScript cred = - let script = Scripts.tryCompile Debug $ mkPermissionedMinting # pdata (pconstant $ transPubKeyHash cred) +blacklistMintingScript :: ScriptTarget -> C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 +blacklistMintingScript target cred = + let script = Scripts.tryCompile target $ mkPermissionedMinting # pdata (pconstant $ transPubKeyHash cred) in C.PlutusScriptSerialised $ serialiseScript script -blacklistSpendingScript :: C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 -blacklistSpendingScript cred = - let script = Scripts.tryCompile Debug $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred) +blacklistSpendingScript :: ScriptTarget -> C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 +blacklistSpendingScript target cred = + let script = Scripts.tryCompile target $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred) in C.PlutusScriptSerialised $ serialiseScript script {-| 'C.PlutusScript C.PlutusScriptV3' that always succeeds. Can be used for minting, withdrawal, spending, etc. -} -alwaysSucceedsScript :: C.PlutusScript C.PlutusScriptV3 -alwaysSucceedsScript = - C.PlutusScriptSerialised $ serialiseScript $ Scripts.tryCompile Debug palwaysSucceed +alwaysSucceedsScript :: ScriptTarget -> C.PlutusScript C.PlutusScriptV3 +alwaysSucceedsScript target = + C.PlutusScriptSerialised $ serialiseScript $ Scripts.tryCompile target palwaysSucceed -- Utilities scriptPolicyIdV3 :: C.PlutusScript C.PlutusScriptV3 -> C.PolicyId diff --git a/src/lib/Wst/Server.hs b/src/lib/Wst/Server.hs index f3cdcc7..7ac9a7d 100644 --- a/src/lib/Wst/Server.hs +++ b/src/lib/Wst/Server.hs @@ -36,6 +36,7 @@ import Wst.Server.Types (APIInEra, AddToBlacklistArgs (..), BuildTxAPI, SeizeAssetsArgs (..), SerialiseAddress (..), TextEnvelopeJSON (..), TransferProgrammableTokenArgs (..)) +import SmartTokens.Core.Scripts (ScriptTarget(Production)) data ServerArgs = ServerArgs @@ -91,7 +92,7 @@ queryBlacklistedNodes :: forall era env m. -> m [C.Hash C.PaymentKey] queryBlacklistedNodes _ (SerialiseAddress addr) = do programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) - let transferLogic = Env.mkTransferLogicEnv programmableBaseLogicCred (paymentKeyHashFromAddress addr) + let transferLogic = Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress addr) getHash = either (error "deserialiseFromRawBytes failed") id . C.deserialiseFromRawBytes (C.proxyToAsType $ Proxy @(C.Hash C.PaymentKey)) @@ -141,8 +142,9 @@ issueProgrammableTokenEndpoint IssueProgrammableTokenArgs{itaAssetName, itaQuant dirEnv <- asks Env.directoryEnv -- FIXME: Replace alwaysSucceedsArgs with blacklist monetary policy as soon as it is finished - let tokenArgs = alwaysSucceedsArgs - Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ do + let tokenArgs = alwaysSucceedsArgs Production + programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) + Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer (Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress itaIssuer)) $ do TextEnvelopeJSON <$> Endpoints.issueProgrammableTokenTx tokenArgs itaAssetName itaQuantity paymentCredentialFromAddress :: C.Address C.ShelleyAddr -> C.PaymentCredential @@ -168,7 +170,7 @@ transferProgrammableTokenEndpoint TransferProgrammableTokenArgs{ttaSender, ttaRe operatorEnv <- Env.loadOperatorEnvFromAddress ttaSender dirEnv <- asks Env.directoryEnv programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) - let transferLogic = Env.mkTransferLogicEnv programmableBaseLogicCred (paymentKeyHashFromAddress ttaIssuer) + let transferLogic = Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress ttaIssuer) assetId <- programmableTokenAssetId <$> Env.getGlobalParams <*> pure (fromTransferEnv transferLogic) <*> pure ttaAssetName Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer transferLogic $ do TextEnvelopeJSON <$> Endpoints.transferSmartTokensTx assetId ttaQuantity (paymentCredentialFromAddress ttaRecipient) @@ -188,7 +190,7 @@ addToBlacklistEndpoint AddToBlacklistArgs{atbIssuer, atbBlacklistAddress} = do operatorEnv <- Env.loadOperatorEnvFromAddress atbIssuer dirEnv <- asks Env.directoryEnv programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) - let transferLogic = Env.mkTransferLogicEnv programmableBaseLogicCred (paymentKeyHashFromAddress atbIssuer) + let transferLogic = Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress atbIssuer) Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer transferLogic $ do TextEnvelopeJSON <$> Endpoints.blacklistCredentialTx badCred @@ -207,6 +209,6 @@ seizeAssetsEndpoint SeizeAssetsArgs{saIssuer, saTarget} = do operatorEnv <- Env.loadOperatorEnvFromAddress saIssuer dirEnv <- asks Env.directoryEnv programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) - let transferLogic = Env.mkTransferLogicEnv programmableBaseLogicCred (paymentKeyHashFromAddress saIssuer) + let transferLogic = Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress saIssuer) Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer transferLogic $ do TextEnvelopeJSON <$> Endpoints.seizeCredentialAssetsTx badCred diff --git a/src/lib/Wst/Server/Endpoints.hs b/src/lib/Wst/Server/Endpoints.hs deleted file mode 100644 index 8949dfd..0000000 --- a/src/lib/Wst/Server/Endpoints.hs +++ /dev/null @@ -1,31 +0,0 @@ - -{- | This module contains the endpoints of the server. --} -module Wst.Server.Endpoints ( - healthcheck, - -- * Query endpoints - queryGlobalParams, - - -- * Build tx endpoints - issueProgrammableTokens -) where - -import Cardano.Api qualified as C -import Control.Monad.Except (MonadError) -import Convex.Class (MonadUtxoQuery) -import Servant (Handler) -import Servant.API (NoContent (..)) -import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams) -import Wst.AppError (AppError) -import Wst.Offchain.Query (UTxODat) -import Wst.Offchain.Query qualified as Query -import Wst.Server.Types (IssueProgrammableTokenArgs, TextEnvelopeJSON) - -healthcheck :: Handler NoContent -healthcheck = pure NoContent - -queryGlobalParams :: forall era m. (MonadUtxoQuery m, C.IsBabbageBasedEra era, MonadError (AppError era) m) => m (UTxODat era ProgrammableLogicGlobalParams) -queryGlobalParams = Query.globalParamsNode - -issueProgrammableTokens :: forall era m. IssueProgrammableTokenArgs -> m (TextEnvelopeJSON (C.Tx era)) -issueProgrammableTokens = undefined diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index f6a840b..e3eba06 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -84,7 +84,6 @@ library Wst.Offchain.Query Wst.Offchain.Scripts Wst.Server - Wst.Server.Endpoints Wst.Server.Types hs-source-dirs: lib From 4f4997ab8d59d6d90fc8bafae748976cdf039199 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Thu, 2 Jan 2025 16:10:39 +0100 Subject: [PATCH 04/22] Fix build error --- .../Wst/Offchain/BuildTx/ProgrammableLogic.hs | 51 ++++--------------- src/lib/Wst/Offchain/Endpoints/Deployment.hs | 11 ++-- src/lib/Wst/Offchain/Env.hs | 24 +++++++-- src/lib/Wst/Server.hs | 13 ++--- 4 files changed, 39 insertions(+), 60 deletions(-) diff --git a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs index 81fc5e7..943b8f3 100644 --- a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs +++ b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs @@ -6,11 +6,7 @@ {-# HLINT ignore "Use second" #-} module Wst.Offchain.BuildTx.ProgrammableLogic - ( - IssueNewTokenArgs (..), - alwaysSucceedsArgs, - fromTransferEnv, - programmableTokenMintingScript, + ( programmableTokenMintingScript, programmableTokenAssetId, issueProgrammableToken, transferProgrammableToken, @@ -42,7 +38,6 @@ import PlutusLedgerApi.V3 (CurrencySymbol (..)) import SmartTokens.Contracts.Issuance (SmartTokenMintingAction (MintPToken, RegisterPToken)) import SmartTokens.Contracts.ProgrammableLogicBase (ProgrammableLogicGlobalRedeemer (..), TokenProof (..)) -import SmartTokens.Core.Scripts (ScriptTarget) import SmartTokens.Types.ProtocolParams import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..)) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..), @@ -50,46 +45,20 @@ import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..), import Wst.Offchain.Env (TransferLogicEnv (..)) import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (..)) -import Wst.Offchain.Scripts (alwaysSucceedsScript, - programmableLogicMintingScript) - -data IssueNewTokenArgs = IssueNewTokenArgs - { intaMintingLogic :: C.PlutusScript C.PlutusScriptV3, -- TODO: We could add a parameter for the script 'lang' instead of fixing it to PlutusV3 - intaTransferLogic :: C.PlutusScript C.PlutusScriptV3, - intaIssuerLogic :: C.PlutusScript C.PlutusScriptV3 - } - -{-| 'IssueNewTokenArgs' for the policy that always succeeds (no checks) --} -alwaysSucceedsArgs :: ScriptTarget -> IssueNewTokenArgs -alwaysSucceedsArgs target = - IssueNewTokenArgs - { intaMintingLogic = alwaysSucceedsScript target - , intaTransferLogic = alwaysSucceedsScript target - , intaIssuerLogic = alwaysSucceedsScript target - } - -{-| 'IssueNewTokenArgs' for the transfer logic --} -fromTransferEnv :: TransferLogicEnv -> IssueNewTokenArgs -fromTransferEnv TransferLogicEnv{tleMintingScript, tleTransferScript, tleIssuerScript} = - IssueNewTokenArgs - { intaMintingLogic = tleMintingScript - , intaTransferLogic = tleTransferScript - , intaIssuerLogic = tleIssuerScript - } +import Wst.Offchain.Scripts (programmableLogicMintingScript) +-- FIXME: Move to Env {-| The minting script for a programmable token that uses the global parameters -} -programmableTokenMintingScript :: ProgrammableLogicGlobalParams -> IssueNewTokenArgs -> C.PlutusScript C.PlutusScriptV3 -programmableTokenMintingScript ProgrammableLogicGlobalParams {progLogicCred, directoryNodeCS} IssueNewTokenArgs{intaMintingLogic} = +programmableTokenMintingScript :: ProgrammableLogicGlobalParams -> TransferLogicEnv -> C.PlutusScript C.PlutusScriptV3 +programmableTokenMintingScript ProgrammableLogicGlobalParams {progLogicCred, directoryNodeCS} TransferLogicEnv{tleMintingScript} = let progLogicScriptCredential = fromRight (error "could not parse protocol params") $ unTransCredential progLogicCred directoryNodeSymbol = fromRight (error "could not parse protocol params") $ unTransPolicyId directoryNodeCS - in programmableLogicMintingScript (error "programmableTokenMintingScript: scriptTarget") progLogicScriptCredential (C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion intaMintingLogic) directoryNodeSymbol + in programmableLogicMintingScript (error "programmableTokenMintingScript: scriptTarget") progLogicScriptCredential (C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion tleMintingScript) directoryNodeSymbol {-| 'C.AssetId' of the programmable tokens -} -programmableTokenAssetId :: ProgrammableLogicGlobalParams -> IssueNewTokenArgs -> C.AssetName -> C.AssetId +programmableTokenAssetId :: ProgrammableLogicGlobalParams -> TransferLogicEnv -> C.AssetName -> C.AssetId programmableTokenAssetId params inta = C.AssetId (C.scriptPolicyId $ C.PlutusScript C.plutusScriptVersion $ programmableTokenMintingScript params inta) @@ -102,7 +71,7 @@ programmableTokenAssetId params inta = -} issueProgrammableToken :: forall era env m. (MonadReader env m, Env.HasDirectoryEnv env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => UTxODat era ProgrammableLogicGlobalParams -> (C.AssetName, C.Quantity) -> [UTxODat era DirectorySetNode] -> m C.PolicyId issueProgrammableToken paramsTxOut (an, q) directoryList = Utils.inBabbage @era $ do - inta@IssueNewTokenArgs{intaTransferLogic, intaIssuerLogic} <- asks (fromTransferEnv . Env.transferLogicEnv) + inta@TransferLogicEnv{tleMintingScript, tleTransferScript, tleIssuerScript} <- asks Env.transferLogicEnv glParams <- asks (Env.globalParams . Env.directoryEnv) -- The global params in the UTxO need to match those in our 'DirectoryEnv'. @@ -127,8 +96,8 @@ issueProgrammableToken paramsTxOut (an, q) directoryList = Utils.inBabbage @era let nodeArgs = InsertNodeArgs { inaNewKey = issuedSymbol - , inaTransferLogic = C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion intaTransferLogic - , inaIssuerLogic = C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion intaIssuerLogic + , inaTransferLogic = C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion tleTransferScript + , inaIssuerLogic = C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion tleIssuerScript } mintPlutus mintingScript RegisterPToken an q diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index 0969864..fda65b5 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-| Deploy the directory and global params -} module Wst.Offchain.Endpoints.Deployment( @@ -78,19 +79,19 @@ issueProgrammableTokenTx :: forall era env m. , C.HasScriptLanguageInEra C.PlutusScriptV3 era , MonadUtxoQuery m ) - => BuildTx.IssueNewTokenArgs -- ^ credentials of the token - -> C.AssetName -- ^ Name of the asset + => C.AssetName -- ^ Name of the asset -> Quantity -- ^ Amount of tokens to be minted -> m (C.Tx era) -issueProgrammableTokenTx issueTokenArgs assetName quantity = do +issueProgrammableTokenTx assetName quantity = do directory <- Query.registryNodes @era paramsNode <- Query.globalParamsNode @era + Env.TransferLogicEnv{Env.tleMintingScript} <- asks Env.transferLogicEnv (tx, _) <- Env.balanceTxEnv_ $ do polId <- BuildTx.issueProgrammableToken paramsNode (assetName, quantity) directory Env.operatorPaymentCredential >>= BuildTx.paySmartTokensToDestination (assetName, quantity) polId - let hsh = C.hashScript (C.PlutusScript C.plutusScriptVersion $ BuildTx.intaMintingLogic issueTokenArgs) - BuildTx.addScriptWithdrawal hsh 0 $ BuildTx.buildScriptWitness (BuildTx.intaMintingLogic issueTokenArgs) C.NoScriptDatumForStake () + let hsh = C.hashScript (C.PlutusScript C.plutusScriptVersion tleMintingScript) + BuildTx.addScriptWithdrawal hsh 0 $ BuildTx.buildScriptWitness tleMintingScript C.NoScriptDatumForStake () pure (Convex.CoinSelection.signBalancedTxBody [] tx) deployBlacklistTx :: (MonadReader env m, Env.HasOperatorEnv era env, MonadBlockchain era m, MonadError (AppError era) m, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era, Env.HasDirectoryEnv env) => m (C.Tx era) diff --git a/src/lib/Wst/Offchain/Env.hs b/src/lib/Wst/Offchain/Env.hs index b007498..22a897b 100644 --- a/src/lib/Wst/Offchain/Env.hs +++ b/src/lib/Wst/Offchain/Env.hs @@ -35,6 +35,7 @@ module Wst.Offchain.Env( -- ** Transfer logic environment TransferLogicEnv(..), + alwaysSucceedsTransferLogic, HasTransferLogicEnv(..), mkTransferLogicEnv, addTransferEnv, @@ -93,7 +94,8 @@ import SmartTokens.Core.Scripts (ScriptTarget) import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams (..)) import System.Environment qualified import Wst.AppError (AppError (..)) -import Wst.Offchain.Scripts (blacklistMintingScript, blacklistSpendingScript, +import Wst.Offchain.Scripts (alwaysSucceedsScript, blacklistMintingScript, + blacklistSpendingScript, directoryNodeMintingScript, directoryNodeSpendingScript, freezeTransferScript, permissionedTransferScript, @@ -248,11 +250,23 @@ getGlobalParams = asks (globalParams . directoryEnv) data TransferLogicEnv = TransferLogicEnv - { tleBlacklistMintingScript :: PlutusScript PlutusScriptV3 + { tleBlacklistMintingScript :: PlutusScript PlutusScriptV3 , tleBlacklistSpendingScript :: PlutusScript PlutusScriptV3 - , tleMintingScript :: PlutusScript PlutusScriptV3 - , tleTransferScript :: PlutusScript PlutusScriptV3 - , tleIssuerScript :: PlutusScript PlutusScriptV3 + , tleMintingScript :: PlutusScript PlutusScriptV3 + , tleTransferScript :: PlutusScript PlutusScriptV3 + , tleIssuerScript :: PlutusScript PlutusScriptV3 + } + +{-| 'IssueNewTokenArgs' for the policy that always succeeds (no checks) +-} +alwaysSucceedsTransferLogic :: ScriptTarget -> TransferLogicEnv +alwaysSucceedsTransferLogic target = + TransferLogicEnv + { tleBlacklistMintingScript = alwaysSucceedsScript target + , tleBlacklistSpendingScript = alwaysSucceedsScript target + , tleMintingScript = alwaysSucceedsScript target + , tleTransferScript = alwaysSucceedsScript target + , tleIssuerScript = alwaysSucceedsScript target } class HasTransferLogicEnv e where diff --git a/src/lib/Wst/Server.hs b/src/lib/Wst/Server.hs index 7ac9a7d..cca2723 100644 --- a/src/lib/Wst/Server.hs +++ b/src/lib/Wst/Server.hs @@ -21,12 +21,11 @@ import PlutusTx.Prelude qualified as P import Servant (Server, ServerT) import Servant.API (NoContent (..), (:<|>) (..)) import Servant.Server (hoistServer, serve) +import SmartTokens.Core.Scripts (ScriptTarget (Production)) import SmartTokens.Types.PTokenDirectory (blnKey) import Wst.App (WstApp, runWstAppServant) import Wst.AppError (AppError) -import Wst.Offchain.BuildTx.ProgrammableLogic (alwaysSucceedsArgs, - fromTransferEnv, - programmableTokenAssetId) +import Wst.Offchain.BuildTx.ProgrammableLogic (programmableTokenAssetId) import Wst.Offchain.Endpoints.Deployment qualified as Endpoints import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (uDatum)) @@ -36,7 +35,6 @@ import Wst.Server.Types (APIInEra, AddToBlacklistArgs (..), BuildTxAPI, SeizeAssetsArgs (..), SerialiseAddress (..), TextEnvelopeJSON (..), TransferProgrammableTokenArgs (..)) -import SmartTokens.Core.Scripts (ScriptTarget(Production)) data ServerArgs = ServerArgs @@ -140,12 +138,9 @@ issueProgrammableTokenEndpoint :: forall era env m. issueProgrammableTokenEndpoint IssueProgrammableTokenArgs{itaAssetName, itaQuantity, itaIssuer} = do operatorEnv <- Env.loadOperatorEnvFromAddress itaIssuer dirEnv <- asks Env.directoryEnv - - -- FIXME: Replace alwaysSucceedsArgs with blacklist monetary policy as soon as it is finished - let tokenArgs = alwaysSucceedsArgs Production programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer (Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress itaIssuer)) $ do - TextEnvelopeJSON <$> Endpoints.issueProgrammableTokenTx tokenArgs itaAssetName itaQuantity + TextEnvelopeJSON <$> Endpoints.issueProgrammableTokenTx itaAssetName itaQuantity paymentCredentialFromAddress :: C.Address C.ShelleyAddr -> C.PaymentCredential paymentCredentialFromAddress = \case @@ -171,7 +166,7 @@ transferProgrammableTokenEndpoint TransferProgrammableTokenArgs{ttaSender, ttaRe dirEnv <- asks Env.directoryEnv programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) let transferLogic = Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress ttaIssuer) - assetId <- programmableTokenAssetId <$> Env.getGlobalParams <*> pure (fromTransferEnv transferLogic) <*> pure ttaAssetName + assetId <- programmableTokenAssetId <$> Env.getGlobalParams <*> pure transferLogic <*> pure ttaAssetName Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer transferLogic $ do TextEnvelopeJSON <$> Endpoints.transferSmartTokensTx assetId ttaQuantity (paymentCredentialFromAddress ttaRecipient) From 1035988d2ddebacdfb8b51e1ac7655a3ad0172fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Thu, 2 Jan 2025 17:41:09 +0100 Subject: [PATCH 05/22] Use scripts from env everywhere --- .../Wst/Offchain/BuildTx/ProgrammableLogic.hs | 31 +------ src/lib/Wst/Offchain/Endpoints/Deployment.hs | 2 +- src/lib/Wst/Offchain/Env.hs | 91 ++++++++++++++----- src/lib/Wst/Server.hs | 24 ++--- src/test/unit/Wst/Test/UnitTest.hs | 74 ++++++++------- 5 files changed, 119 insertions(+), 103 deletions(-) diff --git a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs index 943b8f3..6ec25f2 100644 --- a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs +++ b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs @@ -6,9 +6,7 @@ {-# HLINT ignore "Use second" #-} module Wst.Offchain.BuildTx.ProgrammableLogic - ( programmableTokenMintingScript, - programmableTokenAssetId, - issueProgrammableToken, + ( issueProgrammableToken, transferProgrammableToken, seizeProgrammableToken, ) @@ -25,10 +23,8 @@ import Convex.BuildTx (MonadBuildTx, addReference, addWithdrawalWithTxBody, spendPlutusInlineDatum) import Convex.CardanoApi.Lenses as L import Convex.Class (MonadBlockchain (queryNetworkId)) -import Convex.PlutusLedger.V1 (transPolicyId, unTransCredential, - unTransPolicyId) +import Convex.PlutusLedger.V1 (transPolicyId) import Convex.Utils qualified as Utils -import Data.Either (fromRight) import Data.Foldable (find, maximumBy, traverse_) import Data.Function (on) import Data.List (partition) @@ -45,24 +41,6 @@ import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..), import Wst.Offchain.Env (TransferLogicEnv (..)) import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (..)) -import Wst.Offchain.Scripts (programmableLogicMintingScript) - --- FIXME: Move to Env -{-| The minting script for a programmable token that uses the global parameters --} -programmableTokenMintingScript :: ProgrammableLogicGlobalParams -> TransferLogicEnv -> C.PlutusScript C.PlutusScriptV3 -programmableTokenMintingScript ProgrammableLogicGlobalParams {progLogicCred, directoryNodeCS} TransferLogicEnv{tleMintingScript} = - let progLogicScriptCredential = fromRight (error "could not parse protocol params") $ unTransCredential progLogicCred - directoryNodeSymbol = fromRight (error "could not parse protocol params") $ unTransPolicyId directoryNodeCS - in programmableLogicMintingScript (error "programmableTokenMintingScript: scriptTarget") progLogicScriptCredential (C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion tleMintingScript) directoryNodeSymbol - -{-| 'C.AssetId' of the programmable tokens --} -programmableTokenAssetId :: ProgrammableLogicGlobalParams -> TransferLogicEnv -> C.AssetName -> C.AssetId -programmableTokenAssetId params inta = - C.AssetId - (C.scriptPolicyId $ C.PlutusScript C.plutusScriptVersion $ programmableTokenMintingScript params inta) - {- Issue a programmable token and register it in the directory set if necessary. The caller should ensure that the specific minting logic stake script witness is included in the final transaction. @@ -71,8 +49,9 @@ programmableTokenAssetId params inta = -} issueProgrammableToken :: forall era env m. (MonadReader env m, Env.HasDirectoryEnv env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => UTxODat era ProgrammableLogicGlobalParams -> (C.AssetName, C.Quantity) -> [UTxODat era DirectorySetNode] -> m C.PolicyId issueProgrammableToken paramsTxOut (an, q) directoryList = Utils.inBabbage @era $ do - inta@TransferLogicEnv{tleMintingScript, tleTransferScript, tleIssuerScript} <- asks Env.transferLogicEnv + inta@TransferLogicEnv{tleTransferScript, tleIssuerScript} <- asks Env.transferLogicEnv glParams <- asks (Env.globalParams . Env.directoryEnv) + dir <- asks Env.directoryEnv -- The global params in the UTxO need to match those in our 'DirectoryEnv'. -- If they don't, we get a script error when trying to balance the transaction. @@ -81,7 +60,7 @@ issueProgrammableToken paramsTxOut (an, q) directoryList = Utils.inBabbage @era -- FIXME: Error handling error "Global params do not match" - let mintingScript = programmableTokenMintingScript (uDatum paramsTxOut) inta + let mintingScript = Env.programmableTokenMintingScript dir inta issuedPolicyId = C.scriptPolicyId $ C.PlutusScript C.PlutusScriptV3 mintingScript issuedSymbol = transPolicyId issuedPolicyId diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index fda65b5..0c74a95 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -98,7 +98,7 @@ deployBlacklistTx :: (MonadReader env m, Env.HasOperatorEnv era env, MonadBlockc deployBlacklistTx = do opEnv <- asks Env.operatorEnv dirEnv <- asks Env.directoryEnv - (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withDirectory dirEnv $ Env.withTransferFromOperator (error "issueProgramableTokenTx: target") + (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withDirectory dirEnv $ Env.withTransferFromOperator $ Env.balanceTxEnv_ BuildTx.initBlacklist pure (Convex.CoinSelection.signBalancedTxBody [] tx) diff --git a/src/lib/Wst/Offchain/Env.hs b/src/lib/Wst/Offchain/Env.hs index 22a897b..f653e77 100644 --- a/src/lib/Wst/Offchain/Env.hs +++ b/src/lib/Wst/Offchain/Env.hs @@ -23,9 +23,9 @@ module Wst.Offchain.Env( -- ** Directory environment DirectoryScriptRoot(..), + mkDirectoryEnv, HasDirectoryEnv(..), DirectoryEnv(..), - mkDirectoryEnv, programmableLogicStakeCredential, programmableLogicBaseCredential, directoryNodePolicyId, @@ -34,15 +34,21 @@ module Wst.Offchain.Env( getGlobalParams, -- ** Transfer logic environment + BlacklistTransferLogicScriptRoot(..), + mkTransferLogicEnv, TransferLogicEnv(..), + transferLogicForDirectory, alwaysSucceedsTransferLogic, HasTransferLogicEnv(..), - mkTransferLogicEnv, addTransferEnv, withTransfer, withTransferFor, withTransferFromOperator, + -- ** Minting tokens + programmableTokenMintingScript, + programmableTokenAssetId, + -- * Runtime data RuntimeEnv(..), HasRuntimeEnv(..), @@ -80,11 +86,13 @@ import Convex.BuildTx qualified as BuildTx import Convex.Class (MonadBlockchain, MonadUtxoQuery (..), queryProtocolParameters, utxosByPaymentCredential) import Convex.CoinSelection qualified as CoinSelection -import Convex.PlutusLedger.V1 (transCredential, transPolicyId) +import Convex.PlutusLedger.V1 (transCredential, transPolicyId, + unTransCredential, unTransPolicyId) import Convex.Utils (mapError) import Convex.Utxos (BalanceChanges) import Convex.Utxos qualified as Utxos import Convex.Wallet.Operator (returnOutputFor) +import Data.Either (fromRight) import Data.Functor.Identity (Identity (..)) import Data.Map qualified as Map import Data.Maybe (listToMaybe) @@ -101,6 +109,7 @@ import Wst.Offchain.Scripts (alwaysSucceedsScript, blacklistMintingScript, permissionedTransferScript, programmableLogicBaseScript, programmableLogicGlobalScript, + programmableLogicMintingScript, protocolParamsMintingScript, protocolParamsSpendingScript, scriptPolicyIdV3) @@ -171,10 +180,10 @@ balanceTxEnv btx = do (balBody, balChanges) <- mapError BalancingError (CoinSelection.balanceTx mempty output (Utxos.fromApiUtxo bteOperatorUtxos) txBuilder CoinSelection.TrailingChange) pure ((balBody, balChanges), r) -{-| Data that completely determines the on-chain scripts and their hashes. -Any information that results in different script hashes should go in here. -We should be able to write a function 'ScriptRoot -> script' for all of -our scripts. +{-| Data that completely determines the on-chain scripts of the programmable +token directory, and their hashes. Any information that results in different +script hashes should go in here. We should be able to write a function +'DirectoryScriptRoot -> script' for all of the directory scripts. -} data DirectoryScriptRoot = DirectoryScriptRoot @@ -275,21 +284,31 @@ class HasTransferLogicEnv e where instance HasTransferLogicEnv TransferLogicEnv where transferLogicEnv = id --- FIXME (jm): replace arguments with transferLogicEnvRoot? -{-| The 'TransferLogicEnv' with scripts that allow the given payment credential -to manage the blacklist and issue / burn tokens +{-| Data that completely determines the on-chain scripts of the blacklist +transfer logic, and their hashes. Any information that results in different +script hashes should go in here. We should be able to write a function +'BlacklistTransferLogicScriptRoot -> script' for all of the blacklist transfer +logic scripts. -} -mkTransferLogicEnv :: ScriptTarget -> C.PaymentCredential -> C.Hash C.PaymentKey -> TransferLogicEnv -mkTransferLogicEnv target progLogicBaseCred cred = - let blacklistMinting = blacklistMintingScript target cred +data BlacklistTransferLogicScriptRoot = + BlacklistTransferLogicScriptRoot + { tlrTarget :: ScriptTarget + , tlrDirEnv :: DirectoryEnv + , tlrIssuer :: C.Hash C.PaymentKey + } + +mkTransferLogicEnv :: BlacklistTransferLogicScriptRoot -> TransferLogicEnv +mkTransferLogicEnv BlacklistTransferLogicScriptRoot{tlrTarget, tlrDirEnv, tlrIssuer} = + let blacklistMinting = blacklistMintingScript tlrTarget tlrIssuer blacklistPolicy = scriptPolicyIdV3 blacklistMinting + progLogicBaseCred = programmableLogicBaseCredential tlrDirEnv in TransferLogicEnv { tleBlacklistMintingScript = blacklistMinting - , tleBlacklistSpendingScript = blacklistSpendingScript target cred - , tleMintingScript = permissionedTransferScript target cred - , tleTransferScript = freezeTransferScript target progLogicBaseCred blacklistPolicy - , tleIssuerScript = permissionedTransferScript target cred + , tleBlacklistSpendingScript = blacklistSpendingScript tlrTarget tlrIssuer + , tleMintingScript = permissionedTransferScript tlrTarget tlrIssuer + , tleTransferScript = freezeTransferScript tlrTarget progLogicBaseCred blacklistPolicy + , tleIssuerScript = permissionedTransferScript tlrTarget tlrIssuer } blacklistNodePolicyId :: TransferLogicEnv -> C.PolicyId @@ -395,15 +414,41 @@ withTransfer dir action = do asks (addTransferEnv dir) >>= runReaderT action -withTransferFor :: MonadReader (CombinedEnv o Identity t r era) m => ScriptTarget -> C.PaymentCredential -> C.Hash C.PaymentKey -> ReaderT (CombinedEnv o Identity Identity r era) m a -> m a -withTransferFor target plbBaseCred opPKH = withTransfer $ mkTransferLogicEnv target plbBaseCred opPKH +withTransferFor :: MonadReader (CombinedEnv o Identity t r era) m => BlacklistTransferLogicScriptRoot -> ReaderT (CombinedEnv o Identity Identity r era) m a -> m a +withTransferFor = withTransfer . mkTransferLogicEnv -withTransferFromOperator :: (MonadReader (CombinedEnv Identity Identity t r era) m) => ScriptTarget -> ReaderT (CombinedEnv Identity Identity Identity r era) m a -> m a -withTransferFromOperator target action = do +{-| Transfer logic scripts for the blacklist managed by the given 'C.PaymentKey' hash +-} +transferLogicForDirectory :: (HasDirectoryEnv env, MonadReader env m) => C.Hash C.PaymentKey -> m TransferLogicEnv +transferLogicForDirectory pkh = do + env <- ask + let dirEnv = directoryEnv env + pure (mkTransferLogicEnv $ BlacklistTransferLogicScriptRoot (srTarget $ dsScriptRoot dirEnv) dirEnv pkh) + +withTransferFromOperator :: (MonadReader (CombinedEnv Identity Identity t r era) m) => ReaderT (CombinedEnv Identity Identity Identity r era) m a -> m a +withTransferFromOperator action = do env <- ask let opPkh = fst . bteOperator . operatorEnv $ env - programmableBaseLogicCred = programmableLogicBaseCredential . directoryEnv $ env - runReaderT action (addTransferEnv (mkTransferLogicEnv target programmableBaseLogicCred opPkh) env) + root <- transferLogicForDirectory opPkh + runReaderT action (addTransferEnv root env) + +{-| The minting script for a programmable token that uses the global parameters +-} +programmableTokenMintingScript :: DirectoryEnv -> TransferLogicEnv -> C.PlutusScript C.PlutusScriptV3 +programmableTokenMintingScript dirEnv@DirectoryEnv{dsScriptRoot} TransferLogicEnv{tleMintingScript} = + let ProgrammableLogicGlobalParams {progLogicCred, directoryNodeCS} = globalParams dirEnv + DirectoryScriptRoot{srTarget} = dsScriptRoot + progLogicScriptCredential = fromRight (error "could not parse protocol params") $ unTransCredential progLogicCred + directoryNodeSymbol = fromRight (error "could not parse protocol params") $ unTransPolicyId directoryNodeCS + in programmableLogicMintingScript srTarget progLogicScriptCredential (C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion tleMintingScript) directoryNodeSymbol + +{-| 'C.AssetId' of the programmable tokens +-} +programmableTokenAssetId :: DirectoryEnv -> TransferLogicEnv -> C.AssetName -> C.AssetId +programmableTokenAssetId dirEnv inta = + C.AssetId + (C.scriptPolicyId $ C.PlutusScript C.plutusScriptVersion $ programmableTokenMintingScript dirEnv inta) + {-| Add a 'DirectoryEnv' for the 'C.TxIn' in to the environment and run the action with the modified environment diff --git a/src/lib/Wst/Server.hs b/src/lib/Wst/Server.hs index cca2723..35b3c39 100644 --- a/src/lib/Wst/Server.hs +++ b/src/lib/Wst/Server.hs @@ -21,11 +21,9 @@ import PlutusTx.Prelude qualified as P import Servant (Server, ServerT) import Servant.API (NoContent (..), (:<|>) (..)) import Servant.Server (hoistServer, serve) -import SmartTokens.Core.Scripts (ScriptTarget (Production)) import SmartTokens.Types.PTokenDirectory (blnKey) import Wst.App (WstApp, runWstAppServant) import Wst.AppError (AppError) -import Wst.Offchain.BuildTx.ProgrammableLogic (programmableTokenAssetId) import Wst.Offchain.Endpoints.Deployment qualified as Endpoints import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (uDatum)) @@ -89,9 +87,8 @@ queryBlacklistedNodes :: forall era env m. -> SerialiseAddress (C.Address C.ShelleyAddr) -> m [C.Hash C.PaymentKey] queryBlacklistedNodes _ (SerialiseAddress addr) = do - programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) - let transferLogic = Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress addr) - getHash = + transferLogic <- Env.transferLogicForDirectory (paymentKeyHashFromAddress addr) + let getHash = either (error "deserialiseFromRawBytes failed") id . C.deserialiseFromRawBytes (C.proxyToAsType $ Proxy @(C.Hash C.PaymentKey)) . P.fromBuiltin @@ -138,8 +135,8 @@ issueProgrammableTokenEndpoint :: forall era env m. issueProgrammableTokenEndpoint IssueProgrammableTokenArgs{itaAssetName, itaQuantity, itaIssuer} = do operatorEnv <- Env.loadOperatorEnvFromAddress itaIssuer dirEnv <- asks Env.directoryEnv - programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) - Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer (Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress itaIssuer)) $ do + logic <- Env.transferLogicForDirectory (paymentKeyHashFromAddress itaIssuer) + Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer logic $ do TextEnvelopeJSON <$> Endpoints.issueProgrammableTokenTx itaAssetName itaQuantity paymentCredentialFromAddress :: C.Address C.ShelleyAddr -> C.PaymentCredential @@ -164,10 +161,9 @@ transferProgrammableTokenEndpoint :: forall era env m. transferProgrammableTokenEndpoint TransferProgrammableTokenArgs{ttaSender, ttaRecipient, ttaAssetName, ttaQuantity, ttaIssuer} = do operatorEnv <- Env.loadOperatorEnvFromAddress ttaSender dirEnv <- asks Env.directoryEnv - programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) - let transferLogic = Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress ttaIssuer) - assetId <- programmableTokenAssetId <$> Env.getGlobalParams <*> pure transferLogic <*> pure ttaAssetName - Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer transferLogic $ do + logic <- Env.transferLogicForDirectory (paymentKeyHashFromAddress ttaIssuer) + assetId <- Env.programmableTokenAssetId dirEnv <$> Env.transferLogicForDirectory (paymentKeyHashFromAddress ttaIssuer) <*> pure ttaAssetName + Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer logic $ do TextEnvelopeJSON <$> Endpoints.transferSmartTokensTx assetId ttaQuantity (paymentCredentialFromAddress ttaRecipient) addToBlacklistEndpoint :: forall era env m. @@ -184,8 +180,7 @@ addToBlacklistEndpoint AddToBlacklistArgs{atbIssuer, atbBlacklistAddress} = do let badCred = paymentCredentialFromAddress atbBlacklistAddress operatorEnv <- Env.loadOperatorEnvFromAddress atbIssuer dirEnv <- asks Env.directoryEnv - programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) - let transferLogic = Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress atbIssuer) + transferLogic <- Env.transferLogicForDirectory (paymentKeyHashFromAddress atbIssuer) Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer transferLogic $ do TextEnvelopeJSON <$> Endpoints.blacklistCredentialTx badCred @@ -203,7 +198,6 @@ seizeAssetsEndpoint SeizeAssetsArgs{saIssuer, saTarget} = do let badCred = paymentCredentialFromAddress saTarget operatorEnv <- Env.loadOperatorEnvFromAddress saIssuer dirEnv <- asks Env.directoryEnv - programmableBaseLogicCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv) - let transferLogic = Env.mkTransferLogicEnv Production programmableBaseLogicCred (paymentKeyHashFromAddress saIssuer) + transferLogic <- Env.transferLogicForDirectory (paymentKeyHashFromAddress saIssuer) Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer transferLogic $ do TextEnvelopeJSON <$> Endpoints.seizeCredentialAssetsTx badCred diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index 6469251..b2ee08f 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -27,6 +27,7 @@ import Convex.NodeParams (NodeParams, ledgerProtocolParameters, import Convex.Utils (failOnError) import Convex.Wallet.MockWallet qualified as Wallet import Convex.Wallet.Operator (signTxOperator) +import Convex.Wallet.Operator qualified as Operator import Data.List (isPrefixOf) import Data.Word (Word32) import GHC.Exception (SomeException, throw) @@ -34,8 +35,8 @@ import SmartTokens.Core.Scripts (ScriptTarget (Production)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, testCase) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..)) -import Wst.Offchain.BuildTx.ProgrammableLogic (alwaysSucceedsArgs) import Wst.Offchain.Endpoints.Deployment qualified as Endpoints +import Wst.Offchain.Env (DirectoryScriptRoot) import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query qualified as Query import Wst.Offchain.Scripts qualified as Scripts @@ -74,20 +75,20 @@ tests = testGroup "unit tests" ] ] -deployDirectorySet :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m C.TxIn +deployDirectorySet :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m DirectoryScriptRoot deployDirectorySet = failOnError $ Env.withEnv $ asAdmin @C.ConwayEra $ do - (tx, txI) <- Endpoints.deployTx + (tx, scriptRoot) <- Endpoints.deployTx Production void $ sendTx $ signTxOperator admin tx - Env.withDirectoryFor Production txI $ do + Env.withDirectoryFor scriptRoot $ do Query.registryNodes @C.ConwayEra >>= void . expectSingleton "registry output" void $ Query.globalParamsNode @C.ConwayEra - pure txI + pure scriptRoot insertDirectoryNode :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m () insertDirectoryNode = failOnError $ Env.withEnv $ do - txI <- deployDirectorySet - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ do + scriptRoot <- deployDirectorySet + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ do Endpoints.insertNodeTx dummyNodeArgs >>= void . sendTx . signTxOperator admin Query.registryNodes @C.ConwayEra >>= void . expectN 2 "registry outputs" @@ -102,9 +103,9 @@ issueAlwaysSucceedsValidator = failOnError $ Env.withEnv $ do -- But I'll leave it in because it seems right. registerAlwaysSucceedsStakingCert - txI <- deployDirectorySet - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ do - Endpoints.issueProgrammableTokenTx alwaysSucceedsArgs "dummy asset" 100 + scriptRoot <- deployDirectorySet + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransfer (Env.alwaysSucceedsTransferLogic Production) $ do + Endpoints.issueProgrammableTokenTx "dummy asset" 100 >>= void . sendTx . signTxOperator admin Query.registryNodes @C.ConwayEra >>= void . expectN 2 "registry outputs" @@ -116,15 +117,15 @@ issueSmartTokensScenario = deployDirectorySet >>= issueTransferLogicProgrammable {-| Issue some tokens with the smart stabelcoin transfer logic validator -} -issueTransferLogicProgrammableToken :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => C.TxIn -> m C.AssetId -issueTransferLogicProgrammableToken txI = failOnError $ Env.withEnv $ do +issueTransferLogicProgrammableToken :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => DirectoryScriptRoot -> m C.AssetId +issueTransferLogicProgrammableToken scriptRoot = failOnError $ Env.withEnv $ do - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) -- register programmable global stake script void $ registerTransferScripts opPkh - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) (balTx, aid) <- Endpoints.issueSmartTokensTx "dummy asset" 100 (C.PaymentCredentialByKey opPkh) @@ -141,17 +142,17 @@ issueTransferLogicProgrammableToken txI = failOnError $ Env.withEnv $ do transferSmartTokens :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m () transferSmartTokens = failOnError $ Env.withEnv $ do userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv) - txI <- deployDirectorySet + scriptRoot <- deployDirectorySet - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do Endpoints.deployBlacklistTx >>= void . sendTx . signTxOperator admin Query.blacklistNodes @C.ConwayEra >>= void . expectSingleton "blacklist output" - aid <- issueTransferLogicProgrammableToken txI + aid <- issueTransferLogicProgrammableToken scriptRoot - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txI $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) Endpoints.transferSmartTokensTx aid 80 (C.PaymentCredentialByKey userPkh) @@ -169,15 +170,15 @@ blacklistCredential = failOnError $ Env.withEnv $ do userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv) let paymentCred = C.PaymentCredentialByKey userPkh - txIn <- deployDirectorySet + scriptRoot <- deployDirectorySet - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do Endpoints.deployBlacklistTx >>= void . sendTx . signTxOperator admin Query.blacklistNodes @C.ConwayEra >>= void . expectSingleton "blacklist output" - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do Endpoints.blacklistCredentialTx paymentCred >>= void . sendTx . signTxOperator admin @@ -191,28 +192,26 @@ blacklistTransfer = failOnError $ Env.withEnv $ do userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv) let userPaymentCred = C.PaymentCredentialByKey userPkh - txIn <- deployDirectorySet - aid <- issueTransferLogicProgrammableToken txIn + scriptRoot <- deployDirectorySet + aid <- issueTransferLogicProgrammableToken scriptRoot - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do Endpoints.deployBlacklistTx >>= void . sendTx . signTxOperator admin - opPkh <- asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do + opPkh <- asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) Endpoints.transferSmartTokensTx aid 50 (C.PaymentCredentialByKey userPkh) >>= void . sendTx . signTxOperator admin pure opPkh - progLogicCred <- asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do - cred <- asks Env.directoryEnv - pure $ Env.programmableLogicBaseCredential cred + transferLogic <- Env.withDirectoryFor scriptRoot $ Env.transferLogicForDirectory (C.verificationKeyHash . Operator.verificationKey . Operator.oPaymentKey $ admin) - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do Endpoints.blacklistCredentialTx userPaymentCred >>= void . sendTx . signTxOperator admin - asWallet Wallet.w2 $ Env.withDirectoryFor Production txIn $ Env.withTransferFor progLogicCred opPkh $ do + asWallet Wallet.w2 $ Env.withDirectoryFor scriptRoot $ Env.withTransfer transferLogic $ do Endpoints.transferSmartTokensTx aid 30 (C.PaymentCredentialByKey opPkh) >>= void . sendTx . signTxOperator (user Wallet.w2) @@ -221,15 +220,14 @@ seizeUserOutput = failOnError $ Env.withEnv $ do userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv) let userPaymentCred = C.PaymentCredentialByKey userPkh - txIn <- deployDirectorySet - aid <- issueTransferLogicProgrammableToken txIn + scriptRoot <- deployDirectorySet + aid <- issueTransferLogicProgrammableToken scriptRoot - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do Endpoints.deployBlacklistTx >>= void . sendTx . signTxOperator admin - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do - opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do Endpoints.transferSmartTokensTx aid 50 (C.PaymentCredentialByKey userPkh) >>= void . sendTx . signTxOperator admin Query.programmableLogicOutputs @C.ConwayEra @@ -237,7 +235,7 @@ seizeUserOutput = failOnError $ Env.withEnv $ do Query.userProgrammableOutputs (C.PaymentCredentialByKey userPkh) >>= void . expectN 1 "user programmable outputs" - asAdmin @C.ConwayEra $ Env.withDirectoryFor Production txIn $ Env.withTransferFromOperator $ do + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) Endpoints.seizeCredentialAssetsTx userPaymentCred >>= void . sendTx . signTxOperator admin @@ -262,11 +260,11 @@ dummyNodeArgs = registerAlwaysSucceedsStakingCert :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m () registerAlwaysSucceedsStakingCert = failOnError $ do pp <- fmap C.unLedgerProtocolParameters queryProtocolParameters - let script = C.PlutusScript C.plutusScriptVersion Scripts.alwaysSucceedsScript + let script = C.PlutusScript C.plutusScriptVersion $ Scripts.alwaysSucceedsScript Production hsh = C.hashScript script cred = C.StakeCredentialByScript hsh txBody <- BuildTx.execBuildTxT $ do - BuildTx.addStakeScriptWitness cred Scripts.alwaysSucceedsScript () + BuildTx.addStakeScriptWitness cred (Scripts.alwaysSucceedsScript Production) () BuildTx.addConwayStakeCredentialRegistrationCertificate cred (pp ^. Ledger.ppKeyDepositL) void (tryBalanceAndSubmit mempty Wallet.w1 txBody TrailingChange []) From e83ec79c6aa4276e73731cbfbe93d807cb9a9bef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Thu, 2 Jan 2025 18:03:06 +0100 Subject: [PATCH 06/22] Parameterise tests by script target --- src/test/unit/Wst/Test/UnitTest.hs | 111 +++++++++++++++-------------- 1 file changed, 58 insertions(+), 53 deletions(-) diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index b2ee08f..63f2fab 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -8,20 +8,18 @@ import Cardano.Api.Shelley qualified as C import Cardano.Ledger.Api qualified as Ledger import Cardano.Ledger.Plutus.ExUnits qualified as Ledger import Cardano.Ledger.Shelley.TxCert qualified as TxCert -import Control.Exception (try) import Control.Lens (set, (%~), (&), (^.)) import Control.Monad (void) -import Control.Monad.Reader (asks) -import Control.Monad.Reader.Class (MonadReader) +import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT), asks) import Convex.BuildTx (MonadBuildTx, addCertificate) import Convex.BuildTx qualified as BuildTx import Convex.Class (MonadBlockchain (queryProtocolParameters, sendTx), MonadMockchain, MonadUtxoQuery) import Convex.CoinSelection (ChangeOutputPosition (TrailingChange)) -import Convex.MockChain +import Convex.MockChain (MockchainT) import Convex.MockChain.CoinSelection (tryBalanceAndSubmit) import Convex.MockChain.Defaults qualified as Defaults -import Convex.MockChain.Utils (mockchainFails, mockchainSucceeds) +import Convex.MockChain.Utils (mockchainFails, mockchainSucceedsWith) import Convex.NodeParams (NodeParams, ledgerProtocolParameters, protocolParameters) import Convex.Utils (failOnError) @@ -29,9 +27,10 @@ import Convex.Wallet.MockWallet qualified as Wallet import Convex.Wallet.Operator (signTxOperator) import Convex.Wallet.Operator qualified as Operator import Data.List (isPrefixOf) +import Data.String (IsString (..)) import Data.Word (Word32) import GHC.Exception (SomeException, throw) -import SmartTokens.Core.Scripts (ScriptTarget (Production)) +import SmartTokens.Core.Scripts (ScriptTarget (Debug, Production)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, testCase) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..)) @@ -52,42 +51,41 @@ testNodeParams = npsTx = Defaults.nodeParams & set (ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxSizeL) testTxSize in npsTx & set (ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxExUnitsL) newExUnits --- | Run the 'Mockchain' action with modified node parameters to allow larger-than-usual --- transactions. This is useful for showing debug output from the scripts and fail if there is an error -mockchainSucceedsWithLargeTx :: MockchainIO C.ConwayEra a -> Assertion -mockchainSucceedsWithLargeTx action = - let params' = testNodeParams & ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxSizeL %~ (*10) - in try @SomeException (runMockchain0IOWith Wallet.initialUTxOs params' action) >>= \case - Right{} -> pure () - Left err -> fail (show err) - tests :: TestTree tests = testGroup "unit tests" - [ testCase "deploy directory and global params" (mockchainSucceedsWithLargeTx deployDirectorySet) - , testCase "insert directory node" (mockchainSucceeds insertDirectoryNode) - , testGroup "issue programmable tokens" - [ testCase "always succeeds validator" (mockchainSucceeds issueAlwaysSucceedsValidator) - , testCase "smart token issuance" (mockchainSucceeds issueSmartTokensScenario) - , testCase "smart token transfer" (mockchainSucceeds transferSmartTokens) - , testCase "blacklist credential" (mockchainSucceeds (void blacklistCredential)) - , testCase "blacklisted transfer" (mockchainFails blacklistTransfer assertBlacklistedAddressException) - , testCase "seize user output" (mockchainSucceeds seizeUserOutput) - ] + [ scriptTargetTests Debug + , scriptTargetTests Production ] -deployDirectorySet :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m DirectoryScriptRoot -deployDirectorySet = failOnError $ Env.withEnv $ asAdmin @C.ConwayEra $ do - (tx, scriptRoot) <- Endpoints.deployTx Production - void $ sendTx $ signTxOperator admin tx - Env.withDirectoryFor scriptRoot $ do - Query.registryNodes @C.ConwayEra - >>= void . expectSingleton "registry output" - void $ Query.globalParamsNode @C.ConwayEra - pure scriptRoot - -insertDirectoryNode :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m () -insertDirectoryNode = failOnError $ Env.withEnv $ do - scriptRoot <- deployDirectorySet +scriptTargetTests :: ScriptTarget -> TestTree +scriptTargetTests target = + testGroup (fromString $ show target) + [ testCase "deploy directory and global params" (mockchainSucceedsWithTarget target deployDirectorySet) + , testCase "insert directory node" (mockchainSucceedsWithTarget target $ deployDirectorySet >>= insertDirectoryNode) + , testGroup "issue programmable tokens" + [ testCase "always succeeds validator" (mockchainSucceedsWithTarget target $ deployDirectorySet >>= issueAlwaysSucceedsValidator) + , testCase "smart token issuance" (mockchainSucceedsWithTarget target issueSmartTokensScenario) + , testCase "smart token transfer" (mockchainSucceedsWithTarget target $ deployDirectorySet >>= transferSmartTokens) + , testCase "blacklist credential" (mockchainSucceedsWithTarget target $ void $ deployDirectorySet >>= blacklistCredential) + , testCase "blacklisted transfer" (mockchainFails blacklistTransfer assertBlacklistedAddressException) + , testCase "seize user output" (mockchainSucceedsWithTarget target $ deployDirectorySet >>= seizeUserOutput) + ] + ] + +deployDirectorySet :: (MonadReader ScriptTarget m, MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m DirectoryScriptRoot +deployDirectorySet = do + target <- ask + failOnError $ Env.withEnv $ asAdmin @C.ConwayEra $ do + (tx, scriptRoot) <- Endpoints.deployTx target + void $ sendTx $ signTxOperator admin tx + Env.withDirectoryFor scriptRoot $ do + Query.registryNodes @C.ConwayEra + >>= void . expectSingleton "registry output" + void $ Query.globalParamsNode @C.ConwayEra + pure scriptRoot + +insertDirectoryNode :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => DirectoryScriptRoot -> m () +insertDirectoryNode scriptRoot = failOnError $ Env.withEnv $ do asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ do Endpoints.insertNodeTx dummyNodeArgs >>= void . sendTx . signTxOperator admin Query.registryNodes @C.ConwayEra @@ -95,15 +93,14 @@ insertDirectoryNode = failOnError $ Env.withEnv $ do {-| Issue some tokens with the "always succeeds" validator -} -issueAlwaysSucceedsValidator :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m () -issueAlwaysSucceedsValidator = failOnError $ Env.withEnv $ do +issueAlwaysSucceedsValidator :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => DirectoryScriptRoot -> m () +issueAlwaysSucceedsValidator scriptRoot = failOnError $ Env.withEnv $ do -- Register the stake validator -- Oddly, the tests passes even if we don't do this. -- But I'll leave it in because it seems right. registerAlwaysSucceedsStakingCert - scriptRoot <- deployDirectorySet asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransfer (Env.alwaysSucceedsTransferLogic Production) $ do Endpoints.issueProgrammableTokenTx "dummy asset" 100 >>= void . sendTx . signTxOperator admin @@ -112,7 +109,7 @@ issueAlwaysSucceedsValidator = failOnError $ Env.withEnv $ do Query.programmableLogicOutputs @C.ConwayEra >>= void . expectN 1 "programmable logic outputs" -issueSmartTokensScenario :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m C.AssetId +issueSmartTokensScenario :: (MonadReader ScriptTarget m, MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m C.AssetId issueSmartTokensScenario = deployDirectorySet >>= issueTransferLogicProgrammableToken {-| Issue some tokens with the smart stabelcoin transfer logic validator @@ -139,10 +136,9 @@ issueTransferLogicProgrammableToken scriptRoot = failOnError $ Env.withEnv $ do {-| Issue some tokens with the smart stabelcoin transfer logic validator -} -transferSmartTokens :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m () -transferSmartTokens = failOnError $ Env.withEnv $ do +transferSmartTokens :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => DirectoryScriptRoot -> m () +transferSmartTokens scriptRoot = failOnError $ Env.withEnv $ do userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv) - scriptRoot <- deployDirectorySet asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do Endpoints.deployBlacklistTx @@ -165,13 +161,11 @@ transferSmartTokens = failOnError $ Env.withEnv $ do Query.userProgrammableOutputs (C.PaymentCredentialByKey opPkh) >>= void . expectN 1 "user programmable outputs" -blacklistCredential :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m C.PaymentCredential -blacklistCredential = failOnError $ Env.withEnv $ do +blacklistCredential :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => DirectoryScriptRoot -> m C.PaymentCredential +blacklistCredential scriptRoot = failOnError $ Env.withEnv $ do userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv) let paymentCred = C.PaymentCredentialByKey userPkh - scriptRoot <- deployDirectorySet - asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do Endpoints.deployBlacklistTx >>= void . sendTx . signTxOperator admin @@ -189,10 +183,10 @@ blacklistCredential = failOnError $ Env.withEnv $ do blacklistTransfer :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m () blacklistTransfer = failOnError $ Env.withEnv $ do + scriptRoot <- runReaderT deployDirectorySet Production userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv) let userPaymentCred = C.PaymentCredentialByKey userPkh - scriptRoot <- deployDirectorySet aid <- issueTransferLogicProgrammableToken scriptRoot asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do @@ -215,12 +209,11 @@ blacklistTransfer = failOnError $ Env.withEnv $ do Endpoints.transferSmartTokensTx aid 30 (C.PaymentCredentialByKey opPkh) >>= void . sendTx . signTxOperator (user Wallet.w2) -seizeUserOutput :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m () -seizeUserOutput = failOnError $ Env.withEnv $ do +seizeUserOutput :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => DirectoryScriptRoot -> m () +seizeUserOutput scriptRoot = failOnError $ Env.withEnv $ do userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv) let userPaymentCred = C.PaymentCredentialByKey userPkh - scriptRoot <- deployDirectorySet aid <- issueTransferLogicProgrammableToken scriptRoot asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do @@ -325,3 +318,15 @@ assertBlacklistedAddressException :: SomeException -> Assertion assertBlacklistedAddressException ex | "user error (TransferBlacklistedCredential (PubKeyCredential" `isPrefixOf` show ex = pure () | otherwise = throw ex + +nodeParamsFor :: ScriptTarget -> NodeParams C.ConwayEra +nodeParamsFor = \case + -- Run the 'Mockchain' action with modified node parameters to allow larger-than-usual + -- transactions. This is useful for showing debug output from the scripts and fail if there is an error + Debug -> testNodeParams & ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxSizeL %~ (*10) + Production -> testNodeParams + +mockchainSucceedsWithTarget :: ScriptTarget -> ReaderT ScriptTarget (MockchainT C.ConwayEra IO) a -> Assertion +mockchainSucceedsWithTarget target = + mockchainSucceedsWith (nodeParamsFor target) . flip runReaderT target + From f280bf8725685279a393c5ae7c7528e4b4b7f7d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Thu, 2 Jan 2025 18:09:22 +0100 Subject: [PATCH 07/22] Delete node params (not required anymore) --- src/test/unit/Wst/Test/UnitTest.hs | 18 +++--------------- src/wst-poc.cabal | 1 - 2 files changed, 3 insertions(+), 16 deletions(-) diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index 63f2fab..3753c2a 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -6,9 +6,8 @@ module Wst.Test.UnitTest( import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C import Cardano.Ledger.Api qualified as Ledger -import Cardano.Ledger.Plutus.ExUnits qualified as Ledger import Cardano.Ledger.Shelley.TxCert qualified as TxCert -import Control.Lens (set, (%~), (&), (^.)) +import Control.Lens ((%~), (&), (^.)) import Control.Monad (void) import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT), asks) import Convex.BuildTx (MonadBuildTx, addCertificate) @@ -28,7 +27,6 @@ import Convex.Wallet.Operator (signTxOperator) import Convex.Wallet.Operator qualified as Operator import Data.List (isPrefixOf) import Data.String (IsString (..)) -import Data.Word (Word32) import GHC.Exception (SomeException, throw) import SmartTokens.Core.Scripts (ScriptTarget (Debug, Production)) import Test.Tasty (TestTree, testGroup) @@ -41,16 +39,6 @@ import Wst.Offchain.Query qualified as Query import Wst.Offchain.Scripts qualified as Scripts import Wst.Test.Env (admin, asAdmin, asWallet, user) -testTxSize :: Word32 -testTxSize = 16384 - -testNodeParams :: NodeParams C.ConwayEra -testNodeParams = - -- restrict script bugdet to current value on mainnet - let newExUnits = Ledger.ExUnits {Ledger.exUnitsSteps = 10_000_000_000, Ledger.exUnitsMem = 14_000_000} - npsTx = Defaults.nodeParams & set (ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxSizeL) testTxSize - in npsTx & set (ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxExUnitsL) newExUnits - tests :: TestTree tests = testGroup "unit tests" [ scriptTargetTests Debug @@ -323,8 +311,8 @@ nodeParamsFor :: ScriptTarget -> NodeParams C.ConwayEra nodeParamsFor = \case -- Run the 'Mockchain' action with modified node parameters to allow larger-than-usual -- transactions. This is useful for showing debug output from the scripts and fail if there is an error - Debug -> testNodeParams & ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxSizeL %~ (*10) - Production -> testNodeParams + Debug -> Defaults.nodeParams & ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxSizeL %~ (*10) + Production -> Defaults.nodeParams mockchainSucceedsWithTarget :: ScriptTarget -> ReaderT ScriptTarget (MockchainT C.ConwayEra IO) a -> Assertion mockchainSucceedsWithTarget target = diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index e3eba06..1e55389 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -178,7 +178,6 @@ test-suite wst-poc-test , base >=4.14.0 , cardano-api , cardano-ledger-api - , cardano-ledger-core , cardano-ledger-shelley , convex-base , convex-coin-selection From 0a6da4f965f0538c4d5cb3baef8920b8609bdf61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Mon, 6 Jan 2025 11:34:47 +0100 Subject: [PATCH 08/22] Add filter for NFT to globalParamsNode --- src/lib/Wst/Offchain/Query.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/lib/Wst/Offchain/Query.hs b/src/lib/Wst/Offchain/Query.hs index 4f1eaae..d293e3e 100644 --- a/src/lib/Wst/Offchain/Query.hs +++ b/src/lib/Wst/Offchain/Query.hs @@ -37,7 +37,8 @@ import Wst.AppError (AppError (GlobalParamsNodeNotFound)) import Wst.Offchain.Env (DirectoryEnv (..), HasDirectoryEnv (directoryEnv), HasTransferLogicEnv (transferLogicEnv), TransferLogicEnv (tleBlacklistSpendingScript), - blacklistNodePolicyId, directoryNodePolicyId) + blacklistNodePolicyId, directoryNodePolicyId, + protocolParamsPolicyId) -- TODO: We should probably filter the UTxOs to check that they have the correct NFTs @@ -83,10 +84,11 @@ userProgrammableOutputs userCred = do -} globalParamsNode :: forall era env m. (MonadReader env m, HasDirectoryEnv env, MonadUtxoQuery m, C.IsBabbageBasedEra era, MonadError (AppError era) m) => m (UTxODat era ProgrammableLogicGlobalParams) globalParamsNode = do - DirectoryEnv{dsProtocolParamsSpendingScript} <- asks directoryEnv - let cred = C.PaymentCredentialByScript . C.hashScript $ C.PlutusScript C.PlutusScriptV3 dsProtocolParamsSpendingScript + env@DirectoryEnv{dsProtocolParamsSpendingScript} <- asks directoryEnv + let cred = C.PaymentCredentialByScript . C.hashScript $ C.PlutusScript C.PlutusScriptV3 dsProtocolParamsSpendingScript + hasNft = utxoHasPolicyId (protocolParamsPolicyId env) utxosByPaymentCredential cred - >>= maybe (throwError GlobalParamsNodeNotFound) pure . listToMaybe . extractUTxO @era + >>= maybe (throwError GlobalParamsNodeNotFound) pure . listToMaybe . filter hasNft . extractUTxO @era {-| Outputs that are locked by the programmable logic base script. -} From 3949143c78fc9cef45b435030dba40834e1ee63d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Mon, 6 Jan 2025 11:39:57 +0100 Subject: [PATCH 09/22] 10x ex units and memory for testing --- src/test/unit/Wst/Test/UnitTest.hs | 8 +++++++- src/wst-poc.cabal | 1 + 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index 3753c2a..708adb3 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -6,6 +6,7 @@ module Wst.Test.UnitTest( import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C import Cardano.Ledger.Api qualified as Ledger +import Cardano.Ledger.Plutus.ExUnits (ExUnits (..)) import Cardano.Ledger.Shelley.TxCert qualified as TxCert import Control.Lens ((%~), (&), (^.)) import Control.Monad (void) @@ -311,7 +312,12 @@ nodeParamsFor :: ScriptTarget -> NodeParams C.ConwayEra nodeParamsFor = \case -- Run the 'Mockchain' action with modified node parameters to allow larger-than-usual -- transactions. This is useful for showing debug output from the scripts and fail if there is an error - Debug -> Defaults.nodeParams & ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxSizeL %~ (*10) + Debug -> + let tenX ExUnits{exUnitsSteps=steps, exUnitsMem=mem} = + ExUnits{exUnitsSteps = 10 * steps, exUnitsMem = 10 * mem} + in Defaults.nodeParams + & ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxSizeL %~ (*10) + & ledgerProtocolParameters . protocolParameters . Ledger.ppMaxTxExUnitsL %~ tenX Production -> Defaults.nodeParams mockchainSucceedsWithTarget :: ScriptTarget -> ReaderT ScriptTarget (MockchainT C.ConwayEra IO) a -> Assertion diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index 1e55389..e3eba06 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -178,6 +178,7 @@ test-suite wst-poc-test , base >=4.14.0 , cardano-api , cardano-ledger-api + , cardano-ledger-core , cardano-ledger-shelley , convex-base , convex-coin-selection From 110b9ff0f87a5f5d8432ff3c560adcf39830cb5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Mon, 6 Jan 2025 11:42:10 +0100 Subject: [PATCH 10/22] Rename workflow --- .github/workflows/ci-compiled-scripts.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci-compiled-scripts.yaml b/.github/workflows/ci-compiled-scripts.yaml index 77270ee..8d0e591 100644 --- a/.github/workflows/ci-compiled-scripts.yaml +++ b/.github/workflows/ci-compiled-scripts.yaml @@ -1,4 +1,4 @@ -name: ci-linux +name: ci-check-generated-code on: push: branches: From 0f32d7039433e3286861cb4f1b27801f8866f0cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Mon, 6 Jan 2025 11:43:13 +0100 Subject: [PATCH 11/22] github action: Fix concurrency group --- .github/workflows/ci-compiled-scripts.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci-compiled-scripts.yaml b/.github/workflows/ci-compiled-scripts.yaml index 8d0e591..e997d0f 100644 --- a/.github/workflows/ci-compiled-scripts.yaml +++ b/.github/workflows/ci-compiled-scripts.yaml @@ -6,7 +6,7 @@ on: pull_request: concurrency: - group: ${{ github.ref }} + group: "check-generated-code ${{ github.ref }}" cancel-in-progress: true jobs: From 21a8743bd21cf5c827fe9caad712b59acebff75c Mon Sep 17 00:00:00 2001 From: Amir Rad Date: Mon, 6 Jan 2025 13:20:34 +0000 Subject: [PATCH 12/22] Deploy all scripts and reg in single tx test case --- src/lib/Wst/Offchain/BuildTx/Common.hs | 1 + .../Wst/Offchain/BuildTx/ProgrammableLogic.hs | 13 +++++-- src/lib/Wst/Offchain/BuildTx/TransferLogic.hs | 21 ++++++++++- src/lib/Wst/Offchain/BuildTx/Utils.hs | 17 +++++++++ src/lib/Wst/Offchain/Endpoints/Deployment.hs | 23 ++++++++++++ src/test/unit/Wst/Test/UnitTest.hs | 35 ++++++++++++------- src/wst-poc.cabal | 2 ++ 7 files changed, 97 insertions(+), 15 deletions(-) create mode 100644 src/lib/Wst/Offchain/BuildTx/Utils.hs diff --git a/src/lib/Wst/Offchain/BuildTx/Common.hs b/src/lib/Wst/Offchain/BuildTx/Common.hs index e69de29..8b13789 100644 --- a/src/lib/Wst/Offchain/BuildTx/Common.hs +++ b/src/lib/Wst/Offchain/BuildTx/Common.hs @@ -0,0 +1 @@ + diff --git a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs index 6ec25f2..518c999 100644 --- a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs +++ b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs @@ -9,6 +9,7 @@ module Wst.Offchain.BuildTx.ProgrammableLogic ( issueProgrammableToken, transferProgrammableToken, seizeProgrammableToken, + registerProgrammableGlobalScript, ) where @@ -38,6 +39,7 @@ import SmartTokens.Types.ProtocolParams import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..)) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..), insertDirectoryNode) +import Wst.Offchain.BuildTx.Utils (addConwayStakeCredentialCertificate) import Wst.Offchain.Env (TransferLogicEnv (..)) import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (..)) @@ -206,13 +208,20 @@ seizeProgrammableToken UTxODat{uIn = paramsTxIn} UTxODat{uIn = seizingTxIn, uOut addReference paramsTxIn -- Protocol Params TxIn addReference dirNodeRef -- Directory Node TxIn spendPlutusInlineDatum seizingTxIn baseSpendingScript () -- Redeemer is ignored in programmableLogicBase - -- QUESTION: why do we have to spend an issuer output? - -- spendPlutusInlineDatum issuerTxIn baseSpendingScript () -- Redeemer is ignored in programmableLogicBase addWithdrawalWithTxBody -- Add the global script witness to the transaction (C.makeStakeAddress nid globalStakeCred) (C.Quantity 0) $ C.ScriptWitness C.ScriptWitnessForStakeAddr . programmableGlobalWitness +registerProgrammableGlobalScript :: forall env era m. (MonadReader env m, C.IsBabbageBasedEra era, MonadBuildTx era m, Env.HasDirectoryEnv env) => m () +registerProgrammableGlobalScript = case C.babbageBasedEra @era of + C.BabbageEraOnwardsBabbage -> error "babbage era registration not implemented" + C.BabbageEraOnwardsConway -> Utils.inConway @era $ do + programmableGlobalScript <- asks (Env.dsProgrammableLogicGlobalScript . Env.directoryEnv) + let hshGlobal = C.hashScript $ C.PlutusScript C.plutusScriptVersion programmableGlobalScript + credGlobal = C.StakeCredentialByScript hshGlobal + addConwayStakeCredentialCertificate credGlobal + -- TODO: check that the issuerTxOut is at a programmable logic payment credential _checkIssuerAddressIsProgLogicCred :: forall era ctx m. ( MonadBuildTx era m) => C.PaymentCredential -> C.TxOut ctx era -> m () _checkIssuerAddressIsProgLogicCred _progLogicCred (C.TxOut (C.AddressInEra _ (C.ShelleyAddress _ _pcred _stakeRef)) _ _ C.ReferenceScriptNone) = diff --git a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs index 6455c53..473460e 100644 --- a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs +++ b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs @@ -9,7 +9,8 @@ module Wst.Offchain.BuildTx.TransferLogic seizeSmartTokens, initBlacklist, insertBlacklistNode, - paySmartTokensToDestination + paySmartTokensToDestination, + registerTransferScripts, ) where @@ -47,6 +48,7 @@ import Wst.AppError (AppError (TransferBlacklistedCredential)) import Wst.Offchain.BuildTx.ProgrammableLogic (issueProgrammableToken, seizeProgrammableToken, transferProgrammableToken) +import Wst.Offchain.BuildTx.Utils (addConwayStakeCredentialCertificate) import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (..)) import Wst.Offchain.Scripts (scriptPolicyIdV3) @@ -327,3 +329,20 @@ unwrapCredential :: Credential -> PlutusTx.BuiltinByteString unwrapCredential = \case PubKeyCredential (PubKeyHash s) -> s ScriptCredential (ScriptHash s) -> s + +registerTransferScripts :: forall env era m. (MonadReader env m, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, MonadBuildTx era m) => m () +registerTransferScripts = case C.babbageBasedEra @era of + C.BabbageEraOnwardsBabbage -> error "babbage era registration not implemented" + C.BabbageEraOnwardsConway -> Utils.inConway @era $ do + transferMintingScript <- asks (Env.tleMintingScript . Env.transferLogicEnv) + transferSpendingScript <- asks (Env.tleTransferScript . Env.transferLogicEnv) + + let + hshMinting = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferMintingScript + credMinting = C.StakeCredentialByScript hshMinting + + hshSpending = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferSpendingScript + credSpending = C.StakeCredentialByScript hshSpending + + addConwayStakeCredentialCertificate credMinting + addConwayStakeCredentialCertificate credSpending diff --git a/src/lib/Wst/Offchain/BuildTx/Utils.hs b/src/lib/Wst/Offchain/BuildTx/Utils.hs new file mode 100644 index 0000000..8fb1ce7 --- /dev/null +++ b/src/lib/Wst/Offchain/BuildTx/Utils.hs @@ -0,0 +1,17 @@ + +module Wst.Offchain.BuildTx.Utils + ( addConwayStakeCredentialCertificate + ) where + + +import Cardano.Api qualified as C +import Cardano.Api.Shelley qualified as C +import Cardano.Ledger.Shelley.TxCert qualified as TxCert +import Convex.BuildTx (MonadBuildTx, addCertificate) + +{-| Add a 'C.StakeCredential' as a certificate to the transaction +-} +addConwayStakeCredentialCertificate :: forall era m. C.IsConwayBasedEra era => MonadBuildTx era m => C.StakeCredential -> m () +addConwayStakeCredentialCertificate stk = + C.conwayEraOnwardsConstraints @era C.conwayBasedEra $ + addCertificate $ C.ConwayCertificate C.conwayBasedEra $ TxCert.RegTxCert $ C.toShelleyStakeCredential stk diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index 0c74a95..e8410bf 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -3,6 +3,7 @@ -} module Wst.Offchain.Endpoints.Deployment( deployTx, + deployTxAll, deployBlacklistTx, insertNodeTx, issueProgrammableTokenTx, @@ -28,14 +29,18 @@ import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..)) import Wst.AppError (AppError) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (inaNewKey)) import Wst.Offchain.BuildTx.DirectorySet qualified as BuildTx +import Wst.Offchain.BuildTx.ProgrammableLogic (registerProgrammableGlobalScript) import Wst.Offchain.BuildTx.ProgrammableLogic qualified as BuildTx import Wst.Offchain.BuildTx.ProtocolParams qualified as BuildTx +import Wst.Offchain.BuildTx.TransferLogic (registerTransferScripts) import Wst.Offchain.BuildTx.TransferLogic qualified as BuildTx import Wst.Offchain.Env (DirectoryScriptRoot (..)) import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (..)) import Wst.Offchain.Query qualified as Query + + {-| Build a transaction that deploys the directory and global params. Returns the transaction and the 'TxIn' that was selected for the one-shot NFTs. -} @@ -49,6 +54,24 @@ deployTx target = do $ BuildTx.mintProtocolParams >> BuildTx.initDirectorySet pure (Convex.CoinSelection.signBalancedTxBody [] tx, root) +{-| Build a transaction that deploys the directory and global params. Returns the +transaction and the 'TxIn' that was selected for the one-shot NFTs. +-} +deployTxAll :: (MonadReader env m, Env.HasOperatorEnv era env, MonadBlockchain era m, MonadError (AppError era) m, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era) => ScriptTarget -> m (C.Tx era, DirectoryScriptRoot) +deployTxAll target = do + (txi, _) <- Env.selectOperatorOutput + opEnv <- asks Env.operatorEnv + let root = DirectoryScriptRoot txi target + (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withDirectoryFor root $ Env.withTransferFromOperator + $ Env.balanceTxEnv_ + $ BuildTx.mintProtocolParams + >> BuildTx.initDirectorySet + >> BuildTx.initBlacklist + >> BuildTx.registerProgrammableGlobalScript + >> BuildTx.registerTransferScripts + + pure (Convex.CoinSelection.signBalancedTxBody [] tx, root) + {-| Build a transaction that inserts a node into the directory -} insertNodeTx :: forall era env m. (MonadReader env m, Env.HasOperatorEnv era env, Env.HasDirectoryEnv env, MonadBlockchain era m, MonadError (AppError era) m, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadUtxoQuery m) => InsertNodeArgs -> m (C.Tx era) diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index 708adb3..bacdad4 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -28,11 +28,13 @@ import Convex.Wallet.Operator (signTxOperator) import Convex.Wallet.Operator qualified as Operator import Data.List (isPrefixOf) import Data.String (IsString (..)) +import Debug.Trace (traceM) import GHC.Exception (SomeException, throw) import SmartTokens.Core.Scripts (ScriptTarget (Debug, Production)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, testCase) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..)) +import Wst.Offchain.BuildTx.Utils (addConwayStakeCredentialCertificate) import Wst.Offchain.Endpoints.Deployment qualified as Endpoints import Wst.Offchain.Env (DirectoryScriptRoot) import Wst.Offchain.Env qualified as Env @@ -58,9 +60,23 @@ scriptTargetTests target = , testCase "blacklist credential" (mockchainSucceedsWithTarget target $ void $ deployDirectorySet >>= blacklistCredential) , testCase "blacklisted transfer" (mockchainFails blacklistTransfer assertBlacklistedAddressException) , testCase "seize user output" (mockchainSucceedsWithTarget target $ deployDirectorySet >>= seizeUserOutput) + , testCase "deploy all" (mockchainSucceedsWithTarget target deployAll) ] ] +deployAll :: (MonadReader ScriptTarget m, MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m () +deployAll = do + target <- ask + failOnError $ Env.withEnv $ asAdmin @C.ConwayEra $ do + (tx, scriptRoot) <- Endpoints.deployTxAll target + void $ sendTx $ signTxOperator admin tx + traceM $ show tx + Env.withDirectoryFor scriptRoot $ do + Query.registryNodes @C.ConwayEra + >>= void . expectSingleton "registry output" + void $ Query.globalParamsNode @C.ConwayEra + + deployDirectorySet :: (MonadReader ScriptTarget m, MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m DirectoryScriptRoot deployDirectorySet = do target <- ask @@ -250,9 +266,9 @@ registerAlwaysSucceedsStakingCert = failOnError $ do BuildTx.addConwayStakeCredentialRegistrationCertificate cred (pp ^. Ledger.ppKeyDepositL) void (tryBalanceAndSubmit mempty Wallet.w1 txBody TrailingChange []) +-- TODO: registration to be moved to the endpoints registerTransferScripts :: (MonadFail m, MonadReader env m, Env.HasDirectoryEnv env, Env.HasTransferLogicEnv env, MonadMockchain C.ConwayEra m) => C.Hash C.PaymentKey -> m C.TxId registerTransferScripts pkh = failOnError $ do - pp <- fmap C.unLedgerProtocolParameters queryProtocolParameters transferMintingScript <- asks (Env.tleMintingScript . Env.transferLogicEnv) transferSpendingScript <- asks (Env.tleTransferScript . Env.transferLogicEnv) transferGlobalScript <- asks (Env.dsProgrammableLogicGlobalScript . Env.directoryEnv) @@ -267,24 +283,19 @@ registerTransferScripts pkh = failOnError $ do credGlobal = C.StakeCredentialByScript hshGlobal txBody <- BuildTx.execBuildTxT $ do - BuildTx.addStakeScriptWitness credMinting transferMintingScript () - BuildTx.addConwayStakeCredentialRegistrationCertificate credMinting (pp ^. Ledger.ppKeyDepositL) + -- pp <- fmap C.unLedgerProtocolParameters queryProtocolParameters + -- BuildTx.addStakeScriptWitness credMinting transferMintingScript () + -- BuildTx.addConwayStakeCredentialRegistrationCertificate credMinting (pp ^. Ledger.ppKeyDepositL) - addStakeCredentialCertificate credSpending - addStakeCredentialCertificate credGlobal + addConwayStakeCredentialCertificate credSpending + addConwayStakeCredentialCertificate credMinting + addConwayStakeCredentialCertificate credGlobal BuildTx.addRequiredSignature pkh x <- tryBalanceAndSubmit mempty Wallet.w1 txBody TrailingChange [] pure $ C.getTxId $ C.getTxBody x -{-| Add a 'C.StakeCredential' as a certificate to the transaction --} -addStakeCredentialCertificate :: forall era m. C.IsConwayBasedEra era => MonadBuildTx era m => C.StakeCredential -> m () -addStakeCredentialCertificate stk = - C.conwayEraOnwardsConstraints @era C.conwayBasedEra $ - addCertificate $ C.ConwayCertificate C.conwayBasedEra $ TxCert.RegTxCert $ C.toShelleyStakeCredential stk - expectSingleton :: MonadFail m => String -> [a] -> m a expectSingleton msg = \case [a] -> pure a diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index e3eba06..bc8814a 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -79,6 +79,7 @@ library Wst.Offchain.BuildTx.ProgrammableLogic Wst.Offchain.BuildTx.ProtocolParams Wst.Offchain.BuildTx.TransferLogic + Wst.Offchain.BuildTx.Utils Wst.Offchain.Endpoints.Deployment Wst.Offchain.Env Wst.Offchain.Query @@ -95,6 +96,7 @@ library , blockfrost-api , blockfrost-client-core , cardano-api + , cardano-ledger-shelley , containers , convex-base , convex-blockfrost From 234168ca8a7dbbcf3710dd58f9da57dfa57e3ee7 Mon Sep 17 00:00:00 2001 From: Amir Rad Date: Mon, 6 Jan 2025 13:47:10 +0000 Subject: [PATCH 13/22] Nonce permissioned scripts --- .../Contracts/ExampleTransferLogic.hs | 4 +- .../SmartTokens/Contracts/ProtocolParams.hs | 50 +++++++------------ src/lib/Wst/Offchain/Endpoints/Deployment.hs | 2 - src/lib/Wst/Offchain/Env.hs | 7 +-- src/lib/Wst/Offchain/Scripts.hs | 34 ++++++++----- 5 files changed, 44 insertions(+), 53 deletions(-) diff --git a/src/lib/SmartTokens/Contracts/ExampleTransferLogic.hs b/src/lib/SmartTokens/Contracts/ExampleTransferLogic.hs index 8398a3e..79f66f3 100644 --- a/src/lib/SmartTokens/Contracts/ExampleTransferLogic.hs +++ b/src/lib/SmartTokens/Contracts/ExampleTransferLogic.hs @@ -78,8 +78,8 @@ instance PUnsafeLiftDecl PBlacklistProof where This ensures that only transactions signed by the specified permissioned credential can spend the associated programmable tokens. -} -mkPermissionedTransfer :: ClosedTerm (PAsData PPubKeyHash :--> PScriptContext :--> PUnit) -mkPermissionedTransfer = plam $ \permissionedCred ctx -> +mkPermissionedTransfer :: ClosedTerm (PData :--> PAsData PPubKeyHash :--> PScriptContext :--> PUnit) +mkPermissionedTransfer = plam $ \_ permissionedCred ctx -> pvalidateConditions [ ptxSignedByPkh # permissionedCred # (pfield @"signatories" # (pfield @"txInfo" # ctx)) ] diff --git a/src/lib/SmartTokens/Contracts/ProtocolParams.hs b/src/lib/SmartTokens/Contracts/ProtocolParams.hs index 8b25b91..fd4d4eb 100644 --- a/src/lib/SmartTokens/Contracts/ProtocolParams.hs +++ b/src/lib/SmartTokens/Contracts/ProtocolParams.hs @@ -1,37 +1,21 @@ -{-# LANGUAGE QualifiedDo #-} -{-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QualifiedDo #-} module SmartTokens.Contracts.ProtocolParams ( mkProtocolParametersMinting, alwaysFailScript, mkPermissionedMinting, ) where -import Plutarch.LedgerApi.V3 ( PTxOutRef, PScriptContext, PPubKeyHash ) +import Plutarch.Core.Utils (phasUTxO, pheadSingleton, pletFieldsMinting, + ptryLookupValue, ptxSignedByPkh, + pvalidateConditions) +import Plutarch.LedgerApi.V3 (PPubKeyHash, PScriptContext, PTxOutRef) import Plutarch.Monadic qualified as P -import Plutarch.Prelude - ( PAsData, - PData, - PEq((#==)), - type (:-->), - (#), - plet, - perror, - pconstantData, - ClosedTerm, - plam, - pfromData, - pfstBuiltin, - psndBuiltin, - pletFields, - PUnit, pfield ) -import Plutarch.Core.Utils - ( pheadSingleton, - ptryLookupValue, - phasUTxO, - pvalidateConditions, - pletFieldsMinting, ptxSignedByPkh ) -import SmartTokens.Types.Constants ( pprotocolParamsTokenData ) +import Plutarch.Prelude (ClosedTerm, PAsData, PData, PEq ((#==)), PUnit, + pconstantData, perror, pfield, pfromData, pfstBuiltin, + plam, plet, pletFields, psndBuiltin, type (:-->), (#)) +import SmartTokens.Types.Constants (pprotocolParamsTokenData) -- | Protocol Parameters minting policy -- This validator allows minting of a single token with a single token name. @@ -40,10 +24,10 @@ mkProtocolParametersMinting = plam $ \oref ctx -> P.do ctxF <- pletFields @'["txInfo", "scriptInfo"] ctx infoF <- pletFields @'["inputs", "mint"] ctxF.txInfo scriptInfoF <- pletFieldsMinting ctxF.scriptInfo - let ownCS = scriptInfoF._0 + let ownCS = scriptInfoF._0 mintedValue <- plet $ pfromData infoF.mint let ownTkPairs = ptryLookupValue # ownCS # mintedValue - -- Enforce that only a single token name is minted for this policy + -- Enforce that only a single token name is minted for this policy ownTkPair <- plet (pheadSingleton # ownTkPairs) ownTokenName <- plet (pfstBuiltin # ownTkPair) ownNumMinted <- plet (psndBuiltin # ownTkPair) @@ -56,14 +40,14 @@ mkProtocolParametersMinting = plam $ \oref ctx -> P.do -- | Permissioned Minting Policy -- This minting policy checks for a given permissioned credential in the signatories of the transaction. -- It allows minting of any number of tokens with any token name so long as the credential authorizes the transaction. -mkPermissionedMinting :: ClosedTerm (PAsData PPubKeyHash :--> PScriptContext :--> PUnit) -mkPermissionedMinting = plam $ \permissionedCred ctx -> +mkPermissionedMinting :: ClosedTerm (PData :--> PAsData PPubKeyHash :--> PScriptContext :--> PUnit) +mkPermissionedMinting = plam $ \_ permissionedCred ctx -> pvalidateConditions [ ptxSignedByPkh # permissionedCred # (pfield @"signatories" # (pfield @"txInfo" # ctx)) ] -- | A nonced always fails script -- The parameter is used to modify the script hash. --- This is where the protocol parameters UTxO should reside. +-- This is where the protocol parameters UTxO should reside. alwaysFailScript :: ClosedTerm (PData :--> PScriptContext :--> PUnit) -alwaysFailScript = plam $ \_ _ctx -> perror \ No newline at end of file +alwaysFailScript = plam $ \_ _ctx -> perror diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index e8410bf..41ce163 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -29,10 +29,8 @@ import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..)) import Wst.AppError (AppError) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (inaNewKey)) import Wst.Offchain.BuildTx.DirectorySet qualified as BuildTx -import Wst.Offchain.BuildTx.ProgrammableLogic (registerProgrammableGlobalScript) import Wst.Offchain.BuildTx.ProgrammableLogic qualified as BuildTx import Wst.Offchain.BuildTx.ProtocolParams qualified as BuildTx -import Wst.Offchain.BuildTx.TransferLogic (registerTransferScripts) import Wst.Offchain.BuildTx.TransferLogic qualified as BuildTx import Wst.Offchain.Env (DirectoryScriptRoot (..)) import Wst.Offchain.Env qualified as Env diff --git a/src/lib/Wst/Offchain/Env.hs b/src/lib/Wst/Offchain/Env.hs index f653e77..cb96081 100644 --- a/src/lib/Wst/Offchain/Env.hs +++ b/src/lib/Wst/Offchain/Env.hs @@ -106,7 +106,8 @@ import Wst.Offchain.Scripts (alwaysSucceedsScript, blacklistMintingScript, blacklistSpendingScript, directoryNodeMintingScript, directoryNodeSpendingScript, freezeTransferScript, - permissionedTransferScript, + permissionedMintingScript, + permissionedSpendingScript, programmableLogicBaseScript, programmableLogicGlobalScript, programmableLogicMintingScript, @@ -306,9 +307,9 @@ mkTransferLogicEnv BlacklistTransferLogicScriptRoot{tlrTarget, tlrDirEnv, tlrIss TransferLogicEnv { tleBlacklistMintingScript = blacklistMinting , tleBlacklistSpendingScript = blacklistSpendingScript tlrTarget tlrIssuer - , tleMintingScript = permissionedTransferScript tlrTarget tlrIssuer + , tleMintingScript = permissionedMintingScript tlrTarget tlrIssuer , tleTransferScript = freezeTransferScript tlrTarget progLogicBaseCred blacklistPolicy - , tleIssuerScript = permissionedTransferScript tlrTarget tlrIssuer + , tleIssuerScript = permissionedSpendingScript tlrTarget tlrIssuer } blacklistNodePolicyId :: TransferLogicEnv -> C.PolicyId diff --git a/src/lib/Wst/Offchain/Scripts.hs b/src/lib/Wst/Offchain/Scripts.hs index a815cd0..ca70685 100644 --- a/src/lib/Wst/Offchain/Scripts.hs +++ b/src/lib/Wst/Offchain/Scripts.hs @@ -13,7 +13,8 @@ module Wst.Offchain.Scripts ( programmableLogicGlobalScript, -- * Transfer logic - permissionedTransferScript, + permissionedMintingScript, + permissionedSpendingScript, freezeTransferScript, blacklistMintingScript, blacklistSpendingScript, @@ -100,31 +101,38 @@ programmableLogicGlobalScript target paramsPolId = let script = Scripts.tryCompile target $ mkProgrammableLogicGlobal # pdata (pconstant $ transPolicyId paramsPolId) in C.PlutusScriptSerialised $ serialiseScript script -permissionedTransferScript :: ScriptTarget -> C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 -permissionedTransferScript target cred = - let script = Scripts.tryCompile target $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred) - in C.PlutusScriptSerialised $ serialiseScript script - freezeTransferScript :: ScriptTarget -> C.PaymentCredential -> C.PolicyId -> C.PlutusScript C.PlutusScriptV3 freezeTransferScript target progLogicBaseSpndingCred blacklistPolicyId = let script = Scripts.tryCompile target $ mkFreezeAndSeizeTransfer # pdata (pconstant $ transCredential progLogicBaseSpndingCred) # pdata (pconstant $ transPolicyId blacklistPolicyId) in C.PlutusScriptSerialised $ serialiseScript script +{-| 'C.PlutusScript C.PlutusScriptV3' that always succeeds. Can be used for minting, withdrawal, spending, etc. +-} +alwaysSucceedsScript :: ScriptTarget -> C.PlutusScript C.PlutusScriptV3 +alwaysSucceedsScript target = + C.PlutusScriptSerialised $ serialiseScript $ Scripts.tryCompile target palwaysSucceed + +-- All the scripts below are essentially nonced permissioned validators +permissionedMintingScript :: ScriptTarget -> C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 +permissionedMintingScript target cred = + let script = Scripts.tryCompile target $ mkPermissionedMinting # pforgetData (pdata (pconstant "permissioned minting" :: ClosedTerm PByteString)) # pdata (pconstant $ transPubKeyHash cred) + in C.PlutusScriptSerialised $ serialiseScript script + +permissionedSpendingScript :: ScriptTarget -> C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 +permissionedSpendingScript target cred = + let script = Scripts.tryCompile target $ mkPermissionedTransfer # pforgetData (pdata (pconstant "permissioned spending" :: ClosedTerm PByteString)) # pdata (pconstant $ transPubKeyHash cred) + in C.PlutusScriptSerialised $ serialiseScript script + blacklistMintingScript :: ScriptTarget -> C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 blacklistMintingScript target cred = - let script = Scripts.tryCompile target $ mkPermissionedMinting # pdata (pconstant $ transPubKeyHash cred) + let script = Scripts.tryCompile target $ mkPermissionedMinting # pforgetData (pdata (pconstant "blacklist minting" :: ClosedTerm PByteString)) # pdata (pconstant $ transPubKeyHash cred) in C.PlutusScriptSerialised $ serialiseScript script blacklistSpendingScript :: ScriptTarget -> C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3 blacklistSpendingScript target cred = - let script = Scripts.tryCompile target $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred) + let script = Scripts.tryCompile target $ mkPermissionedTransfer # pforgetData (pdata (pconstant "blacklist spending" :: ClosedTerm PByteString)) # pdata (pconstant $ transPubKeyHash cred) in C.PlutusScriptSerialised $ serialiseScript script -{-| 'C.PlutusScript C.PlutusScriptV3' that always succeeds. Can be used for minting, withdrawal, spending, etc. --} -alwaysSucceedsScript :: ScriptTarget -> C.PlutusScript C.PlutusScriptV3 -alwaysSucceedsScript target = - C.PlutusScriptSerialised $ serialiseScript $ Scripts.tryCompile target palwaysSucceed -- Utilities scriptPolicyIdV3 :: C.PlutusScript C.PlutusScriptV3 -> C.PolicyId From 32d12f96dc7516e97dab7604ed7119a7cb98778f Mon Sep 17 00:00:00 2001 From: Amir Rad Date: Thu, 9 Jan 2025 12:33:00 +0000 Subject: [PATCH 14/22] CLI deployment and include registrations in deploy tx --- cabal.project | 5 +- flake.lock | 1095 ++++++++++++++++-- flake.nix | 6 + nix/project.nix | 3 +- nix/shell.nix | 2 + src/lib/SmartTokens/Types/ProtocolParams.hs | 1 - src/lib/Wst/Cli.hs | 58 +- src/lib/Wst/Offchain/Endpoints/Deployment.hs | 13 +- src/lib/Wst/Offchain/Env.hs | 4 + src/lib/Wst/Server.hs | 5 +- src/test/unit/Wst/Test/UnitTest.hs | 9 +- 11 files changed, 1057 insertions(+), 144 deletions(-) diff --git a/cabal.project b/cabal.project index 22bab83..82879c2 100644 --- a/cabal.project +++ b/cabal.project @@ -41,8 +41,9 @@ source-repository-package source-repository-package type: git - location: https://github.com/j-mueller/sc-tools - tag: e2759559324e172f12b11ab815323c48ed8922b0 + -- location: https://github.com/j-mueller/sc-tools + location: https://github.com/amirmrad/sc-tools + tag: 6c63efe07015e87719d77fa3fabfe07f959c7227 subdir: src/devnet src/blockfrost diff --git a/flake.lock b/flake.lock index e7ae139..4ab8565 100644 --- a/flake.lock +++ b/flake.lock @@ -18,6 +18,23 @@ } }, "CHaP_2": { + "flake": false, + "locked": { + "lastModified": 1729560667, + "narHash": "sha256-tHDAxN8erb23MIy7zH6VV6mCspKBstj2R1LkeBgZt28=", + "owner": "intersectmbo", + "repo": "cardano-haskell-packages", + "rev": "7f24768c3a2f42a15fef889d5b415100d8082c16", + "type": "github" + }, + "original": { + "owner": "intersectmbo", + "ref": "repo", + "repo": "cardano-haskell-packages", + "type": "github" + } + }, + "CHaP_3": { "flake": false, "locked": { "lastModified": 1731401651, @@ -66,7 +83,40 @@ "type": "github" } }, + "HTTP_3": { + "flake": false, + "locked": { + "lastModified": 1451647621, + "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", + "owner": "phadej", + "repo": "HTTP", + "rev": "9bc0996d412fef1787449d841277ef663ad9a915", + "type": "github" + }, + "original": { + "owner": "phadej", + "repo": "HTTP", + "type": "github" + } + }, "blst": { + "flake": false, + "locked": { + "lastModified": 1656163412, + "narHash": "sha256-xero1aTe2v4IhWIJaEDUsVDOfE77dOV5zKeHWntHogY=", + "owner": "supranational", + "repo": "blst", + "rev": "03b5124029979755c752eec45f3c29674b558446", + "type": "github" + }, + "original": { + "owner": "supranational", + "repo": "blst", + "rev": "03b5124029979755c752eec45f3c29674b558446", + "type": "github" + } + }, + "blst_2": { "flake": false, "locked": { "lastModified": 1691598027, @@ -83,7 +133,7 @@ "type": "github" } }, - "blst_2": { + "blst_3": { "flake": false, "locked": { "lastModified": 1691598027, @@ -134,6 +184,23 @@ "type": "github" } }, + "cabal-32_3": { + "flake": false, + "locked": { + "lastModified": 1603716527, + "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", + "owner": "haskell", + "repo": "cabal", + "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.2", + "repo": "cabal", + "type": "github" + } + }, "cabal-34": { "flake": false, "locked": { @@ -168,6 +235,23 @@ "type": "github" } }, + "cabal-34_3": { + "flake": false, + "locked": { + "lastModified": 1645834128, + "narHash": "sha256-wG3d+dOt14z8+ydz4SL7pwGfe7SiimxcD/LOuPCV6xM=", + "owner": "haskell", + "repo": "cabal", + "rev": "5ff598c67f53f7c4f48e31d722ba37172230c462", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.4", + "repo": "cabal", + "type": "github" + } + }, "cabal-36": { "flake": false, "locked": { @@ -202,6 +286,51 @@ "type": "github" } }, + "cabal-36_3": { + "flake": false, + "locked": { + "lastModified": 1669081697, + "narHash": "sha256-I5or+V7LZvMxfbYgZATU4awzkicBwwok4mVoje+sGmU=", + "owner": "haskell", + "repo": "cabal", + "rev": "8fd619e33d34924a94e691c5fea2c42f0fc7f144", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.6", + "repo": "cabal", + "type": "github" + } + }, + "cardano-cli": { + "inputs": { + "CHaP": "CHaP_2", + "flake-utils": "flake-utils", + "haskellNix": "haskellNix", + "incl": "incl", + "iohkNix": "iohkNix", + "nixpkgs": [ + "cardano-cli", + "haskellNix", + "nixpkgs-unstable" + ] + }, + "locked": { + "lastModified": 1729605049, + "narHash": "sha256-63QosPbGo1KuQWrhJKx4BK0qKW//dvMx6CZGRAK/oBU=", + "owner": "intersectmbo", + "repo": "cardano-cli", + "rev": "07384e916af7ade25e3ffb672b0204b277b8caf4", + "type": "github" + }, + "original": { + "owner": "intersectmbo", + "ref": "cardano-cli-10.1.0.0", + "repo": "cardano-cli", + "type": "github" + } + }, "cardano-shell": { "flake": false, "locked": { @@ -234,6 +363,22 @@ "type": "github" } }, + "cardano-shell_3": { + "flake": false, + "locked": { + "lastModified": 1608537748, + "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", + "owner": "input-output-hk", + "repo": "cardano-shell", + "rev": "9392c75087cb9a3d453998f4230930dea3a95725", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-shell", + "type": "github" + } + }, "commonmark-simple": { "flake": false, "locked": { @@ -268,7 +413,7 @@ }, "easy-purescript-nix": { "inputs": { - "flake-utils": "flake-utils" + "flake-utils": "flake-utils_2" }, "locked": { "lastModified": 1710161569, @@ -311,7 +456,7 @@ "haskell-flake": "haskell-flake", "heist-extra": "heist-extra", "nixos-unified": "nixos-unified", - "nixpkgs": "nixpkgs_4", + "nixpkgs": "nixpkgs_6", "treefmt-nix": "treefmt-nix", "unionmount": "unionmount" }, @@ -363,6 +508,23 @@ } }, "flake-compat_2": { + "flake": false, + "locked": { + "lastModified": 1672831974, + "narHash": "sha256-z9k3MfslLjWQfnjBtEtJZdq3H7kyi2kQtUThfTgdRk0=", + "owner": "input-output-hk", + "repo": "flake-compat", + "rev": "45f2638735f8cdc40fe302742b79f248d23eb368", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "hkm/gitlab-fix", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat_3": { "locked": { "lastModified": 1733328505, "narHash": "sha256-NeCCThCEP3eCl2l/+27kNNK7QrwZB1IJCrXfrbv5oqU=", @@ -377,7 +539,7 @@ "type": "github" } }, - "flake-compat_3": { + "flake-compat_4": { "flake": false, "locked": { "lastModified": 1696426674, @@ -393,7 +555,7 @@ "type": "github" } }, - "flake-compat_4": { + "flake-compat_5": { "flake": false, "locked": { "lastModified": 1672831974, @@ -410,7 +572,7 @@ "type": "github" } }, - "flake-compat_5": { + "flake-compat_6": { "flake": false, "locked": { "lastModified": 1696426674, @@ -506,6 +668,25 @@ "inputs": { "systems": "systems" }, + "locked": { + "lastModified": 1681378341, + "narHash": "sha256-2qUN04W6X9cHHytEsJTM41CmusifPTC0bgTtYsHSNY8=", + "owner": "hamishmack", + "repo": "flake-utils", + "rev": "2767bafdb189cd623354620c2dacbeca8fd58b17", + "type": "github" + }, + "original": { + "owner": "hamishmack", + "ref": "hkm/nested-hydraJobs", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_2": { + "inputs": { + "systems": "systems_2" + }, "locked": { "lastModified": 1685518550, "narHash": "sha256-o2d0KcvaXzTrPRIo0kOLV0/QXHhDQ5DTi+OxcjO8xqY=", @@ -520,9 +701,9 @@ "type": "github" } }, - "flake-utils_2": { + "flake-utils_3": { "inputs": { - "systems": "systems_2" + "systems": "systems_3" }, "locked": { "lastModified": 1731533236, @@ -538,9 +719,9 @@ "type": "github" } }, - "flake-utils_3": { + "flake-utils_4": { "inputs": { - "systems": "systems_3" + "systems": "systems_4" }, "locked": { "lastModified": 1710146030, @@ -590,6 +771,23 @@ "type": "github" } }, + "ghc-8.6.5-iohk_3": { + "flake": false, + "locked": { + "lastModified": 1600920045, + "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", + "owner": "input-output-hk", + "repo": "ghc", + "rev": "95713a6ecce4551240da7c96b6176f980af75cae", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "release/8.6.5-iohk", + "repo": "ghc", + "type": "github" + } + }, "gitignore": { "inputs": { "nixpkgs": [ @@ -635,6 +833,22 @@ } }, "hackage": { + "flake": false, + "locked": { + "lastModified": 1726446873, + "narHash": "sha256-dWdiphXwkk4qQVFkQHuUysphOb0XO8EHJlk/8Km/7q0=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "3126b966be7409ebfd61c88f85dbfb6ec2a51338", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "hackage_2": { "flake": false, "locked": { "lastModified": 1734309106, @@ -650,7 +864,7 @@ "type": "github" } }, - "hackage_2": { + "hackage_3": { "flake": false, "locked": { "lastModified": 1731457652, @@ -682,70 +896,17 @@ } }, "haskell-nix": { - "inputs": { - "HTTP": "HTTP", - "cabal-32": "cabal-32", - "cabal-34": "cabal-34", - "cabal-36": "cabal-36", - "cardano-shell": "cardano-shell", - "flake-compat": "flake-compat", - "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", - "hackage": [ - "hackage" - ], - "hls-1.10": "hls-1.10", - "hls-2.0": "hls-2.0", - "hls-2.2": "hls-2.2", - "hls-2.3": "hls-2.3", - "hls-2.4": "hls-2.4", - "hls-2.5": "hls-2.5", - "hls-2.6": "hls-2.6", - "hls-2.7": "hls-2.7", - "hls-2.8": "hls-2.8", - "hls-2.9": "hls-2.9", - "hpc-coveralls": "hpc-coveralls", - "hydra": "hydra", - "iserv-proxy": "iserv-proxy", - "nixpkgs": [ - "haskell-nix", - "nixpkgs-unstable" - ], - "nixpkgs-2003": "nixpkgs-2003", - "nixpkgs-2105": "nixpkgs-2105", - "nixpkgs-2111": "nixpkgs-2111", - "nixpkgs-2205": "nixpkgs-2205", - "nixpkgs-2211": "nixpkgs-2211", - "nixpkgs-2305": "nixpkgs-2305", - "nixpkgs-2311": "nixpkgs-2311", - "nixpkgs-2405": "nixpkgs-2405", - "nixpkgs-unstable": "nixpkgs-unstable", - "old-ghc-nix": "old-ghc-nix", - "stackage": "stackage" - }, - "locked": { - "lastModified": 1734310321, - "narHash": "sha256-V6n3f2JiauvU+M483gRcEirsPsr2mmhUfDiMHIlWo5g=", - "owner": "input-output-hk", - "repo": "haskell.nix", - "rev": "4bd079e21afcff79917e953d2f1b11d3bfec8603", - "type": "github" - }, - "original": { - "owner": "input-output-hk", - "repo": "haskell.nix", - "type": "github" - } - }, - "haskell-nix_2": { "inputs": { "HTTP": "HTTP_2", "cabal-32": "cabal-32_2", "cabal-34": "cabal-34_2", "cabal-36": "cabal-36_2", "cardano-shell": "cardano-shell_2", - "flake-compat": "flake-compat_4", + "flake-compat": "flake-compat_2", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", - "hackage": "hackage_2", + "hackage": [ + "hackage" + ], "hls-1.10": "hls-1.10_2", "hls-2.0": "hls-2.0_2", "hls-2.2": "hls-2.2_2", @@ -760,7 +921,6 @@ "hydra": "hydra_2", "iserv-proxy": "iserv-proxy_2", "nixpkgs": [ - "plutarch", "haskell-nix", "nixpkgs-unstable" ], @@ -777,11 +937,11 @@ "stackage": "stackage_2" }, "locked": { - "lastModified": 1731459093, - "narHash": "sha256-jtkwdegm5jhft4k2JqqxsxVWxXc2Or+Sbk1ym5T+1h0=", + "lastModified": 1734310321, + "narHash": "sha256-V6n3f2JiauvU+M483gRcEirsPsr2mmhUfDiMHIlWo5g=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "fc8633a447714e7720b7db2a88038e75fa350150", + "rev": "4bd079e21afcff79917e953d2f1b11d3bfec8603", "type": "github" }, "original": { @@ -790,7 +950,115 @@ "type": "github" } }, - "heist-extra": { + "haskell-nix_2": { + "inputs": { + "HTTP": "HTTP_3", + "cabal-32": "cabal-32_3", + "cabal-34": "cabal-34_3", + "cabal-36": "cabal-36_3", + "cardano-shell": "cardano-shell_3", + "flake-compat": "flake-compat_5", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_3", + "hackage": "hackage_3", + "hls-1.10": "hls-1.10_3", + "hls-2.0": "hls-2.0_3", + "hls-2.2": "hls-2.2_3", + "hls-2.3": "hls-2.3_3", + "hls-2.4": "hls-2.4_3", + "hls-2.5": "hls-2.5_3", + "hls-2.6": "hls-2.6_3", + "hls-2.7": "hls-2.7_3", + "hls-2.8": "hls-2.8_3", + "hls-2.9": "hls-2.9_3", + "hpc-coveralls": "hpc-coveralls_3", + "hydra": "hydra_3", + "iserv-proxy": "iserv-proxy_3", + "nixpkgs": [ + "plutarch", + "haskell-nix", + "nixpkgs-unstable" + ], + "nixpkgs-2003": "nixpkgs-2003_3", + "nixpkgs-2105": "nixpkgs-2105_3", + "nixpkgs-2111": "nixpkgs-2111_3", + "nixpkgs-2205": "nixpkgs-2205_3", + "nixpkgs-2211": "nixpkgs-2211_3", + "nixpkgs-2305": "nixpkgs-2305_3", + "nixpkgs-2311": "nixpkgs-2311_3", + "nixpkgs-2405": "nixpkgs-2405_3", + "nixpkgs-unstable": "nixpkgs-unstable_3", + "old-ghc-nix": "old-ghc-nix_3", + "stackage": "stackage_3" + }, + "locked": { + "lastModified": 1731459093, + "narHash": "sha256-jtkwdegm5jhft4k2JqqxsxVWxXc2Or+Sbk1ym5T+1h0=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "fc8633a447714e7720b7db2a88038e75fa350150", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, + "haskellNix": { + "inputs": { + "HTTP": "HTTP", + "cabal-32": "cabal-32", + "cabal-34": "cabal-34", + "cabal-36": "cabal-36", + "cardano-shell": "cardano-shell", + "flake-compat": "flake-compat", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", + "hackage": "hackage", + "hls-1.10": "hls-1.10", + "hls-2.0": "hls-2.0", + "hls-2.2": "hls-2.2", + "hls-2.3": "hls-2.3", + "hls-2.4": "hls-2.4", + "hls-2.5": "hls-2.5", + "hls-2.6": "hls-2.6", + "hls-2.7": "hls-2.7", + "hls-2.8": "hls-2.8", + "hls-2.9": "hls-2.9", + "hpc-coveralls": "hpc-coveralls", + "hydra": "hydra", + "iserv-proxy": "iserv-proxy", + "nixpkgs": [ + "cardano-cli", + "haskellNix", + "nixpkgs-unstable" + ], + "nixpkgs-2003": "nixpkgs-2003", + "nixpkgs-2105": "nixpkgs-2105", + "nixpkgs-2111": "nixpkgs-2111", + "nixpkgs-2205": "nixpkgs-2205", + "nixpkgs-2211": "nixpkgs-2211", + "nixpkgs-2305": "nixpkgs-2305", + "nixpkgs-2311": "nixpkgs-2311", + "nixpkgs-2405": "nixpkgs-2405", + "nixpkgs-unstable": "nixpkgs-unstable", + "old-ghc-nix": "old-ghc-nix", + "stackage": "stackage" + }, + "locked": { + "lastModified": 1726447863, + "narHash": "sha256-bI1GMzozXWQ/Ckukr8bXnH3QzWZ+vZC0o5RkblCXIyI=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "d259dac293df908b6749653122cca88b5e459c30", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, + "heist-extra": { "flake": false, "locked": { "lastModified": 1710541479, @@ -809,7 +1077,7 @@ "hercules-ci-effects": { "inputs": { "flake-parts": "flake-parts_3", - "nixpkgs": "nixpkgs_6" + "nixpkgs": "nixpkgs_8" }, "locked": { "lastModified": 1730903510, @@ -859,6 +1127,23 @@ "type": "github" } }, + "hls-1.10_3": { + "flake": false, + "locked": { + "lastModified": 1680000865, + "narHash": "sha256-rc7iiUAcrHxwRM/s0ErEsSPxOR3u8t7DvFeWlMycWgo=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "b08691db779f7a35ff322b71e72a12f6e3376fd9", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "1.10.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hls-2.0": { "flake": false, "locked": { @@ -893,6 +1178,23 @@ "type": "github" } }, + "hls-2.0_3": { + "flake": false, + "locked": { + "lastModified": 1687698105, + "narHash": "sha256-OHXlgRzs/kuJH8q7Sxh507H+0Rb8b7VOiPAjcY9sM1k=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "783905f211ac63edf982dd1889c671653327e441", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.0.0.1", + "repo": "haskell-language-server", + "type": "github" + } + }, "hls-2.2": { "flake": false, "locked": { @@ -927,6 +1229,23 @@ "type": "github" } }, + "hls-2.2_3": { + "flake": false, + "locked": { + "lastModified": 1693064058, + "narHash": "sha256-8DGIyz5GjuCFmohY6Fa79hHA/p1iIqubfJUTGQElbNk=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "b30f4b6cf5822f3112c35d14a0cba51f3fe23b85", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.2.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hls-2.3": { "flake": false, "locked": { @@ -961,6 +1280,23 @@ "type": "github" } }, + "hls-2.3_3": { + "flake": false, + "locked": { + "lastModified": 1695910642, + "narHash": "sha256-tR58doOs3DncFehHwCLczJgntyG/zlsSd7DgDgMPOkI=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "458ccdb55c9ea22cd5d13ec3051aaefb295321be", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.3.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hls-2.4": { "flake": false, "locked": { @@ -995,6 +1331,23 @@ "type": "github" } }, + "hls-2.4_3": { + "flake": false, + "locked": { + "lastModified": 1699862708, + "narHash": "sha256-YHXSkdz53zd0fYGIYOgLt6HrA0eaRJi9mXVqDgmvrjk=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "54507ef7e85fa8e9d0eb9a669832a3287ffccd57", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.4.0.1", + "repo": "haskell-language-server", + "type": "github" + } + }, "hls-2.5": { "flake": false, "locked": { @@ -1029,6 +1382,23 @@ "type": "github" } }, + "hls-2.5_3": { + "flake": false, + "locked": { + "lastModified": 1701080174, + "narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "27f8c3d3892e38edaef5bea3870161815c4d014c", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.5.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hls-2.6": { "flake": false, "locked": { @@ -1063,6 +1433,23 @@ "type": "github" } }, + "hls-2.6_3": { + "flake": false, + "locked": { + "lastModified": 1705325287, + "narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.6.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hls-2.7": { "flake": false, "locked": { @@ -1097,6 +1484,23 @@ "type": "github" } }, + "hls-2.7_3": { + "flake": false, + "locked": { + "lastModified": 1708965829, + "narHash": "sha256-LfJ+TBcBFq/XKoiNI7pc4VoHg4WmuzsFxYJ3Fu+Jf+M=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "50322b0a4aefb27adc5ec42f5055aaa8f8e38001", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.7.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hls-2.8": { "flake": false, "locked": { @@ -1131,7 +1535,41 @@ "type": "github" } }, + "hls-2.8_3": { + "flake": false, + "locked": { + "lastModified": 1715153580, + "narHash": "sha256-Vi/iUt2pWyUJlo9VrYgTcbRviWE0cFO6rmGi9rmALw0=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "dd1be1beb16700de59e0d6801957290bcf956a0a", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.8.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hls-2.9": { + "flake": false, + "locked": { + "lastModified": 1718469202, + "narHash": "sha256-THXSz+iwB1yQQsr/PY151+2GvtoJnTIB2pIQ4OzfjD4=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "40891bccb235ebacce020b598b083eab9dda80f1", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.9.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.9_2": { "flake": false, "locked": { "lastModified": 1720003792, @@ -1148,7 +1586,7 @@ "type": "github" } }, - "hls-2.9_2": { + "hls-2.9_3": { "flake": false, "locked": { "lastModified": 1720003792, @@ -1197,11 +1635,28 @@ "type": "github" } }, + "hpc-coveralls_3": { + "flake": false, + "locked": { + "lastModified": 1607498076, + "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", + "type": "github" + }, + "original": { + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "type": "github" + } + }, "hydra": { "inputs": { "nix": "nix", "nixpkgs": [ - "haskell-nix", + "cardano-cli", + "haskellNix", "hydra", "nix", "nixpkgs" @@ -1223,6 +1678,29 @@ "hydra_2": { "inputs": { "nix": "nix_2", + "nixpkgs": [ + "haskell-nix", + "hydra", + "nix", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1671755331, + "narHash": "sha256-hXsgJj0Cy0ZiCiYdW2OdBz5WmFyOMKuw4zyxKpgUKm4=", + "owner": "NixOS", + "repo": "hydra", + "rev": "f48f00ee6d5727ae3e488cbf9ce157460853fea8", + "type": "github" + }, + "original": { + "id": "hydra", + "type": "indirect" + } + }, + "hydra_3": { + "inputs": { + "nix": "nix_3", "nixpkgs": [ "plutarch", "haskell-nix", @@ -1244,14 +1722,32 @@ "type": "indirect" } }, + "incl": { + "inputs": { + "nixlib": "nixlib" + }, + "locked": { + "lastModified": 1693483555, + "narHash": "sha256-Beq4WhSeH3jRTZgC1XopTSU10yLpK1nmMcnGoXO0XYo=", + "owner": "divnix", + "repo": "incl", + "rev": "526751ad3d1e23b07944b14e3f6b7a5948d3007b", + "type": "github" + }, + "original": { + "owner": "divnix", + "repo": "incl", + "type": "github" + } + }, "iogx": { "inputs": { "CHaP": [ "CHaP" ], "easy-purescript-nix": "easy-purescript-nix", - "flake-compat": "flake-compat_2", - "flake-utils": "flake-utils_2", + "flake-compat": "flake-compat_3", + "flake-utils": "flake-utils_3", "hackage": [ "hackage" ], @@ -1283,13 +1779,13 @@ }, "iohk-nix": { "inputs": { - "blst": "blst", + "blst": "blst_2", "nixpkgs": [ "iogx", "nixpkgs" ], - "secp256k1": "secp256k1", - "sodium": "sodium" + "secp256k1": "secp256k1_2", + "sodium": "sodium_2" }, "locked": { "lastModified": 1732287300, @@ -1307,14 +1803,14 @@ }, "iohk-nix_2": { "inputs": { - "blst": "blst_2", + "blst": "blst_3", "nixpkgs": [ "plutarch", "haskell-nix", "nixpkgs" ], - "secp256k1": "secp256k1_2", - "sodium": "sodium_2" + "secp256k1": "secp256k1_3", + "sodium": "sodium_3" }, "locked": { "lastModified": 1730297014, @@ -1330,6 +1826,27 @@ "type": "github" } }, + "iohkNix": { + "inputs": { + "blst": "blst", + "nixpkgs": "nixpkgs_2", + "secp256k1": "secp256k1", + "sodium": "sodium" + }, + "locked": { + "lastModified": 1702362799, + "narHash": "sha256-cU8cZXNuo5GRwrSvWqdaqoW5tJ2HWwDEOvWwIVPDPmo=", + "owner": "input-output-hk", + "repo": "iohk-nix", + "rev": "b426fb9e0b109a9d1dd2e1476f9e0bd8bb715142", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "iohk-nix", + "type": "github" + } + }, "iserv-proxy": { "flake": false, "locked": { @@ -1364,6 +1881,23 @@ "type": "github" } }, + "iserv-proxy_3": { + "flake": false, + "locked": { + "lastModified": 1717479972, + "narHash": "sha256-7vE3RQycHI1YT9LHJ1/fUaeln2vIpYm6Mmn8FTpYeVo=", + "owner": "stable-haskell", + "repo": "iserv-proxy", + "rev": "2ed34002247213fc435d0062350b91bab920626e", + "type": "github" + }, + "original": { + "owner": "stable-haskell", + "ref": "iserv-syms", + "repo": "iserv-proxy", + "type": "github" + } + }, "lowdown-src": { "flake": false, "locked": { @@ -1396,6 +1930,22 @@ "type": "github" } }, + "lowdown-src_3": { + "flake": false, + "locked": { + "lastModified": 1633514407, + "narHash": "sha256-Dw32tiMjdK9t3ETl5fzGrutQTzh2rufgZV4A/BbxuD4=", + "owner": "kristapsdz", + "repo": "lowdown", + "rev": "d2c2b44ff6c27b936ec27358a2653caaef8f73b8", + "type": "github" + }, + "original": { + "owner": "kristapsdz", + "repo": "lowdown", + "type": "github" + } + }, "nix": { "inputs": { "lowdown-src": "lowdown-src", @@ -1419,8 +1969,8 @@ }, "nix2container": { "inputs": { - "flake-utils": "flake-utils_3", - "nixpkgs": "nixpkgs_2" + "flake-utils": "flake-utils_4", + "nixpkgs": "nixpkgs_4" }, "locked": { "lastModified": 1730479402, @@ -1439,7 +1989,7 @@ "nix_2": { "inputs": { "lowdown-src": "lowdown-src_2", - "nixpkgs": "nixpkgs_5", + "nixpkgs": "nixpkgs_3", "nixpkgs-regression": "nixpkgs-regression_2" }, "locked": { @@ -1457,6 +2007,42 @@ "type": "github" } }, + "nix_3": { + "inputs": { + "lowdown-src": "lowdown-src_3", + "nixpkgs": "nixpkgs_7", + "nixpkgs-regression": "nixpkgs-regression_3" + }, + "locked": { + "lastModified": 1661606874, + "narHash": "sha256-9+rpYzI+SmxJn+EbYxjGv68Ucp22bdFUSy/4LkHkkDQ=", + "owner": "NixOS", + "repo": "nix", + "rev": "11e45768b34fdafdcf019ddbd337afa16127ff0f", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "2.11.0", + "repo": "nix", + "type": "github" + } + }, + "nixlib": { + "locked": { + "lastModified": 1667696192, + "narHash": "sha256-hOdbIhnpWvtmVynKcsj10nxz9WROjZja+1wRAJ/C9+s=", + "owner": "nix-community", + "repo": "nixpkgs.lib", + "rev": "babd9cd2ca6e413372ed59fbb1ecc3c3a5fd3e5b", + "type": "github" + }, + "original": { + "owner": "nix-community", + "repo": "nixpkgs.lib", + "type": "github" + } + }, "nixos-unified": { "locked": { "lastModified": 1729549045, @@ -1520,6 +2106,22 @@ "type": "github" } }, + "nixpkgs-2003_3": { + "locked": { + "lastModified": 1620055814, + "narHash": "sha256-8LEHoYSJiL901bTMVatq+rf8y7QtWuZhwwpKE2fyaRY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1db42b7fe3878f3f5f7a4f2dc210772fd080e205", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-20.03-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-2105": { "locked": { "lastModified": 1659914493, @@ -1542,17 +2144,49 @@ "narHash": "sha256-lkA5X3VNMKirvA+SUzvEhfA7XquWLci+CGi505YFAIs=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "022caabb5f2265ad4006c1fa5b1ebe69fb0c3faf", + "rev": "022caabb5f2265ad4006c1fa5b1ebe69fb0c3faf", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2105_3": { + "locked": { + "lastModified": 1659914493, + "narHash": "sha256-lkA5X3VNMKirvA+SUzvEhfA7XquWLci+CGi505YFAIs=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "022caabb5f2265ad4006c1fa5b1ebe69fb0c3faf", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2111": { + "locked": { + "lastModified": 1659446231, + "narHash": "sha256-hekabNdTdgR/iLsgce5TGWmfIDZ86qjPhxDg/8TlzhE=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "eabc38219184cc3e04a974fe31857d8e0eac098d", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixpkgs-21.05-darwin", + "ref": "nixpkgs-21.11-darwin", "repo": "nixpkgs", "type": "github" } }, - "nixpkgs-2111": { + "nixpkgs-2111_2": { "locked": { "lastModified": 1659446231, "narHash": "sha256-hekabNdTdgR/iLsgce5TGWmfIDZ86qjPhxDg/8TlzhE=", @@ -1568,7 +2202,7 @@ "type": "github" } }, - "nixpkgs-2111_2": { + "nixpkgs-2111_3": { "locked": { "lastModified": 1659446231, "narHash": "sha256-hekabNdTdgR/iLsgce5TGWmfIDZ86qjPhxDg/8TlzhE=", @@ -1616,6 +2250,22 @@ "type": "github" } }, + "nixpkgs-2205_3": { + "locked": { + "lastModified": 1685573264, + "narHash": "sha256-Zffu01pONhs/pqH07cjlF10NnMDLok8ix5Uk4rhOnZQ=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "380be19fbd2d9079f677978361792cb25e8a3635", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-22.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-2211": { "locked": { "lastModified": 1688392541, @@ -1648,6 +2298,22 @@ "type": "github" } }, + "nixpkgs-2211_3": { + "locked": { + "lastModified": 1688392541, + "narHash": "sha256-lHrKvEkCPTUO+7tPfjIcb7Trk6k31rz18vkyqmkeJfY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "ea4c80b39be4c09702b0cb3b42eab59e2ba4f24b", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-22.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-2305": { "locked": { "lastModified": 1705033721, @@ -1680,6 +2346,22 @@ "type": "github" } }, + "nixpkgs-2305_3": { + "locked": { + "lastModified": 1705033721, + "narHash": "sha256-K5eJHmL1/kev6WuqyqqbS1cdNnSidIZ3jeqJ7GbrYnQ=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a1982c92d8980a0114372973cbdfe0a307f1bdea", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-23.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-2311": { "locked": { "lastModified": 1719957072, @@ -1712,7 +2394,39 @@ "type": "github" } }, + "nixpkgs-2311_3": { + "locked": { + "lastModified": 1719957072, + "narHash": "sha256-gvFhEf5nszouwLAkT9nWsDzocUTqLWHuL++dvNjMp9I=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "7144d6241f02d171d25fba3edeaf15e0f2592105", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-23.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-2405": { + "locked": { + "lastModified": 1720122915, + "narHash": "sha256-Nby8WWxj0elBu1xuRaUcRjPi/rU3xVbkAt2kj4QwX2U=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "835cf2d3f37989c5db6585a28de967a667a75fb1", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-24.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2405_2": { "locked": { "lastModified": 1729242558, "narHash": "sha256-VgcLDu4igNT0eYua6OAl9pWCI0cYXhDbR+pWP44tte0=", @@ -1728,7 +2442,7 @@ "type": "github" } }, - "nixpkgs-2405_2": { + "nixpkgs-2405_3": { "locked": { "lastModified": 1729242558, "narHash": "sha256-VgcLDu4igNT0eYua6OAl9pWCI0cYXhDbR+pWP44tte0=", @@ -1788,6 +2502,22 @@ "type": "github" } }, + "nixpkgs-regression_3": { + "locked": { + "lastModified": 1643052045, + "narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", + "type": "github" + }, + "original": { + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", + "type": "github" + } + }, "nixpkgs-stable": { "locked": { "lastModified": 1690680713, @@ -1837,6 +2567,22 @@ } }, "nixpkgs-unstable": { + "locked": { + "lastModified": 1720181791, + "narHash": "sha256-i4vJL12/AdyuQuviMMd1Hk2tsGt02hDNhA0Zj1m16N8=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "4284c2b73c8bce4b46a6adf23e16d9e2ec8da4bb", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-unstable_2": { "locked": { "lastModified": 1729980323, "narHash": "sha256-eWPRZAlhf446bKSmzw6x7RWEE4IuZgAp8NW3eXZwRAY=", @@ -1852,7 +2598,7 @@ "type": "github" } }, - "nixpkgs-unstable_2": { + "nixpkgs-unstable_3": { "locked": { "lastModified": 1729980323, "narHash": "sha256-eWPRZAlhf446bKSmzw6x7RWEE4IuZgAp8NW3eXZwRAY=", @@ -1868,7 +2614,55 @@ "type": "github" } }, + "nixpkgs_10": { + "locked": { + "lastModified": 1730768919, + "narHash": "sha256-8AKquNnnSaJRXZxc5YmF/WfmxiHX6MMZZasRP6RRQkE=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a04d33c0c3f1a59a2c1cb0c6e34cd24500e5a1dc", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs_2": { + "locked": { + "lastModified": 1688392541, + "narHash": "sha256-lHrKvEkCPTUO+7tPfjIcb7Trk6k31rz18vkyqmkeJfY=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "ea4c80b39be4c09702b0cb3b42eab59e2ba4f24b", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "release-22.11", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_3": { + "locked": { + "lastModified": 1657693803, + "narHash": "sha256-G++2CJ9u0E7NNTAi9n5G8TdDmGJXcIjkJ3NF8cetQB8=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "365e1b3a859281cf11b94f87231adeabbdd878a2", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-22.05-small", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_4": { "locked": { "lastModified": 1712920918, "narHash": "sha256-1yxFvUcJfUphK9V91KufIQom7gCsztza0H4Rz2VCWUU=", @@ -1883,7 +2677,7 @@ "type": "github" } }, - "nixpkgs_3": { + "nixpkgs_5": { "locked": { "lastModified": 1730768919, "narHash": "sha256-8AKquNnnSaJRXZxc5YmF/WfmxiHX6MMZZasRP6RRQkE=", @@ -1899,7 +2693,7 @@ "type": "github" } }, - "nixpkgs_4": { + "nixpkgs_6": { "locked": { "lastModified": 1712883908, "narHash": "sha256-icE1IJE9fHcbDfJ0+qWoDdcBXUoZCcIJxME4lMHwvSM=", @@ -1915,7 +2709,7 @@ "type": "github" } }, - "nixpkgs_5": { + "nixpkgs_7": { "locked": { "lastModified": 1657693803, "narHash": "sha256-G++2CJ9u0E7NNTAi9n5G8TdDmGJXcIjkJ3NF8cetQB8=", @@ -1931,7 +2725,7 @@ "type": "github" } }, - "nixpkgs_6": { + "nixpkgs_8": { "locked": { "lastModified": 1713714899, "narHash": "sha256-+z/XjO3QJs5rLE5UOf015gdVauVRQd2vZtsFkaXBq2Y=", @@ -1947,7 +2741,7 @@ "type": "github" } }, - "nixpkgs_7": { + "nixpkgs_9": { "locked": { "lastModified": 1731531548, "narHash": "sha256-sz8/v17enkYmfpgeeuyzniGJU0QQBfmAjlemAUYhfy8=", @@ -1962,23 +2756,24 @@ "type": "github" } }, - "nixpkgs_8": { + "old-ghc-nix": { + "flake": false, "locked": { - "lastModified": 1730768919, - "narHash": "sha256-8AKquNnnSaJRXZxc5YmF/WfmxiHX6MMZZasRP6RRQkE=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "a04d33c0c3f1a59a2c1cb0c6e34cd24500e5a1dc", + "lastModified": 1631092763, + "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", + "owner": "angerman", + "repo": "old-ghc-nix", + "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", "type": "github" }, "original": { - "owner": "NixOS", - "ref": "nixpkgs-unstable", - "repo": "nixpkgs", + "owner": "angerman", + "ref": "master", + "repo": "old-ghc-nix", "type": "github" } }, - "old-ghc-nix": { + "old-ghc-nix_2": { "flake": false, "locked": { "lastModified": 1631092763, @@ -1995,7 +2790,7 @@ "type": "github" } }, - "old-ghc-nix_2": { + "old-ghc-nix_3": { "flake": false, "locked": { "lastModified": 1631092763, @@ -2014,13 +2809,13 @@ }, "plutarch": { "inputs": { - "CHaP": "CHaP_2", + "CHaP": "CHaP_3", "emanote": "emanote", "flake-parts": "flake-parts_2", "haskell-nix": "haskell-nix_2", "hercules-ci-effects": "hercules-ci-effects", "iohk-nix": "iohk-nix_2", - "nixpkgs": "nixpkgs_7", + "nixpkgs": "nixpkgs_9", "pre-commit-hooks": "pre-commit-hooks" }, "locked": { @@ -2040,9 +2835,9 @@ }, "pre-commit-hooks": { "inputs": { - "flake-compat": "flake-compat_5", + "flake-compat": "flake-compat_6", "gitignore": "gitignore_2", - "nixpkgs": "nixpkgs_8", + "nixpkgs": "nixpkgs_10", "nixpkgs-stable": "nixpkgs-stable_3" }, "locked": { @@ -2061,9 +2856,9 @@ }, "pre-commit-hooks-nix": { "inputs": { - "flake-compat": "flake-compat_3", + "flake-compat": "flake-compat_4", "gitignore": "gitignore", - "nixpkgs": "nixpkgs_3", + "nixpkgs": "nixpkgs_5", "nixpkgs-stable": "nixpkgs-stable_2" }, "locked": { @@ -2083,7 +2878,8 @@ "root": { "inputs": { "CHaP": "CHaP", - "hackage": "hackage", + "cardano-cli": "cardano-cli", + "hackage": "hackage_2", "haskell-nix": "haskell-nix", "iogx": "iogx", "nixpkgs": [ @@ -2127,6 +2923,23 @@ "type": "github" } }, + "secp256k1_3": { + "flake": false, + "locked": { + "lastModified": 1683999695, + "narHash": "sha256-9nJJVENMXjXEJZzw8DHzin1DkFkF8h9m/c6PuM7Uk4s=", + "owner": "bitcoin-core", + "repo": "secp256k1", + "rev": "acf5c55ae6a94e5ca847e07def40427547876101", + "type": "github" + }, + "original": { + "owner": "bitcoin-core", + "ref": "v0.3.2", + "repo": "secp256k1", + "type": "github" + } + }, "sodium": { "flake": false, "locked": { @@ -2161,6 +2974,23 @@ "type": "github" } }, + "sodium_3": { + "flake": false, + "locked": { + "lastModified": 1675156279, + "narHash": "sha256-0uRcN5gvMwO7MCXVYnoqG/OmeBFi8qRVnDWJLnBb9+Y=", + "owner": "input-output-hk", + "repo": "libsodium", + "rev": "dbb48cce5429cb6585c9034f002568964f1ce567", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "libsodium", + "rev": "dbb48cce5429cb6585c9034f002568964f1ce567", + "type": "github" + } + }, "sphinxcontrib-haddock": { "flake": false, "locked": { @@ -2178,6 +3008,22 @@ } }, "stackage": { + "flake": false, + "locked": { + "lastModified": 1726445918, + "narHash": "sha256-M34goAxhRqzDaVXqUo8lLnjZpppJYpr26c+X1Lhj5hU=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "8299f8d17eef21ec8365536ee9705ff66a3504f3", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "stackage_2": { "flake": false, "locked": { "lastModified": 1734307971, @@ -2193,7 +3039,7 @@ "type": "github" } }, - "stackage_2": { + "stackage_3": { "flake": false, "locked": { "lastModified": 1731456685, @@ -2254,6 +3100,21 @@ "type": "github" } }, + "systems_4": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + }, "treefmt-nix": { "inputs": { "nixpkgs": [ diff --git a/flake.nix b/flake.nix index 188b08d..567c840 100644 --- a/flake.nix +++ b/flake.nix @@ -33,6 +33,12 @@ plutarch = { url = "github:colll78/plutarch-plutus/b2379767c7f1c70acf28206bf922f128adc02f28"; }; + + # Must use a version compatible with the pinned `cardano-node` version. + # Check release notes of `cardano-node` version for correct `cardano-cli` version. + cardano-cli = { + url = "github:intersectmbo/cardano-cli?ref=cardano-cli-10.1.0.0"; + }; }; outputs = inputs: inputs.iogx.lib.mkFlake { diff --git a/nix/project.nix b/nix/project.nix index ae9198e..b724edc 100644 --- a/nix/project.nix +++ b/nix/project.nix @@ -2,7 +2,8 @@ let sha256map = { - "https://github.com/j-mueller/sc-tools"."e2759559324e172f12b11ab815323c48ed8922b0" = "sha256-NHX+Euys+jBwKdTRJhK4XZLOOxQ+lf45T0BOroMF1m4="; + # "https://github.com/j-mueller/sc-tools"."dbff9d50478fbce9ee5c718f0536f4183685edd9" = "sha256-b47wr0xuUZohxPnL3Zi6iAYhkY0K7NFHpsv8TXr9LHM="; + "https://github.com/amirmrad/sc-tools"."6c63efe07015e87719d77fa3fabfe07f959c7227" = "sha256-f1qpkjL0YgK2/k8M1BgFYT7bcE14sm0qucbqRjtCbU8="; "https://github.com/colll78/plutarch-plutus"."b2379767c7f1c70acf28206bf922f128adc02f28" = "sha256-mhuW2CHxnc6FDWuMcjW/51PKuPOdYc4yxz+W5RmlQew="; "https://github.com/input-output-hk/catalyst-onchain-libs"."650a3435f8efbd4bf36e58768fac266ba5beede4" = "sha256-NUh+l97+eO27Ppd8Bx0yMl0E5EV+p7+7GuFun1B8gRc="; }; diff --git a/nix/shell.nix b/nix/shell.nix index badcff7..783901f 100644 --- a/nix/shell.nix +++ b/nix/shell.nix @@ -4,12 +4,14 @@ cabalProject: let plutarch = inputs.plutarch.packages.plutarch; + cardano-cli = inputs.cardano-cli.legacyPackages.cardano-cli; in { name = "smart-tokens-plutarch"; packages = [ pkgs.ghcid pkgs.nixpkgs-fmt + cardano-cli ]; env = { }; diff --git a/src/lib/SmartTokens/Types/ProtocolParams.hs b/src/lib/SmartTokens/Types/ProtocolParams.hs index bdc8dbb..c5a9332 100644 --- a/src/lib/SmartTokens/Types/ProtocolParams.hs +++ b/src/lib/SmartTokens/Types/ProtocolParams.hs @@ -2,7 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-deferred-type-errors #-} -{-# LANGUAGE InstanceSigs #-} module SmartTokens.Types.ProtocolParams ( ProgrammableLogicGlobalParams (..), diff --git a/src/lib/Wst/Cli.hs b/src/lib/Wst/Cli.hs index aa7db85..8160376 100644 --- a/src/lib/Wst/Cli.hs +++ b/src/lib/Wst/Cli.hs @@ -1,21 +1,36 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Move brackets to avoid $" #-} module Wst.Cli(runMain) where -import Blammo.Logging.Simple (Message ((:#)), MonadLogger, logError, logInfo, - runLoggerLoggingT, (.=)) +import Blammo.Logging.Simple (Message ((:#)), MonadLogger, logDebug, logError, + logInfo, runLoggerLoggingT, (.=)) +import Cardano.Api qualified as C +import Control.Monad.Except (ExceptT (..), MonadError, liftEither, throwError) import Control.Monad.IO.Class (MonadIO (..)) -import Convex.Wallet.Operator (OperatorConfigSigning) +import Control.Monad.Reader (MonadReader, ask, asks) +import Convex.Blockfrost (evalBlockfrostT, runBlockfrostT) +import Convex.Blockfrost.MonadBlockchain (sendTxBlockfrost) +import Convex.Class (MonadBlockchain (sendTx), MonadUtxoQuery) +import Convex.Wallet.Operator (Operator (Operator, oPaymentKey), + OperatorConfigSigning, + PaymentExtendedKey (PESigningEx), + operatorPaymentCredential, signTxOperator, + verificationKey) import Convex.Wallet.Operator qualified as Operator import Data.Functor.Identity (Identity) -import Data.Proxy (Proxy) +import Data.Proxy (Proxy (Proxy)) import Data.String (IsString (..)) import Options.Applicative (customExecParser, disambiguate, helper, idm, info, prefs, showHelpOnEmpty, showHelpOnError) import SmartTokens.Core.Scripts (ScriptTarget (Production)) import Wst.App (runWstApp) +import Wst.AppError (AppError) import Wst.Cli.Command (Command (..), ManageCommand (StartServer, Status), parseCommand) +import Wst.Offchain.Endpoints.Deployment qualified as Endpoints +import Wst.Offchain.Env (addOperatorEnv) import Wst.Offchain.Env qualified as Env import Wst.Server (ServerArgs (..)) import Wst.Server qualified as Server @@ -43,16 +58,41 @@ runCommand com = do Left err -> runLoggerLoggingT env $ logError (fromString $ show err) Right a -> pure a -deploy :: (MonadLogger m, MonadIO m) => OperatorConfigSigning -> m () +deploy :: forall env m. (MonadLogger m, MonadIO m, MonadUtxoQuery m, MonadReader env m, Env.HasRuntimeEnv env, MonadError (AppError C.ConwayEra) m, MonadBlockchain C.ConwayEra m) => OperatorConfigSigning -> m () deploy config = do logInfo $ "Loading operator files" :# ["key_file" .= Operator.ocSigningKeyFile config] - _operator <- liftIO (Operator.loadOperatorFiles config) - -- TODO: + + -- FIXME: why does this throw? + -- _operator <- liftIO (Operator.loadOperatorFiles config) + + signingKey <- liftIO + $ C.readFileTextEnvelope (C.proxyToAsType $ Proxy @(C.SigningKey C.PaymentExtendedKey)) (C.File $ Operator.ocSigningKeyFile config) + >>= either (error . show) pure + + let operator = Operator (PESigningEx signingKey) Nothing + operatorPaymentHash = C.verificationKeyHash . verificationKey . oPaymentKey $ operator + + opEnv <- Env.loadOperatorEnv @_ @C.ConwayEra operatorPaymentHash C.NoStakeAddress + runEnv <- asks Env.runtimeEnv + + let env = Env.addOperatorEnv opEnv $ Env.addRuntimeEnv runEnv Env.empty + -- Use blockfrost backend to run Wst.Offchain.Endpoints.Deployment with the operator's funds + (tx, root) <- liftIO (runWstApp env $ do + Endpoints.deployFullTx Production) >>= liftEither + + logInfo $ "Created deployment Tx" :# ["root" .= root] + -- Then use operator key to sign + let signedTx = signTxOperator operator tx + logDebug $ "Signed Deployment Tx" :# ["tx" .= show tx] + -- Then submit transaction to blockfrost - -- Convex.Blockfrost.runBLockfrostT for the monadblockchain / monadutxoquery effects - pure () + sendTx signedTx >>= \case + Left err -> logError $ "Error sending Tx" :# ["err" .= show err] + Right txid -> do + logInfo $ "Tx submitted successfully" :# ["txid" .= show txid] + (liftIO $ C.writeFileJSON "deployment-root.json" root) >>= either (error . show) pure startServer :: (MonadIO m, MonadLogger m) => Env.CombinedEnv Proxy Identity Proxy Identity w -> Server.ServerArgs -> m () startServer env' serverArgs@ServerArgs{saPort} = do diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index 41ce163..3ce6681 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -3,7 +3,7 @@ -} module Wst.Offchain.Endpoints.Deployment( deployTx, - deployTxAll, + deployFullTx, deployBlacklistTx, insertNodeTx, issueProgrammableTokenTx, @@ -49,14 +49,17 @@ deployTx target = do let root = DirectoryScriptRoot txi target (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withDirectoryFor root $ Env.balanceTxEnv_ - $ BuildTx.mintProtocolParams >> BuildTx.initDirectorySet + $ BuildTx.mintProtocolParams + >> BuildTx.initDirectorySet + >> BuildTx.registerProgrammableGlobalScript pure (Convex.CoinSelection.signBalancedTxBody [] tx, root) -{-| Build a transaction that deploys the directory and global params. Returns the +{-| Build a transaction that deploys the directory and global params as well as +the relevant stablecoin transfer logic scripts and registrations. Returns the transaction and the 'TxIn' that was selected for the one-shot NFTs. -} -deployTxAll :: (MonadReader env m, Env.HasOperatorEnv era env, MonadBlockchain era m, MonadError (AppError era) m, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era) => ScriptTarget -> m (C.Tx era, DirectoryScriptRoot) -deployTxAll target = do +deployFullTx :: (MonadReader env m, Env.HasOperatorEnv era env, MonadBlockchain era m, MonadError (AppError era) m, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era) => ScriptTarget -> m (C.Tx era, DirectoryScriptRoot) +deployFullTx target = do (txi, _) <- Env.selectOperatorOutput opEnv <- asks Env.operatorEnv let root = DirectoryScriptRoot txi target diff --git a/src/lib/Wst/Offchain/Env.hs b/src/lib/Wst/Offchain/Env.hs index cb96081..0bf95b4 100644 --- a/src/lib/Wst/Offchain/Env.hs +++ b/src/lib/Wst/Offchain/Env.hs @@ -92,12 +92,14 @@ import Convex.Utils (mapError) import Convex.Utxos (BalanceChanges) import Convex.Utxos qualified as Utxos import Convex.Wallet.Operator (returnOutputFor) +import Data.Aeson (FromJSON, ToJSON) import Data.Either (fromRight) import Data.Functor.Identity (Identity (..)) import Data.Map qualified as Map import Data.Maybe (listToMaybe) import Data.Proxy (Proxy (..)) import Data.Text qualified as Text +import GHC.Generics (Generic) import SmartTokens.Core.Scripts (ScriptTarget) import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams (..)) import System.Environment qualified @@ -191,6 +193,8 @@ data DirectoryScriptRoot = { srTxIn :: C.TxIn , srTarget :: ScriptTarget } + deriving (Show, Generic) + deriving anyclass (ToJSON, FromJSON) class HasDirectoryEnv e where directoryEnv :: e -> DirectoryEnv diff --git a/src/lib/Wst/Server.hs b/src/lib/Wst/Server.hs index 35b3c39..91994f9 100644 --- a/src/lib/Wst/Server.hs +++ b/src/lib/Wst/Server.hs @@ -15,6 +15,7 @@ import Control.Monad.Except (MonadError) import Control.Monad.Reader (MonadReader, asks) import Convex.CardanoApi.Lenses qualified as L import Convex.Class (MonadBlockchain, MonadUtxoQuery) +import Convex.CoinSelection qualified import Data.Data (Proxy (..)) import Network.Wai.Handler.Warp qualified as Warp import PlutusTx.Prelude qualified as P @@ -133,11 +134,13 @@ issueProgrammableTokenEndpoint :: forall era env m. ) => IssueProgrammableTokenArgs -> m (TextEnvelopeJSON (C.Tx era)) issueProgrammableTokenEndpoint IssueProgrammableTokenArgs{itaAssetName, itaQuantity, itaIssuer} = do + let C.ShelleyAddress _network cred _stake = itaIssuer + destinationCredential = C.fromShelleyPaymentCredential cred operatorEnv <- Env.loadOperatorEnvFromAddress itaIssuer dirEnv <- asks Env.directoryEnv logic <- Env.transferLogicForDirectory (paymentKeyHashFromAddress itaIssuer) Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer logic $ do - TextEnvelopeJSON <$> Endpoints.issueProgrammableTokenTx itaAssetName itaQuantity + TextEnvelopeJSON . fst <$> Endpoints.issueSmartTokensTx itaAssetName itaQuantity destinationCredential paymentCredentialFromAddress :: C.Address C.ShelleyAddr -> C.PaymentCredential paymentCredentialFromAddress = \case diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index bacdad4..6b7e690 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -28,7 +28,6 @@ import Convex.Wallet.Operator (signTxOperator) import Convex.Wallet.Operator qualified as Operator import Data.List (isPrefixOf) import Data.String (IsString (..)) -import Debug.Trace (traceM) import GHC.Exception (SomeException, throw) import SmartTokens.Core.Scripts (ScriptTarget (Debug, Production)) import Test.Tasty (TestTree, testGroup) @@ -68,9 +67,8 @@ deployAll :: (MonadReader ScriptTarget m, MonadUtxoQuery m, MonadBlockchain C.Co deployAll = do target <- ask failOnError $ Env.withEnv $ asAdmin @C.ConwayEra $ do - (tx, scriptRoot) <- Endpoints.deployTxAll target + (tx, scriptRoot) <- Endpoints.deployFullTx target void $ sendTx $ signTxOperator admin tx - traceM $ show tx Env.withDirectoryFor scriptRoot $ do Query.registryNodes @C.ConwayEra >>= void . expectSingleton "registry output" @@ -271,7 +269,6 @@ registerTransferScripts :: (MonadFail m, MonadReader env m, Env.HasDirectoryEnv registerTransferScripts pkh = failOnError $ do transferMintingScript <- asks (Env.tleMintingScript . Env.transferLogicEnv) transferSpendingScript <- asks (Env.tleTransferScript . Env.transferLogicEnv) - transferGlobalScript <- asks (Env.dsProgrammableLogicGlobalScript . Env.directoryEnv) let hshMinting = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferMintingScript credMinting = C.StakeCredentialByScript hshMinting @@ -279,9 +276,6 @@ registerTransferScripts pkh = failOnError $ do hshSpending = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferSpendingScript credSpending = C.StakeCredentialByScript hshSpending - hshGlobal = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferGlobalScript - credGlobal = C.StakeCredentialByScript hshGlobal - txBody <- BuildTx.execBuildTxT $ do -- pp <- fmap C.unLedgerProtocolParameters queryProtocolParameters -- BuildTx.addStakeScriptWitness credMinting transferMintingScript () @@ -289,7 +283,6 @@ registerTransferScripts pkh = failOnError $ do addConwayStakeCredentialCertificate credSpending addConwayStakeCredentialCertificate credMinting - addConwayStakeCredentialCertificate credGlobal BuildTx.addRequiredSignature pkh From 242ce178d8f7339cdfcd4ec99db61a205c04d424 Mon Sep 17 00:00:00 2001 From: Amir Rad Date: Fri, 10 Jan 2025 16:27:45 +0000 Subject: [PATCH 15/22] Add vkey-witness and submit endpoints --- src/lib/Wst/App.hs | 2 +- src/lib/Wst/AppError.hs | 2 ++ src/lib/Wst/Client.hs | 9 +++++---- src/lib/Wst/Offchain/Query.hs | 2 +- src/lib/Wst/Server.hs | 31 ++++++++++++++++++++++++++----- src/lib/Wst/Server/Types.hs | 22 ++++++++++++++++++++++ 6 files changed, 57 insertions(+), 11 deletions(-) diff --git a/src/lib/Wst/App.hs b/src/lib/Wst/App.hs index 256581e..480ab83 100644 --- a/src/lib/Wst/App.hs +++ b/src/lib/Wst/App.hs @@ -36,7 +36,7 @@ runWstApp env WstApp{unWstApp} = do {-| Interpret the 'WstApp' in a servant handler -} -runWstAppServant :: forall env era a. (Env.HasRuntimeEnv env) => env -> WstApp env era a -> Handler a +runWstAppServant :: forall env era a. (C.IsAlonzoBasedEra era, Env.HasRuntimeEnv env) => env -> WstApp env era a -> Handler a runWstAppServant env action = liftIO (runWstApp env action) >>= \case Left err -> do let err_ = S.err500 { S.errBody = fromString (show err) } diff --git a/src/lib/Wst/AppError.hs b/src/lib/Wst/AppError.hs index 1779451..c2f80ff 100644 --- a/src/lib/Wst/AppError.hs +++ b/src/lib/Wst/AppError.hs @@ -5,6 +5,7 @@ module Wst.AppError( ) where import Blockfrost.Client.Core (BlockfrostError) +import Convex.Class (ValidationError) import Convex.CoinSelection qualified as CoinSelection import PlutusLedgerApi.Data.V3 (Credential) @@ -14,4 +15,5 @@ data AppError era = | BalancingError (CoinSelection.BalanceTxError era) | BlockfrostErr BlockfrostError | TransferBlacklistedCredential Credential -- ^ Attempting to transfer funds from a blacklisted address + | SubmitError (ValidationError era) deriving stock (Show) diff --git a/src/lib/Wst/Client.hs b/src/lib/Wst/Client.hs index 2d1ca45..8569548 100644 --- a/src/lib/Wst/Client.hs +++ b/src/lib/Wst/Client.hs @@ -38,20 +38,21 @@ getGlobalParams env = do postIssueProgrammableTokenTx :: forall era. C.IsShelleyBasedEra era => ClientEnv -> IssueProgrammableTokenArgs -> IO (Either ClientError (TextEnvelopeJSON (C.Tx era))) postIssueProgrammableTokenTx env args = do - let _ :<|> _ :<|> (issueProgrammableTokenTx :<|> _) = client (Proxy @(API era)) + let _ :<|> _ :<|> ((issueProgrammableTokenTx :<|> _) :<|> _) = client (Proxy @(API era)) runClientM (issueProgrammableTokenTx args) env postTransferProgrammableTokenTx :: forall era. C.IsShelleyBasedEra era => ClientEnv -> TransferProgrammableTokenArgs -> IO (Either ClientError (TextEnvelopeJSON (C.Tx era))) postTransferProgrammableTokenTx env args = do - let _ :<|> _ :<|> (_ :<|> transferProgrammableTokenTx :<|> _) = client (Proxy @(API era)) + let _ :<|> _ :<|> ((_ :<|> transferProgrammableTokenTx :<|> _) :<|> _) = client (Proxy @(API era)) runClientM (transferProgrammableTokenTx args) env postAddToBlacklistTx :: forall era. C.IsShelleyBasedEra era => ClientEnv -> AddToBlacklistArgs -> IO (Either ClientError (TextEnvelopeJSON (C.Tx era))) postAddToBlacklistTx env args = do - let _ :<|> _ :<|> (_ :<|> _ :<|> addToBlacklistTx :<|> _) = client (Proxy @(API era)) + let _ :<|> _ :<|> ((_ :<|> _ :<|> addToBlacklistTx :<|> _) :<|> _) = client (Proxy @(API era)) runClientM (addToBlacklistTx args) env postSeizeFundsTx :: forall era. C.IsShelleyBasedEra era => ClientEnv -> SeizeAssetsArgs -> IO (Either ClientError (TextEnvelopeJSON (C.Tx era))) postSeizeFundsTx env args = do - let _ :<|> _ :<|> (_ :<|> _ :<|> _ :<|> seizeFunds) = client (Proxy @(API era)) + let _ :<|> _ :<|> ((_ :<|> _ :<|> _ :<|> seizeFunds) :<|> _) = client (Proxy @(API era)) runClientM (seizeFunds args) env + diff --git a/src/lib/Wst/Offchain/Query.hs b/src/lib/Wst/Offchain/Query.hs index 4347e60..440d5c6 100644 --- a/src/lib/Wst/Offchain/Query.hs +++ b/src/lib/Wst/Offchain/Query.hs @@ -61,7 +61,7 @@ data UTxODat era a = -- | Aeson options for the UTxODat type. Used to derive JSON instances and ToSchema utxoDatOptions :: JSON.Options -utxoDatOptions = JSON.customJsonOptions 2 +utxoDatOptions = JSON.customJsonOptions 1 instance (C.IsCardanoEra era, ToJSON a) => ToJSON (UTxODat era a) where toJSON = JSON.genericToJSON utxoDatOptions diff --git a/src/lib/Wst/Server.hs b/src/lib/Wst/Server.hs index 2238209..a7a9feb 100644 --- a/src/lib/Wst/Server.hs +++ b/src/lib/Wst/Server.hs @@ -12,12 +12,13 @@ module Wst.Server( import Cardano.Api.Shelley qualified as C import Control.Lens qualified as L +import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.Except (MonadError) import Control.Monad.Reader (MonadReader, asks) import Convex.CardanoApi.Lenses qualified as L -import Convex.Class (MonadBlockchain, MonadUtxoQuery) -import Convex.CoinSelection qualified +import Convex.Class (MonadBlockchain (sendTx), MonadUtxoQuery) import Data.Data (Proxy (..)) +import Data.List (nub) import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Middleware.Cors import PlutusTx.Prelude qualified as P @@ -27,12 +28,13 @@ import Servant.Server (hoistServer, serve) import Servant.Server.StaticFiles (serveDirectoryWebApp) import SmartTokens.Types.PTokenDirectory (blnKey) import Wst.App (WstApp, runWstAppServant) -import Wst.AppError (AppError) +import Wst.AppError (AppError (..)) import Wst.Offchain.Endpoints.Deployment qualified as Endpoints import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (uDatum)) import Wst.Offchain.Query qualified as Query -import Wst.Server.Types (APIInEra, AddToBlacklistArgs (..), BuildTxAPI, +import Wst.Server.Types (APIInEra, AddToBlacklistArgs (..), + AddVKeyWitnessArgs (..), BuildTxAPI, IssueProgrammableTokenArgs (..), QueryAPI, SeizeAssetsArgs (..), SerialiseAddress (..), TextEnvelopeJSON (..), @@ -85,10 +87,14 @@ queryApi = txApi :: forall env. (Env.HasDirectoryEnv env) => ServerT (BuildTxAPI C.ConwayEra) (WstApp env C.ConwayEra) txApi = - issueProgrammableTokenEndpoint @C.ConwayEra @env + (issueProgrammableTokenEndpoint @C.ConwayEra @env :<|> transferProgrammableTokenEndpoint @C.ConwayEra @env :<|> addToBlacklistEndpoint :<|> seizeAssetsEndpoint + ) + :<|> pure . addWitnessEndpoint + :<|> submitTxEndpoint + computeUserAddress :: forall era env m. ( MonadReader env m @@ -234,3 +240,18 @@ seizeAssetsEndpoint SeizeAssetsArgs{saIssuer, saTarget} = do transferLogic <- Env.transferLogicForDirectory (paymentKeyHashFromAddress saIssuer) Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer transferLogic $ do TextEnvelopeJSON <$> Endpoints.seizeCredentialAssetsTx badCred + +addWitnessEndpoint :: forall era. AddVKeyWitnessArgs era -> TextEnvelopeJSON (C.Tx era) +addWitnessEndpoint AddVKeyWitnessArgs{avwTx, avwVKeyWitness} = + let C.Tx txBody txWits = unTextEnvelopeJSON avwTx + vkey = unTextEnvelopeJSON avwVKeyWitness + x = C.makeSignedTransaction (nub $ vkey : txWits) txBody + in TextEnvelopeJSON x + +submitTxEndpoint :: forall era m. + ( MonadBlockchain era m + , MonadError (AppError era) m + ) + => TextEnvelopeJSON (C.Tx era) -> m C.TxId +submitTxEndpoint (TextEnvelopeJSON tx) = do + either (throwError . SubmitError) pure =<< sendTx tx diff --git a/src/lib/Wst/Server/Types.hs b/src/lib/Wst/Server/Types.hs index b145cb2..c6d2300 100644 --- a/src/lib/Wst/Server/Types.hs +++ b/src/lib/Wst/Server/Types.hs @@ -19,6 +19,7 @@ module Wst.Server.Types ( TransferProgrammableTokenArgs(..), AddToBlacklistArgs(..), SeizeAssetsArgs(..), + AddVKeyWitnessArgs(..), -- * Newtypes TextEnvelopeJSON(..), @@ -180,6 +181,23 @@ instance FromJSON SeizeAssetsArgs where instance ToSchema SeizeAssetsArgs where declareNamedSchema = Schema.genericDeclareNamedSchema (SchemaOptions.fromAesonOptions jsonOptions2) +data AddVKeyWitnessArgs era = + AddVKeyWitnessArgs + { avwTx :: TextEnvelopeJSON (C.Tx era) + , avwVKeyWitness :: TextEnvelopeJSON (C.KeyWitness era) + } + deriving stock (Generic) + +instance C.IsShelleyBasedEra era => ToJSON (AddVKeyWitnessArgs era) where + toJSON = JSON.genericToJSON jsonOptions3 + toEncoding = JSON.genericToEncoding jsonOptions3 + +instance C.IsShelleyBasedEra era => FromJSON (AddVKeyWitnessArgs era) where + parseJSON = JSON.genericParseJSON jsonOptions3 + +instance C.IsShelleyBasedEra era => ToSchema (AddVKeyWitnessArgs era) where + declareNamedSchema = Schema.genericDeclareNamedSchema (SchemaOptions.fromAesonOptions jsonOptions2) + type BuildTxAPI era = "programmable-token" :> ( "issue" :> Description "Create some programmable tokens" :> ReqBody '[JSON] IssueProgrammableTokenArgs :> Post '[JSON] (TextEnvelopeJSON (C.Tx era)) @@ -187,3 +205,7 @@ type BuildTxAPI era = :<|> "blacklist" :> Description "Add a credential to the blacklist" :> ReqBody '[JSON] AddToBlacklistArgs :> Post '[JSON] (TextEnvelopeJSON (C.Tx era)) :<|> "seize" :> Description "Seize a user's funds" :> ReqBody '[JSON] SeizeAssetsArgs :> Post '[JSON] (TextEnvelopeJSON (C.Tx era)) ) + :<|> + "add-vkey-witness" :> Description "Add a VKey witness to a transaction" :> ReqBody '[JSON] (AddVKeyWitnessArgs era) :> Post '[JSON] (TextEnvelopeJSON (C.Tx era)) + :<|> + "submit" :> Description "Submit a transaction to the blockchain" :> ReqBody '[JSON] (TextEnvelopeJSON (C.Tx era)) :> Post '[JSON] C.TxId From 69559e34f5157989f0d70590be28dcab49d82689 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Mon, 13 Jan 2025 20:39:40 +0100 Subject: [PATCH 16/22] Include CA root certificates (#62) --- nix/containers.nix | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/nix/containers.nix b/nix/containers.nix index d1ffd04..6878031 100644 --- a/nix/containers.nix +++ b/nix/containers.nix @@ -54,6 +54,10 @@ in rec { (inputs.n2c.packages.nix2container.buildLayer { copyToRoot = [frontend]; }) + # CA certificates for SSL (required for calling blockfrost API) + (inputs.n2c.packages.nix2container.buildLayer { + copyToRoot = [pkgs.dockerTools.caCertificates]; + }) ]; }; From 6f53e3c7b7788e17add982c53271239686476629 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Mon, 13 Jan 2025 20:46:36 +0100 Subject: [PATCH 17/22] Fix build --- src/lib/Wst/Cli.hs | 10 +++------- src/lib/Wst/Orphans.hs | 5 +++++ src/lib/Wst/Server.hs | 1 - src/test/lib/Wst/Test/MockServer.hs | 9 ++++++--- src/test/unit/Wst/Test/UnitTest.hs | 4 +--- src/wst-poc.cabal | 3 +-- 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/lib/Wst/Cli.hs b/src/lib/Wst/Cli.hs index ce26a7b..d96a69f 100644 --- a/src/lib/Wst/Cli.hs +++ b/src/lib/Wst/Cli.hs @@ -7,16 +7,13 @@ module Wst.Cli(runMain) where import Blammo.Logging.Simple (Message ((:#)), MonadLogger, logDebug, logError, logInfo, runLoggerLoggingT, (.=)) import Cardano.Api qualified as C -import Control.Monad.Except (ExceptT (..), MonadError, liftEither, throwError) +import Control.Monad.Except (MonadError, liftEither) import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Reader (MonadReader, ask, asks) -import Convex.Blockfrost (evalBlockfrostT, runBlockfrostT) -import Convex.Blockfrost.MonadBlockchain (sendTxBlockfrost) +import Control.Monad.Reader (MonadReader, asks) import Convex.Class (MonadBlockchain (sendTx), MonadUtxoQuery) import Convex.Wallet.Operator (Operator (Operator, oPaymentKey), OperatorConfigSigning, - PaymentExtendedKey (PESigningEx), - operatorPaymentCredential, signTxOperator, + PaymentExtendedKey (PESigningEx), signTxOperator, verificationKey) import Convex.Wallet.Operator qualified as Operator import Data.Functor.Identity (Identity) @@ -31,7 +28,6 @@ import Wst.AppError (AppError) import Wst.Cli.Command (Command (..), ManageCommand (StartServer, Status), parseCommand) import Wst.Offchain.Endpoints.Deployment qualified as Endpoints -import Wst.Offchain.Env (addOperatorEnv) import Wst.Offchain.Env qualified as Env import Wst.Server (ServerArgs (..)) import Wst.Server qualified as Server diff --git a/src/lib/Wst/Orphans.hs b/src/lib/Wst/Orphans.hs index 73ffbab..aac89a2 100644 --- a/src/lib/Wst/Orphans.hs +++ b/src/lib/Wst/Orphans.hs @@ -105,3 +105,8 @@ instance ToSchema C.Quantity where $ mempty & L.type_ ?~ OpenApiInteger +instance ToSchema C.TxId where + declareNamedSchema _ = pure + $ NamedSchema (Just "TxId") + $ mempty + & L.type_ ?~ OpenApiString diff --git a/src/lib/Wst/Server.hs b/src/lib/Wst/Server.hs index a7a9feb..3dd87a8 100644 --- a/src/lib/Wst/Server.hs +++ b/src/lib/Wst/Server.hs @@ -13,7 +13,6 @@ module Wst.Server( import Cardano.Api.Shelley qualified as C import Control.Lens qualified as L import Control.Monad.Error.Class (MonadError (throwError)) -import Control.Monad.Except (MonadError) import Control.Monad.Reader (MonadReader, asks) import Convex.CardanoApi.Lenses qualified as L import Convex.Class (MonadBlockchain (sendTx), MonadUtxoQuery) diff --git a/src/test/lib/Wst/Test/MockServer.hs b/src/test/lib/Wst/Test/MockServer.hs index 4115d82..12aaf10 100644 --- a/src/test/lib/Wst/Test/MockServer.hs +++ b/src/test/lib/Wst/Test/MockServer.hs @@ -10,9 +10,10 @@ import Control.Monad.IO.Class (MonadIO (..)) import Data.Proxy (Proxy (..)) import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Middleware.Cors -import Servant (Server) +import Servant (Server, throwError) import Servant.API (NoContent (..), (:<|>) (..)) import Servant.Server (serve) +import Servant.Server qualified as Server import Test.Gen.Cardano.Api.Typed qualified as Gen import Test.QuickCheck qualified as QC import Test.QuickCheck.Gen qualified as Gen @@ -39,10 +40,12 @@ genTx = liftIO $ fmap TextEnvelopeJSON $ QC.generate $ hedgehog $ Gen.genTx C.sh mockTxApi :: Server (BuildTxAPI C.ConwayEra) mockTxApi = - const genTx - :<|> const genTx + (const genTx :<|> const genTx :<|> const genTx + :<|> const genTx) + :<|> const (throwError Server.err501) + :<|> const (throwError Server.err501) -- | Start the mock server runMockServer :: IO () diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index 6404ef6..24a5c18 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -7,11 +7,9 @@ import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C import Cardano.Ledger.Api qualified as Ledger import Cardano.Ledger.Plutus.ExUnits (ExUnits (..)) -import Cardano.Ledger.Shelley.TxCert qualified as TxCert import Control.Lens ((%~), (&), (^.)) import Control.Monad (void) import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT), asks) -import Convex.BuildTx (MonadBuildTx, addCertificate) import Convex.BuildTx qualified as BuildTx import Convex.Class (MonadBlockchain (queryProtocolParameters, sendTx), MonadMockchain, MonadUtxoQuery) @@ -265,7 +263,7 @@ registerAlwaysSucceedsStakingCert = failOnError $ do void (tryBalanceAndSubmit mempty Wallet.w1 txBody TrailingChange []) -- TODO: registration to be moved to the endpoints -registerTransferScripts :: (MonadFail m, MonadReader env m, Env.HasDirectoryEnv env, Env.HasTransferLogicEnv env, MonadMockchain C.ConwayEra m) => C.Hash C.PaymentKey -> m C.TxId +registerTransferScripts :: (MonadFail m, MonadReader env m, Env.HasTransferLogicEnv env, MonadMockchain C.ConwayEra m) => C.Hash C.PaymentKey -> m C.TxId registerTransferScripts pkh = failOnError $ do transferMintingScript <- asks (Env.tleMintingScript . Env.transferLogicEnv) transferSpendingScript <- asks (Env.tleTransferScript . Env.transferLogicEnv) diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index 7d31c18..f2ce639 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -182,11 +182,10 @@ test-suite wst-poc-test Wst.Test.UnitTest build-depends: - , base >=4.14.0 + , base >=4.14.0 , cardano-api , cardano-ledger-api , cardano-ledger-core - , cardano-ledger-shelley , convex-base , convex-coin-selection , convex-mockchain From 8453053bb8a9b162f36ca1d4973ecc9a7ebedb78 Mon Sep 17 00:00:00 2001 From: Amir Rad Date: Tue, 14 Jan 2025 09:34:13 +0000 Subject: [PATCH 18/22] Review comments --- src/lib/Wst/Offchain/BuildTx/Common.hs | 1 - src/test/unit/Wst/Test/UnitTest.hs | 3 --- 2 files changed, 4 deletions(-) delete mode 100644 src/lib/Wst/Offchain/BuildTx/Common.hs diff --git a/src/lib/Wst/Offchain/BuildTx/Common.hs b/src/lib/Wst/Offchain/BuildTx/Common.hs deleted file mode 100644 index 8b13789..0000000 --- a/src/lib/Wst/Offchain/BuildTx/Common.hs +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index 24a5c18..55fb245 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -275,9 +275,6 @@ registerTransferScripts pkh = failOnError $ do credSpending = C.StakeCredentialByScript hshSpending txBody <- BuildTx.execBuildTxT $ do - -- pp <- fmap C.unLedgerProtocolParameters queryProtocolParameters - -- BuildTx.addStakeScriptWitness credMinting transferMintingScript () - -- BuildTx.addConwayStakeCredentialRegistrationCertificate credMinting (pp ^. Ledger.ppKeyDepositL) addConwayStakeCredentialCertificate credSpending addConwayStakeCredentialCertificate credMinting From 796332ca6af9d2a0a19bb31d97497caa1f41de49 Mon Sep 17 00:00:00 2001 From: Amir Rad Date: Tue, 14 Jan 2025 13:59:31 +0000 Subject: [PATCH 19/22] Fixes and better errors --- src/lib/Wst/AppError.hs | 2 + src/lib/Wst/Offchain/BuildTx/TransferLogic.hs | 22 +++++++++-- src/lib/Wst/Offchain/Endpoints/Deployment.hs | 18 +++++++-- src/lib/Wst/Server.hs | 8 ++-- src/test/unit/Wst/Test/UnitTest.hs | 37 ++++++++++--------- 5 files changed, 59 insertions(+), 28 deletions(-) diff --git a/src/lib/Wst/AppError.hs b/src/lib/Wst/AppError.hs index c2f80ff..fce9105 100644 --- a/src/lib/Wst/AppError.hs +++ b/src/lib/Wst/AppError.hs @@ -14,6 +14,8 @@ data AppError era = | GlobalParamsNodeNotFound -- ^ The node with the global parameters was not found | BalancingError (CoinSelection.BalanceTxError era) | BlockfrostErr BlockfrostError + | NoTokensToSeize -- ^ No tokens to seize + | DuplicateBlacklistNode -- ^ Attempting to add a duplicate blacklist node | TransferBlacklistedCredential Credential -- ^ Attempting to transfer funds from a blacklisted address | SubmitError (ValidationError era) deriving stock (Show) diff --git a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs index 48f2ca4..3606b7d 100644 --- a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs +++ b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs @@ -9,6 +9,7 @@ module Wst.Offchain.BuildTx.TransferLogic seizeSmartTokens, initBlacklist, insertBlacklistNode, + spendBlacklistOutput, paySmartTokensToDestination, registerTransferScripts, ) @@ -17,6 +18,7 @@ where import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C import Control.Lens (over, (^.)) +import Control.Monad (when) import Control.Monad.Except (MonadError (throwError)) import Control.Monad.Reader (MonadReader, asks) import Convex.BuildTx (MonadBuildTx (addTxBuilder), TxBuilder (TxBuilder), @@ -44,7 +46,7 @@ import SmartTokens.Contracts.ExampleTransferLogic (BlacklistProof (..)) import SmartTokens.Types.ProtocolParams import SmartTokens.Types.PTokenDirectory (BlacklistNode (..), DirectorySetNode (..)) -import Wst.AppError (AppError (TransferBlacklistedCredential)) +import Wst.AppError (AppError (DuplicateBlacklistNode, TransferBlacklistedCredential)) import Wst.Offchain.BuildTx.ProgrammableLogic (issueProgrammableToken, seizeProgrammableToken, transferProgrammableToken) @@ -91,7 +93,7 @@ initBlacklist = Utils.inBabbage @era $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) addRequiredSignature opPkh -insertBlacklistNode :: forall era env m. (MonadReader env m, Env.HasOperatorEnv era env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => C.PaymentCredential -> [UTxODat era BlacklistNode]-> m () +insertBlacklistNode :: forall era env m. (MonadReader env m, Env.HasOperatorEnv era env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m, MonadError (AppError era) m) => C.PaymentCredential -> [UTxODat era BlacklistNode]-> m () insertBlacklistNode cred blacklistNodes = Utils.inBabbage @era $ do -- mint new blacklist token mintingScript <- asks (Env.tleBlacklistMintingScript . Env.transferLogicEnv) @@ -102,7 +104,6 @@ insertBlacklistNode cred blacklistNodes = Utils.inBabbage @era $ do mintPlutus mintingScript () newAssetName quantity let - -- find the node to insert on UTxODat {uIn = prevNodeRef,uOut = (C.TxOut prevAddr prevVal _ _), uDatum = prevNode} = maximumBy (compare `on` (blnKey . uDatum)) $ @@ -119,6 +120,9 @@ insertBlacklistNode cred blacklistNodes = Utils.inBabbage @era $ do newPrevNodeDatum = C.TxOutDatumInline C.babbageBasedEra $ C.toHashableScriptData newPrevNode newPrevNodeOutput = C.TxOut prevAddr prevVal newPrevNodeDatum C.ReferenceScriptNone + when (blnKey prevNode == blnKey newNode) + $ throwError DuplicateBlacklistNode + -- spend previous node spendingScript <- asks (Env.tleBlacklistSpendingScript . Env.transferLogicEnv) spendPlutusInlineDatum prevNodeRef spendingScript () @@ -131,6 +135,13 @@ insertBlacklistNode cred blacklistNodes = Utils.inBabbage @era $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) addRequiredSignature opPkh +spendBlacklistOutput :: forall era env m. (MonadReader env m, Env.HasOperatorEnv era env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => C.TxIn -> m () +spendBlacklistOutput txin = Utils.inBabbage @era $ do + spendingScript <- asks (Env.tleBlacklistSpendingScript . Env.transferLogicEnv) + spendPlutusInlineDatum txin spendingScript () + opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) + addRequiredSignature opPkh + {-| Add a smart token output that locks the given value, addressed to the payment credential -} @@ -330,6 +341,7 @@ registerTransferScripts = case C.babbageBasedEra @era of C.BabbageEraOnwardsConway -> Utils.inConway @era $ do transferMintingScript <- asks (Env.tleMintingScript . Env.transferLogicEnv) transferSpendingScript <- asks (Env.tleTransferScript . Env.transferLogicEnv) + transferSeizeSpendingScript <- asks (Env.tleIssuerScript . Env.transferLogicEnv) let hshMinting = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferMintingScript @@ -338,5 +350,9 @@ registerTransferScripts = case C.babbageBasedEra @era of hshSpending = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferSpendingScript credSpending = C.StakeCredentialByScript hshSpending + hshSeizeSpending = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferSeizeSpendingScript + credSeizeSpending = C.StakeCredentialByScript hshSeizeSpending + addConwayStakeCredentialCertificate credMinting addConwayStakeCredentialCertificate credSpending + addConwayStakeCredentialCertificate credSeizeSpending diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index 3ce6681..69ee25f 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -17,16 +17,17 @@ module Wst.Offchain.Endpoints.Deployment( import Cardano.Api (Quantity) import Cardano.Api.Shelley qualified as C import Control.Monad (when) -import Control.Monad.Except (MonadError) +import Control.Monad.Except (MonadError (..)) import Control.Monad.Reader (MonadReader, asks) import Convex.BuildTx qualified as BuildTx import Convex.Class (MonadBlockchain, MonadUtxoQuery) import Convex.CoinSelection qualified import Data.Foldable (maximumBy) import Data.Function (on) +import GHC.IsList (IsList (..)) import SmartTokens.Core.Scripts (ScriptTarget (..)) import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..)) -import Wst.AppError (AppError) +import Wst.AppError (AppError (NoTokensToSeize)) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (inaNewKey)) import Wst.Offchain.BuildTx.DirectorySet qualified as BuildTx import Wst.Offchain.BuildTx.ProgrammableLogic qualified as BuildTx @@ -38,7 +39,6 @@ import Wst.Offchain.Query (UTxODat (..)) import Wst.Offchain.Query qualified as Query - {-| Build a transaction that deploys the directory and global params. Returns the transaction and the 'TxIn' that was selected for the one-shot NFTs. -} @@ -216,7 +216,17 @@ seizeCredentialAssetsTx :: forall era env m. seizeCredentialAssetsTx sanctionedCred = do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) directory <- Query.registryNodes @era - seizeTxo <- head <$> Query.userProgrammableOutputs sanctionedCred + let getTxOutValue (C.TxOut _a v _d _r) = v + -- simple fold to choose the UTxO with the most total assets + nonAda v = foldl (\acc -> \case + (C.AdaAssetId, _) -> acc + (_aid, q) -> acc + q + ) 0 $ toList v + + getNonAdaTokens = nonAda . C.txOutValueToValue . getTxOutValue . uOut + seizeTxo <- maximumBy (compare `on` getNonAdaTokens) <$> Query.userProgrammableOutputs sanctionedCred + when (getNonAdaTokens seizeTxo == 0) $ + throwError NoTokensToSeize paramsTxIn <- Query.globalParamsNode @era (tx, _) <- Env.balanceTxEnv_ $ do BuildTx.seizeSmartTokens paramsTxIn seizeTxo (C.PaymentCredentialByKey opPkh) directory diff --git a/src/lib/Wst/Server.hs b/src/lib/Wst/Server.hs index 3dd87a8..61e8790 100644 --- a/src/lib/Wst/Server.hs +++ b/src/lib/Wst/Server.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {-| servant server for stablecoin POC -} @@ -130,7 +131,8 @@ queryBlacklistedNodes _ (SerialiseAddress addr) = do . P.fromBuiltin . blnKey . uDatum - Env.withEnv $ Env.withTransfer transferLogic (fmap (fmap getHash) (Query.blacklistNodes @era)) + nonHeadNodes (P.fromBuiltin . blnKey . uDatum -> hsh) = hsh /= "" + Env.withEnv $ Env.withTransfer transferLogic (fmap getHash . filter nonHeadNodes <$> (Query.blacklistNodes @era)) txOutValue :: C.IsMaryBasedEra era => C.TxOut C.CtxUTxO era -> C.Value txOutValue = L.view (L._TxOut . L._2 . L._TxOutValue) diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index 55fb245..03f9042 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -86,11 +86,10 @@ deployDirectorySet = do pure scriptRoot insertDirectoryNode :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => DirectoryScriptRoot -> m () -insertDirectoryNode scriptRoot = failOnError $ Env.withEnv $ do - asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ do - Endpoints.insertNodeTx dummyNodeArgs >>= void . sendTx . signTxOperator admin - Query.registryNodes @C.ConwayEra - >>= void . expectN 2 "registry outputs" +insertDirectoryNode scriptRoot = failOnError $ Env.withEnv $ asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ do + Endpoints.insertNodeTx dummyNodeArgs >>= void . sendTx . signTxOperator admin + Query.registryNodes @C.ConwayEra + >>= void . expectN 2 "registry outputs" {-| Issue some tokens with the "always succeeds" validator -} @@ -190,9 +189,8 @@ blacklistTransfer = failOnError $ Env.withEnv $ do aid <- issueTransferLogicProgrammableToken scriptRoot - asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do - Endpoints.deployBlacklistTx - >>= void . sendTx . signTxOperator admin + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ Endpoints.deployBlacklistTx + >>= void . sendTx . signTxOperator admin opPkh <- asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) @@ -202,13 +200,11 @@ blacklistTransfer = failOnError $ Env.withEnv $ do transferLogic <- Env.withDirectoryFor scriptRoot $ Env.transferLogicForDirectory (C.verificationKeyHash . Operator.verificationKey . Operator.oPaymentKey $ admin) - asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do - Endpoints.blacklistCredentialTx userPaymentCred - >>= void . sendTx . signTxOperator admin + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ Endpoints.blacklistCredentialTx userPaymentCred + >>= void . sendTx . signTxOperator admin - asWallet Wallet.w2 $ Env.withDirectoryFor scriptRoot $ Env.withTransfer transferLogic $ do - Endpoints.transferSmartTokensTx aid 30 (C.PaymentCredentialByKey opPkh) - >>= void . sendTx . signTxOperator (user Wallet.w2) + asWallet Wallet.w2 $ Env.withDirectoryFor scriptRoot $ Env.withTransfer transferLogic $ Endpoints.transferSmartTokensTx aid 30 (C.PaymentCredentialByKey opPkh) + >>= void . sendTx . signTxOperator (user Wallet.w2) seizeUserOutput :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => DirectoryScriptRoot -> m () seizeUserOutput scriptRoot = failOnError $ Env.withEnv $ do @@ -217,9 +213,8 @@ seizeUserOutput scriptRoot = failOnError $ Env.withEnv $ do aid <- issueTransferLogicProgrammableToken scriptRoot - asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do - Endpoints.deployBlacklistTx - >>= void . sendTx . signTxOperator admin + asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ Endpoints.deployBlacklistTx + >>= void . sendTx . signTxOperator admin asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do Endpoints.transferSmartTokensTx aid 50 (C.PaymentCredentialByKey userPkh) @@ -240,7 +235,6 @@ seizeUserOutput scriptRoot = failOnError $ Env.withEnv $ do Query.userProgrammableOutputs (C.PaymentCredentialByKey opPkh) >>= void . expectN 2 "user programmable outputs" - dummyNodeArgs :: InsertNodeArgs dummyNodeArgs = InsertNodeArgs @@ -267,6 +261,8 @@ registerTransferScripts :: (MonadFail m, MonadReader env m, Env.HasTransferLogic registerTransferScripts pkh = failOnError $ do transferMintingScript <- asks (Env.tleMintingScript . Env.transferLogicEnv) transferSpendingScript <- asks (Env.tleTransferScript . Env.transferLogicEnv) + transferSeizeSpendingScript <- asks (Env.tleIssuerScript . Env.transferLogicEnv) + let hshMinting = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferMintingScript credMinting = C.StakeCredentialByScript hshMinting @@ -274,10 +270,15 @@ registerTransferScripts pkh = failOnError $ do hshSpending = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferSpendingScript credSpending = C.StakeCredentialByScript hshSpending + hshSeizeSpending = C.hashScript $ C.PlutusScript C.plutusScriptVersion transferSeizeSpendingScript + credSeizeSpending = C.StakeCredentialByScript hshSeizeSpending + + txBody <- BuildTx.execBuildTxT $ do addConwayStakeCredentialCertificate credSpending addConwayStakeCredentialCertificate credMinting + addConwayStakeCredentialCertificate credSeizeSpending BuildTx.addRequiredSignature pkh From 89818f5c45de951091c988a0e5bb2d609e59ca2c Mon Sep 17 00:00:00 2001 From: Amir Rad Date: Tue, 14 Jan 2025 19:44:33 +0000 Subject: [PATCH 20/22] Export scripts json --- compiled-binds/alwaysFail.json | 2 +- compiled-binds/permissionedMinting.json | 2 +- compiled-binds/permissionedTransfer.json | 2 +- compiled-binds/protocolParametersNFTMinting.json | 2 +- compiled-prod/permissionedMinting.json | 2 +- compiled-prod/permissionedTransfer.json | 2 +- compiled-tracing/permissionedMinting.json | 2 +- compiled-tracing/permissionedTransfer.json | 2 +- 8 files changed, 8 insertions(+), 8 deletions(-) diff --git a/compiled-binds/alwaysFail.json b/compiled-binds/alwaysFail.json index 93e4082..0938944 100644 --- a/compiled-binds/alwaysFail.json +++ b/compiled-binds/alwaysFail.json @@ -1,5 +1,5 @@ { - "cborHex": "5840583e010000225335738921314c5b6c69622f536d617274546f6b656e732f436f6e7472616374732f50726f746f636f6c506172616d732e68733a36395d001601", + "cborHex": "5840583e010000225335738921314c5b6c69622f536d617274546f6b656e732f436f6e7472616374732f50726f746f636f6c506172616d732e68733a35335d001601", "description": "Always Fail", "type": "PlutusScriptV3" } \ No newline at end of file diff --git a/compiled-binds/permissionedMinting.json b/compiled-binds/permissionedMinting.json index 7971941..bda885d 100644 --- a/compiled-binds/permissionedMinting.json +++ b/compiled-binds/permissionedMinting.json @@ -1,5 +1,5 @@ { - "cborHex": "5902b15902ae010000225335738921314c5b6c69622f536d617274546f6b656e732f436f6e7472616374732f50726f746f636f6c506172616d732e68733a36305d001533357346a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3231365d0013232300223300200200123002233002002001225335738921194c5b2e2f506c7574617263682f4c6973742e68733a3139375d00153335573e002294054ccd5cd19baf3574200200829444c008d5d100099299ab9c49012c4c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2f4669656c642e68733a3237385d00137586ae84c94cd5ce2481194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d001357446ae88004c94cd5ce2481264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea80040054cd5ce2492c4c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2f4669656c642e68733a3237385d0013574264a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001325335738921264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea80040045261601", + "cborHex": "5902b25902af01000022253357389201314c5b6c69622f536d617274546f6b656e732f436f6e7472616374732f50726f746f636f6c506172616d732e68733a34345d001533357346a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3231365d0013232300223300200200123002233002002001225335738921194c5b2e2f506c7574617263682f4c6973742e68733a3139375d00153335573e002294054ccd5cd19baf3574200200829444c008d5d100099299ab9c49012c4c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2f4669656c642e68733a3237385d00137586ae84c94cd5ce2481194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d001357446ae88004c94cd5ce2481264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea80040054cd5ce2492c4c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2f4669656c642e68733a3237385d0013574264a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001325335738921264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea80040045261601", "description": "Permissioned Minting", "type": "PlutusScriptV3" } \ No newline at end of file diff --git a/compiled-binds/permissionedTransfer.json b/compiled-binds/permissionedTransfer.json index e7b70da..70e6970 100644 --- a/compiled-binds/permissionedTransfer.json +++ b/compiled-binds/permissionedTransfer.json @@ -1,5 +1,5 @@ { - "cborHex": "5902b75902b4010000225335738921374c5b6c69622f536d617274546f6b656e732f436f6e7472616374732f4578616d706c655472616e736665724c6f6769632e68733a38325d001533357346a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3231365d0013232300223300200200123002233002002001225335738921194c5b2e2f506c7574617263682f4c6973742e68733a3139375d00153335573e002294054ccd5cd19baf3574200200829444c008d5d100099299ab9c49012c4c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2f4669656c642e68733a3237385d00137586ae84c94cd5ce2481194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d001357446ae88004c94cd5ce2481264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea80040054cd5ce2492c4c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2f4669656c642e68733a3237385d0013574264a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001325335738921264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea80040045261601", + "cborHex": "5902b85902b501000022253357389201374c5b6c69622f536d617274546f6b656e732f436f6e7472616374732f4578616d706c655472616e736665724c6f6769632e68733a38325d001533357346a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3231365d0013232300223300200200123002233002002001225335738921194c5b2e2f506c7574617263682f4c6973742e68733a3139375d00153335573e002294054ccd5cd19baf3574200200829444c008d5d100099299ab9c49012c4c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2f4669656c642e68733a3237385d00137586ae84c94cd5ce2481194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d001357446ae88004c94cd5ce2481264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea80040054cd5ce2492c4c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2f4669656c642e68733a3237385d0013574264a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001325335738921264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea80040045261601", "description": "Permissioned Transfer", "type": "PlutusScriptV3" } \ No newline at end of file diff --git a/compiled-binds/protocolParametersNFTMinting.json b/compiled-binds/protocolParametersNFTMinting.json index 4676151..2c3736e 100644 --- a/compiled-binds/protocolParametersNFTMinting.json +++ b/compiled-binds/protocolParametersNFTMinting.json @@ -1,5 +1,5 @@ { - "cborHex": "5904c45904c1010000225335738921314c5b6c69622f536d617274546f6b656e732f436f6e7472616374732f50726f746f636f6c506172616d732e68733a33395d001323232323232323232533357346644a66ae712401194c5b2e2f506c7574617263682f426f6f6c2e68733a3134335d0013335734004002940cc894cd5ce249194c5b2e2f506c7574617263682f426f6f6c2e68733a3134335d0013335734004002940cdd780126010f4e50726f746f636f6c506172616d73003375e0029801010100325335738921214c5b6c69622f506c7574617263682f436f72652f5574696c732e68733a3931325d0013325335738921194c5b2e2f506c7574617263682f4c6973742e68733a3330335d0013232300223300200200123002233002002001225335738921194c5b2e2f506c7574617263682f4c6973742e68733a3139375d00153335573e002294054cc94cd5ce2481194c5b2e2f506c7574617263682f426f6f6c2e68733a3134375d0013357340022944c00cd5d0800898011aba2001253357389201214c5b6c69622f506c7574617263682f436f72652f5574696c732e68733a3931335d0013375e01aa66ae7124012c4c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2f4669656c642e68733a3237385d0013574264a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001325335738921264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea8004004004dd61aba15335738921194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001008149858d55cf0011aab9d0013253357389201214c5b6c69622f506c7574617263682f436f72652f5574696c732e68733a3635365d00153335573e0022a66ae712410e4c69737420697320656d7074792e001613253335573e00226ae8400854cd5ce249244c69737420636f6e7461696e73206d6f7265207468616e206f6e6520656c656d656e742e0016357440026644a66ae71241214c5b6c69622f506c7574617263682f436f72652f5574696c732e68733a3737305d001332323002233002002001230022330020020012253357389201194c5b2e2f506c7574617263682f4c6973742e68733a3139375d00153335573e0022c2a666ae68cdd79aab9d3574200200826eacd55cf1aba100113002357440020026ae84008004dd59aba1325335738921194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001325335738921194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d001357446ae88004d5d10022999ab9a3370e6aae74009200010011635573c0026ea8d5d099299ab9c491194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001357446ae88008c94cd5ce249264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea8004d5d0a99ab9c491194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001325335738921264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea80040041", + "cborHex": "5904c45904c1010000225335738921314c5b6c69622f536d617274546f6b656e732f436f6e7472616374732f50726f746f636f6c506172616d732e68733a32335d001323232323232323232533357346644a66ae712401194c5b2e2f506c7574617263682f426f6f6c2e68733a3134335d0013335734004002940cc894cd5ce249194c5b2e2f506c7574617263682f426f6f6c2e68733a3134335d0013335734004002940cdd780126010f4e50726f746f636f6c506172616d73003375e0029801010100325335738921214c5b6c69622f506c7574617263682f436f72652f5574696c732e68733a3931325d0013325335738921194c5b2e2f506c7574617263682f4c6973742e68733a3330335d0013232300223300200200123002233002002001225335738921194c5b2e2f506c7574617263682f4c6973742e68733a3139375d00153335573e002294054cc94cd5ce2481194c5b2e2f506c7574617263682f426f6f6c2e68733a3134375d0013357340022944c00cd5d0800898011aba2001253357389201214c5b6c69622f506c7574617263682f436f72652f5574696c732e68733a3931335d0013375e01aa66ae7124012c4c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2f4669656c642e68733a3237385d0013574264a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001325335738921264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea8004004004dd61aba15335738921194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001008149858d55cf0011aab9d0013253357389201214c5b6c69622f506c7574617263682f436f72652f5574696c732e68733a3635365d00153335573e0022a66ae712410e4c69737420697320656d7074792e001613253335573e00226ae8400854cd5ce249244c69737420636f6e7461696e73206d6f7265207468616e206f6e6520656c656d656e742e0016357440026644a66ae71241214c5b6c69622f506c7574617263682f436f72652f5574696c732e68733a3737305d001332323002233002002001230022330020020012253357389201194c5b2e2f506c7574617263682f4c6973742e68733a3139375d00153335573e0022c2a666ae68cdd79aab9d3574200200826eacd55cf1aba100113002357440020026ae84008004dd59aba1325335738921194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001325335738921194c5b2e2f506c7574617263682f4c6973742e68733a3234365d00135744a66ae71241194c5b2e2f506c7574617263682f4c6973742e68733a3234365d001357446ae88004d5d10022999ab9a3370e6aae74009200010011635573c0026ea8d5d099299ab9c491194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001357446ae88008c94cd5ce249264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea8004d5d0a99ab9c491194c5b2e2f506c7574617263682f4c6973742e68733a3234345d001001325335738921264c5b2e2f506c7574617263682f44617461526570722f496e7465726e616c2e68733a3431325d00135573c6ea80040041", "description": "Protocol Parameters NFT", "type": "PlutusScriptV3" } \ No newline at end of file diff --git a/compiled-prod/permissionedMinting.json b/compiled-prod/permissionedMinting.json index 28afea0..afe7877 100644 --- a/compiled-prod/permissionedMinting.json +++ b/compiled-prod/permissionedMinting.json @@ -1,5 +1,5 @@ { - "cborHex": "586c586a01000022533357346646460044660040040024600446600400400244a666aae7c0045280a999ab9a3375e6ae84004010528898011aba20013237586ae84c8d5d11aba2357446ae88d5d11aba2357446ae88004c8d55cf1baa00100135742646aae78dd50008008a4c2c1", + "cborHex": "586c586a010000222533357346646460044660040040024600446600400400244a666aae7c0045280a999ab9a3375e6ae84004010528898011aba20013237586ae84c8d5d11aba2357446ae88d5d11aba2357446ae88004c8d55cf1baa00100135742646aae78dd50008008a4c2d", "description": "Permissioned Minting", "type": "PlutusScriptV3" } \ No newline at end of file diff --git a/compiled-prod/permissionedTransfer.json b/compiled-prod/permissionedTransfer.json index 31737f0..bb4c5a0 100644 --- a/compiled-prod/permissionedTransfer.json +++ b/compiled-prod/permissionedTransfer.json @@ -1,5 +1,5 @@ { - "cborHex": "586c586a01000022533357346646460044660040040024600446600400400244a666aae7c0045280a999ab9a3375e6ae84004010528898011aba20013237586ae84c8d5d11aba2357446ae88d5d11aba2357446ae88004c8d55cf1baa00100135742646aae78dd50008008a4c2c1", + "cborHex": "586c586a010000222533357346646460044660040040024600446600400400244a666aae7c0045280a999ab9a3375e6ae84004010528898011aba20013237586ae84c8d5d11aba2357446ae88d5d11aba2357446ae88004c8d55cf1baa00100135742646aae78dd50008008a4c2d", "description": "Permissioned Transfer", "type": "PlutusScriptV3" } \ No newline at end of file diff --git a/compiled-tracing/permissionedMinting.json b/compiled-tracing/permissionedMinting.json index 28afea0..afe7877 100644 --- a/compiled-tracing/permissionedMinting.json +++ b/compiled-tracing/permissionedMinting.json @@ -1,5 +1,5 @@ { - "cborHex": "586c586a01000022533357346646460044660040040024600446600400400244a666aae7c0045280a999ab9a3375e6ae84004010528898011aba20013237586ae84c8d5d11aba2357446ae88d5d11aba2357446ae88004c8d55cf1baa00100135742646aae78dd50008008a4c2c1", + "cborHex": "586c586a010000222533357346646460044660040040024600446600400400244a666aae7c0045280a999ab9a3375e6ae84004010528898011aba20013237586ae84c8d5d11aba2357446ae88d5d11aba2357446ae88004c8d55cf1baa00100135742646aae78dd50008008a4c2d", "description": "Permissioned Minting", "type": "PlutusScriptV3" } \ No newline at end of file diff --git a/compiled-tracing/permissionedTransfer.json b/compiled-tracing/permissionedTransfer.json index 31737f0..bb4c5a0 100644 --- a/compiled-tracing/permissionedTransfer.json +++ b/compiled-tracing/permissionedTransfer.json @@ -1,5 +1,5 @@ { - "cborHex": "586c586a01000022533357346646460044660040040024600446600400400244a666aae7c0045280a999ab9a3375e6ae84004010528898011aba20013237586ae84c8d5d11aba2357446ae88d5d11aba2357446ae88004c8d55cf1baa00100135742646aae78dd50008008a4c2c1", + "cborHex": "586c586a010000222533357346646460044660040040024600446600400400244a666aae7c0045280a999ab9a3375e6ae84004010528898011aba20013237586ae84c8d5d11aba2357446ae88d5d11aba2357446ae88004c8d55cf1baa00100135742646aae78dd50008008a4c2d", "description": "Permissioned Transfer", "type": "PlutusScriptV3" } \ No newline at end of file From 4c4070446d09bc33643fc5e109ebd00fc89a9903 Mon Sep 17 00:00:00 2001 From: Amir Rad Date: Tue, 14 Jan 2025 21:07:05 +0000 Subject: [PATCH 21/22] Export applied scripts json --- .github/workflows/ci-compiled-scripts.yaml | 2 +- ...164285b050c6a24ef10576b9fbf091a870b3f.json | 5 + ...ac45c1ad59263e282fa00a7083620fb449413.json | 5 + ...6d1fd415358a27ba829024ee0b90af5e32f14.json | 5 + ...714bfa2d105df42a13283ca53f62692ec3f8d.json | 5 + ...0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefa.json | 5 + ...0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefa.json | 5 + ...268d4a7ecb51d5c44c096685dfb2cb881d7d3.json | 5 + ...268d4a7ecb51d5c44c096685dfb2cb881d7d3.json | 5 + ...3544caecefef5242025f45c3fa5213d7662a9.json | 5 + ...01b4fef9437a4d768700c313415fc2ad5ee09.json | 5 + ...bad27450f7dcc81376ae6ebda8d25e942508e.json | 5 + ...784066fa3c03684fee2bfac7b571654ae8f55.json | 5 + ...a73d1f38a186655599c69c932e8acb2ae099a.json | 5 + ...1a5266bba7dc685b786b1cc33551aa66867c9.json | 5 + deployment-root.json | 1 + generated/openapi/schema.json | 76 ++++++++++++ src/exe/export-smart-tokens/Main.hs | 116 +++++++++++++++++- src/wst-poc.cabal | 3 + 19 files changed, 265 insertions(+), 3 deletions(-) create mode 100644 applied-prod/blacklistMinting-8ea903ae40af4e0cff4164285b050c6a24ef10576b9fbf091a870b3f.json create mode 100644 applied-prod/blacklistSpending-9f6381bdf046fd671ebac45c1ad59263e282fa00a7083620fb449413.json create mode 100644 applied-prod/directoryNodeMinting-f1f838a525637791ca06d1fd415358a27ba829024ee0b90af5e32f14.json create mode 100644 applied-prod/directoryNodeSpending-9c0b7840bea475b3b20714bfa2d105df42a13283ca53f62692ec3f8d.json create mode 100644 applied-prod/programmableLogicBase-fca77bcce1e5e73c97a0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefa.json create mode 100644 applied-prod/programmableLogicBaseSpending-fca77bcce1e5e73c97a0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefa.json create mode 100644 applied-prod/programmableLogicGlobal-36775ef231d797f8234268d4a7ecb51d5c44c096685dfb2cb881d7d3.json create mode 100644 applied-prod/programmableLogicGlobalStake-36775ef231d797f8234268d4a7ecb51d5c44c096685dfb2cb881d7d3.json create mode 100644 applied-prod/programmableTokenMinting-b34a184f1f2871aa4d33544caecefef5242025f45c3fa5213d7662a9.json create mode 100644 applied-prod/protocolParametersNFTMinting-c348817600e8cd22ddf01b4fef9437a4d768700c313415fc2ad5ee09.json create mode 100644 applied-prod/protocolParametersSpending-b8459bc5cc1dae2962abad27450f7dcc81376ae6ebda8d25e942508e.json create mode 100644 applied-prod/transferLogicIssuerSpending-b427cc9d5b829bbf66a784066fa3c03684fee2bfac7b571654ae8f55.json create mode 100644 applied-prod/transferLogicMinting-6714325b1663ff1e81aa73d1f38a186655599c69c932e8acb2ae099a.json create mode 100644 applied-prod/transferLogicSpending-5b7d265e7d862937c6e1a5266bba7dc685b786b1cc33551aa66867c9.json create mode 100644 deployment-root.json diff --git a/.github/workflows/ci-compiled-scripts.yaml b/.github/workflows/ci-compiled-scripts.yaml index 3038ac2..59e86e9 100644 --- a/.github/workflows/ci-compiled-scripts.yaml +++ b/.github/workflows/ci-compiled-scripts.yaml @@ -44,6 +44,6 @@ jobs: - name: check compiled scripts are consistent # git diff --quiet implies --exit-code run: | - cabal run export-smart-tokens + cabal run export-smart-tokens 08a8d0bb8717839931b0a594f7c28b0a3b7c78f6e9172e977e250eab7637d879.0 '"addr_test1qq986m3uel86pl674mkzneqtycyg7csrdgdxj6uf7v7kd857kquweuh5kmrj28zs8czrwkl692jm67vna2rf7xtafhpqk3hecm"' cabal run write-openapi-schema -- generated/openapi/schema.json git diff --quiet diff --git a/applied-prod/blacklistMinting-8ea903ae40af4e0cff4164285b050c6a24ef10576b9fbf091a870b3f.json b/applied-prod/blacklistMinting-8ea903ae40af4e0cff4164285b050c6a24ef10576b9fbf091a870b3f.json new file mode 100644 index 0000000..a5f1b82 --- /dev/null +++ b/applied-prod/blacklistMinting-8ea903ae40af4e0cff4164285b050c6a24ef10576b9fbf091a870b3f.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Blacklist Minting", + "cborHex": "58a958a70100003232323232332225333004332323002233002002001230022330020020012253335573e002294054ccc018cdd798040008020a51130023007001323758600e64600e600e600e600e600e600e600e600e0026010002600c600e0022930b1ba9488111626c61636b6c697374206d696e74696e67004c011e581c0a7d6e3ccfcfa0ff5eaeec29e40b26088f62036a1a696b89f33d669e005734ae895d0918011baa0015573d" +} diff --git a/applied-prod/blacklistSpending-9f6381bdf046fd671ebac45c1ad59263e282fa00a7083620fb449413.json b/applied-prod/blacklistSpending-9f6381bdf046fd671ebac45c1ad59263e282fa00a7083620fb449413.json new file mode 100644 index 0000000..cfd2f38 --- /dev/null +++ b/applied-prod/blacklistSpending-9f6381bdf046fd671ebac45c1ad59263e282fa00a7083620fb449413.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Blacklist Spending", + "cborHex": "58aa58a80100003232323232332225333004332323002233002002001230022330020020012253335573e002294054ccc018cdd798040008020a51130023007001323758600e64600e600e600e600e600e600e600e600e0026010002600c600e0022930b1ba9488112626c61636b6c697374207370656e64696e67004c011e581c0a7d6e3ccfcfa0ff5eaeec29e40b26088f62036a1a696b89f33d669e005734ae895d0918011baa0015573d" +} diff --git a/applied-prod/directoryNodeMinting-f1f838a525637791ca06d1fd415358a27ba829024ee0b90af5e32f14.json b/applied-prod/directoryNodeMinting-f1f838a525637791ca06d1fd415358a27ba829024ee0b90af5e32f14.json new file mode 100644 index 0000000..f684585 --- /dev/null +++ b/applied-prod/directoryNodeMinting-f1f838a525637791ca06d1fd415358a27ba829024ee0b90af5e32f14.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Directory Node Minting Policy", + "cborHex": "5905ea5905e70100003232323232323232323232323232323232323232323232323232323232323223232323232323232323232325333026533302300214a22664604644a66604c002294454cc048c00cc0b40044c008c0b0004c88c8cdd79ba7302e003374e605c0026058605a0026460566058002605400400226464646464a66605666e1d2002002132533302c4a2264a66605a66e1cdc6800a407026464646464a6660646644666068004002940cdc800100319b900060011533303253301b330293333222223375e002666604400800a0060046ea4018dd4801181b001981b181a801805899814999111919baf002333302100400332325333038337126e34dd71816181f001240702a66607066e1c00520001303c003153330383370e00290010981e0018b0b181c0009baa303a00132325333038337126e34dd71816181f001240702a66607066e1c00520001303c303b003153330383370e00290010981e181d8018b0b181c0009baa303a3039001303737580026ea4018dd48008058a999819199980f8091ba900648008044526161616375c606a0066eb8c0d000cc0c8004c0c4004dd618108038b1bae00116302f0011533302b323302323375e02a606260640020026eb0c0bcc0c0c0bcc0c004854ccc0acc09401454ccc0acc8cdd78009ba73302b4c010140003302b4c120581effffffffffffffffffffffffffffffffffffffffffffffffffffffffffff003302b0183302b018022301f0041533302b333301800b4c0101400048008028526161616163030002302a001375460586056605a01e66038464646466604e44a6660540022c2a66605a66ebcc0b8c0c40040344c8c88cc00400c008dd6981a18111bab30343032002302e302137566066606200226004606000200244646464a66606066e1d20040021323232323253330353370e66646064444a66606c002200426600666008004607a00260780024466e00008ccc0cc8894ccc0dc00440084cc00ccdc000124004607a00290001bab303d0014800002d2004153330353370e01290010a99981a99b90375c0026eb8c0e400c54ccc0d4cdd780080508028b0b0b0b181c001981b000981a8009bac0013034001163035002302f0013754606260600086eacc0b8004c0b0004c0b4004008cc06c8c8c8c8c94ccc0accdc3a40080042605e0022c606000460540026ea8004c0acc0a4c0b000400858cc8c088894ccc09400440784c94ccc0a4c0100044cc0a0004c00cc0b00084c00cc0b0008c0b00048c010dd59815181498158009bac3029008333223022225333025001101e132533302930050011330280013003302c00213003302c0023003302c00123003375660526050605400246052605060540020026eb0c09c0208cc0688cdd7981280080200099199180f11998011bab001232223002003374c002244a002464a666048603c002244a00224460040066603c4a66604866ebc004dd424000244a00224460040060020026eacc09400cc8c8c94ccc08ccdc3a40000042604e0022c605000460440026ea8c090c08cc08c018c084c088004c084c084004c080004c07c004c080c07c004c07c00530127d8799f582008a8d0bb8717839931b0a594f7c28b0a3b7c78f6e9172e977e250eab7637d87900ff002233301900200100314a044446e9ccc060010cc06000ccc060008cc06000403d300105d8799f40ff00222233330050040012330093300a00400300116233002003001222330102253330130011225001153330163375e602e60340020082600a60340022600460320020024644460040066eacc05c00488cdd79ba6002374c00244660060046ea000488cc038cdd8001000806929998050008b0992999805800898090010b18080009180411299980580088020998069801980900098011808800a5eb808c018894ccc0240045280a99802180198080008980118078009198048008010a515746446600644a66600c002200e26466600a6020601c00446601466ec0c030c03c00c0040084004c008c0300040048c8c0088cc0080080048c0088cc00800800555cfa5eb7bdb1815d02b9a5573a460046004002ae895d0918011baa0015573d" +} diff --git a/applied-prod/directoryNodeSpending-9c0b7840bea475b3b20714bfa2d105df42a13283ca53f62692ec3f8d.json b/applied-prod/directoryNodeSpending-9c0b7840bea475b3b20714bfa2d105df42a13283ca53f62692ec3f8d.json new file mode 100644 index 0000000..81d7ea6 --- /dev/null +++ b/applied-prod/directoryNodeSpending-9c0b7840bea475b3b20714bfa2d105df42a13283ca53f62692ec3f8d.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Directory Spending", + "cborHex": "590118590115010000323232323232323232323232323223232323232533300e3370e90020010a9998071980498091bac301200137566024601060220082930b0b180980118070009baa32301030063011001323010300f3011001332300922533300c001161533300e30033012001130120011300230110012330070053237566022602060240026020601e60220026eb0c03c004c034c03cc038004c03800530011e581cc348817600e8cd22ddf01b4fef9437a4d768700c313415fc2ad5ee09002300a300a001223300323375e60140020060024600444a66600a002294054cc018c00cc02c0044c008c0280048c8c0088cc0080080048c0088cc00800800555cf919801000801ab9a14a2aae755d12ba1230023754002aae79" +} diff --git a/applied-prod/programmableLogicBase-fca77bcce1e5e73c97a0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefa.json b/applied-prod/programmableLogicBase-fca77bcce1e5e73c97a0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefa.json new file mode 100644 index 0000000..ada584f --- /dev/null +++ b/applied-prod/programmableLogicBase-fca77bcce1e5e73c97a0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefa.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Programmable Logic Base", + "cborHex": "58af58ad01000032323232323232232533300453330043375e600a600e00200629444cc8c8c8c0088cc0080080048c0088cc008008004894ccd55cf8008b0a999803980198050008a5113002300900123375e600c002008600c0022930b1bab323007323007300730073007300730070013008001300630070014c0122d87a9f581c36775ef231d797f8234268d4a7ecb51d5c44c096685dfb2cb881d7d3ff005734aae755d12ba1230023754002aae781" +} diff --git a/applied-prod/programmableLogicBaseSpending-fca77bcce1e5e73c97a0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefa.json b/applied-prod/programmableLogicBaseSpending-fca77bcce1e5e73c97a0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefa.json new file mode 100644 index 0000000..ada584f --- /dev/null +++ b/applied-prod/programmableLogicBaseSpending-fca77bcce1e5e73c97a0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefa.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Programmable Logic Base", + "cborHex": "58af58ad01000032323232323232232533300453330043375e600a600e00200629444cc8c8c8c0088cc0080080048c0088cc008008004894ccd55cf8008b0a999803980198050008a5113002300900123375e600c002008600c0022930b1bab323007323007300730073007300730070013008001300630070014c0122d87a9f581c36775ef231d797f8234268d4a7ecb51d5c44c096685dfb2cb881d7d3ff005734aae755d12ba1230023754002aae781" +} diff --git a/applied-prod/programmableLogicGlobal-36775ef231d797f8234268d4a7ecb51d5c44c096685dfb2cb881d7d3.json b/applied-prod/programmableLogicGlobal-36775ef231d797f8234268d4a7ecb51d5c44c096685dfb2cb881d7d3.json new file mode 100644 index 0000000..2c25c4f --- /dev/null +++ b/applied-prod/programmableLogicGlobal-36775ef231d797f8234268d4a7ecb51d5c44c096685dfb2cb881d7d3.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Programmable Logic Global", + "cborHex": "5907a259079f01000032323232323232323232323232323232323232323232323232323232323223232323232323232323253330223370e90020010991919191919299981419b87480080084c8c8c8c8c8c94ccc0b8cdc3a400800426464646464646464a66606c6604c6604c6604c6604c66e1cccc0cc8894ccc0dc004400854ccc0e4cdd780b19181f182000099181f182000099181f181f9820000981e80089980199b8000248008c0f80044cc00c008c0f8005200000e48008cdd7981d181e00180999baf33027375860740346eb4c0e8034cdd2a400066060607400a660606e98004cc0c0c0e8c0ec010cc0c0cdd2a400405e05e660546074607a6ea8c0e8c0ec018048c8ccc0dc005282513375e6e98008dd30008a4c2c646606644a66606c00220602a66607066ebcc0e8c0f000400c4c0f40044cc0c8c0f0004c008c0f4004008c0e401cdd5981c001181b801181b800981b99181b181b981c000998110049bad303500a30350013034001375860640022c6068004605c0026ea8c0bcc0c0004c0bcc0c0c8c0bcc0c0c0c4004cc06c030dd69817181780098170011bac302c00e13232533302a3301a3370e60586ea8c0b8c0bc04520043322330172330182337126eb4c0d4004cc88cccc07800920002333301f00248001d69bab0010063030002303000137566068002002646060666050444a66605800220042660066464a66606066ebcc0d0c0d80040344ccc095c00021bab30343035002100430330013034303200130330010230013758605c01c0022930b19999911111919998161111299981880108008991919299981b19b87480080084c8c8c8c94ccc0e8cdc3a4008004264646464a66607c6605c6605c66e4000800ccdc80018009981c80a9bab3042008133300f304300e304300d00c16375c608260840066eb8c100008dd7181e981f8051bac303e001163040002303a001375460766078002607660786460766078607a00260106eb4c0e80044c8c8c8c94ccc0e8cdc3a400800426464a666078660586605866060608060866ea8c100c104004040cdd79820001181f18200059981b8099bab3040006133300d304100c304100b33036304000b00a1630400013758607c0022c608000460740026ea8c0ecc0f0004c0ecc0f0c8c0ecc0f0c0f4004c020dd6981d000981e001181b0009baa30370030043034002027301f004302d00700b3758605a00400a002666444666050444a66605800220042660066464a66606066ebcc0d0c0d80040344c8c8c94ccc0cccdc3a40040042c2646464a66606c66e1d200200216132323253330393370e90000010a99981c99816981e800808899981738000d3756607a607c0162c2a6660726605a607a002020266605ce00034dd5981e981f0058b181f801181c8009baa303a001303c00230360013754606e002607200460660026ea8c0d0c0d4c0d80044010c0cc004c0d0c8c0ccc0d0c0d4004c0c8004c0cc00408c004dd61816181698168058021bac302c00e302e002302800137546052018664604444a66604a002204026604260066056002600460580024605260586ea8c09c004dd59814003981398140009bac3026001163028002302200137546460486046604c002646048604a604c002664603a44a6660400022c2a6660446006604c0022604c00226004604e002466036014646eacc094c098c09c004c090c094c098004004dd6181100199181198108009811000981080098100009810180f001180f000980f000a6011e581cc348817600e8cd22ddf01b4fef9437a4d768700c313415fc2ad5ee09002301322533301600114a22a660086006603800226004603a0024466602c00400200629400048888cc048894ccc054004401454ccc05ccdd7980c980d80080309802180f180d80089801180e00080091199809001000a50300c222533301233710900a000899801980200119b810014805054ccc048cdc424014002266006602e602e602e602e602e00466e04005200a13300500200123014301430143014301430143014301430143014001300a22253330103370e00290000980a001099801980a80119b81001480088c028894ccc0340045280a99980799baf301300100314a22600460280024446660084466600e00a004002004002444a666016004200226666460164444a6660200022660180060042646464a66602a66ebc0080044cc03ccdd80011ba63300b3756603800c6eacc07000cccc02001c014c06801054ccc054cdc81bae002375c00226601e00c66601000e00a00826601e00666601000e60340086601e00c00a602c004602a008602c002444a66601c004200226660066028004602a00400260220046024004002444a666014004200226666460144444a66601e0022660160060042646464a66602866ebc0080044cc038cdd80011ba83300b375a603600c6eb4c06c00cccc02001c014c06401054ccc050cdc81bae002375c00226601c00c66601000e00a00826601c00666601000e60320086601c00c00a602a0046028008602a002444a66601a00420022666006602600460280040026020004602200400297adef6c604bd702ba0223300323375e60140020060024600444a66600a002294054cc018c00cc02c0044c008c0300048c8c0088cc0080080048c0088cc00800800555cf919801000801ab9a14a2aae748c00cc00c0055d0aba2230023754002aae781" +} diff --git a/applied-prod/programmableLogicGlobalStake-36775ef231d797f8234268d4a7ecb51d5c44c096685dfb2cb881d7d3.json b/applied-prod/programmableLogicGlobalStake-36775ef231d797f8234268d4a7ecb51d5c44c096685dfb2cb881d7d3.json new file mode 100644 index 0000000..2c25c4f --- /dev/null +++ b/applied-prod/programmableLogicGlobalStake-36775ef231d797f8234268d4a7ecb51d5c44c096685dfb2cb881d7d3.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Programmable Logic Global", + "cborHex": "5907a259079f01000032323232323232323232323232323232323232323232323232323232323223232323232323232323253330223370e90020010991919191919299981419b87480080084c8c8c8c8c8c94ccc0b8cdc3a400800426464646464646464a66606c6604c6604c6604c6604c66e1cccc0cc8894ccc0dc004400854ccc0e4cdd780b19181f182000099181f182000099181f181f9820000981e80089980199b8000248008c0f80044cc00c008c0f8005200000e48008cdd7981d181e00180999baf33027375860740346eb4c0e8034cdd2a400066060607400a660606e98004cc0c0c0e8c0ec010cc0c0cdd2a400405e05e660546074607a6ea8c0e8c0ec018048c8ccc0dc005282513375e6e98008dd30008a4c2c646606644a66606c00220602a66607066ebcc0e8c0f000400c4c0f40044cc0c8c0f0004c008c0f4004008c0e401cdd5981c001181b801181b800981b99181b181b981c000998110049bad303500a30350013034001375860640022c6068004605c0026ea8c0bcc0c0004c0bcc0c0c8c0bcc0c0c0c4004cc06c030dd69817181780098170011bac302c00e13232533302a3301a3370e60586ea8c0b8c0bc04520043322330172330182337126eb4c0d4004cc88cccc07800920002333301f00248001d69bab0010063030002303000137566068002002646060666050444a66605800220042660066464a66606066ebcc0d0c0d80040344ccc095c00021bab30343035002100430330013034303200130330010230013758605c01c0022930b19999911111919998161111299981880108008991919299981b19b87480080084c8c8c8c94ccc0e8cdc3a4008004264646464a66607c6605c6605c66e4000800ccdc80018009981c80a9bab3042008133300f304300e304300d00c16375c608260840066eb8c100008dd7181e981f8051bac303e001163040002303a001375460766078002607660786460766078607a00260106eb4c0e80044c8c8c8c94ccc0e8cdc3a400800426464a666078660586605866060608060866ea8c100c104004040cdd79820001181f18200059981b8099bab3040006133300d304100c304100b33036304000b00a1630400013758607c0022c608000460740026ea8c0ecc0f0004c0ecc0f0c8c0ecc0f0c0f4004c020dd6981d000981e001181b0009baa30370030043034002027301f004302d00700b3758605a00400a002666444666050444a66605800220042660066464a66606066ebcc0d0c0d80040344c8c8c94ccc0cccdc3a40040042c2646464a66606c66e1d200200216132323253330393370e90000010a99981c99816981e800808899981738000d3756607a607c0162c2a6660726605a607a002020266605ce00034dd5981e981f0058b181f801181c8009baa303a001303c00230360013754606e002607200460660026ea8c0d0c0d4c0d80044010c0cc004c0d0c8c0ccc0d0c0d4004c0c8004c0cc00408c004dd61816181698168058021bac302c00e302e002302800137546052018664604444a66604a002204026604260066056002600460580024605260586ea8c09c004dd59814003981398140009bac3026001163028002302200137546460486046604c002646048604a604c002664603a44a6660400022c2a6660446006604c0022604c00226004604e002466036014646eacc094c098c09c004c090c094c098004004dd6181100199181198108009811000981080098100009810180f001180f000980f000a6011e581cc348817600e8cd22ddf01b4fef9437a4d768700c313415fc2ad5ee09002301322533301600114a22a660086006603800226004603a0024466602c00400200629400048888cc048894ccc054004401454ccc05ccdd7980c980d80080309802180f180d80089801180e00080091199809001000a50300c222533301233710900a000899801980200119b810014805054ccc048cdc424014002266006602e602e602e602e602e00466e04005200a13300500200123014301430143014301430143014301430143014001300a22253330103370e00290000980a001099801980a80119b81001480088c028894ccc0340045280a99980799baf301300100314a22600460280024446660084466600e00a004002004002444a666016004200226666460164444a6660200022660180060042646464a66602a66ebc0080044cc03ccdd80011ba63300b3756603800c6eacc07000cccc02001c014c06801054ccc054cdc81bae002375c00226601e00c66601000e00a00826601e00666601000e60340086601e00c00a602c004602a008602c002444a66601c004200226660066028004602a00400260220046024004002444a666014004200226666460144444a66601e0022660160060042646464a66602866ebc0080044cc038cdd80011ba83300b375a603600c6eb4c06c00cccc02001c014c06401054ccc050cdc81bae002375c00226601c00c66601000e00a00826601c00666601000e60320086601c00c00a602a0046028008602a002444a66601a00420022666006602600460280040026020004602200400297adef6c604bd702ba0223300323375e60140020060024600444a66600a002294054cc018c00cc02c0044c008c0300048c8c0088cc0080080048c0088cc00800800555cf919801000801ab9a14a2aae748c00cc00c0055d0aba2230023754002aae781" +} diff --git a/applied-prod/programmableTokenMinting-b34a184f1f2871aa4d33544caecefef5242025f45c3fa5213d7662a9.json b/applied-prod/programmableTokenMinting-b34a184f1f2871aa4d33544caecefef5242025f45c3fa5213d7662a9.json new file mode 100644 index 0000000..420a488 --- /dev/null +++ b/applied-prod/programmableTokenMinting-b34a184f1f2871aa4d33544caecefef5242025f45c3fa5213d7662a9.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Programmable Token Minting", + "cborHex": "5902995902960100003232323232323232323232323232323232323332222323232323232323253330193370e9000001099191919191919299981019b87375a604401c9000099191929998119980b9980b9980b99b873330183756604a604c00801400e00c66ebcc8c098c0a0004c094010058cdc39bad00148008cc06c050cc070090dd59812981318130070a4c2c604e004604400260386603a02400c2a66604066e2120000031533302033014330143370e66602a6eacc088c08c00401c01000ccdd7991811981280098110008099980c0089980c8109bab30223023302300b14985854ccc080cc060044cc064084dd59811181198118058a4c2c604660420026eb0c080028dd69811001180e800980b9980c0010009bab301c005301b00116301d002301800137546030603200860306030002602e002602c602e602a004602a002602a002980122d87a9f581cfca77bcce1e5e73c97a0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefaff004c011e581cf1f838a525637791ca06d1fd415358a27ba829024ee0b90af5e32f14004c0122d87a9f581c6714325b1663ff1e81aa73d1f38a186655599c69c932e8acb2ae099aff002233300e0020014a0444666600800490001199980280124000eb4dd580080180091111980591299980700088028a99980799baf3010301100100613004301430110011300230120010012300722533300a00114a02a66601666ebcc03400400c5288980118070009180311299980480088020998029801980600098011806800a5eb815d0129998020008b0992999802800898040010b180400091198019129998030008b0a99980399baf300830090010041375660186012002260046014002002464600446600400400246004466004004002aae7d5cd2ab9d5742ae888c008dd5000aab9e01" +} diff --git a/applied-prod/protocolParametersNFTMinting-c348817600e8cd22ddf01b4fef9437a4d768700c313415fc2ad5ee09.json b/applied-prod/protocolParametersNFTMinting-c348817600e8cd22ddf01b4fef9437a4d768700c313415fc2ad5ee09.json new file mode 100644 index 0000000..e19c2ae --- /dev/null +++ b/applied-prod/protocolParametersNFTMinting-c348817600e8cd22ddf01b4fef9437a4d768700c313415fc2ad5ee09.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Protocol Parameters NFT", + "cborHex": "59014d59014a010000323232323232323232322323232323232323232533300f3300c3300c3375e00498010f4e50726f746f636f6c506172616d73003375e002980101010032332300f22533301200114a02a664660280022944c00cc0580044c008c0540048cdd7806980a180a8008009bac3012008149858c04c008c038004c94ccc030004584c94ccc0340044c04400858c03c004cc88cc030894ccc03c0045854ccc040cdd79808980980080209bab30153013001130023012001001300f0020013756601c64601c601c601c002601a008a66601466e1cc02c0092000100116300e001375460166014601400460166014002601400298127d8799f582008a8d0bb8717839931b0a594f7c28b0a3b7c78f6e9172e977e250eab7637d87900ff00223330050020014a0464600446600400400246004466004004002aae7d5cd2ab9d5744ae848c008dd5000aab9e01" +} diff --git a/applied-prod/protocolParametersSpending-b8459bc5cc1dae2962abad27450f7dcc81376ae6ebda8d25e942508e.json b/applied-prod/protocolParametersSpending-b8459bc5cc1dae2962abad27450f7dcc81376ae6ebda8d25e942508e.json new file mode 100644 index 0000000..fc4eb6c --- /dev/null +++ b/applied-prod/protocolParametersSpending-b8459bc5cc1dae2962abad27450f7dcc81376ae6ebda8d25e942508e.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Protocol Parameters Spending", + "cborHex": "4c4b0100003226375291010001" +} diff --git a/applied-prod/transferLogicIssuerSpending-b427cc9d5b829bbf66a784066fa3c03684fee2bfac7b571654ae8f55.json b/applied-prod/transferLogicIssuerSpending-b427cc9d5b829bbf66a784066fa3c03684fee2bfac7b571654ae8f55.json new file mode 100644 index 0000000..fdfc6cb --- /dev/null +++ b/applied-prod/transferLogicIssuerSpending-b427cc9d5b829bbf66a784066fa3c03684fee2bfac7b571654ae8f55.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Transfer Logic Issuer Spending", + "cborHex": "58ad58ab0100003232323232332225333004332323002233002002001230022330020020012253335573e002294054ccc018cdd798040008020a51130023007001323758600e64600e600e600e600e600e600e600e600e0026010002600c600e0022930b1ba94881157065726d697373696f6e6564207370656e64696e67004c011e581c0a7d6e3ccfcfa0ff5eaeec29e40b26088f62036a1a696b89f33d669e005734ae895d0918011baa0015573d" +} diff --git a/applied-prod/transferLogicMinting-6714325b1663ff1e81aa73d1f38a186655599c69c932e8acb2ae099a.json b/applied-prod/transferLogicMinting-6714325b1663ff1e81aa73d1f38a186655599c69c932e8acb2ae099a.json new file mode 100644 index 0000000..b06abcf --- /dev/null +++ b/applied-prod/transferLogicMinting-6714325b1663ff1e81aa73d1f38a186655599c69c932e8acb2ae099a.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Transfer Logic Minting", + "cborHex": "58ac58aa0100003232323232332225333004332323002233002002001230022330020020012253335573e002294054ccc018cdd798040008020a51130023007001323758600e64600e600e600e600e600e600e600e600e0026010002600c600e0022930b1ba94881147065726d697373696f6e6564206d696e74696e67004c011e581c0a7d6e3ccfcfa0ff5eaeec29e40b26088f62036a1a696b89f33d669e005734ae895d0918011baa0015573d" +} diff --git a/applied-prod/transferLogicSpending-5b7d265e7d862937c6e1a5266bba7dc685b786b1cc33551aa66867c9.json b/applied-prod/transferLogicSpending-5b7d265e7d862937c6e1a5266bba7dc685b786b1cc33551aa66867c9.json new file mode 100644 index 0000000..006d3e7 --- /dev/null +++ b/applied-prod/transferLogicSpending-5b7d265e7d862937c6e1a5266bba7dc685b786b1cc33551aa66867c9.json @@ -0,0 +1,5 @@ +{ + "type": "PlutusScriptV3", + "description": "Transfer Logic Spending", + "cborHex": "59027159026e01000032323232323232323233222323232323232533300d3300a3370e601c6ea8c03cc04001520043332223233300f222533301300114a2264646464a66603066e1d2004002132323232533301c33019330193372000400666e4000c004c8cc8c070894ccc07c0045280a999198108008a513003302200113002302300123375e603e0020320026eacc0780204cc02cc07c028c07c02458dd719299980d8008b099299980e0008980f8010b180f800980f0019bae301c002375c603600c6eb0c06800458c070008c05c004dd5180b980c000980b980c19180b980c180c80098021bad3016301830160020040023300e222533301333710900a000899801980b180b180b180b180b180b180b180b180b180b00119b810014805054ccc04ccdc424014002266006602c602c602c602c602c00466e04005200a133301122253330163370e00290000980c001099801980c80119b8100148008008004008dd618078029bac300f0033233300c222533301000110021330033253330123375e6028602c00201c2646464a66602a66e1d2002002161335740602e60346ea8c05cc068dd5180b800803180c801180a0009baa30143015301600110033013301532301430153016001301300130140014bd700009bac300f004149858c8c040c040c040004c03c004c038004c034004c034c02c008c02c004c02c00530122d87a9f581cfca77bcce1e5e73c97a0bfa8c90f7cd2faff6fd6ed5b6fec1c04eefaff004c011e581c8ea903ae40af4e0cff4164285b050c6a24ef10576b9fbf091a870b3f00223330050020014a0464600446600400400246004466004004002aae7d5cd2ab9d5742ae888c008dd5000aab9e01" +} diff --git a/deployment-root.json b/deployment-root.json new file mode 100644 index 0000000..acdb9ec --- /dev/null +++ b/deployment-root.json @@ -0,0 +1 @@ +{"srTarget":"Production","srTxIn":"08a8d0bb8717839931b0a594f7c28b0a3b7c78f6e9172e977e250eab7637d879#0"} \ No newline at end of file diff --git a/generated/openapi/schema.json b/generated/openapi/schema.json index e015260..a362c75 100644 --- a/generated/openapi/schema.json +++ b/generated/openapi/schema.json @@ -16,6 +16,21 @@ ], "type": "object" }, + "AddVKeyWitnessArgs_ConwayEra": { + "properties": { + "w_tx": { + "$ref": "#/components/schemas/TextEnvelopeJSON" + }, + "w_v_key_witness": { + "$ref": "#/components/schemas/TextEnvelopeJSON" + } + }, + "required": [ + "w_tx", + "w_v_key_witness" + ], + "type": "object" + }, "Address": { "description": "bech32-encoded cardano address", "example": "addr_test1qpju2uhn72ur6j5alln6nz7dqcgcjal7xjaw7lwdjdaex4qhr3xpz63fjwvlpsnu8efnhfdja78d3vkv8ks6ac09g3usemu2yl", @@ -132,6 +147,9 @@ ], "type": "object" }, + "TxId": { + "type": "string" + }, "TxIn": { "description": "TxIn consisting of (Transaction hash + # + index)", "example": "01f4b788593d4f70de2a45c2e1e87088bfbdfa29577ae1b62aba60e095e3ab53#2", @@ -359,6 +377,35 @@ } } }, + "/api/v1/tx/add-vkey-witness": { + "post": { + "description": "Add a VKey witness to a transaction", + "requestBody": { + "content": { + "application/json;charset=utf-8": { + "schema": { + "$ref": "#/components/schemas/AddVKeyWitnessArgs_ConwayEra" + } + } + } + }, + "responses": { + "200": { + "content": { + "application/json;charset=utf-8": { + "schema": { + "$ref": "#/components/schemas/TextEnvelopeJSON" + } + } + }, + "description": "" + }, + "400": { + "description": "Invalid `body`" + } + } + } + }, "/api/v1/tx/programmable-token/blacklist": { "post": { "description": "Add a credential to the blacklist", @@ -474,6 +521,35 @@ } } } + }, + "/api/v1/tx/submit": { + "post": { + "description": "Submit a transaction to the blockchain", + "requestBody": { + "content": { + "application/json;charset=utf-8": { + "schema": { + "$ref": "#/components/schemas/TextEnvelopeJSON" + } + } + } + }, + "responses": { + "200": { + "content": { + "application/json;charset=utf-8": { + "schema": { + "$ref": "#/components/schemas/TxId" + } + } + }, + "description": "" + }, + "400": { + "description": "Invalid `body`" + } + } + } } } } \ No newline at end of file diff --git a/src/exe/export-smart-tokens/Main.hs b/src/exe/export-smart-tokens/Main.hs index ec77ac9..17a835a 100644 --- a/src/exe/export-smart-tokens/Main.hs +++ b/src/exe/export-smart-tokens/Main.hs @@ -1,14 +1,27 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where +import Cardano.Api qualified as C +import Cardano.Api.Shelley qualified as C import Cardano.Binary qualified as CBOR -import Data.Aeson (KeyValue ((.=)), object) +import Control.Monad (when) +import Control.Monad.IO.Class +import Control.Monad.Reader (asks) +import Data.Aeson (KeyValue ((.=)), eitherDecode, object) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Bifunctor (first) import Data.ByteString.Base16 qualified as Base16 import Data.ByteString.Lazy qualified as LBS +import Data.ByteString.Lazy.Char8 qualified as LBS8 +import Data.String (IsString (..)) import Data.Text (Text, pack) +import Data.Text qualified as Text import Data.Text.Encoding qualified as Text +import Options.Applicative (Parser, argument, customExecParser, disambiguate, + eitherReader, help, helper, idm, info, metavar, + prefs, showHelpOnEmpty, showHelpOnError) +import Options.Applicative.Builder (ReadM) import Plutarch (Config (..), LogLevel (..), TracingMode (..), compile) import Plutarch.Evaluate (applyArguments, evalScript) import Plutarch.Prelude @@ -22,9 +35,19 @@ import SmartTokens.Contracts.ProgrammableLogicBase (mkProgrammableLogicBase, import SmartTokens.Contracts.ProtocolParams (alwaysFailScript, mkPermissionedMinting, mkProtocolParametersMinting) +import SmartTokens.Core.Scripts (ScriptTarget (Production)) import SmartTokens.LinkedList.MintDirectory (mkDirectoryNodeMP) import SmartTokens.LinkedList.SpendBlacklist (pmkBlacklistSpending) import SmartTokens.LinkedList.SpendDirectory (pmkDirectorySpending) +import Text.Read (readMaybe) +import Wst.Offchain.Env (BlacklistTransferLogicScriptRoot (..), + DirectoryEnv (..), + DirectoryScriptRoot (DirectoryScriptRoot), + HasDirectoryEnv (directoryEnv), TransferLogicEnv (..), + mkDirectoryEnv, programmableTokenMintingScript, + transferLogicEnv, withDirectoryFor, withEnv, + withTransferFor) +import Wst.Server.Types (SerialiseAddress (..)) encodeSerialiseCBOR :: Script -> Text encodeSerialiseCBOR = Text.decodeUtf8 . Base16.encode . CBOR.serialize' . serialiseScript @@ -60,7 +83,68 @@ writePlutusScriptNoTrace :: String -> FilePath -> ClosedTerm a -> IO () writePlutusScriptNoTrace = writePlutusScript NoTracing main :: IO () -main = do +main = runMain + +runMain :: IO () +runMain = + customExecParser + (prefs $ disambiguate <> showHelpOnEmpty <> showHelpOnError) + (info (helper <*> parseExportCommand) idm) + >>= runExportCommand + +runExportCommand :: ExportCommand -> IO () +runExportCommand ExportCommand{ecTxIn, ecIssuerAddress=SerialiseAddress issuerAddr} = do + let opkh = case issuerAddr of + (C.ShelleyAddress _ntw (C.fromShelleyPaymentCredential -> C.PaymentCredentialByKey pmt) _stakeRef) -> pmt + _ -> error "Expected public key address" -- FIXME: proper error + dirRoot = DirectoryScriptRoot ecTxIn Production + blacklistTransferRoot = BlacklistTransferLogicScriptRoot Production (mkDirectoryEnv dirRoot) opkh + + withEnv $ + withDirectoryFor dirRoot $ do + withTransferFor blacklistTransferRoot $ do + transferEnv@TransferLogicEnv + { tleBlacklistMintingScript + , tleBlacklistSpendingScript + , tleMintingScript + , tleTransferScript + , tleIssuerScript + } <- asks transferLogicEnv + dirEnv@DirectoryEnv + { dsDirectoryMintingScript + , dsDirectorySpendingScript + , dsProtocolParamsMintingScript + , dsProtocolParamsSpendingScript + , dsProgrammableLogicBaseScript + , dsProgrammableLogicGlobalScript + } <- asks directoryEnv + let programmableMinting = programmableTokenMintingScript dirEnv transferEnv + writeAppliedScript "./applied-prod/protocolParametersNFTMinting" "Protocol Parameters NFT" dsProtocolParamsMintingScript + writeAppliedScript "./applied-prod/protocolParametersSpending" "Protocol Parameters Spending" dsProtocolParamsSpendingScript + writeAppliedScript "./applied-prod/programmableLogicBaseSpending" "Programmable Logic Base" dsProgrammableLogicBaseScript + writeAppliedScript "./applied-prod/programmableLogicGlobalStake" "Programmable Logic Global" dsProgrammableLogicGlobalScript + writeAppliedScript "./applied-prod/directoryNodeMinting" "Directory Node Minting Policy" dsDirectoryMintingScript + writeAppliedScript "./applied-prod/directoryNodeSpending" "Directory Spending" dsDirectorySpendingScript + writeAppliedScript "./applied-prod/blacklistSpending" "Blacklist Spending" tleBlacklistSpendingScript + writeAppliedScript "./applied-prod/blacklistMinting" "Blacklist Minting" tleBlacklistMintingScript + writeAppliedScript "./applied-prod/transferLogicMinting" "Transfer Logic Minting" tleMintingScript + writeAppliedScript "./applied-prod/transferLogicSpending" "Transfer Logic Spending" tleTransferScript + writeAppliedScript "./applied-prod/transferLogicIssuerSpending" "Transfer Logic Issuer Spending" tleIssuerScript + writeAppliedScript "./applied-prod/programmableTokenMinting" "Programmable Token Minting" programmableMinting + + exportUnapplied + +writeAppliedScript :: forall m lang. (MonadIO m, C.IsPlutusScriptLanguage lang) => FilePath -> C.TextEnvelopeDescr -> C.PlutusScript lang -> m () +writeAppliedScript path desc script = liftIO $ do + let lang = C.plutusScriptVersion @lang + hsh = C.hashScript $ C.PlutusScript lang script + hshStr = C.serialiseToRawBytesHexText hsh + path' = path <> "-" <> Text.unpack hshStr <> ".json" + C.writeFileTextEnvelope (C.File path') (Just desc) script >>= either (error . show) pure + + +exportUnapplied :: IO () +exportUnapplied = do putStrLn "Writing Plutus Scripts to files" writePlutusScriptTraceBind "Programmable Logic Base" "./compiled-binds/programmableLogicBase.json" mkProgrammableLogicBase writePlutusScriptTraceBind "Programmable Logic Global" "./compiled-binds/programmableLogicGlobal.json" mkProgrammableLogicGlobal @@ -97,3 +181,31 @@ main = do writePlutusScriptNoTrace "Directory Node Minting Policy" "./compiled-prod/directoryNodeMintingPolicy.json" mkDirectoryNodeMP writePlutusScriptNoTrace "Directory Spending" "./compiled-prod/directorySpending.json" pmkDirectorySpending writePlutusScriptNoTrace "Blacklist Spending" "./compiled-prod/blacklistSpending.json" pmkBlacklistSpending + +data ExportCommand = ExportCommand + { ecTxIn :: C.TxIn + , ecIssuerAddress :: SerialiseAddress (C.Address C.ShelleyAddr) + } + +parseExportCommand :: Parser ExportCommand +parseExportCommand = ExportCommand <$> parseTxIn <*> parseAddress + +parseAddress :: Parser (SerialiseAddress (C.Address C.ShelleyAddr)) +parseAddress = argument (eitherReader (eitherDecode . LBS8.pack)) (help "The address to use for the issuer" <> metavar "ISSUER_ADDRESS") + +parseTxIn :: Parser C.TxIn +parseTxIn = + argument + txInReader + (help "The TxIn that was selected when deploying the system. Format: ." <> metavar "TX_IN") + +txInReader :: ReadM C.TxIn +txInReader = eitherReader $ \str -> do + (txId, txIx) <- case break (== '.') str of + (txId, _:txIx) -> Right (txId, txIx) + _ -> Left "Expected ." + when (length txId /= 64) $ Left "Expected tx ID with 64 characters" + ix <- case readMaybe @Word txIx of + Nothing -> Left "Expected tx index" + Just n -> Right (C.TxIx n) + return $ C.TxIn (fromString txId) ix diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index f2ce639..ee60526 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -143,7 +143,10 @@ executable export-smart-tokens , base , base16-bytestring , bytestring + , cardano-api , cardano-binary + , mtl + , optparse-applicative , plutarch , plutus-ledger-api , text From 0f2550e7857a37c82bbd734af68f5814c81f8110 Mon Sep 17 00:00:00 2001 From: Amir Rad Date: Wed, 15 Jan 2025 14:57:55 +0000 Subject: [PATCH 22/22] Fix nix ci script --- .github/workflows/ci-nix.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci-nix.yaml b/.github/workflows/ci-nix.yaml index 0a63ed6..244965d 100644 --- a/.github/workflows/ci-nix.yaml +++ b/.github/workflows/ci-nix.yaml @@ -57,6 +57,6 @@ jobs: - name: check compiled scripts are consistent # git diff --quiet implies --exit-code run: | - nix run --accept-flake-config .#export-smart-tokens + nix run --accept-flake-config .#export-smart-tokens 08a8d0bb8717839931b0a594f7c28b0a3b7c78f6e9172e977e250eab7637d879.0 '"addr_test1qq986m3uel86pl674mkzneqtycyg7csrdgdxj6uf7v7kd857kquweuh5kmrj28zs8czrwkl692jm67vna2rf7xtafhpqk3hecm"' git diff --quiet