WIP

Author: jasagredo

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

@@ -34,6 +34,7 @@ import           Ouroboros.Consensus.HardFork.History.EpochInfo
 import           Ouroboros.Consensus.HardFork.Simple
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Query
+import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId)
 import           Ouroboros.Consensus.Ledger.Tables (EmptyMK)
 import           Ouroboros.Consensus.Node.Run
@@ -294,7 +295,7 @@ instance ShelleyBasedEra era => SerialiseNodeToClient (ShelleyBlock proto era) (
   encodeNodeToClient _ _ = toEraCBOR @era
   decodeNodeToClient _ _ = fromEraCBOR @era
 
-instance ShelleyCompatible proto era
+instance (ShelleyCompatible proto era, LedgerSupportsProtocol (ShelleyBlock proto era))
       => SerialiseNodeToClient (ShelleyBlock proto era) (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))) where
   encodeNodeToClient _ version (SomeBlockQuery q)
     | blockQueryIsSupportedOnVersion q version

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}

ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Examples.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 #if __GLASGOW_HASKELL__ >= 908

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

@@ -204,7 +204,7 @@ instance (Arbitrary (InstantStake era), CanMock proto era)
     <*> arbitrary
     <*> pure (LedgerTables EmptyMK)
 
-instance CanMock proto era
+instance (Arbitrary (InstantStake era), CanMock proto era)
       => Arbitrary (LedgerState (ShelleyBlock proto era) ValuesMK) where
   arbitrary = ShelleyLedgerState
     <$> arbitrary

ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Translation.hs

@@ -67,7 +67,6 @@ import           Test.Consensus.Byron.Generators (genByronLedgerConfig,
                      genByronLedgerState)
 import           Test.Consensus.Cardano.MockCrypto (MockCryptoCompatByron)
 import           Test.Consensus.Shelley.Generators ()
-import           Test.Consensus.Shelley.MockCrypto
 import           Test.QuickCheck
 import           Test.Tasty
 import           Test.Tasty.QuickCheck
@@ -325,44 +324,41 @@ instance Arbitrary (TestSetup (ShelleyBlock Proto ShelleyEra)
                               (ShelleyBlock Proto AllegraEra)) where
   arbitrary = TestSetup (fixedShelleyLedgerConfig emptyFromByronTranslationContext)
                         (fixedShelleyLedgerConfig Genesis.NoGenesis)
-                        <$> genShelleyLedgerState
+                        <$> arbitrary
                         <*> (EpochNo <$> arbitrary)
 
 instance Arbitrary (TestSetup (ShelleyBlock Proto AllegraEra)
                               (ShelleyBlock Proto MaryEra)) where
   arbitrary = TestSetup (fixedShelleyLedgerConfig Genesis.NoGenesis)
                         (fixedShelleyLedgerConfig Genesis.NoGenesis)
-                        <$> genShelleyLedgerState
+                        <$> arbitrary
                         <*> (EpochNo <$> arbitrary)
 
 instance Arbitrary (TestSetup (ShelleyBlock Proto MaryEra)
                               (ShelleyBlock Proto AlonzoEra)) where
   arbitrary = TestSetup (fixedShelleyLedgerConfig Genesis.NoGenesis)
                         <$> (fixedShelleyLedgerConfig <$> arbitrary)
-                        <*> genShelleyLedgerState
+                        <*> arbitrary
                         <*> (EpochNo <$> arbitrary)
 
 instance Arbitrary (TestSetup (ShelleyBlock (TPraos Crypto) AlonzoEra)
                               (ShelleyBlock (Praos Crypto) BabbageEra)) where
   arbitrary = TestSetup <$> (fixedShelleyLedgerConfig <$> arbitrary)
                         <*> (pure $ fixedShelleyLedgerConfig Genesis.NoGenesis)
-                        <*> genShelleyLedgerState
+                        <*> arbitrary
                         <*> (EpochNo <$> arbitrary)
 
 instance Arbitrary (TestSetup (ShelleyBlock (Praos Crypto) BabbageEra)
                               (ShelleyBlock (Praos Crypto) ConwayEra)) where
   arbitrary = TestSetup <$> (pure $ fixedShelleyLedgerConfig Genesis.NoGenesis)
                         <*> (fixedShelleyLedgerConfig <$> arbitrary)
-                        <*> genShelleyLedgerState
+                        <*> arbitrary
                         <*> (EpochNo <$> arbitrary)
 
 {-------------------------------------------------------------------------------
     Generators
 -------------------------------------------------------------------------------}
 
-genShelleyLedgerState :: CanMock proto era => Gen (LedgerState (ShelleyBlock proto era) EmptyMK)
-genShelleyLedgerState = arbitrary
-
 -- | A fixed ledger config should be sufficient as the updating of the ledger
 -- tables on era transitions does not depend on the configurations of any of
 -- the ledgers involved.

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

@@ -179,7 +179,8 @@ type ClientCodecs blk  m =
 defaultCodecs :: forall m blk.
                  ( MonadST m
                  , SerialiseNodeToClientConstraints blk
-                 , forall fp. ShowQuery (BlockQuery blk fp)
+                 , BlockSupportsLedgerQuery blk
+                 , Show (BlockNodeToClientVersion blk)
                  , StandardHash blk
                  , Serialise (HeaderHash blk)
                  )
@@ -240,7 +241,8 @@ defaultCodecs ccfg version networkVersion = Codecs {
 clientCodecs :: forall m blk.
                 ( MonadST m
                 , SerialiseNodeToClientConstraints blk
-                , forall fp. ShowQuery (BlockQuery blk fp)
+                , BlockSupportsLedgerQuery blk
+                , Show (BlockNodeToClientVersion blk)
                 , StandardHash blk
                 , Serialise (HeaderHash blk)
                 )