Skip to content

Commit a8fd47b

Browse files
jasagredojasagredo
committed
Only open a V1 ValueHandle when we perform UTxO operations
1 parent b9b8703 commit a8fd47b

File tree

4 files changed

+109
-57
lines changed

4 files changed

+109
-57
lines changed

‎ouroboros-consensus/changelog.d/20250617_113413_javier.sagredo_only_vh_second_try.md‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
<!--
2+
A new scriv changelog fragment.
3+
4+
Uncomment the section that is right (remove the HTML comment wrapper).
5+
-->
6+
7+
<!--
8+
### Patch
9+
10+
- A bullet item for the Patch category.
11+
12+
-->
13+
14+
### Non-Breaking
15+
16+
- Only open BackingStore ValueHandles in V1 when we perform a UTxO operation.
17+
18+
19+
<!--
20+
### Breaking
21+
22+
- A bullet item for the Breaking category.
23+
24+
-->

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1.hs‎

Lines changed: 25 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@
99
{-# LANGUAGE ScopedTypeVariables #-}
1010
{-# LANGUAGE StandaloneDeriving #-}
1111
{-# LANGUAGE StandaloneKindSignatures #-}
12-
{-# LANGUAGE TupleSections #-}
1312
{-# LANGUAGE TypeApplications #-}
1413
{-# LANGUAGE TypeFamilies #-}
1514
{-# LANGUAGE TypeOperators #-}
@@ -670,8 +669,11 @@ newForkerAtTarget ::
670669
Target (Point blk) ->
671670
m (Either GetForkerError (Forker m l blk))
672671
newForkerAtTarget h rr pt = getEnv h $ \ldbEnv ->
673-
withReadLock (ldbLock ldbEnv) (acquireAtTarget ldbEnv rr (Right pt))
674-
>>= traverse (newForker h ldbEnv)
672+
withReadLock
673+
(ldbLock ldbEnv)
674+
( acquireAtTarget ldbEnv (Right pt)
675+
>>= traverse (newForker h ldbEnv rr)
676+
)
675677

676678
newForkerByRollback ::
677679
( HeaderHash l ~ HeaderHash blk
@@ -687,7 +689,7 @@ newForkerByRollback ::
687689
Word64 ->
688690
m (Either GetForkerError (Forker m l blk))
689691
newForkerByRollback h rr n = getEnv h $ \ldbEnv -> do
690-
withReadLock (ldbLock ldbEnv) (acquireAtTarget ldbEnv rr (Left n)) >>= traverse (newForker h ldbEnv)
692+
withReadLock (ldbLock ldbEnv) (acquireAtTarget ldbEnv (Left n) >>= traverse (newForker h ldbEnv rr))
691693

692694
-- | Close all open block and header 'Forker's.
693695
closeAllForkers ::
@@ -704,9 +706,6 @@ closeAllForkers ldbEnv =
704706
where
705707
forkersVar = ldbForkers ldbEnv
706708

707-
type Resources m l =
708-
(LedgerBackingStoreValueHandle m l, DbChangelog l)
709-
710709
-- | Acquire both a value handle and a db changelog at the tip. Holds a read lock
711710
-- while doing so.
712711
acquireAtTarget ::
@@ -719,13 +718,12 @@ acquireAtTarget ::
719718
, LedgerSupportsProtocol blk
720719
) =>
721720
LedgerDBEnv m l blk ->
722-
ResourceRegistry m ->
723721
Either Word64 (Target (Point blk)) ->
724-
ReadLocked m (Either GetForkerError (Resources m l))
725-
acquireAtTarget ldbEnv rr target = readLocked $ runExceptT $ do
722+
ReadLocked m (Either GetForkerError (DbChangelog l))
723+
acquireAtTarget ldbEnv target = readLocked $ runExceptT $ do
726724
dblog <- lift $ readTVarIO (ldbChangelog ldbEnv)
727725
-- Get the prefix of the dblog ending in the specified target.
728-
dblog' <- case target of
726+
case target of
729727
Right VolatileTip -> pure dblog
730728
Right ImmutableTip -> pure $ rollbackToAnchor dblog
731729
Right (SpecificPoint pt) -> do
@@ -745,30 +743,6 @@ acquireAtTarget ldbEnv rr target = readLocked $ runExceptT $ do
745743
, rollbackRequested = n
746744
}
747745
Just dblog' -> pure dblog'
748-
lift $ (,dblog') <$> acquire ldbEnv rr dblog'
749-
750-
acquire ::
751-
(IOLike m, GetTip l) =>
752-
LedgerDBEnv m l blk ->
753-
ResourceRegistry m ->
754-
DbChangelog l ->
755-
m (LedgerBackingStoreValueHandle m l)
756-
acquire ldbEnv rr dblog = do
757-
-- bsvhClose is idempotent, so we let the resource call it even if the value
758-
-- handle might have been closed somewhere else
759-
(_, vh) <- allocate rr (\_ -> bsValueHandle $ ldbBackingStore ldbEnv) bsvhClose
760-
let dblogSlot = getTipSlot (changelogLastFlushedState dblog)
761-
if bsvhAtSlot vh == dblogSlot
762-
then pure vh
763-
else
764-
bsvhClose vh
765-
>> error
766-
( "Critical error: Value handles are created at "
767-
<> show (bsvhAtSlot vh)
768-
<> " while the db changelog is at "
769-
<> show dblogSlot
770-
<> ". There is either a race condition or a logic bug"
771-
)
772746

773747
{-------------------------------------------------------------------------------
774748
Make forkers from consistent views
@@ -783,21 +757,32 @@ newForker ::
783757
) =>
784758
LedgerDBHandle m l blk ->
785759
LedgerDBEnv m l blk ->
786-
Resources m l ->
787-
m (Forker m l blk)
788-
newForker h ldbEnv (vh, dblog) = do
760+
ResourceRegistry m ->
761+
DbChangelog l ->
762+
ReadLocked m (Forker m l blk)
763+
newForker h ldbEnv rr dblog = readLocked $ do
789764
dblogVar <- newTVarIO dblog
790765
forkerKey <- atomically $ stateTVar (ldbNextForkerKey ldbEnv) $ \r -> (r, r + 1)
766+
forkerMVar <- newMVar $ Left (ldbLock ldbEnv, ldbBackingStore ldbEnv, rr)
791767
let forkerEnv =
792768
ForkerEnv
793-
{ foeBackingStoreValueHandle = vh
769+
{ foeBackingStoreValueHandle = forkerMVar
794770
, foeChangelog = dblogVar
795771
, foeSwitchVar = ldbChangelog ldbEnv
796772
, foeSecurityParam = ledgerDbCfgSecParam $ ldbCfg ldbEnv
797773
, foeTracer =
798774
LedgerDBForkerEvent . TraceForkerEventWithKey forkerKey >$< ldbTracer ldbEnv
799775
}
800-
atomically $ modifyTVar (ldbForkers ldbEnv) $ Map.insert forkerKey forkerEnv
776+
atomically $ do
777+
-- We need to make sure to release this read access when we drop the value
778+
-- handle, so in 'closeForkerEnv' (if it wasn't promoted) or in
779+
-- 'getValueHandle' (if it was promoted).
780+
unsafeAcquireReadAccess (ldbLock ldbEnv)
781+
782+
-- Note that we add the forkerEnv to the 'ldbForkers' so that an exception
783+
-- which will close all the forkers, also closes this one, releasing the
784+
-- read access we acquired above.
785+
modifyTVar (ldbForkers ldbEnv) $ Map.insert forkerKey forkerEnv
801786
traceWith (foeTracer forkerEnv) ForkerOpen
802787
pure $ mkForker h (ldbQueryBatchSize ldbEnv) forkerKey
803788

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Forker.hs‎

Lines changed: 52 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE DeriveAnyClass #-}
22
{-# LANGUAGE DeriveGeneric #-}
33
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE LambdaCase #-}
45
{-# LANGUAGE NamedFieldPuns #-}
56
{-# LANGUAGE ScopedTypeVariables #-}
67
{-# LANGUAGE StandaloneDeriving #-}
@@ -18,6 +19,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V1.Forker
1819
, implForkerReadTables
1920
) where
2021

22+
import Control.ResourceRegistry
2123
import Control.Tracer
2224
import qualified Data.Map.Strict as Map
2325
import Data.Semigroup
@@ -40,15 +42,25 @@ import Ouroboros.Consensus.Storage.LedgerDB.V1.DiffSeq
4042
, numInserts
4143
)
4244
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.DiffSeq as DS
45+
import Ouroboros.Consensus.Storage.LedgerDB.V1.Lock
4346
import Ouroboros.Consensus.Util.IOLike
4447

4548
{-------------------------------------------------------------------------------
4649
Forkers
4750
-------------------------------------------------------------------------------}
4851

4952
data ForkerEnv m l blk = ForkerEnv
50-
{ foeBackingStoreValueHandle :: !(LedgerBackingStoreValueHandle m l)
51-
-- ^ Local, consistent view of backing store
53+
{ foeBackingStoreValueHandle ::
54+
!( StrictMVar
55+
m
56+
( Either
57+
(LedgerDBLock m, LedgerBackingStore m l, ResourceRegistry m)
58+
(LedgerBackingStoreValueHandle m l)
59+
)
60+
)
61+
-- ^ Either the ingredients to create a value handle or a value handle, i.e. a
62+
-- local, consistent view of backing store. Use 'getValueHandle' to promote
63+
-- this if needed.
5264
, foeChangelog :: !(StrictTVar m (DbChangelog l))
5365
-- ^ In memory db changelog, 'foeBackingStoreValueHandle' must refer to
5466
-- the anchor of this changelog.
@@ -77,32 +89,58 @@ deriving instance
7789
Close
7890
-------------------------------------------------------------------------------}
7991

80-
closeForkerEnv :: ForkerEnv m l blk -> m ()
81-
closeForkerEnv ForkerEnv{foeBackingStoreValueHandle} = bsvhClose foeBackingStoreValueHandle
92+
closeForkerEnv :: IOLike m => ForkerEnv m l blk -> m ()
93+
closeForkerEnv ForkerEnv{foeBackingStoreValueHandle} = do
94+
either (\(l, _, _) -> atomically . unsafeReleaseReadAccess $ l) bsvhClose
95+
=<< takeMVar foeBackingStoreValueHandle
8296

8397
{-------------------------------------------------------------------------------
8498
Acquiring consistent views
8599
-------------------------------------------------------------------------------}
86100

101+
-- | Get the value handle in a forker, creating it on demand if this is the
102+
-- first time we access the tables.
103+
getValueHandle :: (GetTip l, IOLike m) => ForkerEnv m l blk -> m (LedgerBackingStoreValueHandle m l)
104+
getValueHandle ForkerEnv{foeBackingStoreValueHandle, foeChangelog} =
105+
modifyMVar foeBackingStoreValueHandle $ \case
106+
r@(Right bsvh) -> pure (r, bsvh)
107+
Left (l, bs, rr) -> do
108+
-- bsvhClose is idempotent, so we let the resource call it even if the value
109+
-- handle might have been closed somewhere else
110+
(_, bsvh) <- allocate rr (\_ -> bsValueHandle bs) bsvhClose
111+
dblogSlot <- getTipSlot . changelogLastFlushedState <$> readTVarIO foeChangelog
112+
if bsvhAtSlot bsvh == dblogSlot
113+
then do
114+
atomically $ unsafeReleaseReadAccess l
115+
pure (Right bsvh, bsvh)
116+
else
117+
bsvhClose bsvh
118+
>> error
119+
( "Critical error: Value handles are created at "
120+
<> show (bsvhAtSlot bsvh)
121+
<> " while the db changelog is at "
122+
<> show dblogSlot
123+
<> ". There is either a race condition or a logic bug"
124+
)
125+
87126
implForkerReadTables ::
88-
(MonadSTM m, HasLedgerTables l, GetTip l) =>
127+
(IOLike m, HasLedgerTables l, GetTip l) =>
89128
ForkerEnv m l blk ->
90129
LedgerTables l KeysMK ->
91130
m (LedgerTables l ValuesMK)
92131
implForkerReadTables env ks = do
93132
traceWith (foeTracer env) ForkerReadTablesStart
94133
chlog <- readTVarIO (foeChangelog env)
95-
unfwd <- readKeySetsWith lvh (changelogLastFlushedState chlog) ks
134+
bsvh <- getValueHandle env
135+
unfwd <- readKeySetsWith bsvh (changelogLastFlushedState chlog) ks
96136
case forwardTableKeySets chlog unfwd of
97137
Left _err -> error "impossible!"
98138
Right vs -> do
99139
traceWith (foeTracer env) ForkerReadTablesEnd
100140
pure vs
101-
where
102-
lvh = foeBackingStoreValueHandle env
103141

104142
implForkerRangeReadTables ::
105-
(MonadSTM m, HasLedgerTables l) =>
143+
(IOLike m, GetTip l, HasLedgerTables l) =>
106144
QueryBatchSize ->
107145
ForkerEnv m l blk ->
108146
RangeQueryPrevious l ->
@@ -132,12 +170,11 @@ implForkerRangeReadTables qbs env rq0 = do
132170
nrequested = 1 + max (BackingStore.rqCount rq) (1 + maxDeletes)
133171

134172
let st = changelogLastFlushedState ldb
135-
values <- BackingStore.bsvhRangeRead lvh st (rq{BackingStore.rqCount = nrequested})
173+
bsvh <- getValueHandle env
174+
values <- BackingStore.bsvhRangeRead bsvh st (rq{BackingStore.rqCount = nrequested})
136175
traceWith (foeTracer env) ForkerRangeReadTablesEnd
137176
pure $ ltliftA2 (doFixupReadResult nrequested) diffs values
138177
where
139-
lvh = foeBackingStoreValueHandle env
140-
141178
rq = BackingStore.RangeQuery rq1 (fromIntegral $ defaultQueryBatchSize qbs)
142179

143180
rq1 = case rq0 of
@@ -230,15 +267,15 @@ implForkerGetLedgerState env = current <$> readTVar (foeChangelog env)
230267
-- | Obtain statistics for a combination of backing store value handle and
231268
-- changelog.
232269
implForkerReadStatistics ::
233-
(MonadSTM m, HasLedgerTables l, GetTip l) =>
270+
(IOLike m, HasLedgerTables l, GetTip l) =>
234271
ForkerEnv m l blk ->
235272
m (Maybe Forker.Statistics)
236273
implForkerReadStatistics env = do
237274
traceWith (foeTracer env) ForkerReadStatistics
238275
dblog <- readTVarIO (foeChangelog env)
239-
276+
bsvh <- getValueHandle env
240277
let seqNo = getTipSlot $ changelogLastFlushedState dblog
241-
BackingStore.Statistics{sequenceNumber = seqNo', numEntries = n} <- bsvhStat lbsvh
278+
BackingStore.Statistics{sequenceNumber = seqNo', numEntries = n} <- bsvhStat bsvh
242279
if seqNo /= seqNo'
243280
then
244281
error $
@@ -265,8 +302,6 @@ implForkerReadStatistics env = do
265302
Forker.Statistics
266303
{ ledgerTableSize = n + nInserts - nDeletes
267304
}
268-
where
269-
lbsvh = foeBackingStoreValueHandle env
270305

271306
implForkerPush ::
272307
(MonadSTM m, GetTip l, HasLedgerTables l) =>

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Lock.hs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,8 @@ module Ouroboros.Consensus.Storage.LedgerDB.V1.Lock
1717
, withReadLock
1818
, withWriteLock
1919
, writeLocked
20+
, unsafeAcquireReadAccess
21+
, unsafeReleaseReadAccess
2022
) where
2123

2224
import qualified Control.RAWLock as Lock
@@ -85,3 +87,9 @@ writeLocked = WriteLocked
8587
withWriteLock :: IOLike m => LedgerDBLock m -> WriteLocked m a -> m a
8688
withWriteLock (LedgerDBLock lock) m =
8789
Lock.withWriteAccess lock (\() -> (,()) <$> runWriteLocked m)
90+
91+
unsafeAcquireReadAccess :: IOLike m => LedgerDBLock m -> STM m ()
92+
unsafeAcquireReadAccess (LedgerDBLock lock) = Lock.unsafeAcquireReadAccess lock
93+
94+
unsafeReleaseReadAccess :: IOLike m => LedgerDBLock m -> STM m ()
95+
unsafeReleaseReadAccess (LedgerDBLock lock) = Lock.unsafeReleaseReadAccess lock

0 commit comments

Comments
 (0)