Reorganize LedgerDB constraints

Author: jasagredo

ouroboros-consensus-cardano/app/snapshot-converter.hs

@@ -166,8 +166,7 @@ checkSnapshotFileStructure m p (SomeHasFS fs) = case m of
 
 load ::
   forall blk.
-  ( LedgerDbSerialiseConstraints blk
-  , CanStowLedgerTables (LedgerState blk)
+  ( CanStowLedgerTables (LedgerState blk)
   , LedgerSupportsProtocol blk
   , LedgerSupportsLedgerDB blk
   ) =>
@@ -218,8 +217,7 @@ load config@Config{inpath = pathToDiskSnapshot -> Just (fs@(SomeHasFS hasFS), pa
 load _ _ _ _ = error "Malformed input path!"
 
 store ::
-  ( LedgerDbSerialiseConstraints blk
-  , CanStowLedgerTables (LedgerState blk)
+  ( CanStowLedgerTables (LedgerState blk)
   , LedgerSupportsProtocol blk
   , LedgerSupportsLedgerDB blk
   ) =>

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Serialisation/Common.hs

@@ -105,6 +105,7 @@ import Ouroboros.Consensus.Ledger.Query
 import Ouroboros.Consensus.Ledger.Tables
 import Ouroboros.Consensus.Node.NetworkProtocolVersion
 import Ouroboros.Consensus.Node.Run
+import Ouroboros.Consensus.Storage.LedgerDB
 import Ouroboros.Consensus.Storage.Serialisation
 import Ouroboros.Consensus.TypeFamilyWrappers
 import Ouroboros.Network.Block (Serialised)
@@ -200,7 +201,7 @@ class
   , -- LedgerTables on the HardForkBlock might not be compositionally
     -- defined, but we need to require this instances for any instantiation.
     HasLedgerTables (LedgerState (HardForkBlock xs))
-  , SerializeTablesWithHint (LedgerState (HardForkBlock xs))
+  , LedgerSupportsLedgerDB (HardForkBlock xs)
   ) =>
   SerialiseHFC xs
   where

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs

@@ -48,7 +48,6 @@ openDB ::
   , HasCallStack
   , HasHardForkHistory blk
   , LedgerSupportsLedgerDB blk
-  , LedgerDbSerialiseConstraints blk
   ) =>
   -- | Stateless initializaton arguments
   Complete LedgerDbArgs m blk ->

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/API.hs

@@ -117,7 +117,9 @@ module Ouroboros.Consensus.Storage.LedgerDB.API
   , LedgerDbSerialiseConstraints
   , LedgerSupportsInMemoryLedgerDB
   , LedgerSupportsLedgerDB
-  , LedgerSupportsOnDiskLedgerDB
+  , LedgerSupportsLMDBLedgerDB
+  , LedgerSupportsV1LedgerDB
+  , LedgerSupportsV2LedgerDB
   , ResolveBlock
   , currentPoint
 
@@ -722,7 +724,11 @@ data TraceReplayProgressEvent blk
   Updating ledger tables
 -------------------------------------------------------------------------------}
 
-type LedgerSupportsInMemoryLedgerDB blk = (CanUpgradeLedgerTables (LedgerState blk))
+type LedgerSupportsInMemoryLedgerDB l =
+  (CanUpgradeLedgerTables l, SerializeTablesWithHint l)
+
+type LedgerSupportsV1LedgerDB l =
+  (LedgerSupportsInMemoryLedgerDB l, LedgerSupportsLMDBLedgerDB l)
 
 -- | When pushing differences on InMemory Ledger DBs, we will sometimes need to
 -- update ledger tables to the latest era. For unary blocks this is a no-op, but
@@ -761,12 +767,18 @@ instance
   Supporting On-Disk backing stores
 -------------------------------------------------------------------------------}
 
-type LedgerSupportsOnDiskLedgerDB blk =
-  (IndexedMemPack (LedgerState blk EmptyMK) (TxOut (LedgerState blk)))
+type LedgerSupportsLMDBLedgerDB l =
+  (IndexedMemPack (l EmptyMK) (TxOut l), MemPackIdx l EmptyMK ~ l EmptyMK)
+
+type LedgerSupportsV2LedgerDB l =
+  (LedgerSupportsInMemoryLedgerDB l)
+
+type LedgerSupportsLedgerDB blk = LedgerSupportsLedgerDB' (LedgerState blk) blk
 
-type LedgerSupportsLedgerDB blk =
-  ( LedgerSupportsOnDiskLedgerDB blk
-  , LedgerSupportsInMemoryLedgerDB blk
+type LedgerSupportsLedgerDB' l blk =
+  ( LedgerSupportsLMDBLedgerDB l
+  , LedgerSupportsInMemoryLedgerDB l
+  , LedgerDbSerialiseConstraints blk
   )
 
 {-------------------------------------------------------------------------------

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1.hs

@@ -78,7 +78,6 @@ mkInitDb ::
   forall m blk.
   ( LedgerSupportsProtocol blk
   , IOLike m
-  , LedgerDbSerialiseConstraints blk
   , HasHardForkHistory blk
   , LedgerSupportsLedgerDB blk
   ) =>

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
 
 -- | See "Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.API" for the
 -- documentation. This module just puts together the implementations for the
@@ -62,9 +61,7 @@ restoreBackingStore ::
   ( IOLike m
   , HasLedgerTables l
   , HasCallStack
-  , CanUpgradeLedgerTables l
-  , MemPackIdx l EmptyMK ~ l EmptyMK
-  , SerializeTablesWithHint l
+  , LedgerSupportsV1LedgerDB l
   ) =>
   Tracer m FlavorImplSpecificTrace ->
   Complete BackingStoreArgs m ->
@@ -80,9 +77,7 @@ newBackingStore ::
   ( IOLike m
   , HasLedgerTables l
   , HasCallStack
-  , CanUpgradeLedgerTables l
-  , MemPackIdx l EmptyMK ~ l EmptyMK
-  , SerializeTablesWithHint l
+  , LedgerSupportsV1LedgerDB l
   ) =>
   Tracer m FlavorImplSpecificTrace ->
   Complete BackingStoreArgs m ->
@@ -98,9 +93,7 @@ newBackingStoreInitialiser ::
   ( IOLike m
   , HasLedgerTables l
   , HasCallStack
-  , CanUpgradeLedgerTables l
-  , MemPackIdx l EmptyMK ~ l EmptyMK
-  , SerializeTablesWithHint l
+  , LedgerSupportsV1LedgerDB l
   ) =>
   Tracer m FlavorImplSpecificTrace ->
   Complete BackingStoreArgs m ->

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs

@@ -283,9 +283,9 @@ snapshotToTablesPath = mkFsPath . (\x -> [x, "tables"]) . snapshotToDirName
 loadSnapshot ::
   forall m blk.
   ( IOLike m
-  , LedgerDbSerialiseConstraints blk
   , LedgerSupportsProtocol blk
-  , LedgerSupportsLedgerDB blk
+  , LedgerSupportsV1LedgerDB (LedgerState blk)
+  , LedgerDbSerialiseConstraints blk
   ) =>
   Tracer m V1.FlavorImplSpecificTrace ->
   Complete BackingStoreArgs m ->

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2.hs

@@ -73,7 +73,7 @@ mkInitDb ::
   , IOLike m
   , LedgerDbSerialiseConstraints blk
   , HasHardForkHistory blk
-  , LedgerSupportsInMemoryLedgerDB blk
+  , LedgerSupportsV2LedgerDB (LedgerState blk)
   ) =>
   Complete LedgerDbArgs m blk ->
   HandleEnv m ->

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs

@@ -245,7 +245,7 @@ loadSnapshot ::
   ( LedgerDbSerialiseConstraints blk
   , LedgerSupportsProtocol blk
   , IOLike m
-  , LedgerSupportsInMemoryLedgerDB blk
+  , LedgerSupportsInMemoryLedgerDB (LedgerState blk)
   ) =>
   Tracer m V2.FlavorImplSpecificTrace ->
   ResourceRegistry m ->