Lisää mahdollisuus katsoa lähetettäviä viestejä ennen lähettämistä
This commit is contained in:
		
							parent
							
								
									f11ddb8ca4
								
							
						
					
					
						commit
						c2cda17113
					
				| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue