assumpta-core 0.1.0.1 → 0.1.0.2

raw patch · 11 files changed

+337/−14 lines, 11 filesdep +filepath

Dependencies added: filepath

Files

• CONTRIBUTE.md +24/−0
• ChangeLog.md +6/−0
• DEVELOPMENT.md +58/−0
• TODO.md +45/−0
• assumpta-core.cabal +44/−9
• examples/simple-client-session-mock-bs.hs +54/−0
• scripts/stack-test.sh +12/−0
• src/Network/Mail/Assumpta/Mock.hs +3/−0
• src/Network/Mail/Assumpta/MonadSmtp.hs +3/−5
• stack-lts-12.26.yaml +8/−0
• test-other/compile-examples.hs +80/−0

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

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

@@ -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+<https://www.rfc-editor.org/errata/rfc5321>.++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.+++

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

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

@@ -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 "====="++

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

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

@@ -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 @\<CRLF>@, 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 =

@@ -0,0 +1,8 @@+resolver: lts-12.26++packages:+- .++extra-deps: []++

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