haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-12 04:08:29 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Infer pg pool size from number of caps by default

Browse Source
This commit is contained in:
Alexey Kuleshevich 2020-11-15 00:03:24 +03:00
parent 47ae6b8387
commit af20bc6291
No known key found for this signature in database
GPG Key ID: E59B216127119E3E
3 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bench/main.hs
View File

@ -36,8 +36,8 @@ runBenchApp pool m = runSimpleApp $ runSqlPool m pool
createBenchPool :: IO ConnectionPool createBenchPool :: IO ConnectionPool
createBenchPool = do createBenchPool = do
loadYamlSettingsArgs [configSettingsYmlValue] useEnv >>= \case loadYamlSettingsArgs [configSettingsYmlValue] useEnv >>= \case
AppSettings{appDatabase = DSPostgres pgString pgPoolSize} -> AppSettings{appDatabase = DSPostgres pgString _} ->
runNoLoggingT $ createPostgresqlPool (encodeUtf8 pgString) pgPoolSize runNoLoggingT $ createPostgresqlPool (encodeUtf8 pgString) 1
_ -> throwString "Benchmarks are crafted for PostgreSQL" _ -> throwString "Benchmarks are crafted for PostgreSQL"
releasePool :: ConnectionPool -> IO () releasePool :: ConnectionPool -> IO ()

2
src/Settings.hs
View File

@ -56,7 +56,7 @@ data AppSettings = AppSettings
} }
data DatabaseSettings data DatabaseSettings
= DSPostgres !Text !Int = DSPostgres !Text !(Maybe Int)
| DSSqlite !Text !Int | DSSqlite !Text !Int
parseDatabase parseDatabase

5
src/Stackage/Database/Schema.hs
View File

@ -66,6 +66,7 @@ import RIO
import RIO.Time import RIO.Time
import Types (CompilerP(..), FlagNameP, Origin, SnapName, VersionRangeP) import Types (CompilerP(..), FlagNameP, Origin, SnapName, VersionRangeP)
import Settings (DatabaseSettings (..)) import Settings (DatabaseSettings (..))
import UnliftIO.Concurrent (getNumCapabilities)
currentSchema :: Int currentSchema :: Int
currentSchema = 1 currentSchema = 1
@ -197,7 +198,9 @@ withStackageDatabase shouldLog dbs inner = do
let makePool :: (MonadUnliftIO m, MonadLogger m) => m (Pool SqlBackend) let makePool :: (MonadUnliftIO m, MonadLogger m) => m (Pool SqlBackend)
makePool = makePool =
case dbs of case dbs of
DSPostgres connStr size -> createPostgresqlPool (encodeUtf8 connStr) size DSPostgres connStr mSize -> do
size <- maybe getNumCapabilities pure mSize
createPostgresqlPool (encodeUtf8 connStr) size
DSSqlite connStr size -> do DSSqlite connStr size -> do
pool <- createSqlitePool connStr size pool <- createSqlitePool connStr size
runSqlPool (do runSqlPool (do