Merge pull request #303 from lehins/attempt-to-fix-slow-queries

Attempt to fix slow queries

bench/main.hs

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

indices

@@ -1,2 +1,3 @@
 create index nightly_snap on nightly(snap);
 create index snapshot_package_snapshot on snapshot_package(snapshot);
+create index snapshot_created on snapshot (created desc);

src/Settings.hs

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

src/Stackage/Database/Schema.hs

@@ -66,6 +66,7 @@ import RIO
 import RIO.Time
 import Types (CompilerP(..), FlagNameP, Origin, SnapName, VersionRangeP)
 import Settings (DatabaseSettings (..))
+import UnliftIO.Concurrent (getNumCapabilities)
 
 currentSchema :: Int
 currentSchema = 1
@@ -197,7 +198,9 @@ withStackageDatabase shouldLog dbs inner = do
     let makePool :: (MonadUnliftIO m, MonadLogger m) => m (Pool SqlBackend)
         makePool =
             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
                     pool <- createSqlitePool connStr size
                     runSqlPool (do