mateamt/src/Util.hs

104 lines
2.5 KiB
Haskell
Raw Normal View History

{-# LANGUAGE FlexibleContexts #-}
2021-07-12 11:29:40 +00:00
{-# LANGUAGE OverloadedStrings #-}
module Util where
import Opaleye
2021-07-12 11:29:40 +00:00
import Data.ByteString.Lazy (fromStrict)
2019-12-12 02:15:56 +00:00
import Data.Maybe (fromMaybe)
import Data.Profunctor.Product.Default (Default)
2021-07-12 11:29:40 +00:00
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
2021-02-01 01:25:08 +00:00
import Database.PostgreSQL.Simple
import Control.Monad (void)
2021-07-12 11:29:40 +00:00
import Control.Monad.Reader (asks)
import Control.Monad.IO.Class (liftIO)
import Network.Mail.Mime
import System.Directory (doesFileExist)
2021-02-01 01:25:08 +00:00
-- internal imports
import Model
2021-07-12 11:29:40 +00:00
import Types
printSql :: Default Unpackspec a a => Select a -> IO ()
2019-12-12 02:15:56 +00:00
printSql = putStrLn . fromMaybe "Empty query" . showSqlForPostgres
2021-02-01 01:25:08 +00:00
initDB :: Connection -> IO ()
initDB conn = do
execute_ conn initAvatar
execute_ conn initUser
execute_ conn initProduct
execute_ conn initToken
execute_ conn initAuthData
execute_ conn initAmount
execute_ conn initJournal
execute_ conn initRole
execute_ conn initUserToRole
void $ runInsertInitialRoles conn
2021-06-24 04:33:05 +00:00
-- This is only a dummy function.
-- TODO: Replace with proper translation function(s)!
__ = id
2021-07-12 11:29:40 +00:00
sendUserNotification
:: UserDetails -- ^ The recipient
-> T.Text -- ^ The mail subject
-> T.Text -- ^ The mail body
-> MateHandler ()
sendUserNotification recipient subject message =
case userDetailsEmail recipient of
Just email ->
sendNotification (Mail
{ mailFrom = Address Nothing "noreply"
, mailTo =
[ Address
(Just $ userDetailsIdent recipient)
2021-10-16 15:50:28 +00:00
email
2021-07-12 11:29:40 +00:00
]
, mailCc = []
, mailBcc = []
, mailHeaders = [("Subject", subject)]
, mailParts =
[[ Part
{ partType = "text/plain; charset=utf-8"
, partEncoding = None
, partDisposition = DefaultDisposition
, partHeaders = []
, partContent = PartContent (fromStrict $ E.encodeUtf8 message)
}
]]
}
)
Nothing ->
return ()
2021-07-14 01:08:58 +00:00
sendAdminNotification
:: T.Text -- The mail subject
-> T.Text -- The mail body
-> MateHandler ()
sendAdminNotification subject message =
-- TODO: Grab administrators from settings and actually send the mails to them
return ()
2021-10-16 15:50:28 +00:00
sendNotification :: Mail -> MateHandler ()
2021-07-12 11:29:40 +00:00
sendNotification mail = do
2021-10-16 15:50:28 +00:00
sendmailPath <- asks rsSendmailPath
2021-07-12 11:29:40 +00:00
liftIO $ do
2021-10-16 15:50:28 +00:00
existence <- doesFileExist sendmailPath
2021-07-12 11:29:40 +00:00
if existence
then
2021-10-16 15:50:28 +00:00
renderSendMailCustom sendmailPath [] mail
2021-07-12 11:29:40 +00:00
else
2021-10-16 15:50:28 +00:00
print ("Warning: sending notification failed: Sendmail not present!"
:: String)