mateamt/src/Util.hs

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

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