Merge branch 'master' of gitlab.ifi.lmu.de:fradrive/fradrive

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
+InvalidCredentialsADPasswordExpired: Passwort abgelaufen; ändern Sie Ihr Fraport Passwort auf dem üblichen Weg (z.B. E-Account Nutzer per Azure-Portal)
-InvalidCredentialsADAccountDisabled: Benutzereintrag gesperrt
+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
+InvalidCredentialsADAccountExpired: Benutzereintrag abgelaufen, bitte wenden Sie sich an den allgemeinen IT Support
-InvalidCredentialsADPasswordMustChange: Passwort muss geändert werden
+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
+InvalidCredentialsADAccountLockedOut: Benutzereintrag wurde durch Eindringlingserkennung gesperrt, bitte wenden Sie sich an den allgemeinen IT Support
 
 LoginTitle: Authentifizierung
 

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
+InvalidCredentialsADLogonFailure: Invalid password
-InvalidCredentialsADAccountRestriction: Account restrictions are preventing login
+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
+InvalidCredentialsADPasswordExpired: Password expired, please change your Fraport account password by the usual way (eg. E-account users via Azure portal)
-InvalidCredentialsADAccountDisabled: Account disabled
+InvalidCredentialsADAccountDisabled: Fraport account disabled, please contact general IT support
 InvalidCredentialsADTooManyContextIds: Account carries to many security identifiers
-InvalidCredentialsADAccountExpired: Account expired
+InvalidCredentialsADAccountExpired: Account expired, please contact general IT support
-InvalidCredentialsADPasswordMustChange: Password needs to be changed
+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
+InvalidCredentialsADAccountLockedOut: Account disabled by intruder detection, please contact general IT support
 
 LoginTitle: Authentication
 

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.Exit -- DEBUG: just for testing
-import System.Posix.Process -- 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
@@ -72,39 +72,51 @@ errorHandler err = do
   setSessionJson SessionError sessErr
 
   selectRep $ do
-    provideRep $ do
+    -- provideRep $ do
-      mr <- getMessageRender
+    --   mr <- getMessageRender
-      let
+    --   let
-        encrypted :: Text -> WidgetFor UniWorX () -> WidgetFor UniWorX ()
+    --     encrypted :: Text -> WidgetFor UniWorX () -> WidgetFor UniWorX ()
-        encrypted plaintextJson plaintext = do
+    --     encrypted plaintextJson plaintext = do
-          let displayEncrypted ciphertext = 
+    --       let displayEncrypted ciphertext = 
-                [whamlet|
+    --             [whamlet|
-                  $newline never
+    --               $newline never
-                  <p>_{MsgErrorResponseEncrypted}
+    --               <p>_{MsgErrorResponseEncrypted}
-                  <pre .literal-error>
+    --               <pre .literal-error>
-                    #{ciphertext}
+    --                 #{ciphertext}
-                |]
+    --             |]
-          if
+    --       if
-            | isEncrypted && shouldEncrypt -> displayEncrypted plaintextJson
+    --         | isEncrypted && shouldEncrypt -> displayEncrypted plaintextJson
-            | shouldEncrypt -> displayEncrypted =<< encodedSecretBox SecretBoxPretty plaintextJson
+    --         | shouldEncrypt -> displayEncrypted =<< encodedSecretBox SecretBoxPretty plaintextJson
-            | otherwise -> plaintext
+    --         | otherwise -> plaintext
 
-        errPage = case err of
+    --     errPage = case err of
-          NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
+    --       NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
-          InternalError err'
+    --       InternalError err'
-            | "Crash Button" `isPrefixOf` err'   -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing
+    --         | "Crash Button" `isPrefixOf` err'   -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing
-            | otherwise -> encrypted err' [whamlet|<p .literal-error>#{fromMaybe err' decrypted}|]
+    --         | otherwise -> encrypted err' [whamlet|<p .literal-error>#{fromMaybe err' decrypted}|]
-          InvalidArgs errs -> [whamlet|
+    --       InvalidArgs errs -> [whamlet|
-              <ul>
+    --           <ul>
-                $forall err' <- errs
+    --             $forall err' <- errs
-                  <li .literal-error>
+    --               <li .literal-error>
-                    #{err'}
+    --                 #{err'}
-             |]
+    --          |]
-          NotAuthenticated -> [whamlet|<p>_{MsgErrorResponseNotAuthenticated}|]
+    --       NotAuthenticated -> [whamlet|<p>_{MsgErrorResponseNotAuthenticated}|]
-          PermissionDenied err' -> [whamlet|<p .errMsg>#{err'}|]
+    --       PermissionDenied err' -> [whamlet|<p .errMsg>#{err'}|]
-          BadMethod method -> [whamlet|<p>_{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
+    --       BadMethod method -> [whamlet|<p>_{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
-      siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do
+    --   siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do
-        errPage
+    --     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

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
 
 -----------------------