module Smtpbz.Internal.Manager
  ( Manager(..)
  , newManager
  ) where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Default (def)
import Network.HTTP.Conduit qualified as Http
import Network.Connection (TLSSettings(..))
import Network.TLS (Supported(..), EMSMode(AllowEMS), clientSupported)


-- A thin wrapper over 'Http.Manager' that API methods require.
--
-- Use 'newManager' to create a 'Manager' that is functionally equivalent to the
-- the default 'Http.Manager' but compatible with smtpbz servers. Alternatively,
-- you can wrap your own 'Http.Manager' if you're certain that it is compatible
-- with smtpbz servers.
newtype Manager = Manager { Manager -> Manager
unManager :: Http.Manager }

-- | Create a 'Manager' that is functionally equivalent to the default 'Http.Manager'
-- but compatible with smtpbz servers.
--
-- Currently, this means relaxing the Extended Main Secret extension requirement.
newManager :: MonadIO m => m Manager
newManager :: forall (m :: * -> *). MonadIO m => m Manager
newManager =
  (Manager -> Manager) -> m Manager -> m Manager
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Manager -> Manager
Manager (IO Manager -> m Manager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ManagerSettings -> IO Manager
Http.newManager (TLSSettings -> Maybe SockSettings -> ManagerSettings
Http.mkManagerSettings TLSSettings
tlsSettings Maybe SockSettings
forall a. Maybe a
Nothing)))

-- | I'm unsure why http-client's API is so bad, but
-- we have to do a little bit of dancing here to cover
-- every possibility.
tlsSettings :: TLSSettings
tlsSettings :: TLSSettings
tlsSettings =
  case TLSSettings
defaultTlsSettings of
    settings :: TLSSettings
settings@(TLSSettingsSimple {settingClientSupported :: TLSSettings -> Supported
settingClientSupported = Supported
supported}) ->
      TLSSettings
settings {settingClientSupported = supported {supportedExtendedMainSecret = AllowEMS}}
    TLSSettings ClientParams
params ->
      ClientParams -> TLSSettings
TLSSettings ClientParams
params {clientSupported = (clientSupported params) {supportedExtendedMainSecret = AllowEMS}}

defaultTlsSettings :: TLSSettings
defaultTlsSettings :: TLSSettings
defaultTlsSettings =
  TLSSettings
forall a. Default a => a
def