module Web.Postie.Settings(
Settings(..)
, TLSSettings(..)
, StartTLSPolicy(..)
, settingsStartTLSPolicy
, defaultExceptionHandler
, mkServerParams
, def
) where
import Web.Postie.Types
import Web.Postie.Address
import Web.Postie.SessionID
import Network (HostName, PortID(..))
import System.IO (hPrint, stderr)
import System.IO.Error (ioeGetErrorType)
import Data.ByteString (ByteString)
import Network.Socket (SockAddr)
import qualified Network.TLS as TLS
import qualified Network.TLS.Extra.Cipher as TLS
import Data.Default.Class
import Control.Exception
import GHC.IO.Exception (IOErrorType(..))
import Control.Applicative ((<$>))
data Settings = Settings {
settingsPort :: PortID
, settingsTimeout :: Int
, settingsMaxDataSize :: Int
, settingsHost :: Maybe HostName
, settingsTLS :: Maybe TLSSettings
, settingsOnException :: Maybe SessionID -> SomeException -> IO ()
, settingsBeforeMainLoop :: IO ()
, settingsOnOpen :: SessionID -> SockAddr -> IO ()
, settingsOnClose :: SessionID -> IO ()
, settingsOnStartTLS :: SessionID -> IO ()
, settingsOnHello :: SessionID -> ByteString -> IO HandlerResponse
, settingsOnMailFrom :: SessionID -> Address -> IO HandlerResponse
, settingsOnRecipient :: SessionID -> Address -> IO HandlerResponse
}
instance Default Settings where
def = defaultSettings
defaultSettings :: Settings
defaultSettings = Settings {
settingsPort = PortNumber 3001
, settingsTimeout = 1800
, settingsMaxDataSize = 32000
, settingsHost = Nothing
, settingsTLS = Nothing
, settingsOnException = defaultExceptionHandler
, settingsBeforeMainLoop = return ()
, settingsOnOpen = \_ _ -> return ()
, settingsOnClose = const $ return ()
, settingsOnStartTLS = const $ return ()
, settingsOnHello = void
, settingsOnMailFrom = void
, settingsOnRecipient = void
}
where
void _ _ = return Accepted
data TLSSettings = TLSSettings {
certFile :: FilePath
, keyFile :: FilePath
, security :: StartTLSPolicy
, tlsLogging :: TLS.Logging
, tlsAllowedVersions :: [TLS.Version]
, tlsCiphers :: [TLS.Cipher]
}
instance Default TLSSettings where
def = defaultTLSSettings
data StartTLSPolicy = AllowStartTLS
| DemandStartTLS
| ConnectWithTLS
deriving (Eq, Show)
defaultTLSSettings :: TLSSettings
defaultTLSSettings = TLSSettings {
certFile = "certificate.pem"
, keyFile = "key.pem"
, security = DemandStartTLS
, tlsLogging = def
, tlsAllowedVersions = [TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12]
, tlsCiphers = TLS.ciphersuite_all
}
settingsStartTLSPolicy :: Settings -> Maybe StartTLSPolicy
settingsStartTLSPolicy settings = security `fmap` settingsTLS settings
mkServerParams :: TLSSettings -> IO TLS.ServerParams
mkServerParams tlsSettings = do
credentials <- loadCredentials
return def {
TLS.serverShared = def {
TLS.sharedCredentials = TLS.Credentials [credentials]
},
TLS.serverSupported = def {
TLS.supportedCiphers = tlsCiphers tlsSettings
, TLS.supportedVersions = tlsAllowedVersions tlsSettings
}
}
where
loadCredentials = either (throw . TLS.Error_Certificate) id <$>
TLS.credentialLoadX509 (certFile tlsSettings) (keyFile tlsSettings)
defaultExceptionHandler :: Maybe SessionID -> SomeException -> IO ()
defaultExceptionHandler _ e = throwIO e `catches` handlers
where
handlers = [Handler ah, Handler oh, Handler tlsh, Handler th, Handler sh]
ah :: AsyncException -> IO ()
ah ThreadKilled = return ()
ah x = hPrint stderr x
oh :: IOException -> IO ()
oh x
| et == ResourceVanished || et == InvalidArgument = return ()
| otherwise = hPrint stderr x
where
et = ioeGetErrorType x
tlsh :: TLS.TLSException -> IO ()
tlsh TLS.Terminated{} = return ()
tlsh TLS.HandshakeFailed{} = return ()
tlsh x = hPrint stderr x
th :: TLS.TLSError -> IO ()
th TLS.Error_EOF = return ()
th (TLS.Error_Packet_Parsing _) = return ()
th (TLS.Error_Packet _) = return ()
th (TLS.Error_Protocol _) = return ()
th x = hPrint stderr x
sh :: SomeException -> IO ()
sh x = hPrint stderr x