diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,8 +4,8 @@ *imm* is written in [Haskell][2], configured in [Dhall][3]. The project includes: -- a main executable `imm` that users directly run -- additional executables (`imm-writefile` and `imm-sendmail`) that `imm` can be configured to use as callbacks +- a main executable `imm` that users run directly +- secondary executables (`imm-writefile`, `imm-sendmail`) which can be used as callbacks triggered by `imm` - a [*Haskell*][2] library, that exports functions useful to both the main executable and callbacks; the API is documented [in Hackage][1]. ## Callbacks @@ -41,18 +41,20 @@ let sendMail = { _executable = "imm-sendmail" - , _arguments = ["--login", "-u", "user@domain.com", "-P", "password", "-s", "smtp.domain.com", "-p", "587", "--to", "foo.bar@domain.com"] + , _arguments = [] } let config : List Callback = [ sendMail ] in config ``` +`imm-sendmail` does not have a built-in SMTP client, instead it must rely on an external SMTP client program, which is configured in `$XDG_CONFIG_HOME/imm/sendmail.dhall` (cf example bundled with the project.) `imm-sendmail` writes the mail bytestring to the standard input of the configured external program. + ### Offline read-it-later *imm* is able to store a local copy of unread elements, to read them later while offline for example. External links won't work offline though. -``` +```dhall let Callback : Type = { _executable : Text , _arguments : List Text diff --git a/data/sendmail.dhall b/data/sendmail.dhall new file mode 100644 --- /dev/null +++ b/data/sendmail.dhall @@ -0,0 +1,16 @@ +-- This file must produce a `Command` expression, +-- that represents how the external SMTP client program is to be called. +let Command : Type = + { _executable : Text + , _arguments : List Text + } + +-- Below is an example using the msmtp program +-- +-- Check out `man msmtp`. +let sendmail : Command = + { _executable = "msmtp" + , _arguments = ["-t", "-a", ""] + } +in sendmail + diff --git a/imm.cabal b/imm.cabal --- a/imm.cabal +++ b/imm.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: imm -version: 1.7.0.0 +version: 1.8.0.0 synopsis: Execute arbitrary callbacks for each element of RSS/Atom feeds description: Cf README file homepage: https://github.com/k0ral/imm @@ -43,7 +43,7 @@ binary, conduit, containers, - dhall, + dhall >= 1.27, directory >= 1.2.3.0, filepath, hashable, @@ -68,7 +68,7 @@ executable imm import: common - build-depends: imm, aeson, async, atom-conduit >=0.7, bytestring, case-insensitive, conduit, connection, containers, dhall, directory, fast-logger, filepath, http-client >=0.4.30, http-client-tls, msgpack, opml-conduit >=0.7, optparse-applicative, prettyprinter-ansi-terminal, refined >=0.4.1, rss-conduit >=0.4.1, safe-exceptions, stm, stm-chans, streaming-bytestring, streaming-with, text, typed-process, uri-bytestring, xml-conduit >=1.5, xml-types + build-depends: imm, aeson, async, atom-conduit >=0.7, bytestring, case-insensitive, conduit, connection, containers, dhall >= 1.27, directory, fast-logger, filepath, http-client >=0.4.30, http-client-tls, msgpack, opml-conduit >=0.7, optparse-applicative, prettyprinter-ansi-terminal, refined >=0.4.1, rss-conduit >=0.4.1, safe-exceptions, stm, stm-chans, streaming-bytestring, streaming-with, text, typed-process, uri-bytestring, xml-conduit >=1.5, xml-types main-is: Main.hs other-modules: Core, Database, HTTP, Logger, Options, Paths_imm, XML autogen-modules: Paths_imm @@ -84,7 +84,7 @@ executable imm-sendmail import: common - build-depends: imm, atom-conduit, blaze-html, blaze-markup, bytestring, directory, filepath, HaskellNet >=0.5, HaskellNet-SSL >= 0.3.3.0, msgpack, mime-mail, network <3, optparse-applicative, prettyprinter, refined, rss-conduit, text, time, uri-bytestring + build-depends: imm, atom-conduit, blaze-html, blaze-markup, bytestring, dhall >= 1.27, directory, filepath, msgpack, mime-mail, optparse-applicative, prettyprinter, refined, rss-conduit, text, time, typed-process, uri-bytestring main-is: Main.hs hs-source-dirs: src/send-mail ghc-options: -Wall -fno-warn-unused-do-bind -threaded diff --git a/src/lib/Imm/Callback.hs b/src/lib/Imm/Callback.hs --- a/src/lib/Imm/Callback.hs +++ b/src/lib/Imm/Callback.hs @@ -20,7 +20,7 @@ , _arguments :: [Text] } deriving (Eq, Generic, Ord, Read, Show) -instance Interpret Callback +instance FromDhall Callback instance Pretty Callback where pretty (Callback executable arguments) = pretty executable <+> sep (pretty <$> arguments) diff --git a/src/lib/Imm/Feed.hs b/src/lib/Imm/Feed.hs --- a/src/lib/Imm/Feed.hs +++ b/src/lib/Imm/Feed.hs @@ -99,10 +99,10 @@ renderFeedElement (AtomElement entry) = decodeUtf8 $ toLazyByteString $ runConduitPure $ renderAtomEntry entry .| renderBuilder def .| foldC parseFeed :: MonadCatch m => Text -> m Feed -parseFeed text = runConduit $ parseLBS def (encodeUtf8 text) .| XML.force "Invalid feed" ((fmap Atom <$> atomFeed) `orE` (fmap Rss <$> rssDocument) `orE` (fmap Rss <$> rss1Document)) +parseFeed text = runConduit $ parseLBS def (encodeUtf8 text) .| XML.force "Invalid feed" (choose [fmap Atom <$> atomFeed, fmap Rss <$> rssDocument, fmap Rss <$> rss1Document]) parseFeedElement :: MonadCatch m => Text -> m FeedElement -parseFeedElement text = runConduit $ parseLBS def (encodeUtf8 text) .| XML.force "Invalid feed element" ((fmap AtomElement <$> atomEntry) `orE` (fmap RssElement <$> rssItem) `orE` (fmap RssElement <$> rss1Item)) +parseFeedElement text = runConduit $ parseLBS def (encodeUtf8 text) .| XML.force "Invalid feed element" (choose [fmap AtomElement <$> atomEntry, fmap RssElement <$> rssItem, fmap RssElement <$> rss1Item]) -- * Generic mutators diff --git a/src/main/HTTP.hs b/src/main/HTTP.hs --- a/src/main/HTTP.hs +++ b/src/main/HTTP.hs @@ -10,9 +10,9 @@ import Control.Exception.Safe import Data.CaseInsensitive -import Network.Connection as Reexport -import Network.HTTP.Client as Reexport -import Network.HTTP.Client.TLS as Reexport +import Network.Connection as Reexport +import Network.HTTP.Client as Reexport +import Network.HTTP.Client.TLS as Reexport import URI.ByteString -- }}} diff --git a/src/main/Main.hs b/src/main/Main.hs --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -124,7 +124,7 @@ forM_ newItem $ \(feedID, feed, element) -> do results <- forM callbacks $ \callback@(Callback executable arguments) -> do let processInput = byteStringInput $ MsgPack.pack $ Message feed element - processConfig = proc executable (map toString arguments) & setStdin processInput + processConfig = proc executable (toString <$> arguments) & setStdin processInput log logger Debug $ "Running" <+> cyan (pretty executable) <+> "on" <+> magenta (pretty feedID) <+> "/" <+> yellow (pretty $ getTitle element) diff --git a/src/send-mail/Main.hs b/src/send-mail/Main.hs --- a/src/send-mail/Main.hs +++ b/src/send-mail/Main.hs @@ -7,36 +7,29 @@ import Imm.Feed import Imm.Pretty -import Data.ByteString (getContents) -import qualified Data.MessagePack as MsgPack -import Data.Text as Text (intercalate) +import Data.ByteString (getContents) +import qualified Data.MessagePack as MsgPack +import Data.Text as Text (intercalate) import Data.Time -import Network.HaskellNet.SMTP -import Network.HaskellNet.SMTP.SSL -import Network.Mail.Mime hiding (sendmail) -import Network.Socket -import Options.Applicative +import Dhall hiding (map, maybe) +import Network.Mail.Mime hiding (sendmail) +import Options.Applicative hiding (auto) import Refined +import System.Directory (XdgDirectory (..), getXdgDirectory) +import System.Exit (ExitCode (..)) +import System.FilePath +import System.Process.Typed import Text.Atom.Types import Text.RSS.Types -- }}} --- * Types - -type Username = String -type Password = String -type ServerName = String - --- | How to connect to the SMTP server -data ConnectionSettings = Plain ServerName PortNumber | Encrypted ServerName Settings Bool - deriving(Eq, Generic, Ord, Show) - --- | How to authenticate to the SMTP server -data Authentication = Authentication AuthType Username Password - deriving(Eq, Generic, Show) +-- | How to call external command +data Command = Command + { _executable :: FilePath + , _arguments :: [Text] + } deriving (Eq, Generic, Ord, Read, Show) -data SMTPServer = SMTPServer (Maybe Authentication) ConnectionSettings - deriving (Eq, Generic, Show) +instance FromDhall Command -- | How to format outgoing mails from feed elements data FormatMail = FormatMail @@ -47,61 +40,36 @@ } data CliOptions = CliOptions - { _smtpServer :: SMTPServer + { _configFile :: FilePath , _recipients :: [Address] , _dryRun :: Bool } deriving (Eq, Generic, Show) parseOptions :: MonadIO m => m CliOptions -parseOptions = io $ customExecParser (prefs $ showHelpOnError <> showHelpOnEmpty) (info (cliOptions <**> helper) $ progDesc "Send a mail for each new RSS/Atom item.") +parseOptions = io $ do + defaultConfigFile <- getXdgDirectory XdgConfig $ "imm" "sendmail.dhall" + customExecParser (prefs $ showHelpOnError <> showHelpOnEmpty) (info (cliOptions defaultConfigFile <**> helper) $ progDesc description) -cliOptions :: Parser CliOptions -cliOptions = CliOptions - <$> smtpServerParser +description :: String +description = "Send a mail for each new RSS/Atom item." + +cliOptions :: FilePath -> Parser CliOptions +cliOptions defaultConfigFile = CliOptions + <$> (configFileOption <|> pure defaultConfigFile) <*> many recipientParser <*> switch (long "dry-run" <> help "Disable all I/Os, except for logs.") -smtpServerParser :: Parser SMTPServer -smtpServerParser = SMTPServer - <$> ((Just <$> authenticationParser) <|> pure Nothing) - <*> (plainConnection <|> encryptedConnection) - -authenticationParser :: Parser Authentication -authenticationParser = Authentication - <$> authenticationType - <*> strOption (long "user" <> short 'u' <> help "SMTP username") - <*> strOption (long "password" <> short 'P' <> help "SMTP password") - -authenticationType :: Parser AuthType -authenticationType = flag' PLAIN (long "plain" <> help "Use plain authentication.") - <|> flag' LOGIN (long "login" <> help "Use login authentication") - <|> flag' CRAM_MD5 (long "cram-md5" <> help "Use CRAM MD5 authentication") - -plainConnection :: Parser ConnectionSettings -plainConnection = Plain - <$> strOption (long "server" <> short 's' <> help "SMTP server address.") - <*> option auto (long "port" <> short 'p' <> help "SMTP server port.") - -encryptedConnection :: Parser ConnectionSettings -encryptedConnection = Encrypted - <$> strOption (long "server" <> short 's' <> help "SMTP server address.") - <*> encryptionSettings - <*> switch (long "starttls" <> help "Use STARTTLS.") - -encryptionSettings :: Parser Settings -encryptionSettings = Settings - <$> option auto (long "ssl-port" <> short 's' <> help "SSL port.") - <*> option auto (long "max-line-length" <> short 'l' <> help "Maximum line length.") - <*> switch (long "log" <> help "Log to console.") - <*> switch (long "disable-certificate-validation" <> help "Disable certificate validation.") +configFileOption :: Parser FilePath +configFileOption = strOption $ long "config" <> short 'c' <> metavar "FILE" <> help "Dhall configuration file for SMTP client call" recipientParser :: Parser Address recipientParser = strOption (long "to" <> help "Mail recipients.") main :: IO () main = do - CliOptions smtpServer recipients dryRun <- parseOptions + CliOptions configFile recipients dryRun <- parseOptions + Command executable arguments <- input auto $ fromString configFile message <- getContents <&> fromStrict <&> MsgPack.unpack case message of @@ -110,7 +78,16 @@ currentTime <- io getCurrentTime let formatMail = FormatMail defaultFormatFrom defaultFormatSubject defaultFormatBody (const $ const recipients) mail = buildMail formatMail currentTime timezone feed element - unless dryRun $ io $ withSMTPConnection smtpServer $ sendMimeMail2 mail + + unless dryRun $ do + processInput <- renderMail' mail <&> byteStringInput + let processConfig = proc executable (toString <$> arguments) & setStdin processInput + + (exitCode, _output, errors) <- readProcess processConfig + case exitCode of + ExitSuccess -> exitSuccess + ExitFailure _ -> putStrLn (decodeUtf8 errors) >> exitFailure + _ -> putStrLn "Invalid input" >> exitFailure return () @@ -145,26 +122,6 @@ -- * Low-level helpers - -authenticate_ :: SMTPConnection -> Authentication -> IO Bool -authenticate_ connection (Authentication t u p) = do - result <- authenticate t u p connection - unless result $ putStrLn "Authentication failed" - return result - -withSMTPConnection :: SMTPServer -> (SMTPConnection -> IO a) -> IO a -withSMTPConnection (SMTPServer authentication (Plain server port)) f = - doSMTPPort server port $ \connection -> do - forM_ authentication (authenticate_ connection) - f connection -withSMTPConnection (SMTPServer authentication (Encrypted server settings False)) f = - doSMTPSSLWithSettings server settings $ \connection -> do - forM_ authentication (authenticate_ connection) - f connection -withSMTPConnection (SMTPServer authentication (Encrypted server settings True)) f = - doSMTPSTARTTLSWithSettings server settings $ \connection -> do - forM_ authentication (authenticate_ connection) - f connection -- | Build mail from a given feed buildMail :: FormatMail -> UTCTime -> TimeZone -> Feed -> FeedElement -> Mail