Propagate tagged tx out datum changes to cardano-cli. We can now buil…

…d a transactions with actual datums or datum hashes.

Co-authored-by: duncan@well-typed.com

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

@@ -14,9 +14,8 @@ import           Cardano.Prelude
 import           Cardano.Chain.Update (InstallerHash (..), ProtocolVersion (..),
                      SoftwareVersion (..), SystemTag (..))
 
-import           Cardano.Api (NetworkId, TxIn)
-import           Cardano.Api.Byron (Address (..), ByronAddr, ByronEra,
-                     ByronProtocolParametersUpdate (..), TxOut)
+import           Cardano.Api       hiding (GenesisParameters)
+import           Cardano.Api.Byron hiding (GenesisParameters)
 
 import           Cardano.CLI.Byron.Genesis
 import           Cardano.CLI.Byron.Key
@@ -82,7 +81,7 @@ data ByronCommand =
         -- ^ Signing key of genesis UTxO owner.
         (Address ByronAddr)
         -- ^ Genesis UTxO address.
-        [TxOut ByronEra]
+        [TxOut CtxTx ByronEra]
         -- ^ Tx output.
   | SpendUTxO
         NetworkId
@@ -93,7 +92,7 @@ data ByronCommand =
         -- ^ Signing key of Tx underwriter.
         [TxIn]
         -- ^ Inputs available for spending to the Tx underwriter's key.
-        [TxOut ByronEra]
+        [TxOut CtxTx ByronEra]
         -- ^ Genesis UTxO output Address.
 
   | GetTxId TxFile

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

@@ -284,12 +284,12 @@ parseTxIdAtto = (<?> "Transaction ID (hexadecimal)") $ do
 parseTxIxAtto :: Atto.Parser TxIx
 parseTxIxAtto = toEnum <$> Atto.decimal
 
-parseTxOut :: Parser (TxOut ByronEra)
+parseTxOut :: Parser (TxOut CtxTx ByronEra)
 parseTxOut =
   option
     ( (\(addr, lovelace) -> TxOut (pAddressInEra addr)
                                   (pLovelaceTxOut lovelace)
-                                  TxOutDatumHashNone)
+                                  TxOutDatumNone)
       <$> auto
     )
     $ long "txout"

cardano-cli/src/Cardano/CLI/Byron/Run.hs

@@ -197,7 +197,7 @@ runSpendGenesisUTxO
   -> NewTxFile
   -> SigningKeyFile
   -> Address ByronAddr
-  -> [TxOut ByronEra]
+  -> [TxOut CtxTx ByronEra]
   -> ExceptT ByronClientCmdError IO ()
 runSpendGenesisUTxO genesisFile nw bKeyFormat (NewTxFile ctTx) ctKey genRichAddr outs = do
     genesis <- firstExceptT ByronCmdGenesisError $ readGenesis genesisFile nw
@@ -212,7 +212,7 @@ runSpendUTxO
   -> NewTxFile
   -> SigningKeyFile
   -> [TxIn]
-  -> [TxOut ByronEra]
+  -> [TxOut CtxTx ByronEra]
   -> ExceptT ByronClientCmdError IO ()
 runSpendUTxO nw bKeyFormat (NewTxFile ctTx) ctKey ins outs = do
     sk <- firstExceptT ByronCmdKeyFailure $ readByronSigningKey bKeyFormat ctKey

cardano-cli/src/Cardano/CLI/Byron/Tx.hs

@@ -144,7 +144,7 @@ txSpendGenesisUTxOByronPBFT
   -> NetworkId
   -> SomeByronSigningKey
   -> Address ByronAddr
-  -> [TxOut ByronEra]
+  -> [TxOut CtxTx ByronEra]
   -> Tx ByronEra
 txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do
     let txBodyCont =
@@ -160,7 +160,6 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do
             )
             TxMetadataNone
             TxAuxScriptsNone
-            (BuildTxWith TxExtraScriptDataNone)
             TxExtraKeyWitnessesNone
             (BuildTxWith Nothing)
             TxWithdrawalsNone
@@ -183,7 +182,7 @@ txSpendUTxOByronPBFT
   :: NetworkId
   -> SomeByronSigningKey
   -> [TxIn]
-  -> [TxOut ByronEra]
+  -> [TxOut CtxTx ByronEra]
   -> Tx ByronEra
 txSpendUTxOByronPBFT nId sk txIns outs = do
   let txBodyCont = TxBodyContent
@@ -199,7 +198,6 @@ txSpendUTxOByronPBFT nId sk txIns outs = do
                      )
                      TxMetadataNone
                      TxAuxScriptsNone
-                     (BuildTxWith TxExtraScriptDataNone)
                      TxExtraKeyWitnessesNone
                      (BuildTxWith Nothing)
                      TxWithdrawalsNone

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

@@ -259,12 +259,17 @@ pScriptWitnessFiles witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefi
     pScriptDatumOrFile =
       case witctx of
         WitCtxTxIn  -> ScriptDatumOrFileForTxIn <$>
-                         pScriptDataOrFile (scriptFlagPrefix ++ "-datum")
+                         pScriptDataOrFile
+                           (scriptFlagPrefix ++ "-datum")
+                           "The script datum, in JSON syntax."
+                           "The script datum, in the given JSON file."
         WitCtxMint  -> pure NoScriptDatumOrFileForMint
         WitCtxStake -> pure NoScriptDatumOrFileForStake
 
     pScriptRedeemerOrFile :: Parser ScriptDataOrFile
     pScriptRedeemerOrFile = pScriptDataOrFile (scriptFlagPrefix ++ "-redeemer")
+                           "The script redeemer, in JSON syntax."
+                           "The script redeemer, in the given JSON file."
 
     pExecutionUnits :: Parser ExecutionUnits
     pExecutionUnits =
@@ -276,23 +281,26 @@ pScriptWitnessFiles witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefi
           )
 
 
-pScriptDataOrFile :: String -> Parser ScriptDataOrFile
-pScriptDataOrFile dataFlagPrefix =
+pScriptDataOrFile :: String -> String -> String -> Parser ScriptDataOrFile
+pScriptDataOrFile dataFlagPrefix helpTextForValue helpTextForFile =
       ScriptDataFile  <$> pScriptDataFile
   <|> ScriptDataValue <$> pScriptDataValue
   where
     pScriptDataFile =
       Opt.strOption
         (  Opt.long (dataFlagPrefix ++ "-file")
         <> Opt.metavar "FILE"
-        <> Opt.help "The JSON file containing the script data."
+        <> Opt.help (helpTextForFile ++ " The file must follow the special \
+                                         \JSON schema for script data.")
         )
 
     pScriptDataValue =
       Opt.option readerScriptData
         (  Opt.long (dataFlagPrefix ++ "-value")
         <> Opt.metavar "JSON VALUE"
-        <> Opt.help "The JSON value for the script data. Supported JSON data types: string, number, object & array."
+        <> Opt.help (helpTextForValue ++ " There is no schema: (almost) any \
+                                         \JSON value is supported, including \
+                                         \top-level strings and numbers.")
         )
 
     readerScriptData = do
@@ -707,7 +715,11 @@ pTransaction =
     ParamsFromFile <$> pProtocolParamsFile
 
   pTxHashScriptData :: Parser TransactionCmd
-  pTxHashScriptData = TxHashScriptData <$> pScriptDataOrFile "script-data"
+  pTxHashScriptData = TxHashScriptData <$>
+                        pScriptDataOrFile
+                          "script-data"
+                          "The script data, in JSON syntax."
+                          "The script data, in the given JSON file."
 
   pTransactionId  :: Parser TransactionCmd
   pTransactionId = TxGetTxId <$> pInputTxFile
@@ -1808,22 +1820,46 @@ pTxOut =
           (  Opt.long "tx-out"
           <> Opt.metavar "ADDRESS VALUE"
           -- TODO alonzo: Update the help text to describe the new syntax as well.
-          <> Opt.help "The transaction output as Address+Lovelace where Address is \
-                      \the Bech32-encoded address followed by the amount in \
-                      \Lovelace."
+          <> Opt.help "The transaction output as ADDRESS VALUE where ADDRESS is \
+                      \the Bech32-encoded address followed by the value in \
+                      \the multi-asset syntax (including simply Lovelace)."
           )
-    <*> optional pDatumHash
+    <*> optional pTxOutDatum
 
 
-pDatumHash :: Parser (Hash ScriptData)
-pDatumHash  =
-  Opt.option (readerFromParsecParser parseHashScriptData)
-    (  Opt.long "tx-out-datum-hash"
-    <> Opt.metavar "HASH"
-    <> Opt.help "Required datum hash for tx inputs intended \
-               \to be utilizied by a Plutus script."
-    )
+pTxOutDatum :: Parser TxOutDatumAnyEra
+pTxOutDatum =
+      pTxOutDatumByHashOnly
+  <|> pTxOutDatumByHashOf
+  <|> pTxOutDatumByValue
   where
+    pTxOutDatumByHashOnly =
+      TxOutDatumByHashOnly <$>
+        Opt.option (readerFromParsecParser parseHashScriptData)
+          (  Opt.long "tx-out-datum-hash"
+          <> Opt.metavar "HASH"
+          <> Opt.help "The script datum hash for this tx output, as \
+                     \the raw datum hash (in hex)."
+          )
+
+    pTxOutDatumByHashOf =
+      TxOutDatumByHashOf <$>
+        pScriptDataOrFile
+          "tx-out-datum-hash"
+          "The script datum hash for this tx output, by hashing the \
+          \script datum given here in JSON syntax."
+          "The script datum hash for this tx output, by hashing the \
+          \script datum in the given JSON file."
+
+    pTxOutDatumByValue =
+      TxOutDatumByValue <$>
+        pScriptDataOrFile
+          "tx-out-datum-embed"
+          "The script datum to embed in the tx for this output, \
+          \given here in JSON syntax."
+          "The script datum to embed in the tx for this output, \
+          \in the given JSON file."
+
     parseHashScriptData :: Parsec.Parser (Hash ScriptData)
     parseHashScriptData = do
       str <- Parsec.many1 Parsec.hexDigit Parsec.<?> "script data hash"
@@ -2751,7 +2787,7 @@ parseStakeAddress = do
       Nothing   -> fail $ "invalid address: " <> Text.unpack str
       Just addr -> pure addr
 
-parseTxOutAnyEra :: Parsec.Parser (Maybe (Hash ScriptData) -> TxOutAnyEra)
+parseTxOutAnyEra :: Parsec.Parser (Maybe TxOutDatumAnyEra -> TxOutAnyEra)
 parseTxOutAnyEra = do
     addr <- parseAddressAny
     Parsec.spaces

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

@@ -666,7 +666,7 @@ printFilteredUTxOs shelleyBasedEra' (UTxO utxo) = do
 
 printUtxo
   :: ShelleyBasedEra era
-  -> (TxIn, TxOut era)
+  -> (TxIn, TxOut CtxUTxO era)
   -> IO ()
 printUtxo shelleyBasedEra' txInOutTuple =
   case shelleyBasedEra' of

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

@@ -341,7 +341,6 @@ runTxBuildRaw (AnyCardanoEra era)
                  <*> validateTxValidityUpperBound era mUpperBound)
         <*> validateTxMetadataInEra  era metadataSchema metadataFiles
         <*> validateTxAuxScripts     era scriptFiles
-        <*> pure (BuildTxWith TxExtraScriptDataNone) --TODO alonzo: support this
         <*> pure TxExtraKeyWitnessesNone --TODO alonzo: support this
         <*> validateProtocolParameters era mpparams
         <*> validateTxWithdrawals    era withdrawals
@@ -405,7 +404,6 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId tx
                    <*> validateTxValidityUpperBound era mUpperBound)
           <*> validateTxMetadataInEra     era metadataSchema metadataFiles
           <*> validateTxAuxScripts        era scriptFiles
-          <*> pure (BuildTxWith TxExtraScriptDataNone) --TODO alonzo: support this
           <*> pure TxExtraKeyWitnessesNone --TODO alonzo: support this
           <*> validateProtocolParameters  era mpparams
           <*> validateTxWithdrawals       era withdrawals
@@ -560,26 +558,25 @@ validateTxInsCollateral era txins =
 validateTxOuts :: forall era.
                   CardanoEra era
                -> [TxOutAnyEra]
-               -> ExceptT ShelleyTxCmdError IO [TxOut era]
-validateTxOuts era = mapM toTxOutInAnyEra
+               -> ExceptT ShelleyTxCmdError IO [TxOut CtxTx era]
+validateTxOuts era = mapM toTxOut
   where
-    toTxOutInAnyEra :: TxOutAnyEra
-                    -> ExceptT ShelleyTxCmdError IO (TxOut era)
-    toTxOutInAnyEra (TxOutAnyEra addr val mDatumHash) =
+    toTxOut :: TxOutAnyEra -> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era)
+    toTxOut (TxOutAnyEra addr val mDatumHash) =
       case (scriptDataSupportedInEra era, mDatumHash) of
         (_, Nothing) ->
-          TxOut <$> toAddressInAnyEra addr
-                <*> toTxOutValueInAnyEra val
-                <*> pure TxOutDatumHashNone
-        (Just supported, Just dh) ->
-          TxOut <$> toAddressInAnyEra addr
-                <*> toTxOutValueInAnyEra val
-                <*> pure (TxOutDatumHash supported dh)
+          TxOut <$> toAddressInEra addr
+                <*> toTxOutValue val
+                <*> pure TxOutDatumNone
+        (Just supported, Just d) ->
+          TxOut <$> toAddressInEra addr
+                <*> toTxOutValue val
+                <*> toTxOutDatum supported d
         (Nothing, Just _) ->
           txFeatureMismatch era TxFeatureTxOutDatum
 
-    toAddressInAnyEra :: AddressAny -> ExceptT ShelleyTxCmdError IO (AddressInEra era)
-    toAddressInAnyEra addrAny =
+    toAddressInEra :: AddressAny -> ExceptT ShelleyTxCmdError IO (AddressInEra era)
+    toAddressInEra addrAny =
       case addrAny of
         AddressByron   bAddr -> return (AddressInEra ByronAddressInAnyEra bAddr)
         AddressShelley sAddr ->
@@ -589,15 +586,27 @@ validateTxOuts era = mapM toTxOutInAnyEra
             ShelleyBasedEra era' ->
               return (AddressInEra (ShelleyAddressInEra era') sAddr)
 
-    toTxOutValueInAnyEra :: Value -> ExceptT ShelleyTxCmdError IO (TxOutValue era)
-    toTxOutValueInAnyEra val =
+    toTxOutValue :: Value -> ExceptT ShelleyTxCmdError IO (TxOutValue era)
+    toTxOutValue val =
       case multiAssetSupportedInEra era of
         Left adaOnlyInEra ->
           case valueToLovelace val of
             Just l  -> return (TxOutAdaOnly adaOnlyInEra l)
             Nothing -> txFeatureMismatch era TxFeatureMultiAssetOutputs
         Right multiAssetInEra -> return (TxOutValue multiAssetInEra val)
 
+    toTxOutDatum :: ScriptDataSupportedInEra era
+                 -> TxOutDatumAnyEra
+                 -> ExceptT ShelleyTxCmdError IO (TxOutDatum CtxTx era)
+    toTxOutDatum supported (TxOutDatumByHashOnly dh) =
+      pure (TxOutDatumHash supported dh)
+
+    toTxOutDatum supported (TxOutDatumByHashOf df) =
+      TxOutDatumHash supported . hashScriptData <$> readScriptDataOrFile df
+
+    toTxOutDatum supported (TxOutDatumByValue df) =
+      TxOutDatum supported  <$> readScriptDataOrFile df
+
 
 validateTxFee :: CardanoEra era
               -> Maybe Lovelace

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

@@ -20,6 +20,7 @@ module Cardano.CLI.Types
   , TransferDirection(..)
   , TxOutAnyEra (..)
   , TxOutChangeAddress (..)
+  , TxOutDatumAnyEra (..)
   , UpdateProposalFile (..)
   , VerificationKeyFile (..)
   , Stakes (..)
@@ -191,7 +192,12 @@ data TransferDirection = TransferToReserves | TransferToTreasury
 data TxOutAnyEra = TxOutAnyEra
                      AddressAny
                      Value
-                     (Maybe (Hash ScriptData))
+                     (Maybe TxOutDatumAnyEra)
+  deriving (Eq, Show)
+
+data TxOutDatumAnyEra = TxOutDatumByHashOnly (Hash ScriptData)
+                      | TxOutDatumByHashOf    ScriptDataOrFile
+                      | TxOutDatumByValue     ScriptDataOrFile
   deriving (Eq, Show)
 
 -- | A partially-specified transaction output indented to use as a change