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!!!"
|
||||
else
|
||||
return ""
|
||||
liftIO $ sendMail email "Einkauf beim Matematen"
|
||||
liftIO $ sendMail master email "Einkauf beim Matematen"
|
||||
[lt|
|
||||
Hallo #{userIdent user},
|
||||
|
||||
|
|
|
@ -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\" <matemat@matemat.hq.c3d2.de>")]
|
||||
("List-Id", "\"Matemat\" <"<> (fromString fromMail) <>">")]
|
||||
, mailParts =[[Part
|
||||
{ partType = "text/plain; charset=utf-8"
|
||||
, partEncoding = None
|
||||
|
|
|
@ -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,11 +145,12 @@ 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"
|
||||
Just address ->
|
||||
sendMail master address "Profiländerung"
|
||||
[stext|
|
||||
Hallo #{userIdent user},
|
||||
|
||||
|
|
|
@ -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}
|
||||
|
||||
|
|
5
Model.hs
5
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 <http://www.gnu.org/licenses/>.
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
module Model where
|
||||
|
||||
import ClassyPrelude.Yesod
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Reference in a new issue