diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 39d599fb246..a132b20f8e7 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -81,6 +81,7 @@ module Cardano.Api.Shelley ), ShelleySigningKey(..), getShelleyKeyWitnessVerificationKey, + getTxBodyAndWitnesses, makeShelleySignature, toShelleySigningKey, diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index 5ce2bb6560d..43f000a0118 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/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) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index a80db419222..0ca23d30cc2 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/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 diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index 1cd1346f82b..5f216541ba8 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/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 diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index d9014e69a22..935ce39bc47 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/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 diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs index e692436a198..b21b1fddd8d 100644 --- a/cardano-cli/src/Cardano/CLI/Types.hs +++ b/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 +