{-# 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 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)