git.iko.soy/typeable/wai
on master help sign in
Merge branch 'master' into wai2

Conflicts: wai-websockets/wai-websockets.cabal warp-tls/warp-tls.cabal

commit3977342417c7eed559eb4b3d6263593278c3e118 authorMichael Snoyman <michael@snoyman.com> dateSat 30 Nov 2013, 18:28 (13 years ago) parent2cf25246d796f9
2 files changed+17−20
compare with master
unifiedsplit
wai-websockets/Network/Wai/Handler/WebSockets.hs+1−18 warp-tls/Network/Wai/Handler/WarpTLS.hs+16−2
wai-websockets/Network/Wai/Handler/WebSockets.hs+1−18
@@ -4,10 +4,7 @@ module Network.Wai.Handler.WebSockets
44 , interceptWith
55 ) where
66
7−import Control.Monad (forever)
87import Control.Monad.IO.Class (liftIO)
9−import Control.Concurrent (forkIO, threadDelay)
10−import Control.Exception (SomeException (..), handle)
118import Blaze.ByteString.Builder (Builder)
129import qualified Blaze.ByteString.Builder as Builder
1310import Data.ByteString (ByteString)
@@ -57,27 +54,13 @@ runWebSockets opts req app _ conn = do
5754 let pc = WS.PendingConnection
5855 { WS.pendingOptions = opts
5956 , WS.pendingRequest = req
60− , WS.pendingOnAccept = forkPingThread
57+ , WS.pendingOnAccept = \_ -> return ()
6158 , WS.pendingIn = is
6259 , WS.pendingOut = os
6360 }
6461
6562 liftIO $ app pc
6663
67−--------------------------------------------------------------------------------
68−-- | Start a ping thread in the background
69−forkPingThread :: WS.Connection -> IO ()
70−forkPingThread conn = do
71− _ <- forkIO pingThread
72− return ()
73− where
74− pingThread = handle ignore $ forever $ do
75− WS.sendPing conn (BC.pack "ping")
76− threadDelay $ 30 * 1000 * 1000
77−
78− ignore :: SomeException -> IO ()
79− ignore _ = return ()
80−
8164------------------------------------------------------------------------------
8265-- | Converts a 'Connection' to an 'InputStream' \/ 'OutputStream' pair. Note that,
8366-- as is usually the case in @io-streams@, writing a 'Nothing' to the generated
warp-tls/Network/Wai/Handler/WarpTLS.hs+16−2
@@ -66,6 +66,18 @@ data TLSSettings = TLSSettings
6666 -- Default: 'TLS.defaultLogging'.
6767 --
6868 -- Since 1.4.0
69+ , tlsAllowedVersions :: [TLS.Version]
70+ -- ^ The TLS versions this server accepts.
71+ --
72+ -- Default: '[TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12]'.
73+ --
74+ -- Since 1.4.2
75+ , tlsCiphers :: [TLS.Cipher]
76+ -- ^ The TLS ciphers this server accepts.
77+ --
78+ -- Default: '[TLSExtra.cipher_AES128_SHA1, TLSExtra.cipher_AES256_SHA1, TLSExtra.cipher_RC4_128_MD5, TLSExtra.cipher_RC4_128_SHA1]'
79+ --
80+ -- Since 1.4.2
6981 }
7082
7183-- | An action when a plain HTTP comes to HTTP over TLS/SSL port.
@@ -88,6 +100,8 @@ defaultTlsSettings = TLSSettings
88100 , keyFile = "key.pem"
89101 , onInsecure = DenyInsecure "This server only accepts secure HTTPS connections."
90102 , tlsLogging = TLS.defaultLogging
103+ , tlsAllowedVersions = [TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12]
104+ , tlsCiphers = ciphers
91105 }
92106
93107-- | Running 'Application' with 'TLSSettings' and 'Settings' using
@@ -100,8 +114,8 @@ runTLSSocket TLSSettings {..} set sock app = do
100114 TLS.updateServerParams
101115 (\sp -> sp { TLS.serverWantClientCert = False }) $
102116 TLS.defaultParamsServer
103− { TLS.pAllowedVersions = [TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12]
104− , TLS.pCiphers = ciphers
117+ { TLS.pAllowedVersions = tlsAllowedVersions
118+ , TLS.pCiphers = tlsCiphers
105119 , TLS.pCertificates = zip certs $ (Just pk):repeat Nothing
106120 , TLS.pLogging = tlsLogging
107121 }