The credit scaling in the impl was backwards from the prototype

The credit scaling for levelling vs teiring use different formulas. The
implementation's version of this scaling had the two cases swapped. This
will have resulted in supplying too few credits to levelling runs (and
thus having to complete too much at the end) and too many to teiring
runs (thus completing too early). In both cases it will have resulted in
IO not being spread out evenly, and thus higher peak latency for
updates.

We can now successfully assert that upon expecting a merging run to be
complete we have supplied credits equalling the total debt. Previously
this assertion failed, which led to the discovery of the bug.

We need to find a test to ensure we are spreading out merging work and
not supplying too many credits. We supply credits for the worst case,
which currently means we supply excess in typical cases. We should scale
the credit supply to the actual debt for each merge, based on the size
of the input runs.

Author: dcoutts

src/Database/LSMTree/Internal/MergeSchedule.hs

@@ -884,17 +884,14 @@ supplyCredits conf c levels =
 -- on the merging run.
 --
 -- Initially, 1 update supplies 1 credit. However, since merging runs have
--- different numbers of input runs/entries, we may have to a more or less
+-- different numbers of input runs\/entries, we may have to a more or less
 -- merging work than 1 merge step for each credit.
-scaleCreditsForMerge :: MergePolicyForLevel -> Ref (MergingRun m h) -> Credits -> MR.Credits
--- A single run is a trivially completed merge, so it requires no credits.
-scaleCreditsForMerge LevelTiering _ (Credits c) =
-    -- A tiering merge has 5 runs at most (one could be held back to merged
-    -- again) and must be completed before the level is full (once 4 more
-    -- runs come in).
-    MR.Credits (c * (1 + 4))
-
-scaleCreditsForMerge LevelLevelling mr (Credits c) =
+scaleCreditsForMerge ::
+     MergePolicyForLevel
+  -> Ref (MergingRun m h)
+  -> Credits
+  -> MR.Credits
+scaleCreditsForMerge LevelLevelling _ (Credits c) =
     -- A levelling merge has 1 input run and one resident run, which is (up
     -- to) 4x bigger than the others. It needs to be completed before
     -- another run comes in.
@@ -904,6 +901,11 @@ scaleCreditsForMerge LevelLevelling mr (Credits c) =
     -- worst-case upper bound by looking at the sizes of the input runs.
     -- As as result, merge work would/could be more evenly distributed over
     -- time when the resident run is smaller than the worst case.
+    MR.Credits (c * (1 + 4))
+scaleCreditsForMerge LevelTiering mr (Credits c) =
+    -- A tiering merge has 5 runs at most (one could be held back to merged
+    -- again) and must be completed before the level is full (once 4 more
+    -- runs come in).
     let NumRuns n = MR.numRuns mr
        -- same as division rounding up: ceiling (c * n / 4)
     in MR.Credits ((c * n + 3) `div` 4)

src/Database/LSMTree/Internal/MergingRun.hs

@@ -765,13 +765,10 @@ expectCompleted (DeRef MergingRun {..}) = do
     when (knownCompleted == MergeMaybeCompleted) $ do
       (SpentCredits   spentCredits,
        UnspentCredits unspentCredits) <- atomicReadCredits mergeCreditsVar
-      let !totalDebt       = numEntriesToTotalDebt mergeNumEntries
-          !suppliedCredits = spentCredits + unspentCredits
-          !credits         = assert (suppliedCredits <= totalDebt) $
-                             totalDebt - spentCredits
-      --TODO: the following ought to be true and be the right answer:
-      --  !credits         = assert (suppliedCredits == totalDebt) $
-      --                     unspentCredits
+      let totalDebt       = numEntriesToTotalDebt mergeNumEntries
+          suppliedCredits = spentCredits + unspentCredits
+          !credits        = assert (suppliedCredits == totalDebt) $
+                            unspentCredits
 
       --TODO: what about exception safety: check if it is ok to be interrupted
       -- between performMergeSteps and completeMerge here, and above.