Remove JSON instance for TxShelleyCert and BabbageTxBody

hydra-cluster/src/Hydra/Cluster/Scenarios.hs

@@ -523,12 +523,12 @@ canSubmitTransactionThroughAPI tracer workDir node hydraScriptsTxId =
         Left e -> failure $ show e
         Right body -> do
           let unsignedTx = makeSignedTransaction [] body
-          let unsignedRequest = toJSON $ toLedgerTx unsignedTx
+          let unsignedRequest = toLedgerTx unsignedTx
           sendRequest hydraNodeId unsignedRequest
             `shouldThrow` expectErrorStatus 400 (Just "MissingVKeyWitnessesUTXOW")
 
           let signedTx = signTx cardanoBobSk unsignedTx
-          let signedRequest = toJSON $ toLedgerTx signedTx
+          let signedRequest = toLedgerTx signedTx
           (sendRequest hydraNodeId signedRequest <&> responseBody)
             `shouldReturn` TransactionSubmitted
  where

hydra-node/src/Hydra/Ledger/Cardano.hs

@@ -28,6 +28,7 @@ import Cardano.Ledger.Shelley.UTxO qualified as Ledger
 import Codec.CBOR.Decoding qualified as CBOR
 import Codec.CBOR.Encoding qualified as CBOR
 import Control.Monad (foldM)
+import Data.Aeson qualified as Aeson
 import Data.ByteString qualified as BS
 import Data.Default (def)
 import Data.Map.Strict qualified as Map
@@ -50,7 +51,6 @@ import Test.QuickCheck (
   suchThat,
   vectorOf,
  )
-import qualified Data.Aeson as Aeson
 
 -- * Ledger
 
@@ -126,7 +126,7 @@ instance FromCBOR Tx where
         (pure . fromLedgerTx)
 
 instance ToJSON Tx where
-  toJSON tx = Aeson.String $ decodeUtf8 @Text $ serialiseToCBOR tx
+  toJSON = toJSON . toLedgerTx
 
 instance FromJSON Tx where
   parseJSON v = do

hydra-node/src/Hydra/Ledger/Cardano/Json.hs

@@ -11,20 +11,21 @@ module Hydra.Ledger.Cardano.Json where
 import Hydra.Cardano.Api
 import Hydra.Prelude
 
+import Cardano.Binary qualified as CBOR
 import Cardano.Crypto.Hash.Class qualified as Crypto
 import Cardano.Ledger.Address qualified as Ledger
 import Cardano.Ledger.Allegra.Scripts qualified as Ledger
 import Cardano.Ledger.Alonzo.Scripts qualified as Ledger
 import Cardano.Ledger.Alonzo.TxAuxData qualified as Ledger
 import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
-import Cardano.Ledger.Api (Babbage, outputsTxBodyL)
+import Cardano.Ledger.Api (Babbage)
 import Cardano.Ledger.Api qualified as Ledger
 import Cardano.Ledger.Api.Era (eraProtVerLow)
 import Cardano.Ledger.Babbage.PParams (BabbagePParams (..))
 import Cardano.Ledger.Babbage.PParams qualified as Ledger
 import Cardano.Ledger.Babbage.Tx qualified as Ledger
 import Cardano.Ledger.Babbage.TxBody qualified as Ledger
-import Cardano.Ledger.BaseTypes (StrictMaybe (..), isSJust)
+import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import Cardano.Ledger.Binary (
   DecCBOR,
   EncCBOR,
@@ -36,14 +37,11 @@ import Cardano.Ledger.Binary (
   serialize',
  )
 import Cardano.Ledger.Binary.Decoding (Annotator)
-import Cardano.Ledger.Block (txid)
 import Cardano.Ledger.Core qualified as Ledger
 import Cardano.Ledger.Mary.Value qualified as Ledger
 import Cardano.Ledger.SafeHash qualified as Ledger
 import Cardano.Ledger.Shelley.API qualified as Ledger
-import Cardano.Ledger.Shelley.TxCert qualified as Ledger
 import Codec.Binary.Bech32 qualified as Bech32
-import Control.Lens ((^.))
 import Data.Aeson (
   FromJSONKey (fromJSONKey),
   FromJSONKeyFunction (FromJSONKeyTextParser),
@@ -66,7 +64,6 @@ import Data.Aeson.Types (
  )
 import Data.ByteString.Base16 qualified as Base16
 import Data.Map qualified as Map
-import Data.Set qualified as Set
 
 -- XXX: Maybe use babbagePParamsHKDPairs?
 instance FromJSON (Ledger.BabbagePParams Identity era) where
@@ -165,23 +162,6 @@ instance Ledger.Crypto crypto => ToJSON (Ledger.BootstrapWitness crypto) where
 instance Ledger.Crypto crypto => FromJSON (Ledger.BootstrapWitness crypto) where
   parseJSON = parseHexEncodedCborAnnotated @LedgerEra "BootstrapWitness"
 
---
--- DCert
---
--- TODO: Delegation certificates can actually be represented as plain JSON
--- objects (it's a sum type), so we may want to revisit this interface later?
-
-instance Ledger.Era era => ToJSON (Ledger.ShelleyTxCert era) where
-  toJSON = String . decodeUtf8 . Base16.encode . serialize' (eraProtVerLow @era)
-
-instance
-  ( Ledger.ShelleyEraTxCert era
-  , Ledger.TxCert era ~ Ledger.ShelleyTxCert era
-  ) =>
-  FromJSON (Ledger.ShelleyTxCert era)
-  where
-  parseJSON = parseHexEncodedCbor @era "TxCert"
-
 --
 -- IsValid
 --
@@ -261,69 +241,12 @@ instance Ledger.Era era => ToJSON (Ledger.Timelock era) where
 instance Ledger.Era era => FromJSON (Ledger.Timelock era) where
   parseJSON = parseHexEncodedCborAnnotated @era "Timelock"
 
---
--- TxBody
---
-
-instance ToJSON (Ledger.BabbageTxBody LedgerEra) where
-  toJSON b =
-    object $
-      mconcat
-        [ onlyIf (const True) "inputs" (Set.map fromLedgerTxIn (Ledger.spendInputs' b))
-        , onlyIf (not . null) "collateral" (Set.map fromLedgerTxIn (Ledger.collateralInputs' b))
-        , onlyIf (not . null) "referenceInputs" (Set.map fromLedgerTxIn (Ledger.referenceInputs' b))
-        , onlyIf (const True) "outputs" (fromLedgerTxOut <$> b ^. outputsTxBodyL)
-        , onlyIf isSJust "collateralReturn" (fromLedgerTxOut <$> Ledger.collateralReturn' b)
-        , onlyIf isSJust "totalCollateral" (Ledger.totalCollateral' b)
-        , onlyIf (not . null) "certificates" (Ledger.certs' b)
-        , onlyIf (not . null . Ledger.unWithdrawals) "withdrawals" (Ledger.withdrawals' b)
-        , onlyIf (const True) "fees" (Ledger.txfee' b)
-        , onlyIf (not . isOpenInterval) "validity" (Ledger.vldt' b)
-        , onlyIf (not . null) "requiredSignatures" (Ledger.reqSignerHashes' b)
-        , onlyIf (/= mempty) "mint" (fromLedgerMultiAsset (Ledger.mint' b))
-        , onlyIf isSJust "scriptIntegrityHash" (Ledger.scriptIntegrityHash' b)
-        , onlyIf isSJust "auxiliaryDataHash" (Ledger.adHash' b)
-        , onlyIf isSJust "networkId" (Ledger.txnetworkid' b)
-        ]
-
 -- NOTE: The 'Sized' instance is always using the fixed 'LedgerEra' to determine
 -- version and thus encoded size.
 instance (EncCBOR a, FromJSON a) => FromJSON (Sized a) where
   parseJSON =
     fmap (mkSized $ eraProtVerLow @LedgerEra) . parseJSON
 
-instance
-  ( Ledger.BabbageEraTxBody era
-  , FromJSON (Ledger.MaryValue (Ledger.EraCrypto era))
-  , FromJSON (Ledger.TxAuxData era)
-  , FromJSON (Ledger.TxOut era)
-  , FromJSON (Ledger.TxCert era)
-  , FromJSON (Ledger.TxIn (Ledger.EraCrypto era))
-  , FromJSON (Ledger.BabbageTxOut era)
-  ) =>
-  FromJSON (Ledger.BabbageTxBody era)
-  where
-  parseJSON = withObject "TxBody" $ \o -> do
-    Ledger.BabbageTxBody
-      <$> (o .: "inputs")
-      <*> (o .:? "collateral" .!= mempty)
-      <*> (o .:? "referenceInputs" .!= mempty)
-      <*> (o .: "outputs")
-      <*> (o .:? "collateralReturn" .!= SNothing)
-      <*> (o .:? "totalCollateral" .!= SNothing)
-      <*> (o .:? "certificates" .!= mempty)
-      <*> (o .:? "withdrawals" .!= Ledger.Withdrawals mempty)
-      <*> (o .:? "fees" .!= mempty)
-      <*> (o .:? "validity" .!= Ledger.ValidityInterval SNothing SNothing)
-      <*> pure SNothing -- TODO: Protocol Updates? Likely irrelevant to the L2.
-      <*> (o .:? "requiredSignatures" .!= mempty)
-      <*> (valueToMultiAsset <$> o .:? "mint" .!= mempty)
-      <*> (o .:? "scriptIntegrityHash" .!= SNothing)
-      <*> (o .:? "auxiliaryDataHash" .!= SNothing)
-      <*> (o .:? "networkId" .!= SNothing)
-   where
-    valueToMultiAsset (Ledger.MaryValue _ multiAsset) = multiAsset
-
 --
 -- TxDats
 --
@@ -405,23 +328,13 @@ instance
 --
 
 instance
-  ( ToJSON (Ledger.TxBody era)
-  , ToJSON (Ledger.TxAuxData era)
-  , ToJSON (Ledger.TxWits era)
+  ( ToCBOR (Ledger.AlonzoTx era)
   , Ledger.EraTxBody era
   , Ledger.Era era
   ) =>
   ToJSON (Ledger.AlonzoTx era)
   where
-  toJSON (Ledger.AlonzoTx body witnesses isValid auxiliaryData) =
-    object $
-      mconcat
-        [ ["id" .= txid body]
-        , ["body" .= body]
-        , ["witnesses" .= witnesses]
-        , ["isValid" .= isValid]
-        , onlyIf isSJust "auxiliaryData" auxiliaryData
-        ]
+  toJSON = Aeson.String . decodeUtf8 @Text . Base16.encode . CBOR.serialize'
 
 instance
   ( FromJSON (Ledger.TxBody era)
@@ -444,9 +357,6 @@ instance
       -- (2) As base16 string representing a CBOR-serialized transaction, since
       -- this is the most common medium of exchange used for transactions.
       <|> parseHexEncodedCborAnnotated @era "Tx" value
-      -- (3) As high-level JSON object, which full format is specified via a
-      -- JSON-schema.
-      <|> parseAsAdHocJSONObject value
    where
     parseAsEnvelopedBase16CBOR =
       withObject "Tx" $ \o -> do
@@ -455,14 +365,6 @@ instance
         guard . (== envelopeType) =<< (o .: "type")
         parseHexEncodedCborAnnotated @era "Tx" (String str)
 
-    parseAsAdHocJSONObject =
-      withObject "Tx" $ \o -> do
-        Ledger.AlonzoTx
-          <$> (o .: "body")
-          <*> (o .: "witnesses")
-          <*> (o .:? "isValid" .!= Ledger.IsValid True)
-          <*> (o .:? "auxiliaryData" .!= SNothing)
-
 --
 -- ValidityInterval
 --

hydra-node/test/Hydra/API/HTTPServerSpec.hs

@@ -69,12 +69,6 @@ spec = do
            in case fromJSON @(SubmitTxRequest Tx) json of
                 Success{} -> property True
                 Error e -> counterexample (toString $ toText e) $ property False
-      prop "accepts json encoded transaction" $
-        forAll (arbitrary @Tx) $ \tx ->
-          let json = toJSON (toLedgerTx tx)
-           in case fromJSON @(SubmitTxRequest Tx) json of
-                Success{} -> property True
-                Error e -> counterexample (toString $ toText e) $ property False
       prop "accepts transaction encoded as TextEnvelope" $
         forAll (arbitrary @Tx) $ \tx ->
           let json = toJSON $ serialiseToTextEnvelope Nothing tx