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

feat(course admin): application restore

Browse Source
This commit is contained in:
ros 2021-08-17 11:42:14 +02:00
parent e2d43fd0de
commit cb4ed8d988
1 changed files with 12 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Application.hs
View File

@ -116,6 +116,8 @@ import qualified Utils.Pool as Custom
import Utils.Postgresql
import Handler.Utils.Memcached (manageMemcachedLocalInvalidations)
import qualified System.Clock as Clock
-- Import all relevant handler modules here.
-- (HPack takes care to add new modules to our cabal file nowadays.)
import Handler.News
@ -213,7 +215,7 @@ makeFoundation appSettings''@AppSettings{..} = do
-- from there, and then create the real foundation.
let
mkFoundation :: _ -> (forall m. MonadIO m => Custom.Pool' m DBConnLabel DBConnUseState SqlBackend) -> _
mkFoundation appSettings' appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey = UniWorX {..}
mkFoundation appSettings' appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache = UniWorX {..}
-- The UniWorX {..} syntax is an example of record wild cards. For more
-- information, see:
-- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
@ -233,6 +235,8 @@ makeFoundation appSettings''@AppSettings{..} = do
(error "MinioConn forced in tempFoundation")
(error "VerpSecret forced in tempFoundation")
(error "AuthKey forced in tempFoundation")
(error "PersonalisedSheetFilesSeedKey forced in tempFoundation")
(error "VolatileClusterSettingsCache forced in tempFoundation")
runAppLoggingT tempFoundation $ do
$logInfoS "InstanceID" $ UUID.toText appInstanceID
@ -293,6 +297,11 @@ makeFoundation appSettings''@AppSettings{..} = do
appClusterID <- clusterSetting (Proxy :: Proxy 'ClusterId) `customRunSqlPool` sqlPool
appVerpSecret <- clusterSetting (Proxy :: Proxy 'ClusterVerpSecret) `customRunSqlPool` sqlPool
appAuthKey <- clusterSetting (Proxy :: Proxy 'ClusterAuthKey) `customRunSqlPool` sqlPool
appPersonalisedSheetFilesSeedKey <- clusterSetting (Proxy :: Proxy 'ClusterPersonalisedSheetFilesSeedKey) `customRunSqlPool` sqlPool
let appVolatileClusterSettingsCacheTime' = Clock.fromNanoSecs ns
where (MkFixed ns :: Nano) = realToFrac appVolatileClusterSettingsCacheTime
appVolatileClusterSettingsCache <- newTVarIO $ mkVolatileClusterSettingsCache appVolatileClusterSettingsCacheTime'
needsRechunk <- exists [FileContentChunkContentBased !=. True] `customRunSqlPool` sqlPool
let appSettings' = appSettings''
@ -326,7 +335,7 @@ makeFoundation appSettings''@AppSettings{..} = do
$logDebugS "Runtime configuration" $ tshow appSettings'
let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey
let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache
-- Return the foundation
$logDebugS "setup" "Done"
@ -709,4 +718,4 @@ addPWEntry :: User
addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do
PWHashConf{..} <- getsYesod $ view _appAuthPWHash
(AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength
void $ insert User{..}
void $ insert User{..}