module AirGQL.Types.PragmaConf (
  PragmaConf (..),
  getSQLitePragmas,
  defaultConf,
)
where

import Protolude (
  Bool (True),
  IO,
  Int,
  Integer,
  pure,
  show,
  ($),
  (<>),
 )

import Database.SQLite.Simple qualified as SS


data PragmaConf = PragmaConf
  { PragmaConf -> Int
maxPageCount :: Int
  , PragmaConf -> Integer
hardHeapLimit :: Integer
  , PragmaConf -> Bool
allowRecursTrig :: Bool
  }


defaultConf :: PragmaConf
defaultConf :: PragmaConf
defaultConf =
  PragmaConf
    { $sel:maxPageCount:PragmaConf :: Int
maxPageCount = Int
4096
    , $sel:hardHeapLimit:PragmaConf :: Integer
hardHeapLimit = Integer
500_000_000 -- Bytes
    , $sel:allowRecursTrig:PragmaConf :: Bool
allowRecursTrig = Bool
True
    }


-- | Get the SQLite pragmas to use for a database
getSQLitePragmas :: PragmaConf -> IO [SS.Query]
getSQLitePragmas :: PragmaConf -> IO [Query]
getSQLitePragmas PragmaConf
pragConf = do
  let
    getPrag :: Text -> Text -> Query
getPrag Text
key Text
value =
      Text -> Query
SS.Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"PRAGMA " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value

  [Query] -> IO [Query]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    [ Text -> Text -> Query
getPrag Text
"case_sensitive_like" Text
"True"
    , Text -> Text -> Query
getPrag Text
"foreign_keys" Text
"True"
    , -- TODO: Check if this really works
      Text -> Text -> Query
getPrag Text
"hard_heap_limit" (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ forall a b. (Show a, StringConv String b) => a -> b
show @Integer PragmaConf
pragConf.hardHeapLimit
    , Text -> Text -> Query
getPrag Text
"max_page_count" (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ forall a b. (Show a, StringConv String b) => a -> b
show @Int PragmaConf
pragConf.maxPageCount
    , Text -> Text -> Query
getPrag Text
"recursive_triggers" (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ forall a b. (Show a, StringConv String b) => a -> b
show @Bool PragmaConf
pragConf.allowRecursTrig
    , -- TODO: Reactivate after https://sqlite.org/forum/forumpost/d7b9a365e0
      --       (Also activate in SqlQuery.hs)
      -- , getPrag "trusted_schema" "False"
      Text -> Text -> Query
getPrag Text
"writable_schema" Text
"False"
    ]