{-# LANGUAGE RecordWildCards #-}

-- | Bundles of prepared statements used by LeiosDB's SQLite backend.
--
-- 'DB.Statement's are compiled SQL statements ready to be run on
-- an SQLite connection.
-- Consult [SQLite documentation](https://www.sqlite.org/c3ref/prepare.html)
-- for more details.
module Ouroboros.Consensus.Storage.LeiosDB.Impl.SQLite.Statements
  ( VolStmts (..)
  , prepareVolStmts
  , finalizeVolStmts
  , ImmStmts (..)
  , prepareImmStmts
  , finalizeImmStmts
  , GcStmts (..)
  , prepareGcStmts
  , finalizeGcStmts
  , CopierStmts (..)
  , prepareCopierStmts
  , finalizeCopierStmts
  , SweeperStmts (..)
  , prepareSweeperStmts
  , finalizeSweeperStmts
  ) where

import Control.Exception (mask_, onException)
import Data.IORef (modifyIORef', newIORef, readIORef)
import Data.String (fromString)
import qualified Database.SQLite3.Direct as DB
import GHC.Stack (HasCallStack)
import Ouroboros.Consensus.Storage.LeiosDB.Impl.SQLite.Primitives (dbFinalize, dbPrepare)
import Ouroboros.Consensus.Storage.LeiosDB.Impl.SQLite.Queries

-- | Prepare a bundle of statements with the given preparer. If preparing one
-- throws, the ones already prepared are finalized before the exception
-- propagates: a connection with an open statement refuses to close, so a
-- half-prepared bundle would leak the connection too.
preparingStmts ::
  HasCallStack => DB.Database -> ((String -> IO DB.Statement) -> IO a) -> IO a
preparingStmts :: forall a.
HasCallStack =>
Database -> ((String -> IO Statement) -> IO a) -> IO a
preparingStmts Database
db (String -> IO Statement) -> IO a
k = do
  preparedVar <- [Statement] -> IO (IORef [Statement])
forall a. a -> IO (IORef a)
newIORef []
  let prep String
sql = IO Statement -> IO Statement
forall a. IO a -> IO a
mask_ (IO Statement -> IO Statement) -> IO Statement -> IO Statement
forall a b. (a -> b) -> a -> b
$ do
        stmt <- HasCallStack => Database -> Utf8 -> IO Statement
Database -> Utf8 -> IO Statement
dbPrepare Database
db (String -> Utf8
forall a. IsString a => String -> a
fromString String
sql)
        modifyIORef' preparedVar (stmt :)
        pure stmt
  k prep `onException` (readIORef preparedVar >>= mapM_ dbFinalize)

-- | The copy statements, prepared on the copier's immutable connection --
-- main is the immutable file, the volatile file is ATTACHed as @vol@.
data CopierStmts = CopierStmts
  { CopierStmts -> Statement
ccCompleteness :: !DB.Statement
  -- ^ 'sql_copy_completeness'
  , CopierStmts -> Statement
ccInsertEb :: !DB.Statement
  -- ^ 'sql_copy_insert_eb'
  , CopierStmts -> Statement
ccInsertEbTxs :: !DB.Statement
  -- ^ 'sql_copy_insert_ebTxs'
  , CopierStmts -> Statement
ccInsertTxs :: !DB.Statement
  -- ^ 'sql_copy_insert_txs'
  }

-- | Prepare the copy statements on the copier's immutable connection, which
-- must already have the volatile partition ATTACHed as @vol@.
prepareCopierStmts :: HasCallStack => DB.Database -> IO CopierStmts
prepareCopierStmts :: HasCallStack => Database -> IO CopierStmts
prepareCopierStmts Database
db = Database
-> ((String -> IO Statement) -> IO CopierStmts) -> IO CopierStmts
forall a.
HasCallStack =>
Database -> ((String -> IO Statement) -> IO a) -> IO a
preparingStmts Database
db (((String -> IO Statement) -> IO CopierStmts) -> IO CopierStmts)
-> ((String -> IO Statement) -> IO CopierStmts) -> IO CopierStmts
forall a b. (a -> b) -> a -> b
$ \String -> IO Statement
prep -> do
  ccCompleteness <- String -> IO Statement
prep String
sql_copy_completeness
  ccInsertEb <- prep sql_copy_insert_eb
  ccInsertEbTxs <- prep sql_copy_insert_ebTxs
  ccInsertTxs <- prep sql_copy_insert_txs
  pure CopierStmts{..}

finalizeCopierStmts :: CopierStmts -> IO ()
finalizeCopierStmts :: CopierStmts -> IO ()
finalizeCopierStmts CopierStmts{Statement
ccCompleteness :: CopierStmts -> Statement
ccInsertEb :: CopierStmts -> Statement
ccInsertEbTxs :: CopierStmts -> Statement
ccInsertTxs :: CopierStmts -> Statement
ccCompleteness :: Statement
ccInsertEb :: Statement
ccInsertEbTxs :: Statement
ccInsertTxs :: Statement
..} = do
  Statement -> IO ()
dbFinalize Statement
ccCompleteness
  Statement -> IO ()
dbFinalize Statement
ccInsertEb
  Statement -> IO ()
dbFinalize Statement
ccInsertEbTxs
  Statement -> IO ()
dbFinalize Statement
ccInsertTxs

-- | The GC tick's prepared statements, prepared once on the writer's
-- volatile connection.
data GcStmts = GcStmts
  { GcStmts -> Statement
gsHasWork :: !DB.Statement
  -- ^ 'sql_gc_has_work'
  , GcStmts -> Statement
gsAddGcCandidatesTxs :: !DB.Statement
  -- ^ 'sql_gc_stage_marked'
  , GcStmts -> Statement
gsMarkEbForGC :: !DB.Statement
  -- ^ 'sql_gc_mark'
  }

prepareGcStmts :: HasCallStack => DB.Database -> IO GcStmts
prepareGcStmts :: HasCallStack => Database -> IO GcStmts
prepareGcStmts Database
db = Database -> ((String -> IO Statement) -> IO GcStmts) -> IO GcStmts
forall a.
HasCallStack =>
Database -> ((String -> IO Statement) -> IO a) -> IO a
preparingStmts Database
db (((String -> IO Statement) -> IO GcStmts) -> IO GcStmts)
-> ((String -> IO Statement) -> IO GcStmts) -> IO GcStmts
forall a b. (a -> b) -> a -> b
$ \String -> IO Statement
prep -> do
  gsHasWork <- String -> IO Statement
prep String
sql_gc_has_work
  gsAddGcCandidatesTxs <- prep sql_gc_stage_marked
  gsMarkEbForGC <- prep sql_gc_mark
  pure GcStmts{..}

finalizeGcStmts :: GcStmts -> IO ()
finalizeGcStmts :: GcStmts -> IO ()
finalizeGcStmts GcStmts{Statement
gsHasWork :: GcStmts -> Statement
gsAddGcCandidatesTxs :: GcStmts -> Statement
gsMarkEbForGC :: GcStmts -> Statement
gsHasWork :: Statement
gsAddGcCandidatesTxs :: Statement
gsMarkEbForGC :: Statement
..} = do
  Statement -> IO ()
dbFinalize Statement
gsHasWork
  Statement -> IO ()
dbFinalize Statement
gsAddGcCandidatesTxs
  Statement -> IO ()
dbFinalize Statement
gsMarkEbForGC

-- | The sweep statements, prepared on the writer's volatile connection;
-- lifecycle mirrors 'CopierStmts'.
data SweeperStmts = SweeperStmts
  { SweeperStmts -> Statement
swPickMarked :: !DB.Statement
  -- ^ 'sql_sweep_pick_marked'
  , SweeperStmts -> Statement
swEvictEbTxs :: !DB.Statement
  -- ^ 'sql_gc_ebTxs'
  , SweeperStmts -> Statement
swEvictMissingTxs :: !DB.Statement
  -- ^ 'sql_gc_missing_txs'
  , SweeperStmts -> Statement
swEvictEbs :: !DB.Statement
  -- ^ 'sql_gc_ebs_by_hash'
  , SweeperStmts -> Statement
swAnyMarked :: !DB.Statement
  -- ^ 'sql_sweep_any_marked'
  , SweeperStmts -> Statement
swPickOrphans :: !DB.Statement
  -- ^ 'sql_sweep_pick_orphans'
  , SweeperStmts -> Statement
swOrphanTxs :: !DB.Statement
  -- ^ 'sql_sweep_orphan_txs'
  , SweeperStmts -> Statement
swPopOrphans :: !DB.Statement
  -- ^ 'sql_sweep_pop_orphans'
  , SweeperStmts -> Statement
swHasUnstagedGcCandidates :: !DB.Statement
  -- ^ 'sql_has_unstaged_gc_candidates'
  , SweeperStmts -> Statement
swUnstagedGcCandidatesPage :: !DB.Statement
  -- ^ 'sql_unstaged_gc_candidates_page'
  , SweeperStmts -> Statement
swInsertGcCandidates :: !DB.Statement
  -- ^ 'sql_insert_gc_candidates'
  }

-- | Prepare the sweep statements on the writer's volatile connection.
prepareSweeperStmts :: HasCallStack => DB.Database -> IO SweeperStmts
prepareSweeperStmts :: HasCallStack => Database -> IO SweeperStmts
prepareSweeperStmts Database
db = Database
-> ((String -> IO Statement) -> IO SweeperStmts) -> IO SweeperStmts
forall a.
HasCallStack =>
Database -> ((String -> IO Statement) -> IO a) -> IO a
preparingStmts Database
db (((String -> IO Statement) -> IO SweeperStmts) -> IO SweeperStmts)
-> ((String -> IO Statement) -> IO SweeperStmts) -> IO SweeperStmts
forall a b. (a -> b) -> a -> b
$ \String -> IO Statement
prep -> do
  swPickMarked <- String -> IO Statement
prep String
sql_sweep_pick_marked
  swEvictEbTxs <- prep sql_gc_ebTxs
  swEvictMissingTxs <- prep sql_gc_missing_txs
  swEvictEbs <- prep sql_gc_ebs_by_hash
  swAnyMarked <- prep sql_sweep_any_marked
  swPickOrphans <- prep sql_sweep_pick_orphans
  swOrphanTxs <- prep sql_sweep_orphan_txs
  swPopOrphans <- prep sql_sweep_pop_orphans
  swHasUnstagedGcCandidates <- prep sql_has_unstaged_gc_candidates
  swUnstagedGcCandidatesPage <- prep sql_unstaged_gc_candidates_page
  swInsertGcCandidates <- prep sql_insert_gc_candidates
  pure SweeperStmts{..}

finalizeSweeperStmts :: SweeperStmts -> IO ()
finalizeSweeperStmts :: SweeperStmts -> IO ()
finalizeSweeperStmts SweeperStmts{Statement
swPickMarked :: SweeperStmts -> Statement
swEvictEbTxs :: SweeperStmts -> Statement
swEvictMissingTxs :: SweeperStmts -> Statement
swEvictEbs :: SweeperStmts -> Statement
swAnyMarked :: SweeperStmts -> Statement
swPickOrphans :: SweeperStmts -> Statement
swOrphanTxs :: SweeperStmts -> Statement
swPopOrphans :: SweeperStmts -> Statement
swHasUnstagedGcCandidates :: SweeperStmts -> Statement
swUnstagedGcCandidatesPage :: SweeperStmts -> Statement
swInsertGcCandidates :: SweeperStmts -> Statement
swPickMarked :: Statement
swEvictEbTxs :: Statement
swEvictMissingTxs :: Statement
swEvictEbs :: Statement
swAnyMarked :: Statement
swPickOrphans :: Statement
swOrphanTxs :: Statement
swPopOrphans :: Statement
swHasUnstagedGcCandidates :: Statement
swUnstagedGcCandidatesPage :: Statement
swInsertGcCandidates :: Statement
..} = do
  Statement -> IO ()
dbFinalize Statement
swPickMarked
  Statement -> IO ()
dbFinalize Statement
swEvictEbTxs
  Statement -> IO ()
dbFinalize Statement
swEvictMissingTxs
  Statement -> IO ()
dbFinalize Statement
swEvictEbs
  Statement -> IO ()
dbFinalize Statement
swAnyMarked
  Statement -> IO ()
dbFinalize Statement
swPickOrphans
  Statement -> IO ()
dbFinalize Statement
swOrphanTxs
  Statement -> IO ()
dbFinalize Statement
swPopOrphans
  Statement -> IO ()
dbFinalize Statement
swHasUnstagedGcCandidates
  Statement -> IO ()
dbFinalize Statement
swUnstagedGcCandidatesPage
  Statement -> IO ()
dbFinalize Statement
swInsertGcCandidates

-- | Compiled SQL statements for the Volatile partition.
data VolStmts = VolStmts
  { VolStmts -> Statement
stScanEbPoints :: !DB.Statement
  , VolStmts -> Statement
stInsertEbPoint :: !DB.Statement
  , VolStmts -> Statement
stLookupEbBody :: !DB.Statement
  , VolStmts -> Statement
stInsertEbTxsRow :: !DB.Statement
  , VolStmts -> Statement
stInitMissingCount :: !DB.Statement
  , VolStmts -> Statement
stInsertTx :: !DB.Statement
  , VolStmts -> Statement
stDecrMissingCount :: !DB.Statement
  , VolStmts -> Statement
stInsertMissingTxs :: !DB.Statement
  , VolStmts -> Statement
stDeleteMissingTxs :: !DB.Statement
  , VolStmts -> Statement
stFindCompleteEbs :: !DB.Statement
  , VolStmts -> Statement
stMarkNotifiedEbs :: !DB.Statement
  , VolStmts -> Statement
stMarkPointNotified :: !DB.Statement
  , VolStmts -> Statement
stBatchRetrieveTxs :: !DB.Statement
  , VolStmts -> Statement
stFilterMissingTxs :: !DB.Statement
  , VolStmts -> Statement
stLookupEbClosure :: !DB.Statement
  , VolStmts -> Statement
stScanCompleteEbsSince :: !DB.Statement
  }

-- | Prepared statements of the fallback reads into the immutable partition.
-- The partitions share one schema, so these are the volatile SQL strings
-- prepared against the immutable connection (plus the presence probe).
-- Lifecycle mirrors 'VolStmts': prepared at open time, finalized in 'close'
-- before their connection.
data ImmStmts = ImmStmts
  { ImmStmts -> Statement
immStLookupEbBody :: !DB.Statement
  , ImmStmts -> Statement
immStLookupEbClosure :: !DB.Statement
  , ImmStmts -> Statement
immStBatchRetrieveTxs :: !DB.Statement
  , ImmStmts -> Statement
immStFilterPresent :: !DB.Statement
  }

prepareImmStmts :: HasCallStack => DB.Database -> IO ImmStmts
prepareImmStmts :: HasCallStack => Database -> IO ImmStmts
prepareImmStmts Database
db = Database
-> ((String -> IO Statement) -> IO ImmStmts) -> IO ImmStmts
forall a.
HasCallStack =>
Database -> ((String -> IO Statement) -> IO a) -> IO a
preparingStmts Database
db (((String -> IO Statement) -> IO ImmStmts) -> IO ImmStmts)
-> ((String -> IO Statement) -> IO ImmStmts) -> IO ImmStmts
forall a b. (a -> b) -> a -> b
$ \String -> IO Statement
prep -> do
  immStLookupEbBody <- String -> IO Statement
prep String
sql_lookup_ebBodies
  immStLookupEbClosure <- prep sql_lookup_eb_closure
  immStBatchRetrieveTxs <- prep sql_retrieve_from_ebTxs_json
  immStFilterPresent <- prep sql_imm_filter_present
  pure ImmStmts{..}

-- | Same use-after-free discipline as 'finalizeVolStmts'.
finalizeImmStmts :: ImmStmts -> IO ()
finalizeImmStmts :: ImmStmts -> IO ()
finalizeImmStmts ImmStmts{Statement
immStLookupEbBody :: ImmStmts -> Statement
immStLookupEbClosure :: ImmStmts -> Statement
immStBatchRetrieveTxs :: ImmStmts -> Statement
immStFilterPresent :: ImmStmts -> Statement
immStLookupEbBody :: Statement
immStLookupEbClosure :: Statement
immStBatchRetrieveTxs :: Statement
immStFilterPresent :: Statement
..} = do
  Statement -> IO ()
dbFinalize Statement
immStLookupEbBody
  Statement -> IO ()
dbFinalize Statement
immStLookupEbClosure
  Statement -> IO ()
dbFinalize Statement
immStBatchRetrieveTxs
  Statement -> IO ()
dbFinalize Statement
immStFilterPresent

-- | Prepare every statement 'VolStmts' names. Order is not observable.
prepareVolStmts :: DB.Database -> IO VolStmts
prepareVolStmts :: Database -> IO VolStmts
prepareVolStmts Database
db = Database
-> ((String -> IO Statement) -> IO VolStmts) -> IO VolStmts
forall a.
HasCallStack =>
Database -> ((String -> IO Statement) -> IO a) -> IO a
preparingStmts Database
db (((String -> IO Statement) -> IO VolStmts) -> IO VolStmts)
-> ((String -> IO Statement) -> IO VolStmts) -> IO VolStmts
forall a b. (a -> b) -> a -> b
$ \String -> IO Statement
prep -> do
  stScanEbPoints <- String -> IO Statement
prep String
sql_scan_ebs
  stInsertEbPoint <- prep sql_insert_eb
  stLookupEbBody <- prep sql_lookup_ebBodies
  stInsertEbTxsRow <- prep sql_insert_ebBody
  stInitMissingCount <- prep sql_init_missing_tx_count
  stInsertTx <- prep sql_insert_tx
  stDecrMissingCount <- prep sql_decrement_missing_tx_count
  stInsertMissingTxs <- prep sql_insert_missing_txs
  stDeleteMissingTxs <- prep sql_delete_missing_txs
  stFindCompleteEbs <- prep sql_find_complete_ebs
  stMarkNotifiedEbs <- prep sql_mark_notified_ebs
  stMarkPointNotified <- prep sql_mark_point_notified
  stBatchRetrieveTxs <- prep sql_retrieve_from_ebTxs_json
  stFilterMissingTxs <- prep sql_filter_missing_txs_json
  stLookupEbClosure <- prep sql_lookup_eb_closure
  stScanCompleteEbsSince <- prep sql_scan_complete_ebs_since
  pure VolStmts{..}

-- | Finalise every statement in 'VolStmts'. Called from 'close' immediately
-- before 'sqlite3_close_v2', on the connection's owner thread.
finalizeVolStmts :: VolStmts -> IO ()
finalizeVolStmts :: VolStmts -> IO ()
finalizeVolStmts VolStmts{Statement
stScanEbPoints :: VolStmts -> Statement
stInsertEbPoint :: VolStmts -> Statement
stLookupEbBody :: VolStmts -> Statement
stInsertEbTxsRow :: VolStmts -> Statement
stInitMissingCount :: VolStmts -> Statement
stInsertTx :: VolStmts -> Statement
stDecrMissingCount :: VolStmts -> Statement
stInsertMissingTxs :: VolStmts -> Statement
stDeleteMissingTxs :: VolStmts -> Statement
stFindCompleteEbs :: VolStmts -> Statement
stMarkNotifiedEbs :: VolStmts -> Statement
stMarkPointNotified :: VolStmts -> Statement
stBatchRetrieveTxs :: VolStmts -> Statement
stFilterMissingTxs :: VolStmts -> Statement
stLookupEbClosure :: VolStmts -> Statement
stScanCompleteEbsSince :: VolStmts -> Statement
stScanEbPoints :: Statement
stInsertEbPoint :: Statement
stLookupEbBody :: Statement
stInsertEbTxsRow :: Statement
stInitMissingCount :: Statement
stInsertTx :: Statement
stDecrMissingCount :: Statement
stInsertMissingTxs :: Statement
stDeleteMissingTxs :: Statement
stFindCompleteEbs :: Statement
stMarkNotifiedEbs :: Statement
stMarkPointNotified :: Statement
stBatchRetrieveTxs :: Statement
stFilterMissingTxs :: Statement
stLookupEbClosure :: Statement
stScanCompleteEbsSince :: Statement
..} = do
  Statement -> IO ()
dbFinalize Statement
stScanEbPoints
  Statement -> IO ()
dbFinalize Statement
stInsertEbPoint
  Statement -> IO ()
dbFinalize Statement
stLookupEbBody
  Statement -> IO ()
dbFinalize Statement
stInsertEbTxsRow
  Statement -> IO ()
dbFinalize Statement
stInitMissingCount
  Statement -> IO ()
dbFinalize Statement
stInsertTx
  Statement -> IO ()
dbFinalize Statement
stDecrMissingCount
  Statement -> IO ()
dbFinalize Statement
stInsertMissingTxs
  Statement -> IO ()
dbFinalize Statement
stDeleteMissingTxs
  Statement -> IO ()
dbFinalize Statement
stFindCompleteEbs
  Statement -> IO ()
dbFinalize Statement
stMarkNotifiedEbs
  Statement -> IO ()
dbFinalize Statement
stMarkPointNotified
  Statement -> IO ()
dbFinalize Statement
stBatchRetrieveTxs
  Statement -> IO ()
dbFinalize Statement
stFilterMissingTxs
  Statement -> IO ()
dbFinalize Statement
stLookupEbClosure
  Statement -> IO ()
dbFinalize Statement
stScanCompleteEbsSince