From 26a23276548e05e364b6feca6806c192efc01441 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 10 Nov 2023 14:32:33 -0400 Subject: [PATCH 1/7] Propagate removal of ByronOnlyEra era from ... --- cardano-cli/src/Cardano/CLI/Byron/Parsers.hs | 2 +- cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 2 +- cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs | 2 +- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs index ff6b1250f1..135180b0e5 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs @@ -293,7 +293,7 @@ parseTxOut = pLovelaceTxOut l = if l > (maxBound :: Word64) then error $ show l <> " lovelace exceeds the Word64 upper bound" - else TxOutValueByron ByronEraOnlyByron . Lovelace $ toInteger l + else TxOutValueByron . Lovelace $ toInteger l readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a readerFromAttoParser p = diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index a70be26fdf..615975dece 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -244,7 +244,7 @@ nodeSubmitTx nodeSocketPath network gentx = do localNodeNetworkId = network, localConsensusModeParams = CardanoModeParams (EpochSlots 21600) } - res <- liftIO $ submitTxToNodeLocal connctInfo (TxInByronSpecial ByronEraOnlyByron gentx) + res <- liftIO $ submitTxToNodeLocal connctInfo (TxInByronSpecial gentx) case res of Net.Tx.SubmitSuccess -> liftIO $ Text.putStrLn "Transaction successfully submitted." Net.Tx.SubmitFail reason -> diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs index 04476164d3..fc623ab060 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs @@ -1049,7 +1049,7 @@ printUtxo sbe txInOutTuple = printableValue :: TxOutValue era -> Text printableValue = \case - TxOutValueByron _ (Lovelace i) -> Text.pack $ show i + TxOutValueByron (Lovelace i) -> Text.pack $ show i TxOutValueShelleyBased sbe2 val -> renderValue $ Api.fromLedgerValue sbe2 val runQueryStakePoolsCmd :: () diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 9f14a99723..338fc0e7ad 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -566,7 +566,7 @@ friendlyMintValue = \case friendlyTxOutValue :: TxOutValue era -> Aeson.Value friendlyTxOutValue = \case - TxOutValueByron _ lovelace -> friendlyLovelace $ toShelleyLovelace lovelace + TxOutValueByron lovelace -> friendlyLovelace $ toShelleyLovelace lovelace TxOutValueShelleyBased sbe v -> friendlyLedgerValue sbe v friendlyLedgerValue :: () From 9113dfbe86a3dc864ad9b165c32c359115288d08 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 14 Nov 2023 12:40:38 -0400 Subject: [PATCH 2/7] runTransactionCalculateMinValueCmd was never Byron compatible Remove support for Byron by only accepting shelley based tx outputs --- .../Cardano/CLI/EraBased/Commands/Transaction.hs | 4 ++-- .../src/Cardano/CLI/EraBased/Run/Transaction.hs | 14 +++++++------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index 2002f6fdb5..d90691db3b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -168,9 +168,9 @@ data TransactionCalculateMinFeeCmdArgs = TransactionCalculateMinFeeCmdArgs } deriving Show data TransactionCalculateMinValueCmdArgs era = TransactionCalculateMinValueCmdArgs - { eon :: !(CardanoEra era) + { eon :: !(ShelleyBasedEra era) , protocolParamsFile :: !ProtocolParamsFile - , txOut :: !TxOutAnyEra + , txOut :: !TxOutShelleyBasedEra } deriving Show newtype TransactionHashScriptDataCmdArgs = TransactionHashScriptDataCmdArgs diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index d7280bed46..da9ee3913e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -1023,14 +1023,14 @@ runTransactionCalculateMinValueCmd , txOut } = do pp <- firstExceptT TxCmdProtocolParamsError (readProtocolParameters protocolParamsFile) - out <- toTxOutInAnyEra eon txOut + out <- toTxOutInShelleyBasedEra eon txOut -- TODO: shouldn't we just require shelley based era here instead of error-ing for byron? - forEraInEon eon (error "runTransactionCalculateMinValueCmd: Byron era not implemented yet") $ \sbe -> do - firstExceptT TxCmdPParamsErr . hoistEither - $ checkProtocolParameters sbe pp - pp' <- hoistEither . first TxCmdProtocolParamsConverstionError $ toLedgerPParams sbe pp - let minValue = calculateMinimumUTxO sbe out pp' - liftIO . IO.print $ minValue + + firstExceptT TxCmdPParamsErr . hoistEither + $ checkProtocolParameters eon pp + pp' <- hoistEither . first TxCmdProtocolParamsConverstionError $ toLedgerPParams eon pp + let minValue = calculateMinimumUTxO eon out pp' + liftIO . IO.print $ minValue runTransactionPolicyIdCmd :: () => Cmd.TransactionPolicyIdCmdArgs From 31ad91953ace100d40e424a28c64cc6ecb284d00 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 14 Nov 2023 12:55:16 -0400 Subject: [PATCH 3/7] Propagate minimum value calculation changes --- .../CLI/EraBased/Options/Transaction.hs | 25 +++++++++++-------- .../CLI/Legacy/Commands/Transaction.hs | 2 +- cardano-cli/src/Cardano/CLI/Legacy/Options.hs | 2 +- .../src/Cardano/CLI/Legacy/Run/Transaction.hs | 15 +++++++---- 4 files changed, 27 insertions(+), 17 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs index 13b1211dc4..22dd5b1eec 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs @@ -78,12 +78,17 @@ pTransactionCmds era envCli = $ subParser "calculate-min-fee" $ Opt.info (pTransactionCalculateMinFee envCli) $ Opt.progDesc "Calculate the minimum fee for a transaction." - , Just - $ subParser "calculate-min-required-utxo" - $ Opt.info (pTransactionCalculateMinReqUTxO era) - $ Opt.progDesc "Calculate the minimum required UTxO for a transaction output." - , Just - $ pCalculateMinRequiredUtxoBackwardCompatible era + , caseByronOrShelleyBasedEra + (const Nothing) + (\sbe -> Just $ subParser "calculate-min-required-utxo" + $ Opt.info (pTransactionCalculateMinReqUTxO sbe) + $ Opt.progDesc "Calculate the minimum required UTxO for a transaction output." + ) + era + , caseByronOrShelleyBasedEra + (const Nothing) + (Just . pCalculateMinRequiredUtxoBackwardCompatible) + era , Just $ subParser "hash-script-data" $ Opt.info pTxHashScriptData @@ -99,12 +104,12 @@ pTransactionCmds era envCli = ] -- Backwards compatible parsers -calcMinValueInfo :: CardanoEra era -> ParserInfo (TransactionCmds era) +calcMinValueInfo :: ShelleyBasedEra era -> ParserInfo (TransactionCmds era) calcMinValueInfo era = Opt.info (pTransactionCalculateMinReqUTxO era) $ Opt.progDesc "DEPRECATED: Use 'calculate-min-required-utxo' instead." -pCalculateMinRequiredUtxoBackwardCompatible :: CardanoEra era -> Parser (TransactionCmds era) +pCalculateMinRequiredUtxoBackwardCompatible :: ShelleyBasedEra era -> Parser (TransactionCmds era) pCalculateMinRequiredUtxoBackwardCompatible era = Opt.subparser $ Opt.command "calculate-min-value" (calcMinValueInfo era) <> Opt.internal @@ -275,12 +280,12 @@ pTransactionCalculateMinFee envCli = <*> pTxShelleyWitnessCount <*> pTxByronWitnessCount -pTransactionCalculateMinReqUTxO :: CardanoEra era -> Parser (TransactionCmds era) +pTransactionCalculateMinReqUTxO :: ShelleyBasedEra era -> Parser (TransactionCmds era) pTransactionCalculateMinReqUTxO era = fmap TransactionCalculateMinValueCmd $ TransactionCalculateMinValueCmdArgs era <$> pProtocolParamsFile - <*> pTxOut + <*> pTxOutShelleyBased pTxHashScriptData :: Parser (TransactionCmds era) pTxHashScriptData = diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs index 89a654c575..4b34309c58 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs @@ -125,7 +125,7 @@ data LegacyTransactionCmds | TransactionCalculateMinValueCmd AnyCardanoEra ProtocolParamsFile - TxOutAnyEra + TxOutShelleyBasedEra | TransactionHashScriptDataCmd ScriptDataOrFile | TransactionTxIdCmd diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs index 28966a50ca..dc025d70e5 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs @@ -425,7 +425,7 @@ pTransaction envCli = TransactionCalculateMinValueCmd <$> pLegacyCardanoEra envCli <*> pProtocolParamsFile - <*> pTxOut + <*> pTxOutShelleyBased pTxHashScriptData :: Parser LegacyTransactionCmds pTxHashScriptData = diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index 79eca31535..ad148a7b2e 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -45,8 +45,13 @@ runLegacyTransactionCmds = \case runLegacyTransactionSubmitCmd mNodeSocketPath consensusModeParams network txFp TransactionCalculateMinFeeCmd txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses -> runLegacyTransactionCalculateMinFeeCmd txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses - TransactionCalculateMinValueCmd era pParamsFile txOuts' -> - runLegacyTransactionCalculateMinValueCmd era pParamsFile txOuts' + TransactionCalculateMinValueCmd (AnyCardanoEra era) pParamsFile txOuts' -> + -- We choose to not modify TransactionCalculateMinValueCmd to avoid breaking the cli + -- Although in this case specifying Byron would have resulted in a call to error. + caseByronOrShelleyBasedEra + (const $ pure ()) + (\sbe -> runLegacyTransactionCalculateMinValueCmd (AnyShelleyBasedEra sbe) pParamsFile txOuts') + era TransactionHashScriptDataCmd scriptDataOrFile -> runLegacyTransactionHashScriptDataCmd scriptDataOrFile TransactionTxIdCmd txinfile -> @@ -231,12 +236,12 @@ runLegacyTransactionCalculateMinFeeCmd ) runLegacyTransactionCalculateMinValueCmd :: () - => AnyCardanoEra + => AnyShelleyBasedEra -> ProtocolParamsFile - -> TxOutAnyEra + -> TxOutShelleyBasedEra -> ExceptT TxCmdError IO () runLegacyTransactionCalculateMinValueCmd - (AnyCardanoEra era) + (AnyShelleyBasedEra era) pParamsFile txOut = runTransactionCalculateMinValueCmd From d756cab71a06e94d80fe18931448191cb85ecd5d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 14 Nov 2023 12:58:39 -0400 Subject: [PATCH 4/7] Return collateral only makes sense in the context of a ShelleyBasedEra specifically Babbage era onwards Implement TxOutShelleyBasedEra and remove support for specifying a collateral return output at a Byron address --- .../src/Cardano/CLI/EraBased/Commands/Transaction.hs | 4 ++-- .../src/Cardano/CLI/Legacy/Commands/Transaction.hs | 4 ++-- cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs | 4 ++-- cardano-cli/src/Cardano/CLI/Types/Common.hs | 9 +++++++++ 4 files changed, 15 insertions(+), 6 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index d90691db3b..501ee94ebb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -51,7 +51,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs -- ^ Read only reference inputs , txInsCollateral :: ![TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts. - , mReturnCollateral :: !(Maybe TxOutAnyEra) + , mReturnCollateral :: !(Maybe TxOutShelleyBasedEra) -- ^ Return collateral , mTotalCollateral :: !(Maybe Lovelace) -- ^ Total collateral @@ -98,7 +98,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs -- ^ Required signers , txinsc :: ![TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts. - , mReturnCollateral :: !(Maybe TxOutAnyEra) + , mReturnCollateral :: !(Maybe TxOutShelleyBasedEra) -- ^ Return collateral , mTotalCollateral :: !(Maybe Lovelace) -- ^ Total collateral diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs index 4b34309c58..477dfe9b72 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs @@ -24,7 +24,7 @@ data LegacyTransactionCmds -- ^ Read only reference inputs [TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts. - (Maybe TxOutAnyEra) + (Maybe TxOutShelleyBasedEra) -- ^ Return collateral (Maybe Lovelace) -- ^ Total collateral @@ -67,7 +67,7 @@ data LegacyTransactionCmds -- ^ Required signers [TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts. - (Maybe TxOutAnyEra) + (Maybe TxOutShelleyBasedEra) -- ^ Return collateral (Maybe Lovelace) -- ^ Total collateral diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index ad148a7b2e..e9a2e76bb8 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -80,7 +80,7 @@ runLegacyTransactionBuildCmd :: () -> [TxIn] -- ^ Read only reference inputs -> [RequiredSigner] -- ^ Required signers -> [TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts. - -> Maybe TxOutAnyEra -- ^ Return collateral + -> Maybe TxOutShelleyBasedEra -- ^ Return collateral -> Maybe Lovelace -- ^ Total collateral -> [TxOutAnyEra] -> TxOutChangeAddress @@ -125,7 +125,7 @@ runLegacyTransactionBuildRawCmd :: () -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] -> [TxIn] -- ^ Read only reference inputs -> [TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts. - -> Maybe TxOutAnyEra + -> Maybe TxOutShelleyBasedEra -- ^ Return collateral -> Maybe Lovelace -- ^ Total collateral -> [RequiredSigner] -> [TxOutAnyEra] diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index 2dba412520..56c39c35e1 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -64,6 +64,7 @@ module Cardano.CLI.Types.Common , TxInCount(..) , TxMempoolQuery (..) , TxOutAnyEra (..) + , TxOutShelleyBasedEra (..) , TxOutChangeAddress (..) , TxOutCount(..) , TxOutDatumAnyEra (..) @@ -382,6 +383,14 @@ instance ToJSON SlotsTillKesKeyExpiry where instance FromJSON SlotsTillKesKeyExpiry where parseJSON v = SlotsTillKesKeyExpiry <$> parseJSON v + +data TxOutShelleyBasedEra + = TxOutShelleyBasedEra + !(Address ShelleyAddr) + Value + TxOutDatumAnyEra + ReferenceScriptAnyEra + deriving Show -- | A TxOut value that is the superset of possibilities for any era: any -- address type and allowing multi-asset values. This is used as the type for -- values passed on the command line. It can be converted into the From b1fcca9ee210e2105b8eeb5f8b956e3caba71788 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 14 Nov 2023 13:01:31 -0400 Subject: [PATCH 5/7] Propagate changes related to removing support for specifying a byron collateral return output --- .../Cardano/CLI/EraBased/Options/Common.hs | 36 +++++- .../Cardano/CLI/EraBased/Run/Transaction.hs | 118 +++++++++++++----- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 1 - 3 files changed, 118 insertions(+), 37 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 55de5b44d0..bedeb2f36e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -1848,9 +1848,9 @@ pTxInCollateral = <> Opt.help "TxId#TxIx" ) -pReturnCollateral :: Parser TxOutAnyEra +pReturnCollateral :: Parser TxOutShelleyBasedEra pReturnCollateral = - Opt.option (readerFromParsecParser parseTxOutAnyEra) + Opt.option (readerFromParsecParser parseTxOutShelleyBasedEra) ( mconcat [ Opt.long "tx-out-return-collateral" , Opt.metavar "ADDRESS VALUE" @@ -1899,6 +1899,19 @@ pTxOut = <*> pTxOutDatum <*> pRefScriptFp +pTxOutShelleyBased :: Parser TxOutShelleyBasedEra +pTxOutShelleyBased = + Opt.option (readerFromParsecParser parseTxOutShelleyBasedEra) + ( 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 VALUE where ADDRESS is \ + \the Bech32-encoded address followed by the value in \ + \Lovelace." + ) + <*> pTxOutDatum + <*> pRefScriptFp + pTxOutDatum :: Parser TxOutDatumAnyEra pTxOutDatum = pTxOutDatumByHashOnly @@ -2998,6 +3011,25 @@ pDRepActivity = , Opt.help "TODO" ] +parseTxOutShelleyBasedEra + :: Parsec.Parser (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra) +parseTxOutShelleyBasedEra = do + addr <- parseShelleyAddress + Parsec.spaces + -- Accept the old style of separating the address and value in a + -- transaction output: + Parsec.option () (Parsec.char '+' >> Parsec.spaces) + val <- parseValue + return (TxOutShelleyBasedEra addr val) + +parseShelleyAddress :: Parsec.Parser (Address ShelleyAddr) +parseShelleyAddress = do + str <- lexPlausibleAddressString + case deserialiseAddress AsShelleyAddress str of + Nothing -> fail $ "invalid address: " <> Text.unpack str + Just addr -> pure addr + + parseTxOutAnyEra :: Parsec.Parser (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra) parseTxOutAnyEra = do diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index da9ee3913e..75a44d5a63 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -164,7 +165,7 @@ runTransactionBuildCmd _ -> pure TxUpdateProposalNone requiredSigners <- mapM (firstExceptT TxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners - mReturnCollateral <- forM mReturnColl $ toTxOutInAnyEra era + mReturnCollateral <- forM mReturnColl $ toTxOutInShelleyBasedEra eon txOuts <- mapM (toTxOutInAnyEra era) txouts @@ -319,7 +320,11 @@ runTransactionBuildRawCmd _ -> pure TxUpdateProposalNone requiredSigners <- mapM (firstExceptT TxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners - mReturnCollateral <- forM mReturnColl $ toTxOutInAnyEra eon + + mReturnCollateral <- forEraInEon eon (pure Nothing) $ \sbe -> + forM mReturnColl $ toTxOutInShelleyBasedEra sbe + + -- NB: We need to be able to construct txs in Byron to other Byron addresses txOuts <- mapM (toTxOutInAnyEra eon) txouts -- the same collateral input can be used for several plutus scripts @@ -690,6 +695,14 @@ toAddressInAnyEra era addrAny = runExcept $ do pure (AddressInEra (ShelleyAddressInEra sbe) sAddr) +toAddressInShelleyBasedEra + :: ShelleyBasedEra era + -> Address ShelleyAddr + -> Either TxCmdError (AddressInEra era) +toAddressInShelleyBasedEra sbe sAddr = runExcept $ + pure (AddressInEra (ShelleyAddressInEra sbe) sAddr) + + lovelaceToCoin :: Lovelace -> Ledger.Coin lovelaceToCoin (Lovelace ll) = Ledger.Coin ll @@ -698,10 +711,10 @@ toTxOutValueInAnyEra -> Value -> Either TxCmdError (TxOutValue era) toTxOutValueInAnyEra era val = - caseByronOrShelleyBasedEra - (\w -> + caseByronOrShelleyBasedEra + (const $ case valueToLovelace val of - Just l -> return (TxOutValueByron w l) + Just l -> return (TxOutValueByron l) Nothing -> txFeatureMismatchPure era TxFeatureMultiAssetOutputs ) (\sbe -> @@ -715,7 +728,46 @@ toTxOutValueInAnyEra era val = sbe ) era +toTxOutValueInShelleyBasedEra + :: ShelleyBasedEra era + -> Value + -> Either TxCmdError (TxOutValue era) +toTxOutValueInShelleyBasedEra sbe val = + caseShelleyToAllegraOrMaryEraOnwards + (\_ -> case valueToLovelace val of + Just l -> return (TxOutValueShelleyBased sbe $ lovelaceToCoin l) + Nothing -> txFeatureMismatchPure (toCardanoEra sbe) TxFeatureMultiAssetOutputs + ) + (\w -> return (TxOutValueShelleyBased sbe (toLedgerValue w val)) + ) + sbe + +toTxOutInShelleyBasedEra + :: ShelleyBasedEra era + -> TxOutShelleyBasedEra + -> ExceptT TxCmdError IO (TxOut CtxTx era) +toTxOutInShelleyBasedEra era (TxOutShelleyBasedEra addr' val' mDatumHash refScriptFp) = do + addr <- hoistEither $ toAddressInShelleyBasedEra era addr' + val <- hoistEither $ toTxOutValueInShelleyBasedEra era val' + + datum <- + caseShelleyToMaryOrAlonzoEraOnwards + (const (pure TxOutDatumNone)) + (\wa -> toTxAlonzoDatum wa mDatumHash) + era + + refScript <- inEonForEra + (pure ReferenceScriptNone) + (\wb -> getReferenceScript wb refScriptFp) + (toCardanoEra era) + + pure $ TxOut addr val datum refScript + + +-- TODO: toTxOutInAnyEra eventually will not be needed because +-- byron related functionality will be treated +-- separately toTxOutInAnyEra :: CardanoEra era -> TxOutAnyEra -> ExceptT TxCmdError IO (TxOut CtxTx era) @@ -735,37 +787,35 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do (const (pure ReferenceScriptNone)) (\wb -> getReferenceScript wb refScriptFp) era - pure $ TxOut addr val datum refScript - where - getReferenceScript :: () - => BabbageEraOnwards era - -> ReferenceScriptAnyEra - -> ExceptT TxCmdError IO (ReferenceScript era) - getReferenceScript w = \case - ReferenceScriptAnyEraNone -> return ReferenceScriptNone - ReferenceScriptAnyEra fp -> ReferenceScript w <$> firstExceptT TxCmdScriptFileError (readFileScriptInAnyLang fp) - - toTxAlonzoDatum :: () - => AlonzoEraOnwards era - -> TxOutDatumAnyEra - -> ExceptT TxCmdError IO (TxOutDatum CtxTx era) - toTxAlonzoDatum supp cliDatum = - case cliDatum of - TxOutDatumByNone -> pure TxOutDatumNone - TxOutDatumByHashOnly h -> pure (TxOutDatumHash supp h) - TxOutDatumByHashOf sDataOrFile -> do - sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile - pure (TxOutDatumHash supp $ hashScriptDataBytes sData) - TxOutDatumByValue sDataOrFile -> do - sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile - pure (TxOutDatumInTx supp sData) - TxOutInlineDatumByValue sDataOrFile -> do - let cEra = alonzoEraOnwardsToCardanoEra supp - forEraInEon cEra (txFeatureMismatch cEra TxFeatureInlineDatums) $ \babbageOnwards -> do - sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile - pure $ TxOutDatumInline babbageOnwards sData +getReferenceScript :: () + => BabbageEraOnwards era + -> ReferenceScriptAnyEra + -> ExceptT TxCmdError IO (ReferenceScript era) +getReferenceScript w = \case + ReferenceScriptAnyEraNone -> return ReferenceScriptNone + ReferenceScriptAnyEra fp -> ReferenceScript w <$> firstExceptT TxCmdScriptFileError (readFileScriptInAnyLang fp) + +toTxAlonzoDatum :: () + => AlonzoEraOnwards era + -> TxOutDatumAnyEra + -> ExceptT TxCmdError IO (TxOutDatum CtxTx era) +toTxAlonzoDatum supp cliDatum = + case cliDatum of + TxOutDatumByNone -> pure TxOutDatumNone + TxOutDatumByHashOnly h -> pure (TxOutDatumHash supp h) + TxOutDatumByHashOf sDataOrFile -> do + sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile + pure (TxOutDatumHash supp $ hashScriptDataBytes sData) + TxOutDatumByValue sDataOrFile -> do + sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile + pure (TxOutDatumInTx supp sData) + TxOutInlineDatumByValue sDataOrFile -> do + let cEra = alonzoEraOnwardsToCardanoEra supp + forEraInEon cEra (txFeatureMismatch cEra TxFeatureInlineDatums) $ \babbageOnwards -> do + sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile + pure $ TxOutDatumInline babbageOnwards sData -- TODO: Currently we specify the policyId with the '--mint' option on the cli -- and we added a separate '--policy-id' parser that parses the policy id for the diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 338fc0e7ad..b311d102e6 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -5,7 +5,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} From 74f5a765a441e2edc64ed09036fcd0a841f87813 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 14 Nov 2023 13:01:56 -0400 Subject: [PATCH 6/7] SRP: Remove me --- cabal.project | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cabal.project b/cabal.project index 5c176c9171..2b6dc29579 100644 --- a/cabal.project +++ b/cabal.project @@ -43,3 +43,8 @@ write-ghc-environment-files: always -- IMPORTANT -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-api.git + tag: dd496b21d0e2bb41d73465798c562add40e5cc9e + subdir: cardano-api \ No newline at end of file From ba4a41919026eb2b005b0bda155df8baec2dd2f4 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 15 Nov 2023 08:03:03 -0400 Subject: [PATCH 7/7] Update golden tests --- cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index bedeb2f36e..7c11434666 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -1907,7 +1907,7 @@ pTxOutShelleyBased = -- TODO alonzo: Update the help text to describe the new syntax as well. <> Opt.help "The transaction output as ADDRESS VALUE where ADDRESS is \ \the Bech32-encoded address followed by the value in \ - \Lovelace." + \the multi-asset syntax (including simply Lovelace)." ) <*> pTxOutDatum <*> pRefScriptFp