103 lines
3.6 KiB
Haskell
103 lines
3.6 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
|
|
|
|
|
|
--------------------
|
|
-- Telephone Utils
|
|
|
|
-- | normalize phone numbers
|
|
canonicalPhone :: Text -> Text
|
|
canonicalPhone pn
|
|
| Just pn01 <- Text.stripPrefix "01" pn
|
|
= german_mobile pn01
|
|
| Just pn01 <- Text.stripPrefix "+491" pn
|
|
= german_mobile pn01
|
|
| Just pn00 <- Text.stripPrefix "00" pn
|
|
= Text.cons '+' $ Text.map repl_nondigit pn00
|
|
| Just ('0', pn0) <- Text.uncons pn
|
|
, Just (snr, _ ) <- Text.uncons pn0
|
|
, snr /= '0'
|
|
, Char.isDigit snr
|
|
= "+49 " <> Text.map repl_nondigit pn0
|
|
| otherwise
|
|
= Text.map repl_nondigit pn
|
|
where
|
|
-- split_area :: Text -> Char -> Int -> Text -> Text
|
|
-- split_area c f p n =
|
|
-- let (area,sufx) = Text.splitAt p $ Text.filter Char.isDigit n
|
|
-- in c <> Text.cons f area <> Text.cons ' ' sufx
|
|
|
|
german_mobile :: Text -> Text
|
|
--german_mobile = split_area "+49" '1' 2
|
|
german_mobile wpx =
|
|
let (area,endnr) = Text.splitAt 2 $ Text.filter Char.isDigit wpx
|
|
in "+49 1" <> area <> Text.cons ' ' endnr
|
|
|
|
repl_nondigit :: Char -> Char
|
|
repl_nondigit c
|
|
| Char.isDigit c = c
|
|
| c == '+' = '+'
|
|
| otherwise = ' '
|