64 lines
2.5 KiB
Haskell
64 lines
2.5 KiB
Haskell
-- SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Utils.Mail where
|
|
|
|
|
|
import Import.NoModel
|
|
|
|
import qualified Data.Char as Char
|
|
import qualified Data.Text as Text
|
|
import qualified Data.CaseInsensitive as CI
|
|
|
|
import qualified Text.Email.Validate as Email
|
|
|
|
-- | domains used by LDAP accounts
|
|
fraportMailDomains :: [Text]
|
|
fraportMailDomains = ["@fraport.de"] -- <&> foldCase only!
|
|
|
|
-- | returns the part before the @ symbol of an email address that ends with a fraport domain, preserving case
|
|
-- eg. getFraportLogin "E1234@fraport.de" == Just "E1234"
|
|
-- getFraportLogin "S.Guy@fraport.de" == Just "S.Guy"
|
|
-- getFraportLogin "S.Guy@elsewhere.com" == Nothing
|
|
-- Use CI.traverse getFraportLogin :: CI Text -> Maybe (CI Text)
|
|
-- CI.traverse getFraportLogin "S.Jost@Fraport.de" == Just "S.Jost"
|
|
getFraportLogin :: Text -> Maybe Text
|
|
getFraportLogin email = orgCase <$> lowerCaseLogin
|
|
where
|
|
orgCase = flip Text.take email . Text.length
|
|
lowerCaseLogin = firstJust (flip Text.stripSuffix $ foldCase email) fraportMailDomains
|
|
|
|
-- | check that an email is valid and that it is not an E-account that nobody reads
|
|
-- also see `Handler.Utils.Users.getUserEmail` for Tests accepting User Type
|
|
validEmail :: Text -> Bool -- Email = Text
|
|
validEmail email = validRFC5322 && not invalidFraport
|
|
where
|
|
validRFC5322 = Email.isValid $ encodeUtf8 email
|
|
invalidFraport = case getFraportLogin email of
|
|
Just fralogin -> Text.all Char.isDigit $ Text.drop 1 fralogin -- Emails like E1234@fraport.de or 012345!fraport.de are not read
|
|
Nothing -> False
|
|
|
|
validEmail' :: CI Text -> Bool -- UserEmail = CI Text
|
|
validEmail' = validEmail . CI.original
|
|
|
|
-- | returns the first valid Email, if any
|
|
pickValidEmail :: [Text] -> Maybe Text
|
|
pickValidEmail = find validEmail
|
|
|
|
-- | returns the first valid Email, if any
|
|
pickValidEmail' :: [CI Text] -> Maybe (CI Text)
|
|
pickValidEmail' = find validEmail'
|
|
|
|
-- | returns first argument, if it is a valid email address; returns second argument untested otherwise; convenience function
|
|
pickValidUserEmail :: CI Text -> CI Text -> CI Text
|
|
pickValidUserEmail x y
|
|
| validEmail' x = x
|
|
| otherwise = y
|
|
|
|
-- | returns first valid email address or none if none are valid
|
|
pickValidUserEmail' :: CI Text -> CI Text -> Maybe (CI Text)
|
|
pickValidUserEmail' x y
|
|
| validEmail' x = Just x
|
|
| validEmail' y = Just y
|
|
| otherwise = Nothing |