From ff5ad513ba99e6e630b6af1d94ae7dc9243e180f Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 11 Apr 2024 13:00:30 +0200 Subject: [PATCH] Rename `QueryLedger` to `BlockSupportsLedgerQuery` --- .../Consensus/Byron/Ledger/Ledger.hs | 2 +- .../Consensus/Shelley/Ledger/Query.hs | 3 ++- .../Consensus/Network/NodeToClient.hs | 4 +-- .../Test/Consensus/HardFork/Combinator/A.hs | 2 +- .../Test/Consensus/HardFork/Combinator/B.hs | 2 +- .../Combinator/Abstract/SingleEraBlock.hs | 2 +- .../HardFork/Combinator/Ledger/Query.hs | 2 +- .../Ouroboros/Consensus/Ledger/Dual.hs | 2 +- .../Ouroboros/Consensus/Ledger/Query.hs | 27 +++++++++++++------ .../MiniProtocol/LocalStateQuery/Server.hs | 2 +- .../Ouroboros/Consensus/Node/Run.hs | 2 +- .../Test/Util/TestBlock.hs | 2 +- .../Ouroboros/Consensus/Mock/Ledger/Block.hs | 2 +- 13 files changed, 33 insertions(+), 21 deletions(-) diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs index 93e2922e7e..64fb697478 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs @@ -199,7 +199,7 @@ instance ApplyBlock (LedgerState ByronBlock) ByronBlock where data instance BlockQuery ByronBlock :: Type -> Type where GetUpdateInterfaceState :: BlockQuery ByronBlock UPI.State -instance QueryLedger ByronBlock where +instance BlockSupportsLedgerQuery ByronBlock where answerBlockQuery _cfg GetUpdateInterfaceState (ExtLedgerState ledgerState _) = CC.cvsUpdateState (byronLedgerState ledgerState) diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs index 7b5daad9f6..def3c190a1 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs @@ -300,7 +300,8 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where instance (Typeable era, Typeable proto) => ShowProxy (BlockQuery (ShelleyBlock proto era)) where -instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) => QueryLedger (ShelleyBlock proto era) where +instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) + => BlockSupportsLedgerQuery (ShelleyBlock proto era) where answerBlockQuery cfg query ext = case query of GetLedgerTip -> diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToClient.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToClient.hs index ebf4babd2e..5ccf59049a 100644 --- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToClient.hs +++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToClient.hs @@ -109,7 +109,7 @@ mkHandlers :: ( IOLike m , LedgerSupportsMempool blk , LedgerSupportsProtocol blk - , QueryLedger blk + , BlockSupportsLedgerQuery blk , ConfigSupportsNode blk ) => NodeKernelArgs m addrNTN addrNTC blk @@ -290,7 +290,7 @@ clientCodecs ccfg version networkVersion = Codecs { dec = decodeNodeToClient ccfg version -- | Identity codecs used in tests. -identityCodecs :: (Monad m, QueryLedger blk) +identityCodecs :: (Monad m, BlockSupportsLedgerQuery blk) => Codecs blk CodecFailure m (AnyMessage (ChainSync (Serialised blk) (Point blk) (Tip blk))) (AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))) diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs index f83229036a..e960a3b481 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs @@ -347,7 +347,7 @@ instance ShowQuery (BlockQuery BlockA) where data instance BlockQuery BlockA result deriving (Show) -instance QueryLedger BlockA where +instance BlockSupportsLedgerQuery BlockA where answerBlockQuery _ qry = case qry of {} instance SameDepIndex (BlockQuery BlockA) where diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs index a4ea68ed74..fccddbafb5 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs @@ -283,7 +283,7 @@ instance ShowQuery (BlockQuery BlockB) where data instance BlockQuery BlockB result deriving (Show) -instance QueryLedger BlockB where +instance BlockSupportsLedgerQuery BlockB where answerBlockQuery _ qry = case qry of {} instance SameDepIndex (BlockQuery BlockB) where diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs index c42840d463..800c0234fc 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs @@ -57,7 +57,7 @@ class ( LedgerSupportsProtocol blk , InspectLedger blk , LedgerSupportsMempool blk , ConvertRawTxId (GenTx blk) - , QueryLedger blk + , BlockSupportsLedgerQuery blk , HasPartialConsensusConfig (BlockProtocol blk) , HasPartialLedgerConfig blk , ConvertRawHash blk diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Ledger/Query.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Ledger/Query.hs index c5b4d9d02e..e64271d343 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Ledger/Query.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Ledger/Query.hs @@ -109,7 +109,7 @@ data instance BlockQuery (HardForkBlock xs) :: Type -> Type where => QueryHardFork (x ': xs) result -> BlockQuery (HardForkBlock (x ': xs)) result -instance All SingleEraBlock xs => QueryLedger (HardForkBlock xs) where +instance All SingleEraBlock xs => BlockSupportsLedgerQuery (HardForkBlock xs) where answerBlockQuery (ExtLedgerCfg cfg) query diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs index 9d1e4a7ef8..ffd59bbbcd 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs @@ -502,7 +502,7 @@ instance (Typeable m, Typeable a) => ShowProxy (BlockQuery (DualBlock m a)) where -- | Not used in the tests: no constructors -instance Bridge m a => QueryLedger (DualBlock m a) where +instance Bridge m a => BlockSupportsLedgerQuery (DualBlock m a) where answerBlockQuery _ = \case {} instance SameDepIndex (BlockQuery (DualBlock m a)) where diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query.hs index 3a2dba894e..fb75facca0 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query.hs @@ -11,9 +11,9 @@ {-# LANGUAGE UndecidableInstances #-} module Ouroboros.Consensus.Ledger.Query ( BlockQuery + , BlockSupportsLedgerQuery (..) , ConfigSupportsNode (..) , Query (..) - , QueryLedger (..) , QueryVersion (..) , ShowQuery (..) , answerQuery @@ -124,8 +124,10 @@ data QueryEncoderException blk = (SomeSecond Query blk) QueryVersion -deriving instance Show (SomeSecond BlockQuery blk) => Show (QueryEncoderException blk) -instance (Typeable blk, Show (SomeSecond BlockQuery blk)) => Exception (QueryEncoderException blk) +deriving instance Show (SomeSecond BlockQuery blk) + => Show (QueryEncoderException blk) +instance (Typeable blk, Show (SomeSecond BlockQuery blk)) + => Exception (QueryEncoderException blk) queryEncodeNodeToClient :: forall blk. @@ -202,7 +204,10 @@ queryDecodeNodeToClient codecConfig queryVersion blockVersion (1, 3) -> requireVersion QueryVersion2 $ SomeSecond GetChainPoint _ -> fail $ "Query: invalid size and tag" <> show (size, tag) - requireVersion :: QueryVersion -> SomeSecond Query blk -> Decoder s (SomeSecond Query blk) + requireVersion :: + QueryVersion + -> SomeSecond Query blk + -> Decoder s (SomeSecond Query blk) requireVersion expectedVersion someSecondQuery = if queryVersion >= expectedVersion then return someSecondQuery @@ -261,7 +266,7 @@ deriving instance Show (BlockQuery blk result) => Show (Query blk result) -- | Answer the given query about the extended ledger state. answerQuery :: - (QueryLedger blk, ConfigSupportsNode blk, HasAnnTip blk) + (BlockSupportsLedgerQuery blk, ConfigSupportsNode blk, HasAnnTip blk) => ExtLedgerCfg blk -> Query blk result -> ExtLedgerState blk @@ -279,12 +284,18 @@ data family BlockQuery blk :: Type -> Type -- -- Used by the LocalStateQuery protocol to allow clients to query the extended -- ledger state. -class (ShowQuery (BlockQuery blk), SameDepIndex (BlockQuery blk)) => QueryLedger blk where +class (ShowQuery (BlockQuery blk), SameDepIndex (BlockQuery blk)) + => BlockSupportsLedgerQuery blk where -- | Answer the given query about the extended ledger state. - answerBlockQuery :: ExtLedgerCfg blk -> BlockQuery blk result -> ExtLedgerState blk -> result + answerBlockQuery :: + ExtLedgerCfg blk + -> BlockQuery blk result + -> ExtLedgerState blk + -> result instance SameDepIndex (BlockQuery blk) => Eq (SomeSecond BlockQuery blk) where SomeSecond qry == SomeSecond qry' = isJust (sameDepIndex qry qry') -deriving instance (forall result. Show (BlockQuery blk result)) => Show (SomeSecond BlockQuery blk) +deriving instance (forall result. Show (BlockQuery blk result)) + => Show (SomeSecond BlockQuery blk) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalStateQuery/Server.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalStateQuery/Server.hs index c4ab3ce2d3..21fbbe6b31 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalStateQuery/Server.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalStateQuery/Server.hs @@ -13,7 +13,7 @@ import Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..), Target (..)) localStateQueryServer :: - forall m blk. (IOLike m, QueryLedger blk, ConfigSupportsNode blk, HasAnnTip blk) + forall m blk. (IOLike m, BlockSupportsLedgerQuery blk, ConfigSupportsNode blk, HasAnnTip blk) => ExtLedgerCfg blk -> STM m (Point blk) -- ^ Get tip point diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Run.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Run.hs index fb7505ee68..f5bb6f038e 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Run.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Run.hs @@ -80,7 +80,7 @@ class ( LedgerSupportsProtocol blk , HasHardForkHistory blk , LedgerSupportsMempool blk , HasTxId (GenTx blk) - , QueryLedger blk + , BlockSupportsLedgerQuery blk , SupportedNetworkProtocolVersion blk , ConfigSupportsNode blk , ConvertRawHash blk diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs index 4250c695a0..775ac72a02 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs @@ -647,7 +647,7 @@ instance HasHardForkHistory TestBlock where data instance BlockQuery TestBlock result where QueryLedgerTip :: BlockQuery TestBlock (Point TestBlock) -instance QueryLedger TestBlock where +instance BlockSupportsLedgerQuery TestBlock where answerBlockQuery _cfg QueryLedgerTip (ExtLedgerState TestLedger { lastAppliedPoint } _) = lastAppliedPoint diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs index b855a6bb14..a82a7f3361 100644 --- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs +++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs @@ -494,7 +494,7 @@ txSize = fromIntegral . Lazy.length . serialise data instance BlockQuery (SimpleBlock c ext) result where QueryLedgerTip :: BlockQuery (SimpleBlock c ext) (Point (SimpleBlock c ext)) -instance MockProtocolSpecific c ext => QueryLedger (SimpleBlock c ext) where +instance MockProtocolSpecific c ext => BlockSupportsLedgerQuery (SimpleBlock c ext) where answerBlockQuery _cfg QueryLedgerTip = castPoint . ledgerTipPoint