Compare commits
No commits in common. "dab82e12f541f5dacaffd224c388b7846524aa70" and "4749cc3e7358621ed8c90fb00f2bc2ae927ceb40" have entirely different histories.
dab82e12f5
...
4749cc3e73
@ -10,7 +10,7 @@
|
|||||||
#:use-module (gnu packages haskell-crypto)
|
#:use-module (gnu packages haskell-crypto)
|
||||||
#:use-module (gnu packages haskell-check)
|
#:use-module (gnu packages haskell-check)
|
||||||
#:use-module (gnu packages haskell-web)
|
#:use-module (gnu packages haskell-web)
|
||||||
#:use-module (gnu packages golang-web)
|
#:use-module (gnu packages golang)
|
||||||
#:use-module (gnu packages version-control))
|
#:use-module (gnu packages version-control))
|
||||||
|
|
||||||
(define vcs-file?
|
(define vcs-file?
|
||||||
@ -23,7 +23,8 @@
|
|||||||
(version "0.0.1-git")
|
(version "0.0.1-git")
|
||||||
(source (local-file "../.." "tiedote-md-checkout"
|
(source (local-file "../.." "tiedote-md-checkout"
|
||||||
#:recursive? #t
|
#:recursive? #t
|
||||||
#:select? vcs-file?))
|
#:select? vcs-file?
|
||||||
|
))
|
||||||
(build-system haskell-build-system)
|
(build-system haskell-build-system)
|
||||||
(inputs (list ghc-acid-state
|
(inputs (list ghc-acid-state
|
||||||
ghc-cryptonite
|
ghc-cryptonite
|
||||||
|
@ -3,7 +3,7 @@
|
|||||||
(url "https://git.savannah.gnu.org/git/guix.git")
|
(url "https://git.savannah.gnu.org/git/guix.git")
|
||||||
(branch "master")
|
(branch "master")
|
||||||
(commit
|
(commit
|
||||||
"a6fc564bcc32ba599fc701f340c2d59c47bb225b")
|
"ee0cf3b9ff4cd5a9d3637d09677195ea9ee1a8c0")
|
||||||
(introduction
|
(introduction
|
||||||
(make-channel-introduction
|
(make-channel-introduction
|
||||||
"9edb3f66fd807b096b48283debdcddccfea34bad"
|
"9edb3f66fd807b096b48283debdcddccfea34bad"
|
||||||
|
@ -19,8 +19,7 @@ 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, diffUTCTime, nominalDay, secondsToNominalDiffTime)
|
import Data.Time (getCurrentTime)
|
||||||
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
|
||||||
@ -61,30 +60,12 @@ 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 {..} = do
|
sendRecipientVerifications mail sender sendmailPath Message {..} = sendmail sendmailPath $
|
||||||
currentTime <- getCurrentTime
|
toLazyByteString $ buildMessage $
|
||||||
let recipientCount = T.pack $ show $ length recipients
|
setHeaderCC previewTo $
|
||||||
formattedSendTime = T.pack $ formatTime defaultTimeLocale "%d.%m.%Y klo %H.%M (UTC%Ez)" sendTime
|
set body (Part $ encodeUtf8 $ ("Viesti lähetetään seuraaviin osoitteisiin. Lähetä vastauksena uusi lista, mikäli tämä on virheellinen.\n\n" <>) $
|
||||||
formatTimeDiff timediff
|
T.intercalate "\n" $ map (decodeUtf8 . emailToByteString) recipients) $
|
||||||
| timediff > nominalDay = formatTime defaultTimeLocale
|
reply defaultCharsets (replySettings sender) mail
|
||||||
"%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
|
||||||
|
Loading…
Reference in New Issue
Block a user