CLI Alonzo script support

cardano-api/src/Cardano/Api.hs

@@ -311,6 +311,7 @@ module Cardano.Api (
 
     -- * Use of a script in an era as a witness
     WitCtxTxIn, WitCtxMint, WitCtxStake,
+    WitCtx(..),
     ScriptWitness(..),
     Witness(..),
     KeyWitnessInCtx(..),
@@ -338,6 +339,9 @@ module Cardano.Api (
     -- ** Script data
     ScriptData(..),
 
+    -- * Script execution units
+    ExecutionUnits(..),
+
     -- ** Script addresses
     -- | Making addresses from scripts.
     ScriptHash,

cardano-api/src/Cardano/Api/Script.hs

@@ -33,6 +33,7 @@ module Cardano.Api.Script (
 
     -- * Use of a script in an era as a witness
     WitCtxTxIn, WitCtxMint, WitCtxStake,
+    WitCtx(..),
     ScriptWitness(..),
     Witness(..),
     KeyWitnessInCtx(..),
@@ -599,6 +600,17 @@ data WitCtxMint
 --
 data WitCtxStake
 
+
+-- | This GADT provides a value-level representation of all the witness
+-- contexts. This enables pattern matching on the context to allow them to be
+-- treated in a non-uniform way.
+--
+data WitCtx witctx where
+     WitCtxTxIn  :: WitCtx WitCtxTxIn
+     WitCtxMint  :: WitCtx WitCtxMint
+     WitCtxStake :: WitCtx WitCtxStake
+
+
 -- | A /use/ of a script within a transaction body to witness that something is
 -- being used in an authorised manner. That can be
 --

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -162,20 +162,20 @@ renderKeyCmd cmd =
 data TransactionCmd
   = TxBuildRaw
       AnyCardanoEra
-      [(TxIn, Maybe ScriptFile)]
+      [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
       -- ^ Transaction inputs with optional spending scripts
       [TxOutAnyEra]
-      (Maybe (Value, [ScriptFile]))
+      (Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
       -- ^ Multi-Asset value with script witness
       (Maybe SlotNo)
       -- ^ Transaction lower bound
       (Maybe SlotNo)
       -- ^ Transaction upper bound
       (Maybe Lovelace)
       -- ^ Tx fee
-      [(CertificateFile, Maybe ScriptFile)]
+      [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
       -- ^ Certificates with potential script witness
-      [(StakeAddress, Lovelace, Maybe ScriptFile)]
+      [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
       TxMetadataJsonSchema
       [ScriptFile]
       -- ^ Auxillary scripts

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -211,6 +211,14 @@ pScriptFor name help = ScriptFile <$> Opt.strOption
   <> Opt.completer (Opt.bashCompleter "file")
   )
 
+pScriptWitnessFiles :: WitCtx witctx
+                    -> String
+                    -> String
+                    -> Parser (ScriptWitnessFiles witctx)
+pScriptWitnessFiles _ name help =
+    -- Just the simple case for now. TODO: extend to Plutus witnesses.
+    SimpleScriptWitnessFile <$> pScriptFor name help
+
 pStakeAddressCmd :: Parser StakeAddressCmd
 pStakeAddressCmd =
     asum
@@ -515,7 +523,9 @@ pTransaction =
                                  <*> many pCertificateFile
                                  <*> many pWithdrawal
                                  <*> pTxMetadataJsonSchema
-                                 <*> many (pScriptFor "auxiliary-script-file" "Filepath of auxiliary script(s)")
+                                 <*> many (pScriptFor
+                                             "auxiliary-script-file"
+                                             "Filepath of auxiliary script(s)")
                                  <*> many pMetadataFile
                                  <*> optional pUpdateProposalFile
                                  <*> pTxBodyFile Output
@@ -1079,7 +1089,8 @@ pProtocolParamsFile =
       <> Opt.completer (Opt.bashCompleter "file")
       )
 
-pCertificateFile :: Parser (CertificateFile, Maybe ScriptFile)
+pCertificateFile :: Parser (CertificateFile,
+                            Maybe (ScriptWitnessFiles WitCtxStake))
 pCertificateFile =
   (,) <$> (CertificateFile
              <$> (  Opt.strOption
@@ -1092,7 +1103,10 @@ pCertificateFile =
                      Opt.strOption (Opt.long "certificate" <> Opt.internal)
                   )
           )
-      <*> optional (pScriptFor "certificate-script-file" "Filepath of the certificate script witness")
+      <*> optional (pScriptWitnessFiles
+                      WitCtxStake
+                      "certificate-script-file"
+                      "Filepath of the certificate script witness")
  where
    helpText = "Filepath of the certificate. This encompasses all \
               \types of certificates (stake pool certificates, \
@@ -1153,15 +1167,20 @@ pMetadataFile =
           <> Opt.completer (Opt.bashCompleter "file")
           )
 
-pWithdrawal :: Parser (StakeAddress, Lovelace, Maybe ScriptFile)
+pWithdrawal :: Parser (StakeAddress,
+                       Lovelace,
+                       Maybe (ScriptWitnessFiles WitCtxStake))
 pWithdrawal =
     (\(stakeAddr,lovelace) maybeScriptFp -> (stakeAddr, lovelace, maybeScriptFp))
       <$> Opt.option (readerFromAttoParser parseWithdrawal)
             (  Opt.long "withdrawal"
             <> Opt.metavar "WITHDRAWAL"
             <> Opt.help helpText
             )
-      <*> optional (pScriptFor "withdrawal-script-file" "Filepath of the withdrawal script witness.")
+      <*> optional (pScriptWitnessFiles
+                      WitCtxStake
+                      "withdrawal-script-file"
+                      "Filepath of the withdrawal script witness.")
  where
    helpText = "The reward withdrawal as StakeAddress+Lovelace where \
               \StakeAddress is the Bech32-encoded stake address \
@@ -1606,14 +1625,17 @@ pCardanoEra = asum
   , pure (AnyCardanoEra MaryEra)
   ]
 
-pTxIn :: Parser (TxIn, Maybe ScriptFile)
+pTxIn :: Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
 pTxIn =
      (,) <$> Opt.option (readerFromAttoParser parseTxIn)
                (  Opt.long "tx-in"
                 <> Opt.metavar "TX-IN"
                <> Opt.help "TxId#TxIx"
                )
-         <*> optional (pScriptFor "txin-script-file" "Filepath of the spending script witness")
+         <*> optional (pScriptWitnessFiles
+                         WitCtxTxIn
+                         "txin-script-file"
+                         "Filepath of the spending script witness")
 
 parseTxIn :: Atto.Parser TxIn
 parseTxIn = TxIn <$> parseTxId <*> (Atto.char '#' *> parseTxIx)
@@ -1657,15 +1679,18 @@ pMultiAsset =
       <> Opt.help "Multi-asset value(s) with the multi-asset cli syntax"
       )
 
-pMintMultiAsset :: Parser (Value, [ScriptFile])
+pMintMultiAsset :: Parser (Value, [ScriptWitnessFiles WitCtxMint])
 pMintMultiAsset =
   (,) <$> Opt.option
             (readerFromParsecParser parseValue)
               (  Opt.long "mint"
               <> Opt.metavar "VALUE"
               <> Opt.help helpText
               )
-      <*> some (pScriptFor "minting-script-file" "Filepath of the multi-asset witness script.")
+      <*> some (pScriptWitnessFiles
+                  WitCtxMint
+                  "minting-script-file"
+                  "Filepath of the multi-asset witness script.")
 
  where
    helpText = "Mint multi-asset value(s) with the multi-asset cli syntax. \

cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs

@@ -234,7 +234,7 @@ runTransactionCmd cmd =
 
 runTxBuildRaw
   :: AnyCardanoEra
-  -> [(TxIn, Maybe ScriptFile)]
+  -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
   -- ^ TxIn with potential script witness
   -> [TxOutAnyEra]
   -> Maybe SlotNo
@@ -243,11 +243,11 @@ runTxBuildRaw
   -- ^ Tx upper bound
   -> Maybe Lovelace
   -- ^ Tx fee
-  -> Maybe (Value, [ScriptFile])
+  -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -- ^ Multi-Asset value(s)
-  -> [(CertificateFile, Maybe ScriptFile)]
+  -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -- ^ Certificate with potential script witness
-  -> [(StakeAddress, Lovelace, Maybe ScriptFile)]
+  -> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
@@ -316,19 +316,22 @@ txFeatureMismatch era feature =
     left (ShelleyTxCmdTxFeatureMismatch (anyCardanoEra era) feature)
 
 validateTxIns
-  :: forall era. IsCardanoEra era
+  :: forall era.
+     IsCardanoEra era
   => CardanoEra era
-  -> [(TxIn, Maybe ScriptFile)]
-  -> ExceptT ShelleyTxCmdError IO [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
+  -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
+  -> ExceptT ShelleyTxCmdError IO
+             [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
 validateTxIns era = mapM convert
  where
    convert
-     :: (TxIn, Maybe ScriptFile)
-     -> ExceptT ShelleyTxCmdError IO (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
-   convert (txin, mScriptFile) =
-     case mScriptFile of
-       Just sFp -> do
-         sWit <- createScriptWitness era sFp
+     :: (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
+     -> ExceptT ShelleyTxCmdError IO
+                (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
+   convert (txin, mScriptWitnessFiles) =
+     case mScriptWitnessFiles of
+       Just scriptWitnessFiles -> do
+         sWit <- createScriptWitness era scriptWitnessFiles
          return ( txin
                 , BuildTxWith $ ScriptWitness ScriptWitnessForSpending sWit
                 )
@@ -445,7 +448,7 @@ validateTxAuxScripts era files =
 validateTxWithdrawals
   :: forall era. IsCardanoEra era
   => CardanoEra era
-  -> [(StakeAddress, Lovelace, Maybe ScriptFile)]
+  -> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> ExceptT ShelleyTxCmdError IO (TxWithdrawals BuildTx era)
 validateTxWithdrawals _ [] = return TxWithdrawalsNone
 validateTxWithdrawals era withdrawals =
@@ -456,13 +459,15 @@ validateTxWithdrawals era withdrawals =
       return (TxWithdrawals supported convWithdrawals)
  where
   convert
-    :: (StakeAddress, Lovelace, Maybe ScriptFile)
+    :: (StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))
     -> ExceptT ShelleyTxCmdError IO
-           (StakeAddress, Lovelace, BuildTxWith BuildTx (Witness WitCtxStake era))
-  convert (sAddr, ll, mScriptFile) =
-    case mScriptFile of
-      Just sFp -> do
-        sWit <- createScriptWitness era sFp
+              (StakeAddress,
+               Lovelace,
+               BuildTxWith BuildTx (Witness WitCtxStake era))
+  convert (sAddr, ll, mScriptWitnessFiles) =
+    case mScriptWitnessFiles of
+      Just scriptWitnessFiles -> do
+        sWit <- createScriptWitness era scriptWitnessFiles
         return ( sAddr
                , ll
                , BuildTxWith $ ScriptWitness ScriptWitnessForStakeAddr sWit
@@ -472,7 +477,7 @@ validateTxWithdrawals era withdrawals =
 validateTxCertificates
   :: forall era. IsCardanoEra era
   => CardanoEra era
-  -> [(CertificateFile, Maybe ScriptFile)]
+  -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> ExceptT ShelleyTxCmdError IO (TxCertificates BuildTx era)
 validateTxCertificates era certFiles =
   case certificatesSupportedInEra era of
@@ -502,16 +507,17 @@ validateTxCertificates era certFiles =
        _ -> return Nothing
 
    convert
-     :: (CertificateFile, Maybe ScriptFile)
-     -> ExceptT ShelleyTxCmdError IO (Maybe (StakeCredential, Witness WitCtxStake era))
-   convert (cert, mScript) = do
+     :: (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
+     -> ExceptT ShelleyTxCmdError IO
+                (Maybe (StakeCredential, Witness WitCtxStake era))
+   convert (cert, mScriptWitnessFiles) = do
      mStakeCred <- deriveStakeCredentialWitness cert
      case mStakeCred of
        Nothing -> return Nothing
        Just sCred ->
-         case mScript of
-           Just sFp -> do
-            sWit <- createScriptWitness era sFp
+         case mScriptWitnessFiles of
+           Just scriptWitnessFiles -> do
+            sWit <- createScriptWitness era scriptWitnessFiles
             return $ Just ( sCred
                           , ScriptWitness ScriptWitnessForStakeAddr sWit
                           )
@@ -533,10 +539,10 @@ validateTxUpdateProposal era (Just (UpdateProposalFile file)) =
 
 validateTxMintValue :: forall era. IsCardanoEra era
                     => CardanoEra era
-                    -> Maybe (Value, [ScriptFile])
+                    -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
                     -> ExceptT ShelleyTxCmdError IO (TxMintValue BuildTx era)
 validateTxMintValue _ Nothing = return TxMintNone
-validateTxMintValue era (Just (val, scripts)) =
+validateTxMintValue era (Just (val, scriptWitnessFiles)) =
     case multiAssetSupportedInEra era of
       Left _ -> txFeatureMismatch era TxFeatureMintValue
       Right supported -> do
@@ -546,7 +552,7 @@ validateTxMintValue era (Just (val, scripts)) =
               Set.fromList [ pid | (AssetId pid _, _) <- valueToList val ]
 
         -- The set (and map) of policy ids for which we have witnesses:
-        witnesses <- mapM (createScriptWitness era) scripts
+        witnesses <- mapM (createScriptWitness era) scriptWitnessFiles
         let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
             witnessesProvidedMap = Map.fromList
                                      [ (scriptWitnessPolicyId witness, witness)
@@ -580,9 +586,9 @@ scriptWitnessPolicyId witness =
 createScriptWitness
   :: IsCardanoEra era
   => CardanoEra era
-  -> ScriptFile
+  -> ScriptWitnessFiles witctx
   -> ExceptT ShelleyTxCmdError IO (ScriptWitness witctx era)
-createScriptWitness era (ScriptFile fp) = do
+createScriptWitness era (SimpleScriptWitnessFile (ScriptFile fp)) = do
   ScriptInAnyLang sLang script <- firstExceptT ShelleyTxCmdScriptFileError
                                     $ readFileScriptInAnyLang fp
   case scriptLanguageSupportedInEra era sLang of

cardano-cli/src/Cardano/CLI/Types.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralisedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 module Cardano.CLI.Types
   ( CBORObject (..)
@@ -11,6 +13,10 @@ module Cardano.CLI.Types
   , SigningKeyFile (..)
   , SocketPath (..)
   , ScriptFile (..)
+  , ScriptDataOrFile (..)
+  , ScriptRedeemerOrFile
+  , ScriptWitnessFiles (..)
+  , ScriptDatumOrFile (..)
   , TransferDirection(..)
   , TxOutAnyEra (..)
   , UpdateProposalFile (..)
@@ -145,6 +151,39 @@ newtype VerificationKeyFile
 newtype ScriptFile = ScriptFile { unScriptFile :: FilePath }
                      deriving (Eq, Show)
 
+data ScriptDataOrFile = ScriptDataFile  FilePath   -- ^ By reference to a file
+                      | ScriptDataValue ScriptData -- ^ By value
+  deriving (Eq, Show)
+
+type ScriptRedeemerOrFile = ScriptDataOrFile
+
+-- | This type is like 'ScriptWitness', but the file paths from which to load
+-- the script witness data representation.
+--
+-- It is era-independent, but witness context-dependent.
+--
+data ScriptWitnessFiles witctx where
+     SimpleScriptWitnessFile  :: ScriptFile
+                              -> ScriptWitnessFiles witctx
+
+     PlutusScriptWitnessFiles :: ScriptFile
+                              -> ScriptDatumOrFile witctx
+                              -> ScriptRedeemerOrFile
+                              -> ExecutionUnits
+                              -> ScriptWitnessFiles witctx
+
+deriving instance Show (ScriptWitnessFiles witctx)
+
+data ScriptDatumOrFile witctx where
+     ScriptDatumOrFileForTxIn    :: ScriptDataOrFile
+                                 -> ScriptDatumOrFile WitCtxTxIn
+
+     NoScriptDatumOrFileForMint  :: ScriptDatumOrFile WitCtxMint
+     NoScriptDatumOrFileForStake :: ScriptDatumOrFile WitCtxStake
+
+deriving instance Show (ScriptDatumOrFile witctx)
+
+
 -- | Determines the direction in which the MIR certificate will transfer ADA.
 data TransferDirection = TransferToReserves | TransferToTreasury
                          deriving Show