Merge #1772

1772: Rename getSuccessors to filterByPredecessor r=mrBliss a=kderme

Last piece of #1684

Co-authored-by: kderme <[email protected]>

ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs

@@ -97,7 +97,7 @@ initialChainSelection immDB volDB lgrDB tracer cfg varInvalid curSlot = do
     i :: Anchor blk <- ImmDB.getAnchorForTip immDB
     (succsOf, ledger) <- atomically $ do
       invalid <- forgetFingerprint <$> readTVar varInvalid
-      (,) <$> (ignoreInvalidSuc volDB invalid <$> VolDB.getSuccessors volDB)
+      (,) <$> (ignoreInvalidSuc volDB invalid <$> VolDB.filterByPredecessor volDB)
           <*> LgrDB.getCurrent lgrDB
 
     chains <- constructChains i succsOf
@@ -364,11 +364,11 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr = do
     (invalid, succsOf, predecessor, curChain, tipPoint, ledgerDB)
       <- atomically $ (,,,,,)
           <$> (forgetFingerprint <$> readTVar cdbInvalid)
-          <*> VolDB.getSuccessors   cdbVolDB
-          <*> VolDB.getPredecessor  cdbVolDB
-          <*> Query.getCurrentChain cdb
-          <*> Query.getTipPoint     cdb
-          <*> LgrDB.getCurrent      cdbLgrDB
+          <*> VolDB.filterByPredecessor cdbVolDB
+          <*> VolDB.getPredecessor      cdbVolDB
+          <*> Query.getCurrentChain     cdb
+          <*> Query.getTipPoint         cdb
+          <*> LgrDB.getCurrent          cdbLgrDB
     let curChainAndLedger :: ChainAndLedger blk
         curChainAndLedger =
           -- The current chain we're working with here is not longer than @k@

ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/VolDB.hs

@@ -38,7 +38,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.VolDB (
   , getBlockInfo
   , getIsMember
   , getPredecessor
-  , getSuccessors
+  , filterByPredecessor
   , getMaxSlotNo
   , putBlock
   , closeDB
@@ -222,9 +222,10 @@ getPredecessor :: Functor (STM m)
                -> STM m (HeaderHash blk -> Maybe (WithOrigin (HeaderHash blk)))
 getPredecessor = fmap (fmap VolDB.bpreBid .) . getBlockInfo
 
-getSuccessors :: VolDB m blk
-              -> STM m (WithOrigin (HeaderHash blk) -> Set (HeaderHash blk))
-getSuccessors db = withSTM db VolDB.getSuccessors
+filterByPredecessor :: VolDB m blk
+                    -> STM m (WithOrigin (HeaderHash blk)
+                    -> Set (HeaderHash blk))
+filterByPredecessor db = withSTM db VolDB.filterByPredecessor
 
 getMaxSlotNo :: VolDB m blk
              -> STM m MaxSlotNo
@@ -263,8 +264,9 @@ garbageCollect db slotNo = withDB db $ \vol ->
 -- the chain (fragment) ending with @B@ is also a potential candidate.
 candidates
   :: forall blk.
-     (WithOrigin (HeaderHash blk) -> Set (HeaderHash blk)) -- ^ @getSuccessors@
-  -> Point blk                                             -- ^ @B@
+     (WithOrigin (HeaderHash blk) -> Set (HeaderHash blk))
+     -- ^ @filterByPredecessor@
+  -> Point blk -- ^ @B@
   -> [NonEmpty (HeaderHash blk)]
      -- ^ Each element in the list is a list of hashes from which we can
      -- construct a fragment anchored at the point @B@.

ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/API.hs

@@ -37,14 +37,14 @@ withDB :: (HasCallStack, MonadThrow m)
 withDB openDB = bracket openDB closeDB
 
 data VolatileDB blockId m = VolatileDB {
-      closeDB           :: HasCallStack => m ()
-    , isOpenDB          :: HasCallStack => m Bool
-    , reOpenDB          :: HasCallStack => m ()
-    , getBlockComponent :: forall b. HasCallStack
+      closeDB             :: HasCallStack => m ()
+    , isOpenDB            :: HasCallStack => m Bool
+    , reOpenDB            :: HasCallStack => m ()
+    , getBlockComponent   :: forall b. HasCallStack
                         => BlockComponent (VolatileDB blockId m) b
                         -> blockId
                         -> m (Maybe b)
-    , putBlock          :: HasCallStack => BlockInfo blockId -> Builder -> m ()
+    , putBlock            :: HasCallStack => BlockInfo blockId -> Builder -> m ()
       -- | Return a function that returns the successors of the block with the
       -- given @blockId@.
       --
@@ -55,11 +55,11 @@ data VolatileDB blockId m = VolatileDB {
       --
       -- Note that it is not required that the given block has been added to
       -- the VolatileDB.
-    , getSuccessors     :: HasCallStack => STM m (WithOrigin blockId -> Set blockId)
+    , filterByPredecessor :: HasCallStack => STM m (WithOrigin blockId -> Set blockId)
       -- | Return a function that returns the 'BlockInfo' of the block with
       -- the given @blockId@ or 'Nothing' if the @blockId@ is not found in the
       -- VolatileDB.
-    , getBlockInfo      :: HasCallStack => STM m (blockId -> Maybe (BlockInfo blockId))
+    , getBlockInfo        :: HasCallStack => STM m (blockId -> Maybe (BlockInfo blockId))
       -- | Try to remove all blocks with a slot number less than the given
       -- one.
       --
@@ -116,9 +116,9 @@ data VolatileDB blockId m = VolatileDB {
       -- will be removed anyway. The reason for @<@ opposed to @<=@ is to
       -- avoid issues with /EBBs/, which have the same slot number as the
       -- block after it.
-    , garbageCollect    :: HasCallStack => SlotNo -> m ()
+    , garbageCollect      :: HasCallStack => SlotNo -> m ()
       -- | Return the highest slot number ever stored by the VolatileDB.
-    , getMaxSlotNo      :: HasCallStack => STM m MaxSlotNo
+    , getMaxSlotNo        :: HasCallStack => STM m MaxSlotNo
 } deriving NoUnexpectedThunks via OnlyCheckIsWHNF "VolatileDB" (VolatileDB blockId m)
 
 

ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/Impl.hs

@@ -191,15 +191,15 @@ openDB hasFS parser tracer maxBlocksPerFile = do
           , tracer           = tracer
           }
     return VolatileDB {
-        closeDB           = closeDBImpl           env
-      , isOpenDB          = isOpenDBImpl          env
-      , reOpenDB          = reOpenDBImpl          env
-      , getBlockComponent = getBlockComponentImpl env
-      , putBlock          = putBlockImpl          env
-      , garbageCollect    = garbageCollectImpl    env
-      , getSuccessors     = getSuccessorsImpl     env
-      , getBlockInfo      = getBlockInfoImpl      env
-      , getMaxSlotNo      = getMaxSlotNoImpl      env
+        closeDB             = closeDBImpl             env
+      , isOpenDB            = isOpenDBImpl            env
+      , reOpenDB            = reOpenDBImpl            env
+      , getBlockComponent   = getBlockComponentImpl   env
+      , putBlock            = putBlockImpl            env
+      , garbageCollect      = garbageCollectImpl      env
+      , filterByPredecessor = filterByPredecessorImpl env
+      , getBlockInfo        = getBlockInfoImpl        env
+      , getMaxSlotNo        = getMaxSlotNoImpl        env
       }
 
 closeDBImpl :: IOLike m
@@ -411,10 +411,10 @@ tryCollectFile hasFS slot st@InternalState{..} (fileId, fileInfo)
       bids
     succMap'       = foldl' deleteMapSet currentSuccMap deletedPairs
 
-getSuccessorsImpl :: forall m blockId. (IOLike m, Ord blockId)
-                  => VolatileDBEnv m blockId
-                  -> STM m (WithOrigin blockId -> Set blockId)
-getSuccessorsImpl = getterSTM $ \st blockId ->
+filterByPredecessorImpl :: forall m blockId. (IOLike m, Ord blockId)
+                        => VolatileDBEnv m blockId
+                        -> STM m (WithOrigin blockId -> Set blockId)
+filterByPredecessorImpl = getterSTM $ \st blockId ->
     fromMaybe Set.empty (Map.lookup blockId (currentSuccMap st))
 
 getBlockInfoImpl :: forall m blockId. (IOLike m, Ord blockId)

ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/Mock.hs

@@ -21,15 +21,15 @@ openDBMock maxBlocksPerFile = do
 
     db :: StrictTVar m (DBModel blockId) -> VolatileDB blockId m
     db dbVar = VolatileDB {
-          closeDB           = update_   $ closeModel
-        , isOpenDB          = query     $ isOpenModel
-        , reOpenDB          = update_   $ reOpenModel
-        , getBlockComponent = queryE   .: getBlockComponentModel
-        , putBlock          = updateE_ .: putBlockModel
-        , garbageCollect    = updateE_  . garbageCollectModel
-        , getSuccessors     = querySTME $ getSuccessorsModel
-        , getBlockInfo      = querySTME $ getBlockInfoModel
-        , getMaxSlotNo      = querySTME $ getMaxSlotNoModel
+          closeDB             = update_   $ closeModel
+        , isOpenDB            = query     $ isOpenModel
+        , reOpenDB            = update_   $ reOpenModel
+        , getBlockComponent   = queryE   .: getBlockComponentModel
+        , putBlock            = updateE_ .: putBlockModel
+        , garbageCollect      = updateE_  . garbageCollectModel
+        , filterByPredecessor = querySTME $ filterByPredecessorModel
+        , getBlockInfo        = querySTME $ getBlockInfoModel
+        , getMaxSlotNo        = querySTME $ getMaxSlotNoModel
         }
       where
         update_ :: (DBModel blockId -> DBModel blockId) -> m ()

ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/Model.hs

@@ -17,7 +17,7 @@ module Test.Ouroboros.Storage.VolatileDB.Model
     , putBlockModel
     , garbageCollectModel
     , getBlockInfoModel
-    , getSuccessorsModel
+    , filterByPredecessorModel
     , getMaxSlotNoModel
       -- * Corruptions
     , runCorruptionsModel
@@ -302,11 +302,11 @@ garbageCollectModel slot dbm = whenOpen dbm $
       fileId /= getCurrentFileId dbm &&
       fileMaxSlotNo file < MaxSlotNo slot
 
-getSuccessorsModel
+filterByPredecessorModel
   :: forall blockId. Ord blockId
   => DBModel blockId
   -> Either VolatileDBError (WithOrigin blockId -> Set blockId)
-getSuccessorsModel dbm = whenOpen dbm $ \predecessor ->
+filterByPredecessorModel dbm = whenOpen dbm $ \predecessor ->
     fromMaybe Set.empty $ Map.lookup predecessor successors
   where
     successors :: Map (WithOrigin blockId) (Set blockId)

ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/StateMachine.hs

@@ -119,7 +119,7 @@ data Cmd
     | GetBlockComponent BlockId
     | PutBlock TestBlock
     | GarbageCollect SlotNo
-    | GetSuccessors [Predecessor]
+    | FilterByPredecessor [Predecessor]
     | GetBlockInfo [BlockId]
     | GetMaxSlotNo
     | Corruption Corruptions
@@ -230,20 +230,20 @@ runPure :: Cmd
         -> DBModel BlockId
         -> (Resp, DBModel BlockId)
 runPure = \case
-    GetBlockComponent bid -> ok MbAllComponents            $ queryE   (getBlockComponentModel allComponents bid)
-    GetSuccessors bids    -> ok (Successors  . (<$> bids)) $ queryE    getSuccessorsModel
-    GetBlockInfo bids     -> ok (BlockInfos  . (<$> bids)) $ queryE    getBlockInfoModel
-    GarbageCollect slot   -> ok Unit                       $ updateE_ (garbageCollectModel slot)
-    IsOpen                -> ok Bool                       $ query     isOpenModel
-    Close                 -> ok Unit                       $ update_   closeModel
-    ReOpen                -> ok Unit                       $ update_   reOpenModel
-    GetMaxSlotNo          -> ok MaxSlot                    $ queryE    getMaxSlotNoModel
-    PutBlock b            -> ok Unit                       $ updateE_ (putBlockModel blockInfo blob)
+    GetBlockComponent bid    -> ok MbAllComponents            $ queryE   (getBlockComponentModel allComponents bid)
+    FilterByPredecessor bids -> ok (Successors  . (<$> bids)) $ queryE    filterByPredecessorModel
+    GetBlockInfo bids        -> ok (BlockInfos  . (<$> bids)) $ queryE    getBlockInfoModel
+    GarbageCollect slot      -> ok Unit                       $ updateE_ (garbageCollectModel slot)
+    IsOpen                   -> ok Bool                       $ query     isOpenModel
+    Close                    -> ok Unit                       $ update_   closeModel
+    ReOpen                   -> ok Unit                       $ update_   reOpenModel
+    GetMaxSlotNo             -> ok MaxSlot                    $ queryE    getMaxSlotNoModel
+    PutBlock b               -> ok Unit                       $ updateE_ (putBlockModel blockInfo blob)
       where
         blockInfo = testBlockToBlockInfo b
         blob      = testBlockToBuilder b
-    Corruption cors       -> ok Unit                       $ update_  (withClosedDB (runCorruptionsModel cors))
-    DuplicateBlock {}     -> ok Unit                       $ update_  (withClosedDB noop)
+    Corruption cors          -> ok Unit                       $ update_  (withClosedDB (runCorruptionsModel cors))
+    DuplicateBlock {}        -> ok Unit                       $ update_  (withClosedDB noop)
   where
     query f m = (Right (f m), m)
 
@@ -345,7 +345,7 @@ generatorCmdImpl Model {..} = frequency
     , (2, GetBlockComponent <$> genBlockId)
     , (2, GarbageCollect <$> genGCSlot)
     , (2, GetBlockInfo <$> listOf genBlockId)
-    , (2, GetSuccessors <$> listOf genWithOriginBlockId)
+    , (2, FilterByPredecessor <$> listOf genWithOriginBlockId)
     , (2, return GetMaxSlotNo)
 
     , (if null dbFiles then 0 else 1,
@@ -466,10 +466,10 @@ shrinkerImpl m (At (CmdErr cmd mbErr)) = fmap At $
 
 shrinkCmd :: Model Symbolic -> Cmd -> [Cmd]
 shrinkCmd Model{..} cmd = case cmd of
-    GetBlockInfo   bids  -> GetBlockInfo   <$> shrinkList (const []) bids
-    GetSuccessors  preds -> GetSuccessors  <$> shrinkList (const []) preds
-    Corruption cors      -> Corruption <$> shrinkCorruptions cors
-    _                    -> []
+    GetBlockInfo   bids       -> GetBlockInfo <$> shrinkList (const []) bids
+    FilterByPredecessor preds -> FilterByPredecessor <$> shrinkList (const []) preds
+    Corruption cors           -> Corruption <$> shrinkCorruptions cors
+    _                         -> []
 
 -- | Environment to run commands against the real VolatileDB implementation.
 data VolatileDBEnv h = VolatileDBEnv
@@ -496,15 +496,15 @@ runDB :: HasCallStack
       -> Cmd
       -> IO Success
 runDB VolatileDBEnv { db, hasFS } cmd = case cmd of
-    GetBlockComponent bid -> MbAllComponents          <$> getBlockComponent db allComponents bid
-    PutBlock b            -> Unit                     <$> putBlock db (testBlockToBlockInfo b) (testBlockToBuilder b)
-    GetSuccessors  bids   -> Successors .  (<$> bids) <$> atomically (getSuccessors db)
-    GetBlockInfo   bids   -> BlockInfos .  (<$> bids) <$> atomically (getBlockInfo db)
-    GarbageCollect slot   -> Unit                     <$> garbageCollect db slot
-    GetMaxSlotNo          -> MaxSlot                  <$> atomically (getMaxSlotNo db)
-    IsOpen                -> Bool                     <$> isOpenDB db
-    Close                 -> Unit                     <$> closeDB db
-    ReOpen                -> Unit                     <$> reOpenDB db
+    GetBlockComponent bid    -> MbAllComponents          <$> getBlockComponent db allComponents bid
+    PutBlock b               -> Unit                     <$> putBlock db (testBlockToBlockInfo b) (testBlockToBuilder b)
+    FilterByPredecessor bids -> Successors .  (<$> bids) <$> atomically (filterByPredecessor db)
+    GetBlockInfo   bids      -> BlockInfos .  (<$> bids) <$> atomically (getBlockInfo db)
+    GarbageCollect slot      -> Unit                     <$> garbageCollect db slot
+    GetMaxSlotNo             -> MaxSlot                  <$> atomically (getMaxSlotNo db)
+    IsOpen                   -> Bool                     <$> isOpenDB db
+    Close                    -> Unit                     <$> closeDB db
+    ReOpen                   -> Unit                     <$> reOpenDB db
     Corruption corrs ->
       withClosedDB $
         forM_ corrs $ \(corr, file) -> corruptFile hasFS corr file
@@ -540,7 +540,7 @@ prop_sequential = forAllCommands smUnused Nothing $ \cmds -> monadicIO $ do
         $ tabulate "GetBlockInfo: total number of Just's"
           [groupIsMember $ isMemberTrue events]
         $ tabulate "Successors"
-          (tagGetSuccessors events)
+          (tagFilterByPredecessor events)
         $ prop
   where
     dbm = initDBModel maxBlocksPerFile
@@ -773,12 +773,12 @@ tagSimulatedErrors events = fmap tagError events
       At (CmdErr _ Nothing) -> "NoError"
       At (CmdErr cmd _)     -> cmdName (At cmd) <> " Error"
 
-tagGetSuccessors :: [VolDBEvent Symbolic] -> [String]
-tagGetSuccessors = mapMaybe f
+tagFilterByPredecessor :: [VolDBEvent Symbolic] -> [String]
+tagFilterByPredecessor = mapMaybe f
   where
     f :: VolDBEvent Symbolic -> Maybe String
     f ev = case (getCmd ev, eventMockResp ev) of
-        (GetSuccessors _pid, Resp (Right (Successors st))) ->
+        (FilterByPredecessor _pid, Resp (Right (Successors st))) ->
             if all Set.null st then Just "Empty Successors"
             else Just "Non empty Successors"
         _otherwise -> Nothing