Lift the 8-byte key restriction for the compact index

Now that `topBits64` is fully safe, remove the 8-byte key constraint when using
the compact index. Instead, the config option for the index type includes a hint
not to use the compact index if their keys are too small, because that will lead
to bad performance.

Author: jorisdral

bench/micro/Bench/Database/LSMTree/Internal/Index.hs

@@ -11,15 +11,13 @@ import           Criterion.Main (Benchmark, Benchmarkable, bench, bgroup, env,
 import           Data.List (foldl')
                  -- foldl' is included in the Prelude from base 4.20 onwards
 #endif
-import           Database.LSMTree.Extras.Generators (getKeyForIndexCompact,
-                     mkPages, toAppends)
+import           Database.LSMTree.Extras.Generators (mkPages, toAppends)
                      -- also for @Arbitrary@ instantiation of @SerialisedKey@
 import           Database.LSMTree.Extras.Index (Append, append)
 import           Database.LSMTree.Internal.Index (Index,
                      IndexType (Compact, Ordinary), newWithDefaults, search,
                      unsafeEnd)
-import           Database.LSMTree.Internal.Serialise
-                     (SerialisedKey (SerialisedKey))
+import           Database.LSMTree.Internal.Serialise (SerialisedKey)
 import           Test.QuickCheck (choose, vector)
 import           Test.QuickCheck.Gen (Gen (MkGen))
 import           Test.QuickCheck.Random (mkQCGen)
@@ -61,8 +59,7 @@ generated (MkGen exec) = exec (mkQCGen 411) 30
 keysForIndexCompact :: Int             -- ^ Number of keys
                     -> [SerialisedKey] -- ^ Constructed keys
 keysForIndexCompact = vector                                        >>>
-                      generated                                     >>>
-                      map (getKeyForIndexCompact >>> SerialisedKey)
+                      generated
 
 {-|
     Constructs append operations whose serialised keys conform to the key size

doc/format-run.md

@@ -198,8 +198,9 @@ big-endian.
 The compact index type is designed to work with keys that are large
 cryptographic hashes, e.g. 32 bytes. In particular it requires:
 
-* keys must be uniformly distributed
-* keys must be at least 8 bytes (64bits), but can otherwise be variable length
+* keys must be uniformly distributed;
+* keys can be of variable length;
+* keys less than 8 bytes (64bits) are padded with zeros (in LSB position).
 
 For this important special case, we can do significantly better than storing a
 whole key per page: we can typically store just 8 bytes (64bits) per page. This

src-extras/Database/LSMTree/Extras/Generators.hs

@@ -33,8 +33,6 @@ module Database.LSMTree.Extras.Generators (
   , genRawBytesSized
   , packRawBytesPinnedOrUnpinned
   , LargeRawBytes (..)
-  , isKeyForIndexCompact
-  , KeyForIndexCompact (..)
   , BiasedKey (..)
     -- * helpers
   , shrinkVec
@@ -510,28 +508,6 @@ instance Arbitrary LargeRawBytes where
 
 deriving newtype instance SerialiseValue LargeRawBytes
 
--- Serialised keys for the compact index must be at least 8 bytes long.
-
-genKeyForIndexCompact :: Gen RawBytes
-genKeyForIndexCompact =
-    genRawBytesN =<< QC.sized (\s -> QC.chooseInt (8, s + 8))
-
-isKeyForIndexCompact :: RawBytes -> Bool
-isKeyForIndexCompact rb = RB.size rb >= 8
-
-newtype KeyForIndexCompact =
-    KeyForIndexCompact { getKeyForIndexCompact :: RawBytes }
-  deriving stock (Eq, Ord, Show)
-
-instance Arbitrary KeyForIndexCompact where
-  arbitrary =
-      KeyForIndexCompact <$> genKeyForIndexCompact
-  shrink (KeyForIndexCompact rawBytes) =
-      [KeyForIndexCompact rawBytes' | rawBytes' <- shrink rawBytes,
-                                      isKeyForIndexCompact rawBytes']
-
-deriving newtype instance SerialiseKey KeyForIndexCompact
-
 -- we try to make collisions and close keys more likely (very crudely)
 arbitraryBiasedKey :: (RawBytes -> k) -> Gen RawBytes -> Gen k
 arbitraryBiasedKey fromRB genUnbiased = fromRB <$> frequency

src/Database/LSMTree.hs

@@ -149,7 +149,6 @@ module Database.LSMTree (
   serialiseKeyIdentity,
   serialiseKeyIdentityUpToSlicing,
   serialiseKeyPreservesOrdering,
-  serialiseKeyMinimalSize,
   serialiseValueIdentity,
   serialiseValueIdentityUpToSlicing,
   packSlice,
@@ -227,8 +226,7 @@ import           Database.LSMTree.Internal.Config
                      DiskCachePolicy (..), FencePointerIndexType (..),
                      LevelNo (..), MergeBatchSize (..), MergePolicy (..),
                      MergeSchedule (..), SizeRatio (..), TableConfig (..),
-                     WriteBufferAlloc (..), defaultTableConfig,
-                     serialiseKeyMinimalSize)
+                     WriteBufferAlloc (..), defaultTableConfig)
 import           Database.LSMTree.Internal.Config.Override
                      (TableConfigOverride (..), noTableConfigOverride)
 import           Database.LSMTree.Internal.Entry (NumEntries (..))

src/Database/LSMTree/Internal/Config.hs

@@ -20,7 +20,6 @@ module Database.LSMTree.Internal.Config (
     -- * Fence pointer index
   , FencePointerIndexType (..)
   , indexTypeForRun
-  , serialiseKeyMinimalSize
     -- * Disk cache policy
   , DiskCachePolicy (..)
   , diskCachePolicyForLevel
@@ -36,11 +35,9 @@ import           Database.LSMTree.Internal.Index (IndexType)
 import qualified Database.LSMTree.Internal.Index as Index
                      (IndexType (Compact, Ordinary))
 import qualified Database.LSMTree.Internal.MergingRun as MR
-import qualified Database.LSMTree.Internal.RawBytes as RB
 import           Database.LSMTree.Internal.Run (RunDataCaching (..))
 import           Database.LSMTree.Internal.RunAcc (RunBloomFilterAlloc (..))
 import           Database.LSMTree.Internal.RunBuilder (RunParams (..))
-import           Database.LSMTree.Internal.Serialise.Class (SerialiseKey (..))
 
 newtype LevelNo = LevelNo Int
   deriving stock (Show, Eq, Ord)
@@ -321,12 +318,11 @@ data FencePointerIndexType =
   | {- |
     Compact indexes are designed  for the case where the keys in the database are uniformly distributed, e.g., when the keys are hashes.
 
-    When using a compact index, the 'Database.LSMTree.Internal.Serialise.Class.serialiseKey' function must satisfy the following additional law:
+    When using a compact index, some requirements apply to serialised keys:
 
-    [Minimal size]
-      @'Database.LSMTree.Internal.RawBytes.size' ('Database.LSMTree.Internal.Serialise.Class.serialiseKey' x) >= 8@
-
-    Use 'serialiseKeyMinimalSize' to test this law.
+    * keys must be uniformly distributed;
+    * keys can be of variable length;
+    * keys less than 8 bytes (64bits) are padded with zeros (in LSB position).
     -}
     CompactIndex
   deriving stock (Eq, Show)
@@ -339,10 +335,6 @@ indexTypeForRun :: FencePointerIndexType -> IndexType
 indexTypeForRun CompactIndex  = Index.Compact
 indexTypeForRun OrdinaryIndex = Index.Ordinary
 
--- | Test the __Minimal size__ law for the 'CompactIndex' option.
-serialiseKeyMinimalSize :: SerialiseKey k => k -> Bool
-serialiseKeyMinimalSize x = RB.size (serialiseKey x) >= 8
-
 {-------------------------------------------------------------------------------
   Disk cache policy
 -------------------------------------------------------------------------------}

src/Database/LSMTree/Simple.hs

@@ -134,7 +134,6 @@ module Database.LSMTree.Simple (
     serialiseKeyIdentity,
     serialiseKeyIdentityUpToSlicing,
     serialiseKeyPreservesOrdering,
-    serialiseKeyMinimalSize,
     serialiseValueIdentity,
     serialiseValueIdentityUpToSlicing,
     packSlice,
@@ -182,9 +181,8 @@ import           Database.LSMTree (BloomFilterAlloc, CursorClosedError (..),
                      UnionCredits (..), UnionDebt (..), WriteBufferAlloc,
                      isValidSnapshotName, noTableConfigOverride, packSlice,
                      serialiseKeyIdentity, serialiseKeyIdentityUpToSlicing,
-                     serialiseKeyMinimalSize, serialiseKeyPreservesOrdering,
-                     serialiseValueIdentity, serialiseValueIdentityUpToSlicing,
-                     toSnapshotName)
+                     serialiseKeyPreservesOrdering, serialiseValueIdentity,
+                     serialiseValueIdentityUpToSlicing, toSnapshotName)
 import qualified Database.LSMTree as LSMT
 import qualified Database.LSMTree.Internal.Types as LSMT
 import qualified Database.LSMTree.Internal.Unsafe as Internal

test/Test/Database/LSMTree/Generators.hs

@@ -64,9 +64,6 @@ tests = testGroup "Test.Database.LSMTree.Generators" [
         prop_arbitraryAndShrinkPreserveInvariant
           (\(LargeRawBytes rb) -> labelRawBytes rb)
           (deepseqInvariant @LargeRawBytes)
-    , testGroup "KeyForIndexCompact" $
-        prop_arbitraryAndShrinkPreserveInvariant noTags $
-          isKeyForIndexCompact . getKeyForIndexCompact
     , testGroup "BiasedKey" $
           prop_arbitraryAndShrinkPreserveInvariant
             (labelTestKOps @BiasedKey)

test/Test/Database/LSMTree/Internal/Index/Compact.hs

@@ -28,7 +28,7 @@ import           Data.Word
 import           Database.LSMTree.Extras
 import           Database.LSMTree.Extras.Generators (ChunkSize (..),
                      LogicalPageSummaries, LogicalPageSummary (..), Pages (..),
-                     genRawBytes, isKeyForIndexCompact, labelPages, toAppends)
+                     genRawBytes, labelPages, toAppends)
 import           Database.LSMTree.Extras.Index (Append (..), appendToCompact)
 import           Database.LSMTree.Internal.BitMath
 import           Database.LSMTree.Internal.Chunk as Chunk (toByteString)
@@ -54,9 +54,7 @@ import           Text.Printf (printf)
 
 tests :: TestTree
 tests = testGroup "Test.Database.LSMTree.Internal.Index.Compact" [
-    testGroup "TestKey" $
-      prop_arbitraryAndShrinkPreserveInvariant @TestKey noTags isTestKey
-  , testProperty "prop_distribution @TestKey" $
+    testProperty "prop_distribution @TestKey" $
       prop_distribution @TestKey
   , testProperty "prop_searchMinMaxKeysAfterConstruction" $
       prop_searchMinMaxKeysAfterConstruction @TestKey 100
@@ -173,15 +171,12 @@ instance Arbitrary TestKey where
   -- Shrink keys extensively: most failures will occur in small counterexamples,
   -- so we don't have to limit the number of shrinks as much.
   shrink (TestKey bytes) = [
-        TestKey bytes'
+        testkey'
       | let RawBytes vec = bytes
       , vec' <- VP.fromList <$> shrink (VP.toList vec)
-      , let bytes' = RawBytes vec'
-      , isKeyForIndexCompact bytes'
+      , let testkey' = TestKey $ RawBytes vec'
       ]
 
-isTestKey :: TestKey -> Bool
-isTestKey (TestKey bytes) = isKeyForIndexCompact bytes
 
 {-------------------------------------------------------------------------------
   Properties

test/Test/Database/LSMTree/Internal/Lookup.hs

@@ -60,7 +60,7 @@ import qualified Database.LSMTree.Internal.Run as Run
 import           Database.LSMTree.Internal.RunAcc as Run
 import           Database.LSMTree.Internal.RunBuilder
                      (RunDataCaching (CacheRunData), RunParams (RunParams))
-import           Database.LSMTree.Internal.Serialise
+import           Database.LSMTree.Internal.Serialise as Serialise
 import           Database.LSMTree.Internal.Serialise.Class
 import           Database.LSMTree.Internal.UniqCounter
 import qualified Database.LSMTree.Internal.WriteBuffer as WB
@@ -569,14 +569,10 @@ liftShrink3InMemLookupData shrinkKey shrinkValue shrinkBlob InMemLookupData{ run
       shrinkEntry = liftShrink2 shrinkValue shrinkBlob
 
 genSerialisedKey :: Gen SerialisedKey
-genSerialisedKey = frequency [
-      (9, arbitrary `suchThat` (\k -> sizeofKey k >= 8))
-    , (1, do x <- getSmall <$> arbitrary
-             pure $ SerialisedKey (RB.pack [0,0,0,0,0,0,0, x]))
-    ]
+genSerialisedKey = Serialise.serialiseKey <$> arbitraryBoundedIntegral @Word64
 
 shrinkSerialisedKey :: SerialisedKey -> [SerialisedKey]
-shrinkSerialisedKey k = [k' | k' <- shrink k, sizeofKey k' >= 8]
+shrinkSerialisedKey k = Serialise.serialiseKey <$> shrink (Serialise.deserialiseKey k :: Word64)
 
 genSerialisedValue :: Gen SerialisedValue
 genSerialisedValue = frequency [ (50, arbitrary), (1, genLongValue) ]

test/Test/Database/LSMTree/Internal/RunAcc.hs

@@ -143,8 +143,7 @@ fromProtoValue (Proto.Value bs) = SerialisedValue . RB.fromShortByteString $ SBS
 fromProtoBlobRef :: Proto.BlobRef -> BlobSpan
 fromProtoBlobRef (Proto.BlobRef x y) = BlobSpan x y
 
--- | Wrapper around 'PageLogical' that generates nearly-full pages, and
--- keys that are always large enough (>= 8 bytes) for the compact index.
+-- | Wrapper around 'PageLogical' that generates nearly-full pages.
 newtype PageLogical' = PageLogical' { getPrototypeKOps :: [(Proto.Key, Proto.Operation)] }
   deriving stock Show
 
@@ -153,7 +152,7 @@ getRealKOps = fmap fromProtoKOp . getPrototypeKOps
 
 instance Arbitrary PageLogical' where
   arbitrary = PageLogical' <$>
-      Proto.genPageContentFits Proto.DiskPage4k (Proto.MinKeySize 8)
+      Proto.genPageContentFits Proto.DiskPage4k Proto.noMinKeySize
   shrink (PageLogical' page) =
       [ PageLogical' page' | page' <- shrink page ]