packages feed

smtp-mail-ng (empty) → 0.1.0.0

raw patch · 11 files changed

+892/−0 lines, 11 filesdep +attoparsecdep +basedep +base16-bytestringsetup-changed

Dependencies added: attoparsec, base, base16-bytestring, base64-bytestring, bytestring, crypto-random, cryptohash, filepath, haskeline, mime-mail, mtl, network, stringsearch, text, tls, transformers, x509-store, x509-system

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Jason Hickner, Alexander Vieth++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jason Hickner nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/Mail/SMTP/Auth.hs view
@@ -0,0 +1,77 @@+{-|+Description: terms for doing SMTP authorization.+-}+module Network.Mail.SMTP.Auth (++    authLogin++  ) where++import Crypto.Hash.MD5 (hash)+import qualified Data.ByteString.Base16 as B16  (encode)+import qualified Data.ByteString.Base64 as B64  (encode)++import Data.ByteString  (ByteString)+import Data.List+import Data.Bits+import Data.Monoid+import qualified Data.ByteString       as B+import qualified Data.ByteString.Char8 as B8++import Network.Mail.SMTP.SMTP+import Network.Mail.SMTP.Types++-- | Do LOGIN authentication.+authLogin :: UserName -> Password -> SMTP ()+authLogin username password = do+  -- There's no Command constructor for AUTH. TODO implement one? It has a+  -- volatile form I think; varies for each AUTH type I believe.+  reply <- bytes (B8.pack "AUTH LOGIN")+  -- TBD do we need to check that it gives the right text?+  -- I thought the RFCs say that only the codes matter...+  expectCode 334+  bytes $ b64Encode username+  expectCode 334+  bytes $ b64Encode password+  -- TODO need a mechanism to specify the error in case the code is bad.+  -- Or, maybe a mechanism to expect multiple codes and handle things+  -- differently based upon the code.+  expectCode 235 ++toAscii :: String -> ByteString+toAscii = B.pack . map (toEnum.fromEnum)++b64Encode :: String -> ByteString+b64Encode = B64.encode . toAscii++hmacMD5 :: ByteString -> ByteString -> ByteString+hmacMD5 text key = hash (okey <> hash (ikey <> text))+    where key' = if B.length key > 64+                 then hash key <> B.replicate 48 0+                 else key <> B.replicate (64-B.length key) 0+          ipad = B.replicate 64 0x36+          opad = B.replicate 64 0x5c+          ikey = B.pack $ B.zipWith xor key' ipad+          okey = B.pack $ B.zipWith xor key' opad++encodePlain :: UserName -> Password -> ByteString+encodePlain user pass = b64Encode $ intercalate "\0" [user, user, pass]++encodeLogin :: UserName -> Password -> (ByteString, ByteString)+encodeLogin user pass = (b64Encode user, b64Encode pass)++cramMD5 :: String -> UserName -> Password -> ByteString+cramMD5 challenge user pass =+    B64.encode $ B8.unwords [user', B16.encode (hmacMD5 challenge' pass')]+  where+    challenge' = toAscii challenge+    user'      = toAscii user+    pass'      = toAscii pass++{- Code from before the fork which is now dead, but I'll leave it around as+ - a reference for when we implement CRAM_MD5+auth :: AuthType -> String -> UserName -> Password -> ByteString+auth PLAIN    _ u p = encodePlain u p+auth LOGIN    _ u p = let (u', p') = encodeLogin u p in B8.unwords [u', p']+auth CRAM_MD5 c u p = cramMD5 c u p+-}
+ Network/Mail/SMTP/ReplyLine.hs view
@@ -0,0 +1,95 @@+{-|+Description: parsing of server replies.+-}++{-# LANGUAGE OverloadedStrings #-}++module Network.Mail.SMTP.ReplyLine (++    ReplyLine+  , Greeting++  , replyCode++  -- Attoparsec parsers for the datatype given above. The only way you can+  -- obtain a ReplyLine or Greeting is by parsing one from a ByteString.+  , greeting+  , replyLines++  ) where++import qualified Data.ByteString as B+import Data.Attoparsec.ByteString.Char8+import Control.Applicative++import Network.Mail.SMTP.Types++-- | A reply from a server: code and message.+data ReplyLine = ReplyLine !ReplyCode !B.ByteString+  deriving (Show)++-- | Projection onto ReplyCode.+replyCode :: ReplyLine -> ReplyCode+replyCode (ReplyLine x _) = x++-- | A greeting from a server: domain/host name and message(s).+data Greeting = Greeting !B.ByteString ![B.ByteString]+  deriving (Show)++-- What follows is definitions for parsing ReplyLine and Greeting via+-- Attoparsec combinators.+-- Parser definitions pulled from RFC 5321 section 4.2++crlf :: Parser ()+crlf = char '\r' >> char '\n' >> pure ()++textstring :: Parser B.ByteString+textstring = takeWhile1 predicate+  where+    -- 9 is horizontal tab, and [32, 126] is all printable US ASCII.+    -- Just check your table ;)+    predicate c' = let c = fromEnum c' in c == 9 || (c >= 32 && c <= 126)++-- | Parser for one or more server replies.+replyLines :: Parser [ReplyLine]+replyLines = (++) <$> many' replyLine' <*> (pure <$> replyLine)++replyLine :: Parser ReplyLine+replyLine = ReplyLine <$> code <* space <*> option "" textstring <* crlf++replyLine' :: Parser ReplyLine+replyLine' = ReplyLine <$> code <* char '-' <*> option "" textstring <* crlf++-- We deviate from the RFC on the response code, because it demands that+-- an SMTP server SHOULD only send the codes listed in the spec. We just take+-- any decimal numbere.+code :: Parser ReplyCode+code = decimal++-- | Parser for a Greeting.+greeting :: Parser Greeting+greeting = manyGreetings <|> oneGreeting+  where++    oneGreeting :: Parser Greeting+    oneGreeting = do+      string "220 "+      bytestring <- takeWhile1 isASCIIPrintableNonWhitespace+      messages <- option [] (char ' ' *> (pure <$> textstring))+      crlf+      return $ Greeting bytestring messages++    manyGreetings :: Parser Greeting+    manyGreetings = do+      string "220-"+      bytestring <- takeWhile1 isASCIIPrintableNonWhitespace+      greets <- option [] (char ' ' *> (pure <$> textstring))+      crlf+      moreGreets <- many (string "220-" *> textstring <* crlf)+      string "220"+      lastgreet <- option [] (pure <$> (char ' ' >> textstring))+      let messages = greets ++ moreGreets ++ lastgreet+      return $ Greeting bytestring messages++isASCIIPrintableNonWhitespace :: Char -> Bool+isASCIIPrintableNonWhitespace c' = let c = fromEnum c' in c > 32 && c <= 126
+ Network/Mail/SMTP/SMTP.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{-|+Description: definition of the SMTP monad and its terms.+-}++module Network.Mail.SMTP.SMTP (++    SMTP++  , smtp++  , command+  , bytes+  , expect+  , expectCode++  , SMTPContext+  , smtpContext++  , getSMTPServerHostName+  , getSMTPClientHostName++  , startTLS++  , SMTPError(..)++  ) where++import Control.Exception+import Control.Monad+import Control.Applicative+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Except+import Control.Monad.Trans.State++import Network+import Network.BSD+import Network.Mail.SMTP.Types+import Network.Mail.SMTP.ReplyLine+import Network.Mail.SMTP.SMTPRaw+import Network.Mail.SMTP.SMTPParameters++-- STARTTLS support demands some TLS- and X.509-related definitions.+import Network.TLS+import Network.TLS.Extra.Cipher (ciphersuite_all)+import System.X509 (getSystemCertificateStore)+import Data.X509.CertificateStore (CertificateStore)+import Data.ByteString.Char8 (pack)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Crypto.Random++import System.IO++-- | An SMTP client EDSL: it can do effects, things can go wrong, and+--   it carries state.+newtype SMTP a = SMTP {+    runSMTP :: ExceptT SMTPError (StateT SMTPContext IO) a+  } deriving (Functor, Applicative, Monad, MonadIO)++-- | Run an expression in the SMTP monad.+--   Should be exception safe, but I am not confident in this.+smtp :: SMTPParameters -> SMTP a -> IO (Either SMTPError a)+smtp smtpParameters smtpValue = do+  smtpContext <- makeSMTPContext smtpParameters+  case smtpContext of+    Left err -> return $ Left err+    Right smtpContext -> do+      x <- evalStateT (runExceptT (runSMTP smtpValue)) smtpContext+      closeSMTPContext smtpContext+      return x++-- | Attempt to make an SMTPContext.+makeSMTPContext :: SMTPParameters -> IO (Either SMTPError SMTPContext)+makeSMTPContext smtpParameters = do+    clientHostname <- getHostName+    result <- liftIO $ try (smtpConnect serverHostname (fromIntegral port))+    return $ case result :: Either SomeException (SMTPRaw, Maybe Greeting) of+      Left err -> Left ConnectionFailure+      Right (smtpRaw, _) -> Right $ SMTPContext smtpRaw serverHostname clientHostname debug+  where+    serverHostname = smtpHost smtpParameters+    port = smtpPort smtpParameters+    debug = if smtpVerbose smtpParameters+            then putStrLn+            else const (return ())++-- | Attempt to close an SMTPContext, freeing its resource.+closeSMTPContext :: SMTPContext -> IO ()+closeSMTPContext smtpContext = hClose (smtpHandle (smtpRaw smtpContext))++-- | Send a command, without waiting for the reply.+command :: Command -> SMTP ()+command cmd = SMTP $ do+  ctxt <- lift get+  liftIO $ (smtpDebug ctxt ("Send command: " ++ show (toByteString cmd)))+  result <- liftIO $ try ((smtpSendCommand (smtpRaw ctxt) cmd))+  case result :: Either SomeException () of+    Left err -> throwE UnknownError+    Right () -> return ()++-- | Send some bytes, with a crlf inserted at the end, without waiting for+--   the reply.+bytes :: B.ByteString -> SMTP ()+bytes bs = SMTP $ do+    ctxt <- lift get+    liftIO $ (smtpDebug ctxt ("Send bytes: " ++ show bs))+    result <- liftIO $ try ((smtpSendRaw (smtpRaw ctxt) (B.append bs crlf)))+    case result :: Either SomeException () of+      Left err -> throwE UnknownError+      Right () -> return ()+  where+    crlf = pack "\r\n"++-- | Pull a response from the server, passing it through a function which+--   checks that it's an expected response. If the response doesn't parse as+--   an SMTP response, we give an UnexpectedResponse.+expect :: ([ReplyLine] -> Maybe SMTPError) -> SMTP ()+expect ok = SMTP $ do+  ctxt <- lift get+  let smtpraw = smtpRaw ctxt+  reply <- liftIO $ smtpGetReplyLines smtpraw+  liftIO $ (smtpDebug ctxt ("Receive response: " ++ show reply))+  case reply of+    Nothing -> throwE UnexpectedResponse+    Just reply -> case ok reply of+      Just err -> throwE err+      Nothing -> return ()++-- | Like expect, but you give only the ReplyCode that is expected. Any other+--   reply code, or an unexpected reponse, is considered a failure.+expectCode :: ReplyCode -> SMTP ()+expectCode code = expect hasCode+  where+    hasCode [] = Just UnexpectedResponse+    hasCode (reply : _) =+      if replyCode reply == code+      then Nothing+      else Just UnexpectedResponse++-- | Grab the SMTPContext.+smtpContext :: SMTP SMTPContext+smtpContext = SMTP $ lift get++-- | Try to get TLS going on an SMTP connection.+startTLS :: SMTP ()+startTLS = do+  context <- tlsContext+  command STARTTLS+  expectCode 220+  tlsUpgrade context+  ctxt <- smtpContext+  command (EHLO (pack $ getSMTPClientHostName ctxt))+  expectCode 250++-- | Attempt to create a TLS context.+tlsContext :: SMTP Context+tlsContext = SMTP $ do+  ctxt <- lift get+  tlsContext <- liftIO $ try (makeTLSContext (getSMTPHandle ctxt) (getSMTPServerHostName ctxt))+  case tlsContext :: Either SomeException Context of+    Left err -> throwE EncryptionError+    Right context -> return context++-- | Upgrade to TLS. If the handshake is successful, the underlying SMTPRaw+--   will be updated so that it pushes/pulls using the TLS context rather+--   than raw Handle.+tlsUpgrade :: Context -> SMTP ()+tlsUpgrade context = SMTP $ do+  result <- liftIO $ try (handshake context)+  case result :: Either SomeException () of+    Left err -> throwE EncryptionError+    Right () -> do+      -- Now that we have upgraded, we must change the means by which we push+      -- and pull data to and from the pipe; we must use the TLS library's+      -- sendData and recvData+      let push = sendData context . BL.fromStrict+      let pull = recvData context+      let close = contextClose context+      lift $ modify (\ctx ->+          ctx { smtpRaw = SMTPRaw push pull close (smtpHandle (smtpRaw ctx)) }+        )++-- | Get a TLS context on a given Handle against a given HostName.+--   We choose a big cipher suite, the SystemRNG, and the system certificate+--   store. Hopefully this will work most of the time.+--   This action may throw an exception. We are careful to handle it and+--   coerce it into a first-class value.+makeTLSContext :: Handle -> HostName -> IO Context+makeTLSContext handle hostname = do+  -- Grab a random number generator.+  rng <- (createEntropyPool >>= return . cprgCreate) :: IO SystemRNG+  -- Find the certificate store. No error reporting if we can't find it; you'll+  -- just (probably) get an error later when the TLS handshake fails due to+  -- an unknown CA.+  certStore <- getSystemCertificateStore+  let params = tlsClientParams hostname certStore+  contextNew handle params rng++-- | ClientParams are a slight variation on the default: we throw in a given+--   certificate store and widen the supported ciphers.+tlsClientParams :: HostName -> CertificateStore -> ClientParams+tlsClientParams hostname certStore = dflt {+      clientSupported = supported+    , clientShared = shared+    }+  where+    dflt = defaultParamsClient hostname ""+    shared = (clientShared dflt) { sharedCAStore = certStore }+    supported = (clientSupported dflt) { supportedCiphers = ciphersuite_all }++-- | Description of an error in the SMTP monad evaluation.+data SMTPError+  = UnexpectedResponse+  | ConnectionFailure+  | EncryptionError+  | UnknownError+  deriving (Show, Eq)++-- | Description of the state which an SMTP term needs in order to be+--   evaluated.+data SMTPContext = SMTPContext {+    smtpRaw :: SMTPRaw+    -- ^ Necessary for push/pull to/from some reasource (probably a Handle).+  , smtpServerHostName :: HostName+  , smtpClientHostName :: HostName+  , smtpDebug :: String -> IO ()+    -- ^ A pipe into which we can throw debug messages. const (return ()) for+    -- squelching, or maybe putStrLn for verbosity.+  }++-- | Access the Handle datatype buried beneath the SMTP abstraction.+--   Use with care!+getSMTPHandle :: SMTPContext -> Handle+getSMTPHandle = smtpHandle . smtpRaw++getSMTPServerHostName :: SMTPContext -> HostName+getSMTPServerHostName = smtpServerHostName++getSMTPClientHostName :: SMTPContext -> HostName+getSMTPClientHostName = smtpClientHostName
+ Network/Mail/SMTP/SMTPParameters.hs view
@@ -0,0 +1,33 @@+{- |+Description: parameters for an SMTP session.+-}+module Network.Mail.SMTP.SMTPParameters (++    SMTPParameters(..)++  , HostName+  , PortNumber(..)++  , defaultSMTPParameters++  ) where++import Network.Socket (HostName, PortNumber(..))+import Network.Mail.SMTP.Types++-- | Data necessary to kick-start an SMTP session, plus a flag to indicate+--   verbosity (actually a misnomer I though; should be smtpQuiet, since we+--   have only two options: verbose or not verbose).+data SMTPParameters = SMTPParameters {+    smtpHost :: HostName+  , smtpPort :: PortNumber+  , smtpVerbose :: Bool+  } deriving (Show)++-- | Default SMTP parameters for some hostname. Uses port 25, non-verbose.+defaultSMTPParameters :: HostName -> SMTPParameters+defaultSMTPParameters hostname = SMTPParameters {+    smtpHost = hostname+  , smtpPort = 25+  , smtpVerbose = False+  }
+ Network/Mail/SMTP/SMTPRaw.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Description: low-level SMTP communciation.+-}++module Network.Mail.SMTP.SMTPRaw (++    SMTPRaw(..)+  , smtpConnect+  , smtpSendCommand+  , smtpSendCommandAndWait+  , smtpSendRaw+  , smtpGetReplyLines+  , smtpDisconnect++  ) where++import qualified Data.ByteString as B+import           Data.ByteString.Char8 (pack, unpack)+import           Network+import           Network.Socket+import           Data.Attoparsec.ByteString.Char8+import           System.IO++import           Network.Mail.SMTP.ReplyLine+import           Network.Mail.SMTP.Types++-- | An SMTPRaw has arbitrary push/pull/close methods, and ALWAYS a Handle,+--   but that Handle is not assumed to be the direct means by which we push+--   pull or close. This is for STARTTLS support.+data SMTPRaw = SMTPRaw {+    smtpPush :: B.ByteString -> IO ()+  , smtpPull :: IO B.ByteString+  , smtpClose :: IO ()+  , smtpHandle :: Handle+  }++-- | Try to open an SMTPRaw, taking the server greeting as well.+--   No exception handling is performed.+smtpConnect :: String -> Int -> IO (SMTPRaw, Maybe Greeting)+smtpConnect host port = do+  handle <- connectTo host (PortNumber $ fromIntegral port)+  greet <- parseWith (B.hGetSome handle 2048) greeting ""+  let push = B.hPut handle+  let pull = B.hGetSome handle 2048+  let close = hClose handle+  return $ (SMTPRaw push pull close handle, maybeResult greet)++-- | Send an SMTP command and wait for the reply.+--   You get Nothing in case the reply does not parse.+--   No exception handling is performed.+smtpSendCommandAndWait :: SMTPRaw -> Command -> IO (Maybe [ReplyLine])+smtpSendCommandAndWait smtpraw cmd = do+  smtpSendCommand smtpraw cmd+  smtpGetReplyLines smtpraw++-- | Send an SMTP command.+--   No exception handling is performed.+smtpSendCommand :: SMTPRaw -> Command -> IO ()+smtpSendCommand smtpraw cmd = do+  smtpSendRaw smtpraw (toByteString cmd)+  smtpSendRaw smtpraw (pack "\r\n")++-- | Send a raw byte string. Use with care. No exception handling is performed.+smtpSendRaw :: SMTPRaw -> B.ByteString -> IO ()+smtpSendRaw = smtpPush++-- | Try to read ReplyLines from the SMTPRaw.+--   No exception handling is performed.+smtpGetReplyLines :: SMTPRaw -> IO (Maybe [ReplyLine])+smtpGetReplyLines smtpraw = do+  replies <- parseWith (smtpPull smtpraw) replyLines ""+  return $ maybeResult replies++-- | Close an SMTPRaw handle+--   Be sure not to use the SMTPHandle after this.+smtpDisconnect :: SMTPRaw -> IO ()+smtpDisconnect = smtpClose
+ Network/Mail/SMTP/Send.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Description: terms for sending mail.+-}++module Network.Mail.SMTP.Send (++    send++  ) where++import Control.Monad.IO.Class++import Network.Mail.SMTP.Types+import Network.Mail.SMTP.SMTP+import Network.Mail.Mime++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Char8 (pack)+import Data.Text.Encoding (encodeUtf8)+import Data.ByteString.Lazy.Search (replace)++-- | Attempt to send an email.+--   This involves sending MAIL, RCPT, and DATA commands.+send :: Mail -> SMTP ()+send mail = do+    content <- liftIO $ renderMail' mail+    sendRendered from to content+  where+    from = enc $ mailFrom mail+    to = map enc $ mailTo mail+    enc = encodeUtf8 . addressEmail++-- | Attempt to send "rendered" mail. First argument is a coding of the+--   sender address, second is a coding of each recipient address, and third+--   is the message body.+--   This function will escape any "\r\n.\r\n" pattern, which would otherwise+--   result in a premature ending to the message.+sendRendered :: B.ByteString -> [B.ByteString] -> BL.ByteString -> SMTP ()+sendRendered from to content = do+    command (MAIL from)+    expectCode 250+    -- TODO TBD expect a 250 for each recipient? Isn't it OK to have some+    -- of them fail?+    mapM_ (\r -> command (RCPT r) >> expectCode 250) to+    command DATA+    expectCode 354+    bytes (BL.toStrict escapedContent)+    -- We have to manually put in the .+    bytes (pack ".")+    expectCode 250++  where++    escapedContent :: BL.ByteString+    escapedContent = replace pattern substitution content++    pattern :: B.ByteString+    pattern = "\r\n.\r\n"++    substitution :: BL.ByteString+    substitution = "\r\n..\r\n"
+ Network/Mail/SMTP/Types.hs view
@@ -0,0 +1,100 @@+{-+Description: various types.+-}++{-# LANGUAGE OverloadedStrings #-}++module Network.Mail.SMTP.Types (++    AuthType(..)++  , UserName+  , Password++  , Command(..)++  , toByteString+    +  , ReplyCode+  , Response(..)++    -- * "Network.Mail.Mime" types (re-exports)+  , Address(..)++  ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import Network.Mail.Mime++type UserName = String+type Password = String++-- | Type of SMTP authorization scheme.+data AuthType+  = LOGIN+  deriving (Show)++-- | SMTP command description.+data Command+    = HELO ByteString+    | EHLO ByteString+    | MAIL ByteString+    | RCPT ByteString+    | DATA+    | EXPN ByteString+    | VRFY ByteString+    | HELP ByteString+    | NOOP+    | RSET+    | QUIT+    | STARTTLS+    deriving (Show, Eq)++-- | Dump an SMTP command to a bytestring, suitable for transmission to a+--   server. No CRLF is appended.+toByteString :: Command -> B.ByteString+toByteString command = case command of+    HELO bs -> B.intercalate space [(B.pack "HELO"), bs]+    EHLO bs -> B.intercalate space [(B.pack "EHLO"), bs]+    MAIL bs -> B.append (B.pack "MAIL FROM:<") (B.append bs ">")+    RCPT bs -> B.append (B.pack "RCPT TO:<") (B.append bs ">")+    EXPN bs -> B.intercalate space [(B.pack "EXPN"), bs]+    VRFY bs -> B.intercalate space [(B.pack "VRFY"), bs]+    HELP bs -> B.intercalate space [(B.pack "HELP"), bs]+    DATA -> B.pack "DATA"+    NOOP -> B.pack "NOOP"+    RSET -> B.pack "RSET"+    QUIT -> B.pack "QUIT"+    STARTTLS -> B.pack "STARTTLS"+  where+    space = B.pack " "++-- | Reply code from a server.+type ReplyCode = Int++-- | This poor datatype... It doesn't look like it's used anywhere+data Response+    = Ok+    | SystemStatus+    | HelpMessage+    | ServiceReady+    | ServiceClosing+    | UserNotLocal+    | CannotVerify+    | StartMailInput+    | ServiceNotAvailable+    | MailboxUnavailable+    | ErrorInProcessing+    | InsufficientSystemStorage+    | SyntaxError+    | ParameterError+    | CommandNotImplemented+    | BadSequence+    | ParameterNotImplemented+    | MailboxUnavailableError+    | UserNotLocalError+    | ExceededStorage+    | MailboxNotAllowed+    | TransactionFailed+    deriving (Show, Eq)
+ README.md view
@@ -0,0 +1,74 @@+SMTP-MAIL-NG+============++An SMTP client EDSL. If you want to interact with an SMTP server, this library+may be able to help you. It even supports STARTTLS!++The star is the SMTP monad, terms of which (thanks to do notation) often+resemble an SMTP session.++### Sending with an SMTP server++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Network.BSD (getHostName)+import Network.Mail.SMTP.SMTP+import Network.Mail.SMTP.SMTPParameters+import Network.Mail.SMTP.Types+import Network.Mail.SMTP.Auth+import Network.Mail.SMTP.Send+import Network.Mail.Mime+import Control.Monad.IO.Class (liftIO)+import Data.ByteString.Char8 (pack)++main = smtp smtpParameters $ do+  hostname <- liftIO getHostName+  -- Send EHLO and expect a 250+  command $ EHLO (pack hostname)+  expectCode 250+  -- Upgrade the connection to TLS+  -- This is a kind of utility term that takes care of sending STARTTLS,+  -- expecting a 220, and then upgrading the underlying connection to TLS.+  startTLS+  -- Authenticate with LOGIN scheme+  authLogin "jarndyce@gmail.com" "mySuperSecretPassword"+  -- Send the message+  send message+  -- End the session.+  -- Closing the connection is handled automatically by the function smtp+  command QUIT++-- We use datatypes from the mime-mail package to describe Mail.+message :: Mail+message = simpleMail' to from subject body+  where+    from = Address (Just "John Jarndyce") "jarndyce@gmail.com"+    to = Address (Just "Harold Skimpole") "harold@skimpole.com"+    subject = "Hey!"+    body = "It works!"++smtpParameters :: SMTPParameters+smtpParameters = (defaultSMTPParameters "smtp.googlemail.com") {+    smtpVerbose = True+  }+```++### Moving forward++We must implement support for more AUTH schemes. Right now all that we+facilitate is LOGIN, although other methods are possible via the bytes+term.++There is an orphan datatype, Response, from before the fork. It may be+good to use this instead of bare Ints.++It would be nice to give a convenient interface for simply sending some+messages, in which the user must supply only a list of Mail values, an+SMTPParameters, and a description of the authentication and encryption+parameters of the mail server.++### Thanks++This library is forked from Jason Hickner's smtp-mail, but it has diverged+significantly and bears little resemblance.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ smtp-mail-ng.cabal view
@@ -0,0 +1,94 @@+-- Initial smtp-mail-ng.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                smtp-mail-ng++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            An SMTP client EDSL++description:         An SMTP client EDSL++-- A longer description of the package.+-- description:         ++-- URL for the project homepage or repository.+homepage:            https://github.com/avieth/smtp-mail-ng++-- The license under which the package is released.+license:             BSD3++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Alexander Vieth++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          aovieth@gmail.com++-- A copyright notice.+-- copyright:           ++category:            Network++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+extra-source-files:  README.md++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10++source-repository head+  type: git+  location: git@github.com:avieth/smtp-mail-ng.git++library+  -- Modules exported by the library.+  exposed-modules:     Network.Mail.SMTP.Send, Network.Mail.SMTP.Auth, Network.Mail.SMTP.SMTPParameters, Network.Mail.SMTP.ReplyLine, Network.Mail.SMTP.Types, Network.Mail.SMTP.SMTP, Network.Mail.SMTP.SMTPRaw+  +  -- Modules included in this library but not exported.+  -- other-modules:       +  +  -- LANGUAGE extensions used by modules in this package.+  other-extensions:    OverloadedStrings, ScopedTypeVariables, RecordWildCards, GeneralizedNewtypeDeriving+  +  -- Other library packages from which modules are imported.+  build-depends: base >=4.7 && <4.8+               , network >=2.6 && <2.7+               , mime-mail >=0.4 && <0.5+               , transformers >=0.4 && <0.5+               , bytestring >=0.10 && <0.11+               , haskeline >=0.7 && <0.8+               , mtl >=2.2 && <2.3+               , attoparsec >=0.12 && <0.13+               , filepath >=1.3 && <1.4+               , text >=1.2 && <1.3+               , cryptohash >=0.11 && <0.12+               , base16-bytestring >=0.1 && <0.2+               , base64-bytestring >=1.0 && <1.1+               , tls >=1.2 && <1.3+               , x509-system >=1.5 && <1.6+               , x509-store >=1.5 && <1.6+               , crypto-random >=0.0 && <0.1+               , stringsearch >= 0.3.6.5+  +  -- Directories containing source files.+  -- hs-source-dirs:      +  +  -- Base language which the package is written in.+  default-language:    Haskell2010++  ghc-options: -Wall+