Cleanup and documentation

jasagredo · jasagredo · commit 7bd4853400f6 · 2025-09-05T10:39:53.000+02:00
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs
@@ -1,8 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/API.hs
@@ -6,12 +6,8 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -814,6 +810,7 @@ data LedgerDbPrune
   Streaming
 -------------------------------------------------------------------------------}
 
+-- | A backend that supports streaming the ledger tables
 class StreamingBackend m backend l where
   data YieldArgs m backend l
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Args.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Args.hs
@@ -1,19 +1,9 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
 {-# LANGUAGE NumericUnderscores #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 -- | Arguments for LedgerDB initialization.
 module Ouroboros.Consensus.Storage.LedgerDB.Args
@@ -99,11 +89,11 @@ data LedgerDbBackendArgs m blk
   QueryBatchSize
 -------------------------------------------------------------------------------}
 
--- | The /maximum/ number of keys to read in a backing store range query.
+-- | The /maximum/ number of keys to read in a forker range query.
 --
 -- When performing a ledger state query that involves on-disk parts of the
 -- ledger state, we might have to read ranges of key-value pair data (e.g.,
--- UTxO) from disk using backing store range queries. Instead of reading all
+-- UTxO) from disk using forker range queries. Instead of reading all
 -- data in one go, we read it in batches. 'QueryBatchSize' determines the size
 -- of these batches.
 --
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/TraceEvent.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/TraceEvent.hs
@@ -1,9 +1,6 @@
-{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Ouroboros.Consensus.Storage.LedgerDB.TraceEvent
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1.hs
@@ -1,16 +1,13 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -375,7 +372,6 @@ mkInternals ::
   ( IOLike m
   , LedgerDbSerialiseConstraints blk
   , LedgerSupportsProtocol blk
-  , ApplyBlock (ExtLedgerState blk) blk
   ) =>
   LedgerDBHandle m (ExtLedgerState blk) blk ->
   SnapshotManagerV1 m blk ->
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Args.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Args.hs
@@ -1,13 +1,4 @@
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 module Ouroboros.Consensus.Storage.LedgerDB.V1.Args
   ( FlushFrequency (..)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore.hs
@@ -1,12 +1,6 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 -- | See "Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.API" for the
 -- documentation. This module just puts together the implementations for the
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/API.hs
@@ -2,13 +2,10 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 -- | The 'BackingStore' is the component of the LedgerDB V1 implementation that
 -- stores a key-value map with the 'LedgerTable's at a specific slot on the
@@ -263,7 +260,7 @@ data RangeQuery keys = RangeQuery
   -- the changelog, which is extremely unlikely due to the random access
   -- pattern of the UTxO set.
   }
-  deriving stock (Show, Eq)
+  deriving (Show, Eq)
 
 {-------------------------------------------------------------------------------
   Statistics
@@ -284,7 +281,7 @@ data Statistics = Statistics
   , numEntries :: !Int
   -- ^ The total number of key-value pair entries that are stored.
   }
-  deriving stock (Show, Eq)
+  deriving (Show, Eq)
 
 {-------------------------------------------------------------------------------
   Tracing
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/InMemory.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/InMemory.hs
@@ -5,8 +5,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2.hs
@@ -1,11 +1,8 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Backend.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Backend.hs
@@ -1,17 +1,21 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
+-- | Common interface for LedgerDB V2 backends
 module Ouroboros.Consensus.Storage.LedgerDB.V2.Backend
-  ( Backend (..)
+  ( -- * Backend API
+    Backend (..)
+
+    -- * Existentials
   , SomeBackendTrace (..)
   , SomeBackendArgs (..)
   , SomeResources (..)
+
+    -- * Tracing
   , LedgerDBV2Trace (..)
   ) where
 
@@ -27,27 +31,20 @@ import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq
 import System.FS.API
 
-data SomeBackendTrace where
-  SomeBackendTrace :: Trace m backend -> SomeBackendTrace
-
-data SomeBackendArgs m blk where
-  SomeBackendArgs :: Backend m backend blk => Args m backend -> SomeBackendArgs m blk
-
-data SomeResources m blk where
-  SomeResources :: Backend m backend blk => Resources m backend -> SomeResources m blk
-
-instance NoThunks (SomeResources m blk) where
-  wNoThunks ctxt (SomeResources res) = wNoThunks ctxt res
-  noThunks ctxt (SomeResources res) = noThunks ctxt res
-  showTypeOf _ = "SomeResources"
-
+-- | Operations needed to open and operate a LedgerDB V2
 class NoThunks (Resources m backend) => Backend m backend blk where
+  -- | The Arguments that will be used initially to create the 'Resources'.
   data Args m backend
 
+  -- | The Resources that will be stored in the LedgerDB environment and given
+  -- to the handle operations.
   data Resources m backend
 
+  -- | A trace dependent on the particular backend.
   data Trace m backend
 
+  -- | Transform 'Args' into 'Resources', with some context made up of
+  -- 'LedgerDbArgs'.
   mkResources ::
     Proxy blk ->
     Tracer m LedgerDBV2Trace ->
@@ -56,15 +53,19 @@ class NoThunks (Resources m backend) => Backend m backend blk where
     SomeHasFS m ->
     m (Resources m backend)
 
+  -- | Release the acquired resources.
   releaseResources :: Proxy blk -> Resources m backend -> m ()
 
+  -- | Create a new handle from the given values. This will only be called when
+  -- starting Consensus from Genesis.
   newHandleFromValues ::
     Tracer m LedgerDBV2Trace ->
     ResourceRegistry m ->
     Resources m backend ->
     ExtLedgerState blk ValuesMK ->
     m (LedgerTablesHandle m (ExtLedgerState blk))
 
+  -- | Create a new handle from a snapshot.
   newHandleFromSnapshot ::
     Tracer m LedgerDBV2Trace ->
     ResourceRegistry m ->
@@ -74,6 +75,7 @@ class NoThunks (Resources m backend) => Backend m backend blk where
     DiskSnapshot ->
     ExceptT (SnapshotFailure blk) m (LedgerSeq' m blk, RealPoint blk)
 
+  -- | Instantiate the 'SnapshotManager' for this backend.
   snapshotManager ::
     Proxy blk ->
     Resources m backend ->
@@ -82,6 +84,28 @@ class NoThunks (Resources m backend) => Backend m backend blk where
     SomeHasFS m ->
     SnapshotManager m m blk (StateRef m (ExtLedgerState blk))
 
+{-------------------------------------------------------------------------------
+  Existentials
+-------------------------------------------------------------------------------}
+
+data SomeBackendTrace where
+  SomeBackendTrace :: Trace m backend -> SomeBackendTrace
+
+data SomeBackendArgs m blk where
+  SomeBackendArgs :: Backend m backend blk => Args m backend -> SomeBackendArgs m blk
+
+data SomeResources m blk where
+  SomeResources :: Backend m backend blk => Resources m backend -> SomeResources m blk
+
+instance NoThunks (SomeResources m blk) where
+  wNoThunks ctxt (SomeResources res) = wNoThunks ctxt res
+  noThunks ctxt (SomeResources res) = noThunks ctxt res
+  showTypeOf _ = "SomeResources"
+
+{-------------------------------------------------------------------------------
+  Tracing
+-------------------------------------------------------------------------------}
+
 data LedgerDBV2Trace
   = -- | Created a new 'LedgerTablesHandle', potentially by duplicating an
     -- existing one.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs
@@ -8,13 +8,11 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
   ( Backend (..)
