Add serialising the PartialLedgerConfig to SerialiseNodeToClientConst…

…raints
IntersectMBO · May 13, 2021 · 7b478e0 · 7b478e0
1 parent 61b7429
commit 7b478e0
Show file tree

Hide file tree

Showing 8 changed files with 41 additions and 9 deletions.
diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node.hs
@@ -289,4 +289,4 @@ instance BlockSupportsMetrics ByronBlock where
 -- Note the use of the @SerialiseNodeToClientConstraints@ constraints even
 -- though there is no polymorphism. This is because the relevant instance is an
 -- orphan instance in the ouroboros-consensus-cardano package i.e. out of scope.
-instance RunNode ByronBlock
+instance SerialiseNodeToClientConstraints ByronBlock => RunNode ByronBlock
diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node/Serialisation.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node/Serialisation.hs
@@ -1,10 +1,12 @@
+{-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE UndecidableInstances  #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -37,6 +39,7 @@ import           Ouroboros.Consensus.Storage.Serialisation
 import           Ouroboros.Consensus.Byron.Ledger
 import           Ouroboros.Consensus.Byron.Ledger.Conversions
 import           Ouroboros.Consensus.Byron.Protocol
+import           Ouroboros.Consensus.HardFork.Combinator (PartialLedgerConfig)
 import qualified Cardano.Chain.Genesis as Genesis
 
 {-------------------------------------------------------------------------------
@@ -149,7 +152,8 @@ instance SerialiseNodeToNode ByronBlock (GenTxId ByronBlock) where
   SerialiseNodeToClient
 -------------------------------------------------------------------------------}
 
-instance SerialiseNodeToClientConstraints ByronBlock
+instance SerialiseNodeToClient ByronBlock (PartialLedgerConfig ByronBlock)
+  => SerialiseNodeToClientConstraints ByronBlock
 
 -- | CBOR-in-CBOR for the annotation. This also makes it compatible with the
 -- wrapped ('Serialised') variant.

diff --git a/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Node.hs b/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Node.hs
@@ -10,8 +10,8 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
-module Ouroboros.Consensus.Mock.Node (
-    CodecConfig (..)
+module Ouroboros.Consensus.Mock.Node
+  ( CodecConfig (..)
   , simpleBlockForging
   ) where
 
@@ -32,6 +32,9 @@ import           Ouroboros.Consensus.Node.Run
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Util.RedundantConstraints
 
+import           Ouroboros.Consensus.HardFork.Combinator
+                     (PartialLedgerConfig)
+import           Ouroboros.Consensus.Node.Serialisation (SerialiseNodeToClient)
 import           Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo)
 
 {-------------------------------------------------------------------------------
@@ -60,6 +63,8 @@ instance ( LedgerSupportsProtocol      (SimpleBlock SimpleMockCrypto ext)
          , Show (CannotForge           (SimpleBlock SimpleMockCrypto ext))
          , Show (ForgeStateInfo        (SimpleBlock SimpleMockCrypto ext))
          , Show (ForgeStateUpdateError (SimpleBlock SimpleMockCrypto ext))
+         , SerialiseNodeToClient       (SimpleBlock SimpleMockCrypto ext)
+                                       (PartialLedgerConfig (SimpleBlock SimpleMockCrypto ext))
          , Serialise ext
          , RunMockBlock SimpleMockCrypto ext
          ) => RunNode (SimpleBlock SimpleMockCrypto ext)

diff --git a/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Node/Serialisation.hs b/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Node/Serialisation.hs
@@ -30,6 +30,7 @@ import           Ouroboros.Consensus.Mock.Node.Abstract
 import           Ouroboros.Consensus.Node.Run
 import           Ouroboros.Consensus.Node.Serialisation
 
+import           Ouroboros.Consensus.HardFork.Combinator (PartialLedgerConfig)
 import           Ouroboros.Consensus.Storage.Serialisation
 
 -- | Local shorthand to make the instances more readable
@@ -99,7 +100,9 @@ instance SerialiseNodeToNode (MockBlock ext) (GenTxId (MockBlock ext))
   possible.
 -------------------------------------------------------------------------------}
 
-instance Serialise ext => SerialiseNodeToClientConstraints (MockBlock ext)
+instance ( SerialiseNodeToClient (MockBlock ext) (PartialLedgerConfig (MockBlock ext))
+         , Serialise ext
+         ) => SerialiseNodeToClientConstraints (MockBlock ext)
 
 instance Serialise ext => SerialiseNodeToClient (MockBlock ext) (MockBlock ext) where
   encodeNodeToClient _ _ = defaultEncodeCBORinCBOR

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node.hs
@@ -75,6 +75,8 @@ import qualified Shelley.Spec.Ledger.API as SL
 import qualified Shelley.Spec.Ledger.LedgerState as SL (stakeDistr)
 import qualified Shelley.Spec.Ledger.OCert as Absolute (KESPeriod (..))
 
+import           Ouroboros.Consensus.HardFork.Combinator (PartialLedgerConfig)
+import           Ouroboros.Consensus.Node.Serialisation (SerialiseNodeToClient)
 import           Ouroboros.Consensus.Shelley.Eras
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Ledger.Inspect ()
@@ -384,7 +386,11 @@ instance ShelleyBasedEra era => BlockSupportsMetrics (ShelleyBlock era) where
 -- here.
 --
 -- Can I make this non-orphaned or put this instance next to PartialLedgerConfig?
-instance ShelleyBasedEra era => RunNode (ShelleyBlock era)
+instance ( ShelleyBasedEra era
+         , SerialiseNodeToClient
+            (ShelleyBlock era)
+            (PartialLedgerConfig (ShelleyBlock era))
+         ) => RunNode (ShelleyBlock era)
 
 {-------------------------------------------------------------------------------
   Register genesis staking

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node/Serialisation.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node/Serialisation.hs
@@ -28,6 +28,7 @@ import           Ouroboros.Consensus.Storage.Serialisation
 
 import qualified Shelley.Spec.Ledger.API as SL
 
+import           Ouroboros.Consensus.HardFork.Combinator (PartialLedgerConfig)
 import           Ouroboros.Consensus.Shelley.Eras (EraCrypto)
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion ()
@@ -133,7 +134,10 @@ data ShelleyEncoderException era =
 instance Typeable era => Exception (ShelleyEncoderException era)
 
 -- TODO why do I need the SerialiseNodeToClient constraint?
-instance ShelleyBasedEra era => SerialiseNodeToClientConstraints (ShelleyBlock era)
+instance
+  ( ShelleyBasedEra era
+  , SerialiseNodeToClient (ShelleyBlock era) (PartialLedgerConfig (ShelleyBlock era))
+  ) => SerialiseNodeToClientConstraints (ShelleyBlock era)
 
 -- | CBOR-in-CBOR for the annotation. This also makes it compatible with the
 -- wrapped ('Serialised') variant.

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Basics.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Basics.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures             #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
@@ -15,8 +16,8 @@
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
 
-module Ouroboros.Consensus.HardFork.Combinator.Basics (
-    -- * Hard fork protocol, block, and ledger state
+module Ouroboros.Consensus.HardFork.Combinator.Basics
+  ( -- * Hard fork protocol, block, and ledger state
     HardForkBlock (..)
   , HardForkProtocol
   , LedgerState (..)
@@ -61,6 +62,8 @@ import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
 import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
 import           Ouroboros.Consensus.HardFork.Combinator.State.Instances ()
 import           Ouroboros.Consensus.HardFork.Combinator.State.Types
+import           Ouroboros.Consensus.Node.Serialisation
+                     (SerialiseNodeToClient (..))
 
 {-------------------------------------------------------------------------------
   Hard fork protocol, block, and ledger state
@@ -167,6 +170,10 @@ instance
         <$> fromCBOR @(History.Shape xs)
         <*> fromCBOR @(PerEraLedgerConfig xs)
 
+instance SerialiseNodeToClient (HardForkBlock xs) (HardForkLedgerConfig xs) where
+  encodeNodeToClient = undefined
+  decodeNodeToClient = undefined
+
 instance CanHardFork xs => NoThunks (HardForkLedgerConfig xs)
 type instance LedgerCfg (LedgerState (HardForkBlock xs)) = HardForkLedgerConfig xs
 

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run.hs
@@ -33,6 +33,8 @@ import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.Serialisation
 import           Ouroboros.Consensus.Util (ShowProxy)
 
+import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
+                     (PartialLedgerConfig)
 import           Ouroboros.Consensus.Storage.ChainDB
                      (ImmutableDbSerialiseConstraints,
                      LgrDbSerialiseConstraints, SerialiseDiskConstraints,
@@ -70,6 +72,7 @@ class ( ConvertRawHash blk
       , SerialiseNodeToClient blk (GenTx blk)
       , SerialiseNodeToClient blk (ApplyTxErr blk)
       , SerialiseNodeToClient blk (SomeSecond BlockQuery blk)
+      , SerialiseNodeToClient blk (PartialLedgerConfig blk)
       , SerialiseResult       blk (BlockQuery blk)
       ) => SerialiseNodeToClientConstraints blk