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

import Import

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 Control.Monad.Trans.State (StateT)


addRecipientsDB :: ( MonadMail 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 (liftHandler . 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

userAddressFrom :: User -> Address
-- ^ Format an e-mail address suitable for usage in a @From@-header
--
-- Uses `userDisplayEmail`
userAddressFrom User{userDisplayEmail, userDisplayName} = Address (Just userDisplayName) $ CI.original userDisplayEmail

userAddress :: User -> Address
-- ^ Format an e-mail address suitable for usage as a recipient
--
-- Uses `userEmail`
userAddress User{userEmail, userDisplayName} = Address (Just userDisplayName) $ CI.original userEmail

userMailT :: ( MonadHandler m
             , HandlerSite m ~ UniWorX
             , MonadThrow m
             , MonadUnliftIO m
             ) => UserId -> MailT m a -> m a
userMailT uid mAct = do
  user@User
    { userLanguages
    , userDateTimeFormat
    , userDateFormat
    , userTimeFormat
    } <- liftHandler . runDB $ getJust uid
  let
    ctx = MailContext
      { mcLanguages = fromMaybe def userLanguages
      , mcDateTimeFormat = \case
          SelFormatDateTime -> userDateTimeFormat
          SelFormatDate -> userDateFormat
          SelFormatTime -> userTimeFormat
      }
  mailT ctx $ do
    _mailTo .= pure (userAddress user)
    mAct

addFileDB :: ( MonadMail m
             , HandlerSite m ~ UniWorX
             ) => FileId -> m (Maybe MailObjectId)
addFileDB fId = runMaybeT $ do
  File{fileTitle = pack . takeBaseName -> fileName, fileContent = Just fileContent} <- MaybeT . liftHandler . runDB $ get fId
  lift . addPart $ do
    _partType .= decodeUtf8 (mimeLookup fileName)
    _partEncoding .= Base64
    _partFilename .= Just fileName
    _partContent .= LBS.fromStrict fileContent
    setMailObjectIdCrypto fId :: StateT Part (HandlerFor UniWorX) MailObjectId