happstack-server-tls 7.0.4 → 7.1.0
raw patch · 2 files changed
+9/−3 lines, 2 files
Files
happstack-server-tls.cabal view
@@ -1,5 +1,5 @@ Name: happstack-server-tls-Version: 7.0.4+Version: 7.1.0 Synopsis: extend happstack-server with https:// support (TLS/SSL) Description: extend happstack-server with https:// support (TLS/SSL) Homepage: http://www.happstack.com/
src/Happstack/Server/Internal/TLS.hs view
@@ -38,6 +38,7 @@ tlsPort :: Int -- port (usually 443) , tlsCert :: FilePath -- path to SSL certificate , tlsKey :: FilePath -- path to SSL private key+ , tlsCA :: Maybe FilePath -- PEM encoded list of CA certificates , tlsTimeout :: Int -- kill connect of timeout (in seconds) , tlsLogAccess :: Maybe (LogAccess UTCTime) -- see 'logMAccess' , tlsValidator :: Maybe (Response -> IO Response) -- ^ a function to validate the output on-the-fly@@ -49,6 +50,7 @@ TLSConf { tlsPort = 443 , tlsCert = "" , tlsKey = ""+ , tlsCA = Nothing , tlsTimeout = 30 , tlsLogAccess = Just logMAccess , tlsValidator = Nothing@@ -68,12 +70,16 @@ -- httpsOnSocket :: FilePath -- ^ path to ssl certificate -> FilePath -- ^ path to ssl private key+ -> Maybe FilePath -- ^ path to PEM encoded list of CA certificates -> Socket -- ^ listening socket (on which listen() has been called, but not accept()) -> IO HTTPS-httpsOnSocket cert key socket =+httpsOnSocket cert key mca socket = do ctx <- SSL.context SSL.contextSetPrivateKeyFile ctx key SSL.contextSetCertificateFile ctx cert+ case mca of+ Nothing -> return ()+ (Just ca) -> SSL.contextSetCAFile ctx ca SSL.contextSetDefaultCiphers ctx certOk <- SSL.contextCheckPrivateKey ctx@@ -105,7 +111,7 @@ listenTLS tlsConf hand = do withOpenSSL $ return () tlsSocket <- listenOn (tlsPort tlsConf)- https <- httpsOnSocket (tlsCert tlsConf) (tlsKey tlsConf) tlsSocket+ https <- httpsOnSocket (tlsCert tlsConf) (tlsKey tlsConf) (tlsCA tlsConf) tlsSocket listenTLS' (tlsTimeout tlsConf) (tlsLogAccess tlsConf) tlsSocket https hand -- | low-level https:// 'Request'/'Response' loop