Connect.hs

-- |
-- Module:     Network.Smtp.Connect
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  experimental
--
-- High level interfaces for networking.

{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}

module Network.Smtp.Connect
    ( -- * Connection
      withMxConn,
      withSmtpConn,

      -- * Initialization
      withIsmtp,

      -- * Utility functions
      ignoreSigPipe,
      withIgnoredSigPipe
    )
    where

import Control.ContStuff
import Control.Monad.IO.Peel
import Control.Exception.Peel as Ex
import Network
import Network.DnsCache
import Network.Smtp.Simple
import Network.Smtp.Types
import System.IO
import System.Posix.Signals


-- | Disable the /SIGPIPE/ signal, so our program doesn't die on broken
-- pipes.

ignoreSigPipe :: IO ()
ignoreSigPipe = () <$ installHandler sigPIPE Ignore Nothing


-- | Run the given computation with the /SIGPIPE/ signal disabled, so
-- our program doesn't die on broken pipes.

withIgnoredSigPipe :: IO a -> IO a
withIgnoredSigPipe =
    Ex.bracket (installHandler sigPIPE Ignore Nothing)
               (\old -> installHandler sigPIPE old Nothing)
    . const


-- | Perform some useful (but not necessarily needed) initialization
-- like disabling SIGPIPE and initializing sockets, run the given
-- computation and then clean up.

withIsmtp :: IO a -> IO a
withIsmtp = withSocketsDo . withIgnoredSigPipe


-- | Interface to 'withSmtpConn', which connects to the first mail
-- exchanger (MX) of the given domain on port 25.  The 'Bool' parameter
-- specifies whether to fall back to the given domain itself, if no MX
-- records can be found.

withMxConn ::
    (Applicative m, DnsMonad m, MonadPeelIO m) =>
    Domain -> Bool -> MailT (Either SomeException a) m a -> m a
withMxConn domain fallback c = do
    mMx <- resolveMX domain
    hostname <-
        case mMx of
          Just (mx:_)   -> return mx
          _ | fallback  -> return domain
            | otherwise -> throwIO $ userError "No MX records for domain"
    withSmtpConn hostname (PortNumber 25) c


-- | Connect to the specified SMTP server and run the given computation.
-- Note that there is also 'withMxConn', which resolves the MX server of
-- the given domain.

withSmtpConn :: forall a m. (Applicative m, MonadPeelIO m) =>
                HostName -> PortID -> MailT (Either SomeException a) m a -> m a
withSmtpConn host port c =
    Ex.bracket connect (liftIO . hClose) $ \h -> do
        sendMail_ (defSendMail h h) c

    where
    connect :: m Handle
    connect =
        liftIO $ do
            h <- connectTo host port
            hSetBuffering h NoBuffering
            hSetBinaryMode h True
            return h