diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index a8a917ad5a1..b330b59d298 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -59,6 +59,7 @@ library Cardano.CLI.Shelley.Run.TextView Cardano.CLI.Shelley.Run.Transaction + Cardano.CLI.Mary.TxOutParser Cardano.CLI.Mary.ValueParser Cardano.CLI.TopHandler diff --git a/cardano-cli/src/Cardano/CLI/Mary/TxOutParser.hs b/cardano-cli/src/Cardano/CLI/Mary/TxOutParser.hs new file mode 100644 index 00000000000..fb796bc1848 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Mary/TxOutParser.hs @@ -0,0 +1,83 @@ +module Cardano.CLI.Mary.TxOutParser + ( TxOutAnyEraParseError (..) + , renderTxOutAnyEraParseError + , stringToTxOutAnyEra + ) where + +import Prelude + +import Control.Applicative (some, (<|>)) +import Data.Bifunctor (first) +import Data.Char (isAsciiLower, isAsciiUpper, isDigit) +import Data.Functor (void) +import Data.Text (Text) +import qualified Data.Text as Text +import Text.Parsec (ParseError, parse, satisfy, try) +import Text.Parsec.Char (space, spaces, string) +import Text.Parsec.String (Parser) + +import Cardano.API (AddressAny (..), AsType (..), deserialiseAddress) +import Cardano.CLI.Mary.ValueParser (ValueExpr, ValueExpressionEvaluationError, + evalValueExpr, renderParsecParseError, renderValueExpressionEvaluationError, + valueExpr) +import Cardano.CLI.Types (TxOutAnyEra (..)) + +stringToTxOutAnyEra :: String -> Either TxOutAnyEraParseError TxOutAnyEra +stringToTxOutAnyEra str = + case parse txOutAnyEra "" str of + Left parseErr -> Left (TxOutAnyEraParseError parseErr) + Right (ParsedTxOutAnyEra addr valExpr) -> do + val <- first ParsedValueExpressionEvaluationError (evalValueExpr valExpr) + pure $ TxOutAnyEra addr val + +-- | Error parsing a 'Value'. +data TxOutAnyEraParseError + = TxOutAnyEraParseError !ParseError + -- ^ Error parsing the transaction output. + | ParsedValueExpressionEvaluationError !ValueExpressionEvaluationError + -- ^ Error evaluating a parsed 'ValueExpr'. + deriving Show + +-- | Render an error message for a 'TxOutAnyEraParseError'. +renderTxOutAnyEraParseError :: TxOutAnyEraParseError -> Text +renderTxOutAnyEraParseError err = + case err of + TxOutAnyEraParseError pErr -> renderParsecParseError pErr + ParsedValueExpressionEvaluationError evalErr -> + renderValueExpressionEvaluationError evalErr + +data ParsedTxOutAnyEra = ParsedTxOutAnyEra !AddressAny !ValueExpr + +txOutAnyEra :: Parser ParsedTxOutAnyEra +txOutAnyEra = do + ParsedTxOutAnyEra + <$> addressAny + <* (try addrValueSepOldSyntax <|> someSpace) + <*> valueExpr + where + -- Essentially @some space@, but the result is discarded. + someSpace :: Parser () + someSpace = void (some space) + + -- Parser for the old style of separating the address and value in a + -- transaction output. + addrValueSepOldSyntax :: Parser () + addrValueSepOldSyntax = spaces *> string "+" *> spaces + +addressAny :: Parser AddressAny +addressAny = do + str <- plausibleAddressString + case deserialiseAddress AsAddressAny str of + Nothing -> fail "expecting valid address" + Just addr -> pure addr + +plausibleAddressString :: Parser Text +plausibleAddressString = + Text.pack <$> some (satisfy isPlausibleAddressChar) + where + -- Covers both base58 and bech32 (with constrained prefixes) + isPlausibleAddressChar c = + isAsciiLower c + || isAsciiUpper c + || isDigit c + || c == '_'