{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {- | Network operations using the package. -} module Network.Mail.Assumpta.Internal.Net where import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Class import Data.Default (def) import qualified Network.Connection as NC import Network.Mail.Assumpta.Connection as C -- -- -- Network types and ops type Port = Int type HostName = String -- | Network handle, containing enough -- information to both communicate a connection, -- and upgrade to TLS. data Handle = Handle { hConn :: !NC.Connection , hContext :: !NC.ConnectionContext } -- Implementation of 'Connection' using -- the -- package. instance Connection Handle where type Cstrt Handle = MonadIO type Params Handle = NC.ConnectionParams open params = do ctx <- liftIO NC.initConnectionContext conn <- liftIO $ NC.connectTo ctx params return $ Handle conn ctx close = liftIO . NC.connectionClose . hConn send h bs = liftIO $ NC.connectionPut (hConn h) bs recv h = liftIO $ NC.connectionGet (hConn h) 2048 upgrade h = let conn = hConn h ctx = hContext h tls = defaultTLSSettings in liftIO $ NC.connectionSetSecure ctx conn tls -- | default TLS settings defaultTLSSettings :: NC.TLSSettings defaultTLSSettings = def mkParams :: HostName -> Int -> NC.ConnectionParams mkParams hostname port = NC.ConnectionParams { NC.connectionHostname = hostname , NC.connectionPort = fromIntegral port , NC.connectionUseSecure = Nothing , NC.connectionUseSocks = Nothing } -- | Open a network 'Handle' with the specified 'NC.ConnectionParams' openParams :: MonadIO m => NC.ConnectionParams -> m Handle openParams = C.open -- | Open a network 'Handle' to the specified hostname and port open :: MonadIO m => HostName -> Port -> m Handle open host port = let p = mkParams host port in openParams p -- | Open a secure network 'Handle' to the specified hostname and port -- using the default TLS settings ('defaultTLSSettings') openTls :: MonadIO m => HostName -> Port -> m Handle openTls host port = let p = (mkParams host port) { NC.connectionUseSecure = Just defaultTLSSettings } in openParams p -- | Close a network 'Handle' close :: MonadIO m => Handle -> m () close = C.close -- | @withHandleParams p a@ -- -- Given some parameters @p@ (hostname, port etc) for opening a 'Handle': -- open a handle, run some action @a@ with it, then -- close. withHandleParams :: (MonadMask m, MonadIO m) => NC.ConnectionParams -> (Handle -> m b) -> m b withHandleParams = C.withConnection -- | @withHandle hostname port a@ -- -- Open a 'Handle' to the specified @hostname@ and @port@, -- run some action @a@ with it, then -- close. withHandle :: (MonadMask m, MonadIO m) => HostName -> Port -> (Handle -> m b) -> m b withHandle host port = let p = mkParams host port in withHandleParams p -- | @withSecureHandle hostname port a@ -- -- Open a secure 'Handle' to the specified @hostname@ and @port@, -- run some action @a@ with it, then -- close. withSecureHandle :: (MonadMask m, MonadIO m) => HostName -> Port -> (Handle -> m b) -> m b withSecureHandle host port = let p = (mkParams host port) { NC.connectionUseSecure = Just defaultTLSSettings } in withHandleParams p