-- SPDX-FileCopyrightText: 2024 Steffen Jost -- -- 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 = ' '