make cofnigurable sendmail and from-email
This commit is contained in:
parent
e7069228a8
commit
d67f517e04
7 changed files with 33 additions and 14 deletions
|
@ -113,7 +113,7 @@ notifyUser user bev quant price master = do
|
||||||
"VERDAMMT NOCHMAL!!!"
|
"VERDAMMT NOCHMAL!!!"
|
||||||
else
|
else
|
||||||
return ""
|
return ""
|
||||||
liftIO $ sendMail email "Einkauf beim Matematen"
|
liftIO $ sendMail master email "Einkauf beim Matematen"
|
||||||
[lt|
|
[lt|
|
||||||
Hallo #{userIdent user},
|
Hallo #{userIdent user},
|
||||||
|
|
||||||
|
|
|
@ -191,7 +191,7 @@ checkAlert bId oldamount = do
|
||||||
master <- getYesod
|
master <- getYesod
|
||||||
let tos = appEmail $ appSettings master
|
let tos = appEmail $ appSettings master
|
||||||
mapM_ (\to ->
|
mapM_ (\to ->
|
||||||
liftIO $ sendMail to "Niedriger Bestand"
|
liftIO $ sendMail master to "Niedriger Bestand"
|
||||||
[stext|
|
[stext|
|
||||||
Hallo,
|
Hallo,
|
||||||
|
|
||||||
|
@ -204,16 +204,18 @@ Dein Matemat
|
||||||
|]
|
|]
|
||||||
) tos
|
) tos
|
||||||
|
|
||||||
sendMail :: MonadIO m => Text -> Text -> TL.Text -> m ()
|
sendMail :: MonadIO m => App -> Text -> Text -> TL.Text -> m ()
|
||||||
sendMail to subject body =
|
sendMail master to subject body = liftIO $ do
|
||||||
liftIO $ renderSendMail
|
let sendmailLocation = appSendmailLocation $ appSettings master
|
||||||
|
fromMail = appFromMail $ appSettings master
|
||||||
|
renderSendMailCustom sendmailLocation []
|
||||||
Mail
|
Mail
|
||||||
{ mailFrom = Address Nothing "noreply"
|
{ mailFrom = Address Nothing "noreply"
|
||||||
, mailTo = [Address Nothing to]
|
, mailTo = [Address Nothing to]
|
||||||
, mailCc = []
|
, mailCc = []
|
||||||
, mailBcc = []
|
, mailBcc = []
|
||||||
, mailHeaders = [("Subject", subject),
|
, mailHeaders = [("Subject", subject),
|
||||||
("List-Id", "\"Matemat\" <matemat@matemat.hq.c3d2.de>")]
|
("List-Id", "\"Matemat\" <"<> (fromString fromMail) <>">")]
|
||||||
, mailParts =[[Part
|
, mailParts =[[Part
|
||||||
{ partType = "text/plain; charset=utf-8"
|
{ partType = "text/plain; charset=utf-8"
|
||||||
, partEncoding = None
|
, partEncoding = None
|
||||||
|
|
|
@ -119,7 +119,8 @@ postModifyUserR uId =
|
||||||
, UserAvatar =. userConfAvatar uc
|
, UserAvatar =. userConfAvatar uc
|
||||||
, UserPin =. userConfPIN uc
|
, UserPin =. userConfPIN uc
|
||||||
]
|
]
|
||||||
liftIO $ notify user (userConfEmail uc)
|
master <- getYesod
|
||||||
|
liftIO $ notify user (userConfEmail uc) master
|
||||||
handleBarcodes (Left uId) (fromMaybe [] $ userConfBarcode uc)
|
handleBarcodes (Left uId) (fromMaybe [] $ userConfBarcode uc)
|
||||||
setMessageI MsgUserEdited
|
setMessageI MsgUserEdited
|
||||||
redirect $ SelectR uId
|
redirect $ SelectR uId
|
||||||
|
@ -144,11 +145,12 @@ modifyUserForm user bs = UserConf
|
||||||
ents <- runDB $ selectList [] [Asc AvatarIdent]
|
ents <- runDB $ selectList [] [Asc AvatarIdent]
|
||||||
optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents
|
optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents
|
||||||
|
|
||||||
notify :: User -> Maybe Text -> IO ()
|
notify :: User -> Maybe Text -> App -> IO ()
|
||||||
notify user email
|
notify user email master
|
||||||
| (userEmail user) == email = return ()
|
| (userEmail user) == email = return ()
|
||||||
| otherwise = case userEmail user of
|
| otherwise = case userEmail user of
|
||||||
Just address -> sendMail address "Profiländerung"
|
Just address ->
|
||||||
|
sendMail master address "Profiländerung"
|
||||||
[stext|
|
[stext|
|
||||||
Hallo #{userIdent user},
|
Hallo #{userIdent user},
|
||||||
|
|
||||||
|
|
|
@ -76,7 +76,7 @@ transferForm = areq currencyField (bfs MsgValue) (Just 0)
|
||||||
notify :: User -> User -> Int -> App -> IO ()
|
notify :: User -> User -> Int -> App -> IO ()
|
||||||
notify sender rcpt amount master = do
|
notify sender rcpt amount master = do
|
||||||
when (isJust $ userEmail sender) $
|
when (isJust $ userEmail sender) $
|
||||||
liftIO $ sendMail (fromJust $ userEmail sender) "Guthabentransfer beim Matematen"
|
liftIO $ sendMail master (fromJust $ userEmail sender) "Guthabentransfer beim Matematen"
|
||||||
[stext|
|
[stext|
|
||||||
Hallo #{userIdent sender}
|
Hallo #{userIdent sender}
|
||||||
|
|
||||||
|
@ -87,7 +87,7 @@ Viele Grüße,
|
||||||
Dein Matemat
|
Dein Matemat
|
||||||
|]
|
|]
|
||||||
when (isJust $ userEmail rcpt) $
|
when (isJust $ userEmail rcpt) $
|
||||||
liftIO $ sendMail (fromJust $ userEmail rcpt) "Guthabentransfer eingetroffen"
|
liftIO $ sendMail master (fromJust $ userEmail rcpt) "Guthabentransfer eingetroffen"
|
||||||
[stext|
|
[stext|
|
||||||
Hallo #{userIdent rcpt}
|
Hallo #{userIdent rcpt}
|
||||||
|
|
||||||
|
|
5
Model.hs
5
Model.hs
|
@ -13,6 +13,11 @@
|
||||||
--
|
--
|
||||||
-- You should have received a copy of the GNU Affero General Public License
|
-- You should have received a copy of the GNU Affero General Public License
|
||||||
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
|
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
module Model where
|
module Model where
|
||||||
|
|
||||||
import ClassyPrelude.Yesod
|
import ClassyPrelude.Yesod
|
||||||
|
|
|
@ -80,6 +80,10 @@ data AppSettings = AppSettings
|
||||||
-- ^ Block user creation
|
-- ^ Block user creation
|
||||||
, appAdminCreds :: Maybe Login
|
, appAdminCreds :: Maybe Login
|
||||||
-- ^ optional admin credentials
|
-- ^ optional admin credentials
|
||||||
|
, appSendmailLocation :: FilePath
|
||||||
|
-- ^ location of system's sendmail command
|
||||||
|
, appFromMail :: String
|
||||||
|
-- ^ Email address from which the yammat appears to send emails
|
||||||
}
|
}
|
||||||
|
|
||||||
data Login = Login
|
data Login = Login
|
||||||
|
@ -125,6 +129,9 @@ instance FromJSON AppSettings where
|
||||||
|
|
||||||
appAdminCreds <- o .:? "credentials"
|
appAdminCreds <- o .:? "credentials"
|
||||||
|
|
||||||
|
appSendmailLocation <- o .: "sendmail-location"
|
||||||
|
appFromMail <- o .: "from-mail"
|
||||||
|
|
||||||
return AppSettings {..}
|
return AppSettings {..}
|
||||||
|
|
||||||
-- | Settings for 'widgetFile', such as which template languages to support and
|
-- | Settings for 'widgetFile', such as which template languages to support and
|
||||||
|
|
|
@ -36,6 +36,9 @@ copyright_link: "https://github.com/nek0/yammat"
|
||||||
|
|
||||||
block_users: false
|
block_users: false
|
||||||
|
|
||||||
|
sendmail-location: "/usr/sbin/sendmail"
|
||||||
|
from-mail: "matemat@matemat.hq.c3d2.de"
|
||||||
|
|
||||||
# optional administrative credentials.
|
# optional administrative credentials.
|
||||||
# credentials:
|
# credentials:
|
||||||
# login: "admin"
|
# login: "admin"
|
||||||
|
|
Loading…
Reference in a new issue