136 lines
3.5 KiB
Haskell
136 lines
3.5 KiB
Haskell
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
module Util where
|
|
|
|
import Opaleye
|
|
|
|
import Data.ByteString.Lazy (fromStrict)
|
|
|
|
import Data.Maybe (fromMaybe)
|
|
|
|
import Data.Profunctor.Product.Default (Default)
|
|
|
|
import Data.String (fromString)
|
|
|
|
import qualified Data.Text as T
|
|
|
|
import qualified Data.Text.Encoding as E
|
|
|
|
import Database.PostgreSQL.Simple
|
|
|
|
import Control.Monad (void)
|
|
import Control.Monad.Reader (asks)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
|
|
import Network.Mail.Mime
|
|
|
|
import System.Directory (doesFileExist)
|
|
|
|
-- internal imports
|
|
|
|
import Model
|
|
|
|
import Types
|
|
|
|
import Control.User
|
|
import Types (UserDetails(userDetailsId))
|
|
|
|
printSql :: Default Unpackspec a a => Select a -> IO ()
|
|
printSql = putStrLn . fromMaybe "Empty query" . showSql
|
|
|
|
initDB :: Connection -> IO ()
|
|
initDB conn = do
|
|
void $ execute_ conn initAvatar
|
|
void $ execute_ conn initUser
|
|
void $ execute_ conn initProduct
|
|
void $ execute_ conn initToken
|
|
void $ execute_ conn initAuthData
|
|
void $ execute_ conn initAmount
|
|
void $ execute_ conn initJournal
|
|
void $ execute_ conn initRole
|
|
void $ execute_ conn initUserToRole
|
|
void $ runInsertInitialRoles conn
|
|
|
|
-- This is only a dummy function.
|
|
-- TODO: Replace with proper translation function(s)!
|
|
__ = id
|
|
|
|
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)
|
|
email
|
|
]
|
|
, 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 ()
|
|
|
|
sendAdminNotification
|
|
:: T.Text -- The mail subject
|
|
-> T.Text -- The mail body
|
|
-> MateHandler ()
|
|
sendAdminNotification subject message = do
|
|
allUsers <- userGetAll
|
|
admins <- mapM
|
|
(\uid -> checkCapability uid roleCanManageSettings. userDetailsId)
|
|
allUsers
|
|
mapM_
|
|
(\ UserDetails {..} ->
|
|
let mail = Mail
|
|
{ mailFrom = Address Nothing "noreply"
|
|
, mailTo =
|
|
[ Address
|
|
(Just userDetailsIdent)
|
|
userDetailsEmail
|
|
]
|
|
, mailCc = []
|
|
, mailBcc =[]
|
|
, mailHeaders =
|
|
[[ Part
|
|
{ partType = "text/plain; charset=utf8"
|
|
, partEncoding = None
|
|
, partDisposition = DefaultDisposition
|
|
, partHeaders = []
|
|
, partContent = PartContent (fromString $ E.encodeUtf8 message)
|
|
}
|
|
]]
|
|
}
|
|
in
|
|
sendNotification mail
|
|
)
|
|
allUsers
|
|
|
|
sendNotification :: Mail -> MateHandler ()
|
|
sendNotification mail = do
|
|
sendmailPath <- asks rsSendmailPath
|
|
liftIO $ do
|
|
existence <- doesFileExist sendmailPath
|
|
if existence
|
|
then
|
|
renderSendMailCustom sendmailPath [] mail
|
|
else
|
|
print ("Warning: sending notification failed: Sendmail not present!"
|
|
:: String)
|