OMS/tiedote.md
3
0
Fork 0
Code Issues 14 Pull Requests Projects Releases Wiki Activity

Lisää tietoa vastaanottajakuittaukseen

Browse Source
This commit is contained in:
Saku Laesvuori 2024-04-09 16:53:44 +03:00
parent 14acd3cd0c
commit dab82e12f5
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
1 changed files with 26 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
src/TiedoteMD/Review.hs
View File

@ -19,7 +19,8 @@ import Data.Maybe (catMaybes)
import Data.Maybe (listToMaybe, fromMaybe) import Data.Maybe (listToMaybe, fromMaybe)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Time (getCurrentTime) import Data.Time (getCurrentTime, diffUTCTime, nominalDay, secondsToNominalDiffTime)
import Data.Time.Format (formatTime, defaultTimeLocale)
import System.Random (getStdRandom, uniform) import System.Random (getStdRandom, uniform)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
@ -60,12 +61,30 @@ managePreviews acid sender sendmailPath = forever $ do
threadDelay $ 1000 * 1000 threadDelay $ 1000 * 1000
sendRecipientVerifications :: MIMEMessage -> Mailbox -> FilePath -> Message -> IO () sendRecipientVerifications :: MIMEMessage -> Mailbox -> FilePath -> Message -> IO ()
sendRecipientVerifications mail sender sendmailPath Message {..} = sendmail sendmailPath $ sendRecipientVerifications mail sender sendmailPath Message {..} = do
toLazyByteString $ buildMessage $ currentTime <- getCurrentTime
setHeaderCC previewTo $ let recipientCount = T.pack $ show $ length recipients
set body (Part $ encodeUtf8 $ ("Viesti lähetetään seuraaviin osoitteisiin. Lähetä vastauksena uusi lista, mikäli tämä on virheellinen.\n\n" <>) $ formattedSendTime = T.pack $ formatTime defaultTimeLocale "%d.%m.%Y klo %H.%M (UTC%Ez)" sendTime
T.intercalate "\n" $ map (decodeUtf8 . emailToByteString) recipients) $ formatTimeDiff timediff
reply defaultCharsets (replySettings sender) mail | timediff > nominalDay = formatTime defaultTimeLocale
"%d päivän, %H tunnin ja %M minuutin päästä" timediff
| timediff > secondsToNominalDiffTime 3600 = formatTime defaultTimeLocale
"%h tunnin ja %M minuutin päästä" timediff
| timediff > secondsToNominalDiffTime (10 * 60) = formatTime defaultTimeLocale
"%m minuutin päästä" timediff
| timediff > secondsToNominalDiffTime 60 = formatTime defaultTimeLocale
"%m minuutin ja %S sekunnin päästä" timediff
| otherwise = formatTime defaultTimeLocale "%s sekunnin päästä" timediff
sendingAfter = T.pack $ formatTimeDiff $ diffUTCTime sendTime currentTime
sendmail sendmailPath $
toLazyByteString $ buildMessage $
setHeaderCC previewTo $
set body (Part $ encodeUtf8 $
(("Viesti lähetetään seuraaviin " <> recipientCount <> " osoitteiseen " <> formattedSendTime <>
", eli " <> sendingAfter <> ". Lähetä vastauksena uusi lista, mikäli tämä on" <>
" virheellinen.\n\n") <>) $
T.intercalate "\n" $ map (decodeUtf8 . emailToByteString) recipients) $
reply defaultCharsets (replySettings sender) mail
where addressToMailboxes (Single mb) = [mb] where addressToMailboxes (Single mb) = [mb]
addressToMailboxes (Group _ mbs) = mbs addressToMailboxes (Group _ mbs) = mbs
sameRecipient (Mailbox _ addr1) (Mailbox _ addr2) = addr1 == addr2 sameRecipient (Mailbox _ addr1) (Mailbox _ addr2) = addr1 == addr2