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

25
src/TiedoteMD/Review.hs
View File

@ -19,7 +19,8 @@ import Data.Maybe (catMaybes)
import Data.Maybe (listToMaybe, fromMaybe)
import Data.Ord (comparing)
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 qualified Data.ByteString as BS
@ -60,10 +61,28 @@ managePreviews acid sender sendmailPath = forever $ do
threadDelay $ 1000 * 1000
sendRecipientVerifications :: MIMEMessage -> Mailbox -> FilePath -> Message -> IO ()
sendRecipientVerifications mail sender sendmailPath Message {..} = sendmail sendmailPath $
sendRecipientVerifications mail sender sendmailPath Message {..} = do
currentTime <- getCurrentTime
let recipientCount = T.pack $ show $ length recipients
formattedSendTime = T.pack $ formatTime defaultTimeLocale "%d.%m.%Y klo %H.%M (UTC%Ez)" sendTime
formatTimeDiff timediff
| 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 osoitteisiin. Lähetä vastauksena uusi lista, mikäli tämä on virheellinen.\n\n" <>) $
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]