Extract role token minting validator to marlowe-plutus

marlowe-integration-tests/marlowe-integration-tests.cabal

@@ -94,6 +94,7 @@ executable marlowe-integration-tests
     , base16
     , bytestring
     , cardano-api ^>=8.2
+    , cardano-ledger-babbage
     , co-log >=0.5.0.0 && <0.6.0.0
     , containers
     , deepseq

marlowe-integration-tests/test/Language/Marlowe/Runtime/CliSpec.hs

@@ -8,15 +8,17 @@ import Cardano.Api (
   AsType (..),
   File (..),
   InAnyShelleyBasedEra (..),
+  ShelleyBasedEra (..),
   TxBody,
-  deserialiseFromCBOR,
   readFileTextEnvelope,
-  serialiseToCBOR,
   shelleyBasedToCardanoEra,
  )
+import Cardano.Api.Shelley (TxBody (ShelleyTxBody))
+import Cardano.Ledger.Babbage.Tx (BabbageTxBody (..))
 import qualified Control.Monad.Reader as Reader
 import qualified Data.Aeson as Aeson
 import Data.Foldable (for_)
+import Data.Function (on)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Data.Maybe as Maybe
@@ -185,20 +187,31 @@ expectSameResultFromCLIAndJobClient outputFile extraCliArgs extractTxBody comman
       jobClientEffect :: Integration (InAnyShelleyBasedEra TxBody)
       jobClientEffect = do
         InAnyShelleyBasedEra era txBody <- extractTxBody <$> marloweRuntimeJobClient command
-        either (fail . show) (pure . InAnyShelleyBasedEra era)
-          . deserialiseFromCBOR (AsTxBody $ cardanoEraToAsType $ shelleyBasedToCardanoEra era)
-          . serialiseToCBOR
-          $ txBody
+        pure $ InAnyShelleyBasedEra era txBody
 
-  (_, InAnyShelleyBasedEra era expected) <- concurrently cliEffect jobClientEffect
+  (_, InAnyShelleyBasedEra era (ShelleyTxBody ShelleyBasedEraBabbage expected _ _ _ _)) <-
+    concurrently cliEffect jobClientEffect
 
-  (either (error . show) id -> actual) <-
+  (either (error . show) id -> ShelleyTxBody ShelleyBasedEraBabbage actual _ _ _ _) <-
     liftIO $
       readFileTextEnvelope (AsTxBody (cardanoEraToAsType $ shelleyBasedToCardanoEra era)) $
         File txBodyEnvelopeFilePath
 
   liftIO do
-    actual `shouldBe` expected
+    on shouldBe btbInputs actual expected
+    on shouldBe btbCollateral actual expected
+    on shouldBe btbReferenceInputs actual expected
+    on shouldBe btbOutputs actual expected
+    on shouldBe btbCollateralReturn actual expected
+    on shouldBe btbCerts actual expected
+    on shouldBe btbWithdrawals actual expected
+    on shouldBe btbTxFee actual expected
+    on shouldBe btbUpdate actual expected
+    on shouldBe btbReqSignerHashes actual expected
+    on shouldBe btbMint actual expected
+    on shouldBe btbScriptIntegrityHash actual expected
+    on shouldBe btbAuxDataHash actual expected
+    on shouldBe btbTxNetworkId actual expected
 
 toPosixTime :: Time.UTCTime -> PlutusLedgerApi.V2.POSIXTime
 toPosixTime t = PlutusLedgerApi.V2.POSIXTime $ floor $ 1000 * Time.nominalDiffTimeToSeconds (POSIX.utcTimeToPOSIXSeconds t)

marlowe-integration/marlowe-integration.cabal

@@ -74,7 +74,7 @@ library
     , marlowe-cli
     , marlowe-protocols
     , marlowe-runtime-web:{marlowe-runtime-web, server}
-    , marlowe-runtime:{marlowe-runtime, contract, indexer, proxy-api, runtime, sync}
+    , marlowe-runtime:{marlowe-runtime, contract, indexer, proxy-api, runtime, sync, tx}
     , network
     , nonempty-containers
     , postgresql-libpq

marlowe-integration/src/Test/Integration/Marlowe/Local.hs

@@ -114,6 +114,7 @@ import qualified Language.Marlowe.Runtime.Indexer.Database as Indexer
 import qualified Language.Marlowe.Runtime.Indexer.Database.PostgreSQL as IndexerDB
 import qualified Language.Marlowe.Runtime.Sync.Database as Sync
 import qualified Language.Marlowe.Runtime.Sync.Database.PostgreSQL as Sync
+import Language.Marlowe.Runtime.Transaction (mkCommandLineRoleTokenMintingPolicy)
 import Language.Marlowe.Runtime.Web.Client (healthcheck)
 import Language.Marlowe.Runtime.Web.Server (ServerDependencies (..), server)
 import Network.HTTP.Client (defaultManagerSettings, newManager)
@@ -451,15 +452,15 @@ toMarloweScripts testnetMagic MarloweScriptsRefs{..} = MarloweScripts{..}
     networkId = Testnet $ NetworkMagic $ fromIntegral testnetMagic
     marloweTxOutRef = fromCardanoTxIn $ fst $ unAnUTxO $ fst mrMarloweValidator
     payoutTxOutRef = fromCardanoTxIn $ fst $ unAnUTxO $ fst mrRolePayoutValidator
-    refScritptPublisher (AnUTxO (_, Cardano.TxOut addr _ _ _), _) = addr
+    refScriptPublisher (AnUTxO (_, Cardano.TxOut addr _ _ _), _) = addr
     refScriptValue (AnUTxO (_, Cardano.TxOut _ value _ _), _) = Cardano.txOutValueToValue value
 
     marloweReferenceScriptUTxO =
       ReferenceScriptUtxo
         { txOutRef = marloweTxOutRef
         , txOut =
             TransactionOutput
-              { address = fromCardanoAddressInEra BabbageEra $ refScritptPublisher mrMarloweValidator
+              { address = fromCardanoAddressInEra BabbageEra $ refScriptPublisher mrMarloweValidator
               , assets = assetsFromCardanoValue $ refScriptValue mrMarloweValidator
               , datumHash = Nothing
               , datum = Nothing
@@ -471,7 +472,7 @@ toMarloweScripts testnetMagic MarloweScriptsRefs{..} = MarloweScripts{..}
         { txOutRef = payoutTxOutRef
         , txOut =
             TransactionOutput
-              { address = fromCardanoAddressInEra BabbageEra $ refScritptPublisher mrRolePayoutValidator
+              { address = fromCardanoAddressInEra BabbageEra $ refScriptPublisher mrRolePayoutValidator
               , assets = assetsFromCardanoValue $ refScriptValue mrRolePayoutValidator
               , datumHash = Nothing
               , datum = Nothing
@@ -529,6 +530,7 @@ testContainer = proc TestContainerDependencies{..} -> do
             confirmationTimeout = 60
             runtimeVersion = Version [0] []
             indexParties = pure ()
+            mkRoleTokenMintingPolicy = mkCommandLineRoleTokenMintingPolicy "marlowe-minting-validator"
          in MarloweRuntimeDependencies{..}
 
   tcpServer "marlowe-runtime"

marlowe-runtime/marlowe-runtime.cabal

@@ -531,6 +531,8 @@ library tx
     , async
     , async-components ==0.1.1.0
     , base >=4.9 && <5
+    , base16 ^>=0.3.2
+    , bytestring >=0.10.12 && <0.12
     , cardano-api ^>=8.2
     , cardano-ledger-core ^>=1.2
     , co-log >=0.5.0.0 && <0.6.0.0
@@ -543,14 +545,15 @@ library tx
     , marlowe-cardano ==0.1.2.0
     , marlowe-chain-sync:{marlowe-chain-sync, plutus-compat} ==0.0.4
     , marlowe-protocols ==0.2.0.0
-    , marlowe-runtime:{marlowe-runtime, contract-api, history-api, plutus-scripts, tx-api} ==0.0.4
+    , marlowe-runtime:{marlowe-runtime, contract-api, history-api, tx-api} ==0.0.4
     , ouroboros-consensus ^>=0.7
     , ouroboros-network-api ^>=0.5
     , plutus-ledger-api ^>=1.5
     , plutus-tx ^>=1.5
     , retry ^>=0.9.3
     , semialign >=1.2 && <2
     , stm ^>=2.5
+    , text ^>=1.2
     , time >=1.9 && <2
     , transformers ^>=0.5.6
     , unliftio ^>=0.2.1
@@ -610,25 +613,6 @@ library runtime
     , typed-protocols ^>=0.1
     , unliftio ^>=0.2.1
 
-library plutus-scripts
-  import:          lang
-  hs-source-dirs:  plutus-scripts
-  visibility:      public
-
-  -- Needed to suppress the erroneous warning about plutus-tx-plugin not being
-  -- needed.
-  ghc-options:     -Wno-unused-packages
-  exposed-modules:
-    Language.Marlowe.Runtime.Plutus.V2.Scripts.MarloweV1.RoleTokensPolicy
-    Language.Marlowe.Runtime.Plutus.V2.Scripts.MarloweV1.RoleTokensPolicy.Types
-
-  build-depends:
-    , base >=4.9 && <5
-    , newtype-generics ^>=0.6.2
-    , plutus-ledger-api ^>=1.5
-    , plutus-tx ^>=1.5
-    , plutus-tx-plugin ^>=1.5
-
 library config
   import:          lang
   hs-source-dirs:  config

marlowe-runtime/marlowe-runtime/Main.hs

@@ -71,6 +71,7 @@ import qualified Language.Marlowe.Runtime.Indexer.Database.PostgreSQL as Indexer
 import qualified Language.Marlowe.Runtime.Indexer.Party as Party
 import qualified Language.Marlowe.Runtime.Sync.Database as Sync
 import qualified Language.Marlowe.Runtime.Sync.Database.PostgreSQL as SyncPostgres
+import Language.Marlowe.Runtime.Transaction (mkCommandLineRoleTokenMintingPolicy)
 import Logging (RootSelector (..), renderRootSelectorOTel)
 import Network.Protocol.Driver (TcpServerDependencies (..), tcpServer)
 import Network.Protocol.Driver.Trace (tcpServerTraced)
@@ -175,6 +176,7 @@ run Options{..} = bracket (Pool.acquire 100 (Just 5000000) (fromString databaseU
                   either throwIO pure =<< Pool.use pool do
                     connection <- ask
                     liftIO $ runInIO $ Party.indexParties connection
+              , mkRoleTokenMintingPolicy = mkCommandLineRoleTokenMintingPolicy mintingPolicyCmd
               }
 
       tcpServer "marlowe-runtime"
@@ -218,6 +220,7 @@ data Options = Options
   , lockingMicrosecondsBetweenRetries :: Word64
   , submitConfirmationBlocks :: BlockNo
   , httpPort :: PortNumber
+  , mintingPolicyCmd :: String
   }
 
 getOptions :: IO Options
@@ -246,6 +249,7 @@ getOptions = do
         <*> lockingMicrosecondsBetweenRetriesParser lockingMicrosecondsBetweenRetries
         <*> submitConfirmationBlocksParser
         <*> httpPortParser
+        <*> mintingPolicyCmdParser
 
     databaseUriParser =
       strOption $
@@ -447,6 +451,15 @@ getOptions = do
           , showDefault
           ]
 
+    mintingPolicyCmdParser =
+      strOption $
+        mconcat
+          [ long "minting-policy-cmd"
+          , metavar "CMD"
+          , help
+              "A command which creates the role token minting policy for a contract. It should read the arguments via the command line and output the serialized script binary to stdout."
+          ]
+
     infoMod =
       mconcat
         [ fullDesc

marlowe-runtime/marlowe-tx/Main.hs

@@ -14,10 +14,19 @@ import Control.Concurrent.Component.Run (AppM, runAppMTraced)
 import qualified Data.Text as T
 import Data.Time (NominalDiffTime)
 import Data.Version (showVersion)
-import Language.Marlowe.Runtime.ChainSync.Api (BlockNo (..), ChainSyncQuery (..), RuntimeChainSeekClient)
+import Language.Marlowe.Runtime.ChainSync.Api (
+  BlockNo (..),
+  ChainSyncQuery (..),
+  RuntimeChainSeekClient,
+ )
 import Language.Marlowe.Runtime.Contract.Api (ContractRequest)
 import qualified Language.Marlowe.Runtime.Core.ScriptRegistry as ScriptRegistry
-import Language.Marlowe.Runtime.Transaction (MarloweTx (..), TransactionDependencies (..), transaction)
+import Language.Marlowe.Runtime.Transaction (
+  MarloweTx (..),
+  TransactionDependencies (..),
+  mkCommandLineRoleTokenMintingPolicy,
+  transaction,
+ )
 import qualified Language.Marlowe.Runtime.Transaction.Query as Query
 import qualified Language.Marlowe.Runtime.Transaction.Submit as Submit
 import Logging (RootSelector (..), renderRootSelectorOTel)
@@ -99,6 +108,7 @@ run Options{..} = flip runComponent_ () proc _ -> do
                 payouts
           , getCurrentScripts = ScriptRegistry.getCurrentScripts
           , analysisTimeout = analysisTimeout
+          , mkRoleTokenMintingPolicy = mkCommandLineRoleTokenMintingPolicy mintingPolicyCmd
           , ..
           }
 
@@ -123,6 +133,7 @@ data Options = Options
   , submitConfirmationBlocks :: BlockNo
   , analysisTimeout :: NominalDiffTime
   , httpPort :: PortNumber
+  , mintingPolicyCmd :: String
   }
 
 getOptions :: IO Options
@@ -141,6 +152,7 @@ getOptions = execParser $ info (helper <*> parser) infoMod
         <*> submitConfirmationBlocksParser
         <*> analysisTimeoutParser
         <*> httpPortParser
+        <*> mintingPolicyCmdParser
 
     chainSeekPortParser =
       option auto $
@@ -233,6 +245,15 @@ getOptions = execParser $ info (helper <*> parser) infoMod
           , showDefault
           ]
 
+    mintingPolicyCmdParser =
+      strOption $
+        mconcat
+          [ long "minting-policy-cmd"
+          , metavar "CMD"
+          , help
+              "A command which creates the role token minting policy for a contract. It should read the arguments via the command line and output the serialized script binary to stdout."
+          ]
+
     submitConfirmationBlocksParser =
       option (BlockNo <$> auto) $
         mconcat