diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Poll.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Poll.hs index 6e8d57a18d..6681b3f725 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Poll.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Poll.hs @@ -165,7 +165,7 @@ runGovernanceVerifyPollCmd readFileTextEnvelope AsGovernancePoll pollFile txFileOrPipe <- liftIO $ fileOrPipe (unFile txFile) - tx <- firstExceptT GovernanceCmdCddlError . newExceptT $ + tx <- firstExceptT GovernanceCmdTextEnvCddlReadError . newExceptT $ readFileTx txFileOrPipe signatories <- firstExceptT GovernanceCmdVerifyPollError . newExceptT $ pure $ diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index cb43df39d6..e38905fe40 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -1150,7 +1150,7 @@ runTransactionSignCmd case txOrTxBody of InputTxFile (File inputTxFilePath) -> do inputTxFile <- liftIO $ fileOrPipe inputTxFilePath - anyTx <- lift (readFileTx inputTxFile) & onLeft (left . TxCmdCddlError) + anyTx <- lift (readFileTx inputTxFile) & onLeft (left . TxCmdTextEnvCddlError) InAnyShelleyBasedEra sbe tx <- pure anyTx @@ -1169,14 +1169,13 @@ runTransactionSignCmd InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT TxCmdCddlError . newExceptT + unwitnessed <- firstExceptT TxCmdTextEnvCddlError . newExceptT $ 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 @@ -1189,22 +1188,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 -- @@ -1220,7 +1203,7 @@ runTransactionSubmitCmd , txFile } = do txFileOrPipe <- liftIO $ fileOrPipe txFile - InAnyShelleyBasedEra era tx <- lift (readFileTx txFileOrPipe) & onLeft (left . TxCmdCddlError) + InAnyShelleyBasedEra era tx <- lift (readFileTx txFileOrPipe) & onLeft (left . TxCmdTextEnvCddlError) let txInMode = TxInMode era tx localNodeConnInfo = LocalNodeConnectInfo { localConsensusModeParams = consensusModeParams @@ -1254,7 +1237,7 @@ runTransactionCalculateMinFeeCmd txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- - firstExceptT TxCmdCddlError . newExceptT + firstExceptT TxCmdTextEnvCddlError . newExceptT $ readFileTxBody txbodyFile pparams <- firstExceptT TxCmdProtocolParamsError @@ -1262,12 +1245,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 @@ -1429,16 +1407,13 @@ runTransactionTxIdCmd case inputTxBodyOrTxFile of 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)) + unwitnessed <- firstExceptT TxCmdTextEnvCddlError . newExceptT + $ readFileTxBody txbodyFile + return $ unIncompleteCddlTxBody unwitnessed InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath - InAnyShelleyBasedEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdCddlError) + InAnyShelleyBasedEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdTextEnvCddlError) return . InAnyShelleyBasedEra era $ getTxBody tx liftIO $ BS.putStrLn $ serialiseToRawBytesHex (getTxId txbody) @@ -1455,13 +1430,9 @@ runTransactionViewCmd case inputTxBodyOrTxFile of InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT TxCmdCddlError . newExceptT + unwitnessed <- firstExceptT TxCmdTextEnvCddlError . newExceptT $ readFileTxBody txbodyFile - InAnyShelleyBasedEra era txbody <- - case unwitnessed of - UnwitnessedCliFormattedTxBody anyTxBody -> pure anyTxBody - IncompleteCddlFormattedTx (InAnyShelleyBasedEra era tx) -> - pure $ InAnyShelleyBasedEra era (getTxBody tx) + InAnyShelleyBasedEra era txbody <- pure $ unIncompleteCddlTxBody unwitnessed -- Why are we differentiating between a transaction body and a 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, @@ -1473,7 +1444,7 @@ runTransactionViewCmd ViewOutputFormatJson -> friendlyTxBody FriendlyJson mOutFile (toCardanoEra era) txbody InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath - InAnyShelleyBasedEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdCddlError) + InAnyShelleyBasedEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdTextEnvCddlError) firstExceptT TxCmdWriteFileError . newExceptT $ case outputFormat of ViewOutputFormatYaml -> friendlyTx FriendlyYaml mOutFile (toCardanoEra era) tx @@ -1494,13 +1465,11 @@ runTransactionWitnessCmd , outFile } = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT TxCmdCddlError . newExceptT + unwitnessed <- firstExceptT TxCmdTextEnvCddlError . 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 <- @@ -1517,28 +1486,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 () @@ -1549,29 +1496,9 @@ runTransactionSignWitnessCmd , outFile = outFile } = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- lift (readFileTxBody txbodyFile) & onLeft (left . TxCmdCddlError) + unwitnessed <- lift (readFileTxBody txbodyFile) & onLeft (left . TxCmdTextEnvCddlError) 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 2841a46600..d9ba0f0c00 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 @@ -511,28 +511,26 @@ deserialiseScriptInAnyLang bs = newtype CddlTx = CddlTx {unCddlTx :: InAnyShelleyBasedEra Tx} deriving (Show, Eq) -readFileTx :: FileOrPipe -> IO (Either CddlError (InAnyShelleyBasedEra Tx)) +readFileTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)) readFileTx file = do - eAnyTx <- readFileInAnyShelleyBasedEra AsTx file - case eAnyTx of - Left e -> fmap unCddlTx <$> acceptTxCDDLSerialisation file e - Right tx -> return $ Right tx + cddlTxOrErr <- readCddlTx file + case cddlTxOrErr of + Left e -> return $ Left e + Right cddlTx -> do + InAnyShelleyBasedEra sbe tx <- pure $ unCddlTx cddlTx + return $ Right $ inAnyShelleyBasedEra sbe 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 (FileError TextEnvelopeCddlError) 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 + cddlTxOrErr <- readCddlTx file + case cddlTxOrErr of + Left e -> return $ Left e + Right cddlTx -> do + InAnyShelleyBasedEra sbe tx <- pure $ unCddlTx cddlTx + return $ Right $ IncompleteCddlTxBody $ inAnyShelleyBasedEra sbe $ getTxBody tx data CddlError = CddlErrorTextEnv !(FileError TextEnvelopeError) @@ -549,22 +547,6 @@ instance Error CddlError where CddlIOError e -> prettyError e -acceptTxCDDLSerialisation - :: FileOrPipe - -> FileError TextEnvelopeError - -> IO (Either CddlError CddlTx) -acceptTxCDDLSerialisation file err = - case err of - e@(FileError _ (TextEnvelopeDecodeError _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx file - e@(FileError _ (TextEnvelopeAesonDecodeError _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx file - e@(FileError _ (TextEnvelopeTypeError _ _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx file - e@FileErrorTempFile{} -> return . Left $ CddlIOError e - e@FileDoesNotExistError{} -> return . Left $ CddlIOError e - e@FileIOError{} -> return . Left $ CddlIOError e - readCddlTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx) readCddlTx = readFileOrPipeTextEnvelopeCddlAnyOf teTypes where diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs index f67cf4daba..e467a03105 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs @@ -28,6 +28,7 @@ data GovernanceCmdError | GovernanceCmdHashError !GovernanceHashError | GovernanceCmdProposalError ProposalError | GovernanceCmdTextEnvReadError !(FileError TextEnvelopeError) + | GovernanceCmdTextEnvCddlReadError !(FileError TextEnvelopeCddlError) | GovernanceCmdCddlError !CddlError | GovernanceCmdKeyReadError !(FileError InputDecodeError) | GovernanceCmdCostModelReadError !(FileError ()) @@ -75,6 +76,8 @@ instance Error GovernanceCmdError where "Proposal error " <> pshow e -- TODO Conway render this properly GovernanceCmdTextEnvReadError fileError -> "Cannot read text envelope: " <> prettyError fileError + GovernanceCmdTextEnvCddlReadError fileError -> + "Cannot read text cddl envelope: " <> prettyError fileError GovernanceCmdCddlError cddlError -> "Reading transaction CDDL file error: " <> prettyError cddlError GovernanceCmdKeyReadError fileError -> diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs index fdbfbdcdd9..f92075760b 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -65,9 +65,8 @@ data TxCmdError | TxCmdBalanceTxBody !AnyTxBodyErrorAutoBalance | TxCmdTxInsDoNotExist !TxInsExistError | TxCmdPParamsErr !ProtocolParametersError - | TxCmdTextEnvCddlError - !(FileError TextEnvelopeError) - !(FileError TextEnvelopeCddlError) + | TxCmdTextEnvError !(FileError TextEnvelopeError) + | TxCmdTextEnvCddlError !(FileError TextEnvelopeCddlError) | TxCmdTxExecUnitsErr !AnyTxCmdTxExecUnitsErr | TxCmdPlutusScriptCostErr !PlutusScriptCostError | TxCmdPParamExecutionUnitsNotAvailable @@ -77,7 +76,6 @@ data TxCmdError | TxCmdQueryConvenienceError !QueryConvenienceError | TxCmdQueryNotScriptLocked !ScriptLockedTxInsError | TxCmdScriptDataError !ScriptDataError - | TxCmdCddlError CddlError | TxCmdCddlWitnessError CddlWitnessError | TxCmdRequiredSignerError RequiredSignerError -- Validation errors @@ -170,10 +168,14 @@ renderTxCmdError = \case pretty $ renderTxInsExistError e TxCmdPParamsErr err' -> prettyError err' - TxCmdTextEnvCddlError textEnvErr cddlErr -> + TxCmdTextEnvError err' -> + mconcat + [ "Failed to decode the ledger's CDDL serialisation format. " + , "File error: " <> prettyError err' + ] + TxCmdTextEnvCddlError cddlErr -> mconcat [ "Failed to decode the ledger's CDDL serialisation format. " - , "TextEnvelope error: " <> prettyError textEnvErr <> "\n" , "TextEnvelopeCddl error: " <> prettyError cddlErr ] TxCmdTxExecUnitsErr (AnyTxCmdTxExecUnitsErr err') -> @@ -207,8 +209,6 @@ renderTxCmdError = \case renderScriptDataError e TxCmdProtocolParamsError e -> renderProtocolParamsError e - TxCmdCddlError e -> - prettyError e TxCmdCddlWitnessError e -> prettyError e TxCmdRequiredSignerError e -> diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs index f824371a7a..eeb6163eb1 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs @@ -345,6 +345,8 @@ createAlonzoTxBody mUpdateProposalFile transactionBodyFile = do ] ) +-- | Execute me with: +-- @cabal test cardano-cli-golden --test-options '-p "/golden view alonzo yaml/"'@ hprop_golden_view_alonzo_yaml :: Property hprop_golden_view_alonzo_yaml = propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do @@ -381,6 +383,8 @@ hprop_golden_view_alonzo_yaml = ["transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] H.diffVsGoldenFile result $ goldenDir "alonzo/transaction-view.out" +-- | Execute me with: +-- @cabal test cardano-cli-golden --test-options '-p "/golden view alonzo signed yaml/"'@ hprop_golden_view_alonzo_signed_yaml :: Property hprop_golden_view_alonzo_signed_yaml = propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do