Define blockQueryIsSupportedOnVersion for test blocks

Author: jasagredo

ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Generators.hs

@@ -278,5 +278,5 @@ instance CanMock proto era
       => Arbitrary (WithVersion ShelleyNodeToClientVersion (SomeSecond BlockQuery (ShelleyBlock proto era))) where
   arbitrary = do
       query@(SomeSecond q) <- arbitrary
-      version <- arbitrary `suchThat` querySupportedVersion q
+      version <- arbitrary `suchThat` blockQueryIsSupportedOnVersion q
       return $ WithVersion version query

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs

@@ -358,6 +358,7 @@ data instance BlockQuery BlockA result
 
 instance BlockSupportsLedgerQuery BlockA where
   answerBlockQuery _ qry = case qry of {}
+  blockQueryIsSupportedOnVersion qry _ = case qry of {}
 
 instance SameDepIndex (BlockQuery BlockA) where
   sameDepIndex qry _qry' = case qry of {}

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs

@@ -291,6 +291,7 @@ data instance BlockQuery BlockB result
 
 instance BlockSupportsLedgerQuery BlockB where
   answerBlockQuery _ qry = case qry of {}
+  blockQueryIsSupportedOnVersion qry _ = case qry of {}
 
 instance SameDepIndex (BlockQuery BlockB) where
   sameDepIndex qry _qry' = case qry of {}

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs

@@ -528,6 +528,7 @@ instance (Typeable m, Typeable a)
 -- | Not used in the tests: no constructors
 instance Bridge m a => BlockSupportsLedgerQuery (DualBlock m a) where
   answerBlockQuery _ = \case {}
+  blockQueryIsSupportedOnVersion qry _ = case qry of {}
 
 instance SameDepIndex (BlockQuery (DualBlock m a)) where
   sameDepIndex = \case {}

ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Roundtrip.hs

@@ -214,7 +214,6 @@ roundtrip_all
      , SerialiseNodeToClientConstraints blk
 
      , Show (BlockNodeToNodeVersion   blk)
-     , Show (BlockNodeToClientVersion blk)
 
      , StandardHash blk
      , GetHeader    blk
@@ -263,7 +262,6 @@ roundtrip_all_skipping
      , SerialiseNodeToClientConstraints blk
 
      , Show (BlockNodeToNodeVersion   blk)
-     , Show (BlockNodeToClientVersion blk)
 
      , StandardHash blk
      , GetHeader    blk
@@ -534,7 +532,6 @@ roundtrip_SerialiseNodeToNode ccfg =
 roundtrip_SerialiseNodeToClient
   :: forall blk.
      ( SerialiseNodeToClientConstraints blk
-     , Show (BlockNodeToClientVersion blk)
      , ArbitraryWithVersion (BlockNodeToClientVersion blk) blk
      , ArbitraryWithVersion (BlockNodeToClientVersion blk) (GenTx blk)
      , ArbitraryWithVersion (BlockNodeToClientVersion blk) (ApplyTxErr blk)

ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs

@@ -650,6 +650,7 @@ data instance BlockQuery TestBlock result where
 instance BlockSupportsLedgerQuery TestBlock where
   answerBlockQuery _cfg QueryLedgerTip (ExtLedgerState TestLedger { lastAppliedPoint } _) =
     lastAppliedPoint
+  blockQueryIsSupportedOnVersion QueryLedgerTip = const True
 
 instance SameDepIndex (BlockQuery TestBlock) where
   sameDepIndex QueryLedgerTip QueryLedgerTip = Just Refl

ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs

@@ -534,6 +534,7 @@ instance MockProtocolSpecific c ext => BlockSupportsLedgerQuery (SimpleBlock c e
         castPoint
       . ledgerTipPoint
       . ledgerState
+  blockQueryIsSupportedOnVersion QueryLedgerTip = const True
 
 instance SameDepIndex (BlockQuery (SimpleBlock c ext)) where
   sameDepIndex QueryLedgerTip QueryLedgerTip = Just Refl

ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node.hs

@@ -38,9 +38,6 @@ import           Ouroboros.Consensus.Util.RedundantConstraints
   RunNode instance for the mock ledger
 -------------------------------------------------------------------------------}
 
-instance HasNetworkProtocolVersion (SimpleBlock SimpleMockCrypto ext) where
-  -- Use defaults
-
 instance SupportedNetworkProtocolVersion (SimpleBlock SimpleMockCrypto ext) where
   supportedNodeToNodeVersions   _ = Map.singleton maxBound ()
   supportedNodeToClientVersions _ = Map.singleton maxBound ()

ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/Serialisation.hs

@@ -23,6 +23,7 @@ import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.SupportsMempool
 import           Ouroboros.Consensus.Mock.Ledger
 import           Ouroboros.Consensus.Mock.Node.Abstract
+import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.Run
 import           Ouroboros.Consensus.Node.Serialisation
 import           Ouroboros.Consensus.Storage.Serialisation
@@ -66,6 +67,9 @@ instance DecodeDisk (MockBlock ext) (AnnTip (MockBlock ext)) where
   possible.
 -------------------------------------------------------------------------------}
 
+instance HasNetworkProtocolVersion (MockBlock ext) where
+  -- Use defaults
+
 instance Serialise ext => SerialiseNodeToNodeConstraints (MockBlock ext) where
   estimateBlockSize hdr =
       7 {- CBOR-in-CBOR -} + 1 {- encodeListLen 2 -} + hdrSize + bodySize
@@ -95,7 +99,7 @@ instance SerialiseNodeToNode (MockBlock ext) (GenTxId (MockBlock ext))
   possible.
 -------------------------------------------------------------------------------}
 
-instance (Serialise ext, Typeable ext, Serialise (MockLedgerConfig SimpleMockCrypto ext))
+instance (Serialise ext, Typeable ext, Serialise (MockLedgerConfig SimpleMockCrypto ext), MockProtocolSpecific SimpleMockCrypto ext)
       => SerialiseNodeToClientConstraints (MockBlock ext)
 
 instance Serialise ext => SerialiseNodeToClient (MockBlock ext) (MockBlock ext) where