diff --git a/src/Application.hs b/src/Application.hs index b214df5ad..f5cbbde08 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -164,22 +164,31 @@ makeFoundation appSettings'@AppSettings{..} = do f loc src lvl str flip runLoggingT logFunc $ do - $logDebugS "InstanceID" $ UUID.toText appInstanceID + $logInfoS "InstanceID" $ UUID.toText appInstanceID -- logDebugS "Configuration" $ tshow appSettings' - smtpPool <- traverse createSmtpPool appSmtpConf + smtpPool <- for appSmtpConf $ \c -> do + $logDebugS "setup" "SMTP-Pool" + createSmtpPool - appWidgetMemcached <- traverse createWidgetMemcached appWidgetMemcachedConf + appWidgetMemcached <- for appWdigetMemcachedConf $ \c -> do + $logDebugS "setup" "Widget-Memcached" + createWidgetMemcached -- Create the database connection pool + $logDebugS "setup" "PostgreSQL-Pool" sqlPool <- createPostgresqlPool (pgConnStr appDatabaseConf) (pgPoolSize appDatabaseConf) - ldapPool <- for appLdapConf $ \LdapConf{..} -> createLdapPool ldapHost ldapPort (poolStripes ldapPool) (poolTimeout ldapPool) ldapTimeout (poolLimit ldapPool) + ldapPool <- for appLdapConf $ \LdapConf{..} -> do + $logDebugS "setup" "LDAP-Pool" + createLdapPool ldapHost ldapPort (poolStripes ldapPool) (poolTimeout ldapPool) ldapTimeout (poolLimit ldapPool) -- Perform database migration using our application's logging settings. + $logDebugS "setup" "Migration" migrateAll `runSqlPool` sqlPool + $logDebugS "setup" "Cluster-Config" appCryptoIDKey <- clusterSetting (Proxy :: Proxy 'ClusterCryptoIDKey) `runSqlPool` sqlPool appSessionKey <- clusterSetting (Proxy :: Proxy 'ClusterClientSessionKey) `runSqlPool` sqlPool appSecretBoxKey <- clusterSetting (Proxy :: Proxy 'ClusterSecretBoxKey) `runSqlPool` sqlPool @@ -187,9 +196,11 @@ makeFoundation appSettings'@AppSettings{..} = do let foundation = mkFoundation sqlPool smtpPool ldapPool appCryptoIDKey appSessionKey appSecretBoxKey appWidgetMemcached appJSONWebKeySet + $logDebugS "setup" "Job-Handling" handleJobs foundation -- Return the foundation + $logDebugS "setup" "Done" return foundation clusterSetting :: forall key m p.