module Handler.Utils.Mail
  ( addRecipientsDB
  , userMailT
  , addFileDB
  ) where

import Import

import Utils.Lens hiding (snoc)

import qualified Data.CaseInsensitive as CI

import qualified Data.ByteString.Lazy as LBS

import qualified Data.Conduit.List as C

import System.FilePath (takeBaseName)
import Network.Mime (defaultMimeLookup)

import Control.Monad.Trans.State (StateT)


addRecipientsDB :: ( MonadMail m
                   , MonadHandler m
                   , HandlerSite m ~ UniWorX
                   ) => [Filter User] -> m ()
-- ^ @setRecipientId uid@ throws an exception if @uid@ does not refer to an existing user
addRecipientsDB uFilter = runConduit $ transPipe (liftHandlerT . runDB) (selectSource uFilter [Asc UserDisplayName]) .| C.mapM_ addRecipient
  where
    addRecipient (Entity _ User{userEmail, userDisplayName}) = do
      let addr = Address (Just userDisplayName) $ CI.original userEmail
      _mailTo %= flip snoc addr

userMailT :: ( MonadHandler m
             , HandlerSite m ~ UniWorX
             , MonadBaseControl IO m
             , MonadLogger m
             ) => UserId -> MailT m a -> m a
userMailT uid mAct = do
  User
    { userEmail
    , userDisplayName
    , userMailLanguages
    , userDateTimeFormat
    , userDateFormat
    , userTimeFormat
    } <- liftHandlerT . runDB $ getJust uid
  let
    addr = Address (Just userDisplayName) $ CI.original userEmail
    ctx = MailContext
      { mcLanguages = userMailLanguages
      , mcDateTimeFormat = \case
          SelFormatDateTime -> userDateTimeFormat
          SelFormatDate -> userDateFormat
          SelFormatTime -> userTimeFormat
      }
  mailT ctx $ do
    _mailTo .= pure addr
    mAct

addFileDB :: ( MonadMail m
             , MonadHandler m
             , HandlerSite m ~ UniWorX
             ) => FileId -> m MailObjectId
addFileDB fId = do
  File{fileTitle = pack . takeBaseName -> fileName, fileContent = Just fileContent} <- liftHandlerT . runDB $ getJust fId
  addPart $ do
    _partType .= decodeUtf8 (defaultMimeLookup fileName)
    _partEncoding .= Base64
    _partFilename .= Just fileName
    _partContent .= LBS.fromStrict fileContent
    setMailObjectId' fId :: StateT Part (HandlerT UniWorX IO) MailObjectId