Add CLI parser for new multi-asset tx output value format

IntersectMBO · Nov 26, 2020 · f11528e · f11528e
1 parent 5e36749
commit f11528e
Show file tree

Hide file tree

Showing 2 changed files with 63 additions and 5 deletions.
diff --git 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
@@ -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)