Lisää mahdollisuus katsoa lähetettäviä viestejä ennen lähettämistä

This commit is contained in:
Saku Laesvuori 2023-11-24 16:26:55 +02:00
parent f11ddb8ca4
commit c2cda17113
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
3 changed files with 28 additions and 16 deletions

View File

@ -33,13 +33,23 @@ main = do
UpdateTable bankCsv -> updateTableMain csv bankCsv
sendInvoicesMain :: FilePath -> SendOptions -> IO ()
sendInvoicesMain csvPath options@SendOptions {email, sendmail, reminders} = do
invoices <- mapMaybe (\(address, invoice) -> (address,) <$> renderEmail reminders [email] address invoice) <$> readInvoices csvPath options
forM_ invoices $ \(address, invoiceMail) -> do
sendEmail sendmail invoiceMail
sendInvoicesMain csvPath options@SendOptions {email, sendmail, reminders, dryRun} = do
invoices <- readInvoices csvPath options
forM_ invoices $ \(address, invoice) -> do
case renderInvoice reminders invoice of
Nothing -> pure ()
Just (subject, body) -> do
case dryRun of
False -> do
sendEmail sendmail $ renderEmail [email] address subject body
putStr "Lähetetty osoitteeseen: "
T.putStrLn $ decodeUtf8 $ renderAddresses address
threadDelay (3 * 1000 * 1000)
True -> do
T.putStrLn $ "To: " <> decodeUtf8 (renderAddresses address)
T.putStrLn $ "From: " <> decodeUtf8 (renderAddresses [email])
T.putStrLn $ "\n" <> body
T.putStrLn "-------\n"
updateTableMain :: FilePath -> FilePath -> IO ()
updateTableMain invoiceCsv transactionCsv = do

View File

@ -3,7 +3,7 @@
module Laskutin.Email where
import Data.Text (Text)
import Data.MIME (MIMEMessage, Address, createTextPlainMessage, defaultCharsets, headerSubject, headerFrom, headerTo, headerBCC, renderMessage)
import Data.MIME (Address, createTextPlainMessage, defaultCharsets, headerSubject, headerFrom, headerTo, headerBCC, renderMessage)
import Control.Lens (set)
import Data.Semigroup (sconcat)
import Data.Time.Calendar
@ -19,12 +19,13 @@ import qualified Data.ByteString.Lazy as LBS
import Laskutin.Types
renderEmail :: Bool -> [Address] -> [Address] -> Invoice -> Maybe ByteString
renderEmail isReminder senders recipients = fmap (renderMessage
renderEmail :: [Address] -> [Address] -> Text -> Text -> ByteString
renderEmail senders recipients subject = renderMessage
. set (headerBCC defaultCharsets) senders
. set (headerTo defaultCharsets) recipients
. set (headerFrom defaultCharsets) senders)
. invoiceEmail isReminder
. set (headerFrom defaultCharsets) senders
. set (headerSubject defaultCharsets) (Just subject)
. createTextPlainMessage
sendEmail :: FilePath -> ByteString -> IO ()
sendEmail sendmail email = do
@ -36,10 +37,9 @@ sendEmail sendmail email = do
ExitSuccess -> pure ()
ExitFailure code -> throwIO $ ErrorCall ("sendmail exited with error code " <> show code)
invoiceEmail :: Bool -> Invoice -> Maybe MIMEMessage
invoiceEmail _ Invoice {isPaid = True} = Nothing
invoiceEmail isReminder Invoice {rows, reference, account, recipient, due, subject, message, isPaid = False} = Just $
set (headerSubject defaultCharsets) (Just $ subjectPrefix <> " " <> subject ) $ createTextPlainMessage $
renderInvoice :: Bool -> Invoice -> Maybe (Text, Text)
renderInvoice _ Invoice {isPaid = True} = Nothing
renderInvoice isReminder Invoice {rows, reference, account, recipient, due, subject, message, isPaid = False} = Just $ (subjectPrefix <> " " <> subject,) $
(if isReminder then "Muistutus alla olevan laskun maksamisesta. Jos olet juuri maksanut kyseisen laskun, tämä muistutus on aiheeton.\n\n" else mempty)
<> (if T.null message then mempty else (message <> "\n\n\n"))
<> sconcat (NE.map renderInvoiceRow rows) <> "\n"

View File

@ -32,6 +32,7 @@ data SendOptions = SendOptions
, email :: Address
, sendmail :: FilePath
, reminders :: Bool
, dryRun :: Bool
}
parseOptions :: IO Options
@ -60,3 +61,4 @@ sendOptions = fmap Send $ SendOptions
(long "email" <> help "Invoice sender email address" <> metavar "EMAIL")
<*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> help "The sendmail program to use")
<*> switch (long "reminders" <> short 'r' <> help "Send reminder emails")
<*> switch (long "dry-run" <> short 'd' <> help "Only print what invoices would be sent. Do not send anything")