git.iko.soy/typeable/wai
on master help sign in
warp-tls added
40f9e4dMichael Snoyman
package-list.sh+1
compare with master
unifiedsplit
@@ -4,6 +4,7 @@ pkgs=( ./wai
4 ./wai-test
4 ./wai-test
5 ./wai-extra
5 ./wai-extra
6 ./warp
6 ./warp
7+ ./warp-tls
7 ./wai-app-static
8 ./wai-app-static
8 ./wai-handler-fastcgi
9 ./wai-handler-fastcgi
9 ./wai-handler-launch
10 ./wai-handler-launch
warp-tls/LICENSEnew file+25
@@ -0,0 +1,25 @@
1+The following license covers this documentation, and the source code, except
2+where otherwise indicated.
3+
4+Copyright 2010, Suite Solutions. All rights reserved.
5+
6+Redistribution and use in source and binary forms, with or without
7+modification, are permitted provided that the following conditions are met:
8+
9+* Redistributions of source code must retain the above copyright notice, this
10+ list of conditions and the following disclaimer.
11+
12+* Redistributions in binary form must reproduce the above copyright notice,
13+ this list of conditions and the following disclaimer in the documentation
14+ and/or other materials provided with the distribution.
15+
16+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
17+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
18+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
19+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
20+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
21+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
22+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
23+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
24+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
25+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
warp-tls/Network/Wai/Handler/WarpTLS.hsnew file+114
@@ -0,0 +1,114 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Network.Wai.Handler.WarpTLS
3+ ( TLSSettings (..)
4+ , runTLS
5+ ) where
6+
7+import qualified Network.TLS as TLS
8+import Network.Wai.Handler.Warp
9+import Network.Wai
10+import Network.Socket
11+import System.IO
12+import Crypto.Random
13+import qualified Data.ByteString.Lazy as L
14+import Data.Conduit.Binary (sourceFileRange)
15+import qualified Data.Conduit as C
16+import qualified Data.Conduit.List as CL
17+import Control.Monad.IO.Class (liftIO)
18+import Control.Exception (bracket, handle, SomeException)
19+import qualified Network.TLS.Extra as TLSExtra
20+import qualified Data.Certificate.X509 as X509
21+import qualified Data.Certificate.PEM as PEM
22+import qualified Data.ByteString as B
23+import Control.Monad (unless)
24+import qualified Data.Certificate.KeyRSA as KeyRSA
25+
26+data TLSSettings = TLSSettings
27+ { certFile :: FilePath
28+ , keyFile :: FilePath
29+ }
30+
31+runTLS :: TLSSettings -> Settings -> Application -> IO ()
32+runTLS tset set app = do
33+ cert <- readCertificate $ certFile tset
34+ pk <- readPrivateKey $ keyFile tset
35+ let params = TLS.defaultParams
36+ { TLS.pWantClientCert = False
37+ , TLS.pAllowedVersions = [TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12]
38+ , TLS.pCiphers = ciphers
39+ , TLS.pCertificates = [(cert, Just pk)]
40+ }
41+ bracket
42+ (bindPort (settingsPort set) (settingsHost set))
43+ sClose
44+ (\sock -> runSettingsConnection set (getter params sock) app)
45+ where
46+ retry :: TLS.TLSParams -> Socket -> SomeException -> IO (Connection, SockAddr)
47+ retry a b _ = getter a b
48+
49+ getter params sock = do
50+ (s, sa) <- accept sock
51+ handle (retry params sock) $ do
52+ h <- socketToHandle s ReadWriteMode
53+ hSetBuffering h NoBuffering
54+ gen <- newGenIO
55+ ctx <- TLS.server params (gen :: SystemRandom) h
56+ b <- TLS.handshake ctx
57+ unless b $ error "Invalid handshake"
58+ let sink = C.Sink $ return $ C.SinkData
59+ { C.sinkPush = \bs -> do
60+ liftIO $ TLS.sendData ctx $ L.fromChunks [bs]
61+ return C.Processing
62+ , C.sinkClose = return ()
63+ }
64+ let conn = Connection
65+ { connSendMany = TLS.sendData ctx . L.fromChunks
66+ , connSendAll = TLS.sendData ctx . L.fromChunks . return
67+ , connSendFile = \fp offset len _th -> C.runResourceT $ sourceFileRange fp (Just offset) (Just len) C.$$ CL.mapM_ (TLS.sendData ctx . L.fromChunks . return)
68+ , connSink = \_th -> sink
69+ , connClose = do
70+ TLS.bye ctx
71+ hClose h
72+ , connSource = \_th -> C.sourceState []
73+ (\buffer ->
74+ case buffer of
75+ (bs:bss) -> return (bss, C.Open bs)
76+ [] -> do
77+ lbs <- TLS.recvData ctx
78+ if L.null lbs
79+ then return (undefined, C.Closed)
80+ else let (bs:bss) = L.toChunks lbs
81+ in return (bss, C.Open bs))
82+ }
83+ return (conn, sa)
84+
85+-- taken from stunnel example in tls-extra
86+ciphers :: [TLS.Cipher]
87+ciphers =
88+ [ TLSExtra.cipher_AES128_SHA1
89+ , TLSExtra.cipher_AES256_SHA1
90+ , TLSExtra.cipher_RC4_128_MD5
91+ , TLSExtra.cipher_RC4_128_SHA1
92+ ]
93+
94+readCertificate :: FilePath -> IO X509.X509
95+readCertificate filepath = do
96+ content <- B.readFile filepath
97+ certdata <-
98+ case PEM.parsePEMCert content of
99+ Nothing -> error "no valid certificate section"
100+ Just x -> return x
101+ case X509.decodeCertificate $ L.fromChunks [certdata] of
102+ Left err -> error ("cannot decode certificate: " ++ err)
103+ Right x -> return x
104+
105+readPrivateKey :: FilePath -> IO TLS.PrivateKey
106+readPrivateKey filepath = do
107+ content <- B.readFile filepath
108+ pkdata <-
109+ case PEM.parsePEMKeyRSA content of
110+ Nothing -> error "no valid RSA key section"
111+ Just x -> return (L.fromChunks [x])
112+ case KeyRSA.decodePrivate pkdata of
113+ Left err -> error ("cannot decode key: " ++ err)
114+ Right (_pub, x) -> return $ TLS.PrivRSA x
warp-tls/Setup.lhsnew file+7
@@ -0,0 +1,7 @@
1+#!/usr/bin/env runhaskell
2+
3+> module Main where
4+> import Distribution.Simple
5+
6+> main :: IO ()
7+> main = defaultMain
warp-tls/certificate.pemnew file+15
@@ -0,0 +1,15 @@
1+-----BEGIN CERTIFICATE-----
2+MIICWDCCAcGgAwIBAgIJAJG1ZMlcMDW6MA0GCSqGSIb3DQEBBQUAMEUxCzAJBgNV
3+BAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEwHwYDVQQKDBhJbnRlcm5ldCBX
4+aWRnaXRzIFB0eSBMdGQwHhcNMTExMDIyMTk0MjU3WhcNMTExMTIxMTk0MjU3WjBF
5+MQswCQYDVQQGEwJBVTETMBEGA1UECAwKU29tZS1TdGF0ZTEhMB8GA1UECgwYSW50
6+ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKB
7+gQCfYZx7kV6ybogMyAf9MINm7Rwin5LKh+TpD1ZkbLgmqFVotQCdthgTK66SPXkx
8+EXGI27biNzacJhX7Ml7/4o8sp2GslYKUO46DYvgi/nnNX/bzA5cDJSSGK11eQEVs
9++p0GEZ/6Juhpx/oQwMDMgo0UHkiH8QtKI8ojXnFF2MsLNwIDAQABo1AwTjAdBgNV
10+HQ4EFgQUaA6FbOj/0VJMb4egNyIDZ/ZNV/YwHwYDVR0jBBgwFoAUaA6FbOj/0VJM
11+b4egNyIDZ/ZNV/YwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQCTQyOk
12+D86Z+yzedXjTLI6FT8QugmQne1YQ8P0w37P76z2reagSvNee2e9B1oTHoPeKZMs0
13+k99oS9yJ/NOQ1Ms90P+q0yBVGxAs/gF65qKgE27YGXzNtNobj/D4OoxcFG+BsORw
14+VvYSBV4FiVy9RwJsr7AMqkUBcOEPCuJHgTx58w==
15+-----END CERTIFICATE-----
warp-tls/key.pemnew file+15
@@ -0,0 +1,15 @@
1+-----BEGIN RSA PRIVATE KEY-----
2+MIICXAIBAAKBgQCfYZx7kV6ybogMyAf9MINm7Rwin5LKh+TpD1ZkbLgmqFVotQCd
3+thgTK66SPXkxEXGI27biNzacJhX7Ml7/4o8sp2GslYKUO46DYvgi/nnNX/bzA5cD
4+JSSGK11eQEVs+p0GEZ/6Juhpx/oQwMDMgo0UHkiH8QtKI8ojXnFF2MsLNwIDAQAB
5+AoGAR8pgAgjo7tZ60ccIUjOX/LSxB6d5J2Eu6wvNjk6qZD9OuWtOa7up/HigmZ63
6+CDMjQNI2/o6AOrWtEQkPYZNbibuifzg5V517nHGSqkqjoIgesAiwEsoKpeOgGTtM
7+MM08oHbJ9uOnDnEEnDBiE0iE3jCTDfmwjqDMpUhu9dZ1EAECQQDKVpzSSV3pzMOp
8+ixNxMpYxzcE+4K9jgM+MlxPBJSQhVrg/cRQWb26cKBi8LdSxF23hQTsFr+8qLwid
9+Ah2AgUOBAkEAyaaCjrNRCiHRpd6YzWZ6GKkxbUvxSuOKX3N7hDaE2OFzQTv2Li8B
10+5mrCsXnSZtOG+MBFdHU66UYie1OzDSDKtwJAKMsvkOID0ihbZmpIwDC/wUjHZkLs
11+eXY14hVvgShY0XPnb7r/nspWlZsr6Xyf/hhIKfr5yFrBMFMNPIJ5qjflgQJAWsyV
12+YTgxN4S+6BdxapvIQq58ySA3CGeo+Q4BAimibB4oTal4UpdsHZrZDB00toRs9Dlv
13+jN70pfGkuS+ZIkIvxQJBAKSf5qpXWp4oZcThkieAiMeAhG96xqRPXhPUxq6QF+YG
14+T4PF1sjlpZwqy7C+2oF3BqLP09mCW7YkH9Jgnl1zDF8=
15+-----END RSA PRIVATE KEY-----
warp-tls/pong.hsnew file+73
@@ -0,0 +1,73 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+import Network.Wai
3+import Network.Wai.Handler.Warp (defaultSettings)
4+import Network.Wai.Handler.WarpTLS
5+import Network.HTTP.Types (status200)
6+import Blaze.ByteString.Builder (copyByteString)
7+import Data.Monoid
8+import qualified Data.Conduit.List as CL
9+
10+main = do
11+ putStrLn "https://localhost:3000/"
12+ runTLS (TLSSettings "certificate.pem" "key.pem") defaultSettings app
13+
14+app req = return $
15+ case rawPathInfo req of
16+ "/builder/withlen" -> builderWithLen
17+ "/builder/nolen" -> builderNoLen
18+ "/file/withlen" -> fileWithLen
19+ "/file/nolen" -> fileNoLen
20+ "/source/withlen" -> sourceWithLen
21+ "/source/nolen" -> sourceNoLen
22+ x -> index x
23+
24+builderWithLen = ResponseBuilder
25+ status200
26+ [ ("Content-Type", "text/plain")
27+ , ("Content-Length", "4")
28+ ]
29+ $ copyByteString "PONG"
30+
31+builderNoLen = ResponseBuilder
32+ status200
33+ [ ("Content-Type", "text/plain")
34+ ]
35+ $ copyByteString "PONG"
36+
37+sourceWithLen = ResponseSource
38+ status200
39+ [ ("Content-Type", "text/plain")
40+ , ("Content-Length", "4")
41+ ]
42+ $ CL.sourceList [copyByteString "PONG"]
43+
44+sourceNoLen = ResponseSource
45+ status200
46+ [ ("Content-Type", "text/plain")
47+ ]
48+ $ CL.sourceList [copyByteString "PONG"]
49+
50+fileWithLen = ResponseFile
51+ status200
52+ [ ("Content-Type", "text/plain")
53+ , ("Content-Length", "4")
54+ ]
55+ "pong.txt"
56+ Nothing
57+
58+fileNoLen = ResponseFile
59+ status200
60+ [ ("Content-Type", "text/plain")
61+ ]
62+ "pong.txt"
63+ Nothing
64+
65+index p = ResponseBuilder status200 [("Content-Type", "text/html")] $ mconcat $ map copyByteString
66+ [ "<p><a href='/builder/withlen'>builder withlen</a></p>\n"
67+ , "<p><a href='/builder/nolen'>builder nolen</a></p>\n"
68+ , "<p><a href='/file/withlen'>file withlen</a></p>\n"
69+ , "<p><a href='/file/nolen'>file nolen</a></p>\n"
70+ , "<p><a href='/source/withlen'>source withlen</a></p>\n"
71+ , "<p><a href='/source/nolen'>source nolen</a></p>\n"
72+ , p
73+ ]
warp-tls/pong.txtnew file+1
@@ -0,0 +1 @@
1+PONG
warp-tls/warp-tls.cabalnew file+33
@@ -0,0 +1,33 @@
1+Name: warp-tls
2+Version: 1.0.0
3+Synopsis: SSL support for Warp via the TLS package
4+License: BSD3
5+License-file: LICENSE
6+Author: Michael Snoyman
7+Maintainer: michael@snoyman.com
8+Homepage: http://github.com/yesodweb/wai
9+Category: Web, Yesod
10+Build-Type: Simple
11+Cabal-Version: >=1.6
12+Stability: Stable
13+Description: SSL support for Warp via the TLS package
14+
15+Library
16+ Build-Depends: base >= 4 && < 5
17+ , bytestring >= 0.9 && < 0.10
18+ , wai >= 1.0 && < 1.1
19+ , warp >= 1.0 && < 1.1
20+ , transformers >= 0.2 && < 0.3
21+ , conduit >= 0.0 && < 0.1
22+ , certificate >= 1.0.1 && < 1.1
23+ , cryptocipher >= 0.3 && < 0.4
24+ , tls-extra >= 0.4 && < 0.5
25+ , tls >= 0.8.1 && < 0.9
26+ , crypto-api >= 0.8 && < 0.9
27+ , network >= 2.2.1 && < 2.4
28+ Exposed-modules: Network.Wai.Handler.WarpTLS
29+ ghc-options: -Wall
30+
31+source-repository head
32+ type: git
33+ location: git://github.com/yesodweb/wai.git