make cofnigurable sendmail and from-email

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},
 

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\" <matemat@matemat.hq.c3d2.de>")]
+         ("List-Id", "\"Matemat\" <"<> (fromString fromMail) <>">")]
       , mailParts =[[Part
         { partType = "text/plain; charset=utf-8"
         , partEncoding = None

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

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}
 

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

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

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"