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

refactor(avs): switch some runDB to runDBRead

Browse Source
This commit is contained in:
Steffen Jost 2024-08-09 17:59:14 +02:00
parent 760b102d52
commit f4823aaf28
2 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Foundation/Type.hs
View File

@ -15,7 +15,7 @@ module Foundation.Type
, _memcachedLocalARC , _memcachedLocalARC
, SMTPPool , SMTPPool
, _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport, _appMemcached, _appUploadCache, _appVerpSecret, _appAuthKey, _appPersonalisedSheetFilesSeedKey, _appVolatileClusterSettingsCache, _appAvsQuery , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport, _appMemcached, _appUploadCache, _appVerpSecret, _appAuthKey, _appPersonalisedSheetFilesSeedKey, _appVolatileClusterSettingsCache, _appAvsQuery
, DB, Form, MsgRenderer, MailM, DBFile , DB, DBRead, Form, MsgRenderer, MailM, DBFile
) where ) where
import Import.NoFoundation import Import.NoFoundation
@ -125,6 +125,7 @@ instance (MonadHandler m, HandlerSite m ~ UniWorX) => ReadLogSettings m where
type DB = YesodDB UniWorX type DB = YesodDB UniWorX
type DBRead = ReaderT SqlReadBackend (HandlerFor UniWorX)
type Form x = Html -> MForm (HandlerFor UniWorX) (FormResult x, WidgetFor UniWorX ()) type Form x = Html -> MForm (HandlerFor UniWorX) (FormResult x, WidgetFor UniWorX ())
type MsgRenderer = MsgRendererS UniWorX -- see Utils type MsgRenderer = MsgRendererS UniWorX -- see Utils
type MailM a = MailT (HandlerFor UniWorX) a type MailM a = MailT (HandlerFor UniWorX) a

6
src/Handler/Utils/Avs.hs
View File

@ -919,7 +919,7 @@ retrieveDifferingLicencesStatus = retrieveDifferingLicences' True
retrieveDifferingLicences' :: Bool -> Handler ((AvsLicenceDifferences, Set AvsPersonId), AvsPersonIdMapPersonCard) retrieveDifferingLicences' :: Bool -> Handler ((AvsLicenceDifferences, Set AvsPersonId), AvsPersonIdMapPersonCard)
retrieveDifferingLicences' getStatus = do retrieveDifferingLicences' getStatus = do
#ifdef DEVELOPMENT #ifdef DEVELOPMENT
avsUsrs <- runDB $ selectList [] [LimitTo 444] avsUsrs <- runDBRead $ selectList [] [LimitTo 444]
let allLicences = AvsResponseGetLicences $ Set.fromList $ let allLicences = AvsResponseGetLicences $ Set.fromList $
[ AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 77 -- AVS:1 FD:2 [ AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 77 -- AVS:1 FD:2
, AvsPersonLicence AvsLicenceRollfeld $ AvsPersonId 12345678 -- AVS:2 FD:1 , AvsPersonLicence AvsLicenceRollfeld $ AvsPersonId 12345678 -- AVS:2 FD:1
@ -967,7 +967,7 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
vorORrollfeld = Set.map avsLicencePersonID vorORrollfeld' vorORrollfeld = Set.map avsLicencePersonID vorORrollfeld'
rollfeld = Set.map avsLicencePersonID rollfeld' rollfeld = Set.map avsLicencePersonID rollfeld'
antijoinAvsLicences :: AvsLicence -> Set AvsPersonId -> DB (Set AvsPersonId,Set AvsPersonId) antijoinAvsLicences :: AvsLicence -> Set AvsPersonId -> DBRead (Set AvsPersonId,Set AvsPersonId)
antijoinAvsLicences lic avsLics = fmap unwrapIds $ antijoinAvsLicences lic avsLics = fmap unwrapIds $
E.select $ do E.select $ do
((_qauli :& _qualUser :& usrAvs) :& excl) <- ((_qauli :& _qualUser :& usrAvs) :& excl) <-
@ -993,7 +993,7 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
aux (E.Value(Just api), _) (l,r) = (Set.insert api l, r) aux (E.Value(Just api), _) (l,r) = (Set.insert api l, r)
aux _ acc = acc -- should never occur aux _ acc = acc -- should never occur
((vorfGrant, vorfRevoke), (rollGrant, rollRevoke)) <- runDB $ (,) ((vorfGrant, vorfRevoke), (rollGrant, rollRevoke)) <- runDBRead $ (,)
<$> antijoinAvsLicences AvsLicenceVorfeld vorORrollfeld <$> antijoinAvsLicences AvsLicenceVorfeld vorORrollfeld
<*> antijoinAvsLicences AvsLicenceRollfeld rollfeld <*> antijoinAvsLicences AvsLicenceRollfeld rollfeld
let setTo0 = vorfRevoke -- revoke driving licences let setTo0 = vorfRevoke -- revoke driving licences