make admin notification
This commit is contained in:
parent
06863cc26d
commit
f612bad546
3 changed files with 57 additions and 3 deletions
|
@ -48,6 +48,17 @@ userGet (Just (uid, _)) = do
|
||||||
conn <- asks rsConnection
|
conn <- asks rsConnection
|
||||||
userDetailsSelect uid conn
|
userDetailsSelect uid conn
|
||||||
|
|
||||||
|
userGetAll
|
||||||
|
:: Maybe (Int, AuthMethod)
|
||||||
|
-> MateHandler [UserDetails]
|
||||||
|
userGetAll Nothing =
|
||||||
|
throwError $ err401
|
||||||
|
{ errBody = "No Authentication present."
|
||||||
|
}
|
||||||
|
userGetAll (Just (_, _)) = do
|
||||||
|
conn <- asks rsConnection
|
||||||
|
userDetailsSelectAll conn
|
||||||
|
|
||||||
userUpdate
|
userUpdate
|
||||||
:: Maybe (Int, AuthMethod)
|
:: Maybe (Int, AuthMethod)
|
||||||
-> UserDetailsSubmit
|
-> UserDetailsSubmit
|
||||||
|
|
|
@ -85,6 +85,18 @@ userSelect ref conn = do
|
||||||
)
|
)
|
||||||
users
|
users
|
||||||
|
|
||||||
|
userDetailsSelectAll
|
||||||
|
:: PGS.Connection
|
||||||
|
-> MateHandler [UserDetails]
|
||||||
|
userDetailsSelectAll conn = do
|
||||||
|
users <- liftIO (map fromDatabase <$> runSelect conn (selectTable userTable)) :: MateHandler [User]
|
||||||
|
return $ map
|
||||||
|
(\(User i1 i2 i3 _ i5 i6) ->
|
||||||
|
UserDetails i1 i2 i3 i5 i6
|
||||||
|
)
|
||||||
|
users
|
||||||
|
|
||||||
|
|
||||||
userDetailsSelect
|
userDetailsSelect
|
||||||
:: Int
|
:: Int
|
||||||
-> PGS.Connection
|
-> PGS.Connection
|
||||||
|
|
37
src/Util.hs
37
src/Util.hs
|
@ -1,5 +1,6 @@
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
module Util where
|
module Util where
|
||||||
|
|
||||||
import Opaleye
|
import Opaleye
|
||||||
|
@ -30,6 +31,9 @@ import Model
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
|
import Control.User
|
||||||
|
import Types (UserDetails(userDetailsId))
|
||||||
|
|
||||||
printSql :: Default Unpackspec a a => Select a -> IO ()
|
printSql :: Default Unpackspec a a => Select a -> IO ()
|
||||||
printSql = putStrLn . fromMaybe "Empty query" . showSql
|
printSql = putStrLn . fromMaybe "Empty query" . showSql
|
||||||
|
|
||||||
|
@ -86,9 +90,36 @@ sendAdminNotification
|
||||||
:: T.Text -- The mail subject
|
:: T.Text -- The mail subject
|
||||||
-> T.Text -- The mail body
|
-> T.Text -- The mail body
|
||||||
-> MateHandler ()
|
-> MateHandler ()
|
||||||
sendAdminNotification subject message =
|
sendAdminNotification subject message = do
|
||||||
-- TODO: Grab administrators from settings and actually send the mails to them
|
allUsers <- userGetAll
|
||||||
return ()
|
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 -> MateHandler ()
|
||||||
sendNotification mail = do
|
sendNotification mail = do
|
||||||
|
|
Loading…
Reference in a new issue