{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}

-- | Email type with case handling options.  This helps mitigate issues with users that get
-- casing wrong in their email addresses: 'render' is case-sensitive, but `validate' gets you
-- a case-insensitive value with case information intact, so you are forced to decide for
-- yourself which version of the email address you want.  Same assymetry for 'FromJSON',
-- 'ToJSON'.
--
-- (The legal situation is simple: [the local part is case
-- sensitive](https://tools.ietf.org/html/rfc5321), [the domain part is case
-- insensitive](https://tools.ietf.org/html/rfc1035).  However, in practice, the entire email,
-- both local and domain part, are treated as case insensitive almost everywhere.  So for
-- interoperability we want to do the same, but not destroy case information in the process.)
module SAML2.WebSSO.Types.Email (Email, render, validate) where

import Data.Aeson
import Data.ByteString qualified as BS
import Data.CaseInsensitive qualified as CI
import Data.String.Conversions
import Data.Word8 (toLower)
import Text.Email.Validate qualified as Email

newtype Email = Email {fromEmail :: Email.EmailAddress}
  deriving (Eq, Ord, Show)

instance CI.FoldCase Email where
  foldCase (Email eml) =
    Email
      ( Email.unsafeEmailAddress
          (BS.map toLower . Email.localPart $ eml)
          (BS.map toLower . Email.domainPart $ eml)
      )

render :: (CI.FoldCase s, ConvertibleStrings BS.ByteString s) => Email -> s
render = cs . Email.toByteString . fromEmail

validate :: forall s. (ConvertibleStrings s BS.ByteString) => s -> Either String (CI.CI Email)
validate = fmap (CI.mk . Email) . Email.validate . cs

instance FromJSON (CI.CI Email) where
  parseJSON = withText "email address" $ either fail pure . validate

instance ToJSON Email where
  toJSON = String . render
