1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
{-# LANGUAGE RecordWildCards, ApplicativeDo, FlexibleContexts #-}
module Main (main) where
import Postdelay.Scan
import Postdelay.Queue
import Data.Function (on)
import Data.List
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Reader
import Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString.Lazy as Lazy.BS
import Data.ByteString.Lazy.Char8 as Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as Lazy.Char8.BS
import Data.Conduit
import System.Environment (getProgName)
import qualified Options.Applicative as Opt (Parser)
import Options.Applicative hiding (Parser)
opts :: Opt.Parser (String, [String], StoreConfig)
opts = do
sConfig <- storeConfig
sender <- strOption $ mconcat
[ long "sender"
, short 'f'
, metavar "SENDER"
]
recipients <- some . strArgument $ mconcat
[ metavar "RECIPIENTS"
]
pure (sender, recipients, sConfig)
main :: (MonadIO m, MonadCatch m) => m ()
main = do
pName <- liftIO getProgName
(sender, recipients, sConfig) <- liftIO . execParser . info (helper <*> opts) $ mconcat
[ fullDesc
, progDesc "Queue an email for later delivery"
, header pName
]
flip runReaderT sConfig $ do
mailStr <- liftIO getContents
delay <- scan mailStr
let
(headers, body) = break (== "") $ lines mailStr
mailStr' = unlines $ filter (not . (isPrefixOf `on` CI.foldCase) "X-Delay:") headers ++ body
sendNow = sendmail sender recipients $ Lazy.Char8.BS.pack mailStr'
sendLater sendDelay = pushStore . yield $ StoredMail
{ message = Lazy.Char8.BS.pack mailStr'
, ..
}
maybe sendNow sendLater delay
|
