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

{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}

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

      -- * Initialization
      withIsmtp
    )
    where

import qualified Data.ByteString.Char8 as Bc
import Control.ContStuff
import Control.Monad.Trans.Control
import Control.Exception.Lifted as Ex
import Network
import Network.DnsCache
import Network.Smtp.Simple
import Network.Smtp.Types
import System.IO


-- | 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


-- | 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, MonadBaseControl IO m) =>
    Domain -> Bool -> MailT 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 (Bc.unpack 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, MonadBaseControl IO m, MonadIO m) =>
    HostName -> PortID -> MailT a m a -> m a
withSmtpConn host port c =
    Ex.bracket connect (liftIO . hClose) $ \h ->
        let (cfg, stateComp) = sendMail_ (defSendMail h h) c
        in evalStateT cfg stateComp

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