Merge branch 'fradrive/localmaster'

This commit is contained in:
Steffen Jost 2023-03-28 11:48:17 +00:00
commit 2e7f12d653
4 changed files with 12 additions and 10 deletions

View File

@ -26,7 +26,7 @@ import Database.Esqueleto.Utils.TH
import Utils.Print import Utils.Print
-- import Data.Aeson (encode) -- import Data.Aeson (encode)
-- import qualified Data.Text as Text import qualified Data.Text as Text
-- import qualified Data.Set as Set -- import qualified Data.Set as Set
import Handler.Utils import Handler.Utils
@ -394,7 +394,7 @@ postPrintAckDirectR = do
Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error
$logWarnS "APC" $ "Result upload failed parsing: " <> tshow e $logWarnS "APC" $ "Result upload failed parsing: " <> tshow e
return (badRequest400, "Error: " <> tshow e) return (badRequest400, "Error: " <> tshow e)
Right reqIds -> do Right (fmap Text.strip -> reqIds) -> do -- inside conduit?
let nrReq = length reqIds let nrReq = length reqIds
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
nrApcIds <- updateWhereCount nrApcIds <- updateWhereCount

View File

@ -56,8 +56,8 @@ userAddressError :: (MonadHandler m, HandlerSite m ~ UniWorX) => User -> m (Bool
userAddressError User{userEmail, userDisplayEmail, userDisplayName} userAddressError User{userEmail, userDisplayEmail, userDisplayName}
| Just okEmail <- pickValidEmail' userDisplayEmail userEmail = pure (True, Address (Just userDisplayName) $ CI.original okEmail) | Just okEmail <- pickValidEmail' userDisplayEmail userEmail = pure (True, Address (Just userDisplayName) $ CI.original okEmail)
| otherwise = do | otherwise = do
$logErrorS "Mail" $ "Attempt to email invalid address: " <> tshow userDisplayEmail <> " Sent to support instead." -- <> " with subject " <> tshow failedSubject $logErrorS "Mail" $ "Attempt to email invalid address: " <> tshow userDisplayEmail <> " / " <> tshow userEmail <> ". Sent to support instead." -- <> " with subject " <> tshow failedSubject
(True,) <$> getsYesod (view _appMailSupport) (False,) <$> getsYesod (view _appMailSupport)
-- | Send an email to the given UserId or to all registered Supervisor with rerouteNotifications == True -- | Send an email to the given UserId or to all registered Supervisor with rerouteNotifications == True
userMailT :: ( MonadHandler m userMailT :: ( MonadHandler m
@ -145,8 +145,9 @@ userMailTdirect uid mAct = do
-- failedSubject <- lookupMailHeader "Subject" -- failedSubject <- lookupMailHeader "Subject"
-- unless (validEmail $ addressEmail mailtoAddr) ($logErrorS "Mail" $ "Attempt to email invalid address: " <> tshow mailtoAddr <> " with subject " <> tshow failedSubject) -- unless (validEmail $ addressEmail mailtoAddr) ($logErrorS "Mail" $ "Attempt to email invalid address: " <> tshow mailtoAddr <> " with subject " <> tshow failedSubject)
_mailTo .= pure mailtoAddr _mailTo .= pure mailtoAddr
res <- mAct
unless mailOk $ mapSubject ("[ERROR]" <>) unless mailOk $ mapSubject ("[ERROR]" <>)
mAct pure res
addFileDB :: ( MonadMail m addFileDB :: ( MonadMail m
, HandlerSite m ~ UniWorX , HandlerSite m ~ UniWorX

View File

@ -82,12 +82,12 @@ validPostAddress _ = False
-- also see `Handler.Utils.Users.getEmailAddress` for Tests accepting User Type -- also see `Handler.Utils.Users.getEmailAddress` for Tests accepting User Type
validEmail :: Email -> Bool -- Email = Text validEmail :: Email -> Bool -- Email = Text
validEmail email = validRFC5322 && not invalidFraport validEmail email = validRFC5322 -- && not invalidFraport
where where
validRFC5322 = Email.isValid $ encodeUtf8 email validRFC5322 = Email.isValid $ encodeUtf8 email
invalidFraport = case Text.stripSuffix "@fraport.de" email of -- invalidFraport = case Text.stripSuffix "@fraport.de" email of
Just fralogin -> all isDigit $ drop 1 fralogin -- Just fralogin -> all isDigit $ drop 1 fralogin
Nothing -> False -- Nothing -> False
validEmail' :: UserEmail -> Bool -- UserEmail = CI Text validEmail' :: UserEmail -> Bool -- UserEmail = CI Text
validEmail' = validEmail . CI.original validEmail' = validEmail . CI.original

View File

@ -437,12 +437,13 @@ fillDb = do
userEmail' = CI.mk $ case firstName of userEmail' = CI.mk $ case firstName of
"James" -> userIdent "James" -> userIdent
"John" -> userIdent "John" -> userIdent
--"Elizabeth" -> "AVSID:" <> userMatrikelnummer' "Elizabeth" -> "AVSID:" <> userMatrikelnummer'
_ -> "E" <> userMatrikelnummer' <> "@fraport.de" _ -> "E" <> userMatrikelnummer' <> "@fraport.de"
userDisplayEmail' :: CI Text userDisplayEmail' :: CI Text
userDisplayEmail' = CI.mk $ case userSurname of userDisplayEmail' = CI.mk $ case userSurname of
"Walker" -> "AVSNO:" <> userMatrikelnummer' "Walker" -> "AVSNO:" <> userMatrikelnummer'
"Clark" -> "E" <> userMatrikelnummer' <> "@fraport.de" "Clark" -> "E" <> userMatrikelnummer' <> "@fraport.de"
"Elizabeth" -> ""
_ -> userIdent _ -> userIdent
matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int) matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int)