{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module Simplex.Chat.Options.SQLite where

import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Char8 as B
import Foreign.C.String
import Options.Applicative
import Simplex.Chat.Store.SQLite.Migrations.M20251117_member_relations_vector
import Simplex.Messaging.Agent.Store.Interface (DBOpts (..))
import Simplex.Messaging.Agent.Store.SQLite.Common (SQLiteFuncDef (..), SQLiteFuncPtrs (..))
import Simplex.Messaging.Agent.Store.SQLite.DB (TrackQueries (..))
import System.FilePath (combine)

data ChatDbOpts = ChatDbOpts
  { ChatDbOpts -> FilePath
dbFilePrefix :: String,
    ChatDbOpts -> ScrubbedBytes
dbKey :: ScrubbedBytes,
    ChatDbOpts -> TrackQueries
trackQueries :: TrackQueries,
    ChatDbOpts -> Bool
vacuumOnMigration :: Bool
  }

chatDbOptsP :: FilePath -> FilePath -> Parser ChatDbOpts
chatDbOptsP :: FilePath -> FilePath -> Parser ChatDbOpts
chatDbOptsP FilePath
appDir FilePath
defaultDbName = do
  FilePath
dbFilePrefix <-
    Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"database"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd'
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DB_FILE"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path prefix to chat and agent database files"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (FilePath -> FilePath -> FilePath
combine FilePath
appDir FilePath
defaultDbName)
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault
      )
  ScrubbedBytes
dbKey <-
    Mod OptionFields ScrubbedBytes -> Parser ScrubbedBytes
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( FilePath -> Mod OptionFields ScrubbedBytes
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"key"
          Mod OptionFields ScrubbedBytes
-> Mod OptionFields ScrubbedBytes -> Mod OptionFields ScrubbedBytes
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields ScrubbedBytes
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'k'
          Mod OptionFields ScrubbedBytes
-> Mod OptionFields ScrubbedBytes -> Mod OptionFields ScrubbedBytes
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields ScrubbedBytes
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"KEY"
          Mod OptionFields ScrubbedBytes
-> Mod OptionFields ScrubbedBytes -> Mod OptionFields ScrubbedBytes
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields ScrubbedBytes
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Database encryption key/pass-phrase"
          Mod OptionFields ScrubbedBytes
-> Mod OptionFields ScrubbedBytes -> Mod OptionFields ScrubbedBytes
forall a. Semigroup a => a -> a -> a
<> ScrubbedBytes -> Mod OptionFields ScrubbedBytes
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value ScrubbedBytes
""
      )
  Bool
disableVacuum <-
    Mod FlagFields Bool -> Parser Bool
switch
      ( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"disable-vacuum"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Do not vacuum database after migrations"
      )
  pure
    ChatDbOpts
      { FilePath
dbFilePrefix :: FilePath
dbFilePrefix :: FilePath
dbFilePrefix,
        ScrubbedBytes
dbKey :: ScrubbedBytes
dbKey :: ScrubbedBytes
dbKey,
        trackQueries :: TrackQueries
trackQueries = Int64 -> TrackQueries
TQSlow Int64
5000, -- 5ms
        vacuumOnMigration :: Bool
vacuumOnMigration = Bool -> Bool
not Bool
disableVacuum
      }

migrationBackupPathP :: Parser (Maybe FilePath)
migrationBackupPathP :: Parser (Maybe FilePath)
migrationBackupPathP =
  Maybe FilePath
-> Mod FlagFields (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. a -> Mod FlagFields a -> Parser a
flag' Maybe FilePath
forall a. Maybe a
Nothing
    ( FilePath -> Mod FlagFields (Maybe FilePath)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"disable-backup"
        Mod FlagFields (Maybe FilePath)
-> Mod FlagFields (Maybe FilePath)
-> Mod FlagFields (Maybe FilePath)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields (Maybe FilePath)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Disable backup when migrating database"
    )
    Parser (Maybe FilePath)
-> Parser (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ((FilePath -> Maybe FilePath)
-> Parser FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption)
        ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"backup-directory"
            Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Directory to backup database for migration"
            Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
""
        )

dbString :: ChatDbOpts -> String
dbString :: ChatDbOpts -> FilePath
dbString ChatDbOpts {FilePath
dbFilePrefix :: ChatDbOpts -> FilePath
dbFilePrefix :: FilePath
dbFilePrefix} = FilePath
dbFilePrefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"_chat.db, " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
dbFilePrefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"_agent.db"

toDBOpts :: ChatDbOpts -> String -> Bool -> [SQLiteFuncDef] -> DBOpts
toDBOpts :: ChatDbOpts -> FilePath -> Bool -> [SQLiteFuncDef] -> DBOpts
toDBOpts ChatDbOpts {FilePath
dbFilePrefix :: ChatDbOpts -> FilePath
dbFilePrefix :: FilePath
dbFilePrefix, ScrubbedBytes
dbKey :: ChatDbOpts -> ScrubbedBytes
dbKey :: ScrubbedBytes
dbKey, TrackQueries
trackQueries :: ChatDbOpts -> TrackQueries
trackQueries :: TrackQueries
trackQueries, Bool
vacuumOnMigration :: ChatDbOpts -> Bool
vacuumOnMigration :: Bool
vacuumOnMigration} FilePath
dbSuffix Bool
keepKey [SQLiteFuncDef]
dbFunctions = do
  DBOpts
    { dbFilePath :: FilePath
dbFilePath = FilePath
dbFilePrefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
dbSuffix,
      [SQLiteFuncDef]
dbFunctions :: [SQLiteFuncDef]
dbFunctions :: [SQLiteFuncDef]
dbFunctions,
      ScrubbedBytes
dbKey :: ScrubbedBytes
dbKey :: ScrubbedBytes
dbKey,
      Bool
keepKey :: Bool
keepKey :: Bool
keepKey,
      vacuum :: Bool
vacuum = Bool
vacuumOnMigration,
      track :: TrackQueries
track = TrackQueries
trackQueries
    }

chatSuffix :: String
chatSuffix :: FilePath
chatSuffix = FilePath
"_chat.db"

agentSuffix :: String
agentSuffix :: FilePath
agentSuffix = FilePath
"_agent.db"

chatDBFunctions :: [SQLiteFuncDef]
chatDBFunctions :: [SQLiteFuncDef]
chatDBFunctions =
  [ ByteString -> CArgCount -> SQLiteFuncPtrs -> SQLiteFuncDef
SQLiteFuncDef ByteString
"migrate_relations_vector" CArgCount
3 (FunPtr SQLiteFunc -> FunPtr SQLiteFuncFinal -> SQLiteFuncPtrs
SQLiteAggrPtrs FunPtr SQLiteFunc
sqliteMemberRelationsStepPtr FunPtr SQLiteFuncFinal
sqliteMemberRelationsFinalPtr),
    ByteString -> CArgCount -> SQLiteFuncPtrs -> SQLiteFuncDef
SQLiteFuncDef ByteString
"set_member_vector_new_relation" CArgCount
4 (Bool -> FunPtr SQLiteFunc -> SQLiteFuncPtrs
SQLiteFuncPtr Bool
True FunPtr SQLiteFunc
sqliteSetMemberVectorNewRelationPtr)
  ]

mobileDbOpts :: CString -> CString -> IO ChatDbOpts
mobileDbOpts :: CString -> CString -> IO ChatDbOpts
mobileDbOpts CString
fp CString
key = do
  FilePath
dbFilePrefix <- CString -> IO FilePath
peekCString CString
fp
  ScrubbedBytes
dbKey <- ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> ScrubbedBytes) -> IO ByteString -> IO ScrubbedBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
B.packCString CString
key
  pure $
    ChatDbOpts
      { FilePath
dbFilePrefix :: FilePath
dbFilePrefix :: FilePath
dbFilePrefix,
        ScrubbedBytes
dbKey :: ScrubbedBytes
dbKey :: ScrubbedBytes
dbKey,
        trackQueries :: TrackQueries
trackQueries = Int64 -> TrackQueries
TQSlow Int64
5000, -- 5ms
        vacuumOnMigration :: Bool
vacuumOnMigration = Bool
True
      }

-- used to create new chat controller,
-- at that point database is already opened, and the key in options is not used
removeDbKey :: ChatDbOpts -> ChatDbOpts
removeDbKey :: ChatDbOpts -> ChatDbOpts
removeDbKey ChatDbOpts
opts = ChatDbOpts
opts {dbKey = ""} :: ChatDbOpts

errorDbStr :: DBOpts -> String
errorDbStr :: DBOpts -> FilePath
errorDbStr DBOpts {FilePath
dbFilePath :: DBOpts -> FilePath
dbFilePath :: FilePath
dbFilePath} = FilePath
dbFilePath