{-# LANGUAGE ScopedTypeVariables #-}

module Network.Mail.Postie
  ( run,
    -- | Runs server with a given application on a specified port
    runSettings,
    -- | Runs server with a given application and settings
    runSettingsSocket,

    -- * Application
    module Network.Mail.Postie.Types,

    -- * Settings
    module Network.Mail.Postie.Settings,

    -- * Address
    module Network.Mail.Postie.Address,

    -- * Exceptions
    UnexpectedEndOfInputException,
    TooMuchDataException,

    -- * Re-exports
    P.Producer,
    P.Consumer,
    P.runEffect,
    (P.>->),
  )
where

import Control.Concurrent
import Control.Exception as E
import Control.Monad (forever, void)
import Network.Socket
import Network.TLS (ServerParams)
import qualified Pipes as P
import System.Timeout
import Network.Mail.Postie.Address
import Network.Mail.Postie.Connection
import Network.Mail.Postie.Pipes (TooMuchDataException, UnexpectedEndOfInputException)
import Network.Mail.Postie.Session
import Network.Mail.Postie.Settings
import Network.Mail.Postie.Types

run :: Int -> Application -> IO ()
run :: Int -> Application -> IO ()
run port :: Int
port = Settings -> Application -> IO ()
runSettings (Settings
forall a. Default a => a
def {settingsPort :: PortNumber
settingsPort = Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
port})

runSettings :: Settings -> Application -> IO ()
runSettings :: Settings -> Application -> IO ()
runSettings settings :: Settings
settings app :: Application
app = IO () -> IO ()
forall a. IO a -> IO a
withSocketsDo
  (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Socket -> (Socket -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (PortNumber -> IO Socket
listenOn PortNumber
port) Socket -> IO ()
close
  ((Socket -> IO ()) -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sock :: Socket
sock ->
    Settings -> Socket -> Application -> IO ()
runSettingsSocket Settings
settings Socket
sock Application
app
  where
    port :: PortNumber
port = Settings -> PortNumber
settingsPort Settings
settings
    listenOn :: PortNumber -> IO Socket
listenOn portNum :: PortNumber
portNum =
      IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
        (Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_INET6 SocketType
Stream ProtocolNumber
defaultProtocol)
        Socket -> IO ()
close
        ( \sock :: Socket
sock -> do
            Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
ReuseAddr 1
            Socket -> SockAddr -> IO ()
bind Socket
sock (PortNumber -> FlowInfo -> HostAddress6 -> FlowInfo -> SockAddr
SockAddrInet6 PortNumber
portNum 0 (0, 0, 0, 0) 0)
            Socket -> Int -> IO ()
listen Socket
sock Int
maxListenQueue
            Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock
        )

runSettingsSocket :: Settings -> Socket -> Application -> IO ()
runSettingsSocket :: Settings -> Socket -> Application -> IO ()
runSettingsSocket settings :: Settings
settings sock :: Socket
sock =
  Settings -> IO (Connection, SockAddr) -> Application -> IO ()
runSettingsConnection Settings
settings IO (Connection, SockAddr)
getConn
  where
    getConn :: IO (Connection, SockAddr)
getConn = do
      (s :: Socket
s, sa :: SockAddr
sa) <- Socket -> IO (Socket, SockAddr)
accept Socket
sock
      Connection
conn <- Socket -> IO Connection
mkSocketConnection Socket
s
      (Connection, SockAddr) -> IO (Connection, SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection
conn, SockAddr
sa)

runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
runSettingsConnection settings :: Settings
settings getConn :: IO (Connection, SockAddr)
getConn app :: Application
app = do
  Maybe ServerParams
serverParams <- IO (Maybe ServerParams)
mkServerParams'
  Settings
-> IO (IO Connection, SockAddr)
-> Maybe ServerParams
-> Application
-> IO ()
runSettingsConnectionMaker Settings
settings (Maybe ServerParams -> IO (IO Connection, SockAddr)
getConnMaker Maybe ServerParams
serverParams) Maybe ServerParams
serverParams Application
app
  where
    getConnMaker :: Maybe ServerParams -> IO (IO Connection, SockAddr)
getConnMaker serverParams :: Maybe ServerParams
serverParams = do
      (conn :: Connection
conn, sa :: SockAddr
sa) <- IO (Connection, SockAddr)
getConn
      let mkConn :: IO Connection
mkConn = do
            case Settings -> Maybe StartTLSPolicy
settingsStartTLSPolicy Settings
settings of
              Just ConnectWithTLS -> do
                let (Just sp :: ServerParams
sp) = Maybe ServerParams
serverParams
                Connection -> ServerParams -> IO ()
connSetSecure Connection
conn ServerParams
sp
              _ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn
      (IO Connection, SockAddr) -> IO (IO Connection, SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (IO Connection
mkConn, SockAddr
sa)
    mkServerParams' :: IO (Maybe ServerParams)
mkServerParams' =
      case Settings -> Maybe TLSSettings
settingsTLS Settings
settings of
        Just tls :: TLSSettings
tls -> do
          ServerParams
serverParams <- TLSSettings -> IO ServerParams
mkServerParams TLSSettings
tls
          Maybe ServerParams -> IO (Maybe ServerParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerParams -> Maybe ServerParams
forall a. a -> Maybe a
Just ServerParams
serverParams)
        _ -> Maybe ServerParams -> IO (Maybe ServerParams)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ServerParams
forall a. Maybe a
Nothing

runSettingsConnectionMaker ::
  Settings ->
  IO (IO Connection, SockAddr) ->
  Maybe ServerParams ->
  Application ->
  IO ()
runSettingsConnectionMaker :: Settings
-> IO (IO Connection, SockAddr)
-> Maybe ServerParams
-> Application
-> IO ()
runSettingsConnectionMaker settings :: Settings
settings getConnMaker :: IO (IO Connection, SockAddr)
getConnMaker serverParams :: Maybe ServerParams
serverParams app :: Application
app = do
  Settings -> IO ()
settingsBeforeMainLoop Settings
settings
  IO Any -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Any -> IO ()) -> IO Any -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ do
    (mkConn :: IO Connection
mkConn, sockAddr :: SockAddr
sockAddr) <- IO (IO Connection, SockAddr)
getConnLoop
    IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkIOWithUnmask (((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \unmask :: forall a. IO a -> IO a
unmask -> do
      SessionID
sessionID <- IO SessionID
mkSessionID
      IO Connection
-> (Connection -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Connection
mkConn Connection -> IO ()
connClose ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \conn :: Connection
conn ->
        IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO () -> IO (Maybe ())
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
maxDuration
          (IO () -> IO (Maybe ())) -> IO () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall a. IO a -> IO a
unmask
            (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (Maybe SessionID -> SomeException -> IO ()
onE (Maybe SessionID -> SomeException -> IO ())
-> Maybe SessionID -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ SessionID -> Maybe SessionID
forall a. a -> Maybe a
Just SessionID
sessionID)
            (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO () -> IO () -> IO ()
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (SessionID -> SockAddr -> IO ()
onOpen SessionID
sessionID SockAddr
sockAddr) (SessionID -> IO ()
onClose SessionID
sessionID)
          (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SessionEnv -> IO ()
runSession (SessionID
-> Application
-> Settings
-> Connection
-> Maybe ServerParams
-> SessionEnv
mkSessionEnv SessionID
sessionID Application
app Settings
settings Connection
conn Maybe ServerParams
serverParams)
  where
    getConnLoop :: IO (IO Connection, SockAddr)
getConnLoop = IO (IO Connection, SockAddr)
getConnMaker IO (IO Connection, SockAddr)
-> (IOException -> IO (IO Connection, SockAddr))
-> IO (IO Connection, SockAddr)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(IOException
e :: IOException) -> do
      Maybe SessionID -> SomeException -> IO ()
onE Maybe SessionID
forall a. Maybe a
Nothing (IOException -> SomeException
forall e. Exception e => e -> SomeException
toException IOException
e)
      Int -> IO ()
threadDelay 1000000
      IO (IO Connection, SockAddr)
getConnLoop
    onE :: Maybe SessionID -> SomeException -> IO ()
onE = Settings -> Maybe SessionID -> SomeException -> IO ()
settingsOnException Settings
settings
    onOpen :: SessionID -> SockAddr -> IO ()
onOpen = Settings -> SessionID -> SockAddr -> IO ()
settingsOnOpen Settings
settings
    onClose :: SessionID -> IO ()
onClose = Settings -> SessionID -> IO ()
settingsOnClose Settings
settings
    maxDuration :: Int
maxDuration = Settings -> Int
settingsTimeout Settings
settings Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000000