@@ -33,18 +33,15 @@ import qualified Data.Conduit as C
3333import qualified Data.Conduit.List as CL
3434import Control.Exception (bracket, finally, handle)
3535import qualified Network.TLS.Extra as TLSExtra
36−import qualified Data.Certificate.X509 as X509
3736import qualified Data.ByteString as B
38−import qualified Data.Certificate.KeyRSA as KeyRSA
3937import Data.Conduit.Network (bindPort)
40−import Data.Either (rights)
4138import Control.Applicative ((<$>))
42−import qualified Data.PEM as PEM
4339import Data.Conduit.Network (sourceSocket, sinkSocket, acceptSafe)
4440import Data.Maybe (fromMaybe)
4541import qualified Data.IORef as I
4642import Control.Exception (Exception, throwIO)
4743import Data.Typeable (Typeable)
44+import Data.Default.Class
4845import qualified Data.Conduit.Binary as CB
4946#if MIN_VERSION_tls(1, 1, 3)
5047import qualified Crypto.Random.AESCtr
@@ -100,7 +97,7 @@ defaultTlsSettings = TLSSettings
10097 { certFile = "certificate.pem"
10198 , keyFile = "key.pem"
10299 , onInsecure = DenyInsecure "This server only accepts secure HTTPS connections."
103− , tlsLogging = TLS.defaultLogging
100+ , tlsLogging = def
104101 , tlsAllowedVersions = [TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12]
105102 , tlsCiphers = ciphers
106103 }
@@ -109,16 +106,16 @@ defaultTlsSettings = TLSSettings
109106-- specified 'Socket'.
110107runTLSSocket :: TLSSettings -> Settings -> Socket -> Application -> IO ()
111108runTLSSocket TLSSettings {..} set sock app = do
112− certs <- readCertificates certFile
113− pk <- readPrivateKey keyFile
114− let params =
115− TLS.updateServerParams
116− (\sp -> sp { TLS.serverWantClientCert = False }) $
117− TLS.defaultParamsServer
118− { TLS.pAllowedVersions = tlsAllowedVersions
119− , TLS.pCiphers = tlsCiphers
120− , TLS.pCertificates = zip certs $ (Just pk):repeat Nothing
121− , TLS.pLogging = tlsLogging
109+ credential <- either error id <$> TLS.credentialLoadX509 certFile keyFile
110+ let params = def
111+ { TLS.serverWantClientCert = False
112+ , TLS.serverSupported = def
113+ { TLS.supportedVersions = tlsAllowedVersions
114+ , TLS.supportedCiphers = tlsCiphers
115+ }
116+ , TLS.serverShared = def
117+ { TLS.sharedCredentials = TLS.Credentials [credential]
118+ }
122119 }
123120 runSettingsConnectionMaker set (getter params) app
124121 where
@@ -149,6 +146,7 @@ runTLSSocket TLSSettings {..} set sock app = do
149146 }
150147 params
151148 gen
149+ TLS.contextHookSetLogging ctx tlsLogging
152150 TLS.handshake ctx
153151 buf <- allocateBuffer bufferSize
154152 let conn = Connection
@@ -210,24 +208,3 @@ ciphers =
210208 , TLSExtra.cipher_RC4_128_MD5
211209 , TLSExtra.cipher_RC4_128_SHA1
212210 ]
213−
214−readCertificates :: FilePath -> IO [X509.X509]
215−readCertificates filepath = do
216− certs <- rights . parseCerts . PEM.pemParseBS <$> B.readFile filepath
217− case certs of
218− []-> error "no valid certificate found"
219− x -> return x
220− where parseCerts (Right pems) = map (X509.decodeCertificate . L.fromChunks . (:[]) . PEM.pemContent)
221− $ filter (flip elem ["CERTIFICATE", "TRUSTED CERTIFICATE"] . PEM.pemName) pems
222− parseCerts (Left err) = error $ "cannot parse PEM file: " ++ err
223−
224−readPrivateKey :: FilePath -> IO TLS.PrivateKey
225−readPrivateKey filepath = do
226− pk <- rights . parseKey . PEM.pemParseBS <$> B.readFile filepath
227− case pk of
228− [] -> error "no valid RSA key found"
229− (x:_) -> return x
230−
231− where parseKey (Right pems) = map (fmap (TLS.PrivRSA . snd) . KeyRSA.decodePrivate . L.fromChunks . (:[]) . PEM.pemContent)
232− $ filter ((== "RSA PRIVATE KEY") . PEM.pemName) pems
233− parseKey (Left err) = error $ "Cannot parse PEM file: " ++ err