From d67f517e04a552ecab0fcf8fe86c6aa9106c7cfd Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 6 Mar 2021 22:09:08 +0100 Subject: [PATCH] make cofnigurable sendmail and from-email --- Handler/Buy.hs | 2 +- Handler/Common.hs | 12 +++++++----- Handler/NewUser.hs | 14 ++++++++------ Handler/Transfer.hs | 4 ++-- Model.hs | 5 +++++ Settings.hs | 7 +++++++ config/settings.yml | 3 +++ 7 files changed, 33 insertions(+), 14 deletions(-) diff --git a/Handler/Buy.hs b/Handler/Buy.hs index 21f527e..1d425ac 100644 --- a/Handler/Buy.hs +++ b/Handler/Buy.hs @@ -113,7 +113,7 @@ notifyUser user bev quant price master = do "VERDAMMT NOCHMAL!!!" else return "" - liftIO $ sendMail email "Einkauf beim Matematen" + liftIO $ sendMail master email "Einkauf beim Matematen" [lt| Hallo #{userIdent user}, diff --git a/Handler/Common.hs b/Handler/Common.hs index 3330be0..d5f1b20 100644 --- a/Handler/Common.hs +++ b/Handler/Common.hs @@ -191,7 +191,7 @@ checkAlert bId oldamount = do master <- getYesod let tos = appEmail $ appSettings master mapM_ (\to -> - liftIO $ sendMail to "Niedriger Bestand" + liftIO $ sendMail master to "Niedriger Bestand" [stext| Hallo, @@ -204,16 +204,18 @@ Dein Matemat |] ) tos -sendMail :: MonadIO m => Text -> Text -> TL.Text -> m () -sendMail to subject body = - liftIO $ renderSendMail +sendMail :: MonadIO m => App -> Text -> Text -> TL.Text -> m () +sendMail master to subject body = liftIO $ do + let sendmailLocation = appSendmailLocation $ appSettings master + fromMail = appFromMail $ appSettings master + renderSendMailCustom sendmailLocation [] Mail { mailFrom = Address Nothing "noreply" , mailTo = [Address Nothing to] , mailCc = [] , mailBcc = [] , mailHeaders = [("Subject", subject), - ("List-Id", "\"Matemat\" ")] + ("List-Id", "\"Matemat\" <"<> (fromString fromMail) <>">")] , mailParts =[[Part { partType = "text/plain; charset=utf-8" , partEncoding = None diff --git a/Handler/NewUser.hs b/Handler/NewUser.hs index db1d8f1..8009387 100644 --- a/Handler/NewUser.hs +++ b/Handler/NewUser.hs @@ -119,7 +119,8 @@ postModifyUserR uId = , UserAvatar =. userConfAvatar uc , UserPin =. userConfPIN uc ] - liftIO $ notify user (userConfEmail uc) + master <- getYesod + liftIO $ notify user (userConfEmail uc) master handleBarcodes (Left uId) (fromMaybe [] $ userConfBarcode uc) setMessageI MsgUserEdited redirect $ SelectR uId @@ -144,12 +145,13 @@ modifyUserForm user bs = UserConf ents <- runDB $ selectList [] [Asc AvatarIdent] optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents -notify :: User -> Maybe Text -> IO () -notify user email +notify :: User -> Maybe Text -> App -> IO () +notify user email master | (userEmail user) == email = return () | otherwise = case userEmail user of - Just address -> sendMail address "Profiländerung" - [stext| + Just address -> + sendMail master address "Profiländerung" + [stext| Hallo #{userIdent user}, deine Profileinstellungen wurden geändert. @@ -158,5 +160,5 @@ Nur damit du Bescheid weißt. Grüße, der Matemat - |] + |] Nothing -> return () diff --git a/Handler/Transfer.hs b/Handler/Transfer.hs index 301c204..9e30ec8 100644 --- a/Handler/Transfer.hs +++ b/Handler/Transfer.hs @@ -76,7 +76,7 @@ transferForm = areq currencyField (bfs MsgValue) (Just 0) notify :: User -> User -> Int -> App -> IO () notify sender rcpt amount master = do when (isJust $ userEmail sender) $ - liftIO $ sendMail (fromJust $ userEmail sender) "Guthabentransfer beim Matematen" + liftIO $ sendMail master (fromJust $ userEmail sender) "Guthabentransfer beim Matematen" [stext| Hallo #{userIdent sender} @@ -87,7 +87,7 @@ Viele Grüße, Dein Matemat |] when (isJust $ userEmail rcpt) $ - liftIO $ sendMail (fromJust $ userEmail rcpt) "Guthabentransfer eingetroffen" + liftIO $ sendMail master (fromJust $ userEmail rcpt) "Guthabentransfer eingetroffen" [stext| Hallo #{userIdent rcpt} diff --git a/Model.hs b/Model.hs index 7ce3c2e..0489975 100644 --- a/Model.hs +++ b/Model.hs @@ -13,6 +13,11 @@ -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} module Model where import ClassyPrelude.Yesod diff --git a/Settings.hs b/Settings.hs index 22cd795..c083e20 100644 --- a/Settings.hs +++ b/Settings.hs @@ -80,6 +80,10 @@ data AppSettings = AppSettings -- ^ Block user creation , appAdminCreds :: Maybe Login -- ^ 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 @@ -125,6 +129,9 @@ instance FromJSON AppSettings where appAdminCreds <- o .:? "credentials" + appSendmailLocation <- o .: "sendmail-location" + appFromMail <- o .: "from-mail" + return AppSettings {..} -- | Settings for 'widgetFile', such as which template languages to support and diff --git a/config/settings.yml b/config/settings.yml index dc86ebb..d272d17 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -36,6 +36,9 @@ copyright_link: "https://github.com/nek0/yammat" block_users: false +sendmail-location: "/usr/sbin/sendmail" +from-mail: "matemat@matemat.hq.c3d2.de" + # optional administrative credentials. # credentials: # login: "admin"