Merge pull request #707 from IntersectMBO/smelc/remove-UnwitnessedCli…

…FormattedTxBody-constructor-v2

Remove UnwitnessedCliFormattedTxBody constructor

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 $

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,20 +1237,15 @@ runTransactionCalculateMinFeeCmd
 
   txbodyFile <- liftIO $ fileOrPipe txbodyFilePath
   unwitnessed <-
-    firstExceptT TxCmdCddlError . newExceptT
+    firstExceptT TxCmdTextEnvCddlError . newExceptT
       $ readFileTxBody txbodyFile
   pparams <-
     firstExceptT TxCmdProtocolParamsError
       $ readProtocolParameters protocolParamsFile
 
   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

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

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

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

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