imm 1.7.0.0 → 1.8.0.0

raw patch · 8 files changed

+73/−98 lines, 8 filesdep −HaskellNetdep −HaskellNet-SSLdep −networkdep ~dhallPVP ok

version bump matches the API change (PVP)

Dependencies removed: HaskellNet, HaskellNet-SSL, network

Dependency ranges changed: dhall

API changes (from Hackage documentation)

Files

• README.md +6/−4
• data/sendmail.dhall +16/−0
• imm.cabal +4/−4
• src/lib/Imm/Callback.hs +1/−1
• src/lib/Imm/Feed.hs +2/−2
• src/main/HTTP.hs +3/−3
• src/main/Main.hs +1/−1
• src/send-mail/Main.hs +40/−83

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

@@ -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", "<account>"]+  }+in sendmail+

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

@@ -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)

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

@@ -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 -- }}} 

@@ -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) 

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