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