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

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

Browse Source
This commit is contained in:
Sarah Vaupel 2023-05-01 17:27:50 +00:00
commit ef7c61ff11
4 changed files with 76 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
messages/uniworx/categories/authorization/de-de-formal.msg
View File

@ -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
FormHoneypotFilled: Bitte füllen Sie keines der verstecken Felder aus

14
messages/uniworx/categories/authorization/en-eu.msg
View File

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

100
src/Foundation/Yesod/ErrorHandler.hs
View File

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

14
src/Utils/Avs.hs
View File

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