{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Read operations of LeiosDB's SQLite backend.
--
-- Each lookup asks the volatile
-- partition first and falls back to the immutable one for EBs that were
-- copied evicted.
module Ouroboros.Consensus.Storage.LeiosDB.Impl.SQLite.Read
  ( sqlScanEbPoints
  , sqlScanCompleteEbPointsSince
  , sqlLookupEbBody
  , sqlBatchRetrieveTxs
  , sqlLookupEbClosure
  ) where

import Cardano.Slotting.Slot (SlotNo (..))
import Data.ByteString (ByteString)
import qualified Data.Set as Set
import qualified Database.SQLite3.Direct as DB
import Ouroboros.Consensus.Leios.Types
  ( BytesSize
  , EbHash (..)
  , LeiosPoint (..)
  , TxHash (..)
  )
import Ouroboros.Consensus.Storage.LeiosDB.Impl.SQLite.Connection (Conn (..))
import Ouroboros.Consensus.Storage.LeiosDB.Impl.SQLite.Primitives
import Ouroboros.Consensus.Storage.LeiosDB.Impl.SQLite.Queries
import Ouroboros.Consensus.Storage.LeiosDB.Impl.SQLite.Statements

sqlScanEbPoints :: Conn -> IO [(SlotNo, EbHash)]
sqlScanEbPoints :: Conn -> IO [(SlotNo, EbHash)]
sqlScanEbPoints Conn
conn =
  Database -> IO [(SlotNo, EbHash)] -> IO [(SlotNo, EbHash)]
forall a. HasCallStack => Database -> IO a -> IO a
dbWithTransaction Database
db (IO [(SlotNo, EbHash)] -> IO [(SlotNo, EbHash)])
-> IO [(SlotNo, EbHash)] -> IO [(SlotNo, EbHash)]
forall a b. (a -> b) -> a -> b
$ Statement -> IO [(SlotNo, EbHash)] -> IO [(SlotNo, EbHash)]
forall a. Statement -> IO a -> IO a
useStmt Statement
stmt (IO [(SlotNo, EbHash)] -> IO [(SlotNo, EbHash)])
-> IO [(SlotNo, EbHash)] -> IO [(SlotNo, EbHash)]
forall a b. (a -> b) -> a -> b
$ [(SlotNo, EbHash)] -> IO [(SlotNo, EbHash)]
loop []
 where
  Conn{conVolDb :: Conn -> Database
conVolDb = Database
db, connVolStmts :: Conn -> VolStmts
connVolStmts = VolStmts{stScanEbPoints :: VolStmts -> Statement
stScanEbPoints = Statement
stmt}} = Conn
conn
  loop :: [(SlotNo, EbHash)] -> IO [(SlotNo, EbHash)]
loop [(SlotNo, EbHash)]
acc =
    HasCallStack => Statement -> IO StepResult
Statement -> IO StepResult
dbStep Statement
stmt IO StepResult
-> (StepResult -> IO [(SlotNo, EbHash)]) -> IO [(SlotNo, EbHash)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      StepResult
DB.Done -> [(SlotNo, EbHash)] -> IO [(SlotNo, EbHash)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(SlotNo, EbHash)] -> [(SlotNo, EbHash)]
forall a. [a] -> [a]
reverse [(SlotNo, EbHash)]
acc)
      StepResult
DB.Row -> do
        slot <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> (Int64 -> Word64) -> Int64 -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> SlotNo) -> IO Int64 -> IO SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnIndex -> IO Int64
DB.columnInt64 Statement
stmt ColumnIndex
0
        hash <- MkEbHash <$> DB.columnBlob stmt 1
        loop ((slot, hash) : acc)

sqlScanCompleteEbPointsSince :: Conn -> SlotNo -> IO [LeiosPoint]
sqlScanCompleteEbPointsSince :: Conn -> SlotNo -> IO [LeiosPoint]
sqlScanCompleteEbPointsSince Conn
conn SlotNo
sinceSlot = do
  (volComplete, recent) <-
    Database
-> IO ([LeiosPoint], [LeiosPoint])
-> IO ([LeiosPoint], [LeiosPoint])
forall a. HasCallStack => Database -> IO a -> IO a
dbWithTransaction Database
db (IO ([LeiosPoint], [LeiosPoint])
 -> IO ([LeiosPoint], [LeiosPoint]))
-> IO ([LeiosPoint], [LeiosPoint])
-> IO ([LeiosPoint], [LeiosPoint])
forall a b. (a -> b) -> a -> b
$ do
      volComplete <- Statement -> IO [LeiosPoint] -> IO [LeiosPoint]
forall a. Statement -> IO a -> IO a
useStmt Statement
stmt (IO [LeiosPoint] -> IO [LeiosPoint])
-> IO [LeiosPoint] -> IO [LeiosPoint]
forall a b. (a -> b) -> a -> b
$ do
        HasCallStack => Statement -> ParamIndex -> Int64 -> IO ()
Statement -> ParamIndex -> Int64 -> IO ()
dbBindInt64 Statement
stmt ParamIndex
1 Int64
slot
        Statement -> [LeiosPoint] -> IO [LeiosPoint]
accPointWith Statement
stmt []
      -- Every recent hash, with or without completeness evidence, from the
      -- same snapshot.
      recent <- withStmt db sql_scan_recent_ebs $ \Statement
recentStmt -> do
        HasCallStack => Statement -> ParamIndex -> Int64 -> IO ()
Statement -> ParamIndex -> Int64 -> IO ()
dbBindInt64 Statement
recentStmt ParamIndex
1 Int64
slot
        Statement -> [LeiosPoint] -> IO [LeiosPoint]
accPointWith Statement
recentStmt []
      pure (volComplete, recent)
  -- A recent hash without volatile completeness evidence may be a copied EB
  -- whose closure rows were evicted (its recent announcement never got a body
  -- insert). Presence in the immutable partition is proof of completeness:
  -- copies are atomic and only complete EBs are copied. Without this probe, a
  -- cert-RB parked across a restart would stay parked forever.
  let volCompleteSet = [ByteString] -> Set ByteString
forall a. Ord a => [a] -> Set a
Set.fromList [EbHash -> ByteString
ebHashBytes (LeiosPoint -> EbHash
pointEbHash LeiosPoint
p) | LeiosPoint
p <- [LeiosPoint]
volComplete]
      unknown = [LeiosPoint
p | LeiosPoint
p <- [LeiosPoint]
recent, EbHash -> ByteString
ebHashBytes (LeiosPoint -> EbHash
pointEbHash LeiosPoint
p) ByteString -> Set ByteString -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set ByteString
volCompleteSet]
  if null unknown
    then pure volComplete
    else do
      present <- immFilterPresent conn [ebHashBytes (pointEbHash p) | p <- unknown]
      let presentSet = [ByteString] -> Set ByteString
forall a. Ord a => [a] -> Set a
Set.fromList [ByteString]
present
      pure $
        volComplete
          <> [p | p <- unknown, ebHashBytes (pointEbHash p) `Set.member` presentSet]
 where
  slot :: Int64
slot = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
sinceSlot
  Conn{conVolDb :: Conn -> Database
conVolDb = Database
db, connVolStmts :: Conn -> VolStmts
connVolStmts = VolStmts{stScanCompleteEbsSince :: VolStmts -> Statement
stScanCompleteEbsSince = Statement
stmt}} = Conn
conn

  accPointWith :: DB.Statement -> [LeiosPoint] -> IO [LeiosPoint]
  accPointWith :: Statement -> [LeiosPoint] -> IO [LeiosPoint]
accPointWith Statement
pointsStmt [LeiosPoint]
acc =
    HasCallStack => Statement -> IO StepResult
Statement -> IO StepResult
dbStep Statement
pointsStmt IO StepResult -> (StepResult -> IO [LeiosPoint]) -> IO [LeiosPoint]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      StepResult
DB.Done -> [LeiosPoint] -> IO [LeiosPoint]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([LeiosPoint] -> [LeiosPoint]
forall a. [a] -> [a]
reverse [LeiosPoint]
acc)
      StepResult
DB.Row -> do
        ebSlot <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> (Int64 -> Word64) -> Int64 -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> SlotNo) -> IO Int64 -> IO SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnIndex -> IO Int64
DB.columnInt64 Statement
pointsStmt ColumnIndex
0
        hash <- MkEbHash <$> DB.columnBlob pointsStmt 1
        accPointWith pointsStmt (MkLeiosPoint ebSlot hash : acc)

-- | Which of the given EB hashes the immutable partition holds.
immFilterPresent :: Conn -> [ByteString] -> IO [ByteString]
immFilterPresent :: Conn -> [ByteString] -> IO [ByteString]
immFilterPresent Conn
conn [ByteString]
hashes =
  Statement -> IO [ByteString] -> IO [ByteString]
forall a. Statement -> IO a -> IO a
useStmt Statement
stmt (IO [ByteString] -> IO [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ do
    HasCallStack => Statement -> ParamIndex -> ByteString -> IO ()
Statement -> ParamIndex -> ByteString -> IO ()
dbBindUtf8 Statement
stmt ParamIndex
1 ([ByteString] -> ByteString
jsonHexArray [ByteString]
hashes)
    let loop :: [ByteString] -> IO [ByteString]
loop [ByteString]
acc =
          HasCallStack => Statement -> IO StepResult
Statement -> IO StepResult
dbStep Statement
stmt IO StepResult -> (StepResult -> IO [ByteString]) -> IO [ByteString]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            StepResult
DB.Done -> [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc)
            StepResult
DB.Row -> do
              hashBytes <- Statement -> ColumnIndex -> IO ByteString
DB.columnBlob Statement
stmt ColumnIndex
0
              loop (hashBytes : acc)
    [ByteString] -> IO [ByteString]
loop []
 where
  Conn{connImmStmts :: Conn -> ImmStmts
connImmStmts = ImmStmts{immStFilterPresent :: ImmStmts -> Statement
immStFilterPresent = Statement
stmt}} = Conn
conn

sqlLookupEbBody :: Conn -> EbHash -> IO [(TxHash, BytesSize)]
sqlLookupEbBody :: Conn -> EbHash -> IO [(TxHash, Word32)]
sqlLookupEbBody Conn
conn EbHash
ebHash = do
  vol <-
    Database -> IO [(TxHash, Word32)] -> IO [(TxHash, Word32)]
forall a. HasCallStack => Database -> IO a -> IO a
dbWithTransaction Database
db (IO [(TxHash, Word32)] -> IO [(TxHash, Word32)])
-> IO [(TxHash, Word32)] -> IO [(TxHash, Word32)]
forall a b. (a -> b) -> a -> b
$ Statement -> IO [(TxHash, Word32)] -> IO [(TxHash, Word32)]
forall a. Statement -> IO a -> IO a
useStmt Statement
stmt (IO [(TxHash, Word32)] -> IO [(TxHash, Word32)])
-> IO [(TxHash, Word32)] -> IO [(TxHash, Word32)]
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => Statement -> ParamIndex -> ByteString -> IO ()
Statement -> ParamIndex -> ByteString -> IO ()
dbBindBlob Statement
stmt ParamIndex
1 (let MkEbHash ByteString
bytes = EbHash
ebHash in ByteString
bytes)
      Statement -> [(TxHash, Word32)] -> IO [(TxHash, Word32)]
bodyLoop Statement
stmt []
  -- Bodies insert atomically, so the empty list is a complete miss: the EB
  -- may have been copied to the immutable partition and evicted.
  if null vol then immLookupEbBody conn ebHash else pure vol
 where
  Conn{conVolDb :: Conn -> Database
conVolDb = Database
db, connVolStmts :: Conn -> VolStmts
connVolStmts = VolStmts{stLookupEbBody :: VolStmts -> Statement
stLookupEbBody = Statement
stmt}} = Conn
conn

-- | Immutable-partition fallback of 'sqlLookupEbBody'.
immLookupEbBody :: Conn -> EbHash -> IO [(TxHash, BytesSize)]
immLookupEbBody :: Conn -> EbHash -> IO [(TxHash, Word32)]
immLookupEbBody Conn
conn EbHash
ebHash =
  Statement -> IO [(TxHash, Word32)] -> IO [(TxHash, Word32)]
forall a. Statement -> IO a -> IO a
useStmt Statement
stmt (IO [(TxHash, Word32)] -> IO [(TxHash, Word32)])
-> IO [(TxHash, Word32)] -> IO [(TxHash, Word32)]
forall a b. (a -> b) -> a -> b
$ do
    HasCallStack => Statement -> ParamIndex -> ByteString -> IO ()
Statement -> ParamIndex -> ByteString -> IO ()
dbBindBlob Statement
stmt ParamIndex
1 (let MkEbHash ByteString
bytes = EbHash
ebHash in ByteString
bytes)
    Statement -> [(TxHash, Word32)] -> IO [(TxHash, Word32)]
bodyLoop Statement
stmt []
 where
  Conn{connImmStmts :: Conn -> ImmStmts
connImmStmts = ImmStmts{immStLookupEbBody :: ImmStmts -> Statement
immStLookupEbBody = Statement
stmt}} = Conn
conn

bodyLoop :: DB.Statement -> [(TxHash, BytesSize)] -> IO [(TxHash, BytesSize)]
bodyLoop :: Statement -> [(TxHash, Word32)] -> IO [(TxHash, Word32)]
bodyLoop Statement
stmt [(TxHash, Word32)]
acc =
  HasCallStack => Statement -> IO StepResult
Statement -> IO StepResult
dbStep Statement
stmt IO StepResult
-> (StepResult -> IO [(TxHash, Word32)]) -> IO [(TxHash, Word32)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    StepResult
DB.Done -> [(TxHash, Word32)] -> IO [(TxHash, Word32)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(TxHash, Word32)] -> [(TxHash, Word32)]
forall a. [a] -> [a]
reverse [(TxHash, Word32)]
acc)
    StepResult
DB.Row -> do
      txHash <- ByteString -> TxHash
MkTxHash (ByteString -> TxHash) -> IO ByteString -> IO TxHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnIndex -> IO ByteString
DB.columnBlob Statement
stmt ColumnIndex
0
      size <- fromIntegral <$> DB.columnInt64 stmt 1
      bodyLoop stmt ((txHash, size) : acc)

-- | Retrieve tx bytes for a batch of @(ebHash, txOffset)@ points. Passes
-- the offsets list as a JSON int array bound to a single parameter;
-- SQLite's 'json_each' virtual table joins it against 'ebTxs' + 'txs'.
--
-- No temp tables, no attached databases, no per-item INSERT round-trips.
-- Works on strictly read-only connections.
sqlBatchRetrieveTxs ::
  Conn ->
  EbHash ->
  [Int] ->
  IO [(Int, TxHash, Maybe ByteString)]
sqlBatchRetrieveTxs :: Conn -> EbHash -> [Int] -> IO [(Int, TxHash, Maybe ByteString)]
sqlBatchRetrieveTxs Conn
conn EbHash
ebHash [Int]
offsets = do
  vol <-
    Database
-> IO [(Int, TxHash, Maybe ByteString)]
-> IO [(Int, TxHash, Maybe ByteString)]
forall a. HasCallStack => Database -> IO a -> IO a
dbWithTransaction Database
db (IO [(Int, TxHash, Maybe ByteString)]
 -> IO [(Int, TxHash, Maybe ByteString)])
-> IO [(Int, TxHash, Maybe ByteString)]
-> IO [(Int, TxHash, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ Statement
-> IO [(Int, TxHash, Maybe ByteString)]
-> IO [(Int, TxHash, Maybe ByteString)]
forall a. Statement -> IO a -> IO a
useStmt Statement
stmt (IO [(Int, TxHash, Maybe ByteString)]
 -> IO [(Int, TxHash, Maybe ByteString)])
-> IO [(Int, TxHash, Maybe ByteString)]
-> IO [(Int, TxHash, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => Statement -> ParamIndex -> ByteString -> IO ()
Statement -> ParamIndex -> ByteString -> IO ()
dbBindBlob Statement
stmt ParamIndex
1 (let MkEbHash ByteString
bytes = EbHash
ebHash in ByteString
bytes)
      HasCallStack => Statement -> ParamIndex -> ByteString -> IO ()
Statement -> ParamIndex -> ByteString -> IO ()
dbBindUtf8 Statement
stmt ParamIndex
2 ([Int] -> ByteString
jsonIntArray [Int]
offsets)
      Statement
-> [(Int, TxHash, Maybe ByteString)]
-> IO [(Int, TxHash, Maybe ByteString)]
retrieveLoop Statement
stmt []
  -- Zero rows means the EB's body is absent from the volatile partition
  -- entirely (a present body joins every requested offset): copied+evicted.
  if null vol && not (null offsets)
    then immBatchRetrieveTxs conn ebHash offsets
    else pure vol
 where
  Conn{conVolDb :: Conn -> Database
conVolDb = Database
db, connVolStmts :: Conn -> VolStmts
connVolStmts = VolStmts{stBatchRetrieveTxs :: VolStmts -> Statement
stBatchRetrieveTxs = Statement
stmt}} = Conn
conn

-- | Immutable-partition fallback of 'sqlBatchRetrieveTxs'. Closures land
-- there whole, so the joined tx bytes are never NULL.
immBatchRetrieveTxs ::
  Conn -> EbHash -> [Int] -> IO [(Int, TxHash, Maybe ByteString)]
immBatchRetrieveTxs :: Conn -> EbHash -> [Int] -> IO [(Int, TxHash, Maybe ByteString)]
immBatchRetrieveTxs Conn
conn EbHash
ebHash [Int]
offsets =
  Statement
-> IO [(Int, TxHash, Maybe ByteString)]
-> IO [(Int, TxHash, Maybe ByteString)]
forall a. Statement -> IO a -> IO a
useStmt Statement
stmt (IO [(Int, TxHash, Maybe ByteString)]
 -> IO [(Int, TxHash, Maybe ByteString)])
-> IO [(Int, TxHash, Maybe ByteString)]
-> IO [(Int, TxHash, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ do
    HasCallStack => Statement -> ParamIndex -> ByteString -> IO ()
Statement -> ParamIndex -> ByteString -> IO ()
dbBindBlob Statement
stmt ParamIndex
1 (let MkEbHash ByteString
bytes = EbHash
ebHash in ByteString
bytes)
    HasCallStack => Statement -> ParamIndex -> ByteString -> IO ()
Statement -> ParamIndex -> ByteString -> IO ()
dbBindUtf8 Statement
stmt ParamIndex
2 ([Int] -> ByteString
jsonIntArray [Int]
offsets)
    Statement
-> [(Int, TxHash, Maybe ByteString)]
-> IO [(Int, TxHash, Maybe ByteString)]
retrieveLoop Statement
stmt []
 where
  Conn{connImmStmts :: Conn -> ImmStmts
connImmStmts = ImmStmts{immStBatchRetrieveTxs :: ImmStmts -> Statement
immStBatchRetrieveTxs = Statement
stmt}} = Conn
conn

retrieveLoop ::
  DB.Statement ->
  [(Int, TxHash, Maybe ByteString)] ->
  IO [(Int, TxHash, Maybe ByteString)]
retrieveLoop :: Statement
-> [(Int, TxHash, Maybe ByteString)]
-> IO [(Int, TxHash, Maybe ByteString)]
retrieveLoop Statement
stmt [(Int, TxHash, Maybe ByteString)]
acc =
  HasCallStack => Statement -> IO StepResult
Statement -> IO StepResult
dbStep Statement
stmt IO StepResult
-> (StepResult -> IO [(Int, TxHash, Maybe ByteString)])
-> IO [(Int, TxHash, Maybe ByteString)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    StepResult
DB.Done -> [(Int, TxHash, Maybe ByteString)]
-> IO [(Int, TxHash, Maybe ByteString)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Int, TxHash, Maybe ByteString)]
-> [(Int, TxHash, Maybe ByteString)]
forall a. [a] -> [a]
reverse [(Int, TxHash, Maybe ByteString)]
acc)
    StepResult
DB.Row -> do
      offset <- Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnIndex -> IO Int64
DB.columnInt64 Statement
stmt ColumnIndex
0
      txHash <- MkTxHash <$> DB.columnBlob stmt 1
      -- Column 2 is from LEFT JOIN, NULL if tx not in txs table
      txBytes <- DB.columnBlob stmt 2
      let mbTxBytes = if ByteString
txBytes ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
txBytes
      retrieveLoop stmt ((offset, txHash, mbTxBytes) : acc)

sqlLookupEbClosure :: Conn -> EbHash -> IO (Maybe [(TxHash, ByteString)])
sqlLookupEbClosure :: Conn -> EbHash -> IO (Maybe [(TxHash, ByteString)])
sqlLookupEbClosure Conn
conn EbHash
ebHash = do
  vol <-
    Database
-> IO (Maybe [(TxHash, ByteString)])
-> IO (Maybe [(TxHash, ByteString)])
forall a. HasCallStack => Database -> IO a -> IO a
dbWithTransaction Database
db (IO (Maybe [(TxHash, ByteString)])
 -> IO (Maybe [(TxHash, ByteString)]))
-> IO (Maybe [(TxHash, ByteString)])
-> IO (Maybe [(TxHash, ByteString)])
forall a b. (a -> b) -> a -> b
$ Statement
-> IO (Maybe [(TxHash, ByteString)])
-> IO (Maybe [(TxHash, ByteString)])
forall a. Statement -> IO a -> IO a
useStmt Statement
stmt (IO (Maybe [(TxHash, ByteString)])
 -> IO (Maybe [(TxHash, ByteString)]))
-> IO (Maybe [(TxHash, ByteString)])
-> IO (Maybe [(TxHash, ByteString)])
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => Statement -> ParamIndex -> ByteString -> IO ()
Statement -> ParamIndex -> ByteString -> IO ()
dbBindBlob Statement
stmt ParamIndex
1 (EbHash -> ByteString
ebHashBytes EbHash
ebHash)
      -- FIXME(bladyjoker): This should have a SlotNo as the second part of the key
      Statement
-> [(TxHash, ByteString)] -> IO (Maybe [(TxHash, ByteString)])
closureLoop Statement
stmt []
  -- 'Nothing' covers both no-body and any-tx-missing, which includes a copied
  -- EB re-announced and mid-refetch: the immutable partition must still
  -- answer for it, or replaying its cert-RB fails.
  case vol of
    Just [(TxHash, ByteString)]
rows -> Maybe [(TxHash, ByteString)] -> IO (Maybe [(TxHash, ByteString)])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(TxHash, ByteString)] -> Maybe [(TxHash, ByteString)]
forall a. a -> Maybe a
Just [(TxHash, ByteString)]
rows)
    Maybe [(TxHash, ByteString)]
Nothing -> Conn -> EbHash -> IO (Maybe [(TxHash, ByteString)])
immLookupEbClosure Conn
conn EbHash
ebHash
 where
  Conn{conVolDb :: Conn -> Database
conVolDb = Database
db, connVolStmts :: Conn -> VolStmts
connVolStmts = VolStmts{stLookupEbClosure :: VolStmts -> Statement
stLookupEbClosure = Statement
stmt}} = Conn
conn

-- | Immutable-partition fallback of 'sqlLookupEbClosure'. Closures land there
-- atomically and whole, so any rows are all the rows.
immLookupEbClosure :: Conn -> EbHash -> IO (Maybe [(TxHash, ByteString)])
immLookupEbClosure :: Conn -> EbHash -> IO (Maybe [(TxHash, ByteString)])
immLookupEbClosure Conn
conn EbHash
ebHash =
  Statement
-> IO (Maybe [(TxHash, ByteString)])
-> IO (Maybe [(TxHash, ByteString)])
forall a. Statement -> IO a -> IO a
useStmt Statement
stmt (IO (Maybe [(TxHash, ByteString)])
 -> IO (Maybe [(TxHash, ByteString)]))
-> IO (Maybe [(TxHash, ByteString)])
-> IO (Maybe [(TxHash, ByteString)])
forall a b. (a -> b) -> a -> b
$ do
    HasCallStack => Statement -> ParamIndex -> ByteString -> IO ()
Statement -> ParamIndex -> ByteString -> IO ()
dbBindBlob Statement
stmt ParamIndex
1 (EbHash -> ByteString
ebHashBytes EbHash
ebHash)
    Statement
-> [(TxHash, ByteString)] -> IO (Maybe [(TxHash, ByteString)])
closureLoop Statement
stmt []
 where
  Conn{connImmStmts :: Conn -> ImmStmts
connImmStmts = ImmStmts{immStLookupEbClosure :: ImmStmts -> Statement
immStLookupEbClosure = Statement
stmt}} = Conn
conn

closureLoop ::
  DB.Statement -> [(TxHash, ByteString)] -> IO (Maybe [(TxHash, ByteString)])
closureLoop :: Statement
-> [(TxHash, ByteString)] -> IO (Maybe [(TxHash, ByteString)])
closureLoop Statement
stmt [(TxHash, ByteString)]
acc =
  HasCallStack => Statement -> IO StepResult
Statement -> IO StepResult
dbStep Statement
stmt IO StepResult
-> (StepResult -> IO (Maybe [(TxHash, ByteString)]))
-> IO (Maybe [(TxHash, ByteString)])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    StepResult
DB.Done ->
      -- No rows means the EB body hasn't been downloaded yet
      if [(TxHash, ByteString)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TxHash, ByteString)]
acc then Maybe [(TxHash, ByteString)] -> IO (Maybe [(TxHash, ByteString)])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [(TxHash, ByteString)]
forall a. Maybe a
Nothing else Maybe [(TxHash, ByteString)] -> IO (Maybe [(TxHash, ByteString)])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [(TxHash, ByteString)] -> IO (Maybe [(TxHash, ByteString)]))
-> Maybe [(TxHash, ByteString)]
-> IO (Maybe [(TxHash, ByteString)])
forall a b. (a -> b) -> a -> b
$ [(TxHash, ByteString)] -> Maybe [(TxHash, ByteString)]
forall a. a -> Maybe a
Just ([(TxHash, ByteString)] -> [(TxHash, ByteString)]
forall a. [a] -> [a]
reverse [(TxHash, ByteString)]
acc)
    StepResult
DB.Row -> do
      txHash <- ByteString -> TxHash
MkTxHash (ByteString -> TxHash) -> IO ByteString -> IO TxHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnIndex -> IO ByteString
DB.columnBlob Statement
stmt ColumnIndex
0
      txBytes :: ByteString <- DB.columnBlob stmt 1
      if txBytes == mempty
        then return Nothing
        else closureLoop stmt ((txHash, txBytes) : acc)