Merge branch 'fradrive/localmaster'
This commit is contained in:
commit
2e7f12d653
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
Reference in New Issue
Block a user