Skip to content
Permalink
Browse files

Implement ChainDB.pointOnChain

  • Loading branch information...
mrBliss committed May 15, 2019
1 parent 93d381e commit 73f7a2f00a0ea3dbc82ce0f1cf5f0c92a2aa06a6
Showing with 26 additions and 1 deletion.
  1. +26 −1 ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl.hs
@@ -18,6 +18,7 @@ import Codec.CBOR.Decoding (Decoder)
import Codec.CBOR.Encoding (Encoding)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust)
import Data.Set (Set)
import qualified Data.Set as Set

@@ -239,7 +240,7 @@ openDB args = do
, readBlocks = undefined
, readHeaders = undefined
, knownInvalidBlocks = cdbKnownInvalidBlocks env
, pointOnChain = undefined
, pointOnChain = cdbPointOnChain env
}
where
(argsImmDb, argsVolDb, argsLgrDb) = fromChainDbArgs args
@@ -329,6 +330,30 @@ cdbStreamBlocks cdb@CDB{..} =
modifyTVar' cdbNextIteratorId succ
return newIteratorId

cdbPointOnChain :: ( MonadCatch m
, MonadSTM m
, HasHeader blk
, HasHeader hdr
, HeaderHash hdr ~ HeaderHash blk
)
=> ChainDbEnv m blk hdr
-> Point blk -> m Bool
cdbPointOnChain cdb@CDB{..} pt = do
currentChain <- atomically $ cdbGetCurrentChain cdb
case Fragment.withinFragmentBounds (Block.castPoint pt) currentChain of
True -> return True
False
| pointSlot pt >= pointSlot (Fragment.anchorPoint currentChain)
-- The slot was more recent than the slot of the tip of the
-- ImmutableDB and yet the point wasn't on the current chain: it
-- must be on a fork.
-> return False
| otherwise
-- Unfortunately, we can't avoid reading the whole block, that's the
-- only way to check its hash.
-> isJust <$> ImmDB.getBlockWithPoint cdbImmDB pt


{-------------------------------------------------------------------------------
Lower level functionality

0 comments on commit 73f7a2f

Please sign in to comment.
You can’t perform that action at this time.