diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs index 726b0121f1b..d0f028412c9 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs @@ -311,10 +311,9 @@ chainSelectionForBlock chainSelectionForBlock cdb@CDB{..} blockCache hdr = do curSlot <- atomically $ getCurrentSlot cdbBlockchainTime - (invalid, isMember, succsOf, predecessor, curChain, tipPoint, ledgerDB) - <- atomically $ (,,,,,,) + (invalid, succsOf, predecessor, curChain, tipPoint, ledgerDB) + <- atomically $ (,,,,,) <$> (forgetFingerprint <$> readTVar cdbInvalid) - <*> VolDB.getIsMember cdbVolDB <*> VolDB.getSuccessors cdbVolDB <*> VolDB.getPredecessor cdbVolDB <*> Query.getCurrentChain cdb @@ -335,12 +334,12 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr = do i = castPoint $ AF.anchorPoint curChain -- Let these two functions ignore invalid blocks - isMember' = ignoreInvalid cdb invalid isMember - succsOf' = ignoreInvalidSuc cdb invalid succsOf + predecessor' = ignoreInvalid cdb invalid predecessor + succsOf' = ignoreInvalidSuc cdb invalid succsOf -- The preconditions assert (blockSlot hdr <= curSlot) $ return () - assert (isMember (headerHash hdr)) $ return () + assert (isJust $ predecessor (headerHash hdr)) $ return () if -- The chain might have grown since we added the block such that the @@ -358,7 +357,7 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr = do trace (TryAddToCurrentChain p) addToCurrentChain succsOf' curChainAndLedger curSlot - | Just hashes <- VolDB.isReachable predecessor isMember' i p -> do + | Just hashes <- VolDB.isReachable predecessor' i p -> do -- ### Switch to a fork trace (TrySwitchToAFork p hashes) switchToAFork succsOf' curChainAndLedger hashes curSlot @@ -968,17 +967,16 @@ truncateInvalidCandidate isInvalid (CandidateSuffix rollback suffix) -------------------------------------------------------------------------------} --- | Wrap an @isMember@ function so that it returns 'False' for invalid --- blocks. +-- | Wrap a @getter@ function so that it returns 'Nothing' for invalid blocks. ignoreInvalid :: HasHeader blk => proxy blk -> InvalidBlocks blk - -> (HeaderHash blk -> Bool) - -> (HeaderHash blk -> Bool) -ignoreInvalid _ invalid isMember hash - | Map.member hash invalid = False - | otherwise = isMember hash + -> (HeaderHash blk -> Maybe a) + -> (HeaderHash blk -> Maybe a) +ignoreInvalid _ invalid getter hash + | Map.member hash invalid = Nothing + | otherwise = getter hash -- | Wrap a @successors@ function so that invalid blocks are not returned as -- successors. diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/VolDB.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/VolDB.hs index 683e610c98d..340f78be71b 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/VolDB.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/VolDB.hs @@ -36,6 +36,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.VolDB ( , getKnownBlockComponent , getBlockComponent -- * Wrappers + , getBlockInfo , getIsMember , getPredecessor , getSuccessors @@ -65,7 +66,7 @@ import Data.Bifunctor (first) import qualified Data.ByteString.Lazy as Lazy import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE -import Data.Maybe (mapMaybe) +import Data.Maybe (isJust, mapMaybe) import Data.Proxy (Proxy (..)) import Data.Set (Set) import qualified Data.Set as Set @@ -210,12 +211,18 @@ mkVolDB volDB decHeader decBlock encBlock isEBB addHdrEnv = VolDB {..} Wrappers -------------------------------------------------------------------------------} -getIsMember :: VolDB m blk -> STM m (HeaderHash blk -> Bool) -getIsMember db = withSTM db VolDB.getIsMember +getBlockInfo + :: VolDB m blk + -> STM m (HeaderHash blk -> Maybe (VolDB.BlockInfo (HeaderHash blk))) +getBlockInfo db = withSTM db VolDB.getBlockInfo -getPredecessor :: VolDB m blk - -> STM m (HeaderHash blk -> WithOrigin (HeaderHash blk)) -getPredecessor db = withSTM db VolDB.getPredecessor +getIsMember :: Functor (STM m) => VolDB m blk -> STM m (HeaderHash blk -> Bool) +getIsMember = fmap (isJust .) . getBlockInfo + +getPredecessor :: Functor (STM m) + => VolDB m blk + -> 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)) @@ -282,9 +289,8 @@ isReachableSTM :: (IOLike m, HasHeader blk) -- the reachability of -> STM m (Maybe (NonEmpty (HeaderHash blk))) isReachableSTM volDB getI b = do - (predecessor, isMember, i) <- withSTM volDB $ \db -> - (,,) <$> VolDB.getPredecessor db <*> VolDB.getIsMember db <*> getI - return $ isReachable predecessor isMember i b + (predecessor, i) <- (,) <$> getPredecessor volDB <*> getI + return $ isReachable predecessor i b -- | Check whether the given point, corresponding to a block @B@, is reachable -- from the tip of the ImmutableDB (@I@) by chasing the predecessors. @@ -296,13 +302,12 @@ isReachableSTM volDB getI b = do -- 'True' <=> for all transitive predecessors @B'@ of @B@ we have @B' ∈ V@ or -- @B' = I@. isReachable :: forall blk. (HasHeader blk, HasCallStack) - => (HeaderHash blk -> WithOrigin (HeaderHash blk)) -- ^ @getPredecessor@ - -> (HeaderHash blk -> Bool) -- ^ @isMember@ + => (HeaderHash blk -> Maybe (WithOrigin (HeaderHash blk))) -> Point blk -- ^ @I@ -> Point blk -- ^ @B@ -> Maybe (NonEmpty (HeaderHash blk)) -isReachable predecessor isMember i b = - case computePath predecessor isMember from to of +isReachable predecessor i b = + case computePath predecessor from to of -- Bounds are not on the same fork Nothing -> Nothing Just path -> case path of @@ -331,32 +336,32 @@ isReachable predecessor isMember i b = -- See the documentation of 'Path'. computePath :: forall blk. HasHeader blk - => (HeaderHash blk -> WithOrigin (HeaderHash blk)) -- ^ @getPredecessor@ - -> (HeaderHash blk -> Bool) -- ^ @isMember@ + => (HeaderHash blk -> Maybe (WithOrigin (HeaderHash blk))) + -- Return the predecessor -> StreamFrom blk -> StreamTo blk -> Maybe (Path blk) -computePath predecessor isMember from to = case to of +computePath predecessor from to = case to of StreamToInclusive GenesisPoint -> Nothing StreamToExclusive GenesisPoint -> Nothing StreamToInclusive (BlockPoint { withHash = end }) - | isMember end -> case from of + | Just prev <- predecessor end -> case from of -- Easier to handle this special case (@StreamFromInclusive start, -- StreamToInclusive end, start == end@) here: StreamFromInclusive (BlockPoint { withHash = start }) | start == end -> return $ CompletelyInVolDB [end] - _ -> go [end] end + _ -> go [end] prev | otherwise -> return $ NotInVolDB end StreamToExclusive (BlockPoint { withHash = end }) - | isMember end -> go [] end - | otherwise -> return $ NotInVolDB end + | Just prev <- predecessor end -> go [] prev + | otherwise -> return $ NotInVolDB end where - -- Invariant: @isMember hash@ and @hash@ has been added to @acc@ (if - -- allowed by the bounds) - go :: [HeaderHash blk] -> HeaderHash blk -> Maybe (Path blk) - go acc hash = case predecessor hash of + -- | It only needs the predecessor @prev@ and not the actual hash, because + -- the hash is already added to @acc@ (if allowed by the bounds). + go :: [HeaderHash blk] -> WithOrigin (HeaderHash blk) -> Maybe (Path blk) + go acc prev = case prev of -- Found genesis Origin -> case from of StreamFromInclusive _ @@ -367,7 +372,7 @@ computePath predecessor isMember from to = case to of -> Nothing At predHash - | isMember predHash -> case from of + | Just prev' <- predecessor predHash -> case from of StreamFromInclusive pt | BlockHash predHash == Block.pointHash pt -> return $ CompletelyInVolDB (predHash : acc) @@ -375,7 +380,7 @@ computePath predecessor isMember from to = case to of | BlockHash predHash == Block.pointHash pt -> return $ CompletelyInVolDB acc -- Bound not yet reached, invariants both ok! - _ -> go (predHash : acc) predHash + _ -> go (predHash : acc) prev' -- Predecessor not in the VolatileDB | StreamFromExclusive pt <- from , BlockHash predHash == Block.pointHash pt @@ -394,9 +399,8 @@ computePathSTM -> StreamTo blk -> STM m (Path blk) computePathSTM volDB from to = do - (predecessor, isMember) <- withSTM volDB $ \db -> - (,) <$> VolDB.getPredecessor db <*> VolDB.getIsMember db - case computePath predecessor isMember from to of + predecessor <- getPredecessor volDB + case computePath predecessor from to of Just path -> return path Nothing -> throwM $ InvalidIteratorRange from to diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/API.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/API.hs index 06e37ce8a21..3e8351b81fd 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/API.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/API.hs @@ -56,12 +56,10 @@ 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) - -- | Return a function that returns the predecessor of the block with - -- the given @blockId@. - -- - -- PRECONDITION: the block must be a member of the VolatileDB, you can - -- use 'getIsMember' to check this. - , getPredecessor :: HasCallStack => STM m (blockId -> WithOrigin 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)) -- | Try to remove all blocks with a slot number less than the given -- one. -- @@ -119,7 +117,6 @@ data VolatileDB blockId m = VolatileDB { -- avoid issues with /EBBs/, which have the same slot number as the -- block after it. , garbageCollect :: HasCallStack => SlotNo -> m () - , getIsMember :: HasCallStack => STM m (blockId -> Bool) -- | Return the highest slot number ever stored by the VolatileDB. , getMaxSlotNo :: HasCallStack => STM m MaxSlotNo } deriving NoUnexpectedThunks via OnlyCheckIsWHNF "VolatileDB" (VolatileDB blockId m) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/Impl.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/Impl.hs index cdff3812e94..3db1e25b9d6 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/Impl.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/Impl.hs @@ -197,9 +197,8 @@ openDB hasFS parser tracer maxBlocksPerFile = do , getBlockComponent = getBlockComponentImpl env , putBlock = putBlockImpl env , garbageCollect = garbageCollectImpl env - , getIsMember = getIsMemberImpl env , getSuccessors = getSuccessorsImpl env - , getPredecessor = getPredecessorImpl env + , getBlockInfo = getBlockInfoImpl env , getMaxSlotNo = getMaxSlotNoImpl env } @@ -413,24 +412,17 @@ tryCollectFile hasFS VolatileDBEnv{..} slot st (fileId, fileInfo) mapMaybe (\b -> (b,) . bpreBid . ibBlockInfo <$> Map.lookup b _currentRevMap) bids succMap' = foldl' deleteMapSet _currentSuccMap deletedPairs -getIsMemberImpl :: forall m blockId. (IOLike m, Ord blockId) - => VolatileDBEnv m blockId - -> STM m (blockId -> Bool) -getIsMemberImpl = getterSTM $ \st bid -> Map.member bid (_currentRevMap st) - getSuccessorsImpl :: forall m blockId. (IOLike m, Ord blockId) => VolatileDBEnv m blockId -> STM m (WithOrigin blockId -> Set blockId) getSuccessorsImpl = getterSTM $ \st blockId -> fromMaybe Set.empty (Map.lookup blockId (_currentSuccMap st)) -getPredecessorImpl :: forall m blockId. (IOLike m, Ord blockId, HasCallStack) - => VolatileDBEnv m blockId - -> STM m (blockId -> WithOrigin blockId) -getPredecessorImpl = getterSTM $ \st blockId -> - maybe (error msg) (bpreBid . ibBlockInfo) (Map.lookup blockId (_currentRevMap st)) - where - msg = "precondition violated: block not member of the VolatileDB" +getBlockInfoImpl :: forall m blockId. (IOLike m, Ord blockId) + => VolatileDBEnv m blockId + -> STM m (blockId -> Maybe (BlockInfo blockId)) +getBlockInfoImpl = getterSTM $ \st blockId -> + ibBlockInfo <$> Map.lookup blockId (_currentRevMap st) getMaxSlotNoImpl :: forall m blockId. IOLike m => VolatileDBEnv m blockId diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/Types.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/Types.hs index 91cd6063785..c30dd19afdb 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/Types.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/VolatileDB/Types.hs @@ -159,7 +159,7 @@ data BlockInfo blockId = BlockInfo { , bisEBB :: !IsEBB , bheaderOffset :: !Word16 , bheaderSize :: !Word16 - } deriving (Show, Generic, NoUnexpectedThunks) + } deriving (Eq, Show, Generic, NoUnexpectedThunks) -- | The internal information the db keeps for each block. data InternalBlockInfo blockId = InternalBlockInfo { diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/Mock.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/Mock.hs index 92664848563..34c81a6952d 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/Mock.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/Mock.hs @@ -27,9 +27,8 @@ openDBMock maxBlocksPerFile = do , getBlockComponent = queryE .: getBlockComponentModel , putBlock = updateE_ .: putBlockModel , garbageCollect = updateE_ . garbageCollectModel - , getIsMember = querySTME $ getIsMemberModel , getSuccessors = querySTME $ getSuccessorsModel - , getPredecessor = querySTME $ getPredecessorModel + , getBlockInfo = querySTME $ getBlockInfoModel , getMaxSlotNo = querySTME $ getMaxSlotNoModel } where diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/Model.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/Model.hs index 8b87843038e..6efdf14f922 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/Model.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/Model.hs @@ -16,9 +16,8 @@ module Test.Ouroboros.Storage.VolatileDB.Model , getBlockComponentModel , putBlockModel , garbageCollectModel + , getBlockInfoModel , getSuccessorsModel - , getPredecessorModel - , getIsMemberModel , getMaxSlotNoModel -- * Corruptions , runCorruptionsModel @@ -317,21 +316,12 @@ getSuccessorsModel dbm = whenOpen dbm $ \predecessor -> Map.empty (getBlockToPredecessor dbm) -getPredecessorModel +getBlockInfoModel :: Ord blockId => DBModel blockId - -> Either VolatileDBError (blockId -> WithOrigin blockId) -getPredecessorModel dbm = whenOpen dbm $ \blockId -> - fromMaybe (error msg) $ Map.lookup blockId $ getBlockToPredecessor dbm - where - msg = "precondition violated: block not member of the VolatileDB" - -getIsMemberModel - :: Ord blockId - => DBModel blockId - -> Either VolatileDBError (blockId -> Bool) -getIsMemberModel dbm = whenOpen dbm $ \blockId -> - Map.member blockId (blockIndex dbm) + -> Either VolatileDBError (blockId -> Maybe (BlockInfo blockId)) +getBlockInfoModel dbm = whenOpen dbm $ \blockId -> + fst <$> Map.lookup blockId (blockIndex dbm) getMaxSlotNoModel :: DBModel blockId diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/StateMachine.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/StateMachine.hs index e0f73fc2bc1..01299bbc65b 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/StateMachine.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/VolatileDB/StateMachine.hs @@ -26,7 +26,7 @@ import Data.Functor.Classes import Data.Kind (Type) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map -import Data.Maybe (listToMaybe, mapMaybe) +import Data.Maybe (catMaybes, listToMaybe, mapMaybe) import Data.Proxy (Proxy (..)) import Data.Set (Set) import qualified Data.Set as Set @@ -121,8 +121,7 @@ data Cmd | PutBlock TestBlock | GarbageCollect SlotNo | GetSuccessors [Predecessor] - | GetPredecessor [BlockId] - | GetIsMember [BlockId] + | GetBlockInfo [BlockId] | GetMaxSlotNo | Corruption Corruptions | DuplicateBlock FileId BlockId ByteString @@ -139,9 +138,8 @@ data Success = Unit () | MbAllComponents (Maybe AllComponents) | Bool Bool - | IsMember [Bool] | Successors [Set BlockId] - | Predecessor [Predecessor] + | BlockInfos [Maybe (BlockInfo BlockId)] | MaxSlot MaxSlotNo deriving (Show, Eq) @@ -237,8 +235,7 @@ runPure :: Cmd runPure = \case GetBlockComponent bid -> ok MbAllComponents $ queryE (getBlockComponentModel allComponents bid) GetSuccessors bids -> ok (Successors . (<$> bids)) $ queryE getSuccessorsModel - GetPredecessor bids -> ok (Predecessor . (<$> bids)) $ queryE getPredecessorModel - GetIsMember bids -> ok (IsMember . (<$> bids)) $ queryE getIsMemberModel + GetBlockInfo bids -> ok (BlockInfos . (<$> bids)) $ queryE getBlockInfoModel GarbageCollect slot -> ok Unit $ updateE_ (garbageCollectModel slot) IsOpen -> ok Bool $ query isOpenModel Close -> ok Unit $ update_ closeModel @@ -303,7 +300,6 @@ transitionImpl model cmd _ = eventAfter $ lockstep model cmd preconditionImpl :: Model Symbolic -> At CmdErr Symbolic -> Logic preconditionImpl Model{..} (At (CmdErr cmd mbErrors)) = compatibleWithError .&& case cmd of - GetPredecessor bids -> forall bids (`elem` bidsInModel) Corruption cors -> forall (corruptionFiles cors) (`elem` getDBFiles dbModel) @@ -316,9 +312,6 @@ preconditionImpl Model{..} (At (CmdErr cmd mbErrors)) = Just fileId' -> fileId .>= fileId' _ -> Top where - -- | All the 'BlockId' in the db. - bidsInModel :: [BlockId] - bidsInModel = blockIds dbModel -- | Corruption commands are not allowed to have errors. compatibleWithError :: Logic @@ -354,8 +347,7 @@ generatorCmdImpl Model {..} = frequency , (if open dbModel then 1 else 5, return ReOpen) , (2, GetBlockComponent <$> genBlockId) , (2, GarbageCollect <$> genGCSlot) - , (2, GetIsMember <$> listOf genBlockId) - , (2, GetPredecessor <$> listOf genBlockId) + , (2, GetBlockInfo <$> listOf genBlockId) , (2, GetSuccessors <$> listOf genWithOriginBlockId) , (2, return GetMaxSlotNo) @@ -478,8 +470,7 @@ shrinkerImpl m (At (CmdErr cmd mbErr)) = fmap At $ shrinkCmd :: Model Symbolic -> Cmd -> [Cmd] shrinkCmd Model{..} cmd = case cmd of - GetIsMember bids -> GetIsMember <$> shrinkList (const []) bids - GetPredecessor bids -> GetPredecessor <$> shrinkList (const []) bids + GetBlockInfo bids -> GetBlockInfo <$> shrinkList (const []) bids GetSuccessors preds -> GetSuccessors <$> shrinkList (const []) preds Corruption cors -> Corruption <$> shrinkCorruptions cors _ -> [] @@ -512,8 +503,7 @@ 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) - GetPredecessor bids -> Predecessor . (<$> bids) <$> atomically (getPredecessor db) - GetIsMember bids -> IsMember . (<$> bids) <$> atomically (getIsMember db) + GetBlockInfo bids -> BlockInfos . (<$> bids) <$> atomically (getBlockInfo db) GarbageCollect slot -> Unit <$> garbageCollect db slot GetMaxSlotNo -> MaxSlot <$> atomically (getMaxSlotNo db) IsOpen -> Bool <$> isOpenDB db @@ -551,14 +541,10 @@ prop_sequential = forAllCommands smUnused Nothing $ \cmds -> monadicIO $ do (cmdName . eventCmd <$> events) $ tabulate "Error Tags" (tagSimulatedErrors events) - $ tabulate "IsMember: total number of True's" + $ tabulate "GetBlockInfo: total number of Just's" [groupIsMember $ isMemberTrue events] - $ tabulate "IsMember: at least one True" - [show $ isMemberTrue' events] $ tabulate "Successors" (tagGetSuccessors events) - $ tabulate "Predecessor" - (tagGetPredecessor events) $ prop where dbm = initDBModel maxBlocksPerFile @@ -727,18 +713,9 @@ isMemberTrue events = sum $ count <$> events where count :: Event Symbolic -> Int count e = case eventMockResp e of - Resp (Left _) -> 0 - Resp (Right (IsMember ls)) -> length $ filter id ls - Resp (Right _) -> 0 - -isMemberTrue' :: [Event Symbolic] -> Int -isMemberTrue' events = sum $ count <$> events - where - count :: Event Symbolic -> Int - count e = case eventMockResp e of - Resp (Left _) -> 0 - Resp (Right (IsMember ls)) -> if null ls then 0 else 1 - Resp (Right _) -> 0 + Resp (Left _) -> 0 + Resp (Right (BlockInfos ls)) -> length $ catMaybes ls + Resp (Right _) -> 0 data Tag = -- | Request a block successfully @@ -811,15 +788,6 @@ tagGetSuccessors = mapMaybe f else Just "Non empty Successors" _otherwise -> Nothing -tagGetPredecessor :: [Event Symbolic] -> [String] -tagGetPredecessor = mapMaybe f - where - f :: Event Symbolic -> Maybe String - f ev = case (getCmd ev, eventMockResp ev) of - (GetPredecessor _pid, Resp (Right (Predecessor _))) -> - Just "Predecessor" - _otherwise -> Nothing - execCmd :: Model Symbolic -> Command (At CmdErr) (At Resp) -> Event Symbolic