diff --git a/CONTRIBUTE.md b/CONTRIBUTE.md new file mode 100644 --- /dev/null +++ b/CONTRIBUTE.md @@ -0,0 +1,24 @@ + +Patches/pull requests welcome, +follow the usual `git` workflow for submitting a pull request: + +- fork the project +- create a new branch from master (e.g. `features/my-new-feature` or + `issue/123-my-bugfix`) + +If you're fixing a bug also create an issue +on [GitHub](https://github.com/phlummox/assumpta/issues) +if one doesn't exist yet. + +If it's a new feature explain why you think it's useful or necessary. + +Follow the same coding style with regards to spaces, semicolons, variable +naming etc. In general, we follow the usual Haskell naming convention of making +function and variable names `camelCase` +(even +when they include +[acronyms](https://stackoverflow.com/questions/15526107/acronyms-in-camelcase)). +Mostly. + +Please add tests for any contributions you make. + diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,12 @@ ## Unreleased changes +## 0.1.0.2 + +- Fixes #1 - bug in `sendRawMail` +- Improvements to documentation and example scripts +- Additional test - compile example scripts + ## 0.1.0.1 Typo in README. diff --git a/DEVELOPMENT.md b/DEVELOPMENT.md new file mode 100644 --- /dev/null +++ b/DEVELOPMENT.md @@ -0,0 +1,58 @@ +# Development notes and tips + +I build and test assumpta and assumpta-core +using [`stack`](https://docs.haskellstack.org/en/stable/README/), +plus CI services (Travis CI and CircleCI). + +CircleCI in general is much more irritating, doesn't natively support +'test matrixes', and has obviously had less thought put into its design; +but it's faster, seems to do a better job of cacheing build artifacts, +and lets you use any Docker image you like to run tests in (unlike Travis CI, +which only has a set number of support environments). + +The doctests currently require stack to run, and will +fail if a `STACK_RESOLVER` environment variable isn't found (or if +they can't find `stack` on the `$PATH`. + +So they are best run like this: + +```bash +$ export STACK_RESOLVER=lts-12.26 +$ stack --resolver="${STACK_RESOLVER}" test --flag assumpta-core:test-doctests +``` + +If anyone wants to suggest things which might make the source tree +more friendly to cabal-users, feel free to let me know. + +## SMTP Standards + +The original SMTP standard was +[RFC 821](https://tools.ietf.org/html/rfc821), defined in 1982. + +Most MTAs today use +[RFC 5321](https://tools.ietf.org/html/rfc5321), released in 2008, +which extends SMTP to (inter alia) add security and some new commands. +There are also errata to RFC 5321, available at +. + +I hope to mostly implement RFC 5321. The various forms of +authentication are detailed in other standards, which I +still need to track down. + +## Doctests + +The test suite `doctest-test` currently (AFAIK) requires +stack to run -- I tried it with ghc 8.0.2, cabal-install +2.4.1.0, and version 0.16.2 of the doctest library, and +got a segfault. + +But since the aim of the test suite is to test the +documentation -- not doctest, nor cabal, nor ghc -- +I didn't spend time investigating the problem. + +The test runner doesn't itself actually call `stack` -- but +if run by `stack test`, it gets passed exactly the +environment it needs. + + + diff --git a/TODO.md b/TODO.md new file mode 100644 --- /dev/null +++ b/TODO.md @@ -0,0 +1,45 @@ + +# TODO + +Need Eq, Show instances fo ReplyLine, SmtpError, else testing +is hard + +## Add RFC references + +Justify the code with reference to relevant RFCs. + +## Sounder approach to serialization? + +The only data type we serialize is SMTP Commands, and +it's handled by just one function, toByteString. +So I think it's not worth the trouble of creating instances +for e.g. the `cereal` package. 'AUTH' commands are serialized +separately (and there is only one AUTH command implemented). + +## Two-way mock + +A mock that simulates server responses as well, not just +recording client commands. + +## Improve error messages + +If you try to send more commands after quitting: e.g. you send + +``` +>>> quit +>>> rset +``` + +then you'll get an error like this: + +``` +*** Exception: user error (Error executing smtp: UnexpectedResponse "not enough input") +``` + +Which means: the connection was closed, we couldn't +pull expected input. But a more user-friendly error message would +be nice. + +Also, the `SMTPError` errors that are thrown are fairly terse. +It'd be nice to make those, also, more user-friendly. + diff --git a/assumpta-core.cabal b/assumpta-core.cabal --- a/assumpta-core.cabal +++ b/assumpta-core.cabal @@ -2,7 +2,7 @@ name: assumpta-core -version: 0.1.0.1 +version: 0.1.0.2 synopsis: Core functionality for an SMTP client description: A library for constructing SMTP clients, which provides the core functionality for @@ -31,18 +31,24 @@ extra-source-files: README.md ChangeLog.md + CONTRIBUTE.md + DEVELOPMENT.md + TODO.md + examples/simple-client-session-mock-bs.hs + scripts/stack-test.sh + stack-lts-12.26.yaml source-repository head type: git location: https://github.com/phlummox/assumpta-core --- This enables (or disables) the doctest test suite. Which --- is set up to complain and fail if it is not run being run --- with `stack`. --- You can enable these tests from stack using --- `--flag assumpta-core:test-doctests` -flag test-doctests - description: enable doctests +-- This enables (or disables) tests that rely on +-- "stack": the doctests and example compilation +-- test. +-- You can enable them from stack using +-- `--flag assumpta-core:stack-based-tests` +flag stack-based-tests + description: enable tests requiring stack manual: True default: False @@ -104,7 +110,7 @@ else ghc-options: -Wall - if !(flag(test-doctests)) + if !(flag(stack-based-tests)) buildable: False else build-depends: @@ -132,6 +138,35 @@ , hspec , mtl , text + if flag(warnmore) + if impl(ghc >= 8.0.1) + ghc-options: + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints + -Wno-name-shadowing -Wno-orphans -fwarn-tabs + else + ghc-options: + -Wall + default-language: Haskell2010 + +-- ** +-- - Only works with stack +-- - requires STACK_RESOLVER env var to be set +test-suite compile-examples + type: exitcode-stdio-1.0 + main-is: compile-examples.hs + hs-source-dirs: + test-other + ghc-options: -threaded -rtsopts -with-rtsopts=-N + if !(flag(stack-based-tests)) + buildable: False + else + build-depends: + assumpta-core + , base >=4.0 && <5 + , filepath + , shelly + , text if flag(warnmore) if impl(ghc >= 8.0.1) ghc-options: diff --git a/examples/simple-client-session-mock-bs.hs b/examples/simple-client-session-mock-bs.hs new file mode 100644 --- /dev/null +++ b/examples/simple-client-session-mock-bs.hs @@ -0,0 +1,54 @@ + +{-# LANGUAGE OverloadedStrings #-} + +-- Program that runs a short mock SMTP session. +-- and shows the bytestring that would be sent +-- to a server. + +module Main where + + +import Data.Monoid +import qualified Data.ByteString.Char8 as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +import Network.Mail.Assumpta.MonadSmtp +import qualified Network.Mail.Assumpta.Mock as Mock + +sampleMesg :: BS.ByteString +sampleMesg = BS.intercalate crlf [ + "Date: Tue, 21 Jan 2020 02:28:37 +0800" + , "To: neddie.seagoon@gmail.com" + , "From: jim.moriarty@gmail.com" + , "Subject: test Tue, 21 Jan 2020 02:28:37 +0800" + , "" + , "Sapristi nyuckoes!" + ] + +-- The sender and recipient supplied to the +-- SMTP server are what is used to route the +-- message; any 'To:' and 'From:' fields +-- in the message are completely ignored for this +-- purpose. +sender, recipient :: BS.ByteString +sender = "somesender@mycorp.com" +recipient = "somerecipient@mozilla.org" + +main :: IO () +main = do + let toBinary = TE.encodeUtf8 . T.pack + port = 2025 + let res = Mock.runMockSmtp (do + expectGreeting + ehlo "my-local-host.my-domain" + -- Properly, we should escape periods at the start of a + -- line. But we know there aren't any + sendRawMail sender [recipient] sampleMesg + quit) + BS.putStrLn "Bytestring sent was:" + BS.putStrLn "=====" + BS.putStrLn res + BS.putStrLn "=====" + + diff --git a/scripts/stack-test.sh b/scripts/stack-test.sh new file mode 100644 --- /dev/null +++ b/scripts/stack-test.sh @@ -0,0 +1,12 @@ +#!/usr/bin/env bash + +# run 'stack-only' tests with some resolver + +if [ "$#" -ne 1 ]; then + echo "expected one arg, a resolver to use (e.g. 'lts-11')" + exit 1 +fi + +export STACK_RESOLVER="$1" +stack --resolver="${STACK_RESOLVER}" test --flag assumpta-core:stack-based-tests + diff --git a/src/Network/Mail/Assumpta/Mock.hs b/src/Network/Mail/Assumpta/Mock.hs --- a/src/Network/Mail/Assumpta/Mock.hs +++ b/src/Network/Mail/Assumpta/Mock.hs @@ -15,6 +15,9 @@ >>> runMockSmtp (noop >> quit) "NOOP\r\nQUIT\r\n" +For a slightly longer example, see \"simple-client-session-mock-bs.hs" +in the \"examples" directory. + -} module Network.Mail.Assumpta.Mock diff --git a/src/Network/Mail/Assumpta/MonadSmtp.hs b/src/Network/Mail/Assumpta/MonadSmtp.hs --- a/src/Network/Mail/Assumpta/MonadSmtp.hs +++ b/src/Network/Mail/Assumpta/MonadSmtp.hs @@ -397,11 +397,10 @@ -- convenience func. Expects a raw 'ByteString' -- that can be sent after a data command. -- --- sends MAIL FROM, RCPT TO commands as appropriate, --- expecting 250 in each case. --- Then sends data, likewise expecting 250. +-- Just a sequence of 'mailFrom' the sender, 'rcptTo' calls +-- for each recipient, then 'data_' of the message. -- --- We don't alter the content of @message@, expect insofar +-- We don't alter the content of @message@, except insofar -- as specified by RFC, p. 36, namely: -- If the body content passed does not end in @\@, a -- client must either reject the message as invalid or @@ -419,7 +418,6 @@ ByteString -> t ByteString -> ByteString -> m () sendRawMail sender recipients message = do mailFrom sender - expectCode 250 mapM_ rcptTo recipients let messageEnd = diff --git a/stack-lts-12.26.yaml b/stack-lts-12.26.yaml new file mode 100644 --- /dev/null +++ b/stack-lts-12.26.yaml @@ -0,0 +1,8 @@ +resolver: lts-12.26 + +packages: +- . + +extra-deps: [] + + diff --git a/test-other/compile-examples.hs b/test-other/compile-examples.hs new file mode 100644 --- /dev/null +++ b/test-other/compile-examples.hs @@ -0,0 +1,80 @@ + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -fno-warn-type-defaults #-} + +import Control.Monad +import Data.Char as Ch +import Data.Maybe +import Data.Monoid +import Shelly as Sh +import qualified Data.Text as T +import System.IO + +-- Requires the test-doctests flag to be enabled, +-- and the STACK_RESOLVER environment variable to +-- be defined (specifying a resolver to use, e.g. +-- "lts-14"). +-- +default (T.Text) + +{-# ANN module ("HLint: ignore Eta reduce" :: String) #-} +{-# ANN module ("HLint: ignore Use camelCase" :: String) #-} + +isHaskSource :: Sh.FilePath -> Bool +isHaskSource p = "hs" `hasExt` p + +basename :: Sh.FilePath -> Sh.FilePath -> Sh Sh.FilePath +basename dir file = + relativeTo dir file + +baseNameSatisfies :: + (T.Text -> b) -> Sh.FilePath -> Sh.FilePath -> Sh b +baseNameSatisfies pred basedir file = pred . toTextIgnore <$> basename basedir file + +-- is stack on the path +we_must_have_stack :: Sh () +we_must_have_stack = + unlessM (isJust <$> which "stack") $ do + echo "'stack' binary not found on path, exiting" + terror "abort! abort!" + +-- are we running as part of 'stack test'? +-- If so, we can assume the library has been +-- built and is available to us. +we_must_be_run_by_stack :: Sh () +we_must_be_run_by_stack = + unlessM (isJust <$> get_env "STACK_EXE") $ + terror "STACK_EXE env var not set" + +get_stack_resolver :: Sh T.Text +get_stack_resolver = + get_env "STACK_RESOLVER" >>= \case + Nothing -> terror "STACK_RESOLVER env var not set, exiting" + Just res -> return res + +main :: IO () +main = + do + let examplesDir = "examples" + hSetBuffering stdout LineBuffering + shelly $ verbosely $ do + echo "\n\n==================" + echo "Compiling Examples" + echo "==================\n" + stack_resolver <- get_stack_resolver + we_must_have_stack + we_must_be_run_by_stack + hsFiles <- (filter isHaskSource <$> ls examplesDir) >>= + filterM (baseNameSatisfies startsWithLetter examplesDir) + + forM_ hsFiles $ \hsFile -> do + let hsFile' = toTextIgnore hsFile + echo $ "Compiling " <> hsFile' <> "\n" + run "stack" ["ghc", "--resolver=" <> stack_resolver + , "--", "--make", toTextIgnore hsFile] + + where + startsWithLetter = Ch.isLetter . T.head +