diff --git a/src/regulated-stablecoin/lib/Wst/Offchain/BuildTx/DirectorySet.hs b/src/regulated-stablecoin/lib/Wst/Offchain/BuildTx/DirectorySet.hs index 9c3b80db..10bb2b02 100644 --- a/src/regulated-stablecoin/lib/Wst/Offchain/BuildTx/DirectorySet.hs +++ b/src/regulated-stablecoin/lib/Wst/Offchain/BuildTx/DirectorySet.hs @@ -22,6 +22,7 @@ import Convex.PlutusLedger.V1 (transStakeCredential, unTransAssetName) import Convex.Scripts (toHashableScriptData) import Convex.Utils qualified as Utils import Data.ByteString.Base16 (decode) +import Data.Maybe (fromMaybe) import GHC.Exts (IsList (..)) import Plutarch.Evaluate (unsafeEvalTerm) import Plutarch.Internal.Term (Config (NoTracing)) @@ -90,7 +91,7 @@ data InsertNodeArgs = { inaNewKey :: CurrencySymbol , inaTransferLogic :: C.StakeCredential , inaIssuerLogic :: C.StakeCredential - , inaGlobalStateCS :: CurrencySymbol + , inaGlobalStateCS :: Maybe CurrencySymbol } 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 () @@ -123,7 +124,7 @@ insertDirectoryNode UTxODat{uIn=paramsRef} UTxODat{uIn, uOut=firstTxOut, uDatum= , next = next firstTxData , transferLogicScript = transStakeCredential inaTransferLogic , issuerLogicScript = transStakeCredential inaIssuerLogic - , globalStateCS = inaGlobalStateCS + , globalStateCS = fromMaybe (CurrencySymbol "") inaGlobalStateCS } newDat = C.TxOutDatumInline C.babbageBasedEra $ toHashableScriptData dsn insertedNode = C.TxOut addr newVal newDat C.ReferenceScriptNone diff --git a/src/regulated-stablecoin/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs b/src/regulated-stablecoin/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs index 45db5285..fd50c50b 100644 --- a/src/regulated-stablecoin/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs +++ b/src/regulated-stablecoin/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs @@ -52,7 +52,7 @@ import Wst.Offchain.Query (UTxODat (..)) -} 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{tleTransferScript, tleIssuerScript} <- asks Env.transferLogicEnv + inta@TransferLogicEnv{tleTransferScript, tleIssuerScript, tleGlobalParamsNft} <- asks Env.transferLogicEnv glParams <- asks (Env.globalParams . Env.directoryEnv) dir <- asks Env.directoryEnv @@ -77,10 +77,10 @@ issueProgrammableToken paramsTxOut (an, q) directoryList = Utils.inBabbage @era else do let nodeArgs = InsertNodeArgs - { inaNewKey = issuedSymbol + { inaNewKey = issuedSymbol , inaTransferLogic = C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion tleTransferScript - , inaIssuerLogic = C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion tleIssuerScript - , inaGlobalStateCS = CurrencySymbol "" + , inaIssuerLogic = C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion tleIssuerScript + , inaGlobalStateCS = tleGlobalParamsNft } mintPlutus mintingScript MintPToken an q diff --git a/src/regulated-stablecoin/lib/Wst/Offchain/Env.hs b/src/regulated-stablecoin/lib/Wst/Offchain/Env.hs index 06336dbe..2d5845a4 100644 --- a/src/regulated-stablecoin/lib/Wst/Offchain/Env.hs +++ b/src/regulated-stablecoin/lib/Wst/Offchain/Env.hs @@ -101,6 +101,7 @@ import Data.Maybe (listToMaybe) import Data.Proxy (Proxy (..)) import Data.Text qualified as Text import GHC.Generics (Generic) +import PlutusLedgerApi.V3 (CurrencySymbol) import SmartTokens.Core.Scripts (ScriptTarget) import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams (..)) import System.Environment qualified @@ -280,6 +281,7 @@ data TransferLogicEnv = , tleMintingScript :: PlutusScript PlutusScriptV3 , tleTransferScript :: PlutusScript PlutusScriptV3 , tleIssuerScript :: PlutusScript PlutusScriptV3 + , tleGlobalParamsNft :: Maybe CurrencySymbol } {-| 'IssueNewTokenArgs' for the policy that always succeeds (no checks) @@ -292,6 +294,7 @@ alwaysSucceedsTransferLogic target = , tleMintingScript = alwaysSucceedsScript target , tleTransferScript = alwaysSucceedsScript target , tleIssuerScript = alwaysSucceedsScript target + , tleGlobalParamsNft = Nothing } class HasTransferLogicEnv e where @@ -325,6 +328,7 @@ mkTransferLogicEnv BlacklistTransferLogicScriptRoot{tlrTarget, tlrDirEnv, tlrIss , tleMintingScript = permissionedMintingScript tlrTarget tlrIssuer , tleTransferScript = freezeTransferScript tlrTarget progLogicBaseCred blacklistPolicy , tleIssuerScript = permissionedSpendingScript tlrTarget tlrIssuer + , tleGlobalParamsNft = Nothing } blacklistNodePolicyId :: TransferLogicEnv -> C.PolicyId diff --git a/src/regulated-stablecoin/test/unit/Wst/Test/UnitTest.hs b/src/regulated-stablecoin/test/unit/Wst/Test/UnitTest.hs index a3437ae5..09c1ed34 100644 --- a/src/regulated-stablecoin/test/unit/Wst/Test/UnitTest.hs +++ b/src/regulated-stablecoin/test/unit/Wst/Test/UnitTest.hs @@ -8,13 +8,13 @@ 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 Control.Lens ((%~), (&), (^.)) +import Control.Lens ((%~), (&)) import Control.Monad (void) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT), asks) import Convex.BuildTx qualified as BuildTx -import Convex.Class (MonadBlockchain (queryProtocolParameters, sendTx), - MonadMockchain, MonadUtxoQuery, ValidationError, getTxById) +import Convex.Class (MonadBlockchain (sendTx), MonadMockchain, MonadUtxoQuery, + ValidationError, getTxById) import Convex.CoinSelection (ChangeOutputPosition (TrailingChange)) import Convex.MockChain (MockchainT) import Convex.MockChain.CoinSelection (tryBalanceAndSubmit) @@ -271,10 +271,10 @@ seizeUserOutput scriptRoot = failOnError $ Env.withEnv $ do dummyNodeArgs :: InsertNodeArgs dummyNodeArgs = InsertNodeArgs - { inaNewKey = CurrencySymbol (stringToBuiltinByteStringHex "e165610232235bbbbeff5b998b23e165610232235bbbbeff5b998b23") + { inaNewKey = CurrencySymbol (stringToBuiltinByteStringHex "e165610232235bbbbeff5b998b23e165610232235bbbbeff5b998b23") , inaTransferLogic = C.StakeCredentialByScript "e165610232235bbbbeff5b998b23e165610232235bbbbeff5b998b23" - , inaIssuerLogic = C.StakeCredentialByScript "e165610232235bbbbeff5b998b23e165610232235bbbbeff5b998b23" - , inaGlobalStateCS = CurrencySymbol "" + , inaIssuerLogic = C.StakeCredentialByScript "e165610232235bbbbeff5b998b23e165610232235bbbbeff5b998b23" + , inaGlobalStateCS = Nothing } {-| Register the 'alwaysSucceedsScript' stake validator