From b1fcca9ee210e2105b8eeb5f8b956e3caba71788 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 14 Nov 2023 13:01:31 -0400 Subject: [PATCH] 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 #-}