{-|
Module      : Gargantext.Core.Config.Mail
Description :
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# LANGUAGE TemplateHaskell #-}

module Gargantext.Core.Config.Mail (
  -- * Types
    GargMail(..)
  , LoginType(..)
  , SendEmailType(..)
  , MailConfig(..)
  , MailException(..)

  -- * Utility functions
  , gargMail

  -- * Lenses
  , mc_mail_from
  , mc_mail_host
  , mc_mail_login_type
  , mc_mail_password
  , mc_mail_port
  , mc_mail_user
  , mc_send_login_emails
  )
  where

import Control.Exception.Safe qualified as Exc
import Control.Monad.Fail (fail)
import Data.Maybe
import Data.Text (unpack)
import Data.Text qualified as T
import Gargantext.Prelude
import Network.Mail.Mime (plainPart)
import Network.Mail.SMTP hiding (htmlPart, STARTTLS)
import Network.Socket (PortNumber)
import Toml
import Toml.Schema


type Email = Text
type Name  = Text

data LoginType = NoAuth | Normal | SSL | TLS | STARTTLS
  deriving (Generic, Eq, Show, Read)
instance FromValue LoginType where
  fromValue (Toml.Text' _ t) =
    case t of
      "NoAuth" -> return NoAuth
      "Normal" -> return Normal
      "SSL" -> return SSL
      "TLS" -> return TLS
      "STARTTLS" -> return STARTTLS
      _ -> fail ("Cannot parse login type from " <> T.unpack t)
  fromValue _ = fail ("Expected text for login type")
instance ToValue LoginType where
  toValue v = toValue (show v :: Text)


data SendEmailType = SendEmailViaAws
                   | LogEmailToConsole
                   | WriteEmailToFile
    deriving (Show, Read, Enum, Bounded, Generic)


data MailConfig = MailConfig { _mc_mail_host         :: !T.Text
                             , _mc_mail_port         :: !PortNumber
                             , _mc_mail_user         :: !T.Text
                             , _mc_mail_password     :: !T.Text
                             , _mc_mail_login_type   :: !LoginType
                             , _mc_mail_from         :: !T.Text
                             , _mc_send_login_emails :: !SendEmailType
                             }
  deriving (Generic, Show)
instance FromValue MailConfig where
  fromValue = parseTableFromValue $ do
    _mc_mail_host <- reqKey "host"
    port <- reqKey "port" :: ParseTable l Int
    _mc_mail_user <- reqKey "user"
    _mc_mail_password <- reqKey "password"
    _mc_mail_login_type <- reqKey "login_type"
    _mc_mail_from <- reqKey "from"
    let _mc_send_login_emails = LogEmailToConsole
    return $ MailConfig { _mc_mail_port = fromIntegral port, .. }
instance ToValue MailConfig where
  toValue = defaultTableToValue
instance ToTable MailConfig where
  toTable (MailConfig { .. }) = table [ "port" .= (fromIntegral _mc_mail_port :: Int)
                                      , "host" .= _mc_mail_host
                                      , "user" .= _mc_mail_user
                                      , "password" .= _mc_mail_password
                                      , "from" .= _mc_mail_from
                                      , "login_type" .= _mc_mail_login_type ]

-- readConfig :: SettingsFile -> IO MailConfig
-- readConfig (SettingsFile fp) = do
--   eRes <- Toml.decodeFileEither mailCodec fp

--   case eRes of
--     Left err -> panicTrace ("Error reading TOML file (mail): " <> show err :: Text)
--     Right config -> return config


-- mailCodec :: Toml.TomlCodec MailConfig
-- mailCodec = MailConfig
--   <$> Toml.text "mail.host" .= _mc_mail_host
--   <*> Toml.read "mail.port" .= _mc_mail_port
--   <*> Toml.text "mail.user" .= _mc_mail_user
--   <*> Toml.text "mail.password" .= _mc_mail_password
--   <*> Toml.read "mail.login_type" .= _mc_mail_login_type
--   <*> Toml.text "mail.from" .= _mc_mail_from

  -- pure $ MailConfig { _mc_mail_host       =        cs $ val' "MAIL_HOST"
  --                   , _mc_mail_port       = read $ cs $ val' "MAIL_PORT"
  --                   , _mc_mail_user       =        cs $ val' "MAIL_USER"
  --                   , _mc_mail_from       =        cs $ val' "MAIL_FROM"
  --                   , _mc_mail_password   =        cs $ val' "MAIL_PASSWORD"
  --                   , _mc_mail_login_type = read $ cs $ val' "MAIL_LOGIN_TYPE"
  --                   }


newtype MailException =
  MailException SomeException
  deriving (Show)
instance Exception MailException


data GargMail = GargMail { gm_to      :: Email
                         , gm_name    :: Maybe Name
                         , gm_subject :: Text
                         , gm_body    :: Text
                         }

gargMail :: MailConfig -> GargMail -> IO ()
gargMail mc gm = do
  Exc.catch (gargMail' mc gm) $ \e -> Exc.throw (MailException e)

gargMail' :: MailConfig -> GargMail -> IO ()
gargMail' (MailConfig {..}) (GargMail { .. }) = do
  let host     = unpack _mc_mail_host
      user     = unpack _mc_mail_user
      password = unpack _mc_mail_password
  case _mc_mail_login_type of
    NoAuth   -> sendMail                   host mail
    Normal   -> sendMailWithLogin'         host _mc_mail_port user password mail
    SSL      -> sendMailWithLoginTLS'      host _mc_mail_port user password mail
    TLS      -> sendMailWithLoginTLS'      host _mc_mail_port user password mail
    STARTTLS -> sendMailWithLoginSTARTTLS' host _mc_mail_port user password mail
  where
    mail = simpleMail sender receiver cc bcc gm_subject [plainPart $ cs gm_body]

    sender   = Address (Just "GarganText Email") _mc_mail_from
    receiver = [Address gm_name gm_to]
    cc       = []
    bcc      = []

makeLenses ''MailConfig
