From 5720ba58c848f141e2d3a15f7cf35ca179491a03 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 21 Apr 2023 16:17:50 +0200 Subject: [PATCH 01/32] chore(login): more informative login error message The login messages are more Fraport specific. --- .../categories/authorization/de-de-formal.msg | 14 +++++++------- .../uniworx/categories/authorization/en-eu.msg | 14 +++++++------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/messages/uniworx/categories/authorization/de-de-formal.msg b/messages/uniworx/categories/authorization/de-de-formal.msg index 1c4416244..e16240aa5 100644 --- a/messages/uniworx/categories/authorization/de-de-formal.msg +++ b/messages/uniworx/categories/authorization/de-de-formal.msg @@ -111,15 +111,15 @@ CampusUserInvalidFeaturesOfStudy parseErr@Text: Konnte anhand des Fraport Büko- CampusUserInvalidAssociatedSchools parseErr@Text: Konnte anhand des Fraport Büko-Logins keine Institute ermitteln InvalidCredentialsADNoSuchObject: Benutzereintrag existiert nicht InvalidCredentialsADLogonFailure: Ungültiges Passwort -InvalidCredentialsADAccountRestriction: Kontobeschränkungen verhindern Login +InvalidCredentialsADAccountRestriction: Beschränkungen des Fraport Accounts verhindern Login InvalidCredentialsADInvalidLogonHours: Benutzer:in darf sich zur aktuellen Tageszeit nicht anmelden InvalidCredentialsADInvalidWorkstation: Benutzer:in darf sich von diesem System aus nicht anmelden -InvalidCredentialsADPasswordExpired: Passwort abgelaufen -InvalidCredentialsADAccountDisabled: Benutzereintrag gesperrt +InvalidCredentialsADPasswordExpired: Passwort abgelaufen; ändern Sie Ihr Fraport Passwort auf dem üblichen Weg (z.B. E-Account Nutzer per Azure-Portal) +InvalidCredentialsADAccountDisabled: Ihr Fraport Account wurde gesperrt, bitte wenden Sie sich an den allgemeinen IT Support InvalidCredentialsADTooManyContextIds: Benutzereintrag trägt zu viele Sicherheitskennzeichen -InvalidCredentialsADAccountExpired: Benutzereintrag abgelaufen -InvalidCredentialsADPasswordMustChange: Passwort muss geändert werden -InvalidCredentialsADAccountLockedOut: Benutzereintrag wurde durch Eindringlingserkennung gesperrt +InvalidCredentialsADAccountExpired: Benutzereintrag abgelaufen, bitte wenden Sie sich an den allgemeinen IT Support +InvalidCredentialsADPasswordMustChange: Passwort muss geändert werden; ändern Sie Ihr Fraport Passwort auf dem üblichen Weg (z.B. E-Account Nutzer per Azure-Portal) +InvalidCredentialsADAccountLockedOut: Benutzereintrag wurde durch Eindringlingserkennung gesperrt, bitte wenden Sie sich an den allgemeinen IT Support LoginTitle: Authentifizierung @@ -136,4 +136,4 @@ FormHoneypotNameTip: Ihr Name oder Ihre E-Mail Adresse FormHoneypotNamePlaceholder: Name FormHoneypotComment: Kommentar FormHoneypotCommentPlaceholder: Kommentar -FormHoneypotFilled: Bitte füllen Sie keines der verstecken Felder aus \ No newline at end of file +FormHoneypotFilled: Bitte füllen Sie keines der verstecken Felder aus diff --git a/messages/uniworx/categories/authorization/en-eu.msg b/messages/uniworx/categories/authorization/en-eu.msg index b1676fc75..d2ad99d62 100644 --- a/messages/uniworx/categories/authorization/en-eu.msg +++ b/messages/uniworx/categories/authorization/en-eu.msg @@ -111,16 +111,16 @@ CampusUserInvalidTitle: Could not determine title during Fraport Büko login CampusUserInvalidFeaturesOfStudy parseErr: Could not determine features of study during Fraport Büko login CampusUserInvalidAssociatedSchools parseErr: Could not determine associated departments during Fraport Büko login InvalidCredentialsADNoSuchObject: User entry does not exist -InvalidCredentialsADLogonFailure: Invalid passwod -InvalidCredentialsADAccountRestriction: Account restrictions are preventing login +InvalidCredentialsADLogonFailure: Invalid password +InvalidCredentialsADAccountRestriction: Restrictions on your Fraport account prevent a login InvalidCredentialsADInvalidLogonHours: User may not login at the current time of day InvalidCredentialsADInvalidWorkstation: User may not login from this system -InvalidCredentialsADPasswordExpired: Password expired -InvalidCredentialsADAccountDisabled: Account disabled +InvalidCredentialsADPasswordExpired: Password expired, please change your Fraport account password by the usual way (eg. E-account users via Azure portal) +InvalidCredentialsADAccountDisabled: Fraport account disabled, please contact general IT support InvalidCredentialsADTooManyContextIds: Account carries to many security identifiers -InvalidCredentialsADAccountExpired: Account expired -InvalidCredentialsADPasswordMustChange: Password needs to be changed -InvalidCredentialsADAccountLockedOut: Account disabled by intruder detection +InvalidCredentialsADAccountExpired: Account expired, please contact general IT support +InvalidCredentialsADPasswordMustChange: Password needs to be changed, please change your Fraport account password by the usual way (eg. E-account users via Azure portal) +InvalidCredentialsADAccountLockedOut: Account disabled by intruder detection, please contact general IT support LoginTitle: Authentication From 54a956dc3663b6d3fe0540d75983a1845074f21f Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 24 Apr 2023 13:45:10 +0000 Subject: [PATCH 02/32] chore(error): remove default layout from error handler --- src/Foundation/Yesod/ErrorHandler.hs | 88 ++++++++++++++-------------- 1 file changed, 44 insertions(+), 44 deletions(-) diff --git a/src/Foundation/Yesod/ErrorHandler.hs b/src/Foundation/Yesod/ErrorHandler.hs index fb330960b..a8edfbccf 100644 --- a/src/Foundation/Yesod/ErrorHandler.hs +++ b/src/Foundation/Yesod/ErrorHandler.hs @@ -72,39 +72,51 @@ errorHandler err = do setSessionJson SessionError sessErr selectRep $ do - provideRep $ do - mr <- getMessageRender - let - encrypted :: Text -> WidgetFor UniWorX () -> WidgetFor UniWorX () - encrypted plaintextJson plaintext = do - let displayEncrypted ciphertext = - [whamlet| - $newline never -

_{MsgErrorResponseEncrypted} - 

-                    #{ciphertext}
-                |]
-          if
-            | isEncrypted && shouldEncrypt -> displayEncrypted plaintextJson
-            | shouldEncrypt -> displayEncrypted =<< encodedSecretBox SecretBoxPretty plaintextJson
-            | otherwise -> plaintext
+    -- provideRep $ do
+    --   mr <- getMessageRender
+    --   let
+    --     encrypted :: Text -> WidgetFor UniWorX () -> WidgetFor UniWorX ()
+    --     encrypted plaintextJson plaintext = do
+    --       let displayEncrypted ciphertext = 
+    --             [whamlet|
+    --               $newline never
+    --               
_{MsgErrorResponseEncrypted}
+    --               
+    --                 #{ciphertext}
+    --             |]
+    --       if
+    --         | isEncrypted && shouldEncrypt -> displayEncrypted plaintextJson
+    --         | shouldEncrypt -> displayEncrypted =<< encodedSecretBox SecretBoxPretty plaintextJson
+    --         | otherwise -> plaintext
 
-        errPage = case err of
-          NotFound -> [whamlet|
_{MsgErrorResponseNotFound}|]
-          InternalError err'
-            | "Crash Button" `isPrefixOf` err'   -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing
-            | otherwise -> encrypted err' [whamlet|
#{fromMaybe err' decrypted}|]
-          InvalidArgs errs -> [whamlet|
-              
    
-                $forall err' <- errs
-                  
  • 
-                    #{err'}
-             |]
-          NotAuthenticated -> [whamlet|
    _{MsgErrorResponseNotAuthenticated}|]
-          PermissionDenied err' -> [whamlet|
    #{err'}|]
-          BadMethod method -> [whamlet|
    _{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
-      siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do
-        errPage
+    --     errPage = case err of
+    --       NotFound -> [whamlet|
    _{MsgErrorResponseNotFound}|]
+    --       InternalError err'
+    --         | "Crash Button" `isPrefixOf` err'   -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing
+    --         | otherwise -> encrypted err' [whamlet|
    #{fromMaybe err' decrypted}|]
+    --       InvalidArgs errs -> [whamlet|
+    --           
      
+    --             $forall err' <- errs
+    --               
    • 
+    --                 #{err'}
+    --          |]
+    --       NotAuthenticated -> [whamlet|
      _{MsgErrorResponseNotAuthenticated}|]
+    --       PermissionDenied err' -> [whamlet|
      #{err'}|]
+    --       BadMethod method -> [whamlet|
      _{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
+    --   siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do
+    --     errPage
+    provideRep $ case err of
+      PermissionDenied err' -> return err'
+      InternalError err'
+        | isEncrypted && shouldEncrypt -> do
+            addHeader "Encrypted-Error-Message" "True"
+            return err'
+        | shouldEncrypt -> do
+            addHeader "Encrypted-Error-Message" "True"
+            encodedSecretBox SecretBoxPretty err'
+        | otherwise -> return $ fromMaybe err' decrypted
+      InvalidArgs errs -> return . Text.unlines . map (Text.replace "\n" "\n\t") $ errs
+      _other -> return Text.empty
     provideRep . fmap PrettyValue $ case err of
       PermissionDenied err' -> return $ object [ "message" JSON..= err' ]
       InternalError err'
@@ -120,15 +132,3 @@ errorHandler err = do
         | otherwise -> return $ object [ "message" JSON..= fromMaybe err' decrypted ]
       InvalidArgs errs -> return $ object [ "messages" JSON..= errs ]
       _other -> return $ object []
-    provideRep $ case err of
-      PermissionDenied err' -> return err'
-      InternalError err'
-        | isEncrypted && shouldEncrypt -> do
-            addHeader "Encrypted-Error-Message" "True"
-            return err'
-        | shouldEncrypt -> do
-            addHeader "Encrypted-Error-Message" "True"
-            encodedSecretBox SecretBoxPretty err'
-        | otherwise -> return $ fromMaybe err' decrypted
-      InvalidArgs errs -> return . Text.unlines . map (Text.replace "\n" "\n\t") $ errs
-      _other -> return Text.empty

From ea82d75a0934f8e13f26af5cb8a06c11d32dc0c5 Mon Sep 17 00:00:00 2001
From: Steffen Jost 
Date: Mon, 24 Apr 2023 15:15:14 +0000
Subject: [PATCH 03/32] fix(build): remove redundant constraints

---
 src/Foundation/Yesod/ErrorHandler.hs | 12 ++++++------
 src/Utils/Avs.hs                     | 14 ++++++++++++--
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/src/Foundation/Yesod/ErrorHandler.hs b/src/Foundation/Yesod/ErrorHandler.hs
index a8edfbccf..769f65faf 100644
--- a/src/Foundation/Yesod/ErrorHandler.hs
+++ b/src/Foundation/Yesod/ErrorHandler.hs
@@ -9,9 +9,9 @@ module Foundation.Yesod.ErrorHandler
 import Import.NoFoundation hiding (errorHandler)
 
 import Foundation.Type
-import Foundation.I18n
+-- import Foundation.I18n
 import Foundation.Authorization
-import Foundation.SiteLayout
+-- import Foundation.SiteLayout
 import Foundation.Routes
 import Foundation.DB
 
@@ -20,15 +20,15 @@ import qualified Data.Text as Text
 
 import qualified Network.Wai as W
   
-import System.Exit -- DEBUG: just for testing
-import System.Posix.Process -- DEBUG: just for testing
+-- import System.Exit -- DEBUG: just for testing
+-- import System.Posix.Process -- DEBUG: just for testing
 
 errorHandler :: ( MonadSecretBox (HandlerFor UniWorX)
-                , MonadSecretBox (WidgetFor UniWorX)
+                -- , MonadSecretBox (WidgetFor UniWorX)
                 , MonadSecretBox (ExceptT EncodedSecretBoxException (HandlerFor UniWorX))
                 , MonadAuth (HandlerFor UniWorX)
                 , BearerAuthSite UniWorX
-                , YesodPersistBackend UniWorX ~ SqlBackend
+                -- , YesodPersistBackend UniWorX ~ SqlBackend
                 )
              => ErrorResponse -> HandlerFor UniWorX TypedContent
 errorHandler err = do
diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs
index 1a978eb45..00580b26a 100644
--- a/src/Utils/Avs.hs
+++ b/src/Utils/Avs.hs
@@ -32,10 +32,10 @@ type AVSGetRampLicences = "RampDrivingLicenceInfo"  :> ReqBody '[JSON] AvsQueryG
 type AVSSetRampLicences = "RampDrivingLicence"      :> ReqBody '[JSON] AvsQuerySetLicences  :> Post '[JSON] AvsResponseSetLicences
 
 avsMaxSetLicenceAtOnce :: Int
-avsMaxSetLicenceAtOnce = 99   -- maximum input set size for avsQuerySetLicences as enforced by AVS
+avsMaxSetLicenceAtOnce = 90   -- maximum input set size for avsQuerySetLicences as enforced by AVS
 
 avsMaxGetStatusAtOnce :: Int
-avsMaxGetStatusAtOnce = 990   -- maximum input set size for avsQueryStatus as enforced by AVS
+avsMaxGetStatusAtOnce = 900   -- maximum input set size for avsQueryStatus as enforced by AVS
 
 
 avsApi :: Proxy AVS
@@ -105,6 +105,16 @@ mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
           res1 <- rawQueryStatus   (AvsQueryStatus avid_1)
           res2 <- splitQueryStatus (AvsQueryStatus avid_2)
           return $ res1 <> res2
+
+    -- splitQuery :: (a -> Set b) -> (Set b -> a) -> (a -> ClientM c) -> a -> ClientM c
+    -- splitQuery toSet fromSet rawQuery q 
+    --   | Set.size (toSet q) <= avsMaxGetStatusAtOnce = rawQueryStatus q
+    --   | otherwise = do
+    --       let (fromSet -> avid_1,fromSet -> avid_2) = Set.splitAt avsMaxGetStatusAtOnce (toSet q)
+    --       res1 <- rawQuery avid_1
+    --       res2 <- splitQuery toSet fromSet rawQuery avid_2
+    --       return $ fromSet (toSet res1 <> toSet res2)
+
 #endif
 
 -----------------------

From ebb81e0c54f9a8d3b6d27ce9d650d50b8bd8bcd2 Mon Sep 17 00:00:00 2001
From: Steffen Jost 
Date: Mon, 24 Apr 2023 16:42:57 +0000
Subject: [PATCH 04/32] refactor(avs): avs queries are automatically chunked

---
 src/Model/Types/Avs.hs |  6 ++++
 src/Utils/Avs.hs       | 68 +++++++++++++++++++-----------------------
 2 files changed, 36 insertions(+), 38 deletions(-)

diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs
index bd9aaa0e9..a12980ed6 100644
--- a/src/Model/Types/Avs.hs
+++ b/src/Model/Types/Avs.hs
@@ -197,6 +197,7 @@ discernAvsCardPersonalNo _ = Nothing
 newtype AvsPersonId = AvsPersonId { avsPersonId :: Int } -- untagged Int
   deriving (Eq, Ord, Generic)
   deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField, Hashable, Binary)
+-- TODO: consider using "makeWrapped ''AvsPersonId"
 instance E.SqlString AvsPersonId
 -- As opposed to AvsObjPersonId, AvsPersonId is an untagged Int with respect to FromJSON/ToJSON, as needed by AVS API; 
 instance FromJSON AvsPersonId where
@@ -590,6 +591,7 @@ deriveJSON defaultOptions
 type AvsResponseStatus :: Type
 newtype AvsResponseStatus = AvsResponseStatus (Set AvsStatusPerson)
   deriving (Eq, Ord, Show, Generic)
+makeWrapped ''AvsResponseStatus  
 deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
@@ -601,6 +603,7 @@ instance Semigroup AvsResponseStatus where
 
 newtype AvsResponsePerson = AvsResponsePerson (Set AvsDataPerson)
   deriving (Eq, Ord, Show, Generic)
+-- makeWrapped ''AvsResponsePerson
 deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
@@ -610,6 +613,7 @@ deriveJSON defaultOptions
 
 newtype AvsResponseContact = AvsResponseContact (Set AvsDataContact)
   deriving (Eq, Ord, Show, Generic)
+makeWrapped ''AvsResponseContact
 deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
@@ -666,10 +670,12 @@ deriveJSON defaultOptions
 newtype AvsQueryStatus = AvsQueryStatus (Set AvsPersonId)
   deriving (Eq, Ord, Show, Generic)  
 deriveJSON defaultOptions ''AvsQueryStatus
+makeWrapped ''AvsQueryStatus
 
 newtype AvsQueryContact = AvsQueryContact (Set AvsObjPersonId) -- note the difference to AvsQueryStatus, which receives a list of id, whereas here we sent a list of single-field object 
   deriving (Eq, Ord, Show, Generic)
 deriveJSON defaultOptions ''AvsQueryContact
+makeWrapped ''AvsQueryContact
 
 newtype AvsQueryGetLicences = AvsQueryGetLicences AvsObjPersonId -- this should have been a set, but the specification was implemented differently
   deriving (Eq, Ord, Show, Generic)
diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs
index 00580b26a..abe528279 100644
--- a/src/Utils/Avs.hs
+++ b/src/Utils/Avs.hs
@@ -13,10 +13,10 @@ import qualified Data.Text          as Text
 
 import Servant
 import Servant.Client
-#ifdef DEVELOPMENT
-#else
+-- #ifdef DEVELOPMENT
+-- #else
 import Servant.Client.Core (requestPath)
-#endif
+-- #endif
 
 import Model.Types.Avs
 
@@ -34,8 +34,8 @@ type AVSSetRampLicences = "RampDrivingLicence"      :> ReqBody '[JSON] AvsQueryS
 avsMaxSetLicenceAtOnce :: Int
 avsMaxSetLicenceAtOnce = 90   -- maximum input set size for avsQuerySetLicences as enforced by AVS
 
-avsMaxGetStatusAtOnce :: Int
-avsMaxGetStatusAtOnce = 900   -- maximum input set size for avsQueryStatus as enforced by AVS
+avsMaxQueryAtOnce :: Int
+avsMaxQueryAtOnce = 900   -- maximum input set size for avsQueryStatus as enforced by AVS
 
 
 avsApi :: Proxy AVS
@@ -68,20 +68,20 @@ avsQueryAllLicences = AvsQueryGetLicences $ AvsObjPersonId avsPersonIdZero
 
 
 mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
-#ifdef DEVELOPMENT
-mkAvsQuery _ _ _ = AvsQuery
-    { avsQueryPerson          = \_ -> return . Right $ AvsResponsePerson      mempty
-    , avsQueryStatus          = \_ -> return . Right $ AvsResponseStatus      mempty
-    , avsQueryContact         = \_ -> return . Right $ AvsResponseContact     $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing)
-    , avsQuerySetLicences     = \_ -> return . Right $ AvsResponseSetLicences mempty
-    , avsQueryGetAllLicences  =       return . Right $ AvsResponseGetLicences mempty
-    }
-#else
+-- #ifdef DEVELOPMENT
+-- mkAvsQuery _ _ _ = AvsQuery
+--     { avsQueryPerson          = \_ -> return . Right $ AvsResponsePerson      mempty
+--     , avsQueryStatus          = \_ -> return . Right $ AvsResponseStatus      mempty
+--     , avsQueryContact         = \_ -> return . Right $ AvsResponseContact     $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing)
+--     , avsQuerySetLicences     = \_ -> return . Right $ AvsResponseSetLicences mempty
+--     , avsQueryGetAllLicences  =       return . Right $ AvsResponseGetLicences mempty
+--     }
+-- #else
 mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
-    { avsQueryPerson      = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson      q)  cliEnv
-    , avsQueryStatus      = \q -> liftIO $                     runClientM (splitQueryStatus    q)  cliEnv
-    , avsQueryContact     = \q -> liftIO $                     runClientM (rawQueryContact     q)  cliEnv
-    , avsQuerySetLicences = \q -> liftIO $                     runClientM (rawQuerySetLicences q)  cliEnv
+    { avsQueryPerson      = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson             q)  cliEnv
+    , avsQueryStatus      = \q -> liftIO $                     runClientM (splitQuery rawQueryStatus  q)  cliEnv
+    , avsQueryContact     = \q -> liftIO $                     runClientM (splitQuery rawQueryContact q)  cliEnv
+    , avsQuerySetLicences = \q -> liftIO $                     runClientM (rawQuerySetLicences        q)  cliEnv -- TODO: currently uses setLicencesAvs for splitting to ensure return of correctly set licences
     -- , avsQueryGetLicences = \q -> liftIO $                     runClientM (rawQueryGetLicences q)  cliEnv
     , avsQueryGetAllLicences =    liftIO $                     runClientM (rawQueryGetLicences avsQueryAllLicences) cliEnv
     }
@@ -96,26 +96,18 @@ mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
       | baseUrl == base = Right $ AvsResponsePerson mempty -- WORKAROUND: AVS server erroneously returns 404 if no matching person could be found in its database!
     catch404toEmpty other = other
 
-    -- TODO: make a generic implementation for this
-    splitQueryStatus :: AvsQueryStatus -> ClientM AvsResponseStatus
-    splitQueryStatus q@(AvsQueryStatus avids)
-      | Set.size avids <= avsMaxGetStatusAtOnce = rawQueryStatus q
-      | otherwise = do 
-          let (avid_1,avid_2) = Set.splitAt avsMaxGetStatusAtOnce avids
-          res1 <- rawQueryStatus   (AvsQueryStatus avid_1)
-          res2 <- splitQueryStatus (AvsQueryStatus avid_2)
-          return $ res1 <> res2
-
-    -- splitQuery :: (a -> Set b) -> (Set b -> a) -> (a -> ClientM c) -> a -> ClientM c
-    -- splitQuery toSet fromSet rawQuery q 
-    --   | Set.size (toSet q) <= avsMaxGetStatusAtOnce = rawQueryStatus q
-    --   | otherwise = do
-    --       let (fromSet -> avid_1,fromSet -> avid_2) = Set.splitAt avsMaxGetStatusAtOnce (toSet q)
-    --       res1 <- rawQuery avid_1
-    --       res2 <- splitQuery toSet fromSet rawQuery avid_2
-    --       return $ fromSet (toSet res1 <> toSet res2)
-
-#endif
+    splitQuery :: (Wrapped a, Wrapped c, Unwrapped a ~ Set b, Semigroup (Unwrapped c)) 
+               => (a -> ClientM c) -> a -> ClientM c
+    splitQuery rawQuery q
+        | Set.size s <= avsMaxQueryAtOnce = rawQuery q
+        | otherwise = do
+            let (avsid1, avsid2) = Set.splitAt avsMaxQueryAtOnce s
+            res1 <-            rawQuery $ view _Unwrapped' avsid1
+            res2 <- splitQuery rawQuery $ view _Unwrapped' avsid2
+            return $ view _Unwrapped' (res1 ^. _Wrapped' <> res2 ^. _Wrapped')
+      where 
+        s = view _Wrapped' q
+-- #endif
 
 -----------------------
 -- Utility Functions --

From 76fb44d898f684396fd98fe55ff8e64a7980b704 Mon Sep 17 00:00:00 2001
From: Steffen Jost 
Date: Tue, 25 Apr 2023 09:48:45 +0000
Subject: [PATCH 05/32] chore(users): keep filters after table action

---
 src/Handler/Users.hs                  | 18 +++++++++---------
 src/Handler/Utils.hs                  | 19 +++++++++++++++++++
 src/Handler/Utils/Table/Pagination.hs |  2 +-
 src/Utils/Form.hs                     |  3 ++-
 templates/widgets/form/form.hamlet    |  2 +-
 5 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs
index 2c68d028a..3ae8c8885 100644
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@@ -334,7 +334,7 @@ postUsersR = do
       , dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
       , dbtParams    = DBParamsForm
         { dbParamsFormMethod = POST
-        , dbParamsFormAction = Just $ SomeRoute UsersR
+        , dbParamsFormAction = Nothing -- Just $ SomeRoute (UsersR, [("users-user-company","fraport")])
         , dbParamsFormAttrs  = []
         , dbParamsFormSubmit = FormSubmit
         , dbParamsFormAdditional
@@ -351,21 +351,21 @@ postUsersR = do
       , dbtExtraReps = []
       }
 
+  $logInfoS "UsersFormResult" $ tshow usersRes
   formResult usersRes $ \case
     (act, usersSet)
-      | Set.null usersSet && isNotSetSupervisor act -> do
-          addMessageI Info MsgActionNoUsersSelected
-          redirect UsersR
+      | Set.null usersSet && isNotSetSupervisor act ->
+          addMessageI Info MsgActionNoUsersSelected          
     (UserLdapSyncData, userSet) -> do
       runDBJobs . forM_ userSet $ \uid -> queueDBJob $ JobSynchroniseLdapUser uid
-      addMessageI Success . MsgSynchroniseLdapUserQueued $ Set.size userSet
-      redirect UsersR
+      addMessageI Success . MsgSynchroniseLdapUserQueued $ Set.size userSet      
+      redirectKeepGetParams UsersR
     (UserHijack, Set.minView -> Just (uid, _)) ->
       hijackUser uid >>= sendResponse
     (UserRemoveSupervisorData, userSet) -> do      
       runDB $ deleteWhere [UserSupervisorUser <-. Set.toList userSet]
       addMessageI Success $ MsgUsersRemoveSupervisors $ Set.size userSet
-      redirect UsersR
+      redirectKeepGetParams UsersR
     (act, usersSet)
       | isActionSupervisor act -> do 
         avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser $ getActionSupervisors act
@@ -382,8 +382,8 @@ postUsersR = do
         if nrSuperNotFound > 0
           then addMessageI Warning $ MsgUsersChangeSupervisorsWarning (Set.size usersSet) (length supersFound) nrSuperNotFound
           else addMessageI Success $ MsgUsersChangeSupervisorsSuccess (Set.size usersSet) (length supersFound)
-        redirect UsersR
-    _other -> error "Should not be possible"
+        redirectKeepGetParams UsersR
+    _other -> addMessageI Warning MsgInvalidInput
 
   ((allUsersRes, allUsersWgt), allUsersEnctype) <- runFormPost . identifyForm FIDAllUsersAction $ buttonForm
 
diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs
index 1ff03ffde..f7a43dd6a 100644
--- a/src/Handler/Utils.hs
+++ b/src/Handler/Utils.hs
@@ -137,3 +137,22 @@ redirectAlternatives = go
       Just xs' -> over _1 (x :) $ nunsnoc xs'
     nsnoc [] x = x :| []
     nsnoc (x' : xs) x = x' :| (xs ++ [x])
+
+-- | redirect to currentRoute, if Just otherwise to given default
+reload :: (MonadHandler m, HandlerSite m ~ UniWorX) => Route (HandlerSite m) -> m a
+reload r = getCurrentRoute >>= redirect . fromMaybe r
+
+-- | like `reload`, preserving all GET parameters
+reloadKeepGetParams :: (MonadHandler m, HandlerSite m ~ UniWorX) => Route (HandlerSite m) -> m a
+reloadKeepGetParams r = liftHandler $ do 
+  getps <- reqGetParams <$> getRequest
+  route <- fromMaybe r  <$> getCurrentRoute
+  -- addMessage Info $ toHtml (show getps) -- DEBUG ONLY
+  -- RECALL: redirect GET parameters are used like so: -- redirect (UsersR, [("users-user-company","fraport")])
+  redirect (route, getps) 
+
+-- | redirect preserving all GET parameters
+redirectKeepGetParams :: (MonadHandler m, HandlerSite m ~ UniWorX) => Route (HandlerSite m) -> m a
+redirectKeepGetParams route = liftHandler $ do 
+  getps <- reqGetParams <$> getRequest  
+  redirect (route, getps)  
\ No newline at end of file
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 10b90e28f..076b1ac29 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -964,7 +964,7 @@ instance Monoid' x => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) En
 instance Default (DBParams (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX)) x) where
   def = DBParamsForm
     { dbParamsFormMethod     = POST
-    , dbParamsFormAction     = Nothing
+    , dbParamsFormAction     = Nothing -- Recall: Nothing preserves GET Parameters
     , dbParamsFormAttrs      = []
     , dbParamsFormSubmit     = FormSubmit
     , dbParamsFormAdditional = \_ -> return (pure (), mempty)
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 9ad82b29f..c5f8ef383 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -307,7 +307,7 @@ data FormIdentifier
   | FIDAvsQueryLicence
   | FIDAvsSetLicence
   | FIDBtnAvsImportUnknown
-  | FIDBtnAvsRevokeUnknown  
+  | FIDBtnAvsRevokeUnknown
   deriving (Eq, Ord, Read, Show)
 
 instance PathPiece FormIdentifier where
@@ -1089,6 +1089,7 @@ wrapForm' :: Button site button => button -> WidgetT site IO () -> FormSettings
 wrapForm' btn formWidget FormSettings{..} = do
   formId <- maybe newIdent (return . toPathPiece) formAnchor
   formActionUrl <- traverse toTextUrl formAction
+  let hasAction = isJust formActionUrl
   $(widgetFile "widgets/form/form")
 
 
diff --git a/templates/widgets/form/form.hamlet b/templates/widgets/form/form.hamlet
index 7d4a7901f..371a7c701 100644
--- a/templates/widgets/form/form.hamlet
+++ b/templates/widgets/form/form.hamlet
@@ -5,7 +5,7 @@ $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 $# Wrapper for all kinds of forms
-
      
+
   $# Distinguish different falvours of submit button layouts here:
   $case formSubmit
     $of FormNoSubmit

From 014d479df8f36515915bc7991bb97bad24dcbef9 Mon Sep 17 00:00:00 2001
From: Steffen Jost 
Date: Tue, 25 Apr 2023 09:56:18 +0000
Subject: [PATCH 06/32] fix(users): prevent accidental user hijacking

---
 src/Handler/Users.hs | 4 ++--
 src/Utils/Form.hs    | 1 +
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs
index 3ae8c8885..1e20bdde1 100644
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@@ -45,7 +45,7 @@ import Auth.Dummy (apDummy)
 
 
 hijackUserForm :: Form ()
-hijackUserForm csrf = do
+hijackUserForm = identifyForm FIDHijackUser $ \csrf -> do
   (btnResult, btnView) <- mopt (buttonField BtnHijack) "" Nothing
   return (btnResult >>= guard . is _Just, mconcat [toWidget csrf, fvWidget btnView])
 
@@ -351,7 +351,7 @@ postUsersR = do
       , dbtExtraReps = []
       }
 
-  $logInfoS "UsersFormResult" $ tshow usersRes
+  -- $logInfoS "UsersFormResult" $ tshow usersRes
   formResult usersRes $ \case
     (act, usersSet)
       | Set.null usersSet && isNotSetSupervisor act ->
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index c5f8ef383..1cee75678 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -308,6 +308,7 @@ data FormIdentifier
   | FIDAvsSetLicence
   | FIDBtnAvsImportUnknown
   | FIDBtnAvsRevokeUnknown
+  | FIDHijackUser
   deriving (Eq, Ord, Read, Show)
 
 instance PathPiece FormIdentifier where

From 32b1074dcaf949d8d9b9a50ec648820a1aadb4db Mon Sep 17 00:00:00 2001
From: Steffen Jost 
Date: Tue, 25 Apr 2023 10:41:48 +0000
Subject: [PATCH 07/32] chore(actions): keep filters for table actions on LMS,
 Qualifications and PrintCenter

---
 .../uniworx/categories/term/de-de-formal.msg   |  4 ++--
 messages/uniworx/utils/utils/de-de-formal.msg  |  6 ++++--
 messages/uniworx/utils/utils/en-eu.msg         |  6 ++++--
 src/Handler/LMS.hs                             | 17 +++++++----------
 src/Handler/PrintCenter.hs                     | 10 ++++------
 src/Handler/Qualification.hs                   | 18 ++++++++----------
 src/Handler/Users.hs                           |  4 ++--
 src/Handler/Utils.hs                           |  2 +-
 src/Utils/Form.hs                              |  2 +-
 9 files changed, 33 insertions(+), 36 deletions(-)

diff --git a/messages/uniworx/categories/term/de-de-formal.msg b/messages/uniworx/categories/term/de-de-formal.msg
index 8a93e5698..80555c631 100644
--- a/messages/uniworx/categories/term/de-de-formal.msg
+++ b/messages/uniworx/categories/term/de-de-formal.msg
@@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Gregor Kleen ,Steffen Jost ,Winnie Ros 
+# SPDX-FileCopyrightText: 2023 Gregor Kleen ,Steffen Jost ,Winnie Ros 
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -14,7 +14,7 @@ TermEnd: Ende Kursperiode
 LectureStart: Beginn Kurse
 TermEdited  tid@TermId: Semester #{tid} erfolgreich editiert.
 TermNewTitle: Semester editieren/anlegen.
-InvalidInput: Eingaben bitte korrigieren.
+InvalidInput: Ungültige Eingabe, bitte korrigieren.
 Term !ident-ok: Semester
 TermPlaceholder: JJJJ
 TermStartDay: Erster Tag
diff --git a/messages/uniworx/utils/utils/de-de-formal.msg b/messages/uniworx/utils/utils/de-de-formal.msg
index 3dfdcd670..1d5b9d184 100644
--- a/messages/uniworx/utils/utils/de-de-formal.msg
+++ b/messages/uniworx/utils/utils/de-de-formal.msg
@@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Winnie Ros 
+# SPDX-FileCopyrightText: 2023 Steffen Jost ,Gregor Kleen ,Sarah Vaupel ,Winnie Ros 
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -150,4 +150,6 @@ SheetGradingPassPoints': Bestehen nach Punkten
 SheetGradingPassBinary': Bestanden/Nicht bestanden
 SheetGradingPassAlways': Automatisch bestanden, sobald korrigiert
 SheetTypeNormal !ident-ok: Normal
-SheetTypeBonus !ident-ok: Bonus
\ No newline at end of file
+SheetTypeBonus !ident-ok: Bonus
+
+InvalidFormAction: Keine Aktion ausgeführt wegen ungültigen Formulardaten
\ No newline at end of file
diff --git a/messages/uniworx/utils/utils/en-eu.msg b/messages/uniworx/utils/utils/en-eu.msg
index 8e551020c..9162d42f4 100644
--- a/messages/uniworx/utils/utils/en-eu.msg
+++ b/messages/uniworx/utils/utils/en-eu.msg
@@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Sarah Vaupel ,Winnie Ros 
+# SPDX-FileCopyrightText: 2023 Sarah Vaupel ,Winnie Ros ,Steffen Jost 
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -150,4 +150,6 @@ SheetGradingPassPoints': Passing by points
 SheetGradingPassBinary': Pass/Fail
 SheetGradingPassAlways': Automatically passed when corrected
 SheetTypeNormal: Normal
-SheetTypeBonus: Bonus
\ No newline at end of file
+SheetTypeBonus: Bonus
+
+InvalidFormAction: No action taken due to invalid form data
\ No newline at end of file
diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs
index 8b3f3d9db..7ec9be91b 100644
--- a/src/Handler/LMS.hs
+++ b/src/Handler/LMS.hs
@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Sarah Vaupel ,Steffen Jost ,Steffen Jost 
+-- SPDX-FileCopyrightText: 2023 Sarah Vaupel ,Steffen Jost ,Steffen Jost 
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -365,16 +365,14 @@ mkLmsTable :: forall h p cols act act'.
            -> PSValidator (MForm Handler) (FormResult (First act', DBFormResult UserId Bool LmsTableData))
            -> DB (FormResult (act', Set UserId), Widget)
 mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
-  now <- liftIO getCurrentTime
-  currentRoute <- fromMaybe (error "mkLmsAllTable called from 404-handler") <$> liftHandler getCurrentRoute -- we know the route here
-  let
-    -- currentRoute = LmsR (qualificationSchool quali) (qualificationShorthand quali) -- bad idea as seen
+  now <- liftIO getCurrentTime  
+  let    
     nowaday = utctDay now
     mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
     csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
     dbtIdent :: Text
     dbtIdent = "qualification"
-    dbtSQLQuery q = lmsTableQuery qid q
+    dbtSQLQuery = lmsTableQuery qid
     dbtRowKey = queryUser >>> (E.^. UserId)
     dbtProj = dbtProjId
 
@@ -472,7 +470,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
     dbtParams = if not isAdmin then def {dbParamsFormAction = Nothing, dbParamsFormSubmit = FormNoSubmit} else 
       DBParamsForm
       { dbParamsFormMethod = POST
-      , dbParamsFormAction = Just $ SomeRoute currentRoute
+      , dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute
       , dbParamsFormAttrs  = []
       , dbParamsFormSubmit = FormSubmit
       , dbParamsFormAdditional
@@ -504,8 +502,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
 getLmsR,  postLmsR :: SchoolId -> QualificationShorthand -> Handler Html
 getLmsR = postLmsR
 postLmsR sid qsh = do
-  isAdmin <- hasReadAccessTo AdminR  
-  currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
+  isAdmin <- hasReadAccessTo AdminR    
   ((lmsRes, lmsTable), Entity qid quali) <- runDB $ do
     qent <- getBy404 $ SchoolQualificationShort sid qsh
     let acts :: Map LmsTableAction (AForm Handler LmsTableActionData)
@@ -613,7 +610,7 @@ postLmsR sid qsh = do
       when (isRenewPinAct action) $ addMessageI Success $ MsgLmsPinRenewal       numExaminees
       when (isNotifyAct action)   $ addMessageI Success $ MsgLmsNotificationSend numExaminees
       when (diffSelected /= 0)    $ addMessageI Warning $ MsgLmsActionFailed     diffSelected
-      redirect currentRoute    
+      reloadKeepGetParams $ LmsR sid qsh
 
   let heading = citext2widget $ "LMS " <> qualificationName quali
   siteLayout heading $ do
diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs
index c6faa651e..cd3beeec1 100644
--- a/src/Handler/PrintCenter.hs
+++ b/src/Handler/PrintCenter.hs
@@ -157,8 +157,7 @@ pjTableQuery (printJob `E.LeftOuterJoin` recipient
   return (printJob, recipient, sender, course, quali)
 
 mkPJTable :: DB (FormResult (PJTableActionData, Set PrintJobId), Widget)
-mkPJTable = do
-  currentRoute <- fromMaybe (error "mkPJTable called from 404-handler") <$> liftHandler getCurrentRoute -- albeit we do know the route here
+mkPJTable = do  
   let
     dbtSQLQuery = pjTableQuery
     dbtRowKey = queryPrintJob >>> (E.^. PrintJobId)
@@ -227,7 +226,7 @@ mkPJTable = do
     dbtExtraReps = []
     dbtParams = DBParamsForm
       { dbParamsFormMethod = POST
-      , dbParamsFormAction = Just $ SomeRoute currentRoute
+      , dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute
       , dbParamsFormAttrs  = []
       , dbParamsFormSubmit = FormSubmit
       , dbParamsFormAdditional
@@ -254,8 +253,7 @@ mkPJTable = do
 
 getPrintCenterR,  postPrintCenterR :: Handler Html
 getPrintCenterR = postPrintCenterR
-postPrintCenterR = do
-  currentRoute <- fromMaybe (error "printCenterR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
+postPrintCenterR = do  
   (pjRes, pjTable) <- runDB mkPJTable
 
   formResult pjRes $ \case
@@ -263,7 +261,7 @@ postPrintCenterR = do
     now <- liftIO getCurrentTime
     num <- runDB $ updateWhereCount  [PrintJobAcknowledged ==. Nothing, PrintJobId <-. pjIds] [PrintJobAcknowledged =. Just now]
     addMessageI Success $ MsgPrintJobAcknowledge num
-    redirect currentRoute
+    reloadKeepGetParams PrintCenterR
 
   siteLayoutMsg MsgMenuApc $ do
     setTitleI MsgMenuApc
diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs
index 242c3c355..11669a68c 100644
--- a/src/Handler/Qualification.hs
+++ b/src/Handler/Qualification.hs
@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Steffen Jost ,Steffen Jost 
+-- SPDX-FileCopyrightText: 2023 Steffen Jost ,Steffen Jost 
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -294,8 +294,7 @@ mkQualificationTable ::
            -> DB (FormResult (QualificationTableActionData, Set UserId), Widget)
 mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
   svs <- getSupervisees
-  now <- liftIO getCurrentTime
-  currentRoute <- fromMaybe (error "mkQualificationTable called from 404-handler") <$> liftHandler getCurrentRoute
+  now <- liftIO getCurrentTime  
   let
     nowaday = utctDay now
     mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
@@ -303,7 +302,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
     dbtIdent :: Text
     dbtIdent = "qualification"
     fltrSvs = if isAdmin then const E.true else \quser -> quser E.^. QualificationUserUser `Ex.in_` E.vals svs
-    dbtSQLQuery q = qualificationTableQuery qid fltrSvs q
+    dbtSQLQuery = qualificationTableQuery qid fltrSvs
     dbtRowKey = queryUser >>> (E.^. UserId)
     dbtProj = dbtProjId -- FilteredPostId
     dbtColonnade = cols
@@ -393,7 +392,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
     dbtExtraReps = []    
     dbtParams = DBParamsForm
       { dbParamsFormMethod = POST
-      , dbParamsFormAction = Just $ SomeRoute currentRoute
+      , dbParamsFormAction = Nothing
       , dbParamsFormAttrs  = []
       , dbParamsFormSubmit = FormSubmit
       , dbParamsFormAdditional
@@ -419,8 +418,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
 
 getQualificationR,  postQualificationR :: SchoolId -> QualificationShorthand -> Handler Html
 getQualificationR = postQualificationR
-postQualificationR sid qsh = do
-  currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
+postQualificationR sid qsh = do  
   isAdmin <- hasReadAccessTo AdminR
   ((lmsRes, qualificationTable), Entity qid quali) <- runDB $ do
     qent@Entity{entityVal=Qualification{qualificationAuditDuration=auditMonths}} <- getBy404 $ SchoolQualificationShort sid qsh
@@ -476,7 +474,7 @@ postQualificationR sid qsh = do
       let msgKind = if upd > 0  then Success else Warning
           msgVal  = upd & if isUnexpire then MsgQualificationSetUnexpire else MsgQualificationSetExpire
       addMessageI msgKind msgVal
-      redirect currentRoute
+      reloadKeepGetParams $ QualificationR sid qsh
     (action, selectedUsers) | isBlockAct action && (isAdmin || action == QualificationActBlockSupervisorData)  -> do
       now <- liftIO getCurrentTime
       let nowaday = utctDay now 
@@ -498,8 +496,8 @@ postQualificationR sid qsh = do
             | isNothing qubr -> MsgQualificationStatusUnblock
             | otherwise      -> MsgQualificationStatusBlock
       addMessageI warnLevel $ fbmsg qsh oks nrq
-      redirect currentRoute
-    _ -> addMessageI Error MsgUnauthorized 
+      reloadKeepGetParams $ QualificationR sid qsh
+    _ -> addMessageI Error MsgInvalidFormAction
 
   let heading = citext2widget $ qualificationName quali
   siteLayout heading $ do
diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs
index 1e20bdde1..6961ac1f9 100644
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Winnie Ros 
+-- SPDX-FileCopyrightText: 2023 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Winnie Ros 
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -383,7 +383,7 @@ postUsersR = do
           then addMessageI Warning $ MsgUsersChangeSupervisorsWarning (Set.size usersSet) (length supersFound) nrSuperNotFound
           else addMessageI Success $ MsgUsersChangeSupervisorsSuccess (Set.size usersSet) (length supersFound)
         redirectKeepGetParams UsersR
-    _other -> addMessageI Warning MsgInvalidInput
+    _other -> addMessageI Error MsgInvalidFormAction
 
   ((allUsersRes, allUsersWgt), allUsersEnctype) <- runFormPost . identifyForm FIDAllUsersAction $ buttonForm
 
diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs
index f7a43dd6a..d13be8cee 100644
--- a/src/Handler/Utils.hs
+++ b/src/Handler/Utils.hs
@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Steffen Jost ,Winnie Ros 
+-- SPDX-FileCopyrightText: 2023 Gregor Kleen ,Steffen Jost ,Winnie Ros 
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 1cee75678..1dfdc2703 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Felix Hamann ,Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Steffen Jost ,Wolfgang Witt 
+-- SPDX-FileCopyrightText: 2023 Felix Hamann ,Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Steffen Jost ,Wolfgang Witt 
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 

From 0922723a85b97d51081484f4fa6a407b6451d0f7 Mon Sep 17 00:00:00 2001
From: Steffen Jost 
Date: Tue, 25 Apr 2023 10:42:16 +0000
Subject: [PATCH 08/32] chore(avs): reactivate avs development dummy

---
 src/Utils/Avs.hs | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs
index abe528279..7dfe7148c 100644
--- a/src/Utils/Avs.hs
+++ b/src/Utils/Avs.hs
@@ -13,10 +13,10 @@ import qualified Data.Text          as Text
 
 import Servant
 import Servant.Client
--- #ifdef DEVELOPMENT
--- #else
+#ifdef DEVELOPMENT
+#else
 import Servant.Client.Core (requestPath)
--- #endif
+#endif
 
 import Model.Types.Avs
 
@@ -68,15 +68,15 @@ avsQueryAllLicences = AvsQueryGetLicences $ AvsObjPersonId avsPersonIdZero
 
 
 mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
--- #ifdef DEVELOPMENT
--- mkAvsQuery _ _ _ = AvsQuery
---     { avsQueryPerson          = \_ -> return . Right $ AvsResponsePerson      mempty
---     , avsQueryStatus          = \_ -> return . Right $ AvsResponseStatus      mempty
---     , avsQueryContact         = \_ -> return . Right $ AvsResponseContact     $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing)
---     , avsQuerySetLicences     = \_ -> return . Right $ AvsResponseSetLicences mempty
---     , avsQueryGetAllLicences  =       return . Right $ AvsResponseGetLicences mempty
---     }
--- #else
+#ifdef DEVELOPMENT
+mkAvsQuery _ _ _ = AvsQuery
+    { avsQueryPerson          = \_ -> return . Right $ AvsResponsePerson      mempty
+    , avsQueryStatus          = \_ -> return . Right $ AvsResponseStatus      mempty
+    , avsQueryContact         = \_ -> return . Right $ AvsResponseContact     $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing)
+    , avsQuerySetLicences     = \_ -> return . Right $ AvsResponseSetLicences mempty
+    , avsQueryGetAllLicences  =       return . Right $ AvsResponseGetLicences mempty
+    }
+#else
 mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
     { avsQueryPerson      = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson             q)  cliEnv
     , avsQueryStatus      = \q -> liftIO $                     runClientM (splitQuery rawQueryStatus  q)  cliEnv
@@ -107,7 +107,7 @@ mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
             return $ view _Unwrapped' (res1 ^. _Wrapped' <> res2 ^. _Wrapped')
       where 
         s = view _Wrapped' q
--- #endif
+#endif
 
 -----------------------
 -- Utility Functions --

From 5fcc85c9a029ce5826ff93b9e14eefac892ca2eb Mon Sep 17 00:00:00 2001
From: Steffen Jost 
Date: Tue, 25 Apr 2023 13:10:19 +0000
Subject: [PATCH 09/32] refactor(login): clarify login fields

---
 messages/auth/campus/de.msg                                | 4 ++--
 messages/auth/campus/en.msg                                | 4 ++--
 messages/uniworx/categories/authorization/de-de-formal.msg | 6 +++---
 messages/uniworx/categories/authorization/en-eu.msg        | 6 +++---
 4 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/messages/auth/campus/de.msg b/messages/auth/campus/de.msg
index 8755ecf03..1812fdf28 100644
--- a/messages/auth/campus/de.msg
+++ b/messages/auth/campus/de.msg
@@ -2,7 +2,7 @@
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
-CampusIdentPlaceholder: V.Nachname@fraport.de
-CampusIdent: Fraport AG Kennung
+CampusIdentPlaceholder: V.Nachname@fraport.de / E12345
+CampusIdent: Fraport Kennung
 CampusPassword: Passwort
 CampusPasswordPlaceholder: Passwort
\ No newline at end of file
diff --git a/messages/auth/campus/en.msg b/messages/auth/campus/en.msg
index 55652d3fa..02ffd46fd 100644
--- a/messages/auth/campus/en.msg
+++ b/messages/auth/campus/en.msg
@@ -2,7 +2,7 @@
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
-CampusIdentPlaceholder: F.Last@fraport.de
-CampusIdent: Fraport AG account
+CampusIdentPlaceholder: F.Last@fraport.de / E12345
+CampusIdent: Fraport account
 CampusPassword: Password
 CampusPasswordPlaceholder: Password
\ No newline at end of file
diff --git a/messages/uniworx/categories/authorization/de-de-formal.msg b/messages/uniworx/categories/authorization/de-de-formal.msg
index e16240aa5..b7ee11560 100644
--- a/messages/uniworx/categories/authorization/de-de-formal.msg
+++ b/messages/uniworx/categories/authorization/de-de-formal.msg
@@ -96,9 +96,9 @@ TutorialNoCapacity: In dieser Übung sind keine Plätze mehr frei.
 ExamOccurrenceNoCapacity: Zu diesem Termin/Raum sind keine Plätze mehr frei.
 CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer:innen angemeldet.
 
-LDAPLoginTitle: Fraport AG Login (Büko)
-PWHashLoginTitle: FRADrive Login
-PWHashLoginNote: Verwenden Sie dieses Formular für zugesandte FRADrive Logindaten. Angestellte der Fraport AG sollten stattdessen den Büko-Login verwenden!
+LDAPLoginTitle: Fraport Login für interne und externe Nutzer
+PWHashLoginTitle: Spezieller Funktionsnutzer Login
+PWHashLoginNote: Verwenden Sie dieses Formular nur, wenn Sie explizit dazu aufgefordert wurden. Alle anderen sollten das andere Login Formular verwenden!
 DummyLoginTitle: Development-Login
 InternalLdapError: Interner Fehler beim Fraport Büko-Login
 CampusUserInvalidIdent: Konnte anhand des Fraport Büko-Logins keine eindeutige Identifikation ermitteln
diff --git a/messages/uniworx/categories/authorization/en-eu.msg b/messages/uniworx/categories/authorization/en-eu.msg
index d2ad99d62..59dad7860 100644
--- a/messages/uniworx/categories/authorization/en-eu.msg
+++ b/messages/uniworx/categories/authorization/en-eu.msg
@@ -97,9 +97,9 @@ TutorialNoCapacity: Tutorial has reached maximum capacity
 ExamOccurrenceNoCapacity: Occurrence/Room has reached maximum capacity
 CourseNotEmpty: There are currently no participants enrolled for this course.
 
-LDAPLoginTitle: Fraport AG login (Büko)
-PWHashLoginTitle: FRADrive login
-PWHashLoginNote: Use this form if you have received special FRADrive credentials. Fraport AG employees should use the Büko login instead!
+LDAPLoginTitle: Fraport login for intern and extern users
+PWHashLoginTitle: Special function user login
+PWHashLoginNote: Only use this login form if you have received special instructions to do so. All others should use the other login field.
 DummyLoginTitle: Development login
 InternalLdapError: Internal error during Fraport Büko login
 CampusUserInvalidIdent: Could not determine unique identification during Fraport Büko login

From d973acf42b27645aa436dda389fed9411bace950 Mon Sep 17 00:00:00 2001
From: Steffen Jost 
Date: Tue, 25 Apr 2023 14:43:50 +0000
Subject: [PATCH 10/32] chore(print): switch all letters to sans serif font

---
 templates/letter/din5008.latex         |  3 ++-
 templates/letter/din5008with_pin.latex |  1 +
 templates/letter/plain_article.latex   | 10 +++++++---
 test/Database/Fill.hs                  |  2 +-
 4 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/templates/letter/din5008.latex b/templates/letter/din5008.latex
index c6c88f17e..0816d2ec5 100644
--- a/templates/letter/din5008.latex
+++ b/templates/letter/din5008.latex
@@ -66,7 +66,8 @@ $endif$
   % if luatex or xetex
   \usepackage{fontspec}
   \setmonofont{DejaVu Sans Mono}
-\fi 
+\fi
+\renewcommand{\familydefault}{\sfdefault}
 
 $if(mathspec)$
   \ifXeTeX
diff --git a/templates/letter/din5008with_pin.latex b/templates/letter/din5008with_pin.latex
index 22e3b0a0f..68047cc04 100644
--- a/templates/letter/din5008with_pin.latex
+++ b/templates/letter/din5008with_pin.latex
@@ -67,6 +67,7 @@ $endif$
   \usepackage{fontspec}
   \setmonofont{DejaVu Sans Mono}
 \fi 
+\renewcommand{\familydefault}{\sfdefault}
 
 $if(mathspec)$
   \ifXeTeX
diff --git a/templates/letter/plain_article.latex b/templates/letter/plain_article.latex
index e95489125..bdd9d7cd9 100644
--- a/templates/letter/plain_article.latex
+++ b/templates/letter/plain_article.latex
@@ -51,15 +51,19 @@ $endif$
 \fi
 
 \ifPDFTeX
+  \usepackage{helvet}
   \usepackage[$if(fontenc)$$fontenc$$else$T1$endif$]{fontenc}
   \usepackage[utf8]{inputenc}
-  \usepackage{textcomp} % provide euro and other symbols
-  \usepackage{DejaVuSansMono} % better monofont
+  \usepackage{textcomp}% provide euro and other symbols
+  \usepackage{DejaVuSansMono}% better monofont  
+  \renewcommand{\familydefault}{\sfdefault}
 \else 
   % if luatex or xetex
   \usepackage{fontspec}    
+  %\setmainfont{TeXGyreHeros}%could not install the package somehow tex-gyre in default.nix/shell.nix did not work
+  \setmainfont{DejaVu Sans}
   \setmonofont{DejaVu Sans Mono}
-  %\renewcommand{\familydefault}{\sfdefault}
+  \renewcommand{\familydefault}{\sfdefault}
 \fi 
 
 $if(mathspec)$
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index b5f4549ba..13c67c30c 100644
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@@ -932,7 +932,7 @@ fillDb = do
                 
      
                   
      Benötigte Unterlagen