module AirGQL.Config (
  Config (..),
  maxGraphqlResultCount,
  defaultConfig,
)
where

import Data.Bool (Bool (False))
import Data.Int (Int)


-- | The maximum number of results allowed for the GraphiQL playground
maxGraphqlResultCount :: Int
maxGraphqlResultCount :: Int
maxGraphqlResultCount = Int
10000


data Config = Config
  { Config -> Int
maxTablesPerDb :: Int
  , Config -> Int
maxColumnsPerTable :: Int
  , Config -> Int
maxRowsPerTable :: Int
  , Config -> Int
maxVisibleCellsPerTable :: Int
  , Config -> Int
maxDbSize :: Int -- Bytes
  , Config -> Int
maxCellSize :: Int -- Bytes
  , Config -> Int
hardHeapLimit :: Int -- Bytes
  , Config -> Int
sqlTimeoutTime :: Int -- Seconds
  , Config -> Bool
allowRecursiveTriggers :: Bool
  }


defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
  Config
    { $sel:maxTablesPerDb:Config :: Int
maxTablesPerDb = Int
100
    , $sel:maxColumnsPerTable:Config :: Int
maxColumnsPerTable = Int
500
    , $sel:maxRowsPerTable:Config :: Int
maxRowsPerTable = Int
100_000
    , $sel:maxVisibleCellsPerTable:Config :: Int
maxVisibleCellsPerTable = Int
0 -- Not used currently
    , $sel:maxDbSize:Config :: Int
maxDbSize = Int
100_000_000 -- Bytes
    , $sel:maxCellSize:Config :: Int
maxCellSize = Int
10_000_000 -- Bytes
    , $sel:hardHeapLimit:Config :: Int
hardHeapLimit = Int
500_000_000 -- Bytes
    , $sel:sqlTimeoutTime:Config :: Int
sqlTimeoutTime = Int
20
    , $sel:allowRecursiveTriggers:Config :: Bool
allowRecursiveTriggers = Bool
False
    }