Compare commits

...

3 Commits

3 changed files with 29 additions and 11 deletions

View File

@ -10,7 +10,7 @@
#:use-module (gnu packages haskell-crypto)
#:use-module (gnu packages haskell-check)
#:use-module (gnu packages haskell-web)
#:use-module (gnu packages golang)
#:use-module (gnu packages golang-web)
#:use-module (gnu packages version-control))
(define vcs-file?
@ -23,8 +23,7 @@
(version "0.0.1-git")
(source (local-file "../.." "tiedote-md-checkout"
#:recursive? #t
#:select? vcs-file?
))
#:select? vcs-file?))
(build-system haskell-build-system)
(inputs (list ghc-acid-state
ghc-cryptonite

View File

@ -3,7 +3,7 @@
(url "https://git.savannah.gnu.org/git/guix.git")
(branch "master")
(commit
"ee0cf3b9ff4cd5a9d3637d09677195ea9ee1a8c0")
"a6fc564bcc32ba599fc701f340c2d59c47bb225b")
(introduction
(make-channel-introduction
"9edb3f66fd807b096b48283debdcddccfea34bad"

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,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