-- 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