From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 8 Nov 2017 23:47:26 +0100 Subject: Use a better project structure --- server/src/SendMail.hs | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 server/src/SendMail.hs (limited to 'server/src/SendMail.hs') diff --git a/server/src/SendMail.hs b/server/src/SendMail.hs new file mode 100644 index 0000000..f7ba3fd --- /dev/null +++ b/server/src/SendMail.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} + +module SendMail + ( sendMail + ) where + +import Control.Arrow (left) +import Control.Exception (SomeException, try) +import Data.Either (isLeft) + +import Data.Text (Text) +import Data.Text.Lazy.Builder (toLazyText, fromText) +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import qualified MimeMail as M + +import Model.Mail (Mail(Mail)) + +sendMail :: Mail -> IO (Either Text ()) +sendMail mail = do + result <- left (T.pack . show) <$> (try (M.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ())) + if isLeft result + then putStrLn ("Error sending the following email:" ++ (show mail) ++ "\n" ++ (show result)) + else putStrLn "OK" + return result + +getMimeMail :: Mail -> M.Mail +getMimeMail (Mail mailFrom mailTo mailSubject mailPlainBody) = + let fromMail = M.emptyMail (address mailFrom) + in fromMail + { M.mailTo = map address mailTo + , M.mailParts = [ [ M.plainPart . strictToLazy $ mailPlainBody ] ] + , M.mailHeaders = [("Subject", mailSubject)] + } + +address :: Text -> M.Address +address addressEmail = + M.Address + { M.addressName = Nothing + , M.addressEmail = addressEmail + } + +strictToLazy :: Text -> LT.Text +strictToLazy = toLazyText . fromText -- cgit v1.2.3 From 5a63f7be9375e3ab888e4232dd7ef72c2f1ffae1 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 13 Nov 2017 23:56:40 +0100 Subject: Setup stylish-haskell --- server/src/SendMail.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'server/src/SendMail.hs') diff --git a/server/src/SendMail.hs b/server/src/SendMail.hs index f7ba3fd..959f21d 100644 --- a/server/src/SendMail.hs +++ b/server/src/SendMail.hs @@ -4,17 +4,17 @@ module SendMail ( sendMail ) where -import Control.Arrow (left) -import Control.Exception (SomeException, try) -import Data.Either (isLeft) +import Control.Arrow (left) +import Control.Exception (SomeException, try) +import Data.Either (isLeft) -import Data.Text (Text) -import Data.Text.Lazy.Builder (toLazyText, fromText) -import qualified Data.Text as T -import qualified Data.Text.Lazy as LT -import qualified MimeMail as M +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import Data.Text.Lazy.Builder (fromText, toLazyText) +import qualified MimeMail as M -import Model.Mail (Mail(Mail)) +import Model.Mail (Mail (Mail)) sendMail :: Mail -> IO (Either Text ()) sendMail mail = do -- cgit v1.2.3 From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Nov 2017 00:20:25 +0100 Subject: Show payment count and partition - Also fixes exceedingPayer in back by using only punctual payments --- server/src/SendMail.hs | 2 -- 1 file changed, 2 deletions(-) (limited to 'server/src/SendMail.hs') diff --git a/server/src/SendMail.hs b/server/src/SendMail.hs index 959f21d..d00912f 100644 --- a/server/src/SendMail.hs +++ b/server/src/SendMail.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module SendMail ( sendMail ) where -- cgit v1.2.3 From 554880727d833befab00666c7a4f95611e8370b9 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Nov 2017 15:39:11 +0100 Subject: Remove local MimeMail --- server/src/SendMail.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'server/src/SendMail.hs') diff --git a/server/src/SendMail.hs b/server/src/SendMail.hs index d00912f..c15ed62 100644 --- a/server/src/SendMail.hs +++ b/server/src/SendMail.hs @@ -5,12 +5,12 @@ module SendMail import Control.Arrow (left) import Control.Exception (SomeException, try) import Data.Either (isLeft) +import qualified Network.Mail.Mime as M import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as LT import Data.Text.Lazy.Builder (fromText, toLazyText) -import qualified MimeMail as M import Model.Mail (Mail (Mail)) -- cgit v1.2.3 From a4acc2e84158fa822f88a1d0bdddb470708b5809 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 3 Jan 2018 17:31:20 +0100 Subject: Modify weelky report and payment search interface - Add payment balance in weekly report - Show a message and hide pages when the search results in no results - Go to page 1 when the search is updated / erased --- server/src/SendMail.hs | 39 +++++++++++++++++++++++++++++++-------- 1 file changed, 31 insertions(+), 8 deletions(-) (limited to 'server/src/SendMail.hs') diff --git a/server/src/SendMail.hs b/server/src/SendMail.hs index c15ed62..3b17a0a 100644 --- a/server/src/SendMail.hs +++ b/server/src/SendMail.hs @@ -9,18 +9,41 @@ import qualified Network.Mail.Mime as M import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import Data.Text.Lazy.Builder (fromText, toLazyText) -import Model.Mail (Mail (Mail)) +import Conf (Conf) +import qualified Conf +import Model.Mail (Mail (..)) -sendMail :: Mail -> IO (Either Text ()) -sendMail mail = do - result <- left (T.pack . show) <$> (try (M.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ())) - if isLeft result - then putStrLn ("Error sending the following email:" ++ (show mail) ++ "\n" ++ (show result)) - else putStrLn "OK" - return result +sendMail :: Conf -> Mail -> IO (Either Text ()) +sendMail conf mail = + if Conf.devMode conf + then + do + T.putStrLn . mockMailMessage $ mail + return (Right ()) + else + do + result <- left (T.pack . show) <$> (try (M.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ())) + if isLeft result + then putStrLn ("Error sending the following email:" ++ (show mail) ++ "\n" ++ (show result)) + else return () + return result + +mockMailMessage :: Mail -> Text +mockMailMessage mail = T.concat $ + [ "[MOCK MAIL] " + , subject mail + , " (from: " + , from mail + , ") (to: " + , T.intercalate ", " $ to mail + , ")" + , "\n" + , body mail + ] getMimeMail :: Mail -> M.Mail getMimeMail (Mail mailFrom mailTo mailSubject mailPlainBody) = -- cgit v1.2.3 From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Jan 2018 12:13:09 +0100 Subject: WIP --- server/src/SendMail.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'server/src/SendMail.hs') diff --git a/server/src/SendMail.hs b/server/src/SendMail.hs index 3b17a0a..13d4072 100644 --- a/server/src/SendMail.hs +++ b/server/src/SendMail.hs @@ -43,6 +43,7 @@ mockMailMessage mail = T.concat $ , ")" , "\n" , body mail + , "\n" ] getMimeMail :: Mail -> M.Mail -- cgit v1.2.3