|
|
|
@ -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,12 +61,30 @@ managePreviews acid sender sendmailPath = forever $ do
|
|
|
|
|
threadDelay $ 1000 * 1000
|
|
|
|
|
|
|
|
|
|
sendRecipientVerifications :: MIMEMessage -> Mailbox -> FilePath -> Message -> IO ()
|
|
|
|
|
sendRecipientVerifications mail sender sendmailPath Message {..} = 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" <>) $
|
|
|
|
|
T.intercalate "\n" $ map (decodeUtf8 . emailToByteString) recipients) $
|
|
|
|
|
reply defaultCharsets (replySettings sender) mail
|
|
|
|
|
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 " <> 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]
|
|
|
|
|
addressToMailboxes (Group _ mbs) = mbs
|
|
|
|
|
sameRecipient (Mailbox _ addr1) (Mailbox _ addr2) = addr1 == addr2
|
|
|
|
|