fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

printf debugging

Browse Source
This commit is contained in:
Gregor Kleen 2019-04-27 10:24:47 +02:00
parent 53db7803b7
commit 60d6d2eda5
1 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Application.hs
View File

@ -164,22 +164,31 @@ makeFoundation appSettings'@AppSettings{..} = do
f loc src lvl str f loc src lvl str
flip runLoggingT logFunc $ do flip runLoggingT logFunc $ do
$logDebugS "InstanceID" $ UUID.toText appInstanceID $logInfoS "InstanceID" $ UUID.toText appInstanceID
-- logDebugS "Configuration" $ tshow appSettings' -- 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 -- Create the database connection pool
$logDebugS "setup" "PostgreSQL-Pool"
sqlPool <- createPostgresqlPool sqlPool <- createPostgresqlPool
(pgConnStr appDatabaseConf) (pgConnStr appDatabaseConf)
(pgPoolSize 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. -- Perform database migration using our application's logging settings.
$logDebugS "setup" "Migration"
migrateAll `runSqlPool` sqlPool migrateAll `runSqlPool` sqlPool
$logDebugS "setup" "Cluster-Config"
appCryptoIDKey <- clusterSetting (Proxy :: Proxy 'ClusterCryptoIDKey) `runSqlPool` sqlPool appCryptoIDKey <- clusterSetting (Proxy :: Proxy 'ClusterCryptoIDKey) `runSqlPool` sqlPool
appSessionKey <- clusterSetting (Proxy :: Proxy 'ClusterClientSessionKey) `runSqlPool` sqlPool appSessionKey <- clusterSetting (Proxy :: Proxy 'ClusterClientSessionKey) `runSqlPool` sqlPool
appSecretBoxKey <- clusterSetting (Proxy :: Proxy 'ClusterSecretBoxKey) `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 let foundation = mkFoundation sqlPool smtpPool ldapPool appCryptoIDKey appSessionKey appSecretBoxKey appWidgetMemcached appJSONWebKeySet
$logDebugS "setup" "Job-Handling"
handleJobs foundation handleJobs foundation
-- Return the foundation -- Return the foundation
$logDebugS "setup" "Done"
return foundation return foundation
clusterSetting :: forall key m p. clusterSetting :: forall key m p.