From 5720ba58c848f141e2d3a15f7cf35ca179491a03 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Fri, 21 Apr 2023 16:17:50 +0200
Subject: [PATCH 1/3] 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 <S.Jost@Fraport.de>
Date: Mon, 24 Apr 2023 13:45:10 +0000
Subject: [PATCH 2/3] 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
-                  <p>_{MsgErrorResponseEncrypted}
-                  <pre .literal-error>
-                    #{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
+    --               <p>_{MsgErrorResponseEncrypted}
+    --               <pre .literal-error>
+    --                 #{ciphertext}
+    --             |]
+    --       if
+    --         | isEncrypted && shouldEncrypt -> displayEncrypted plaintextJson
+    --         | shouldEncrypt -> displayEncrypted =<< encodedSecretBox SecretBoxPretty plaintextJson
+    --         | otherwise -> plaintext
 
-        errPage = case err of
-          NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
-          InternalError err'
-            | "Crash Button" `isPrefixOf` err'   -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing
-            | otherwise -> encrypted err' [whamlet|<p .literal-error>#{fromMaybe err' decrypted}|]
-          InvalidArgs errs -> [whamlet|
-              <ul>
-                $forall err' <- errs
-                  <li .literal-error>
-                    #{err'}
-             |]
-          NotAuthenticated -> [whamlet|<p>_{MsgErrorResponseNotAuthenticated}|]
-          PermissionDenied err' -> [whamlet|<p .errMsg>#{err'}|]
-          BadMethod method -> [whamlet|<p>_{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
-      siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do
-        errPage
+    --     errPage = case err of
+    --       NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
+    --       InternalError err'
+    --         | "Crash Button" `isPrefixOf` err'   -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing
+    --         | otherwise -> encrypted err' [whamlet|<p .literal-error>#{fromMaybe err' decrypted}|]
+    --       InvalidArgs errs -> [whamlet|
+    --           <ul>
+    --             $forall err' <- errs
+    --               <li .literal-error>
+    --                 #{err'}
+    --          |]
+    --       NotAuthenticated -> [whamlet|<p>_{MsgErrorResponseNotAuthenticated}|]
+    --       PermissionDenied err' -> [whamlet|<p .errMsg>#{err'}|]
+    --       BadMethod method -> [whamlet|<p>_{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 <S.Jost@Fraport.de>
Date: Mon, 24 Apr 2023 15:15:14 +0000
Subject: [PATCH 3/3] 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
 
 -----------------------