Skip to content

Commit d5acb59

Browse files
jasagredoamesgen
jasagredo
authored and
amesgen
committed
Expose querySupportedVersions and classify queries in blockQueryIsSupportedOnVersion 
1 parent 99e49de commit d5acb59

13 files changed

Lines changed: 264 additions & 145 deletions

File tree

‎ouroboros-consensus-cardano/changelog.d/js-query-version.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
### Breaking
2+
3+
- Define `blockQueryIsSupportedOnVersion` for Byron and Shelley.
4+
- For Shelley, this is just a relocation of the now gone `querySupportedVersion` function.

‎ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -200,6 +200,7 @@ data instance BlockQuery ByronBlock :: Type -> Type where
200200
instance BlockSupportsLedgerQuery ByronBlock where
201201
answerBlockQuery _cfg GetUpdateInterfaceState (ExtLedgerState ledgerState _) =
202202
CC.cvsUpdateState (byronLedgerState ledgerState)
203+
blockQueryIsSupportedOnVersion GetUpdateInterfaceState = const True
203204

204205
instance SameDepIndex (BlockQuery ByronBlock) where
205206
sameDepIndex GetUpdateInterfaceState GetUpdateInterfaceState = Just Refl

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs‎

Lines changed: 47 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@ module Ouroboros.Consensus.Shelley.Ledger.Query (
2323
, NonMyopicMemberRewards (..)
2424
, StakeSnapshot (..)
2525
, StakeSnapshots (..)
26-
, querySupportedVersion
2726
-- * Serialisation
2827
, decodeShelleyQuery
2928
, decodeShelleyResult
@@ -509,6 +508,53 @@ instance
509508
hst = headerState ext
510509
st = shelleyLedgerState lst
511510

511+
-- | Is the given query supported by the given 'ShelleyNodeToClientVersion'?
512+
blockQueryIsSupportedOnVersion = \case
513+
GetLedgerTip -> const True
514+
GetEpochNo -> const True
515+
GetNonMyopicMemberRewards {} -> const True
516+
GetCurrentPParams -> const True
517+
GetProposedPParamsUpdates -> (< v12)
518+
GetStakeDistribution -> const True
519+
GetUTxOByAddress {} -> const True
520+
GetUTxOWhole -> const True
521+
DebugEpochState -> const True
522+
GetCBOR q -> blockQueryIsSupportedOnVersion q
523+
GetFilteredDelegationsAndRewardAccounts {} -> const True
524+
GetGenesisConfig -> const True
525+
DebugNewEpochState -> const True
526+
DebugChainDepState -> const True
527+
GetRewardProvenance -> const True
528+
GetUTxOByTxIn {} -> const True
529+
GetStakePools -> const True
530+
GetStakePoolParams {} -> const True
531+
GetRewardInfoPools -> const True
532+
GetPoolState {} -> const True
533+
GetStakeSnapshots {} -> const True
534+
GetPoolDistr {} -> const True
535+
GetStakeDelegDeposits {} -> const True
536+
GetConstitution -> (>= v8)
537+
GetGovState -> (>= v8)
538+
GetDRepState {} -> (>= v8)
539+
GetDRepStakeDistr {} -> (>= v8)
540+
GetCommitteeMembersState {} -> (>= v8)
541+
GetFilteredVoteDelegatees {} -> (>= v8)
542+
GetAccountState {} -> (>= v8)
543+
GetSPOStakeDistr {} -> (>= v8)
544+
GetProposals {} -> (>= v9)
545+
GetRatifyState {} -> (>= v9)
546+
GetFuturePParams {} -> (>= v10)
547+
GetBigLedgerPeerSnapshot -> (>= v11)
548+
QueryStakePoolDefaultVote {} -> (>= v12)
549+
-- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@
550+
-- must be added. See #2830 for a template on how to do this.
551+
where
552+
v8 = ShelleyNodeToClientVersion8
553+
v9 = ShelleyNodeToClientVersion9
554+
v10 = ShelleyNodeToClientVersion10
555+
v11 = ShelleyNodeToClientVersion11
556+
v12 = ShelleyNodeToClientVersion12
557+
512558
instance SameDepIndex (BlockQuery (ShelleyBlock proto era)) where
513559
sameDepIndex GetLedgerTip GetLedgerTip
514560
= Just Refl
@@ -703,54 +749,6 @@ instance ShelleyCompatible proto era => ShowQuery (BlockQuery (ShelleyBlock prot
703749
GetBigLedgerPeerSnapshot -> show
704750
QueryStakePoolDefaultVote {} -> show
705751

706-
-- | Is the given query supported by the given 'ShelleyNodeToClientVersion'?
707-
querySupportedVersion :: BlockQuery (ShelleyBlock proto era) result -> ShelleyNodeToClientVersion -> Bool
708-
querySupportedVersion = \case
709-
GetLedgerTip -> const True
710-
GetEpochNo -> const True
711-
GetNonMyopicMemberRewards {} -> const True
712-
GetCurrentPParams -> const True
713-
GetProposedPParamsUpdates -> (< v12)
714-
GetStakeDistribution -> const True
715-
GetUTxOByAddress {} -> const True
716-
GetUTxOWhole -> const True
717-
DebugEpochState -> const True
718-
GetCBOR q -> querySupportedVersion q
719-
GetFilteredDelegationsAndRewardAccounts {} -> const True
720-
GetGenesisConfig -> const True
721-
DebugNewEpochState -> const True
722-
DebugChainDepState -> const True
723-
GetRewardProvenance -> const True
724-
GetUTxOByTxIn {} -> const True
725-
GetStakePools -> const True
726-
GetStakePoolParams {} -> const True
727-
GetRewardInfoPools -> const True
728-
GetPoolState {} -> const True
729-
GetStakeSnapshots {} -> const True
730-
GetPoolDistr {} -> const True
731-
GetStakeDelegDeposits {} -> const True
732-
GetConstitution -> (>= v8)
733-
GetGovState -> (>= v8)
734-
GetDRepState {} -> (>= v8)
735-
GetDRepStakeDistr {} -> (>= v8)
736-
GetCommitteeMembersState {} -> (>= v8)
737-
GetFilteredVoteDelegatees {} -> (>= v8)
738-
GetAccountState {} -> (>= v8)
739-
GetSPOStakeDistr {} -> (>= v8)
740-
GetProposals {} -> (>= v9)
741-
GetRatifyState {} -> (>= v9)
742-
GetFuturePParams {} -> (>= v10)
743-
GetBigLedgerPeerSnapshot -> (>= v11)
744-
QueryStakePoolDefaultVote {} -> (>= v12)
745-
-- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@
746-
-- must be added. See #2830 for a template on how to do this.
747-
where
748-
v8 = ShelleyNodeToClientVersion8
749-
v9 = ShelleyNodeToClientVersion9
750-
v10 = ShelleyNodeToClientVersion10
751-
v11 = ShelleyNodeToClientVersion11
752-
v12 = ShelleyNodeToClientVersion12
753-
754752
{-------------------------------------------------------------------------------
755753
Auxiliary
756754
-------------------------------------------------------------------------------}

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Serialisation.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ import Ouroboros.Consensus.HardFork.Combinator.PartialConfig
3232
import Ouroboros.Consensus.HardFork.History.EpochInfo
3333
import Ouroboros.Consensus.HardFork.Simple
3434
import Ouroboros.Consensus.HeaderValidation
35+
import Ouroboros.Consensus.Ledger.Query
3536
import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId)
3637
import Ouroboros.Consensus.Node.Run
3738
import Ouroboros.Consensus.Node.Serialisation
@@ -294,7 +295,7 @@ instance ShelleyBasedEra era => SerialiseNodeToClient (ShelleyBlock proto era) (
294295
instance ShelleyCompatible proto era
295296
=> SerialiseNodeToClient (ShelleyBlock proto era) (SomeSecond BlockQuery (ShelleyBlock proto era)) where
296297
encodeNodeToClient _ version (SomeSecond q)
297-
| querySupportedVersion q version
298+
| blockQueryIsSupportedOnVersion q version
298299
= encodeShelleyQuery q
299300
| otherwise
300301
= throw $ ShelleyEncoderUnsupportedQuery (SomeSecond q) version

‎ouroboros-consensus-diffusion/changelog.d/js-query-version.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
<!-- empty, only two redundant constraints were removed -->

‎ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToClient.hs‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -180,7 +180,6 @@ type ClientCodecs blk m =
180180
defaultCodecs :: forall m blk.
181181
( MonadST m
182182
, SerialiseNodeToClientConstraints blk
183-
, ShowQuery (BlockQuery blk)
184183
, StandardHash blk
185184
, Serialise (HeaderHash blk)
186185
)
@@ -241,7 +240,6 @@ defaultCodecs ccfg version networkVersion = Codecs {
241240
clientCodecs :: forall m blk.
242241
( MonadST m
243242
, SerialiseNodeToClientConstraints blk
244-
, ShowQuery (BlockQuery blk)
245243
, StandardHash blk
246244
, Serialise (HeaderHash blk)
247245
)

‎ouroboros-consensus/changelog.d/js-query-version.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
### Breaking
2+
3+
- Add method `blockQueryIsSupportedOnVersion` to `BlockSupportsLedgerQuery`.
4+
- Export new function `querySupportedVersions`.

‎ouroboros-consensus/ouroboros-consensus.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -117,6 +117,7 @@ library
117117
Ouroboros.Consensus.HardFork.Combinator.Ledger.Query
118118
Ouroboros.Consensus.HardFork.Combinator.Lifting
119119
Ouroboros.Consensus.HardFork.Combinator.Mempool
120+
Ouroboros.Consensus.HardFork.Combinator.NetworkVersion
120121
Ouroboros.Consensus.HardFork.Combinator.Node
121122
Ouroboros.Consensus.HardFork.Combinator.Node.DiffusionPipelining
122123
Ouroboros.Consensus.HardFork.Combinator.Node.InitStorage

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Ledger/Query.hs‎

Lines changed: 20 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@
1919

2020
module Ouroboros.Consensus.HardFork.Combinator.Ledger.Query (
2121
BlockQuery (..)
22+
, HardForkNodeToClientVersion (..)
2223
, HardForkQueryResult
2324
, QueryAnytime (..)
2425
, QueryHardFork (..)
@@ -57,6 +58,7 @@ import Ouroboros.Consensus.HardFork.Combinator.Basics
5758
import Ouroboros.Consensus.HardFork.Combinator.Block
5859
import Ouroboros.Consensus.HardFork.Combinator.Info
5960
import Ouroboros.Consensus.HardFork.Combinator.Ledger ()
61+
import Ouroboros.Consensus.HardFork.Combinator.NetworkVersion
6062
import Ouroboros.Consensus.HardFork.Combinator.PartialConfig
6163
import Ouroboros.Consensus.HardFork.Combinator.State (Current (..),
6264
Past (..), Situated (..))
@@ -108,7 +110,9 @@ data instance BlockQuery (HardForkBlock xs) :: Type -> Type where
108110
=> QueryHardFork (x ': xs) result
109111
-> BlockQuery (HardForkBlock (x ': xs)) result
110112

111-
instance All SingleEraBlock xs => BlockSupportsLedgerQuery (HardForkBlock xs) where
113+
114+
115+
instance (All SingleEraBlock xs, All BlockSupportsLedgerQuery xs) => BlockSupportsLedgerQuery (HardForkBlock xs) where
112116
answerBlockQuery
113117
(ExtLedgerCfg cfg)
114118
query
@@ -135,6 +139,21 @@ instance All SingleEraBlock xs => BlockSupportsLedgerQuery (HardForkBlock xs) wh
135139
lcfg = configLedger cfg
136140
ei = State.epochInfoLedger lcfg hardForkState
137141

142+
blockQueryIsSupportedOnVersion q (HardForkNodeToClientDisabled x) = case q of
143+
QueryIfCurrent (QZ q') -> blockQueryIsSupportedOnVersion q' x
144+
QueryIfCurrent{} -> False
145+
QueryAnytime{} -> False
146+
QueryHardFork {} -> False
147+
blockQueryIsSupportedOnVersion q (HardForkNodeToClientEnabled _hfv npversions) = case q of
148+
QueryIfCurrent qc -> go qc npversions
149+
QueryAnytime{} -> True
150+
QueryHardFork{} -> True
151+
where
152+
go :: forall ys result. All BlockSupportsLedgerQuery ys => QueryIfCurrent ys result -> NP EraNodeToClientVersion ys -> Bool
153+
go (QZ _) (EraNodeToClientDisabled :* _) = False
154+
go (QZ x) (EraNodeToClientEnabled v :* _) = blockQueryIsSupportedOnVersion x v
155+
go (QS x) (_ :* n) = go x n
156+
138157
-- | Precondition: the 'ledgerState' and 'headerState' should be from the same
139158
-- era. In practice, this is _always_ the case, unless the 'ExtLedgerState' was
140159
-- manually crafted.

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/NetworkVersion.hs‎

Lines changed: 110 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,110 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE GADTs #-}
4+
{-# LANGUAGE StandaloneDeriving #-}
5+
{-# LANGUAGE TypeFamilies #-}
6+
{-# LANGUAGE TypeOperators #-}
7+
{-# LANGUAGE UndecidableInstances #-}
8+
9+
{-# OPTIONS_GHC -Wno-orphans #-}
10+
11+
-- | Defines the different NTC and NTN versions for the HardFork Combinator.
12+
13+
module Ouroboros.Consensus.HardFork.Combinator.NetworkVersion (
14+
EraNodeToClientVersion (..)
15+
, HardForkNodeToClientVersion (..)
16+
, HardForkNodeToNodeVersion (..)
17+
, HardForkSpecificNodeToClientVersion (..)
18+
, HardForkSpecificNodeToNodeVersion (..)
19+
, isHardForkNodeToClientEnabled
20+
, isHardForkNodeToNodeEnabled
21+
) where
22+
23+
import Data.SOP.Constraint
24+
import Data.SOP.Strict
25+
import Ouroboros.Consensus.HardFork.Combinator.Basics
26+
import Ouroboros.Consensus.Node.NetworkProtocolVersion
27+
import Ouroboros.Consensus.TypeFamilyWrappers
28+
29+
{-------------------------------------------------------------------------------
30+
Versioning
31+
-------------------------------------------------------------------------------}
32+
33+
-- | Versioning of the specific additions made by the HFC to the @NodeToNode@
34+
-- protocols, e.g., the era tag.
35+
data HardForkSpecificNodeToNodeVersion =
36+
HardForkSpecificNodeToNodeVersion1
37+
deriving (Eq, Ord, Show, Enum, Bounded)
38+
39+
-- | Versioning of the specific additions made by the HFC to the @NodeToClient@
40+
-- protocols, e.g., the era tag or the hard-fork specific queries.
41+
data HardForkSpecificNodeToClientVersion =
42+
-- | Include the Genesis window in 'EraParams'.
43+
HardForkSpecificNodeToClientVersion3
44+
deriving (Eq, Ord, Show, Enum, Bounded)
45+
46+
data HardForkNodeToNodeVersion xs where
47+
-- | Disable the HFC
48+
--
49+
-- This means that only the first era (@x@) is supported, and moreover, is
50+
-- compatible with serialisation used if the HFC would not be present at all.
51+
HardForkNodeToNodeDisabled ::
52+
BlockNodeToNodeVersion x
53+
-> HardForkNodeToNodeVersion (x ': xs)
54+
55+
-- | Enable the HFC
56+
--
57+
-- Serialised values will always include tags inserted by the HFC to
58+
-- distinguish one era from another. We version the hard-fork specific parts
59+
-- with 'HardForkSpecificNodeToNodeVersion'.
60+
HardForkNodeToNodeEnabled ::
61+
HardForkSpecificNodeToNodeVersion
62+
-> NP WrapNodeToNodeVersion xs
63+
-> HardForkNodeToNodeVersion xs
64+
65+
data HardForkNodeToClientVersion xs where
66+
-- | Disable the HFC
67+
--
68+
-- See 'HardForkNodeToNodeDisabled'
69+
HardForkNodeToClientDisabled ::
70+
BlockNodeToClientVersion x
71+
-> HardForkNodeToClientVersion (x ': xs)
72+
73+
-- | Enable the HFC
74+
--
75+
-- See 'HardForkNodeToNodeEnabled'
76+
HardForkNodeToClientEnabled ::
77+
HardForkSpecificNodeToClientVersion
78+
-> NP EraNodeToClientVersion xs
79+
-> HardForkNodeToClientVersion xs
80+
81+
data EraNodeToClientVersion blk =
82+
EraNodeToClientEnabled !(BlockNodeToClientVersion blk)
83+
| EraNodeToClientDisabled
84+
85+
deriving instance Show (BlockNodeToClientVersion blk) => Show (EraNodeToClientVersion blk)
86+
87+
deriving instance Eq (BlockNodeToClientVersion blk) => Eq (EraNodeToClientVersion blk)
88+
89+
deriving instance (All HasNetworkProtocolVersion xs, All (Compose Show WrapNodeToNodeVersion) xs) => Show (HardForkNodeToNodeVersion xs)
90+
deriving instance (All HasNetworkProtocolVersion xs, All (Compose Show EraNodeToClientVersion) xs) => Show (HardForkNodeToClientVersion xs)
91+
92+
deriving instance (All HasNetworkProtocolVersion xs, All (Compose Eq WrapNodeToNodeVersion) xs) => Eq (HardForkNodeToNodeVersion xs)
93+
deriving instance (All HasNetworkProtocolVersion xs, All (Compose Eq EraNodeToClientVersion) xs) => Eq (HardForkNodeToClientVersion xs)
94+
95+
instance ( All (Compose Show WrapNodeToNodeVersion) xs
96+
, All (Compose Eq WrapNodeToNodeVersion) xs
97+
, All (Compose Show EraNodeToClientVersion) xs
98+
, All (Compose Eq EraNodeToClientVersion) xs
99+
, All HasNetworkProtocolVersion xs)
100+
=> HasNetworkProtocolVersion (HardForkBlock xs) where
101+
type BlockNodeToNodeVersion (HardForkBlock xs) = HardForkNodeToNodeVersion xs
102+
type BlockNodeToClientVersion (HardForkBlock xs) = HardForkNodeToClientVersion xs
103+
104+
isHardForkNodeToNodeEnabled :: HardForkNodeToNodeVersion xs -> Bool
105+
isHardForkNodeToNodeEnabled HardForkNodeToNodeEnabled {} = True
106+
isHardForkNodeToNodeEnabled _ = False
107+
108+
isHardForkNodeToClientEnabled :: HardForkNodeToClientVersion xs -> Bool
109+
isHardForkNodeToClientEnabled HardForkNodeToClientEnabled {} = True
110+
isHardForkNodeToClientEnabled _ = False

0 commit comments

Comments
 (0)