From 8e48fea28c12f676177406cc80f9b03552d4fa80 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 18 Nov 2023 15:23:21 +1100 Subject: [PATCH 1/4] Simplify Show instance for TxValidationError --- cardano-api/internal/Cardano/Api/InMode.hs | 61 ++++++---------------- 1 file changed, 17 insertions(+), 44 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/InMode.hs b/cardano-api/internal/Cardano/Api/InMode.hs index 499cfe2213..1755ca44c1 100644 --- a/cardano-api/internal/Cardano/Api/InMode.hs +++ b/cardano-api/internal/Cardano/Api/InMode.hs @@ -219,59 +219,32 @@ toConsensusTxId (TxIdInMode ConwayEra txid) = -- transaction to a local node. The errors are specific to an era. -- data TxValidationError era where + ByronTxValidationError + :: Consensus.ApplyTxErr Consensus.ByronBlock + -> TxValidationError ByronEra - ByronTxValidationError - :: Consensus.ApplyTxErr Consensus.ByronBlock - -> TxValidationError ByronEra - - ShelleyTxValidationError - :: ShelleyBasedEra era - -> Consensus.ApplyTxErr (Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)) - -> TxValidationError era + ShelleyTxValidationError + :: ShelleyBasedEra era + -> Consensus.ApplyTxErr (Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)) + -> TxValidationError era -- The GADT in the ShelleyTxValidationError case requires a custom instance instance Show (TxValidationError era) where - showsPrec p (ByronTxValidationError err) = + showsPrec p = \case + ByronTxValidationError err -> showParen (p >= 11) ( showString "ByronTxValidationError " . showsPrec 11 err ) - showsPrec p (ShelleyTxValidationError ShelleyBasedEraShelley err) = - showParen (p >= 11) - ( showString "ShelleyTxValidationError ShelleyBasedEraShelley " - . showsPrec 11 err - ) - - showsPrec p (ShelleyTxValidationError ShelleyBasedEraAllegra err) = - showParen (p >= 11) - ( showString "ShelleyTxValidationError ShelleyBasedEraAllegra " - . showsPrec 11 err - ) - - showsPrec p (ShelleyTxValidationError ShelleyBasedEraMary err) = - showParen (p >= 11) - ( showString "ShelleyTxValidationError ShelleyBasedEraMary " - . showsPrec 11 err - ) - - showsPrec p (ShelleyTxValidationError ShelleyBasedEraAlonzo err) = - showParen (p >= 11) - ( showString "ShelleyTxValidationError ShelleyBasedEraAlonzo " - . showsPrec 11 err - ) - - showsPrec p (ShelleyTxValidationError ShelleyBasedEraBabbage err) = - showParen (p >= 11) - ( showString "ShelleyTxValidationError ShelleyBasedEraBabbage " - . showsPrec 11 err - ) - - showsPrec p (ShelleyTxValidationError ShelleyBasedEraConway err) = - showParen (p >= 11) - ( showString "ShelleyTxValidationError ShelleyBasedEraConway " - . showsPrec 11 err - ) + ShelleyTxValidationError sbe err -> + shelleyBasedEraConstraints sbe $ + showParen (p >= 11) + ( showString "ShelleyTxValidationError " + . showString (show sbe) + . showString " " + . showsPrec 11 err + ) -- | A 'TxValidationError' in one of the eras supported by a given protocol -- mode. From 033c0a7505f3b8171c7ed78529c3675c492a643b Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 18 Nov 2023 15:31:18 +1100 Subject: [PATCH 2/4] Add ByronEraOnly witness to ByronTxValidationError constructor --- cardano-api/internal/Cardano/Api/InMode.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/InMode.hs b/cardano-api/internal/Cardano/Api/InMode.hs index 1755ca44c1..2b9d02bb08 100644 --- a/cardano-api/internal/Cardano/Api/InMode.hs +++ b/cardano-api/internal/Cardano/Api/InMode.hs @@ -220,20 +220,22 @@ toConsensusTxId (TxIdInMode ConwayEra txid) = -- data TxValidationError era where ByronTxValidationError - :: Consensus.ApplyTxErr Consensus.ByronBlock - -> TxValidationError ByronEra + :: ByronEraOnly era + -> Consensus.ApplyTxErr Consensus.ByronBlock + -> TxValidationError era ShelleyTxValidationError :: ShelleyBasedEra era -> Consensus.ApplyTxErr (Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)) -> TxValidationError era --- The GADT in the ShelleyTxValidationError case requires a custom instance instance Show (TxValidationError era) where showsPrec p = \case - ByronTxValidationError err -> + ByronTxValidationError w err -> showParen (p >= 11) ( showString "ByronTxValidationError " + . showString (show w) + . showString " " . showsPrec 11 err ) @@ -269,7 +271,7 @@ fromConsensusApplyTxErr :: () -> TxValidationErrorInCardanoMode fromConsensusApplyTxErr = \case Consensus.ApplyTxErrByron err -> - TxValidationErrorInCardanoMode $ ByronTxValidationError err + TxValidationErrorInCardanoMode $ ByronTxValidationError ByronEraOnlyByron err Consensus.ApplyTxErrShelley err -> TxValidationErrorInCardanoMode $ ShelleyTxValidationError ShelleyBasedEraShelley err Consensus.ApplyTxErrAllegra err -> From 4de22b9cc1b48071381917e2fbd3b21a23d7fd9d Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 18 Nov 2023 17:04:24 +1100 Subject: [PATCH 3/4] ToJSON instance for TxValidationError --- cardano-api/cardano-api.cabal | 1 + .../Cardano/Api/Eon/ShelleyBasedEra.hs | 3 + cardano-api/internal/Cardano/Api/InMode.hs | 32 +++- cardano-api/internal/Cardano/Api/Orphans.hs | 148 +++++++++++++++++- cardano-api/internal/Cardano/Api/Pretty.hs | 10 +- .../internal/Cardano/Api/Via/ShowOf.hs | 23 +++ 6 files changed, 205 insertions(+), 12 deletions(-) create mode 100644 cardano-api/internal/Cardano/Api/Via/ShowOf.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index c2c77d1787..446fb12c67 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -131,6 +131,7 @@ library internal Cardano.Api.Utils Cardano.Api.Value Cardano.Api.ValueParser + Cardano.Api.Via.ShowOf -- TODO: Eliminate in the future when -- we create wrapper types for the ledger types -- in this module diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs index c2fb04c934..716e2f1423 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs @@ -47,6 +47,7 @@ import qualified Cardano.Ledger.BaseTypes as L import Cardano.Ledger.Binary (FromCBOR) import qualified Cardano.Ledger.Core as L import qualified Cardano.Ledger.SafeHash as L +import qualified Cardano.Ledger.Shelley.Rules as L import qualified Cardano.Ledger.UTxO as L import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus @@ -213,6 +214,8 @@ type ShelleyBasedEraConstraints era = , IsCardanoEra era , IsShelleyBasedEra era , ToJSON (Consensus.ChainDepState (ConsensusProtocol era)) + , ToJSON (L.PredicateFailure (L.EraRule "LEDGER" (ShelleyLedgerEra era))) + , ToJSON (L.PredicateFailure (L.EraRule "UTXOW" (ShelleyLedgerEra era))) , Typeable era ) diff --git a/cardano-api/internal/Cardano/Api/InMode.hs b/cardano-api/internal/Cardano/Api/InMode.hs index 2b9d02bb08..e4950c0409 100644 --- a/cardano-api/internal/Cardano/Api/InMode.hs +++ b/cardano-api/internal/Cardano/Api/InMode.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -30,6 +31,7 @@ import Cardano.Api.Eon.ByronEraOnly import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras import Cardano.Api.Modes +import Cardano.Api.Orphans () import Cardano.Api.Tx import Cardano.Api.TxBody @@ -43,8 +45,11 @@ import qualified Ouroboros.Consensus.Shelley.HFEras as Consensus import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus import qualified Ouroboros.Consensus.TypeFamilyWrappers as Consensus +import Data.Aeson (ToJSON (..), (.=)) +import qualified Data.Aeson as Aeson import Data.SOP.Strict (NS (S, Z)) - +import qualified Data.Text as Text +import GHC.Generics -- ---------------------------------------------------------------------------- -- Transactions in the context of a consensus mode @@ -229,6 +234,8 @@ data TxValidationError era where -> Consensus.ApplyTxErr (Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)) -> TxValidationError era +deriving instance Generic (TxValidationError era) + instance Show (TxValidationError era) where showsPrec p = \case ByronTxValidationError w err -> @@ -248,6 +255,29 @@ instance Show (TxValidationError era) where . showsPrec 11 err ) +instance ToJSON (TxValidationError era) where + toJSON = \case + ByronTxValidationError w err -> + byronEraOnlyConstraints w $ + Aeson.object + [ "kind" .= Aeson.String "ByronTxValidationError" + , "era" .= toJSON (Text.pack (show w)) + , "error" .= toJSON err + ] + ShelleyTxValidationError sbe err -> + shelleyBasedEraConstraints sbe $ + Aeson.object + [ "kind" .= Aeson.String "ShelleyTxValidationError" + , "era" .= toJSON (Text.pack (show sbe)) + , "error" .= appTxErrToJson sbe err + ] + +appTxErrToJson :: () + => ShelleyBasedEra era + -> Consensus.ApplyTxErr (Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)) + -> Aeson.Value +appTxErrToJson w e = shelleyBasedEraConstraints w $ toJSON e + -- | A 'TxValidationError' in one of the eras supported by a given protocol -- mode. -- diff --git a/cardano-api/internal/Cardano/Api/Orphans.hs b/cardano-api/internal/Cardano/Api/Orphans.hs index 176a02e5f7..98785b01f0 100644 --- a/cardano-api/internal/Cardano/Api/Orphans.hs +++ b/cardano-api/internal/Cardano/Api/Orphans.hs @@ -1,7 +1,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -11,23 +12,55 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-} module Cardano.Api.Orphans () where +import Cardano.Api.Via.ShowOf + import Cardano.Binary (DecoderError (..)) +import qualified Cardano.Chain.Byron.API as L +import qualified Cardano.Chain.Common as L +import qualified Cardano.Chain.Delegation.Validation.Scheduling as L.Scheduling +import qualified Cardano.Chain.Update as L +import qualified Cardano.Chain.Update.Validation.Endorsement as L.Endorsement +import qualified Cardano.Chain.Update.Validation.Interface as L.Interface +import qualified Cardano.Chain.Update.Validation.Registration as L.Registration +import qualified Cardano.Chain.Update.Validation.Voting as L.Voting +import qualified Cardano.Chain.UTxO.UTxO as L +import qualified Cardano.Chain.UTxO.Validation as L +import qualified Cardano.Ledger.Allegra.Rules as L import qualified Cardano.Ledger.Alonzo.PParams as Ledger +import qualified Cardano.Ledger.Alonzo.Rules as L +import qualified Cardano.Ledger.Alonzo.Tx as L +import qualified Cardano.Ledger.Api as L import qualified Cardano.Ledger.Babbage.PParams as Ledger +import qualified Cardano.Ledger.Babbage.Rules as L import Cardano.Ledger.BaseTypes (strictMaybeToMaybe) +import qualified Cardano.Ledger.BaseTypes as L import qualified Cardano.Ledger.BaseTypes as Ledger +import Cardano.Ledger.Binary +import qualified Cardano.Ledger.Binary.Plain as Plain +import qualified Cardano.Ledger.Coin as L import qualified Cardano.Ledger.Conway.PParams as Ledger +import qualified Cardano.Ledger.Conway.Rules as L +import qualified Cardano.Ledger.Conway.TxCert as L +import qualified Cardano.Ledger.Core as L import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Crypto as CC (Crypto) import qualified Cardano.Ledger.Crypto as Crypto +import qualified Cardano.Ledger.Crypto as L import Cardano.Ledger.HKD (NoUpdate (..)) +import qualified Cardano.Ledger.Keys as L.Keys +import qualified Cardano.Ledger.SafeHash as L +import qualified Cardano.Ledger.Shelley.API.Mempool as L import qualified Cardano.Ledger.Shelley.PParams as Ledger +import qualified Cardano.Ledger.Shelley.Rules as L +import qualified Cardano.Ledger.Shelley.TxBody as L +import qualified Cardano.Ledger.Shelley.TxCert as L import qualified Cardano.Protocol.TPraos.API as Ledger import Cardano.Protocol.TPraos.BHeader (HashHeader (..)) +import qualified Cardano.Protocol.TPraos.Rules.Prtcl as L import qualified Cardano.Protocol.TPraos.Rules.Prtcl as Ledger import qualified Cardano.Protocol.TPraos.Rules.Tickn as Ledger import Ouroboros.Consensus.Byron.Ledger.Block (ByronHash (..)) @@ -36,20 +69,129 @@ import Ouroboros.Consensus.Protocol.Praos (PraosState) import qualified Ouroboros.Consensus.Protocol.Praos as Consensus import Ouroboros.Consensus.Protocol.TPraos (TPraosState) import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus +import qualified Ouroboros.Consensus.Shelley.Eras as Consensus import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyHash (..)) import qualified Ouroboros.Consensus.Shelley.Ledger.Query as Consensus import Ouroboros.Network.Block (HeaderHash, Tip (..)) import qualified Codec.Binary.Bech32 as Bech32 import qualified Codec.CBOR.Read as CBOR -import Data.Aeson (KeyValue ((.=)), ToJSON (..), object, pairs, (.=)) +import Data.Aeson (KeyValue ((.=)), ToJSON (..), ToJSONKey (..), object, pairs) import qualified Data.Aeson as Aeson import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Short as SBS import Data.Data (Data) +import Data.Kind (Constraint, Type) import Data.Maybe.Strict (StrictMaybe (..)) import Data.Monoid import qualified Data.Text.Encoding as Text +import Data.Typeable (Typeable) +import GHC.Generics +import GHC.Stack (HasCallStack) +import GHC.TypeLits +import Lens.Micro + +deriving instance Generic (L.ApplyTxError era) +deriving instance Generic (L.Registration.TooLarge a) +deriving instance Generic L.ApplicationNameError +deriving instance Generic L.ApplyMempoolPayloadErr +deriving instance Generic L.Endorsement.Error +deriving instance Generic L.Interface.Error +deriving instance Generic L.LovelaceError +deriving instance Generic L.Registration.Adopted +deriving instance Generic L.Registration.Error +deriving instance Generic L.Scheduling.Error +deriving instance Generic L.SoftwareVersionError +deriving instance Generic L.SystemTagError +deriving instance Generic L.TxValidationError +deriving instance Generic L.UTxOError +deriving instance Generic L.UTxOValidationError +deriving instance Generic L.Voting.Error + +deriving anyclass instance ToJSON L.ApplicationNameError +deriving anyclass instance ToJSON L.ApplyMempoolPayloadErr +deriving anyclass instance ToJSON L.Endorsement.Error +deriving anyclass instance ToJSON L.Interface.Error +deriving anyclass instance ToJSON L.LovelaceError +deriving anyclass instance ToJSON L.Registration.Adopted +deriving anyclass instance ToJSON L.Registration.ApplicationVersion +deriving anyclass instance ToJSON L.Registration.Error +deriving anyclass instance ToJSON L.Scheduling.Error +deriving anyclass instance ToJSON L.SoftwareVersionError +deriving anyclass instance ToJSON L.SystemTagError +deriving anyclass instance ToJSON L.TxValidationError +deriving anyclass instance ToJSON L.UTxOError +deriving anyclass instance ToJSON L.UTxOValidationError +deriving anyclass instance ToJSON L.Voting.Error +deriving anyclass instance ToJSON L.VotingPeriod + +deriving anyclass instance ToJSON (L.GenesisDelegCert L.StandardCrypto) +deriving anyclass instance ToJSON (L.MIRCert L.StandardCrypto) +deriving anyclass instance ToJSON (L.MIRTarget L.StandardCrypto) +deriving anyclass instance ToJSON (L.PoolCert L.StandardCrypto) +deriving anyclass instance ToJSON (L.ShelleyDelegCert L.StandardCrypto) + +deriving anyclass instance + ( ToJSON (L.PredicateFailure (L.EraRule "UTXOW" ledgerera)) + , ToJSON (L.PredicateFailure (L.EraRule "DELEGS" ledgerera)) + ) => ToJSON (L.ShelleyLedgerPredFailure ledgerera) + +deriving anyclass instance + ( L.Crypto (L.EraCrypto ledgerera) + , ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) + ) => ToJSON (L.ShelleyUtxowPredFailure ledgerera) + +deriving anyclass instance + ( L.Crypto (L.EraCrypto ledgerera) + , ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) + ) => ToJSON (L.ShelleyPpupPredFailure ledgerera) + +deriving anyclass instance + ( L.Crypto (L.EraCrypto ledgerera) + , ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) + , ToJSON (L.ScriptPurpose ledgerera) + ) => ToJSON (L.AlonzoUtxowPredFailure ledgerera) + +deriving anyclass instance + ( L.Crypto (L.EraCrypto ledgerera) + , ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) + , ToJSON (L.TxCert ledgerera) + ) => ToJSON (L.BabbageUtxowPredFailure ledgerera) + +deriving anyclass instance + ( L.Crypto (L.EraCrypto ledgerera) + , ToJSON (L.GenesisDelegCert (Consensus.EraCrypto ledgerera)) + , ToJSON (L.MIRCert (Consensus.EraCrypto ledgerera)) + , ToJSON (L.PoolCert (Consensus.EraCrypto ledgerera)) + , ToJSON (L.ShelleyDelegCert (Consensus.EraCrypto ledgerera)) + ) => ToJSON (L.ShelleyTxCert ledgerera) + +deriving anyclass instance + ( L.Crypto (L.EraCrypto ledgerera) + , ToJSON (L.TxCert ledgerera) + ) => ToJSON (L.ScriptPurpose ledgerera) + +deriving anyclass instance + ( ToJSON (L.PredicateFailure (L.EraRule "LEDGER" ledgerera)) + ) => ToJSON (L.ApplyTxError ledgerera) + +deriving via ShowOf (L.ConwayTxCert c) instance Show (L.ConwayTxCert c) => ToJSON (L.ConwayTxCert c) +deriving via ShowOf (L.Keys.VKey L.Keys.Witness c) instance L.Crypto c => ToJSON (L.Keys.VKey L.Keys.Witness c) + +deriving via ShowOf (L.AllegraUtxoPredFailure ledgerera) instance Show (L.AllegraUtxoPredFailure ledgerera) => ToJSON (L.AllegraUtxoPredFailure ledgerera) +deriving via ShowOf (L.AlonzoUtxoPredFailure ledgerera) instance Show (L.AlonzoUtxoPredFailure ledgerera) => ToJSON (L.AlonzoUtxoPredFailure ledgerera) +deriving via ShowOf (L.BabbageUtxoPredFailure ledgerera) instance Show (L.BabbageUtxoPredFailure ledgerera) => ToJSON (L.BabbageUtxoPredFailure ledgerera) +deriving via ShowOf (L.ConwayLedgerPredFailure ledgerera) instance Show (L.ConwayLedgerPredFailure ledgerera) => ToJSON (L.ConwayLedgerPredFailure ledgerera) +deriving via ShowOf (L.ShelleyDelegsPredFailure ledgerera) instance Show (L.ShelleyDelegsPredFailure ledgerera) => ToJSON (L.ShelleyDelegsPredFailure ledgerera) +deriving via ShowOf (L.ShelleyUtxoPredFailure ledgerera) instance Show (L.ShelleyUtxoPredFailure ledgerera) => ToJSON (L.ShelleyUtxoPredFailure ledgerera) + +deriving instance ToJSON a => ToJSON (L.Registration.TooLarge a) + +deriving via ShowOf L.MIRPot instance ToJSON L.MIRPot +deriving via ShowOf L.KeyHash instance ToJSON L.KeyHash +deriving via ShowOf L.RdmrPtr instance ToJSON L.RdmrPtr + +deriving via ShowOf L.ApplicationName instance ToJSONKey L.ApplicationName deriving instance Data DecoderError deriving instance Data CBOR.DeserialiseFailure diff --git a/cardano-api/internal/Cardano/Api/Pretty.hs b/cardano-api/internal/Cardano/Api/Pretty.hs index 86d825452f..46e82ea503 100644 --- a/cardano-api/internal/Cardano/Api/Pretty.hs +++ b/cardano-api/internal/Cardano/Api/Pretty.hs @@ -19,6 +19,8 @@ module Cardano.Api.Pretty , white ) where +import Cardano.Api.Via.ShowOf + import qualified Data.Text as Text import qualified Data.Text.Lazy as TextLazy import Prettyprinter @@ -28,14 +30,6 @@ import Prettyprinter.Render.Terminal -- of colored output. This is a type alias for AnsiStyle. type Ann = AnsiStyle -newtype ShowOf a = ShowOf a - -instance Show a => Show (ShowOf a) where - show (ShowOf a) = show a - -instance Show a => Pretty (ShowOf a) where - pretty = viaShow - prettyToString :: Doc AnsiStyle -> String prettyToString = show diff --git a/cardano-api/internal/Cardano/Api/Via/ShowOf.hs b/cardano-api/internal/Cardano/Api/Via/ShowOf.hs new file mode 100644 index 0000000000..bca7b3e2fe --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Via/ShowOf.hs @@ -0,0 +1,23 @@ +module Cardano.Api.Via.ShowOf + ( ShowOf(..) + ) where + +import Data.Aeson +import qualified Data.Aeson.Key as Key +import Data.Aeson.Types +import qualified Data.Text as Text +import Prettyprinter + +newtype ShowOf a = ShowOf a + +instance Show a => Show (ShowOf a) where + show (ShowOf a) = show a + +instance Show a => Pretty (ShowOf a) where + pretty = viaShow + +instance Show a => ToJSON (ShowOf a) where + toJSON (ShowOf a) = String (Text.pack (show a)) + +instance Show a => ToJSONKey (ShowOf a) where + toJSONKey = toJSONKeyKey (Key.fromString . show) From d6d8fd248d3a331175a811bf370c50fe064c2b51 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sun, 19 Nov 2023 13:15:08 +1100 Subject: [PATCH 4/4] Remove ByronEraOnly witness to ByronTxValidationError constructor --- cardano-api/internal/Cardano/Api/InMode.hs | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/InMode.hs b/cardano-api/internal/Cardano/Api/InMode.hs index e4950c0409..c8a640cc84 100644 --- a/cardano-api/internal/Cardano/Api/InMode.hs +++ b/cardano-api/internal/Cardano/Api/InMode.hs @@ -225,8 +225,7 @@ toConsensusTxId (TxIdInMode ConwayEra txid) = -- data TxValidationError era where ByronTxValidationError - :: ByronEraOnly era - -> Consensus.ApplyTxErr Consensus.ByronBlock + :: Consensus.ApplyTxErr Consensus.ByronBlock -> TxValidationError era ShelleyTxValidationError @@ -238,11 +237,9 @@ deriving instance Generic (TxValidationError era) instance Show (TxValidationError era) where showsPrec p = \case - ByronTxValidationError w err -> + ByronTxValidationError err -> showParen (p >= 11) ( showString "ByronTxValidationError " - . showString (show w) - . showString " " . showsPrec 11 err ) @@ -257,11 +254,9 @@ instance Show (TxValidationError era) where instance ToJSON (TxValidationError era) where toJSON = \case - ByronTxValidationError w err -> - byronEraOnlyConstraints w $ + ByronTxValidationError err -> Aeson.object [ "kind" .= Aeson.String "ByronTxValidationError" - , "era" .= toJSON (Text.pack (show w)) , "error" .= toJSON err ] ShelleyTxValidationError sbe err -> @@ -301,7 +296,7 @@ fromConsensusApplyTxErr :: () -> TxValidationErrorInCardanoMode fromConsensusApplyTxErr = \case Consensus.ApplyTxErrByron err -> - TxValidationErrorInCardanoMode $ ByronTxValidationError ByronEraOnlyByron err + TxValidationErrorInCardanoMode $ ByronTxValidationError err Consensus.ApplyTxErrShelley err -> TxValidationErrorInCardanoMode $ ShelleyTxValidationError ShelleyBasedEraShelley err Consensus.ApplyTxErrAllegra err ->