084a3d2 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Merge pull request #223 from vincenthz/master

084a3d2Michael Snoyman13 years ago

warp-tls/Network/Wai/Handler/WarpTLS.hs+13−36

compare with master

unifiedsplit

@@ -33,18 +33,15 @@ import qualified Data.Conduit as C

33import qualified Data.Conduit.List as CL

34import Control.Exception (bracket, finally, handle)

35import qualified Network.TLS.Extra as TLSExtra

36−import qualified Data.Certificate.X509 as X509

37import qualified Data.ByteString as B

36import qualified Data.ByteString as B

38−import qualified Data.Certificate.KeyRSA as KeyRSA

39import Data.Conduit.Network (bindPort)

37import Data.Conduit.Network (bindPort)

40−import Data.Either (rights)

41import Control.Applicative ((<$>))

38import Control.Applicative ((<$>))

42−import qualified Data.PEM as PEM

43import Data.Conduit.Network (sourceSocket, sinkSocket, acceptSafe)

39import Data.Conduit.Network (sourceSocket, sinkSocket, acceptSafe)

44import Data.Maybe (fromMaybe)

40import Data.Maybe (fromMaybe)

45import qualified Data.IORef as I

41import qualified Data.IORef as I

46import Control.Exception (Exception, throwIO)

42import Control.Exception (Exception, throwIO)

47import Data.Typeable (Typeable)

43import Data.Typeable (Typeable)

44+import Data.Default.Class

48import qualified Data.Conduit.Binary as CB

45import qualified Data.Conduit.Binary as CB

49#if MIN_VERSION_tls(1, 1, 3)

46#if MIN_VERSION_tls(1, 1, 3)

50import qualified Crypto.Random.AESCtr

47import qualified Crypto.Random.AESCtr

@@ -100,7 +97,7 @@ defaultTlsSettings = TLSSettings

100 { certFile = "certificate.pem"

97 { certFile = "certificate.pem"

101 , keyFile = "key.pem"

98 , keyFile = "key.pem"

102 , onInsecure = DenyInsecure "This server only accepts secure HTTPS connections."

99 , onInsecure = DenyInsecure "This server only accepts secure HTTPS connections."

103− , tlsLogging = TLS.defaultLogging

100+ , tlsLogging = def

104 , tlsAllowedVersions = [TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12]

101 , tlsAllowedVersions = [TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12]

105 , tlsCiphers = ciphers

102 , tlsCiphers = ciphers

106 }

103 }

@@ -109,16 +106,16 @@ defaultTlsSettings = TLSSettings

109-- specified 'Socket'.

106-- specified 'Socket'.

110runTLSSocket :: TLSSettings -> Settings -> Socket -> Application -> IO ()

107runTLSSocket :: TLSSettings -> Settings -> Socket -> Application -> IO ()

111runTLSSocket TLSSettings {..} set sock app = do

108runTLSSocket TLSSettings {..} set sock app = do

112− certs <- readCertificates certFile

109+ credential <- either error id <$> TLS.credentialLoadX509 certFile keyFile

113− pk <- readPrivateKey keyFile

114− let params =

110+ let params = def

115− TLS.updateServerParams

116− (\sp -> sp { TLS.serverWantClientCert = False }) $

111+ { TLS.serverWantClientCert = False

117− TLS.defaultParamsServer

112+ , TLS.serverSupported = def

118− { TLS.pAllowedVersions = tlsAllowedVersions

113+ { TLS.supportedVersions = tlsAllowedVersions

119− , TLS.pCiphers = tlsCiphers

114+ , TLS.supportedCiphers = tlsCiphers

120− , TLS.pCertificates = zip certs $ (Just pk):repeat Nothing

115+ }

121− , TLS.pLogging = tlsLogging

116+ , TLS.serverShared = def

117+ { TLS.sharedCredentials = TLS.Credentials [credential]

118+ }

122 }

119 }

123 runSettingsConnectionMaker set (getter params) app

120 runSettingsConnectionMaker set (getter params) app

124 where

121 where

@@ -149,6 +146,7 @@ runTLSSocket TLSSettings {..} set sock app = do

149 }

146 }

150 params

147 params

151 gen

148 gen

149+ TLS.contextHookSetLogging ctx tlsLogging

152 TLS.handshake ctx

150 TLS.handshake ctx

153 buf <- allocateBuffer bufferSize

151 buf <- allocateBuffer bufferSize

154 let conn = Connection

152 let conn = Connection

@@ -210,24 +208,3 @@ ciphers =

210 , TLSExtra.cipher_RC4_128_MD5

208 , TLSExtra.cipher_RC4_128_MD5

211 , TLSExtra.cipher_RC4_128_SHA1

209 , TLSExtra.cipher_RC4_128_SHA1

212 ]

210 ]

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

warp-tls/warp-tls.cabal+3−16

@@ -12,9 +12,6 @@ Cabal-Version: >=1.6

12Stability: Stable

13Description: HTTP over SSL/TLS support for Warp via the TLS package.

15−flag tls_1_1_3

16− default: True

17−

18Library

15Library

19 Build-Depends: base >= 4 && < 5

16 Build-Depends: base >= 4 && < 5

20 , bytestring >= 0.9

17 , bytestring >= 0.9

@@ -23,20 +20,10 @@ Library

23 , transformers >= 0.2

20 , transformers >= 0.2

24 , conduit >= 0.5 && < 1.1

21 , conduit >= 0.5 && < 1.1

25 , network-conduit >= 0.6 && < 1.1

22 , network-conduit >= 0.6 && < 1.1

26− , certificate >= 1.2

23+ , data-default-class >= 0.0.1

27− , pem >= 0.1

28− , cryptocipher >= 0.3

29− , tls-extra >= 0.6

24+ , tls >= 1.2

30− , tls >= 1.1

31− , crypto-random-api >= 0.2

32 , network >= 2.2.1

25 , network >= 2.2.1

33− , cprng-aes >= 0.3.4

26+ , cprng-aes >= 0.5.0

34− if flag(tls_1_1_3)

35− build-depends: tls >= 1.1.3

36− , cprng-aes >= 0.5.0

37− else

38− build-depends: tls < 1.1.3

39− , cprng-aes < 0.5.0

40 Exposed-modules: Network.Wai.Handler.WarpTLS

27 Exposed-modules: Network.Wai.Handler.WarpTLS

41 ghc-options: -Wall

28 ghc-options: -Wall