{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Simplex.Messaging.Agent.Store.SQLite
  ( DBOpts (..),
    Migrations.getCurrentMigrations,
    migrateDBSchema,
    createDBStore,
    closeDBStore,
    reopenDBStore,
    execSQL,
    -- used in Simplex.Chat.Archive
    sqlString,
    keyString,
    storeKey,
    -- used in tests
    connectSQLiteStore,
    openSQLiteStore,
  )
where

import Control.Concurrent.MVar
import Control.Concurrent.STM
import Control.Exception (bracketOnError, onException, throwIO)
import Control.Monad
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
import Data.Functor (($>))
import Data.IORef
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Database.SQLite.Simple (Query (..))
import qualified Database.SQLite.Simple as SQL
import Database.SQLite.Simple.QQ (sql)
import qualified Database.SQLite3 as SQLite3
import Simplex.Messaging.Agent.Store.Migrations (DBMigrate (..), sharedMigrateSchema)
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
import Simplex.Messaging.Agent.Store.SQLite.Common
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.SQLite.Util
import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationError (..))
import Simplex.Messaging.Util (ifM, safeDecodeUtf8)
import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
import System.FilePath (takeDirectory, takeFileName, (</>))

-- * SQLite Store implementation

createDBStore :: DBOpts -> [Migration] -> MigrationConfig -> IO (Either MigrationError DBStore)
createDBStore :: DBOpts
-> [Migration]
-> MigrationConfig
-> IO (Either MigrationError DBStore)
createDBStore opts :: DBOpts
opts@DBOpts {FilePath
dbFilePath :: FilePath
$sel:dbFilePath:DBOpts :: DBOpts -> FilePath
dbFilePath} [Migration]
migrations MigrationConfig
migrationConfig = do
  let dbDir :: FilePath
dbDir = FilePath -> FilePath
takeDirectory FilePath
dbFilePath
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dbDir
  DBStore
st <- DBOpts -> IO DBStore
connectSQLiteStore DBOpts
opts
  Either MigrationError ()
r <- DBStore
-> DBOpts
-> Maybe Query
-> [Migration]
-> MigrationConfig
-> IO (Either MigrationError ())
migrateDBSchema DBStore
st DBOpts
opts Maybe Query
forall a. Maybe a
Nothing [Migration]
migrations MigrationConfig
migrationConfig IO (Either MigrationError ())
-> IO () -> IO (Either MigrationError ())
forall a b. IO a -> IO b -> IO a
`onException` DBStore -> IO ()
closeDBStore DBStore
st
  case Either MigrationError ()
r of
    Right () -> Either MigrationError DBStore -> IO (Either MigrationError DBStore)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MigrationError DBStore
 -> IO (Either MigrationError DBStore))
-> Either MigrationError DBStore
-> IO (Either MigrationError DBStore)
forall a b. (a -> b) -> a -> b
$ DBStore -> Either MigrationError DBStore
forall a b. b -> Either a b
Right DBStore
st
    Left MigrationError
e -> DBStore -> IO ()
closeDBStore DBStore
st IO ()
-> Either MigrationError DBStore
-> IO (Either MigrationError DBStore)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MigrationError -> Either MigrationError DBStore
forall a b. a -> Either a b
Left MigrationError
e
  where

migrateDBSchema :: DBStore -> DBOpts -> Maybe Query -> [Migration] -> MigrationConfig -> IO (Either MigrationError ())
migrateDBSchema :: DBStore
-> DBOpts
-> Maybe Query
-> [Migration]
-> MigrationConfig
-> IO (Either MigrationError ())
migrateDBSchema DBStore
st DBOpts {FilePath
$sel:dbFilePath:DBOpts :: DBOpts -> FilePath
dbFilePath :: FilePath
dbFilePath, Bool
vacuum :: Bool
$sel:vacuum:DBOpts :: DBOpts -> Bool
vacuum} Maybe Query
migrationsTable [Migration]
migrations MigrationConfig {MigrationConfirmation
confirm :: MigrationConfirmation
confirm :: MigrationConfig -> MigrationConfirmation
confirm, Maybe FilePath
backupPath :: Maybe FilePath
backupPath :: MigrationConfig -> Maybe FilePath
backupPath} =
  let initialize :: IO ()
initialize = DBStore -> Maybe Query -> IO ()
Migrations.initialize DBStore
st Maybe Query
migrationsTable
      getCurrent :: IO [Migration]
getCurrent = DBStore -> (Connection -> IO [Migration]) -> IO [Migration]
forall a. DBStore -> (Connection -> IO a) -> IO a
withTransaction DBStore
st ((Connection -> IO [Migration]) -> IO [Migration])
-> (Connection -> IO [Migration]) -> IO [Migration]
forall a b. (a -> b) -> a -> b
$ Maybe Query -> Connection -> IO [Migration]
Migrations.getCurrentMigrations Maybe Query
migrationsTable
      run :: MigrationsToRun -> IO ()
run = DBStore -> Maybe Query -> Bool -> MigrationsToRun -> IO ()
Migrations.run DBStore
st Maybe Query
migrationsTable Bool
vacuum
      backup :: Maybe (IO ())
backup = FilePath -> IO ()
mkBackup (FilePath -> IO ()) -> Maybe FilePath -> Maybe (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
backupPath
      mkBackup :: FilePath -> IO ()
mkBackup FilePath
bp =
        let f :: FilePath
f = if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
bp then FilePath
dbFilePath else FilePath
bp FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
dbFilePath
          in FilePath -> FilePath -> IO ()
copyFile FilePath
dbFilePath (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
f FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".bak"
      dbm :: DBMigrate
dbm = DBMigrate {IO ()
initialize :: IO ()
initialize :: IO ()
initialize, IO [Migration]
getCurrent :: IO [Migration]
getCurrent :: IO [Migration]
getCurrent, MigrationsToRun -> IO ()
run :: MigrationsToRun -> IO ()
run :: MigrationsToRun -> IO ()
run, Maybe (IO ())
backup :: Maybe (IO ())
backup :: Maybe (IO ())
backup}
   in DBMigrate
-> Bool
-> [Migration]
-> MigrationConfirmation
-> IO (Either MigrationError ())
sharedMigrateSchema DBMigrate
dbm (DBStore -> Bool
dbNew DBStore
st) [Migration]
migrations MigrationConfirmation
confirm

connectSQLiteStore :: DBOpts -> IO DBStore
connectSQLiteStore :: DBOpts -> IO DBStore
connectSQLiteStore DBOpts {FilePath
$sel:dbFilePath:DBOpts :: DBOpts -> FilePath
dbFilePath :: FilePath
dbFilePath, [SQLiteFuncDef]
dbFunctions :: [SQLiteFuncDef]
$sel:dbFunctions:DBOpts :: DBOpts -> [SQLiteFuncDef]
dbFunctions, $sel:dbKey:DBOpts :: DBOpts -> ScrubbedBytes
dbKey = ScrubbedBytes
key, Bool
keepKey :: Bool
$sel:keepKey:DBOpts :: DBOpts -> Bool
keepKey, TrackQueries
track :: TrackQueries
$sel:track:DBOpts :: DBOpts -> TrackQueries
track} = do
  Bool
dbNew <- Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist FilePath
dbFilePath
  Connection
dbConn <- IO Connection -> IO Connection
forall a. IO a -> IO a
dbBusyLoop (IO Connection -> IO Connection) -> IO Connection -> IO Connection
forall a b. (a -> b) -> a -> b
$ FilePath
-> [SQLiteFuncDef]
-> ScrubbedBytes
-> TrackQueries
-> IO Connection
connectDB FilePath
dbFilePath [SQLiteFuncDef]
dbFunctions ScrubbedBytes
key TrackQueries
track
  MVar Connection
dbConnection <- Connection -> IO (MVar Connection)
forall a. a -> IO (MVar a)
newMVar Connection
dbConn
  TVar (Maybe ScrubbedBytes)
dbKey <- Maybe ScrubbedBytes -> IO (TVar (Maybe ScrubbedBytes))
forall a. a -> IO (TVar a)
newTVarIO (Maybe ScrubbedBytes -> IO (TVar (Maybe ScrubbedBytes)))
-> Maybe ScrubbedBytes -> IO (TVar (Maybe ScrubbedBytes))
forall a b. (a -> b) -> a -> b
$! ScrubbedBytes -> Bool -> Maybe ScrubbedBytes
storeKey ScrubbedBytes
key Bool
keepKey
  TVar Bool
dbClosed <- Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
newTVarIO Bool
False
  TVar Int
dbSem <- Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0
  DBStore -> IO DBStore
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DBStore {FilePath
dbFilePath :: FilePath
$sel:dbFilePath:DBStore :: FilePath
dbFilePath, [SQLiteFuncDef]
dbFunctions :: [SQLiteFuncDef]
$sel:dbFunctions:DBStore :: [SQLiteFuncDef]
dbFunctions, TVar (Maybe ScrubbedBytes)
dbKey :: TVar (Maybe ScrubbedBytes)
$sel:dbKey:DBStore :: TVar (Maybe ScrubbedBytes)
dbKey, TVar Int
dbSem :: TVar Int
$sel:dbSem:DBStore :: TVar Int
dbSem, MVar Connection
dbConnection :: MVar Connection
$sel:dbConnection:DBStore :: MVar Connection
dbConnection, Bool
$sel:dbNew:DBStore :: Bool
dbNew :: Bool
dbNew, TVar Bool
dbClosed :: TVar Bool
$sel:dbClosed:DBStore :: TVar Bool
dbClosed}

connectDB :: FilePath -> [SQLiteFuncDef] -> ScrubbedBytes -> DB.TrackQueries -> IO DB.Connection
connectDB :: FilePath
-> [SQLiteFuncDef]
-> ScrubbedBytes
-> TrackQueries
-> IO Connection
connectDB FilePath
path [SQLiteFuncDef]
functions ScrubbedBytes
key TrackQueries
track = do
  Connection
db <- FilePath -> TrackQueries -> IO Connection
DB.open FilePath
path TrackQueries
track
  Connection -> IO ()
prepare Connection
db IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` Connection -> IO ()
DB.close Connection
db
  -- _printPragmas db path
  Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection
db
  where
    prepare :: Connection -> IO ()
prepare Connection
db = do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ScrubbedBytes -> Bool
forall a. ByteArrayAccess a => a -> Bool
BA.null ScrubbedBytes
key) (IO () -> IO ()) -> (Text -> IO ()) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Database -> Text -> IO ()
SQLite3.exec Database
db' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"PRAGMA key = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScrubbedBytes -> Text
keyString ScrubbedBytes
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
      Database -> Text -> IO ()
SQLite3.exec Database
db' (Text -> IO ()) -> (Query -> Text) -> Query -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Text
fromQuery (Query -> IO ()) -> Query -> IO ()
forall a b. (a -> b) -> a -> b
$
        [sql|
          PRAGMA busy_timeout = 100;
          PRAGMA foreign_keys = ON;
          -- PRAGMA trusted_schema = OFF;
          PRAGMA secure_delete = ON;
          PRAGMA auto_vacuum = FULL;
        |]
      (SQLiteFuncDef -> IO ()) -> [SQLiteFuncDef] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SQLiteFuncDef -> IO ()
addFunction [SQLiteFuncDef]
functions
      where
        db' :: Database
db' = Connection -> Database
SQL.connectionHandle (Connection -> Database) -> Connection -> Database
forall a b. (a -> b) -> a -> b
$ Connection -> Connection
DB.conn Connection
db
        addFunction :: SQLiteFuncDef -> IO ()
addFunction SQLiteFuncDef {ByteString
funcName :: ByteString
$sel:funcName:SQLiteFuncDef :: SQLiteFuncDef -> ByteString
funcName, CArgCount
argCount :: CArgCount
$sel:argCount:SQLiteFuncDef :: SQLiteFuncDef -> CArgCount
argCount, SQLiteFuncPtrs
funcPtrs :: SQLiteFuncPtrs
$sel:funcPtrs:SQLiteFuncDef :: SQLiteFuncDef -> SQLiteFuncPtrs
funcPtrs} =
          (Error -> IO ()) -> (() -> IO ()) -> Either Error () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO ()) -> (Error -> IOError) -> Error -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOError
userError (FilePath -> IOError) -> (Error -> FilePath) -> Error -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> FilePath
forall a. Show a => a -> FilePath
show) () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error () -> IO ()) -> IO (Either Error ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case SQLiteFuncPtrs
funcPtrs of
            SQLiteFuncPtr Bool
isDet FunPtr SQLiteFunc
funcPtr -> Database
-> ByteString
-> CArgCount
-> Bool
-> FunPtr SQLiteFunc
-> IO (Either Error ())
createStaticFunction Database
db' ByteString
funcName CArgCount
argCount Bool
isDet FunPtr SQLiteFunc
funcPtr
            SQLiteAggrPtrs FunPtr SQLiteFunc
stepPtr FunPtr SQLiteFuncFinal
finalPtr -> Database
-> ByteString
-> CArgCount
-> FunPtr SQLiteFunc
-> FunPtr SQLiteFuncFinal
-> IO (Either Error ())
createStaticAggregate Database
db' ByteString
funcName CArgCount
argCount FunPtr SQLiteFunc
stepPtr FunPtr SQLiteFuncFinal
finalPtr

closeDBStore :: DBStore -> IO ()
closeDBStore :: DBStore -> IO ()
closeDBStore st :: DBStore
st@DBStore {TVar Bool
$sel:dbClosed:DBStore :: DBStore -> TVar Bool
dbClosed :: TVar Bool
dbClosed} =
  IO Bool -> IO () -> IO () -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (TVar Bool -> IO Bool
forall a. TVar a -> IO a
readTVarIO TVar Bool
dbClosed) (FilePath -> IO ()
putStrLn FilePath
"closeDBStore: already closed") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    DBStore -> (Connection -> IO ()) -> IO ()
forall a. DBStore -> (Connection -> IO a) -> IO a
withConnection DBStore
st ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
      Connection -> IO ()
DB.close Connection
conn
      STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
dbClosed Bool
True

openSQLiteStore :: DBStore -> ScrubbedBytes -> Bool -> IO ()
openSQLiteStore :: DBStore -> ScrubbedBytes -> Bool -> IO ()
openSQLiteStore st :: DBStore
st@DBStore {TVar Bool
$sel:dbClosed:DBStore :: DBStore -> TVar Bool
dbClosed :: TVar Bool
dbClosed} ScrubbedBytes
key Bool
keepKey =
  IO Bool -> IO () -> IO () -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (TVar Bool -> IO Bool
forall a. TVar a -> IO a
readTVarIO TVar Bool
dbClosed) (DBStore -> ScrubbedBytes -> Bool -> IO ()
openSQLiteStore_ DBStore
st ScrubbedBytes
key Bool
keepKey) (FilePath -> IO ()
putStrLn FilePath
"openSQLiteStore: already opened")

openSQLiteStore_ :: DBStore -> ScrubbedBytes -> Bool -> IO ()
openSQLiteStore_ :: DBStore -> ScrubbedBytes -> Bool -> IO ()
openSQLiteStore_ DBStore {MVar Connection
$sel:dbConnection:DBStore :: DBStore -> MVar Connection
dbConnection :: MVar Connection
dbConnection, FilePath
$sel:dbFilePath:DBStore :: DBStore -> FilePath
dbFilePath :: FilePath
dbFilePath, [SQLiteFuncDef]
$sel:dbFunctions:DBStore :: DBStore -> [SQLiteFuncDef]
dbFunctions :: [SQLiteFuncDef]
dbFunctions, TVar (Maybe ScrubbedBytes)
$sel:dbKey:DBStore :: DBStore -> TVar (Maybe ScrubbedBytes)
dbKey :: TVar (Maybe ScrubbedBytes)
dbKey, TVar Bool
$sel:dbClosed:DBStore :: DBStore -> TVar Bool
dbClosed :: TVar Bool
dbClosed} ScrubbedBytes
key Bool
keepKey =
  IO Connection
-> (Connection -> IO Bool) -> (Connection -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
    (MVar Connection -> IO Connection
forall a. MVar a -> IO a
takeMVar MVar Connection
dbConnection)
    (MVar Connection -> Connection -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar Connection
dbConnection)
    ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DB.Connection {TMap Query SlowQueryStats
slow :: TMap Query SlowQueryStats
slow :: Connection -> TMap Query SlowQueryStats
slow, TrackQueries
track :: TrackQueries
track :: Connection -> TrackQueries
track} -> do
      DB.Connection {Connection
conn :: Connection -> Connection
conn :: Connection
conn} <- FilePath
-> [SQLiteFuncDef]
-> ScrubbedBytes
-> TrackQueries
-> IO Connection
connectDB FilePath
dbFilePath [SQLiteFuncDef]
dbFunctions ScrubbedBytes
key TrackQueries
track
      STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
dbClosed Bool
False
        TVar (Maybe ScrubbedBytes) -> Maybe ScrubbedBytes -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe ScrubbedBytes)
dbKey (Maybe ScrubbedBytes -> STM ()) -> Maybe ScrubbedBytes -> STM ()
forall a b. (a -> b) -> a -> b
$! ScrubbedBytes -> Bool -> Maybe ScrubbedBytes
storeKey ScrubbedBytes
key Bool
keepKey
      MVar Connection -> Connection -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Connection
dbConnection DB.Connection {Connection
conn :: Connection
conn :: Connection
conn, TMap Query SlowQueryStats
slow :: TMap Query SlowQueryStats
slow :: TMap Query SlowQueryStats
slow, TrackQueries
track :: TrackQueries
track :: TrackQueries
track}

reopenDBStore :: DBStore -> IO ()
reopenDBStore :: DBStore -> IO ()
reopenDBStore st :: DBStore
st@DBStore {TVar (Maybe ScrubbedBytes)
$sel:dbKey:DBStore :: DBStore -> TVar (Maybe ScrubbedBytes)
dbKey :: TVar (Maybe ScrubbedBytes)
dbKey, TVar Bool
$sel:dbClosed:DBStore :: DBStore -> TVar Bool
dbClosed :: TVar Bool
dbClosed} =
  IO Bool -> IO () -> IO () -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (TVar Bool -> IO Bool
forall a. TVar a -> IO a
readTVarIO TVar Bool
dbClosed) IO ()
open (FilePath -> IO ()
putStrLn FilePath
"reopenDBStore: already opened")
  where
    open :: IO ()
open =
      TVar (Maybe ScrubbedBytes) -> IO (Maybe ScrubbedBytes)
forall a. TVar a -> IO a
readTVarIO TVar (Maybe ScrubbedBytes)
dbKey IO (Maybe ScrubbedBytes) -> (Maybe ScrubbedBytes -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just ScrubbedBytes
key -> DBStore -> ScrubbedBytes -> Bool -> IO ()
openSQLiteStore_ DBStore
st ScrubbedBytes
key Bool
True
        Maybe ScrubbedBytes
Nothing -> FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"reopenDBStore: no key"

keyString :: ScrubbedBytes -> Text
keyString :: ScrubbedBytes -> Text
keyString = Text -> Text
sqlString (Text -> Text) -> (ScrubbedBytes -> Text) -> ScrubbedBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

sqlString :: Text -> Text
sqlString :: Text -> Text
sqlString Text
s = Text
quote Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
quote Text
"''" Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quote
  where
    quote :: Text
quote = Text
"'"

-- _printPragmas :: DB.Connection -> FilePath -> IO ()
-- _printPragmas db path = do
--   foreign_keys <- DB.query_ db "PRAGMA foreign_keys;" :: IO [[Int]]
--   print $ path <> " foreign_keys: " <> show foreign_keys
--   -- when run via sqlite-simple query for trusted_schema seems to return empty list
--   trusted_schema <- DB.query_ db "PRAGMA trusted_schema;" :: IO [[Int]]
--   print $ path <> " trusted_schema: " <> show trusted_schema
--   secure_delete <- DB.query_ db "PRAGMA secure_delete;" :: IO [[Int]]
--   print $ path <> " secure_delete: " <> show secure_delete
--   auto_vacuum <- DB.query_ db "PRAGMA auto_vacuum;" :: IO [[Int]]
--   print $ path <> " auto_vacuum: " <> show auto_vacuum

execSQL :: DB.Connection -> Text -> IO [Text]
execSQL :: Connection -> Text -> IO [Text]
execSQL Connection
db Text
query = do
  IORef [Text]
rs <- [Text] -> IO (IORef [Text])
forall a. a -> IO (IORef a)
newIORef []
  Database -> Text -> ExecCallback -> IO ()
SQLite3.execWithCallback (Connection -> Database
SQL.connectionHandle (Connection -> Database) -> Connection -> Database
forall a b. (a -> b) -> a -> b
$ Connection -> Connection
DB.conn Connection
db) Text
query (IORef [Text] -> ExecCallback
addSQLResultRow IORef [Text]
rs)
  [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> IO [Text] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [Text] -> IO [Text]
forall a. IORef a -> IO a
readIORef IORef [Text]
rs

addSQLResultRow :: IORef [Text] -> SQLite3.ColumnIndex -> [Text] -> [Maybe Text] -> IO ()
addSQLResultRow :: IORef [Text] -> ExecCallback
addSQLResultRow IORef [Text]
rs ColumnIndex
_count [Text]
names [Maybe Text]
values = IORef [Text] -> ([Text] -> [Text]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [Text]
rs (([Text] -> [Text]) -> IO ()) -> ([Text] -> [Text]) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
  [] -> [[Maybe Text] -> Text
showValues [Maybe Text]
values, Text -> [Text] -> Text
T.intercalate Text
"|" [Text]
names]
  [Text]
rs' -> [Maybe Text] -> Text
showValues [Maybe Text]
values Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
rs'
  where
    showValues :: [Maybe Text] -> Text
showValues = Text -> [Text] -> Text
T.intercalate Text
"|" ([Text] -> Text)
-> ([Maybe Text] -> [Text]) -> [Maybe Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Text) -> [Maybe Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"")