mail-pool (empty) → 1.0.0
raw patch · 6 files changed
+227/−0 lines, 6 filesdep +HaskellNetdep +basedep +mail-poolsetup-changed
Dependencies added: HaskellNet, base, mail-pool, microlens, mime-mail, network, optparse-applicative, resource-pool
Files
- LICENSE +21/−0
- Readme.md +8/−0
- Setup.hs +2/−0
- app/mail.hs +42/−0
- mail-pool.cabal +59/−0
- src/Network/Mail/Pool.hs +95/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 Jappie Klooster++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Readme.md view
@@ -0,0 +1,8 @@+# Email pool++Preconfigured email connection pool on top of smtp.++I needed this in another long term project so I opensourced it.+Support gauranteed (by virtue of usage).++See example executable for usage.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/mail.hs view
@@ -0,0 +1,42 @@+-- | mail+module Main where++import Network.Mail.Mime+import Network.Mail.Pool+import Options.Applicative++main :: IO ()+main = do+ smtp <- readSettings+ putStrLn "smtp settings:"+ print smtp+ settings <- defSmtpPool smtp+ sendEmail settings email+ where+ email =+ (emptyMail+ Address+ {addressName = Just "beterjappie", addressEmail = "beterjappie@raster.click"})+ { mailTo =+ [ Address+ { addressName = Just "jappie"+ , addressEmail = "jappieklooster@hotmail.com"+ }+ ]+ , mailHeaders =+ [ ("Subject", "geweldig raster -- Raster")+ , ("Reply-To", "superpwnzormegaman@gmail.com")+ ]+ , mailParts =+ [ [ plainPart+ "Hello there, I'd like you to introduce you to rater.click. Click here for a quick demo. Or click here to unsubscribe."+ ]+ ]+ }++readSettings :: IO SmtpCred+readSettings =+ customExecParser (prefs showHelpOnError) $+ info+ (helper <*> emailOptions)+ (fullDesc <> Options.Applicative.header "Email" <> progDesc "Send an email")
+ mail-pool.cabal view
@@ -0,0 +1,59 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: d66253edc87b55628b42590d0cedfa990eebcdde14cbeb1482bfbb00a40eb41e++name: mail-pool+version: 1.0.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+author: Jappie Klooster+maintainer: jappieklooster@hotmail.com+copyright: 2019 Jappie Klooster+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+ LICENSE+ Readme.md++library+ exposed-modules:+ Network.Mail.Pool+ other-modules:+ Paths_mail_pool+ hs-source-dirs:+ src+ 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+ , base >=4.7 && <5+ , microlens+ , mime-mail+ , network+ , optparse-applicative+ , resource-pool+ default-language: Haskell2010++executable exe+ main-is: mail.hs+ other-modules:+ Paths_mail_pool+ hs-source-dirs:+ app+ 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+ , base >=4.7 && <5+ , mail-pool+ , microlens+ , mime-mail+ , network+ , optparse-applicative+ , resource-pool+ default-language: Haskell2010
+ src/Network/Mail/Pool.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE DeriveAnyClass #-}++module Network.Mail.Pool(+ module Network.Mail.Pool,+ module X+ ) where++import Control.Exception+import Control.Monad.IO.Class+import Data.Pool as X+import Lens.Micro+import Network.HaskellNet.SMTP 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, Show)+ deriving anyclass Exception++-- | We use smtp because it's an incredibly stable and well supported protocol+-- this prevents vendorlocking.+data SmtpCred = SmtpCred+ { _smtpPassword :: String+ , _smtpLogin :: String+ , _smtpHost :: String+ , _smtpPort :: PortNumber+ } deriving (Show)++smtpHost :: Lens' SmtpCred String+smtpHost = lens _smtpHost (\a b -> a{_smtpHost= b})+smtpLogin :: Lens' SmtpCred String+smtpLogin = lens _smtpLogin (\a b -> a{_smtpLogin= b})+smtpPassword :: Lens' SmtpCred String+smtpPassword = lens _smtpPassword (\a b -> a{_smtpPassword= b})+smtpPort :: Lens' SmtpCred PortNumber+smtpPort = lens _smtpPort (\a b -> a{_smtpPort= b})+++defSmtpPool :: MonadIO m => SmtpCred -> m (Pool SMTPConnection)+defSmtpPool smtp = do+ liftIO $+ createPool+ (authAndConnect smtp)+ closeSMTP+ 1 -- stripe, see docs, I think I just need 1: https://hackage.haskell.org/package/resource-pool-0.2.3.2/docs/Data-Pool.html+ 60 -- unused connections are kept open for a minute+ 5 -- max. 10 connections open per stripe++handleAny :: (SomeException -> IO a) -> IO a -> IO a+handleAny = handle++-- | we need to auth only once per connection.+-- this is annoying because we want to crash on failure to auth.+authAndConnect :: SmtpCred -> IO SMTPConnection+authAndConnect smtp = do+ conn <- connectSMTPPort (smtp ^. smtpHost) (smtp ^. smtpPort)+ handleAny+ (\ex -> do+ closeSMTP conn -- don't leak+ throwIO ex) $ do+ isSuccess <-+ authenticate LOGIN (smtp ^. smtpLogin) (smtp ^. smtpPassword) conn+ if isSuccess+ then pure conn+ else throwIO $+ ServiceAuthFailure $+ smtpPassword .~ "obfuscated, see the running instance CLI" $ smtp++emailOptions :: Parser SmtpCred+emailOptions =+ SmtpCred <$>+ strOption+ (long "smtp-pass" <> metavar "SMTP-PASS" <>+ help+ "the smtp password, in case of mailjet: https://app.mailjet.com/transactional/smtp") <*>+ strOption+ (long "smtp-login" <> metavar "SMTP-LOGIN" <>+ help+ "the smtp login name, in case of mailjet: https://app.mailjet.com/transactional/smtp") <*>+ strOption+ (long "smtp-host" <> metavar "SMTP-HOST" <> value "in-v3.mailjet.com" <>+ showDefault <>+ help "the smtp host, excluding port") <*>+ option+ auto+ (long "smtp-port" <> help "The port on which the smtp server listens" <>+ showDefault <>+ value 587 <>+ metavar "SMTP-PORT")++sendEmail :: MonadIO m => Pool SMTPConnection -> Mail -> m ()+sendEmail pool = liftIO . withResource pool . sendMimeMail2