diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index ca7566d1a66..abe1ddc6658 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/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 diff --git a/hydra-node/src/Hydra/Ledger/Cardano.hs b/hydra-node/src/Hydra/Ledger/Cardano.hs index 361b20e73cc..236f971c06c 100644 --- a/hydra-node/src/Hydra/Ledger/Cardano.hs +++ b/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 diff --git a/hydra-node/src/Hydra/Ledger/Cardano/Json.hs b/hydra-node/src/Hydra/Ledger/Cardano/Json.hs index 9f7c712be5f..37f03c39c63 100644 --- a/hydra-node/src/Hydra/Ledger/Cardano/Json.hs +++ b/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 -- diff --git a/hydra-node/test/Hydra/API/HTTPServerSpec.hs b/hydra-node/test/Hydra/API/HTTPServerSpec.hs index 4f139fcd784..d4b4329114b 100644 --- a/hydra-node/test/Hydra/API/HTTPServerSpec.hs +++ b/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