@@ -20,6 +20,8 @@ module Network.Wai.Handler.WarpTLS (
2020 , defaultTlsSettings
2121 , tlsSettings
2222 , tlsSettingsMemory
23+ , tlsSettingsChain
24+ , tlsSettingsChainMemory
2325 , OnInsecure (..)
2426 -- * Runner
2527 , runTLS
@@ -56,10 +58,13 @@ import System.IO.Error (isEOFError)
5658data TLSSettings = TLSSettings {
5759 certFile :: FilePath
5860 -- ^ File containing the certificate.
61+ , chainCertFiles :: [FilePath]
62+ -- ^ Files containing chain certificates.
5963 , keyFile :: FilePath
64+ -- ^ File containing the key
6065 , certMemory :: Maybe S.ByteString
66+ , chainCertsMemory :: [S.ByteString]
6167 , keyMemory :: Maybe S.ByteString
62− -- ^ File containing the key
6368 , onInsecure :: OnInsecure
6469 -- ^ Do we allow insecure connections with this server as well? Default
6570 -- is a simple text response stating that a secure connection is required.
@@ -105,8 +110,10 @@ data TLSSettings = TLSSettings {
105110defaultTlsSettings :: TLSSettings
106111defaultTlsSettings = TLSSettings {
107112 certFile = "certificate.pem"
113+ , chainCertFiles = []
108114 , keyFile = "key.pem"
109115 , certMemory = Nothing
116+ , chainCertsMemory = []
110117 , keyMemory = Nothing
111118 , onInsecure = DenyInsecure "This server only accepts secure HTTPS connections."
112119 , tlsLogging = def
@@ -151,6 +158,21 @@ tlsSettings cert key = defaultTlsSettings {
151158 , keyFile = key
152159 }
153160
161+-- | A smart constructor for 'TLSSettings' that allows specifying
162+-- chain certificates.
163+--
164+-- Since 3.0.3
165+tlsSettingsChain
166+ :: FilePath -- ^ Certificate file
167+ -> [FilePath] -- ^ Chain certificate files
168+ -> FilePath -- ^ Key file
169+ -> TLSSettings
170+tlsSettingsChain cert chainCerts key = defaultTlsSettings {
171+ certFile = cert
172+ , chainCertFiles = chainCerts
173+ , keyFile = key
174+ }
175+
154176-- | A smart constructor for 'TLSSettings', but uses in-memory representations
155177-- of the certificate and key
156178--
@@ -164,6 +186,21 @@ tlsSettingsMemory cert key = defaultTlsSettings
164186 , keyMemory = Just key
165187 }
166188
189+-- | A smart constructor for 'TLSSettings', but uses in-memory representations
190+-- of the certificate and key
191+--
192+-- Since 3.0.3
193+tlsSettingsChainMemory
194+ :: S.ByteString -- ^ Certificate bytes
195+ -> [S.ByteString] -- ^ Chain certificate bytes
196+ -> S.ByteString -- ^ Key bytes
197+ -> TLSSettings
198+tlsSettingsChainMemory cert chainCerts key = defaultTlsSettings
199+ { certMemory = Just cert
200+ , chainCertsMemory = chainCerts
201+ , keyMemory = Just key
202+ }
203+
167204----------------------------------------------------------------
168205
169206
@@ -182,11 +219,14 @@ runTLS tset set app = withSocketsDo $
182219runTLSSocket :: TLSSettings -> Settings -> Socket -> Application -> IO ()
183220runTLSSocket tlsset@TLSSettings{..} set sock app = do
184221 credential <- case (certMemory, keyMemory) of
185− (Nothing, Nothing) -> either error id <$> TLS.credentialLoadX509 certFile keyFile
222+ (Nothing, Nothing) ->
223+ either error id <$>
224+ TLS.credentialLoadX509Chain certFile chainCertFiles keyFile
186225 (mcert, mkey) -> do
187226 cert <- maybe (S.readFile certFile) return mcert
188227 key <- maybe (S.readFile keyFile) return mkey
189− either error return $ TLS.credentialLoadX509FromMemory cert key
228+ either error return $
229+ TLS.credentialLoadX509ChainFromMemory cert chainCertsMemory key
190230 runTLSSocket' tlsset set credential sock app
191231
192232runTLSSocket' :: TLSSettings -> Settings -> TLS.Credential -> Socket -> Application -> IO ()