From 99f03078a1c46adbd1119afec8473d19a3e10417 Mon Sep 17 00:00:00 2001
From: Steffen <s.jost@fraport.de>
Date: Tue, 2 Jul 2024 17:37:34 +0200
Subject: [PATCH] chore(db): use runDBRead more often

---
 src/Handler/Admin/Avs.hs           |  71 +++++++-------
 src/Handler/Course/Register.hs     |   4 +-
 src/Handler/Firm.hs                |   6 +-
 src/Handler/LMS.hs                 | 144 ++++++++++++++---------------
 src/Handler/Profile.hs             |   2 +-
 src/Handler/SAP.hs                 |  48 +++++-----
 src/Handler/Users.hs               |   6 +-
 src/Handler/Utils/Avs.hs           |  16 ++--
 src/Handler/Utils/Qualification.hs |  14 +--
 src/Handler/Utils/Widgets.hs       |   4 +-
 src/Jobs/Handler/SynchroniseAvs.hs |  38 ++++----
 11 files changed, 177 insertions(+), 176 deletions(-)

diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs
index 65705b218..b8c0926fc 100644
--- a/src/Handler/Admin/Avs.hs
+++ b/src/Handler/Admin/Avs.hs
@@ -159,7 +159,7 @@ postAdminAvsR = do
           $nothing
             AVS nicht konfiguriert!
         |]
-  
+
   ((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing
 
   let procFormPerson :: AvsQueryPerson -> Handler (Maybe (Maybe Widget, Maybe AvsPersonId))
@@ -168,7 +168,7 @@ postAdminAvsR = do
         try (avsQuery fr) >>= \case
           Left err  -> return $ Just (Just $ exceptionWgt err, Nothing)
           Right (AvsResponsePerson pns) -> do
-            let mapid = case Set.toList pns of 
+            let mapid = case Set.toList pns of
                           [AvsDataPerson{avsPersonPersonID=apid}] -> Just apid
                           _ -> Nothing
                 wgt = [whamlet|
@@ -178,12 +178,12 @@ postAdminAvsR = do
                       |] -- <li>#{decodeUtf8 (Pretty.encodePretty (toJSON p))}
             return $ Just (toMaybe (notNull pns) wgt, mapid)
   (mbPerson,mapid) <- fromMaybe (Nothing,Nothing) <$> formResultMaybe presult procFormPerson
-  
+
   ((sresult', swidget), senctype) <- runFormPost $ makeAvsStatusForm mapid
   let sresult = sresult' <|> maybe FormMissing (FormSuccess . AvsQueryStatus . Set.singleton) mapid -- use unique AvsId from PersonSearch for convenience, if form was empty
       procFormStatus fr = do
         addMessage Info $ text2Html $ "Status Query: " <> tshow (toJSON fr)
-        tryShow $ do 
+        tryShow $ do
           AvsResponseStatus pns <- avsQuery fr
           return [whamlet|
               <ul>
@@ -203,9 +203,9 @@ postAdminAvsR = do
                 $forall AvsDataContact{..} <- pns
                   <li>
                     <ul>
-                      <li>AvsId: #{tshow avsContactPersonID}                      
+                      <li>AvsId: #{tshow avsContactPersonID}
                       <li>^{jsonWidget avsContactPersonInfo}
-                      <li>^{jsonWidget avsContactFirmInfo}              
+                      <li>^{jsonWidget avsContactFirmInfo}
             |] -- <li>#{decodeUtf8 (Pretty.encodePretty (toJSON avsContactPersonInfo))}
   mbContact <- formResultMaybe cresult (Just <<$>> procFormContact)
 
@@ -560,15 +560,15 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
         , sortable (Just "avspersonno")  (i18nCell MsgAvsPersonNo)    $ \(view  resultUserAvs -> a) -> avsPersonNoLinkedCellAdmin a
         -- , colUserCompany
         , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \(view (resultUser . _entityKey) -> uid) -> flip (set' cellContents) mempty $ do -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
-            companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
+            companies' <- liftHandler . runDBRead . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
               E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
               E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
               E.orderBy [E.asc (comp E.^. CompanyName)]
               return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
             let icnSuper  = toWidget $ text2markup " " <> icon IconSupervisor
-                companies = 
+                companies =
                   (\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmUsersR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
-                
+
             pure $ intercalate (text2widget "; ") companies
         , sortable (Just "qualification") (i18nCell MsgTableQualifications)          $ \(preview   resultQualification -> q) -> cellMaybe lmsShortCell q
         , sortable (Just "first-held")    (i18nCell MsgTableQualificationFirstHeld)  $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld   -> d)  -> cellMaybe dayCell d
@@ -639,8 +639,8 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
       mkOption :: E.Value Text -> Option Text
       mkOption (E.unValue -> t) = Option{ optionDisplay = t, optionInternalValue = t, optionExternalValue = toPathPiece t }
       suggestionsBlock :: HandlerFor UniWorX (OptionList Text)
-      suggestionsBlock   = mkOptionList . fmap mkOption <$> runDB (getBlockReasons E.not_)
-      suggestionsUnblock = mkOptionList . fmap mkOption <$> runDB (getBlockReasons id)
+      suggestionsBlock   = mkOptionList . fmap mkOption <$> runDBRead (getBlockReasons E.not_)
+      suggestionsUnblock = mkOptionList . fmap mkOption <$> runDBRead (getBlockReasons id)
 
       acts :: Map LicenceTableAction (AForm Handler LicenceTableActionData)
       acts = mconcat
@@ -697,22 +697,22 @@ instance Button UniWorX UserAvsAction where
 
 
 getAdminAvsUserR,  postAdminAvsUserR :: CryptoUUIDUser -> Handler Html
-getAdminAvsUserR = postAdminAvsUserR 
-postAdminAvsUserR uuid = do    
+getAdminAvsUserR = postAdminAvsUserR
+postAdminAvsUserR uuid = do
     isModal <- hasCustomHeader HeaderIsModal
-    
+
     uid <- decrypt uuid
-    Entity{entityVal=UserAvs{..}} <- runDB $ getBy404 $ UniqueUserAvsUser uid 
+    Entity{entityVal=UserAvs{..}} <- runDB $ getBy404 $ UniqueUserAvsUser uid
     -- let fltrById prj = over _Wrapped (Set.filter ((== userAvsPersonId) . prj)) -- not sufficiently polymorphic
     let fltrIdContact = over _Wrapped (Set.filter ((== userAvsPersonId) . avsContactPersonID))
-        -- fltrIdStatus  = over _Wrapped (Set.filter ((== userAvsPersonId) . avsStatusPersonID))      
+        -- fltrIdStatus  = over _Wrapped (Set.filter ((== userAvsPersonId) . avsStatusPersonID))
     mbContact <- try $ fmap fltrIdContact $ avsQuery $ AvsQueryContact $ Set.singleton $ AvsObjPersonId userAvsPersonId
     -- mbStatus  <- try $ fmap fltrIdStatus  $ avsQuery $ AvsQueryStatus  $ Set.singleton                  userAvsPersonId
     mbStatus <- try $ queryAvsFullStatus userAvsPersonId -- TODO: delete Handler.Utils.Avs.lookupAvsUser if no longer needed -- NOTE: currently needed to provide card firms that are missing in AVS status query responses
     let compsUsed :: [CompanyName] = stripCI <$> mbStatus ^.. _Right . _Wrapped . folded . _avsStatusPersonCardStatus . folded . _avsDataFirm . _Just
-    compDict <- if 1 >= length compsUsed 
+    compDict <- if 1 >= length compsUsed
       then return mempty -- switch company only sensible if there is more than one company to choose
-      else do         
+      else do
         let switchCompFormHandler :: [(CompanyName,CompanyId)] -> Maybe CompanyId -> Handler Widget
             switchCompFormHandler availComps      _  | 1 >= length availComps = return mempty    -- don't offer a form if there is only one company
             switchCompFormHandler availComps mbPrime = do
@@ -722,20 +722,20 @@ postAdminAvsUserR uuid = do
                       <*> areq (selectFieldList [(ciOriginal cn, cid) | (cn, cid) <- availComps]) (fslI MsgUserAvsSwitchCompanyField) mbPrime
                       <*  aopt (buttonField UserAvsSwitchCompany) "" Nothing
                     switchCompValidate :: FormValidator (CryptoUUIDUser,CompanyId) Handler ()
-                    switchCompValidate = do 
+                    switchCompValidate = do
                       (uuid_rcvd,_) <- State.get
-                      guardValidation MsgWrongButtonValue $ uuid_rcvd == uuid                  
+                      guardValidation MsgWrongButtonValue $ uuid_rcvd == uuid
                 ((spRes, spWgt), spEnc) <- runFormPost . validateForm switchCompValidate . identifyForm ("switch-primary-company"::Text) $ renderAForm FormStandard switchCompForm
                 formResultModal spRes (AdminAvsUserR uuid) (\(_,cid) -> do
                     lift $ $logInfoS "AVS" ("Switch company option result " <> tshow spRes)
-                    problems <- liftHandler . runDB $ do 
+                    problems <- liftHandler . runDB $ do
                       (usrUp, problems) <- switchAvsUserCompany True False uid cid
                       update uid usrUp
                       forM problems $ \p -> reportAdminProblem p >> msgAdminProblem p
-                    forM_ problems (\p -> do 
+                    forM_ problems (\p -> do
                         -- lift $ $logErrorS "AVS" $ "Switch company problem: " <> tshow p -- no instance Show for SomeMessages
                         tell . pure =<< messageI Warning p
-                      )      
+                      )
                     let ok = if null problems then Success else Error
                     tell . pure =<< messageI ok (MsgUserAvsCompanySwitched $ unCompanyKey cid)
                   )
@@ -758,10 +758,10 @@ postAdminAvsUserR uuid = do
       setTitle $ toHtml $ show userAvsNoPerson
       let contactWgt = case mbContact of
             Left err -> exceptionWgt err
-            Right (AvsResponseContact adcs) -> 
+            Right (AvsResponseContact adcs) ->
               if null adcs
                 then [whamlet|_{MsgAvsPersonSearchEmpty}|]
-                else 
+                else
                   let cs = mkContactWgt warnBolt userAvsNoPerson <$> toList adcs
                   in  mconcat cs
           cardsWgt = case mbStatus of
@@ -779,14 +779,14 @@ postAdminAvsUserR uuid = do
           ^{cardsWgt}
         <p>
           _{MsgAvsCurrentData}
-      |]        
-  where 
+      |]
+  where
     mkContactWgt :: Widget -> Int -> AvsDataContact -> Widget
     mkContactWgt warnBolt reqAvsNo AvsDataContact
       { -- avsContactPersonID = _api
         avsContactPersonInfo = AvsPersonInfo{..}
       , avsContactFirmInfo   = AvsFirmInfo{ avsFirmFirm = firmName }
-      } = 
+      } =
       let avsNoOk = readMay avsInfoPersonNo /= Just reqAvsNo in
       [whamlet|
         <section .profile>
@@ -794,8 +794,8 @@ postAdminAvsUserR uuid = do
             $if avsNoOk
               <dt .deflist__dt>
                 _{MsgAvsPersonNo}
-              <dd .deflist__dd>                    
-                #{avsInfoPersonNo} 
+              <dd .deflist__dd>
+                #{avsInfoPersonNo}
                 ^{warnBolt}
                 _{MsgAvsPersonNoMismatch}
             <dt .deflist__dt>
@@ -826,7 +826,7 @@ postAdminAvsUserR uuid = do
 
     -- mkCardsWgt :: (Maybe CompanyName, Map CompanyName Widget, Widget) -> Set AvsDataPersonCard -> Widget
     mkCardsWgt :: (Maybe CompanyName, Widget) -> Set AvsDataPersonCard -> Widget
-    mkCardsWgt (mbPrimName, swForm) crds 
+    mkCardsWgt (mbPrimName, swForm) crds
       | null crds = [whamlet|_{MsgAvsCardsEmpty}|]
       | otherwise = do
         let hasCompany     = isJust $ Set.foldr ((<|>) . avsDataFirm)       Nothing crds -- some if, since a true AVS status query never delivers values for these fields, but queryAvsFullStatus-workaround does
@@ -844,7 +844,7 @@ postAdminAvsUserR uuid = do
                   $if hasIssueDate
                     <th .table__th>_{MsgTableAvsCardIssueDate}
                   $if hasValidToDate
-                    <th .table__th>_{MsgTableAvsCardValidTo}        
+                    <th .table__th>_{MsgTableAvsCardValidTo}
                   $if hasCompany
                     <th .table__th>_{MsgTableCompany}
                     <th .table__th>_{MsgAvsPrimaryCompany}
@@ -865,7 +865,7 @@ postAdminAvsUserR uuid = do
                         <td .table__td>
                           $maybe d <- avsDataIssueDate
                             ^{formatTimeW SelFormatDate d}
-                      $if hasValidToDate                    
+                      $if hasValidToDate
                         <td .table__td>
                           $maybe d <- avsDataValidTo
                             ^{formatTimeW SelFormatDate d}
@@ -903,13 +903,13 @@ getProblemAvsErrorR = do
           E.where_ $ E.isJust $ usravs E.^. UserAvsLastSynchError
           return (usravs, user) -- , E.substring (usravs E.^. UserAvsLastSynchError) (E.val ("'#\"%#\" %'") (E.val "#")) -- needs a different type on substring
         qerryUsrAvs :: (E.SqlExpr (Entity UserAvs) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity UserAvs)
-        qerryUsrAvs   = $(E.sqlIJproj 2 1) 
+        qerryUsrAvs   = $(E.sqlIJproj 2 1)
         qerryUser   :: (E.SqlExpr (Entity UserAvs) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity User)
         qerryUser     = $(E.sqlIJproj 2 2)
         reserrUsrAvs :: Lens' (DBRow (Entity UserAvs, Entity User)) (Entity UserAvs)
         reserrUsrAvs  = _dbrOutput . _1
         -- reserrUser   :: Lens' (DBRow (Entity UserAvs, Entity User)) (Entity User)
-        -- reserrUser    = _dbrOutput . _2        
+        -- reserrUser    = _dbrOutput . _2
         dbtRowKey = qerryUsrAvs >>> (E.^. UserAvsId)
         dbtProj = dbtProjId
         dbtColonnade = dbColonnade $ mconcat
@@ -949,4 +949,3 @@ getProblemAvsErrorR = do
   siteLayoutMsg MsgMenuAvsSynchError $ do
     setTitleI MsgMenuAvsSynchError
     [whamlet|^{avsSyncErrTbl}|]
-    
\ No newline at end of file
diff --git a/src/Handler/Course/Register.hs b/src/Handler/Course/Register.hs
index 611c52e70..cda46ab7f 100644
--- a/src/Handler/Course/Register.hs
+++ b/src/Handler/Course/Register.hs
@@ -68,7 +68,7 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
       | otherwise
         -> return $ FormSuccess ()
 
-    mayViewCourseAfterDeregistration <- liftHandler . runDB $ E.selectExists . E.from $ \course -> do
+    mayViewCourseAfterDeregistration <- liftHandler . runDBRead $ E.selectExists . E.from $ \course -> do
       E.where_ $  course E.^. CourseId E.==. E.val cid
            E.&&. (       isSchoolAdminLike muid ata (course E.^. CourseSchool)
                    E.||. mayEditCourse muid ata course
@@ -92,7 +92,7 @@ courseMayReRegister :: Entity Course -> DB Bool
 courseMayReRegister (Entity cid Course{..}) = do
   registrations <- count [ CourseParticipantState ==. CourseParticipantActive, CourseParticipantCourse ==. cid ]
   let capacity = maybe True (>= registrations) courseCapacity
-  
+
   wouldHaveWriteAccessTo [(AuthCapacity, capacity), (AuthCourseRegistered, False)] $ CourseR courseTerm courseSchool courseShorthand CRegisterR
 
 
diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs
index d6d4c28e2..666f4968d 100644
--- a/src/Handler/Firm.hs
+++ b/src/Handler/Firm.hs
@@ -119,7 +119,7 @@ firmActionHandler route isAdmin = flip formResult faHandler
     faHandler (_,fids) | null fids = addMessageI Error MsgNoCompanySelected
 
     faHandler (FirmActNotifyData, Set.toList -> fids) = do
-      usrs <- runDB $ E.select $ E.distinct $ do
+      usrs <- runDBRead $ E.select $ E.distinct $ do
         (usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
         E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList fids
         return $ usr E.^. UserId
@@ -1374,14 +1374,14 @@ handleFirmCommR ultDest cs = do
     csKeys = CompanyKey <$> cs
   mbUser <- maybeAuthId
   -- get employees of chosen companies
-  empys <- mkCompanyUsrList <$> runDB (E.select $ do
+  empys <- mkCompanyUsrList <$> runDBRead (E.select $ do
       (emp :& cmp) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& cmp) -> emp E.^. UserId E.==. cmp E.^. UserCompanyUser)
       E.where_ $ cmp E.^. UserCompanyCompany `E.in_` E.valList csKeys
       E.orderBy [E.ascNullsFirst $ cmp E.^. UserCompanyCompany]
       return (E.just $ cmp E.^. UserCompanyCompany, emp E.^. UserId)
     )
   -- get supervisors of employees
-  sprs <- mkCompanyUsrList <$> runDB (E.select $ do
+  sprs <- mkCompanyUsrList <$> runDBRead (E.select $ do
       (spr :& cmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany `E.on` (\(spr :& cmp) -> spr E.^. UserId E.=?. cmp E.?. UserCompanyUser)
       E.where_ $ (E.isTrue (cmp E.?. UserCompanySupervisor) E.&&. cmp E.?. UserCompanyCompany `E.in_` E.justValList csKeys)
         E.||. (spr E.^. UserId E.=?. E.val mbUser)
diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs
index db45e0f11..b86f41ba9 100644
--- a/src/Handler/LMS.hs
+++ b/src/Handler/LMS.hs
@@ -19,7 +19,7 @@ module Handler.LMS
   , getLmsFakeR           , postLmsFakeR
   , getLmsUserR
   , getLmsUserSchoolR
-  , getLmsUserAllR     
+  , getLmsUserAllR
   )
   where
 
@@ -81,11 +81,11 @@ postLmsAllR = do
   mbBtnForm <- if not isAdmin then return Nothing else do
     ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonManualLms)
     case btnResult of
-      (FormSuccess BtnLmsEnqueue) -> 
-        queueJob' JobLmsQualificationsEnqueue 
+      (FormSuccess BtnLmsEnqueue) ->
+        queueJob' JobLmsQualificationsEnqueue
         >> addMessage Info "Einreihung ablaufender Qualifikationen zum LMS wird nun im Hintergund durchgeführt."
-      (FormSuccess BtnLmsDequeue) -> 
-        queueJob' JobLmsQualificationsDequeue 
+      (FormSuccess BtnLmsDequeue) ->
+        queueJob' JobLmsQualificationsDequeue
         >> addMessage Info "Benachrichtigung abgelaufener Qualifikationen und Aufräumen beendeter LMS Nutzer wird im Hintergund ausgeführt."
       FormMissing -> return ()
       _other -> addMessage Warning "Kein korrekter LMS Knopf erkannt"
@@ -112,20 +112,20 @@ resultAllQualificationActive = _dbrOutput . _2 . _unValue
 resultAllQualificationTotal  :: Lens' AllQualificationTableData Word64
 resultAllQualificationTotal  = _dbrOutput . _3 . _unValue
 
-  
+
 mkLmsAllTable :: Bool -> Int -> DB (Any, Widget)
 mkLmsAllTable isAdmin lmsDeletionDays = do
-  svs <- getSupervisees   
+  svs <- getSupervisees
   let
     resultDBTable = DBTable{..}
       where
         dbtSQLQuery quali = do
-          let filterSvs luser = luser Ex.^. LmsUserQualification Ex.==. quali Ex.^. QualificationId                  
+          let filterSvs luser = luser Ex.^. LmsUserQualification Ex.==. quali Ex.^. QualificationId
                          Ex.&&. (E.val isAdmin E.||. luser Ex.^. LmsUserUser `Ex.in_` E.vals svs)
-              cusers = Ex.subSelectCount $ do 
+              cusers = Ex.subSelectCount $ do
                 luser <- Ex.from $ Ex.table @LmsUser
-                Ex.where_ $ filterSvs luser 
-              cactive = Ex.subSelectCount $ do 
+                Ex.where_ $ filterSvs luser
+              cactive = Ex.subSelectCount $ do
                 luser <- Ex.from $ Ex.table @LmsUser
                 Ex.where_ $ filterSvs luser Ex.&&. E.isNothing (luser E.^. LmsUserStatus)
           -- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem
@@ -155,15 +155,15 @@ mkLmsAllTable isAdmin lmsDeletionDays = do
               foldMap (textCell . formatCalendarDiffDays . fromMonths) . view (resultAllQualification . _qualificationAuditDuration)
           , sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
                                                                         $ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
-          , sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip) 
+          , sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip)
                   $ \(view (resultAllQualification . _qualificationAvsLicence) -> licence) -> maybeCell licence $ textCell . T.singleton . licence2char
-          , sortable Nothing (i18nCell MsgTableQualificationSapExport & cellTooltip MsgTableQualificationSapExportTooltip)  
+          , sortable Nothing (i18nCell MsgTableQualificationSapExport & cellTooltip MsgTableQualificationSapExportTooltip)
                   $ \(view (resultAllQualification . _qualificationSapId) -> mbSapId) ->
                       let icn = IconOK -- change icon here, if desired
-                      in case mbSapId of 
+                      in case mbSapId of
                         Nothing               -> mempty
                         Just sapId | isAdmin  -> cellTooltipIcon (Just icn) (text2message sapId) mempty
-                        Just _                -> iconCell icn 
+                        Just _                -> iconCell icn
           , adminable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip)
                   $ \(view resultAllQualificationActive -> n) -> wgtCell $ word2widget n
           , adminable Nothing (i18nCell MsgTableQualificationCountTotal) $ wgtCell . word2widget . view resultAllQualificationTotal
@@ -342,7 +342,7 @@ instance HasEntity LmsTableData QualificationUser where
   hasEntity = resultQualUser
 
 instance HasQualificationUser LmsTableData where
-  hasQualificationUser = resultQualUser . _entityVal  
+  hasQualificationUser = resultQualUser . _entityVal
 
 data LmsTableAction = LmsActNotify
                     | LmsActRenewNotify
@@ -351,7 +351,7 @@ data LmsTableAction = LmsActNotify
                     | LmsActRestart
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
   deriving anyclass (Universe, Finite)
-  
+
 nullaryPathPiece ''LmsTableAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''LmsTableAction id
 
@@ -360,12 +360,12 @@ data LmsTableActionData = LmsActNotifyData
                         | LmsActRenewPinData            -- no longer used
                         | LmsActResetData
                             { lmsActRestartExtend  :: Maybe Integer
-                            , lmsActRestartUnblock :: Maybe Bool 
+                            , lmsActRestartUnblock :: Maybe Bool
                             , lmsActRestartNotify  :: Maybe Bool
                             }
-                        | LmsActRestartData  
+                        | LmsActRestartData
                             { lmsActRestartExtend  :: Maybe Integer
-                            , lmsActRestartUnblock :: Maybe Bool 
+                            , lmsActRestartUnblock :: Maybe Bool
                             , lmsActRestartNotify  :: Maybe Bool
                             }
   deriving (Eq, Ord, Read, Show, Generic)
@@ -407,14 +407,14 @@ lmsTableQuery now qid (qualUser `E.InnerJoin` user `E.InnerJoin` lmsUser `E.Left
     E.on $ user E.^. UserId E.==. lmsUser  E.^. LmsUserUser
             E.&&. E.val qid E.==. lmsUser  E.^. LmsUserQualification            -- NOTE: condition was once erroneously placed in where-clause, which does not work
     E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
-    E.where_ $    E.val qid E.==. qualUser E.^. QualificationUserQualification        
+    E.where_ $    E.val qid E.==. qualUser E.^. QualificationUserQualification
     -- Letztes Datum anzeigen, wenn mehrere, dann diese in klickbaren Tooltip verstecken!
     let printAcknowledged = E.subSelectMaybe . E.from $ \pj -> do
                     E.where_ $ E.isJust (pj E.^. PrintJobLmsUser)
                         E.&&. ((lmsUser E.^. LmsUserIdent) E.=?. (pj E.^. PrintJobLmsUser))
                     let pjOrder = [E.desc $ pj E.^. PrintJobCreated, E.desc $ pj E.^. PrintJobAcknowledged] -- latest created comes first! This is assumed to be the case later on!
                     pure $ --(E.arrayAggWith E.AggModeAll (pj E.^. PrintJobCreated     ) pjOrder, -- return two aggregates only works with select, the restricted type of subSelect does not seem to support this!
-                           E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) pjOrder                                                        
+                           E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) pjOrder
     return (qualUser, user, lmsUser, qualBlock, printAcknowledged, validQualification now qualUser)
 
 
@@ -423,17 +423,17 @@ mkLmsTable :: ( Functor h, ToSortable h
               )
            => Bool
            -> Entity Qualification
-           -> Map LmsTableAction (AForm Handler LmsTableActionData)           
+           -> Map LmsTableAction (AForm Handler LmsTableActionData)
            -> (Map CompanyId Company -> cols)
            -> PSValidator (MForm Handler) (FormResult (First LmsTableActionData, DBFormResult UserId Bool LmsTableData))
            -> DB (FormResult (LmsTableActionData, Set UserId), Widget)
 mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
   now <- liftIO getCurrentTime
-  -- lookup all companies 
-  cmpMap <- memcachedBy (Just . Right $ 5 * diffMinute) ("CompanyDictionary"::Text) $ do 
+  -- lookup all companies
+  cmpMap <- memcachedBy (Just . Right $ 5 * diffMinute) ("CompanyDictionary"::Text) $ do
     cmps <- selectList [] [] -- [Asc CompanyShorthand]
     return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps
-  let            
+  let
     csvName = T.replace " " "-" $ ciOriginal (quali ^. _qualificationName)
     dbtIdent :: Text
     dbtIdent = "lms"
@@ -486,19 +486,19 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
       --   )
       , single ("notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.^. LmsUserNotified)))
       , single ("avs-number"  , FilterColumn . E.mkExistsFilter $ \row criterion ->
-              E.from $ \usrAvs -> -- do 
+              E.from $ \usrAvs -> -- do
                 E.where_ $ usrAvs E.^. UserAvsUser      E.==. queryUser row E.^. UserId
                     E.&&.  ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) E.==.
                           (E.explicitUnsafeCoerceSqlExprValue "citext" (usrAvs E.^. UserAvsNoPerson) :: E.SqlExpr (E.Value (CI Text))) ))
       , single ("user-company", FilterColumn . E.mkExistsFilter $ \row criterion ->
-              E.from $ \(usrComp `E.InnerJoin` comp) -> do 
+              E.from $ \(usrComp `E.InnerJoin` comp) -> do
                 let testname = (E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf`
                                 (E.explicitUnsafeCoerceSqlExprValue "citext" (comp E.^. CompanyName) :: E.SqlExpr (E.Value (CI Text)))
                     testnumber nr = E.val nr E.==. comp E.^. CompanyAvsId
                     testcrit = maybe testname testnumber $ readMay $ ciOriginal criterion
                 E.on $     usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
                 E.where_ $ usrComp E.^. UserCompanyUser    E.==. queryUser row E.^. UserId E.&&. testcrit
-        )        
+        )
       , fltrAVSCardNos queryUser
       , single ("personal-number", FilterColumn $ \(queryUser -> user) (criteria :: Set.Set Text) -> if
           | Set.null criteria -> E.true
@@ -506,7 +506,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
         )
       ]
     dbtFilterUI mPrev = mconcat
-      [ fltrUserNameEmailHdrUI MsgLmsUser mPrev    
+      [ fltrUserNameEmailHdrUI MsgLmsUser mPrev
       , prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
       , prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
       , fltrAVSCardNosUI mPrev
@@ -516,7 +516,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
       , prismAForm (singletonFilter "notified" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsNotified)
       , prismAForm (singletonFilter "status"  . maybePrism _PathPiece) mPrev $ aopt (hoistField liftHandler (selectField optionsFinite) :: (Field _ (Maybe LmsStatus))) (fslI MsgTableLmsStatus)
       -- , if isNothing mbRenewal then mempty
-      --   else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)      
+      --   else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
       ]
     dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
     dbtCsvEncode = Just DBTCsvEncode
@@ -548,14 +548,14 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
           <*>  view    (resultLmsUser  . _entityVal . _lmsUserReceived)
           <*>  view    (resultLmsUser  . _entityVal . _lmsUserNotified) -- TODO: only exports last email date / print job sending date, not print acknowledge
           <*>  view    (resultLmsUser  . _entityVal . _lmsUserEnded)
-        getCompanies cmps = case mapMaybe (flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany)) cmps of 
+        getCompanies cmps = case mapMaybe (flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany)) cmps of
           []        -> pure   Nothing
           somecmps  -> pure $ Just $ intercalate ", " $ fmap (view (_companyName . _CI)) somecmps
         getCompanyNos = pure . CsvSemicolonList . mapMaybe (preview (_Just . _companyAvsId) . flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany))
-        
+
     dbtCsvDecode = Nothing
     dbtExtraReps = []
-    dbtParams = if not isAdmin then def {dbParamsFormAction = Nothing, dbParamsFormSubmit = FormNoSubmit} else 
+    dbtParams = if not isAdmin then def {dbParamsFormAction = Nothing, dbParamsFormSubmit = FormNoSubmit} else
       DBParamsForm
       { dbParamsFormMethod = POST
       , dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute
@@ -603,18 +603,18 @@ postLmsR sid qsh = do
           [ singletonMap LmsActNotify       $ pure LmsActNotifyData
           , singletonMap LmsActRenewNotify  $ pure LmsActRenewNotifyData
           -- , singletonMap LmsActRenewPin     $ pure LmsActRenewPinData
-          , singletonMap LmsActReset $ LmsActResetData 
-              <$> aopt      intField (fslI MsgLmsActRestartExtend)  Nothing  
+          , singletonMap LmsActReset $ LmsActResetData
+              <$> aopt      intField (fslI MsgLmsActRestartExtend)  Nothing
               <*> aopt checkBoxField (fslI MsgLmsActRestartUnblock) Nothing
-              <*> aopt checkBoxField (fslI MsgLmsActNotify)         Nothing              
+              <*> aopt checkBoxField (fslI MsgLmsActNotify)         Nothing
               <*  aformMessage msgResetInfo
-          , singletonMap LmsActRestart $ LmsActRestartData 
-              <$> aopt      intField (fslI MsgLmsActRestartExtend)  Nothing  
+          , singletonMap LmsActRestart $ LmsActRestartData
+              <$> aopt      intField (fslI MsgLmsActRestartExtend)  Nothing
               <*> aopt checkBoxField (fslI MsgLmsActRestartUnblock) Nothing
               <*> aopt checkBoxField (fslI MsgLmsActNotify)         Nothing
               -- <*> aopt (commentField MsgQualificationActBlockSupervisor) (fslI MsgMessageWarning) Nothing
-              <*  aformMessage msgRestartWarning              
-          ]        
+              <*  aformMessage msgRestartWarning
+          ]
         colChoices cmpMap = mconcat
           [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultUser . _entityKey))
           , colUserNameModalHdrAdmin MsgLmsUser AdminUserR
@@ -622,11 +622,11 @@ postLmsR sid qsh = do
           , sortable (Just "user-company") (i18nCell MsgTableCompany) $ \( view resultCompanyUser -> cmps) ->
               let cs =  [ companyCell (unCompanyKey cmpId) cmpName cmpSpr
                         | Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
-                        , let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap                        
+                        , let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap
                         ]
               in intercalate spacerCell cs
           , colUserMatriclenr isAdmin
-          -- , sortable (Just "validity")      (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)          
+          -- , sortable (Just "validity")      (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
           , sortable (Just "first-held")    (i18nCell MsgTableQualificationFirstHeld)  $ \(   view $ resultQualUser . _entityVal . _qualificationUserFirstHeld   -> d)  -> dayCell d
           , sortable (Just "last-refresh")  (i18nCell MsgTableQualificationLastRefresh)$ \(   view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d)  -> dayCell d
           , sortable (Just "valid-until")   (i18nCell MsgLmsQualificationValidUntil)   $ \(   view $ resultQualUser . _entityVal . _qualificationUserValidUntil  -> d)  -> dayCell d
@@ -653,8 +653,8 @@ postLmsR sid qsh = do
               --   - Letter printed : LmsUserNotified == Just _  && PrintJobId == Just _
               --   - Letter sent    : LmsUserNotified == Just _  && PrintJobId == Just _ && PrintJobAcknowledged == Just _
               let notifyDate      = row ^. resultLmsUser . _entityVal . _lmsUserNotified
-                  lmsident        = row ^. resultLmsUser . _entityVal . _lmsUserIdent                  
-                  recipient       = row ^. hasUser                  
+                  lmsident        = row ^. resultLmsUser . _entityVal . _lmsUserIdent
+                  recipient       = row ^. hasUser
                   letterDates     = row ^? resultPrintAck
                   lastLetterDate  = headDef Nothing =<< letterDates
                   letterSent      = isJust letterDates  && (isNothing lastLetterDate || lastLetterDate >= notifyDate) -- was a letter attempted to send last (not 100% safe, if an email is sent after an unacknowledged letter)
@@ -675,7 +675,7 @@ postLmsR sid qsh = do
                                   $maybe ackdate <- mbackdate
                                     ^{formatTimeW SelFormatDateTime ackdate}
                                   $nothing
-                                    _{MsgPrintJobUnacknowledged}                          
+                                    _{MsgPrintJobUnacknowledged}
                           <p>
                             <a href=@{lprLink}>
                               _{MsgPrintJobs}
@@ -700,25 +700,25 @@ postLmsR sid qsh = do
     _ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page
 
     (action, selectedUsers) | isResetRestartAct action -> do
-      let usersList = Set.toList selectedUsers      
+      let usersList = Set.toList selectedUsers
           numUsers  = Set.size   selectedUsers
           isReset   = isResetAct action
-          actRestartExtend  = action & lmsActRestartExtend  
-          actRestartUnblock = action & lmsActRestartUnblock 
-          actRestartNotify  = action & lmsActRestartNotify  
+          actRestartExtend  = action & lmsActRestartExtend
+          actRestartUnblock = action & lmsActRestartUnblock
+          actRestartNotify  = action & lmsActRestartNotify
 
-      chgUsers <- runDB $ do 
+      chgUsers <- runDB $ do
         when (actRestartUnblock == Just True) $ do
           oks <- qualificationUserBlocking qid usersList True Nothing (Left $ bool "Manueller LMS Neustart" "Manuelle LMS Zurücksetzung" isReset) (fromMaybe True actRestartNotify)
           addMessageI Success $ MsgQualificationStatusUnblock qsh oks numUsers
 
         whenIsJust actRestartExtend $ \extDays -> do
           let cutoff    = addDays extDays nowaday
-          shortUsers <- view (_entityVal . _qualificationUserUser) <<$>> selectList 
+          shortUsers <- view (_entityVal . _qualificationUserUser) <<$>> selectList
             [ QualificationUserQualification ==. qid
-            , QualificationUserUser <-. usersList            
+            , QualificationUserUser <-. usersList
             , QualificationUserValidUntil <. cutoff
-            ] []          
+            ] []
           forM_ shortUsers $ upsertQualificationUser qid now cutoff Nothing "E-Learning Reset"
 
         fromIntegral <$> (if isReset
@@ -727,25 +727,25 @@ postLmsR sid qsh = do
             else deleteWhereCount  [LmsUserQualification ==. qid, LmsUserUser <-. usersList]
           )
 
-      unless isReset $ 
+      unless isReset $
         forM_ selectedUsers $ \uid ->
           queueJob' $ JobLmsEnqueueUser { jQualification = qid, jUser = uid }
 
-      runDB $ forM_ selectedUsers $ \uid -> 
-        audit $ TransactionLmsReset   
-          { transactionQualification   = qid          
+      runDB $ forM_ selectedUsers $ \uid ->
+        audit $ TransactionLmsReset
+          { transactionQualification   = qid
           , transactionLmsUser         = uid
           , transactionLmsReset        = isReset
-          , transactionLmsResetExtend  = actRestartExtend 
+          , transactionLmsResetExtend  = actRestartExtend
           , transactionLmsResetUnblock = actRestartUnblock
-          , transactionLmsResetNotify  = actRestartNotify 
+          , transactionLmsResetNotify  = actRestartNotify
           }
 
       let mStatus  = bool Success Warning $ chgUsers < numUsers
       addMessageI mStatus $ bool MsgLmsActRestartFeedback MsgLmsActResetFeedback isReset chgUsers numUsers
       reloadKeepGetParams $ LmsR sid qsh
 
-    (action, selectedUsers) | isRenewPinAct action || isNotifyAct action -> do      
+    (action, selectedUsers) | isRenewPinAct action || isNotifyAct action -> do
       numExaminees <- runDB $ do
         okUsers <- selectList [ LmsUserQualification  ==. qid                       -- matching qualification
                               , LmsUserEnded          ==. Nothing                   -- not yet deleted
@@ -761,7 +761,7 @@ postLmsR sid qsh = do
         return $ length okUsers
       let numSelected  = length selectedUsers
           diffSelected = numSelected - numExaminees
-          mstat        = bool Success Warning $ diffSelected /= 0 
+          mstat        = bool Success Warning $ diffSelected /= 0
       when (isRenewPinAct action) $ addMessageI mstat   $ MsgLmsPinRenewal       numExaminees
       when (isNotifyAct action)   $ addMessageI mstat   $ MsgLmsNotificationSend numExaminees
       when (diffSelected /= 0)    $ addMessageI Warning $ MsgLmsActionFailed     diffSelected
@@ -791,22 +791,22 @@ getLmsUserR sid qsh = viewLmsUserR (Just sid) (Just qsh)
 viewLmsUserR :: Maybe SchoolId -> Maybe QualificationShorthand -> CryptoUUIDUser -> Handler Html
 viewLmsUserR msid mqsh uuid = do
   uid <- decrypt uuid
-  now <- liftIO getCurrentTime   
-  (user@User{userDisplayName}, quals, qblocks) <- runDB $ do 
+  now <- liftIO getCurrentTime
+  (user@User{userDisplayName}, quals, qblocks) <- runDBRead $ do
     usr <- get404 uid
-    qs  <- Ex.select $ do 
-          (qual :& qualUsr :& lmsUsr) <- 
+    qs  <- Ex.select $ do
+          (qual :& qualUsr :& lmsUsr) <-
             Ex.from $ Ex.table @Qualification
             `Ex.leftJoin` Ex.table @QualificationUser
             `Ex.on` (\(qual :& qualUsr)     -> qualUsr  E.?. QualificationUserUser          E.?=. Ex.val uid
                                         E.&&.  qualUsr  E.?. QualificationUserQualification E.?=. qual Ex.^. QualificationId
-                    ) 
+                    )
             `Ex.leftJoin` Ex.table @LmsUser
             `Ex.on` (\(qual :& _ :& lmsUsr) -> lmsUsr   E.?. LmsUserUser                    E.?=. Ex.val uid
-                                        E.&&.  lmsUsr   E.?. LmsUserQualification           E.?=. qual Ex.^. QualificationId 
+                                        E.&&.  lmsUsr   E.?. LmsUserQualification           E.?=. qual Ex.^. QualificationId
                     )
           Ex.where_ $ E.and $
-            (E.isJust (qualUsr E.?. QualificationUserUser) E.||. E.isJust ( lmsUsr E.?. LmsUserUser)) : catMaybes 
+            (E.isJust (qualUsr E.?. QualificationUserUser) E.||. E.isJust ( lmsUsr E.?. LmsUserUser)) : catMaybes
               [ (qual E.^. QualificationSchool     E.==.) . E.val <$> msid
               , (qual E.^. QualificationShorthand  E.==.) . E.val <$> mqsh
               ]
@@ -816,7 +816,7 @@ viewLmsUserR msid mqsh uuid = do
         <- foldMapM (\(_, mbqu, _, _) -> case mbqu of
               Nothing -> pure mempty
               Just (Entity quid _) -> do
-                blocks <- Ex.select $ do 
+                blocks <- Ex.select $ do
                   (qBlock :& qbUsr) <- Ex.from $ Ex.table @QualificationUserBlock
                     `Ex.leftJoin` Ex.table @User
                     `Ex.on` (\(qBlock :& qbUsr) -> qBlock Ex.^. QualificationUserBlockBlocker Ex.==. qbUsr Ex.?. UserId)
@@ -826,7 +826,7 @@ viewLmsUserR msid mqsh uuid = do
                 return $ Map.singleton quid blocks
             ) qs
     return (usr, qs, Map.filter notNull bs)
-  let heading = [whamlet|_{MsgMenuLmsUser} ^{userWidget user}|]  
+  let heading = [whamlet|_{MsgMenuLmsUser} ^{userWidget user}|]
   siteLayout heading $ do
     setTitle $ toHtml userDisplayName
-    $(widgetFile "lms-user")    
+    $(widgetFile "lms-user")
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index 71c1c2e89..76c9346e9 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -156,7 +156,7 @@ schoolsForm template = formToAForm $ schoolsFormView =<< renderWForm FormStandar
   where
     schoolsForm' :: WForm Handler (FormResult (Set SchoolId))
     schoolsForm' = do
-      allSchools <- liftHandler . runDB $ selectList [] [Asc SchoolName]
+      allSchools <- liftHandler . runDBRead $ selectList [] [Asc SchoolName]
 
       let
         schoolForm (Entity ssh School{schoolName})
diff --git a/src/Handler/SAP.hs b/src/Handler/SAP.hs
index 3414b618b..37ecb64fe 100644
--- a/src/Handler/SAP.hs
+++ b/src/Handler/SAP.hs
@@ -27,10 +27,10 @@ import qualified Database.Esqueleto.Utils as E
 
 
 data SapUserTableCsv = SapUserTableCsv -- for csv export only
-  { csvSUTpersonalNummer :: Text 
+  { csvSUTpersonalNummer :: Text
   , csvSUTqualifikation  :: Text
   , csvSUTgültigVon      :: Day
-  , csvSUTgültigBis      :: Day  
+  , csvSUTgültigBis      :: Day
   -- , csvSUTsupendiertBis  :: Maybe Day
   , csvSUTausprägung     :: Text
   }
@@ -38,7 +38,7 @@ data SapUserTableCsv = SapUserTableCsv -- for csv export only
 makeLenses_ ''SapUserTableCsv
 
 sapUserTableCsvHeader :: Csv.Header
-sapUserTableCsvHeader = Csv.header 
+sapUserTableCsvHeader = Csv.header
     [ "PersonalNummer"
     , "Qualifikation"
     , "GültigVon"
@@ -51,40 +51,40 @@ instance ToNamedRecord SapUserTableCsv where
   toNamedRecord SapUserTableCsv{..} = Csv.namedRecord
     [ "PersonalNummer"  Csv..= csvSUTpersonalNummer
     , "Qualifikation"   Csv..= csvSUTqualifikation
-    , "GültigVon"       Csv..= csvSUTgültigVon   
-    , "GültigBis"       Csv..= csvSUTgültigBis     
+    , "GültigVon"       Csv..= csvSUTgültigVon
+    , "GültigBis"       Csv..= csvSUTgültigBis
     -- , "SupendiertBis"   Csv..= csvSUTsupendiertBis
-    , "Ausprägung"      Csv..= csvSUTausprägung   
+    , "Ausprägung"      Csv..= csvSUTausprägung
     ]
 
 -- | Removes all personalNummer which are not numbers between 10000 and 99999 (also excludes E-Accounts), which should not be returned by the query anyway (only qualfications with sap id and users with internal personnel number must be transmitted)
 --   temporary suspensions are transmitted to SAP in multiple rows: firstheld->suspension1, reinstate1->suspension2, reinstate2->validTo
 sapRes2csv :: [(E.Value (Maybe Text), E.Value (Maybe Text), E.Value Day, E.Value Day, E.Value (Maybe [Maybe Day]), E.Value (Maybe [Maybe Bool]))] -> [SapUserTableCsv]
 sapRes2csv = concatMap procRes
-  where 
+  where
     procRes (E.Value pn@(Just persNo), E.Value (Just sapId), E.Value firstHeld, E.Value validUntil, E.Value (fromMaybe [] -> qubFroms), E.Value (fromMaybe [] -> qubUnblocks))
       | validFraportPersonalNumber pn -- between 10000 and 99999 also see Handler.Utils.Profile.validFraportPersonalNumber
         = let mkSap (dfrom,duntil) = SapUserTableCsv
                               { csvSUTpersonalNummer = persNo
                               , csvSUTqualifikation  = sapId
                               , csvSUTgültigVon      = dfrom
-                              , csvSUTgültigBis      = duntil                            
+                              , csvSUTgültigBis      = duntil
                               , csvSUTausprägung     = "J"
                               }
           in fmap mkSap $ compileBlocks firstHeld validUntil $ zipMaybes qubFroms qubUnblocks
     procRes _ = []
 
 -- | compute a series of valid periods, assume that lists is already sorted by Day
---   the lists encodes qualification_user_blocks with block=False/unblock=True 
+--   the lists encodes qualification_user_blocks with block=False/unblock=True
 compileBlocks :: Day -> Day -> [(Day,Bool)] -> [(Day, Day)]
-compileBlocks dStart dEnd = go (dStart, True) 
-  where 
+compileBlocks dStart dEnd = go (dStart, True)
+  where
     go :: (Day,Bool) -> [(Day,Bool)] -> [(Day, Day)]
     go (d,s) (p1@(d1,s1):r1@((d2,s2):r2))
-      | s1 == s2 && d <= d1                            = go (d,s) (p1:r2)   -- ignore unnecessary 2nd change      
-      | d1 == d2 || succ d1 == d2 || s == s1 || d > d1 = go (d,s)     r1    -- ignore unnecessary 1st change      
+      | s1 == s2 && d <= d1                            = go (d,s) (p1:r2)   -- ignore unnecessary 2nd change
+      | d1 == d2 || succ d1 == d2 || s == s1 || d > d1 = go (d,s)     r1    -- ignore unnecessary 1st change
     go (d,s) ((d1,s1):r1)
-      | dEnd <= d1        =          go (d ,s ) []                          -- remaining dates extend validity        
+      | dEnd <= d1        =          go (d ,s ) []                          -- remaining dates extend validity
       | s, not s1, d < d1 = (d,d1) : go (d1,s1) r1                          -- valid interval found
       | s == s1           =          go (d ,s ) r1                          -- no change
       | otherwise         =          go (d1,s1) r1                          -- ignore invalid interval
@@ -95,18 +95,18 @@ compileBlocks dStart dEnd = go (dStart, True)
 -- | Deliver all employess with a successful LDAP synch within the last 3 months
 getQualificationSAPDirectR :: Handler TypedContent
 getQualificationSAPDirectR = do
-  now   <- liftIO getCurrentTime  
-  fdate <- formatTime' "%Y%m%d_%H-%M" now 
+  now   <- liftIO getCurrentTime
+  fdate <- formatTime' "%Y%m%d_%H-%M" now
   let ldap_cutoff = addDiffDaysRollOver (fromMonths $ -3) now
-  qualUsers <- runDB $ E.select $ do
-    (qual :& qualUser :& user :& qualBlock) <- 
-      E.from $ E.table @Qualification 
+  qualUsers <- runDBRead $ E.select $ do
+    (qual :& qualUser :& user :& qualBlock) <-
+      E.from $ E.table @Qualification
       `E.innerJoin` E.table @QualificationUser
       `E.on` (\(qual :& qualUser) -> qual E.^. QualificationId E.==. qualUser E.^. QualificationUserQualification)
       `E.innerJoin` E.table @User
       `E.on` (\(_ :& qualUser :& user) -> qualUser E.^. QualificationUserUser E.==. user E.^. UserId)
       `E.leftJoin` E.table @QualificationUserBlock
-      `E.on` (\(_ :& qualUser :& _ :& qualBlock) -> 
+      `E.on` (\(_ :& qualUser :& _ :& qualBlock) ->
                   qualUser E.^. QualificationUserId E.=?. qualBlock E.?. QualificationUserBlockQualificationUser
           E.&&.   E.val now                         E.>~. qualBlock E.?. QualificationUserBlockFrom
         )
@@ -116,19 +116,19 @@ getQualificationSAPDirectR = do
         E.&&.  (E.justVal ldap_cutoff E.<=. user E.^. UserLastLdapSynchronisation)
     E.groupBy ( user      E.^. UserCompanyPersonalNumber
               , qualUser  E.^. QualificationUserFirstHeld
-              , qualUser  E.^. QualificationUserValidUntil                
+              , qualUser  E.^. QualificationUserValidUntil
               , qual      E.^. QualificationSapId
               )
     let blockOrder = [E.asc $ qualBlock E.?. QualificationUserBlockFrom, E.asc $ qualBlock E.?. QualificationUserBlockId]
         -- blockAgg f = E.arrayAggWith E.AggModeAll (qualBlock E.^. f) blockOrder
-    return 
+    return
       ( user      E.^. UserCompanyPersonalNumber
       , qual      E.^. QualificationSapId
       , qualUser  E.^. QualificationUserFirstHeld
       , qualUser  E.^. QualificationUserValidUntil
       , E.arrayAggWith E.AggModeAll (E.dayMaybe $ qualBlock E.?. QualificationUserBlockFrom   ) blockOrder
       , E.arrayAggWith E.AggModeAll (             qualBlock E.?. QualificationUserBlockUnblock) blockOrder
-      )    
+      )
   let csvRendered = toCsvRendered sapUserTableCsvHeader $ sapRes2csv qualUsers
       fmtOpts = (review csvPreset CsvPresetRFC)
                     { csvIncludeHeader  = True
@@ -144,7 +144,7 @@ getQualificationSAPDirectR = do
   let logInt = runDB $ logInterface "SAP" quals True (Just nr) ""
   addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\""
   csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered <* logInt
-  
+
 
 -- direct Download see:
 -- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod
diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs
index e52663da0..515deaac3 100644
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@@ -121,7 +121,7 @@ postUsersR = do
 --           (AdminUserR <$> encrypt uid)
 --           (toWidget . display $ last $ impureNonNull $ words $ userDisplayName)
       , sortable (Just "user-supervisor") (i18nCell MsgTableSupervisor) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
-            supervisors' <- liftHandler . runDB . E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
+            supervisors' <- liftHandler . runDBRead . E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
               E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId
               E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid
               E.orderBy [E.asc (usrSpvr E.^. UserDisplayName)]
@@ -135,7 +135,7 @@ postUsersR = do
       , sortable (Just "ldap-sync")  (i18nCell MsgLdapSynced) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastLdapSynchronisation
       , flip foldMap universeF $ \function ->
           sortable (Just $ SortingKey $ CI.mk $ toPathPiece function) (i18nCell function) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
-            schools <- liftHandler . runDB . E.select . E.from $ \(school `E.InnerJoin` userFunction) -> do
+            schools <- liftHandler . runDBRead . E.select . E.from $ \(school `E.InnerJoin` userFunction) -> do
               E.on $ school E.^. SchoolId E.==. userFunction E.^. UserFunctionSchool
               E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
                    E.&&. userFunction E.^. UserFunctionFunction E.==. E.val function
@@ -148,7 +148,7 @@ postUsersR = do
                   <li>#{sh}
               |]
       , sortable (Just "system-function") (i18nCell MsgUserSystemFunctions) $ \DBRow{ dbrOutput = Entity uid _ } ->
-          let getFunctions = fmap (map $ userSystemFunctionFunction . entityVal) . liftHandler . runDB $ selectList [ UserSystemFunctionUser ==. uid, UserSystemFunctionIsOptOut ==. False ] [ Asc UserSystemFunctionFunction ]
+          let getFunctions = fmap (map $ userSystemFunctionFunction . entityVal) . liftHandler . runDBRead $ selectList [ UserSystemFunctionUser ==. uid, UserSystemFunctionIsOptOut ==. False ] [ Asc UserSystemFunctionFunction ]
            in listCell' getFunctions i18nCell
       , sortable Nothing (mempty & cellAttrs <>~ pure ("hide-columns--hider-label", mr MsgTableActionsHead)) $ \inp@DBRow{ dbrOutput = Entity uid _ } -> FormCell
           { formCellAttrs    = []
diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs
index b53d1c097..59e47b02f 100644
--- a/src/Handler/Utils/Avs.hs
+++ b/src/Handler/Utils/Avs.hs
@@ -171,11 +171,11 @@ lookupAvsUsers apis = do
 updateReceivers :: UserId -> Handler  (Entity User, [Entity User], Bool)
 updateReceivers uid = do
   -- First perform AVS update for receiver
-  runDB (getBy (UniqueUserAvsUser uid)) >>= \case
+  runDBRead (getBy (UniqueUserAvsUser uid)) >>= \case
       Just Entity{entityVal=UserAvs{userAvsPersonId = apid}} -> catchAll2log $ upsertAvsUserById apid
       Nothing -> return ()
   -- Retrieve updated user and supervisors now
-  (underling :: Entity User, avsSupers :: [(E.Value UserId, E.Value (Maybe AvsPersonId))]) <- runDB $ (,)
+  (underling :: Entity User, avsSupers :: [(E.Value UserId, E.Value (Maybe AvsPersonId))]) <- runDBRead $ (,)
     <$> getJustEntity uid
     <*> (E.select $ do
           (usrSuper :& usrAvs) <-
@@ -194,7 +194,7 @@ updateReceivers uid = do
   if null receiverIDs
     then directResult
     else do
-      receivers <- runDB $ selectList [UserId <-. receiverIDs] [] -- due to possible address updates, we must runDB once more and cannot join above
+      receivers <- runDBRead $ selectList [UserId <-. receiverIDs] [] -- due to possible address updates, we must runDB once more and cannot join above
       if null receivers
         then directResult
         else return (underling, receivers, uid `elem` (entityKey <$> receivers))
@@ -450,7 +450,7 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
 
 linktoAvsUserByUIDs :: Set UserId -> Handler ()
 linktoAvsUserByUIDs uids = do
-    ips <- runDB $ E.select $ do
+    ips <- runDBRead $ E.select $ do
       usr <- E.from $ E.table @User
       let uid = usr E.^. UserId
           ipn = usr E.^. UserCompanyPersonalNumber
@@ -490,7 +490,7 @@ createAvsUserById muid api = do
         -- check for matching existing user
         let internalPersNo :: Maybe Text = cpi ^? _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo
             -- persMail  :: Maybe UserEmail = cpi ^? _avsInfoPersonEMail . _Just . from _CI
-        oldUsr <- runDB $ do
+        oldUsr <- runDBRead $ do
           mbUid <- if isJust muid
               then return muid
               else firstJustM $ catMaybes
@@ -736,15 +736,15 @@ guessAvsUser :: Text -> Handler (Maybe UserId)
 guessAvsUser (Text.splitAt 6 -> (Text.toUpper -> prefix, readMay -> Just nr))
   | prefix=="AVSID:" =
       let avsid = AvsPersonId nr in
-      runDB (getBy $ UniqueUserAvsId avsid)          >>= \case
+      runDBRead (getBy $ UniqueUserAvsId avsid)          >>= \case
         (Just Entity{entityVal=UserAvs{userAvsUser=uid}}) -> return $ Just uid
         Nothing -> catchAVS2message $ Just <$> upsertAvsUserById avsid
   | prefix=="AVSNO:" =
-      runDB (view (_entityVal . _userAvsUser) <<$>> getByFilter [UserAvsNoPerson ==. nr])
+      runDBRead (view (_entityVal . _userAvsUser) <<$>> getByFilter [UserAvsNoPerson ==. nr])
 guessAvsUser someid@(discernAvsCardPersonalNo -> Just someavsid) =
     catchAVS2message $ upsertAvsUserByCard someavsid >>= \case
       Nothing | Left{} <- someavsid -> -- attempt to find PersonalNumber in DB
-        runDB (getKeyByFilter [UserCompanyPersonalNumber ==. Just someid])
+        runDBRead (getKeyByFilter [UserCompanyPersonalNumber ==. Just someid])
       other -> return other
 guessAvsUser someid = do
     try (runDB $ ldapLookupAndUpsert someid) >>= \case
diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs
index e3feec877..269747570 100644
--- a/src/Handler/Utils/Qualification.hs
+++ b/src/Handler/Utils/Qualification.hs
@@ -112,12 +112,14 @@ validQualification' cutoff qualUser =
            E.&&. quserBlock' False cutoff qualUser
 
 -- selectValidQualifications :: QualificationId -> [UserId] -> UTCTime -> DB [Entity QualificationUser]
-selectValidQualifications ::
-  ( MonadIO m
-  , BackendCompatible SqlBackend backend
-  , PersistQueryRead backend
-  , PersistUniqueRead backend
-  ) => QualificationId -> [UserId] -> UTCTime -> ReaderT backend m [Entity QualificationUser]
+-- selectValidQualifications ::
+--   ( MonadIO m
+--   , BackendCompatible SqlBackend backend
+--   , PersistQueryRead backend
+--   , PersistUniqueRead backend
+--   ) => QualificationId -> [UserId] -> UTCTime -> ReaderT backend m [Entity QualificationUser]
+selectValidQualifications :: (MonadIO m, E.SqlBackendCanRead backend)
+  => QualificationId -> [UserId] -> UTCTime -> ReaderT backend m [Entity QualificationUser]
 selectValidQualifications qid uids cutoff =
   -- cutoff <- utctDay <$> liftIO getCurrentTime
   E.select $ do
diff --git a/src/Handler/Utils/Widgets.hs b/src/Handler/Utils/Widgets.hs
index ef9366550..1845862c3 100644
--- a/src/Handler/Utils/Widgets.hs
+++ b/src/Handler/Utils/Widgets.hs
@@ -62,7 +62,7 @@ userWidget :: HasUser c => c -> Widget
 userWidget x = nameWidget (x ^. _userDisplayName) (x ^._userSurname)
 
 userIdWidget :: UserId -> Widget
-userIdWidget uid = maybeM (msg2widget MsgUserUnknown) userWidget (liftHandler $ runDB $ get uid)
+userIdWidget uid = maybeM (msg2widget MsgUserUnknown) userWidget (liftHandler $ runDBRead $ get uid)
 
 linkUserWidget :: HasRoute UniWorX url => (CryptoUUIDUser -> url) -> Entity User -> Widget
 linkUserWidget lnk (Entity uid usr) = do
@@ -71,7 +71,7 @@ linkUserWidget lnk (Entity uid usr) = do
 
 -- | like linkUserWidget, but on Id only. Requires DB access, use with caution
 linkUserIdWidget :: HasRoute UniWorX url => (CryptoUUIDUser -> url) -> UserId -> Widget
-linkUserIdWidget lnk uid = maybeM (msg2widget MsgUserUnknown) (linkUserWidget lnk . Entity uid) (liftHandler $ runDB $ get uid)
+linkUserIdWidget lnk uid = maybeM (msg2widget MsgUserUnknown) (linkUserWidget lnk . Entity uid) (liftHandler $ runDBRead $ get uid)
 
 userEmailWidget :: HasUser c => c -> Widget
 userEmailWidget x = nameEmailWidget (x ^. _userDisplayEmail) (x ^. _userDisplayName) (x ^. _userSurname)
diff --git a/src/Jobs/Handler/SynchroniseAvs.hs b/src/Jobs/Handler/SynchroniseAvs.hs
index 47b9d0c21..2de92b595 100644
--- a/src/Jobs/Handler/SynchroniseAvs.hs
+++ b/src/Jobs/Handler/SynchroniseAvs.hs
@@ -3,9 +3,9 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 module Jobs.Handler.SynchroniseAvs
-  ( dispatchJobSynchroniseAvs  
+  ( dispatchJobSynchroniseAvs
   -- , dispatchJobSynchroniseAvsId
-  -- , dispatchJobSynchroniseAvsUser  
+  -- , dispatchJobSynchroniseAvsUser
   , dispatchJobSynchroniseAvsQueue
   ) where
 
@@ -26,7 +26,7 @@ import Handler.Utils.Avs
 
 -- pause is a date in the past; don't synch again if the last synch was after pause
 dispatchJobSynchroniseAvs :: Natural -> Natural -> Natural -> Maybe Day -> JobHandler UniWorX
-dispatchJobSynchroniseAvs numIterations epoch iteration pause  
+dispatchJobSynchroniseAvs numIterations epoch iteration pause
   = JobHandlerException . runDB $ do
       now <- liftIO getCurrentTime
       todos <- runConduit $ readUsers .| filterIteration now .| sinkList
@@ -44,13 +44,13 @@ dispatchJobSynchroniseAvs numIterations epoch iteration pause
         userIteration = toInteger (hash epoch `hashWithSalt` userId) `mod` toInteger numIterations
         currentIteration = toInteger iteration `mod` toInteger numIterations
       $logDebugS "SynchronisAvs" [st|User ##{tshow (fromSqlKey userId)}: AVS sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|]
-      guard $ userIteration == currentIteration      
-      return $ AvsSync userId now pause      
+      guard $ userIteration == currentIteration
+      return $ AvsSync userId now pause
 
 -- dispatchJobSynchroniseAvsId :: AvsPersonId -> Maybe Day -> JobHandler UniWorX
--- dispatchJobSynchroniseAvsId apid pause = JobHandlerException $     
---     maybeM insertUnknown processKnown $ runDB $ getBy (UniqueUserAvsId apid)    
---   where 
+-- dispatchJobSynchroniseAvsId apid pause = JobHandlerException $
+--     maybeM insertUnknown processKnown $ runDB $ getBy (UniqueUserAvsId apid)
+--   where
 --     processKnown Entity{entityVal=UserAvs{userAvsUser=uid}} = workJobSychronizeAvs uid pause
 --     insertUnknown = void $ maybeCatchAll $ Just <$> upsertAvsUserById apid
 
@@ -66,7 +66,7 @@ dispatchJobSynchroniseAvs numIterations epoch iteration pause
 --     --           , avsSyncPause        = pause
 --     --           }
 --     --   [ \oldSync -> (AvsSyncPause E.=. E.greatest (E.val pause) (oldSync E.^. AvsSyncPause)) oldSync ] -- causes Esqueleto to call undefined at Database.Esqueleto.Internal.Internal.renderUpdates:1308
---     runDB $ maybeM 
+--     runDB $ maybeM
 --       (insert_ AvsSync{avsSyncUser=uid, avsSyncCreationTime=now, avsSyncPause=pause})
 --       (\Entity{entityKey=asid, entityVal=AvsSync{avsSyncPause=oldPause}} ->
 --         update asid [AvsSyncPause =. max pause oldPause, AvsSyncCreationTime =. now])
@@ -78,10 +78,10 @@ dispatchJobSynchroniseAvs numIterations epoch iteration pause
 -- dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
 --     (unlinked,linked) <- runDB $ do
 --       jobs <- E.select (do
---           (avsSync :& usrAvs) <- E.from $  E.table @AvsSync 
+--           (avsSync :& usrAvs) <- E.from $  E.table @AvsSync
 --                               `E.leftJoin` E.table @UserAvs
 --             `E.on` (\(avsSync :& usrAvs) -> avsSync E.^. AvsSyncUser E.=?. usrAvs E.?. UserAvsUser)
---           let pause    = avsSync E.^. AvsSyncPause  
+--           let pause    = avsSync E.^. AvsSyncPause
 --               lastSync = usrAvs  E.?. UserAvsLastSynch
 --           E.where_ $  E.isNothing pause
 --                 E.||. E.isNothing lastSync
@@ -91,22 +91,22 @@ dispatchJobSynchroniseAvs numIterations epoch iteration pause
 --       let (syncIds, unlinked, linked) = foldl' discernJob mempty jobs
 --       E.deleteWhere [AvsSyncId <-. syncIds]
 --       return (unlinked, linked)
-    
+
 --     void $ updateAvsUserByIds  linked
 --     void $ linktoAvsUserByUIDs unlinked
 --     -- we do not reschedule failed synchs here in order to avoid a loop
---   where 
+--   where
 --     discernJob (accSync, accUid, accApi) (E.Value k,           _, E.Value (Just api)) = (k:accSync, accUid, Set.insert api accApi)
 --     discernJob (accSync, accUid, accApi) (E.Value k, E.Value uid, E.Value  Nothing  ) = (k:accSync, Set.insert uid accUid, accApi)
-    
+
 dispatchJobSynchroniseAvsQueue :: JobHandler UniWorX
-dispatchJobSynchroniseAvsQueue = JobHandlerException $ do    
-    jobs <- runDB $ do
+dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
+    jobs <- runDBRead $ do
       E.select (do
-          (avsSync :& usrAvs) <- E.from $  E.table @AvsSync 
+          (avsSync :& usrAvs) <- E.from $  E.table @AvsSync
                               `E.leftJoin` E.table @UserAvs
             `E.on` (\(avsSync :& usrAvs) -> avsSync E.^. AvsSyncUser E.=?. usrAvs E.?. UserAvsUser)
-          let pause    = avsSync E.^. AvsSyncPause  
+          let pause    = avsSync E.^. AvsSyncPause
               lastSync = usrAvs  E.?. UserAvsLastSynch
               proceed  =        E.isNothing pause
                           E.||. E.isNothing lastSync
@@ -124,7 +124,7 @@ dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
     runDB $ deleteWhere [AvsSyncUser <-. (E.unValue . fst3 <$> jobs)]
     $logInfoS "SynchronisAvs" [st|AVS synch performed for #{length linked} AVS linked users and #{length unlinked} unlinked users|]
     -- we do not reschedule failed synchs here in order to avoid a loop
-  where 
+  where
     discernJob accs (         _ , E.Value (Just api), E.Value True  ) = accs & over _2 (Set.insert api)
     discernJob accs (E.Value uid, E.Value  Nothing  , E.Value True  ) = accs & over _1 (Set.insert uid)
     discernJob accs (         _ ,                 _ , E.Value False ) = accs