diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index cf459204aea..632ce6a546b 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -24,6 +24,7 @@ import Cardano.CLI.Shelley.Commands import Cardano.CLI.Shelley.Key (InputFormat (..), VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..), VerificationKeyTextOrFile (..), deserialiseInput, renderInputDecodeError) +import Cardano.CLI.Mary.Parser (stringToValue) import Cardano.CLI.Types import Control.Monad.Fail (fail) import Data.Attoparsec.Combinator (()) @@ -44,6 +45,7 @@ import qualified Data.Text.Encoding as Text import qualified Options.Applicative as Opt import qualified Shelley.Spec.Ledger.BaseTypes as Shelley import qualified Shelley.Spec.Ledger.TxBody as Shelley +import qualified Text.ParserCombinators.Parsec.Error as Parsec -- -- Shelley CLI command parsers @@ -493,7 +495,7 @@ pTransaction = pTransactionBuild :: Parser TransactionCmd pTransactionBuild = TxBuildRaw <$> some pTxIn - <*> some pTxOut + <*> some pShelleyTxOut <*> optional pMint <*> pTxTTL <*> pTxFee @@ -1447,8 +1449,8 @@ parseTxIx :: Atto.Parser TxIx parseTxIx = toEnum <$> Atto.decimal -pTxOut :: Parser (TxOut ShelleyEra) -pTxOut = +pShelleyTxOut :: Parser (TxOut ShelleyEra) +pShelleyTxOut = Opt.option (readerFromAttoParser parseTxOut) ( Opt.long "tx-out" <> Opt.metavar "TX-OUT" @@ -1463,6 +1465,53 @@ pTxOut = <* Atto.char '+' <*> (TxOutAdaOnly AdaOnlyInShelleyEra <$> parseLovelace) +-- TODO: Use this parser once the latest API changes have been propagated to +-- the \"transaction\" CLI. +_pTxOut :: Parser TxOutAnyEra +_pTxOut = + Opt.option (readerFromAttoParser parseTxOut) + ( Opt.long "tx-out" + <> Opt.metavar "TX-OUT" + <> Opt.help "The transaction output as Address+Lovelace where Address is \ + \the Bech32-encoded address followed by the amount in \ + \Lovelace." + ) + <|> + TxOutAnyEra + <$> pAddressAny + <*> + Opt.option (eitherReader (first renderParseError . stringToValue)) + ( Opt.long "tx-out-value" + <> Opt.metavar "TX-OUT-VALUE" + <> Opt.help + ("The transaction output value formatted in the new " + <> "multi-asset style." + ) + ) + where + parseTxOut :: Atto.Parser TxOutAnyEra + parseTxOut = + TxOutAnyEra <$> parseAddressAny + <* Atto.char '+' + <*> pAdaOnlyValue + + renderParseError :: Parsec.ParseError -> String + renderParseError = + intercalate ", " + . map Parsec.messageString + . Parsec.errorMessages + +pAdaOnlyValue :: Atto.Parser Value +pAdaOnlyValue = lovelaceToValue <$> parseLovelace + +pAddressAny :: Parser AddressAny +pAddressAny = + Opt.option (readerFromAttoParser parseAddressAny) + ( Opt.long "address" + <> Opt.metavar "ADDRESS" + <> Opt.help "A Cardano address." + ) + pMint :: Parser String pMint = Opt.strOption diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs index 4ae8467272b..9ffe3e7ecc1 100644 --- a/cardano-cli/src/Cardano/CLI/Types.hs +++ b/cardano-cli/src/Cardano/CLI/Types.hs @@ -11,13 +11,14 @@ module Cardano.CLI.Types , SigningKeyOrScriptFile (..) , SocketPath (..) , ScriptFile (..) + , TxOutAnyEra (..) , UpdateProposalFile (..) , VerificationKeyFile (..) ) where import Cardano.Prelude -import Data.Aeson +import qualified Data.Aeson as Aeson import qualified Data.Text as Text import qualified Cardano.Chain.Slotting as Byron @@ -44,7 +45,7 @@ newtype GenesisFile = GenesisFile deriving newtype (IsString, Show) instance FromJSON GenesisFile where - parseJSON (String genFp) = pure . GenesisFile $ Text.unpack genFp + parseJSON (Aeson.String genFp) = pure . GenesisFile $ Text.unpack genFp parseJSON invalid = panic $ "Parsing of GenesisFile failed due to type mismatch. " <> "Encountered: " <> Text.pack (show invalid) @@ -80,3 +81,11 @@ newtype ScriptFile = ScriptFile { unScriptFile :: FilePath } data SigningKeyOrScriptFile = ScriptFileForWitness FilePath | SigningKeyFileForWitness FilePath deriving (Eq, 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 +-- era-dependent 'TxOutValue' type. +-- +data TxOutAnyEra = TxOutAnyEra AddressAny Value + deriving (Eq, Show)