Merge #3920

3920: Karknu/rcd 43 mitigation r=jmitchell a=karknu

## Description

Improvement that makes the network disconnect in RCD-43 less likely to happen.

## Linked issue

<!--- Put here the relevant issue from YouTrack -->



Co-authored-by: Erik de Castro Lopo <[email protected]>
Co-authored-by: Karl Knutsson <[email protected]>
Co-authored-by: Kosyrev Serge <[email protected]>
Co-authored-by: Duncan Coutts <[email protected]>

Author: 5 people

db/cardano-sl-db.cabal

@@ -141,6 +141,7 @@ library
                      , ekg-core
                      , ether >= 0.5
                      , exceptions
+                     , extra
                      , filepath
                      , formatting
                      , lens

db/src/Pos/DB/Block/Epoch.hs

@@ -47,6 +47,7 @@ import           Data.Binary (decode, encode)
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy as LBS
 import           Data.Either (partitionEithers)
+import           Data.List.Extra (chunksOf)
 import           Formatting (build, int, sformat, shown, (%))
 import           System.Directory (removeFile)
 import           System.FilePath ((</>))
@@ -363,7 +364,12 @@ consolidateOneEpoch ccp epochSlots = do
 
     -- After the check point is written, delete old blunds for the epoch we have just
     -- consolidated.
-    lift $ mapM_ deleteOldBlund sihs
+    lift $ mapM_ deleter $ chunksOf 1000 sihs
+  where
+    deleter :: ConsolidateM ctx m => [SlotIndexHash] -> m ()
+    deleter xs = do
+        mapM_ deleteOldBlund xs
+        sleepSeconds 2
 
 deleteOldBlund :: ConsolidateM ctx m => SlotIndexHash -> m ()
 deleteOldBlund (SlotIndexHash _ hh) = do
@@ -389,16 +395,18 @@ consolidateEpochBlocks fpath xs = ExceptT $ do
             (liftIO . hClose)
             (\hdl -> do
                 liftIO $ BS.hPutStr hdl epochFileHeader
-                mapM (consolidate hdl) xs
+                mapM (consolidate hdl) $ zip [0 .. ] xs
                 )
     pure $ case partitionEithers ys of
             ([], zs) -> Right $ epochIndexToOffset zs
             (e:_, _) -> Left e
   where
     consolidate
         :: ConsolidateM ctx m
-        => Handle -> SlotIndexHash -> m (Either ConsolidateError SlotIndexLength)
-    consolidate hdl  (SlotIndexHash lsi hh) = do
+        => Handle -> (Int, SlotIndexHash) -> m (Either ConsolidateError SlotIndexLength)
+    consolidate hdl  (indx, SlotIndexHash lsi hh) = do
+        when (indx `mod` 1000 == 0) $
+            sleepSeconds 2
         mblund <- getSerializedBlund hh
         case mblund of
             Nothing ->

db/src/Pos/DB/Rocks/Functions.hs

@@ -41,6 +41,7 @@ import qualified Database.RocksDB as Rocks
 import           System.Directory (createDirectoryIfMissing, doesDirectoryExist,
                      removeDirectoryRecursive)
 import           System.FilePath (takeDirectory, (</>))
+import qualified System.Info (os)
 
 import           Pos.Binary.Class (Bi, serialize')
 import           Pos.DB.BatchOp (rocksWriteBatch)
@@ -82,6 +83,7 @@ openNodeDBs recreate fp = do
     let gStatePath = fp </> "gState"
     let lrcPath = fp </> "lrc"
     let miscPath = fp </> "misc"
+
     mapM_ ensureDirectoryExists
         [ blocksDir
         , _blockDataDir
@@ -91,6 +93,11 @@ openNodeDBs recreate fp = do
         , lrcPath
         , miscPath
         ]
+
+    when (System.Info.os == "darwin") $
+        -- Prevent indexing of blocks on OSX
+        ensureEmptyFileExists (fp </> ".metadata_never_index")
+
     _blockIndexDB <- openRocksDB blocksIndexPath
     _gStateDB <- openRocksDB gStatePath
     _lrcDB <- openRocksDB lrcPath
@@ -101,6 +108,9 @@ openNodeDBs recreate fp = do
     ensureDirectoryExists :: MonadIO m => FilePath -> m ()
     ensureDirectoryExists = liftIO . createDirectoryIfMissing True
 
+    ensureEmptyFileExists :: MonadIO m => FilePath -> m ()
+    ensureEmptyFileExists file = liftIO $ withFile file AppendMode (\_ -> return ())
+
 -- | Safely close all databases from 'NodeDBs'.
 closeNodeDBs :: MonadIO m => NodeDBs -> m ()
 closeNodeDBs NodeDBs {..} =

pkgs/default.nix

@@ -16188,6 +16188,7 @@ license = stdenv.lib.licenses.mit;
 , ekg-core
 , ether
 , exceptions
+, extra
 , filepath
 , formatting
 , hedgehog
@@ -16241,6 +16242,7 @@ directory
 ekg-core
 ether
 exceptions
+extra
 filepath
 formatting
 lens