module Jobs.Handler.HelpRequest ( dispatchJobHelpRequest ) where import Import import Text.Hamlet import qualified Data.CaseInsensitive as CI import Handler.Utils import Data.Bitraversable dispatchJobHelpRequest :: Either (Maybe Address) UserId -> UTCTime -> Maybe Text -- ^ Help Subject -> Maybe Html -- ^ Help Request -> Maybe Text -- ^ Referer -> Maybe ErrorResponse -> Handler () dispatchJobHelpRequest jSender jRequestTime jHelpSubject jHelpRequest jReferer jError = do supportAddress <- getsYesod $ view _appMailSupport userInfo <- bitraverse return (runDB . getEntity) jSender let senderAddress = either id (fmap $ \(Entity _ User{..}) -> Address (Just userDisplayName) (CI.original userEmail)) userInfo mailT def $ do _mailTo .= [supportAddress] whenIsJust senderAddress (_mailFrom .=) replaceMailHeader "Auto-Submitted" $ Just "no" setSubjectI $ maybe MsgMailSubjectSupport MsgMailSubjectSupportCustom jHelpSubject setDate jRequestTime rtime <- formatTimeMail SelFormatDateTime jRequestTime errPartName <- for jError $ \_ -> do objId <- setMailObjectIdRandom mr <- getMailMessageRender return . mr $ MsgHelpErrorYamlFilename objId addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/support.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) whenIsJust ((,) <$> jError <*> errPartName) $ \(err, partName) -> addPart' $ do toMailPart $ toYAML err _partDisposition .= InlineDisposition partName