diff --git a/Changelog.md b/Changelog.md new file mode 100644 --- /dev/null +++ b/Changelog.md @@ -0,0 +1,8 @@ +# Changelog mailpool + + +# Release 2.2.0 2020.12.02 + ++ Add changelog ++ Add fromJSON instance to smtp cred so this easily works with yesod. ++ Improve docs. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/mail-pool.cabal b/mail-pool.cabal --- a/mail-pool.cabal +++ b/mail-pool.cabal @@ -1,11 +1,13 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack -- --- hash: c299804a7b298ac656a71231f969d24b083053723638ab7fb7c3457cd1e7c73d +-- hash: a5217da958b2e9c7340fe97627cde9a46153981cd42ea05f243a279caa92d65f name: mail-pool -version: 2.1.0 +version: 2.2.0 synopsis: Preconfigured email connection pool on top of smtp. description: Email helper functions with some sane defaults such as a resource pool and cli support category: Email @@ -17,10 +19,10 @@ license: MIT license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 extra-source-files: - LICENSE Readme.md + LICENSE + Changelog.md source-repository head type: git @@ -36,15 +38,16 @@ default-extensions: EmptyCase FlexibleContexts FlexibleInstances InstanceSigs MultiParamTypeClasses LambdaCase MultiWayIf NamedFieldPuns TupleSections DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies GeneralizedNewtypeDeriving StandaloneDeriving OverloadedStrings TypeApplications ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wincomplete-record-updates -Widentities build-depends: - HaskellNet >=0.5.1 && <0.6 - , HaskellNet-SSL >=0.3.4.1 && <0.4 + HaskellNet >=0.5.1 + , HaskellNet-SSL >=0.3.4.1 + , aeson >=1.4 , base >=4.7 && <5 - , microlens >=0.4.10 && <0.5.0 - , mime-mail >=0.4.14 && <0.5 - , network >=2.8.0.0 && <3.0.0.0 - , optparse-applicative >=0.14.3.0 && <0.15 - , resource-pool >=0.2.3.2 && <0.3.0.0 - , time >=1.8.0.2 && <1.9 + , microlens >=0.4.10 + , mime-mail >=0.4.14 + , network >=2.8.0.0 + , optparse-applicative >=0.14.3.0 + , resource-pool >=0.2.3.2 + , time >=1.8.0.2 default-language: Haskell2010 executable exe @@ -56,14 +59,15 @@ default-extensions: EmptyCase FlexibleContexts FlexibleInstances InstanceSigs MultiParamTypeClasses LambdaCase MultiWayIf NamedFieldPuns TupleSections DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies GeneralizedNewtypeDeriving StandaloneDeriving OverloadedStrings TypeApplications ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wincomplete-record-updates -Widentities -threaded -rtsopts -with-rtsopts=-N build-depends: - HaskellNet >=0.5.1 && <0.6 - , HaskellNet-SSL >=0.3.4.1 && <0.4 + HaskellNet >=0.5.1 + , HaskellNet-SSL >=0.3.4.1 + , aeson >=1.4 , base >=4.7 && <5 , mail-pool - , microlens >=0.4.10 && <0.5.0 - , mime-mail >=0.4.14 && <0.5 - , network >=2.8.0.0 && <3.0.0.0 - , optparse-applicative >=0.14.3.0 && <0.15 - , resource-pool >=0.2.3.2 && <0.3.0.0 - , time >=1.8.0.2 && <1.9 + , microlens >=0.4.10 + , mime-mail >=0.4.14 + , network >=2.8.0.0 + , optparse-applicative >=0.14.3.0 + , resource-pool >=0.2.3.2 + , time >=1.8.0.2 default-language: Haskell2010 diff --git a/src/Network/Mail/Pool.hs b/src/Network/Mail/Pool.hs --- a/src/Network/Mail/Pool.hs +++ b/src/Network/Mail/Pool.hs @@ -1,21 +1,24 @@ {-# LANGUAGE DeriveAnyClass #-} +-- | SMTP is s an incredibly stable and well supported protocol. +-- Using this rather then API's prevents vendorlocking. +-- +-- This module provides a ready to go connection pool for SMTP. +-- Which has been used in various deployments already. module Network.Mail.Pool ( - - -- * pool - smtpPool - , PoolSettings(..) + sendEmail + , smtpPool , defSettings + , SmtpCred(..) + , PoolSettings(..) + -- ** specify connection type , openTls , openPlain , openTls' - -- * use pool - , sendEmail - -- * optparse - , SmtpCred(..) + -- ** optparse applicative , emailOptions - -- * lenses + -- ** lenses , poolCred , poolConnf , poolStripes @@ -25,12 +28,15 @@ , smtpLogin , smtpPassword , smtpPort - -- * re exports + -- * Exceptions + , ServiceAuthFailure + -- * re exports , module X ) where import Control.Exception import Control.Monad.IO.Class +import Data.Aeson import Data.Pool as X import Data.Time (NominalDiffTime) import Lens.Micro @@ -46,8 +52,7 @@ deriving (Typeable, Show) deriving anyclass Exception --- | We use smtp because it's an incredibly stable and well supported protocol --- this prevents vendorlocking. +-- | Authentication information for the SMTP connection data SmtpCred = SmtpCred { _smtpPassword :: String , _smtpLogin :: String @@ -55,6 +60,13 @@ , _smtpPort :: PortNumber } deriving (Show) +instance FromJSON SmtpCred where + parseJSON = withObject "SmtpCred" $ \v -> SmtpCred + <$> v .: "password" + <*> v .: "login" + <*> v .: "host" + <*> (fromInteger <$> v .: "port") + smtpHost :: Lens' SmtpCred String smtpHost = lens _smtpHost (\a b -> a{_smtpHost= b}) smtpLogin :: Lens' SmtpCred String @@ -64,12 +76,19 @@ smtpPort :: Lens' SmtpCred PortNumber smtpPort = lens _smtpPort (\a b -> a{_smtpPort= b}) +-- | This allows you to override the default settings from 'defSettings' data PoolSettings = PoolSettings - { _poolCred :: SmtpCred -- ^ credentials for smtp connection - , _poolConnf :: SmtpCred -> IO SMTPConnection -- ^ smtpcred can't be factored out. - , _poolStripes :: Int -- ^ stripe, see docs, I think I just need 1: https://hackage.haskell.org/package/resource-pool-0.2.3.2/docs/Data-Pool.html - , _poolUnused :: NominalDiffTime -- ^ unused connections are kept open for a minute - , _poolStripeMax :: Int -- ^ max. 10 connections open per stripe + + { -- | credentials for smtp connection + _poolCred :: SmtpCred + -- | allows overriding of the opening function, for example 'openPlain' or 'openTls' + , _poolConnf :: SmtpCred -> IO SMTPConnection + -- | stripes, see docs: https://hackage.haskell.org/package/resource-pool-0.2.3.2/docs/Data-Pool.html + , _poolStripes :: Int + -- | specify how long connections are kept open. + , _poolUnused :: NominalDiffTime + -- | how many connections per stripe. + , _poolStripeMax :: Int } poolCred :: Lens' PoolSettings SmtpCred @@ -83,6 +102,7 @@ poolStripeMax :: Lens' PoolSettings Int poolStripeMax = lens _poolStripeMax (\a b -> a{_poolStripeMax=b}) +-- | Create settings with good defaults from 'SmtpCred'. defSettings :: SmtpCred -> PoolSettings defSettings cred = PoolSettings { _poolCred = cred @@ -100,10 +120,11 @@ openTls' :: Settings -> SmtpCred -> IO SMTPConnection openTls' def smtp = connectSMTPSTARTTLSWithSettings (smtp ^. smtpHost) $ def { - sslPort = (smtp ^. smtpPort) + sslPort = smtp ^. smtpPort } +-- | Construct a connection pool from settings. smtpPool :: PoolSettings -> IO (Pool SMTPConnection) smtpPool smtp = createPool @@ -158,5 +179,6 @@ value 587 <> metavar "SMTP-PORT") +-- | Send a 'Mail' with help of a connection pool. sendEmail :: MonadIO m => Pool SMTPConnection -> Mail -> m () sendEmail pool = liftIO . withResource pool . sendMimeMail2