diff --git a/cardano-api/internal/Cardano/Api/Eras/Constraints.hs b/cardano-api/internal/Cardano/Api/Eras/Constraints.hs index 910908a891..581d495a95 100644 --- a/cardano-api/internal/Cardano/Api/Eras/Constraints.hs +++ b/cardano-api/internal/Cardano/Api/Eras/Constraints.hs @@ -21,7 +21,6 @@ import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes import Cardano.Api.Orphans () -import Cardano.Api.Query.Types import qualified Cardano.Crypto.Hash.Blake2b as Blake2b import qualified Cardano.Crypto.Hash.Class as C @@ -72,11 +71,9 @@ type ShelleyBasedEraConstraints era = , L.ShelleyEraTxBody (ShelleyLedgerEra era) , L.ShelleyEraTxCert (ShelleyLedgerEra era) , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) - , FromCBOR (DebugLedgerState era) , IsCardanoEra era , IsShelleyBasedEra era , ToJSON (Consensus.ChainDepState (ConsensusProtocol era)) - , ToJSON (DebugLedgerState era) , Typeable era ) diff --git a/cardano-api/internal/Cardano/Api/Query/Types.hs b/cardano-api/internal/Cardano/Api/Query/Types.hs index fe385b68dc..10e8a30d77 100644 --- a/cardano-api/internal/Cardano/Api/Query/Types.hs +++ b/cardano-api/internal/Cardano/Api/Query/Types.hs @@ -1,13 +1,6 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeApplications #-} module Cardano.Api.Query.Types ( DebugLedgerState(..) @@ -15,49 +8,41 @@ module Cardano.Api.Query.Types ) where import Cardano.Api.Eon.ShelleyBasedEra +import Cardano.Api.Eras.Constraints +import Cardano.Api.Orphans () import Cardano.Binary -import Cardano.Ledger.Binary import qualified Cardano.Ledger.Binary.Plain as Plain import qualified Cardano.Ledger.Shelley.API as Shelley -import qualified Cardano.Ledger.Shelley.Core as Core -import qualified Cardano.Ledger.Shelley.LedgerState as Shelley -import qualified Ouroboros.Consensus.Cardano.Block as Consensus import Data.Aeson (ToJSON (..), object, (.=)) import qualified Data.Aeson as Aeson -import Data.Typeable -data DebugLedgerState era where - DebugLedgerState :: - ( ShelleyLedgerEra era ~ ledgerera - ) - => Shelley.NewEpochState ledgerera - -> DebugLedgerState era - -instance - ( Typeable era - , Core.EraTxOut (ShelleyLedgerEra era) - , Core.EraGov (ShelleyLedgerEra era) - , DecCBOR (Shelley.StashedAVVMAddresses (ShelleyLedgerEra era)) - ) => FromCBOR (DebugLedgerState era) where - fromCBOR = DebugLedgerState <$> - (fromCBOR :: Plain.Decoder s (Shelley.NewEpochState (ShelleyLedgerEra era))) - --- TODO: Shelley based era class! -instance ( IsShelleyBasedEra era - , ShelleyLedgerEra era ~ ledgerera - , Consensus.ShelleyBasedEra ledgerera - ) => ToJSON (DebugLedgerState era) where - toJSON = object . toDebugLedgerStatePair - toEncoding = Aeson.pairs . mconcat . toDebugLedgerStatePair - -toDebugLedgerStatePair :: - ( ShelleyLedgerEra era ~ ledgerera - , Consensus.ShelleyBasedEra ledgerera - , Aeson.KeyValue a - ) => DebugLedgerState era -> [a] -toDebugLedgerStatePair (DebugLedgerState newEpochS) = +newtype DebugLedgerState era = DebugLedgerState + { unDebugLedgerState :: Shelley.NewEpochState (ShelleyLedgerEra era) + } + +instance IsShelleyBasedEra era => FromCBOR (DebugLedgerState era) where + fromCBOR = + shelleyBasedEraConstraints (shelleyBasedEra @era) $ + DebugLedgerState <$> + (fromCBOR :: Plain.Decoder s (Shelley.NewEpochState (ShelleyLedgerEra era))) + +instance IsShelleyBasedEra era => ToJSON (DebugLedgerState era) where + toJSON = + let sbe = shelleyBasedEra @era in + shelleyBasedEraConstraints sbe $ object . toDebugLedgerStatePair sbe + toEncoding = + let sbe = shelleyBasedEra @era in + shelleyBasedEraConstraints sbe $ Aeson.pairs . mconcat . toDebugLedgerStatePair sbe + +toDebugLedgerStatePair :: () + => Aeson.KeyValue a + => ShelleyBasedEra era + -> DebugLedgerState era + -> [a] +toDebugLedgerStatePair sbe (DebugLedgerState newEpochS) = + shelleyBasedEraConstraints sbe $ let !nesEL = Shelley.nesEL newEpochS !nesBprev = Shelley.nesBprev newEpochS !nesBcur = Shelley.nesBcur newEpochS