From eb15e23bd4c274e0e72d2828f259cca7b4a9acb9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Mon, 8 Apr 2024 15:41:15 +0200 Subject: [PATCH] Remove UnwitnessedCliFormattedTxBody constructor --- .../Cardano/CLI/EraBased/Run/Transaction.hs | 93 ++----------------- cardano-cli/src/Cardano/CLI/Read.hs | 24 ++--- 2 files changed, 22 insertions(+), 95 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 1a61700753..550ef5a0f8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -942,10 +942,9 @@ runTransactionSignCmd $ readFileTxBody txbodyFile case unwitnessed of - IncompleteCddlFormattedTx anyTx -> do - InAnyShelleyBasedEra sbe unwitTx <- pure anyTx + IncompleteCddlTxBody anyTxBody -> do + InAnyShelleyBasedEra sbe txbody <- pure anyTxBody - 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 TxCmdBootstrapWitnessError @@ -958,22 +957,6 @@ runTransactionSignCmd lift (writeTxFileTextEnvelopeCddl sbe outTxFile tx) & onLeft (left . TxCmdWriteFileError) - UnwitnessedCliFormattedTxBody anyTxbody -> do - InAnyShelleyBasedEra sbe txbody <- pure anyTxbody - -- Byron witnesses require the network ID. This can either be provided - -- directly or derived from a provided Byron address. - byronWitnesses <- firstExceptT TxCmdBootstrapWitnessError - . hoistEither - $ mkShelleyBootstrapWitnesses sbe mNetworkId txbody sksByron - - let shelleyKeyWitnesses = map (makeShelleyKeyWitness sbe txbody) sksShelley - tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody - - firstExceptT TxCmdWriteFileError . newExceptT - $ writeLazyByteStringFile outTxFile - $ shelleyBasedEraConstraints sbe - $ textEnvelopeToJSON Nothing tx - -- ---------------------------------------------------------------------------- -- Transaction submission -- @@ -1031,12 +1014,7 @@ runTransactionCalculateMinFeeCmd let nShelleyKeyWitW32 = fromIntegral nShelleyKeyWitnesses - InAnyShelleyBasedEra sbe txbody <- case unwitnessed of - IncompleteCddlFormattedTx (InAnyShelleyBasedEra sbe unwitTx) -> do - pure $ InAnyShelleyBasedEra sbe $ getTxBody unwitTx - - UnwitnessedCliFormattedTxBody (InAnyShelleyBasedEra sbe txbody) -> do - pure $ InAnyShelleyBasedEra sbe txbody + InAnyShelleyBasedEra sbe txbody <- pure $ unIncompleteCddlTxBody unwitnessed lpparams <- getLedgerPParams sbe pparams @@ -1199,11 +1177,8 @@ runTransactionTxIdCmd InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT TxCmdCddlError . newExceptT - $ readFileTxBody txbodyFile - case unwitnessed of - UnwitnessedCliFormattedTxBody anyTxBody -> return anyTxBody - IncompleteCddlFormattedTx (InAnyShelleyBasedEra era tx) -> - return (InAnyShelleyBasedEra era (getTxBody tx)) + $ readFileTxBody txbodyFile + return $ unIncompleteCddlTxBody unwitnessed InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath @@ -1226,12 +1201,8 @@ runTransactionViewCmd txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT TxCmdCddlError . newExceptT $ readFileTxBody txbodyFile - InAnyShelleyBasedEra era txbody <- - case unwitnessed of - UnwitnessedCliFormattedTxBody anyTxBody -> pure anyTxBody - IncompleteCddlFormattedTx (InAnyShelleyBasedEra era tx) -> - pure $ InAnyShelleyBasedEra era (getTxBody tx) - -- Why are we differentiating between a transaction body and a transaction? + InAnyShelleyBasedEra era txbody <- pure $ unIncompleteCddlTxBody unwitnessed + -- Why are we differentiating between a transaction body and a. newExceptT transaction? -- In the case of a transaction body, we /could/ simply call @makeSignedTransaction []@ -- to get a transaction which would allow us to reuse friendlyTxBS. However, -- this would mean that we'd have an empty list of witnesses mentioned in the output, which @@ -1266,10 +1237,8 @@ runTransactionWitnessCmd unwitnessed <- firstExceptT TxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of - IncompleteCddlFormattedTx anyTx -> do - InAnyShelleyBasedEra sbe cddlTx <- pure anyTx - - let txbody = getTxBody cddlTx + IncompleteCddlTxBody anyTxBody -> do + InAnyShelleyBasedEra sbe txbody <- pure anyTxBody someWit <- firstExceptT TxCmdReadWitnessSigningDataError . newExceptT $ readWitnessSigningData witnessSigningData witness <- @@ -1286,28 +1255,6 @@ runTransactionWitnessCmd firstExceptT TxCmdWriteFileError . newExceptT $ writeTxWitnessFileTextEnvelopeCddl sbe outFile witness - UnwitnessedCliFormattedTxBody anyTxbody -> do - InAnyShelleyBasedEra sbe txbody <- pure anyTxbody - - someWit <- firstExceptT TxCmdReadWitnessSigningDataError - . newExceptT $ readWitnessSigningData witnessSigningData - - witness <- - case categoriseSomeSigningWitness someWit of - -- Byron witnesses require the network ID. This can either be provided - -- directly or derived from a provided Byron address. - AByronWitness bootstrapWitData -> - firstExceptT TxCmdBootstrapWitnessError - . hoistEither - $ mkShelleyBootstrapWitness sbe mNetworkId txbody bootstrapWitData - AShelleyKeyWitness skShelley -> - pure $ makeShelleyKeyWitness sbe txbody skShelley - - firstExceptT TxCmdWriteFileError . newExceptT - $ writeLazyByteStringFile outFile - $ shelleyBasedEraConstraints sbe - $ textEnvelopeToJSON Nothing witness - runTransactionSignWitnessCmd :: () => Cmd.TransactionSignWitnessCmdArgs -> ExceptT TxCmdError IO () @@ -1320,27 +1267,7 @@ runTransactionSignWitnessCmd txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- lift (readFileTxBody txbodyFile) & onLeft (left . TxCmdCddlError) case unwitnessed of - UnwitnessedCliFormattedTxBody (InAnyShelleyBasedEra era txbody) -> do - witnesses <- - sequence - [ do - InAnyShelleyBasedEra era' witness <- - lift (readFileTxKeyWitness file) & onLeft (left . TxCmdCddlWitnessError) - let cEra = shelleyBasedToCardanoEra era - cEra' = shelleyBasedToCardanoEra era' - case testEquality era era' of - Nothing -> cardanoEraConstraints cEra' $ left $ TxCmdWitnessEraMismatch (AnyCardanoEra cEra) (AnyCardanoEra cEra') witnessFile - Just Refl -> return witness - | witnessFile@(WitnessFile file) <- witnessFiles - ] - - let tx = makeSignedTransaction witnesses txbody - - lift (writeLazyByteStringFile outFile $ shelleyBasedEraConstraints era - $ textEnvelopeToJSON Nothing tx) & onLeft (left . TxCmdWriteFileError) - - IncompleteCddlFormattedTx (InAnyShelleyBasedEra era anyTx) -> do - let txbody = getTxBody anyTx + IncompleteCddlTxBody (InAnyShelleyBasedEra era txbody) -> do -- TODO: Left off here. Remember we were never reading byron key witnesses anyways! witnesses <- sequence diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 4c45f43e75..9d79b9083d 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -33,7 +33,7 @@ module Cardano.CLI.Read -- * Tx , CddlError(..) , CddlTx(..) - , IncompleteTx(..) + , IncompleteCddlTxBody(..) , readFileTx , readFileTxBody , readCddlTx -- For testing purposes @@ -518,21 +518,21 @@ readFileTx file = do Left e -> fmap unCddlTx <$> acceptTxCDDLSerialisation file e Right tx -> return $ Right 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. +newtype IncompleteCddlTxBody = + IncompleteCddlTxBody { unIncompleteCddlTxBody :: InAnyShelleyBasedEra TxBody } -data IncompleteTx - = UnwitnessedCliFormattedTxBody (InAnyShelleyBasedEra TxBody) - | IncompleteCddlFormattedTx (InAnyShelleyBasedEra Tx) - -readFileTxBody :: FileOrPipe -> IO (Either CddlError IncompleteTx) +readFileTxBody :: FileOrPipe -> IO (Either CddlError IncompleteCddlTxBody) readFileTxBody file = do eTxBody <- readFileInAnyShelleyBasedEra AsTxBody file case eTxBody of - Left e -> fmap (IncompleteCddlFormattedTx . unCddlTx) <$> acceptTxCDDLSerialisation file e - Right txBody -> return $ Right $ UnwitnessedCliFormattedTxBody txBody + Left e -> do + cddlErrOrTx <- acceptTxCDDLSerialisation file e + case cddlErrOrTx of + Left cddlErr -> return $ Left cddlErr + Right cddlTx -> do + InAnyShelleyBasedEra sbe tx <- pure $ unCddlTx cddlTx + return $ Right $ IncompleteCddlTxBody $ inAnyShelleyBasedEra sbe $ getTxBody tx + Right txBody -> return $ Right $ IncompleteCddlTxBody txBody data CddlError = CddlErrorTextEnv !(FileError TextEnvelopeError)