{-# 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
  (
    sendEmail
  , smtpPool
  , defSettings
  , SmtpCred(..)
  , PoolSettings(..)
  -- ** specify connection type
  , openTls
  , openPlain
  , openTls'
  , createPoolConfig
  -- ** optparse applicative
  , emailOptions
  -- ** lenses
  , poolCred
  , poolConnf
  , poolUnused
  , poolStripeMax
  , smtpHost
  , smtpLogin
  , smtpPassword
  , smtpPort
  -- * Exceptions
  , ServiceAuthFailure
  -- * re exports
  , module X
  ) where

import           Control.Exception
import           Control.Monad.IO.Class
import           Data.Aeson
import           Data.Pool                   as X
import           Lens.Micro
import           Network.HaskellNet.SMTP     as X
import           Network.HaskellNet.SMTP.SSL as X
import           Network.Mail.Mime
import           Network.Socket
import           Options.Applicative
import           Type.Reflection             (Typeable)

-- | Failed to authetnicate with some upstream service (smtp for example)
newtype ServiceAuthFailure a = ServiceAuthFailure a
  deriving (Typeable, Int -> ServiceAuthFailure a -> ShowS
[ServiceAuthFailure a] -> ShowS
ServiceAuthFailure a -> String
(Int -> ServiceAuthFailure a -> ShowS)
-> (ServiceAuthFailure a -> String)
-> ([ServiceAuthFailure a] -> ShowS)
-> Show (ServiceAuthFailure a)
forall a. Show a => Int -> ServiceAuthFailure a -> ShowS
forall a. Show a => [ServiceAuthFailure a] -> ShowS
forall a. Show a => ServiceAuthFailure a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ServiceAuthFailure a -> ShowS
showsPrec :: Int -> ServiceAuthFailure a -> ShowS
$cshow :: forall a. Show a => ServiceAuthFailure a -> String
show :: ServiceAuthFailure a -> String
$cshowList :: forall a. Show a => [ServiceAuthFailure a] -> ShowS
showList :: [ServiceAuthFailure a] -> ShowS
Show)
  deriving anyclass Show (ServiceAuthFailure a)
Typeable (ServiceAuthFailure a)
(Typeable (ServiceAuthFailure a), Show (ServiceAuthFailure a)) =>
(ServiceAuthFailure a -> SomeException)
-> (SomeException -> Maybe (ServiceAuthFailure a))
-> (ServiceAuthFailure a -> String)
-> Exception (ServiceAuthFailure a)
SomeException -> Maybe (ServiceAuthFailure a)
ServiceAuthFailure a -> String
ServiceAuthFailure a -> SomeException
forall a. (Typeable a, Show a) => Show (ServiceAuthFailure a)
forall a. (Typeable a, Show a) => Typeable (ServiceAuthFailure a)
forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (ServiceAuthFailure a)
forall a. (Typeable a, Show a) => ServiceAuthFailure a -> String
forall a.
(Typeable a, Show a) =>
ServiceAuthFailure a -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: forall a.
(Typeable a, Show a) =>
ServiceAuthFailure a -> SomeException
toException :: ServiceAuthFailure a -> SomeException
$cfromException :: forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (ServiceAuthFailure a)
fromException :: SomeException -> Maybe (ServiceAuthFailure a)
$cdisplayException :: forall a. (Typeable a, Show a) => ServiceAuthFailure a -> String
displayException :: ServiceAuthFailure a -> String
Exception

-- | Authentication information for the SMTP connection
data SmtpCred = SmtpCred
  { SmtpCred -> String
_smtpPassword :: String
  , SmtpCred -> String
_smtpLogin    :: String
  , SmtpCred -> String
_smtpHost     :: String
  , SmtpCred -> PortNumber
_smtpPort     :: PortNumber
  } deriving (Int -> SmtpCred -> ShowS
[SmtpCred] -> ShowS
SmtpCred -> String
(Int -> SmtpCred -> ShowS)
-> (SmtpCred -> String) -> ([SmtpCred] -> ShowS) -> Show SmtpCred
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SmtpCred -> ShowS
showsPrec :: Int -> SmtpCred -> ShowS
$cshow :: SmtpCred -> String
show :: SmtpCred -> String
$cshowList :: [SmtpCred] -> ShowS
showList :: [SmtpCred] -> ShowS
Show)

instance FromJSON SmtpCred where
     parseJSON :: Value -> Parser SmtpCred
parseJSON = String -> (Object -> Parser SmtpCred) -> Value -> Parser SmtpCred
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SmtpCred" ((Object -> Parser SmtpCred) -> Value -> Parser SmtpCred)
-> (Object -> Parser SmtpCred) -> Value -> Parser SmtpCred
forall a b. (a -> b) -> a -> b
$ \Object
v -> String -> String -> String -> PortNumber -> SmtpCred
SmtpCred
        (String -> String -> String -> PortNumber -> SmtpCred)
-> Parser String
-> Parser (String -> String -> PortNumber -> SmtpCred)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"password"
        Parser (String -> String -> PortNumber -> SmtpCred)
-> Parser String -> Parser (String -> PortNumber -> SmtpCred)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"login"
        Parser (String -> PortNumber -> SmtpCred)
-> Parser String -> Parser (PortNumber -> SmtpCred)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"host"
        Parser (PortNumber -> SmtpCred)
-> Parser PortNumber -> Parser SmtpCred
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> PortNumber
forall a. Num a => Integer -> a
fromInteger (Integer -> PortNumber) -> Parser Integer -> Parser PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"port")

smtpHost :: Lens' SmtpCred String
smtpHost :: Lens' SmtpCred String
smtpHost = (SmtpCred -> String)
-> (SmtpCred -> String -> SmtpCred) -> Lens' SmtpCred String
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SmtpCred -> String
_smtpHost (\SmtpCred
a String
b -> SmtpCred
a{_smtpHost= b})
smtpLogin :: Lens' SmtpCred String
smtpLogin :: Lens' SmtpCred String
smtpLogin = (SmtpCred -> String)
-> (SmtpCred -> String -> SmtpCred) -> Lens' SmtpCred String
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SmtpCred -> String
_smtpLogin (\SmtpCred
a String
b -> SmtpCred
a{_smtpLogin= b})
smtpPassword :: Lens' SmtpCred String
smtpPassword :: Lens' SmtpCred String
smtpPassword = (SmtpCred -> String)
-> (SmtpCred -> String -> SmtpCred) -> Lens' SmtpCred String
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SmtpCred -> String
_smtpPassword (\SmtpCred
a String
b -> SmtpCred
a{_smtpPassword= b})
smtpPort :: Lens' SmtpCred PortNumber
smtpPort :: Lens' SmtpCred PortNumber
smtpPort = (SmtpCred -> PortNumber)
-> (SmtpCred -> PortNumber -> SmtpCred)
-> Lens' SmtpCred PortNumber
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SmtpCred -> PortNumber
_smtpPort (\SmtpCred
a PortNumber
b -> SmtpCred
a{_smtpPort= b})

-- | This allows you to override the default settings from 'defSettings'
data PoolSettings = PoolSettings

  { -- | credentials for smtp connection
    PoolSettings -> SmtpCred
_poolCred      :: SmtpCred
   -- | allows overriding of the opening function, for example 'openPlain' or 'openTls'
  , PoolSettings -> SmtpCred -> IO SMTPConnection
_poolConnf     :: SmtpCred -> IO SMTPConnection
   -- | specify how long connections are kept open.
  , PoolSettings -> Double
_poolUnused    :: Double
   -- | how many connections per stripe.
  , PoolSettings -> Int
_poolStripeMax :: Int
  }

poolCred      :: Lens' PoolSettings SmtpCred
poolCred :: Lens' PoolSettings SmtpCred
poolCred      = (PoolSettings -> SmtpCred)
-> (PoolSettings -> SmtpCred -> PoolSettings)
-> Lens' PoolSettings SmtpCred
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PoolSettings -> SmtpCred
_poolCred (\PoolSettings
a SmtpCred
b -> PoolSettings
a{_poolCred=b})
poolConnf     :: Lens' PoolSettings (SmtpCred -> IO SMTPConnection)
poolConnf :: Lens' PoolSettings (SmtpCred -> IO SMTPConnection)
poolConnf      = (PoolSettings -> SmtpCred -> IO SMTPConnection)
-> (PoolSettings
    -> (SmtpCred -> IO SMTPConnection) -> PoolSettings)
-> Lens' PoolSettings (SmtpCred -> IO SMTPConnection)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PoolSettings -> SmtpCred -> IO SMTPConnection
_poolConnf (\PoolSettings
a SmtpCred -> IO SMTPConnection
b -> PoolSettings
a{_poolConnf=b})
poolUnused    :: Lens' PoolSettings Double
poolUnused :: Lens' PoolSettings Double
poolUnused      = (PoolSettings -> Double)
-> (PoolSettings -> Double -> PoolSettings)
-> Lens' PoolSettings Double
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PoolSettings -> Double
_poolUnused (\PoolSettings
a Double
b -> PoolSettings
a{_poolUnused=b})
poolStripeMax :: Lens' PoolSettings Int
poolStripeMax :: Lens' PoolSettings Int
poolStripeMax      = (PoolSettings -> Int)
-> (PoolSettings -> Int -> PoolSettings) -> Lens' PoolSettings Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PoolSettings -> Int
_poolStripeMax (\PoolSettings
a Int
b -> PoolSettings
a{_poolStripeMax=b})

-- | Create settings with good defaults from 'SmtpCred'.
defSettings :: SmtpCred -> PoolSettings
defSettings :: SmtpCred -> PoolSettings
defSettings SmtpCred
cred = PoolSettings
  { _poolCred :: SmtpCred
_poolCred = SmtpCred
cred
  , _poolConnf :: SmtpCred -> IO SMTPConnection
_poolConnf = SmtpCred -> IO SMTPConnection
openTls
  , _poolUnused :: Double
_poolUnused = Double
60
  , _poolStripeMax :: Int
_poolStripeMax = Int
5
  }

openPlain :: SmtpCred -> IO SMTPConnection
openPlain :: SmtpCred -> IO SMTPConnection
openPlain SmtpCred
smtp = String -> PortNumber -> IO SMTPConnection
connectSMTPPort (SmtpCred
smtp SmtpCred -> Getting String SmtpCred String -> String
forall s a. s -> Getting a s a -> a
^. Getting String SmtpCred String
Lens' SmtpCred String
smtpHost) (SmtpCred
smtp SmtpCred -> Getting PortNumber SmtpCred PortNumber -> PortNumber
forall s a. s -> Getting a s a -> a
^. Getting PortNumber SmtpCred PortNumber
Lens' SmtpCred PortNumber
smtpPort)

openTls :: SmtpCred -> IO SMTPConnection
openTls :: SmtpCred -> IO SMTPConnection
openTls = Settings -> SmtpCred -> IO SMTPConnection
openTls' Settings
defaultSettingsSMTPSTARTTLS

openTls' :: Settings -> SmtpCred -> IO SMTPConnection
openTls' :: Settings -> SmtpCred -> IO SMTPConnection
openTls' Settings
def SmtpCred
smtp = String -> Settings -> IO SMTPConnection
connectSMTPSTARTTLSWithSettings (SmtpCred
smtp SmtpCred -> Getting String SmtpCred String -> String
forall s a. s -> Getting a s a -> a
^. Getting String SmtpCred String
Lens' SmtpCred String
smtpHost) (Settings -> IO SMTPConnection) -> Settings -> IO SMTPConnection
forall a b. (a -> b) -> a -> b
$ Settings
def {
    sslPort = smtp ^. smtpPort
  }


-- | Construct a connection pool from settings.
smtpPool :: PoolSettings -> IO (Pool SMTPConnection)
smtpPool :: PoolSettings -> IO (Pool SMTPConnection)
smtpPool =
  PoolConfig SMTPConnection -> IO (Pool SMTPConnection)
forall a. PoolConfig a -> IO (Pool a)
newPool (PoolConfig SMTPConnection -> IO (Pool SMTPConnection))
-> (PoolSettings -> PoolConfig SMTPConnection)
-> PoolSettings
-> IO (Pool SMTPConnection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolSettings -> PoolConfig SMTPConnection
createPoolConfig

-- | allows manipulation of the underlying resourcepool config
createPoolConfig :: PoolSettings -> PoolConfig SMTPConnection
createPoolConfig :: PoolSettings -> PoolConfig SMTPConnection
createPoolConfig PoolSettings
smtp =
    IO SMTPConnection
-> (SMTPConnection -> IO ())
-> Double
-> Int
-> PoolConfig SMTPConnection
forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
defaultPoolConfig
      (do
        SMTPConnection
conn <- PoolSettings
smtp PoolSettings
-> Getting
     (SmtpCred -> IO SMTPConnection)
     PoolSettings
     (SmtpCred -> IO SMTPConnection)
-> SmtpCred
-> IO SMTPConnection
forall s a. s -> Getting a s a -> a
^. Getting
  (SmtpCred -> IO SMTPConnection)
  PoolSettings
  (SmtpCred -> IO SMTPConnection)
Lens' PoolSettings (SmtpCred -> IO SMTPConnection)
poolConnf (SmtpCred -> IO SMTPConnection) -> SmtpCred -> IO SMTPConnection
forall a b. (a -> b) -> a -> b
$ PoolSettings
smtp PoolSettings -> Getting SmtpCred PoolSettings SmtpCred -> SmtpCred
forall s a. s -> Getting a s a -> a
^. Getting SmtpCred PoolSettings SmtpCred
Lens' PoolSettings SmtpCred
poolCred
        SMTPConnection -> SmtpCred -> IO ()
authorize SMTPConnection
conn (PoolSettings
smtp PoolSettings -> Getting SmtpCred PoolSettings SmtpCred -> SmtpCred
forall s a. s -> Getting a s a -> a
^. Getting SmtpCred PoolSettings SmtpCred
Lens' PoolSettings SmtpCred
poolCred)
        SMTPConnection -> IO SMTPConnection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SMTPConnection
conn
      )
      SMTPConnection -> IO ()
closeSMTP
      (PoolSettings
smtp PoolSettings -> Getting Double PoolSettings Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double PoolSettings Double
Lens' PoolSettings Double
poolUnused)
      (PoolSettings
smtp PoolSettings -> Getting Int PoolSettings Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int PoolSettings Int
Lens' PoolSettings Int
poolStripeMax )

handleAny :: (SomeException -> IO a) -> IO a -> IO a
handleAny :: forall a. (SomeException -> IO a) -> IO a -> IO a
handleAny = (SomeException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle

-- | we need to auth only once per connection.
--   this is annoying because we want to crash on failure to auth.
authorize :: SMTPConnection -> SmtpCred -> IO ()
authorize :: SMTPConnection -> SmtpCred -> IO ()
authorize SMTPConnection
conn SmtpCred
smtp = do
  (SomeException -> IO ()) -> IO () -> IO ()
forall a. (SomeException -> IO a) -> IO a -> IO a
handleAny
    (\SomeException
ex -> do
       SMTPConnection -> IO ()
closeSMTP SMTPConnection
conn -- don't leak
       SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO SomeException
ex) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
isSuccess <-
      AuthType -> String -> String -> SMTPConnection -> IO Bool
authenticate AuthType
LOGIN (SmtpCred
smtp SmtpCred -> Getting String SmtpCred String -> String
forall s a. s -> Getting a s a -> a
^. Getting String SmtpCred String
Lens' SmtpCred String
smtpLogin) (SmtpCred
smtp SmtpCred -> Getting String SmtpCred String -> String
forall s a. s -> Getting a s a -> a
^. Getting String SmtpCred String
Lens' SmtpCred String
smtpPassword) SMTPConnection
conn
    if Bool
isSuccess
      then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      else ServiceAuthFailure SmtpCred -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ServiceAuthFailure SmtpCred -> IO ())
-> ServiceAuthFailure SmtpCred -> IO ()
forall a b. (a -> b) -> a -> b
$
           SmtpCred -> ServiceAuthFailure SmtpCred
forall a. a -> ServiceAuthFailure a
ServiceAuthFailure (SmtpCred -> ServiceAuthFailure SmtpCred)
-> SmtpCred -> ServiceAuthFailure SmtpCred
forall a b. (a -> b) -> a -> b
$
           (String -> Identity String) -> SmtpCred -> Identity SmtpCred
Lens' SmtpCred String
smtpPassword ((String -> Identity String) -> SmtpCred -> Identity SmtpCred)
-> String -> SmtpCred -> SmtpCred
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
"obfuscated, see the running instance CLI" (SmtpCred -> SmtpCred) -> SmtpCred -> SmtpCred
forall a b. (a -> b) -> a -> b
$ SmtpCred
smtp

emailOptions :: Parser SmtpCred
emailOptions :: Parser SmtpCred
emailOptions =
  String -> String -> String -> PortNumber -> SmtpCred
SmtpCred (String -> String -> String -> PortNumber -> SmtpCred)
-> Parser String
-> Parser (String -> String -> PortNumber -> SmtpCred)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"smtp-pass" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SMTP-PASS" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
     String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
       String
"the smtp password, in case of mailjet: https://app.mailjet.com/transactional/smtp") Parser (String -> String -> PortNumber -> SmtpCred)
-> Parser String -> Parser (String -> PortNumber -> SmtpCred)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"smtp-login" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SMTP-LOGIN" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
     String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
       String
"the smtp login name, in case of mailjet: https://app.mailjet.com/transactional/smtp") Parser (String -> PortNumber -> SmtpCred)
-> Parser String -> Parser (PortNumber -> SmtpCred)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"smtp-host" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SMTP-HOST" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"in-v3.mailjet.com" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
     Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
     String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"the smtp host, excluding port") Parser (PortNumber -> SmtpCred)
-> Parser PortNumber -> Parser SmtpCred
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  ReadM PortNumber
-> Mod OptionFields PortNumber -> Parser PortNumber
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM PortNumber
forall a. Read a => ReadM a
auto
    (String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"smtp-port" Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. String -> Mod f a
help String
"The port on which the smtp server listens" Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<>
     Mod OptionFields PortNumber
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<>
     PortNumber -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value PortNumber
587 Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<>
     String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SMTP-PORT")

-- | Send a 'Mail' with help of a connection pool.
sendEmail :: MonadIO m => Pool SMTPConnection -> Mail -> m ()
sendEmail :: forall (m :: * -> *).
MonadIO m =>
Pool SMTPConnection -> Mail -> m ()
sendEmail Pool SMTPConnection
pool = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Mail -> IO ()) -> Mail -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pool SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a r. Pool a -> (a -> IO r) -> IO r
withResource Pool SMTPConnection
pool ((SMTPConnection -> IO ()) -> IO ())
-> (Mail -> SMTPConnection -> IO ()) -> Mail -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Mail -> SMTPConnection -> IO ()
Mail -> SMTPConnection -> IO ()
sendMail