{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Util where import Servant import Opaleye import qualified Data.ByteString as BS import Data.ByteString.Lazy (fromStrict) import Data.Maybe (fromMaybe, fromJust) 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, filterM) import Control.Monad.Reader (asks) import Control.Monad.IO.Class (liftIO) import Network.Mail.Mime import System.Directory (doesFileExist) import System.Random.Stateful -- internal imports import Model import Types -- | This is the internal function to check a users authorization to do certain -- actions checkCapability :: Int -- ^ User Id to check -> (Role -> Bool) -- ^ Predicate to check -> MateHandler Bool -- ^ Result checkCapability uid accessRule = do conn <- asks rsConnection assocs <- selectUserAssociations uid conn let rids = map roleAssociationRole assocs roles <- selectRoleList rids conn return $ any accessRule roles notImplemented :: MateHandler a notImplemented = throwError $ err501 { errBody = "Function has not yet been implemented!" } 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 conn <- asks rsConnection allUsers <- userDetailsSelectAll conn admins <- filterM ((`checkCapability` roleCanManageSettings) . userDetailsId) allUsers mapM_ (\ UserDetails{..} -> let mail = Mail { mailFrom = Address Nothing "noreply" , mailTo = [ Address (Just userDetailsIdent) (fromJust userDetailsEmail) ] , mailCc = [] , mailBcc =[] , mailHeaders = [("Subject", subject)] , mailParts = [[ Part { partType = "text/plain; charset=utf8" , partEncoding = None , partDisposition = DefaultDisposition , partHeaders = [] , partContent = PartContent (fromString $ T.unpack message) } ]] } in sendNotification mail ) admins 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) randomString :: IO BS.ByteString randomString = uniformByteStringM 32 =<< newIOGenM (mkStdGen 23)