Implement backingstore-agnostic quickcheck-lockstep tests.

About the new modules:
* `Registry.hs` defines a small utility for handling a resource through
  handles. This simplifies the property tests we define in other
  modules.
* `Mock.hs` defines a mocked version of a `BackingStore` that
  generalises over the types keys, values and diffs we want to use.
* `LockStep.hs` instantiates the Lockstep framework.
* `BackingStore.hs` sets up and runs the Lockstep tests.

Other changes:
* Added a utility module that defines a simple `LedgerState` and
  corresponding `TableStuff` instance.

ouroboros-consensus-test/ouroboros-consensus-test.cabal

@@ -76,6 +76,7 @@ library
                        Test.Util.Stream
                        Test.Util.Tasty.Traceable
                        Test.Util.TestBlock
+                       Test.Util.TestLedgerState
                        Test.Util.TestEnv
                        Test.Util.Time
                        Test.Util.Tracer
@@ -241,6 +242,10 @@ test-suite test-storage
                        Test.Ouroboros.Storage.LedgerDB.DbChangelog
                        Test.Ouroboros.Storage.LedgerDB.DiskPolicy
                        Test.Ouroboros.Storage.LedgerDB.HD
+                       Test.Ouroboros.Storage.LedgerDB.HD.BackingStore
+                       Test.Ouroboros.Storage.LedgerDB.HD.BackingStore.Registry
+                       Test.Ouroboros.Storage.LedgerDB.HD.BackingStore.Lockstep
+                       Test.Ouroboros.Storage.LedgerDB.HD.BackingStore.Mock
                        Test.Ouroboros.Storage.LedgerDB.HD.DiffSeq
                        Test.Ouroboros.Storage.LedgerDB.HD.LMDB
                        Test.Ouroboros.Storage.LedgerDB.InMemory
@@ -255,23 +260,28 @@ test-suite test-storage
 
   build-depends:       base
                      , async
+                     , anti-diff
                      , bifunctors
                      , binary
                      , bytestring
                      , cardano-binary
                      , cardano-crypto-class
                      , cardano-slotting
                      , cborg
+                     , constraints
                      , containers
                      , contra-tracer
                      , directory
+                     , exceptions
                      , generics-sop
                      , hashable
                      , mtl
                      , nonempty-containers
                      , nothunks
                      , pretty-show
                      , QuickCheck
+                     , quickcheck-dynamic
+                     , quickcheck-lockstep >=0.2.0
                      , quickcheck-state-machine >=0.7.0
                      , random
                      , serialise

ouroboros-consensus-test/src/Test/Util/TestLedgerState.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns             #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TypeFamilies               #-}
+
+module Test.Util.TestLedgerState (
+    LedgerTables (..)
+  , SimpleLedgerState (..)
+  ) where
+
+import           GHC.Generics (Generic)
+import           NoThunks.Class (NoThunks)
+
+import           Cardano.Binary (FromCBOR (..), ToCBOR (..))
+
+import           Ouroboros.Consensus.Ledger.Basics
+
+{-------------------------------------------------------------------------------
+  Simple ledger state
+-------------------------------------------------------------------------------}
+
+newtype SimpleLedgerState k v (mk :: MapKind) = SimpleLedgerState {
+    lsSimple :: mk k v
+  }
+
+deriving instance (Eq (mk k v)) => Eq (SimpleLedgerState k v mk)
+deriving stock instance Show (mk k v) => Show (SimpleLedgerState k v mk)
+
+instance (ToCBOR k, FromCBOR k, ToCBOR v, FromCBOR v)
+      => SufficientSerializationForAnyBackingStore (SimpleLedgerState k v) where
+  codecLedgerTables = SimpleLedgerTables $ CodecMK toCBOR toCBOR fromCBOR fromCBOR
+
+{-------------------------------------------------------------------------------
+  Simple ledger tables
+-------------------------------------------------------------------------------}
+
+instance (Ord k, Eq v, Show k, Show v) => TableStuff (SimpleLedgerState k v) where
+  newtype LedgerTables (SimpleLedgerState k v) mk = SimpleLedgerTables {
+      ltSimple :: mk k v
+    } deriving Generic
+
+  projectLedgerTables SimpleLedgerState{lsSimple} =
+    SimpleLedgerTables lsSimple
+
+  withLedgerTables st SimpleLedgerTables{ltSimple} =
+    st { lsSimple = ltSimple }
+
+  pureLedgerTables f =
+    SimpleLedgerTables { ltSimple = f }
+
+  mapLedgerTables f SimpleLedgerTables{ltSimple} =
+    SimpleLedgerTables $ f ltSimple
+
+  traverseLedgerTables f SimpleLedgerTables{ltSimple} =
+    SimpleLedgerTables <$> f ltSimple
+
+  zipLedgerTables f l r =
+    SimpleLedgerTables (f (ltSimple l) (ltSimple r))
+
+  zipLedgerTablesA f l r =
+    SimpleLedgerTables <$> f (ltSimple l) (ltSimple r)
+
+  zipLedgerTables2 f l m r =
+    SimpleLedgerTables $ f (ltSimple l) (ltSimple m) (ltSimple r)
+
+  zipLedgerTables2A f l c r =
+    SimpleLedgerTables <$> f (ltSimple l) (ltSimple c) (ltSimple r)
+
+  foldLedgerTables f SimpleLedgerTables{ltSimple} =
+    f ltSimple
+
+  foldLedgerTables2 f l r =
+    f (ltSimple l) (ltSimple r)
+
+  namesLedgerTables =
+    SimpleLedgerTables { ltSimple = NameMK "ltSimple" }
+
+deriving stock instance (Eq (mk k v))
+               => Eq (LedgerTables (SimpleLedgerState k v) mk)
+
+deriving stock instance (Show (mk k v))
+               => Show (LedgerTables (SimpleLedgerState k v) mk)
+
+deriving newtype instance NoThunks (mk k v)
+               => NoThunks (LedgerTables (SimpleLedgerState k v) mk)
+
+instance (Show k, Show v) => ShowLedgerState (LedgerTables (SimpleLedgerState k v)) where
+  showsLedgerState _ = shows

ouroboros-consensus-test/test-storage/Test/Ouroboros/Storage/LedgerDB/HD.hs

@@ -1,11 +1,13 @@
 module Test.Ouroboros.Storage.LedgerDB.HD (tests) where
 
+import qualified Test.Ouroboros.Storage.LedgerDB.HD.BackingStore as BS
 import qualified Test.Ouroboros.Storage.LedgerDB.HD.DiffSeq as DiffSeq
 import qualified Test.Ouroboros.Storage.LedgerDB.HD.LMDB as LMDB
 import           Test.Tasty (TestTree, testGroup)
 
 tests :: TestTree
 tests = testGroup "HD" [
-      DiffSeq.tests
+      BS.tests
+    , DiffSeq.tests
     , LMDB.tests
     ]