Merge pull request #793 from input-output-hk/plt-8805-embed-validators

PLT-8805 Embed Validators

marlowe-cli/cli-test/Language/Marlowe/CLI/Test/CLI/Interpret.hs

@@ -66,7 +66,6 @@ import Data.Map.Strict qualified as Map
 import Data.Maybe (fromMaybe, isJust, mapMaybe, maybeToList)
 import Data.Text qualified as Text
 import Data.Traversable (for)
-import Language.Marlowe.CLI.Cardano.Api.PlutusScript (IsPlutusScriptLanguage)
 import Language.Marlowe.CLI.Run (
   autoRunTransactionImpl,
   autoWithdrawFundsImpl,
@@ -171,14 +170,13 @@ toOneLineJSON :: forall a. (A.ToJSON a) => a -> String
 toOneLineJSON = Text.unpack . A.renderValue . A.toJSON
 
 autoRunTransaction
-  :: forall era env lang m st
+  :: forall era env m st
    . (IsShelleyBasedEra era)
-  => (IsPlutusScriptLanguage lang)
-  => (InterpretMonad env st m lang era)
+  => (InterpretMonad env st m C.PlutusScriptV2 era)
   => Maybe CurrencyNickname
   -> WalletNickname
-  -> Maybe (MarloweTransaction lang era, C.TxIn)
-  -> MarloweTransaction lang era
+  -> Maybe (MarloweTransaction C.PlutusScriptV2 era, C.TxIn)
+  -> MarloweTransaction C.PlutusScriptV2 era
   -> Bool
   -> m (C.TxBody era, Maybe C.TxIn)
 autoRunTransaction currency defaultSubmitter prev curr@MarloweTransaction{..} invalid = do
@@ -242,7 +240,7 @@ autoRunTransaction currency defaultSubmitter prev curr@MarloweTransaction{..} in
                     OutputQueryResult{oqrMatching = fromUTxO -> (AnUTxO (txIn, _) : _)} -> do
                       let scriptOrReference = validatorInfoScriptOrReference openRoleValidatorInfo
                           redeemer = P.Redeemer $ P.toBuiltinData P.emptyByteString
-                          payFromOpenRole :: PayFromScript lang
+                          payFromOpenRole :: PayFromScript C.PlutusScriptV2
                           payFromOpenRole = buildPayFromScript scriptOrReference Nothing redeemer txIn
 
                       pure ([], [payFromOpenRole])
@@ -299,13 +297,12 @@ autoRunTransaction currency defaultSubmitter prev curr@MarloweTransaction{..} in
       throwError $ testExecutionFailed' "[AutoRun] Multiple Marlowe outputs detected - unable to handle them yet."
 
 publishCurrentValidators
-  :: forall env era lang st m
+  :: forall env era st m
    . (C.IsShelleyBasedEra era)
-  => (IsPlutusScriptLanguage lang)
-  => (InterpretMonad env st m lang era)
+  => (InterpretMonad env st m C.PlutusScriptV2 era)
   => Maybe Bool
   -> Maybe WalletNickname
-  -> m (MarloweScriptsRefs lang era)
+  -> m (MarloweScriptsRefs C.PlutusScriptV2 era)
 publishCurrentValidators publishPermanently possiblePublisher = do
   let walletNickname = fromMaybe faucetNickname possiblePublisher
 
@@ -321,7 +318,7 @@ publishCurrentValidators publishPermanently possiblePublisher = do
       fnName = "publishCurrentValidators"
       logTraceMsg' = logStoreLabeledMsg fnName
       queryCtx = toQueryContext txBuildupCtx
-  runCli era fnName (findMarloweScriptsRefs @_ @lang queryCtx publishingStrategy printStats) >>= \case
+  runCli era fnName (findMarloweScriptsRefs @_ queryCtx publishingStrategy printStats) >>= \case
     Just marloweScriptRefs@(MarloweScriptsRefs (AnUTxO (mTxIn, _), mv) (AnUTxO (pTxIn, _), pv) (AnUTxO (orTxIn, _), orv)) -> do
       let logValidatorInfo ValidatorInfo{..} =
             logTraceMsg' $ Text.unpack (C.serialiseAddress viAddress)
@@ -353,10 +350,9 @@ publishCurrentValidators publishPermanently possiblePublisher = do
       pure refs
 
 interpret
-  :: forall env era lang st m
+  :: forall env era st m
    . (C.IsShelleyBasedEra era)
-  => (IsPlutusScriptLanguage lang)
-  => (InterpretMonad env st m lang era)
+  => (InterpretMonad env st m C.PlutusScriptV2 era)
   => CLIOperation
   -> m ()
 interpret co@Initialize{..} = do
@@ -501,7 +497,7 @@ interpret AutoRun{..} = do
             drop l whole
           Nothing -> whole
       step mTh mt = do
-        let prev :: Maybe (MarloweTransaction lang era, C.TxIn)
+        let prev :: Maybe (MarloweTransaction C.PlutusScriptV2 era, C.TxIn)
             prev = do
               pmt <- overAnyMarloweThread getCLIMarloweThreadTransaction <$> mTh
               txIn <- overAnyMarloweThread marloweThreadTxIn =<< mTh
@@ -547,7 +543,7 @@ interpret co@Withdraw{..} = do
   txBuildupCtx <- view txBuildupContextL
   txBodies <- foldMapMFlipped roles \role -> do
     let lastWithdrawalCheckPoint = Map.lookup role _ciWithdrawalsCheckPoints
-        threadTransactions :: [(MarloweTransaction lang era, C.TxId)]
+        threadTransactions :: [(MarloweTransaction C.PlutusScriptV2 era, C.TxId)]
         threadTransactions = do
           let step item acc = (getCLIMarloweThreadTransaction item, C.getTxId . getCLIMarloweThreadTxBody $ item) : acc
           overAnyMarloweThread (foldrMarloweThread step []) marloweThread

marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Interpret.hs

@@ -8,14 +8,14 @@
 module Language.Marlowe.CLI.Test.Interpret where
 
 import Cardano.Api (IsShelleyBasedEra)
+import Cardano.Api qualified as C
 import Contrib.Control.Concurrent (threadDelay)
 import Control.Monad.Except (MonadError (throwError), catchError)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.State.Class (get)
 import Data.Aeson qualified as A
 import Data.Aeson.OneLine qualified as A
 import Data.Text qualified as T
-import Language.Marlowe.CLI.Cardano.Api.PlutusScript (IsPlutusScriptLanguage)
 import Language.Marlowe.CLI.Test.CLI.Interpret qualified as CLI
 import Language.Marlowe.CLI.Test.InterpreterError (testExecutionFailed')
 import Language.Marlowe.CLI.Test.Log (Label (label), logLabeledMsg, logStoreLabeledMsg, throwLabeledError)
@@ -28,10 +28,9 @@ import Language.Marlowe.CLI.Test.Types (
 import Language.Marlowe.CLI.Test.Wallet.Interpret qualified as Wallet
 
 interpret
-  :: forall m lang era
+  :: forall m era
    . (IsShelleyBasedEra era)
-  => (IsPlutusScriptLanguage lang)
-  => (InterpretMonad m lang era)
+  => (InterpretMonad m C.PlutusScriptV2 era)
   => TestOperation
   -> m ()
 interpret (RuntimeOperation ro) = do

marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Runner.hs

@@ -80,7 +80,6 @@ import Language.Marlowe.CLI.Cardano.Api (
   toPlutusProtocolVersion,
   txOutValueValue,
  )
-import Language.Marlowe.CLI.Cardano.Api.PlutusScript (IsPlutusScriptLanguage)
 import Language.Marlowe.CLI.Cardano.Api.Value (
   lovelaceToPlutusValue,
   toPlutusValue,
@@ -377,19 +376,18 @@ liftCliEither = liftIO . liftEitherIO . first fromCLIError
 -- Useful helper to use the interpreter as a part of the test runner.
 -- We don't run runtime monitor thread here because we don't need it.
 execWalletOperations
-  :: forall era lang m resource
+  :: forall era m resource
    . (IsShelleyBasedEra era)
-  => (IsPlutusScriptLanguage lang)
   => (MonadIO m)
-  => (MonadReader (Env lang era resource) m)
-  => InterpretState lang era
+  => (MonadReader (Env C.PlutusScriptV2 era resource) m)
+  => InterpretState C.PlutusScriptV2 era
   -> [Wallet.WalletOperation]
   -> m
       ( Either
           ( TestRunnerError
-          , InterpretState lang era
+          , InterpretState C.PlutusScriptV2 era
           )
-          (InterpretState lang era)
+          (InterpretState C.PlutusScriptV2 era)
       )
 execWalletOperations interpretState operations =
   runExceptT
@@ -482,12 +480,11 @@ type TestInterpreterM lang era a =
 --  * `Right` - close the loop imidiatelly. It is a definite result.
 --  * `Left` - possibly try again. the result is not definite and retry could change it.
 interpretTest
-  :: forall lang era
+  :: forall era
    . (IsShelleyBasedEra era)
-  => (IsPlutusScriptLanguage lang)
   => [TestOperation]
-  -> PrevResult (TestResult lang era) (TestResult lang era)
-  -> TestInterpreterM lang era (Either (TestResult lang era) (TestResult lang era))
+  -> PrevResult (TestResult C.PlutusScriptV2 era) (TestResult C.PlutusScriptV2 era)
+  -> TestInterpreterM C.PlutusScriptV2 era (Either (TestResult C.PlutusScriptV2 era) (TestResult C.PlutusScriptV2 era))
 interpretTest testOperations (PrevResult possiblePrevResult) = do
   stateRef <- views envResource snd
   (testEnv, possibleRuntimeMonitor) <- setupTestInterpretEnv
@@ -606,9 +603,8 @@ acquireTestInterpretContext = do
 releaseTestInterpretContext
   :: (MonadIO m)
   => (IsShelleyBasedEra era)
-  => (IsPlutusScriptLanguage lang)
-  => (MonadReader (TestRunnerEnv lang era) m)
-  => TestInterpretContext lang era
+  => (MonadReader (TestRunnerEnv C.PlutusScriptV2 era) m)
+  => TestInterpretContext C.PlutusScriptV2 era
   -> m ()
 releaseTestInterpretContext (stateRef, faucet) =
   -- In the last phase we execute two cleanup operations
@@ -638,11 +634,10 @@ releaseTestInterpretContext (stateRef, faucet) =
 type TestRunnerM lang era a = ReaderT (TestRunnerEnv lang era) IO a
 
 runTest
-  :: forall era lang
-   . (IsPlutusScriptLanguage lang)
-  => (IsShelleyBasedEra era)
+  :: forall era
+   . (IsShelleyBasedEra era)
   => (FilePath, TestCase)
-  -> TestRunnerM lang era ()
+  -> TestRunnerM C.PlutusScriptV2 era ()
 runTest (testFile, testCase@TestCase{testName, operations = testOperations}) = do
   liftIO $ hPutStrLn stderr ""
   liftIO $ hPutStrLn stderr $ "***** Test " <> coerce testName <> " *****"
@@ -700,11 +695,10 @@ type TestSuiteRunnerInternalEnv lang era =
   Env lang era (TVar (MasterFaucet era))
 
 acquireFaucets
-  :: forall era lang m
+  :: forall era m
    . (IsShelleyBasedEra era)
   => (MonadIO m)
-  => (IsPlutusScriptLanguage lang)
-  => (MonadReader (TestSuiteRunnerInternalEnv lang era) m)
+  => (MonadReader (TestSuiteRunnerInternalEnv C.PlutusScriptV2 era) m)
   => TestFaucetBudget
   -> FaucetsNumber
   -> m (TVar [TestRunnerFaucet era])
@@ -759,11 +753,10 @@ acquireFaucets (TestFaucetBudget testFaucetBudget) (FaucetsNumber faucetNumber)
   liftIO $ newTVarIO subfaucets
 
 releaseFaucets
-  :: forall era lang m
+  :: forall era m
    . (IsShelleyBasedEra era)
   => (MonadIO m)
-  => (IsPlutusScriptLanguage lang)
-  => (MonadReader (TestSuiteRunnerInternalEnv lang era) m)
+  => (MonadReader (TestSuiteRunnerInternalEnv C.PlutusScriptV2 era) m)
   => TVar [TestRunnerFaucet era]
   -> m ()
 releaseFaucets subfaucetsRef = do
@@ -901,12 +894,11 @@ unmaskedReleaseBracket' before after thing =
 makeLenses ''TestSuiteResult
 
 runTests
-  :: forall era lang
+  :: forall era
    . (IsShelleyBasedEra era)
-  => (IsPlutusScriptLanguage lang)
   => [(FilePath, TestCase)]
   -> MaxConcurrentRunners
-  -> TestSuiteRunnerM lang era (TestSuiteResult lang era)
+  -> TestSuiteRunnerM C.PlutusScriptV2 era (TestSuiteResult C.PlutusScriptV2 era)
 runTests tests (MaxConcurrentRunners maxConcurrentRunners) = do
   protocolParams <- view envProtocolParams
   let concurrentRunners = min maxConcurrentRunners (length tests)

marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Wallet/Interpret.hs

@@ -10,7 +10,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Language.Marlowe.CLI.Test.Wallet.Interpret where
@@ -60,7 +59,6 @@ import Data.Tuple.Extra (uncurry3)
 import Language.Marlowe.CLI.Cardano.Api (toReferenceTxInsScriptsInlineDatumsSupportedInEra, toTxOutDatumInline)
 import Language.Marlowe.CLI.Cardano.Api.Value (lovelaceToPlutusValue, toCurrencySymbol, toPlutusValue)
 import Language.Marlowe.CLI.Cardano.Api.Value qualified as CV
-import Language.Marlowe.CLI.Export (readOpenRoleValidator)
 import Language.Marlowe.CLI.IO (readSigningKey, submitTxBody')
 import Language.Marlowe.CLI.Run (toCardanoPolicyId)
 import Language.Marlowe.CLI.Sync (toPlutusAddress)
@@ -132,6 +130,7 @@ import Language.Marlowe.CLI.Types (
 import Language.Marlowe.CLI.Types qualified as CT
 import Language.Marlowe.Cardano (marloweNetworkFromCaradnoNetworkId)
 import Language.Marlowe.Core.V1.Semantics.Types qualified as M
+import Language.Marlowe.Scripts (openRolesValidator)
 import PlutusLedgerApi.V1 (CurrencySymbol, TokenName)
 import PlutusLedgerApi.V1.Value (valueOf)
 import PlutusLedgerApi.V1.Value qualified as P
@@ -235,8 +234,7 @@ openRoleValidatorAddress
 openRoleValidatorAddress = do
   era <- view eraL
   networkId <- getNetworkId
-  openRoleScript <- readOpenRoleValidator @_ @C.PlutusScriptV2
-  pure $ validatorAddress openRoleScript era networkId NoStakeAddress
+  pure $ validatorAddress openRolesValidator era networkId NoStakeAddress
 
 getNetworkId
   :: forall env st m era

marlowe-cli/command/Language/Marlowe/CLI/Command/Contract.hs

@@ -22,6 +22,8 @@ module Language.Marlowe.CLI.Command.Contract (
 
 import Cardano.Api (NetworkId (..), StakeAddressReference (..))
 import Control.Monad.Except (MonadError, MonadIO)
+import Control.Monad.Reader.Class (MonadReader)
+import Data.Map qualified as Map
 import Data.Maybe (fromMaybe)
 import Language.Marlowe.CLI.Command.Parse (
   parseCurrencySymbol,
@@ -36,15 +38,11 @@ import Language.Marlowe.CLI.Export (
   exportMarloweValidator,
   exportRedeemer,
  )
+import Language.Marlowe.CLI.IO (getDefaultCostModel)
 import Language.Marlowe.CLI.Types (CliEnv, CliError)
 import Language.Marlowe.Client (defaultMarloweParams, marloweParams)
-import PlutusLedgerApi.V1 (CurrencySymbol, ProtocolVersion)
-
-import Cardano.Api qualified as C
-import Control.Monad.Reader.Class (MonadReader)
-import Data.Map qualified as Map
-import Language.Marlowe.CLI.IO (getDefaultCostModel)
 import Options.Applicative qualified as O
+import PlutusLedgerApi.V1 (CurrencySymbol, ProtocolVersion)
 
 -- | Marlowe CLI commands and options for exporting data.
 data ContractCommand
@@ -131,7 +129,7 @@ runContractCommand command =
         stake' = fromMaybe NoStakeAddress $ stake command
     case command of
       Export{..} ->
-        exportMarlowe @_ @C.PlutusScriptV2
+        exportMarlowe @_
           marloweParams'
           protocolVersion
           (Map.elems costModel)
@@ -142,9 +140,9 @@ runContractCommand command =
           inputFiles
           outputFile
           printStats
-      ExportAddress{} -> exportMarloweAddress @_ @C.PlutusScriptV2 network' stake'
+      ExportAddress{} -> exportMarloweAddress @_ network' stake'
       ExportValidator{..} ->
-        exportMarloweValidator @_ @C.PlutusScriptV2
+        exportMarloweValidator @_
           protocolVersion
           (Map.elems costModel)
           network'

marlowe-cli/command/Language/Marlowe/CLI/Command/Role.hs

@@ -21,7 +21,6 @@ module Language.Marlowe.CLI.Command.Role (
 ) where
 
 import Cardano.Api (NetworkId (..), StakeAddressReference (..))
-import Cardano.Api qualified as C
 import Control.Monad.Except (MonadError, MonadIO)
 import Control.Monad.Reader.Class (MonadReader)
 import Data.Map qualified as Map
@@ -100,9 +99,9 @@ runRoleCommand command =
     let network' = network command
         stake' = fromMaybe NoStakeAddress $ stake command
     case command of
-      ExportAddress{} -> exportRoleAddress @_ @C.PlutusScriptV2 network' stake'
+      ExportAddress{} -> exportRoleAddress @_ network' stake'
       ExportValidator{..} -> do
-        exportRoleValidator @_ @C.PlutusScriptV2
+        exportRoleValidator @_
           protocolVersion
           (Map.elems costModel)
           network'

marlowe-cli/command/Language/Marlowe/CLI/Command/Transaction.hs

@@ -70,7 +70,6 @@ import Language.Marlowe.CLI.Types (
  )
 
 import Cardano.Api qualified as Api (Value)
-import Cardano.Api qualified as C
 import Control.Monad.Reader.Class (MonadReader)
 import Data.Time.Units (Second)
 import Options.Applicative qualified as O
@@ -357,7 +356,7 @@ runTransactionCommand command =
           (fromMaybe 0 submitTimeout)
           >>= printTxId
       Publish{..} ->
-        buildPublishing @_ @C.PlutusScriptV2
+        buildPublishing @_
           connection
           signingKeyFile
           expires
@@ -367,7 +366,7 @@ runTransactionCommand command =
           submitTimeout
           (PrintStats True)
       FindPublished{..} ->
-        findPublished @_ @C.PlutusScriptV2
+        findPublished @_
           (QueryNode connection)
           strategy
 

marlowe-cli/marlowe-cli.cabal

@@ -111,7 +111,6 @@ library
     , directory
     , errors
     , extra
-    , filepath
     , indexed-traversable
     , marlowe-cardano
     , megaparsec