Merge #3549

3549: Update transaction sign command to allow for incremental signing r=Jimbo4350 a=Jimbo4350

You can now specify an already signed transaction via `--tx-file` in order to add more signatures to it:  

`cardano-cli transaction sign (--tx-body-file FILE | --tx-file FILE) ...`

Resolves: #3545


Co-authored-by: Jordan Millar <jordan.millar@iohk.io>

cardano-api/src/Cardano/Api/Shelley.hs

@@ -81,6 +81,7 @@ module Cardano.Api.Shelley
       ),
     ShelleySigningKey(..),
     getShelleyKeyWitnessVerificationKey,
+    getTxBodyAndWitnesses,
     makeShelleySignature,
     toShelleySigningKey,
 

cardano-cli/src/Cardano/CLI/Byron/Tx.hs

@@ -46,7 +46,7 @@ import           Cardano.Api.Byron
 import           Cardano.CLI.Byron.Key (byronWitnessToVerKey)
 import           Cardano.CLI.Environment
 import           Cardano.CLI.Helpers (textShow)
-import           Cardano.CLI.Types (SocketPath (..))
+import           Cardano.CLI.Types (SocketPath (..), TxFile (..))
 import           Ouroboros.Consensus.Byron.Ledger (ByronBlock, GenTx (..))
 import qualified Ouroboros.Consensus.Byron.Ledger as Byron
 import           Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
@@ -71,11 +71,6 @@ renderByronTxError err =
       "Transaction deserialisation failed at " <> textShow txFp <> " Error: " <> textShow decErr
     EnvSocketError envSockErr -> renderEnvSocketError envSockErr
 
-
-newtype TxFile =
-  TxFile FilePath
-  deriving (Eq, Ord, Show, IsString)
-
 newtype NewTxFile =
   NewTxFile FilePath
   deriving (Eq, Ord, Show, IsString)

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -33,7 +33,6 @@ module Cardano.CLI.Shelley.Commands
   , ProtocolParamsFile (..)
   , ProtocolParamsSourceSpec (..)
   , WitnessFile (..)
-  , TxBodyFile (..)
   , TxFile (..)
   , InputTxFile (..)
   , VerificationKeyBase64 (..)
@@ -75,7 +74,6 @@ data ShelleyCommand
   | GovernanceCmd   GovernanceCmd
   | GenesisCmd      GenesisCmd
   | TextViewCmd     TextViewCmd
-  deriving Show
 
 renderShelleyCommand :: ShelleyCommand -> Text
 renderShelleyCommand sc =
@@ -225,7 +223,7 @@ data TransactionCmd
       (Maybe UpdateProposalFile)
       OutputSerialisation
       TxBodyFile
-  | TxSign TxBodyFile [WitnessSigningData] (Maybe NetworkId) TxFile
+  | TxSign TxBodyOrTxFile [WitnessSigningData] (Maybe NetworkId) TxFile
   | TxCreateWitness TxBodyFile WitnessSigningData (Maybe NetworkId) OutputFile
   | TxAssembleTxBodyWitness TxBodyFile [WitnessFile] OutputFile
   | TxSubmit AnyConsensusModeParams NetworkId FilePath
@@ -246,7 +244,6 @@ data TransactionCmd
       ScriptDataOrFile
   | TxGetTxId InputTxFile
   | TxView InputTxFile
-  deriving Show
 
 data InputTxFile = InputTxBodyFile TxBodyFile | InputTxFile TxFile
   deriving Show
@@ -537,14 +534,6 @@ newtype WitnessFile
   = WitnessFile FilePath
   deriving Show
 
-newtype TxBodyFile
-  = TxBodyFile FilePath
-  deriving Show
-
-newtype TxFile
-  = TxFile FilePath
-  deriving Show
-
 -- | A raw verification key given in Base64, and decoded into a ByteString.
 newtype VerificationKeyBase64
   = VerificationKeyBase64 String

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -724,7 +724,9 @@ pTransaction =
                <*> pTxBodyFile Output
 
   pTransactionSign  :: Parser TransactionCmd
-  pTransactionSign = TxSign <$> pTxBodyFile Input
+  pTransactionSign = TxSign <$> ( TxBodyFp <$> pTxBodyFile Input <|>
+                                  TxFp <$> pTxFile Input
+                                )
                             <*> pSomeWitnessSigningData
                             <*> optional pNetworkId
                             <*> pTxFile Output

cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs

@@ -981,52 +981,73 @@ readScriptDataOrFile (ScriptDataCborFile fp) = do
 -- Transaction signing
 --
 
-runTxSign :: TxBodyFile
+runTxSign :: TxBodyOrTxFile
           -> [WitnessSigningData]
           -> Maybe NetworkId
           -> TxFile
           -> ExceptT ShelleyTxCmdError IO ()
-runTxSign (TxBodyFile txbodyFile) witSigningData mnw (TxFile txFile) = do
+runTxSign txOrTxBody witSigningData mnw (TxFile outTxFile) = do
   sks <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError $
             mapM readWitnessSigningData witSigningData
 
   let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeWitness sks
 
-  unwitnessed <- readFileTxBody txbodyFile
-
-  case unwitnessed of
-    UnwitnessedTx anyTx -> do
-     InAnyShelleyBasedEra _era unwitTx <-
-       onlyInShelleyBasedEras "sign for Byron era transactions" anyTx
-
-     let txbody = getTxBody unwitTx
-     -- Byron witnesses require the network ID. This can either be provided
-     -- directly or derived from a provided Byron address.
-     byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError
-       . hoistEither
-       $ mkShelleyBootstrapWitnesses mnw txbody sksByron
+  case txOrTxBody of
+    (TxFp (TxFile inputTxFile)) -> do
+      anyTx <- readFileTx inputTxFile
 
-     let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley
-         tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody
+      InAnyShelleyBasedEra _era tx <-
+          onlyInShelleyBasedEras "sign for Byron era transactions" anyTx
 
-     firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
-                  writeTxFileTextEnvelopeCddl txFile tx
+      let (txbody, existingTxKeyWits) = getTxBodyAndWitnesses tx
 
-    UnwitnessedTxBody anyTxbody -> do
-      InAnyShelleyBasedEra _era txbody <-
-        --TODO: in principle we should be able to support Byron era txs too
-        onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody
-      -- Byron witnesses require the network ID. This can either be provided
-      -- directly or derived from a provided Byron address.
       byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError
-        . hoistEither
-        $ mkShelleyBootstrapWitnesses mnw txbody sksByron
+                          . hoistEither
+                          $ mkShelleyBootstrapWitnesses mnw txbody sksByron
 
-      let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley
-          tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody
+      let newShelleyKeyWits = map (makeShelleyKeyWitness txbody) sksShelley
+          allKeyWits = existingTxKeyWits ++ newShelleyKeyWits ++ byronWitnesses
+          signedTx = makeSignedTransaction allKeyWits txbody
 
       firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
-        writeFileTextEnvelope txFile Nothing tx
+        writeFileTextEnvelope outTxFile Nothing signedTx
+
+    (TxBodyFp (TxBodyFile txbodyFile)) -> do
+      unwitnessed <- readFileTxBody txbodyFile
+
+      case unwitnessed of
+        IncompleteCddlFormattedTx anyTx -> do
+         InAnyShelleyBasedEra _era unwitTx <-
+           onlyInShelleyBasedEras "sign for Byron era transactions" anyTx
+
+         let txbody = getTxBody unwitTx
+         -- Byron witnesses require the network ID. This can either be provided
+         -- directly or derived from a provided Byron address.
+         byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError
+           . hoistEither
+           $ mkShelleyBootstrapWitnesses mnw txbody sksByron
+
+         let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley
+             tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody
+
+         firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
+                      writeTxFileTextEnvelopeCddl outTxFile tx
+
+        UnwitnessedCliFormattedTxBody anyTxbody -> do
+          InAnyShelleyBasedEra _era txbody <-
+            --TODO: in principle we should be able to support Byron era txs too
+            onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody
+          -- Byron witnesses require the network ID. This can either be provided
+          -- directly or derived from a provided Byron address.
+          byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError
+            . hoistEither
+            $ mkShelleyBootstrapWitnesses mnw txbody sksByron
+
+          let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley
+              tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody
+
+          firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
+            writeFileTextEnvelope outTxFile Nothing tx
 
 
 -- ----------------------------------------------------------------------------
@@ -1083,7 +1104,7 @@ runTxCalculateMinFee (TxBodyFile txbodyFile) nw protocolParamsSourceSpec
     unwitnessed <- readFileTxBody txbodyFile
     pparams <- readProtocolParametersSourceSpec protocolParamsSourceSpec
     case unwitnessed of
-      UnwitnessedTx anyTx -> do
+      IncompleteCddlFormattedTx anyTx -> do
         InAnyShelleyBasedEra _era unwitTx <-
           onlyInShelleyBasedEras "sign for Byron era transactions" anyTx
         let txbody =  getTxBody unwitTx
@@ -1098,7 +1119,7 @@ runTxCalculateMinFee (TxBodyFile txbodyFile) nw protocolParamsSourceSpec
 
         liftIO $ putStrLn $ (show fee :: String) <> " Lovelace"
 
-      UnwitnessedTxBody anyTxBody -> do
+      UnwitnessedCliFormattedTxBody anyTxBody -> do
         InAnyShelleyBasedEra _era txbody <-
               --TODO: in principle we should be able to support Byron era txs too
               onlyInShelleyBasedEras "calculate-min-fee for Byron era transactions" anyTxBody
@@ -1361,8 +1382,8 @@ runTxGetTxId txfile = do
         InputTxBodyFile (TxBodyFile txbodyFile) -> do
           unwitnessed <- readFileTxBody txbodyFile
           case unwitnessed of
-            UnwitnessedTxBody anyTxBody -> return anyTxBody
-            UnwitnessedTx (InAnyCardanoEra era tx) ->
+            UnwitnessedCliFormattedTxBody anyTxBody -> return anyTxBody
+            IncompleteCddlFormattedTx (InAnyCardanoEra era tx) ->
               return (InAnyCardanoEra era (getTxBody tx))
 
         InputTxFile (TxFile txFile) -> do
@@ -1378,8 +1399,8 @@ runTxView txfile = do
       InputTxBodyFile (TxBodyFile txbodyFile) -> do
         unwitnessed <- readFileTxBody txbodyFile
         case unwitnessed of
-          UnwitnessedTxBody anyTxBody -> return anyTxBody
-          UnwitnessedTx (InAnyCardanoEra era tx) ->
+          UnwitnessedCliFormattedTxBody anyTxBody -> return anyTxBody
+          IncompleteCddlFormattedTx (InAnyCardanoEra era tx) ->
             return (InAnyCardanoEra era (getTxBody tx))
       InputTxFile (TxFile txFile) -> do
         InAnyCardanoEra era tx <- readFileTx txFile
@@ -1400,7 +1421,7 @@ runTxCreateWitness
 runTxCreateWitness (TxBodyFile txbodyFile) witSignData mbNw (OutputFile oFile) = do
   unwitnessed <- readFileTxBody txbodyFile
   case unwitnessed of
-    UnwitnessedTx anyTx -> do
+    IncompleteCddlFormattedTx anyTx -> do
      InAnyShelleyBasedEra sbe cddlTx <-
        onlyInShelleyBasedEras "sign for Byron era transactions" anyTx
 
@@ -1422,7 +1443,7 @@ runTxCreateWitness (TxBodyFile txbodyFile) witSignData mbNw (OutputFile oFile) =
      firstExceptT ShelleyTxCmdWriteFileError . newExceptT
        $ writeTxWitnessFileTextEnvelopeCddl sbe oFile witness
 
-    UnwitnessedTxBody anyTxbody -> do
+    UnwitnessedCliFormattedTxBody anyTxbody -> do
       InAnyShelleyBasedEra _era txbody <-
         onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody
 
@@ -1443,8 +1464,6 @@ runTxCreateWitness (TxBodyFile txbodyFile) witSignData mbNw (OutputFile oFile) =
       firstExceptT ShelleyTxCmdWriteFileError . newExceptT
         $ writeFileTextEnvelope oFile Nothing witness
 
-newtype CddlTx = CddlTx {unCddlTx :: InAnyCardanoEra Tx}
-
 runTxSignWitness
   :: TxBodyFile
   -> [WitnessFile]
@@ -1453,7 +1472,7 @@ runTxSignWitness
 runTxSignWitness (TxBodyFile txbodyFile) witnessFiles (OutputFile oFp) = do
     unwitnessed <- readFileTxBody txbodyFile
     case unwitnessed of
-      UnwitnessedTxBody (InAnyCardanoEra era txbody) -> do
+      UnwitnessedCliFormattedTxBody (InAnyCardanoEra era txbody) -> do
         witnesses <-
           sequence
             [ do InAnyCardanoEra era' witness <- readFileWitness file
@@ -1471,7 +1490,7 @@ runTxSignWitness (TxBodyFile txbodyFile) witnessFiles (OutputFile oFp) = do
           . newExceptT
           $ writeFileTextEnvelope oFp Nothing tx
 
-      UnwitnessedTx (InAnyCardanoEra era anyTx) -> do
+      IncompleteCddlFormattedTx (InAnyCardanoEra era anyTx) -> do
         let txbody = getTxBody anyTx
 
         witnesses <-
@@ -1537,16 +1556,19 @@ readFileWitness fp =
     (\e -> unCddlWitness <$> acceptKeyWitnessCDDLSerialisation e)
     (readFileInAnyCardanoEra AsKeyWitness fp)
 
--- UnwitnessedTx is an unwitnessed CDDL formatted tx while
--- UnwitnessedTxBody is CLI formatted tx body.
-data UnwitnessedTx = UnwitnessedTxBody (InAnyCardanoEra TxBody)
-                   | UnwitnessedTx (InAnyCardanoEra Tx)
+-- IncompleteCddlFormattedTx is an CDDL formatted tx or partial tx
+-- (respectively needs additional witnesses or totally unwitnessed)
+-- while UnwitnessedCliFormattedTxBody is CLI formatted TxBody and
+-- needs to be key witnessed.
+data IncompleteTx
+  = UnwitnessedCliFormattedTxBody (InAnyCardanoEra TxBody)
+  | IncompleteCddlFormattedTx (InAnyCardanoEra Tx)
 
-readFileTxBody :: FilePath -> ExceptT ShelleyTxCmdError IO UnwitnessedTx
+readFileTxBody :: FilePath -> ExceptT ShelleyTxCmdError IO IncompleteTx
 readFileTxBody fp =
   handleLeftT
-    (\e -> UnwitnessedTx . unCddlTx <$> acceptTxCDDLSerialisation e)
-    (UnwitnessedTxBody <$> readFileInAnyCardanoEra AsTxBody fp)
+    (\e -> IncompleteCddlFormattedTx . unCddlTx <$> acceptTxCDDLSerialisation e)
+    (UnwitnessedCliFormattedTxBody <$> readFileInAnyCardanoEra AsTxBody fp)
 
 acceptTxCDDLSerialisation
   :: ShelleyTxCmdError

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

@@ -7,6 +7,7 @@
 module Cardano.CLI.Types
   ( BalanceTxExecUnits (..)
   , CBORObject (..)
+  , CddlTx (..)
   , CertificateFile (..)
   , EpochLeadershipSchedule (..)
   , GenesisFile (..)
@@ -20,9 +21,12 @@ module Cardano.CLI.Types
   , ScriptWitnessFiles (..)
   , ScriptDatumOrFile (..)
   , TransferDirection(..)
+  , TxBodyFile (..)
+  , TxBodyOrTxFile (..)
   , TxOutAnyEra (..)
   , TxOutChangeAddress (..)
   , TxOutDatumAnyEra (..)
+  , TxFile (..)
   , UpdateProposalFile (..)
   , VerificationKeyFile (..)
   , Stakes (..)
@@ -53,6 +57,8 @@ data CBORObject = CBORBlockByron Byron.EpochSlots
                 | CBORVoteByron
                 deriving Show
 
+newtype CddlTx = CddlTx {unCddlTx :: InAnyCardanoEra Tx}
+
 -- Encompasses stake certificates, stake pool certificates,
 -- genesis delegate certificates and MIR certificates.
 newtype CertificateFile = CertificateFile { unCertificateFile :: FilePath }
@@ -242,3 +248,15 @@ data EpochLeadershipSchedule
   | NextEpoch
   deriving Show
 
+newtype TxBodyFile
+  = TxBodyFile FilePath
+  deriving Show
+
+newtype TxFile
+  = TxFile FilePath
+  deriving Show
+
+data TxBodyOrTxFile
+  = TxBodyFp TxBodyFile
+  | TxFp TxFile
+