WIP

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

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

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

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

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 #-}

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

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]

cardano-cli/src/Cardano/CLI/Types/Common.hs

@@ -65,6 +65,7 @@ module Cardano.CLI.Types.Common
   , TxInCount(..)
   , TxMempoolQuery (..)
   , TxOutAnyEra (..)
+  , TxOutShelleyBasedEra (..)
   , TxOutChangeAddress (..)
   , TxOutCount(..)
   , TxOutDatumAnyEra (..)
@@ -389,6 +390,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