Merge #1709

1709: ChainDB: add blocks asynchronously r=edsko a=mrBliss

Fixes #1463.

Instead of adding blocks synchronously, they are now put into a queue, after
which `addBlockAsync` returns an `AddBlockResult`, which can be used to wait
until the block has been processed.

A background thread will read the blocks from the queue and add them
synchronously to the ChainDB. The queue is limited in size; when it is full,
callers of `addBlockAsync` might still have to wait.

With this asynchronous approach, threads adding blocks asynchronously can be
killed without worries, the background thread processing the blocks
synchronously won't be killed. Only when the whole ChainDB shuts down will
that background thread get killed. But since there will be no more in-memory
state, it can't get out of sync with the file system state. On the next
startup, a correct in-memory state will be reconstructed from the file system
state.

By letting the BlockFetchClient add blocks asynchronously, we also get a
20-40% bulk chain sync speed-up in some microbenchmarks.

Co-authored-by: Thomas Winant <[email protected]>

io-sim-classes/src/Control/Monad/Class/MonadSTM.hs

@@ -44,6 +44,7 @@ module Control.Monad.Class.MonadSTM
   , writeTBQueueDefault
   , isEmptyTBQueueDefault
   , isFullTBQueueDefault
+  , lengthTBQueueDefault
   ) where
 
 import           Prelude hiding (read)
@@ -423,3 +424,19 @@ isFullTBQueueDefault (TBQueue rsize _read wsize _write _size) = do
          if (r > 0)
             then return False
             else return True
+
+-- 'lengthTBQueue' was added in stm-2.5.0.0, but since we support older
+-- versions of stm, we don't include it as a method in the type class. If we
+-- were to conditionally (@MIN_VERSION_stm(2,5,0)@) include the method in the
+-- type class, the IO simulator would have to conditionally include the
+-- method, requiring a dependency on the @stm@ package, which would be
+-- strange.
+--
+-- Nevertheless, we already provide a default implementation. Downstream
+-- packages that don't mind having a >= 2.5 constraint on stm can use this to
+-- implement 'lengthTBQueue' for the IO simulator.
+lengthTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Natural
+lengthTBQueueDefault (TBQueue rsize _read wsize _write size) = do
+  r <- readTVar rsize
+  w <- readTVar wsize
+  return $! size - r - w

io-sim/src/Control/Monad/IOSim.hs

@@ -13,6 +13,7 @@
 module Control.Monad.IOSim (
   -- * Simulation monad
   SimM,
+  SimSTM,
   -- ** Run simulation
   runSim,
   runSimOrThrow,
@@ -140,6 +141,8 @@ data StmA s a where
   Retry        :: StmA s b
   OrElse       :: StmA s a -> StmA s a -> (a -> StmA s b) -> StmA s b
 
+-- Exported type
+type SimSTM = STM
 
 data MaskingState = Unmasked | MaskedInterruptible | MaskedUninterruptible
   deriving (Eq, Ord, Show)