Fix order in range queries

Author: jasagredo

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs

@@ -1337,17 +1337,12 @@ answerShelleyTraversingQueries ejTxOut ejTxIn filt cfg q forker = case q of
         )
         vs
 
-  vnull :: ValuesMK k v -> Bool
-  vnull (ValuesMK vs) = Map.null vs
-
-  toMaxKey (LedgerTables (ValuesMK vs)) = fst $ Map.findMax vs
-
   loop queryPredicate !prev !acc = do
-    extValues <- LedgerDB.roforkerRangeReadTables forker prev
-    if ltcollapse $ ltmap (K2 . vnull) extValues
-      then pure acc
-      else
+    (extValues, k) <- LedgerDB.roforkerRangeReadTables forker prev
+    case k of
+      Nothing -> pure acc
+      Just k' ->
         loop
           queryPredicate
-          (PreviousQueryWasUpTo $ toMaxKey extValues)
+          (PreviousQueryWasUpTo k')
           (combUtxo acc $ partial queryPredicate extValues)

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

@@ -55,6 +55,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.Forker
   , TraceValidateEvent (..)
   ) where
 
+import Data.Bifunctor (first)
 import Control.Monad (void)
 import Control.Monad.Base
 import Control.Monad.Except
@@ -105,7 +106,7 @@ data Forker m l blk = Forker
 
     forkerReadTables :: !(LedgerTables l KeysMK -> m (LedgerTables l ValuesMK))
   -- ^ Read ledger tables from disk.
-  , forkerRangeReadTables :: !(RangeQueryPrevious l -> m (LedgerTables l ValuesMK))
+  , forkerRangeReadTables :: !(RangeQueryPrevious l -> m (LedgerTables l ValuesMK, Maybe (TxIn l)))
   -- ^ Range-read ledger tables from disk.
   --
   -- This range read will return as many values as the 'QueryBatchSize' that
@@ -206,7 +207,7 @@ ledgerStateReadOnlyForker frk =
   ReadOnlyForker
     { roforkerClose = roforkerClose
     , roforkerReadTables = fmap castLedgerTables . roforkerReadTables . castLedgerTables
-    , roforkerRangeReadTables = fmap castLedgerTables . roforkerRangeReadTables . castRangeQueryPrevious
+    , roforkerRangeReadTables = fmap (first castLedgerTables) . roforkerRangeReadTables . castRangeQueryPrevious
     , roforkerGetLedgerState = ledgerState <$> roforkerGetLedgerState
     , roforkerReadStatistics = roforkerReadStatistics
     }
@@ -239,7 +240,7 @@ data ReadOnlyForker m l blk = ReadOnlyForker
   -- ^ See 'forkerClose'
   , roforkerReadTables :: !(LedgerTables l KeysMK -> m (LedgerTables l ValuesMK))
   -- ^ See 'forkerReadTables'
-  , roforkerRangeReadTables :: !(RangeQueryPrevious l -> m (LedgerTables l ValuesMK))
+  , roforkerRangeReadTables :: !(RangeQueryPrevious l -> m (LedgerTables l ValuesMK, Maybe (TxIn l)))
   -- ^ See 'forkerRangeReadTables'.
   , roforkerGetLedgerState :: !(STM m (l EmptyMK))
   -- ^ See 'forkerGetLedgerState'

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

@@ -146,7 +146,7 @@ implForkerRangeReadTables ::
   QueryBatchSize ->
   ForkerEnv m l blk ->
   RangeQueryPrevious l ->
-  m (LedgerTables l ValuesMK)
+  m (LedgerTables l ValuesMK, Maybe (TxIn l))
 implForkerRangeReadTables qbs env rq0 = do
   traceWith (foeTracer env) ForkerRangeReadTablesStart
   ldb <- readTVarIO $ foeChangelog env
@@ -175,7 +175,8 @@ implForkerRangeReadTables qbs env rq0 = do
   bsvh <- getValueHandle env
   values <- BackingStore.bsvhRangeRead bsvh st (rq{BackingStore.rqCount = nrequested})
   traceWith (foeTracer env) ForkerRangeReadTablesEnd
-  pure $ ltliftA2 (doFixupReadResult nrequested) diffs values
+  let res@(LedgerTables (ValuesMK resValues)) = ltliftA2 (doFixupReadResult nrequested) diffs values
+  pure (res, fst <$> Map.lookupMax resValues)
  where
   rq = BackingStore.RangeQuery rq1 (fromIntegral $ defaultQueryBatchSize qbs)
 

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

@@ -85,15 +85,15 @@ implForkerRangeReadTables ::
   QueryBatchSize ->
   ForkerEnv m l blk ->
   RangeQueryPrevious l ->
-  m (LedgerTables l ValuesMK)
+  m (LedgerTables l ValuesMK, Maybe (TxIn l))
 implForkerRangeReadTables qbs env rq0 = do
   traceWith (foeTracer env) ForkerRangeReadTablesStart
   ldb <- readTVarIO $ foeLedgerSeq env
   let n = fromIntegral $ defaultQueryBatchSize qbs
       stateRef = currentHandle ldb
   case rq0 of
     NoPreviousQuery -> readRange (tables stateRef) (state stateRef) (Nothing, n)
-    PreviousQueryWasFinal -> pure $ LedgerTables emptyMK
+    PreviousQueryWasFinal -> pure (LedgerTables emptyMK, Nothing)
     PreviousQueryWasUpTo k -> do
       tbs <- readRange (tables stateRef) (state stateRef) (Just k, n)
       traceWith (foeTracer env) ForkerRangeReadTablesEnd

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs

@@ -112,7 +112,8 @@ newInMemoryLedgerTablesHandle tracer someFS@(SomeHasFS hasFS) l = do
           guardClosed
             hs
             ( \(LedgerTables (ValuesMK m)) ->
-                pure . LedgerTables . ValuesMK . Map.take t . (maybe id (\g -> snd . Map.split g) f) $ m
+                let m' = Map.take t . (maybe id (\g -> snd . Map.split g) f) $ m
+                in pure (LedgerTables (ValuesMK m'), fst <$> Map.lookupMax m')
             )
       , readAll = \_ -> do
           hs <- readTVarIO tv

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs

@@ -167,12 +167,9 @@ newLSMLedgerTablesHandle tracer rr session (resKey, t0) = do
       , readRange = implReadRange tv
       , readAll = \st ->
           let readAll' m = do
-                v@(LedgerTables (ValuesMK values)) <- implReadRange tv st (m, 100000)
-                maybe (pure v) (\k -> fmap (ltliftA2 unionValues v) $ readAll' (Just $ fst k)) $
-                  Map.lookupMax values
-           in -- TODO!! Be careful with the order of the keys, the last in the map
-              -- is maybe not the last in the serialized form
-              readAll' Nothing
+                (v, n) <- implReadRange tv st (m, 100000)
+                maybe (pure v) (\k -> fmap (ltliftA2 unionValues v) $ readAll' (Just k)) n
+           in readAll' Nothing
       , pushDiffs = const (implPushDiffs tv)
       , takeHandleSnapshot = \_ snapshotName -> do
           guardClosed tv $
@@ -181,16 +178,14 @@ newLSMLedgerTablesHandle tracer rr session (resKey, t0) = do
       , tablesSize = pure Nothing
       }
 
--- TODO: use bytestrings as values
-
 implReadRange ::
   IOLike m =>
   HasLedgerTables l =>
   GoodForLSM l =>
   StrictTVar m (LedgerTablesHandleState m l) ->
   l EmptyMK ->
   (Maybe (TxIn l), Int) ->
-  m (LedgerTables l ValuesMK)
+  m (LedgerTables l ValuesMK, Maybe (TxIn l))
 implReadRange tv st = \(mPrev, num) ->
   guardClosed
     tv
@@ -200,9 +195,15 @@ implReadRange tv st = \(mPrev, num) ->
           cursorFromKey k = fmap (V.drop 1) $ LSM.withCursorAtOffset table k (LSM.take $ num + 1)
          in
           do
-            entries <- maybe cursorFromStart cursorFromKey mPrev
-            pure . LedgerTables . ValuesMK . Map.fromList $
-              [(k, (fromLSMTxOut st v)) | LSM.Entry k v <- V.toList entries]
+            entries <- V.toList <$> maybe cursorFromStart cursorFromKey mPrev
+            pure (LedgerTables . ValuesMK . Map.fromList $
+              [(k, (fromLSMTxOut st v)) | LSM.Entry k v <- entries ]
+                 , case snd <$> List.unsnoc entries of
+                     Nothing -> Nothing
+                     Just (LSM.Entry k _) -> Just k
+                     Just (LSM.EntryWithBlob k _ _) -> Just k
+
+                     )
     )
 
 implPushDiffs ::

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/LedgerSeq.hs

@@ -86,7 +86,7 @@ data LedgerTablesHandle m l = LedgerTablesHandle
   , duplicate :: !(m (LedgerTablesHandle m l))
   -- ^ It is expected that this operation takes constant time.
   , read :: !(l EmptyMK -> LedgerTables l KeysMK -> m (LedgerTables l ValuesMK))
-  , readRange :: !(l EmptyMK -> (Maybe (TxIn l), Int) -> m (LedgerTables l ValuesMK))
+  , readRange :: !(l EmptyMK -> (Maybe (TxIn l), Int) -> m (LedgerTables l ValuesMK, Maybe (TxIn l)))
   , readAll :: !(l EmptyMK -> m (LedgerTables l ValuesMK))
   -- ^ Costly read all operation, not to be used in Consensus but only in
   -- snapshot-converter executable.