From 939af9d3c5f55de1b26256ea2dcdd9520912ad48 Mon Sep 17 00:00:00 2001
From: Jordan Millar <jordan.millar@iohk.io>
Date: Mon, 17 Jan 2022 15:18:18 -0400
Subject: [PATCH] WIP 2

---
 .../src/Cardano/Api/SerialiseLedgerCddl.hs    | 76 ++++++-------------
 cardano-api/src/Cardano/Api/Tx.hs             |  4 +-
 2 files changed, 28 insertions(+), 52 deletions(-)

diff --git a/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs
index 84c19e938f8..22a79b729f1 100644
--- a/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs
+++ b/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs
@@ -42,6 +42,7 @@ import qualified Cardano.Binary as CBOR
 import           Cardano.Api.Eras
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.SerialiseCBOR
+import           Cardano.Api.SerialiseTextEnvelope
 import           Cardano.Api.Tx
 import           Cardano.Api.TxBody
 
@@ -59,72 +60,45 @@ import           Cardano.Api.TxBody
 -- TODO: look at HasTextEnvelope (Tx era) for inspiration with respect to teCddlType
 -- Which could really be a text field.
 data TextEnvelopeCddl = TextEnvelopeCddl
-  { teCddlType :: !TextEnvelopeCddlType
+  { teCddlType :: !Text
   , teCddlDescription :: !Text
   , teCddlRawCBOR :: !ByteString
   } deriving (Eq, Show)
 
-data TextEnvelopeCddlType
-  = TextEnvelopeCddlWitnessedTx
-  | TextEnvelopeCddlUnwitnessedTx
-  deriving (Eq, Show)
-
-
 data TextEnvelopeCddlError
   = TextEnvelopeCddlErrExpectedUnwitnessed TextEnvelopeCddl
   | TextEnvelopeCddlErrExpectedWitnessed TextEnvelopeCddl
   | TextEnvelopeCddlErrCBORDecodingError DecoderError
 
--- TODO: We need to check Tx era directly for witnesses and error on them
-serialiseWitnessedTxLedgerCddl :: IsCardanoEra era => Tx era -> TextEnvelopeCddl
-serialiseWitnessedTxLedgerCddl tx =
+serialiseTxLedgerCddl :: forall era. IsCardanoEra era => Tx era -> TextEnvelopeCddl
+serialiseTxLedgerCddl tx =
   TextEnvelopeCddl
-    { teCddlType = TextEnvelopeCddlWitnessedTx
-    , teCddlDescription = "Witnessed Ledger Tx in CDDL Format"
+    { teCddlType = genType tx
+    , teCddlDescription = "Ledger CDDL Format"
     , teCddlRawCBOR = serialiseToCBOR tx
     -- The SerialiseAsCBOR (Tx era) instance serializes to the CDDL format
     }
-
--- TODO: Likewise here. Makes more sense to check the Tx directly
-deserialiseWitnessedTxLedgerCddl
-  :: CardanoEra era
+ where
+  genTxType :: Text
+  genTxType = case cardanoEra :: CardanoEra era of
+        ByronEra   -> "Tx Byron"
+        ShelleyEra -> "Tx Shelley"
+        AllegraEra -> "Tx AllegraEra"
+        MaryEra    -> "Tx MaryEra"
+        AlonzoEra  -> "Tx AlonzoEra"
+
+  genType :: Tx era -> Text
+  genType tx' = case getTxWitnesses tx' of
+                  [] -> "Unwitnessed " <> genTxType
+                  _ -> "Witnessed " <> genTxType
+
+deserialiseTxLedgerCddl
+  :: IsCardanoEra era
+  => CardanoEra era
   -> TextEnvelopeCddl
   -> Either TextEnvelopeCddlError (Tx era)
-deserialiseWitnessedTxLedgerCddl era tec =
-  case teCddlType tec of
-    TextEnvelopeCddlUnwitnessedTx -> Left $ TextEnvelopeCddlErrExpectedWitnessed tec
-    TextEnvelopeCddlWitnessedTx -> first TextEnvelopeCddlErrCBORDecodingError
-                                     $ deserialiseTx era $ teCddlRawCBOR tec
-
--- TODO: Need to clarify that we are talking about no KEY witnesses.
--- consider a function to check this and produce a wrapped TxBody in a newtype.
--- We will potentially have script witnesses
--- in the tx body
-serialiseUnwitnessedTxLedgerCddl :: IsCardanoEra era => TxBody era -> TextEnvelopeCddl
-serialiseUnwitnessedTxLedgerCddl tBody =
-  TextEnvelopeCddl
-    { teCddlType = TextEnvelopeCddlUnwitnessedTx
-    , teCddlDescription = "Unwitnessed Ledger Tx in CDDL Format"
-    , teCddlRawCBOR = serialiseToCBOR $ makeSignedTransaction [] tBody
-    -- The SerialiseAsCBOR (Tx era) instance serializes to the CDDL format
-    }
-
-deserialiseUnwitnessedTxLedgerCddl
-  :: CardanoEra era
-  -> TextEnvelopeCddl
-  -> Either TextEnvelopeCddlError (TxBody era)
-deserialiseUnwitnessedTxLedgerCddl era tec =
-  case teCddlType tec of
-    TextEnvelopeCddlWitnessedTx ->
-      Left $ TextEnvelopeCddlErrExpectedUnwitnessed tec
-    TextEnvelopeCddlUnwitnessedTx -> do
-      unwitTx <- first TextEnvelopeCddlErrCBORDecodingError
-                   $ deserialiseTx era $ teCddlRawCBOR tec
-      case getTxBodyAndWitnesses unwitTx of
-        -- TODO: Use getTxWitnesses instead
-        (bdy, []) -> Right bdy
-        (bdy, wits) -> Left $ TextEnvelopeCddlErrExpectedUnwitnessed tec
-
+deserialiseTxLedgerCddl era tec =
+  first TextEnvelopeCddlErrCBORDecodingError $ deserialiseTx era $ teCddlRawCBOR tec
 
 deserialiseTx
   :: forall era. IsCardanoEra era
diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs
index 44d69b2164d..d1e994d649a 100644
--- a/cardano-api/src/Cardano/Api/Tx.hs
+++ b/cardano-api/src/Cardano/Api/Tx.hs
@@ -349,7 +349,9 @@ pattern AsShelleyWitness :: AsType (KeyWitness ShelleyEra)
 pattern AsShelleyWitness = AsKeyWitness AsShelleyEra
 {-# COMPLETE AsShelleyWitness #-}
 
-
+-- We implement a custom serialization instance that differs from
+-- cardano-ledger because we to be able to tell the difference between
+-- on disk witnesses for the cli's 'assemble' command.
 instance IsCardanoEra era => SerialiseAsCBOR (KeyWitness era) where
     serialiseToCBOR (ByronKeyWitness wit) = CBOR.serialize' wit