warp-tls (empty) → 1.0.0
raw patch · 4 files changed
+163/−0 lines, 4 filesdep +basedep +bytestringdep +certificatesetup-changed
Dependencies added: base, bytestring, certificate, conduit, crypto-api, cryptocipher, network, tls, tls-extra, transformers, wai, warp
Files
- LICENSE +25/−0
- Network/Wai/Handler/WarpTLS.hs +98/−0
- Setup.lhs +7/−0
- warp-tls.cabal +33/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2010, Suite Solutions. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/Wai/Handler/WarpTLS.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Handler.WarpTLS+ ( TLSSettings (..)+ , runTLS+ ) where++import qualified Network.TLS as TLS+import Network.Wai.Handler.Warp+import Network.Wai+import Network.Socket+import System.IO+import Crypto.Random+import qualified Data.ByteString.Lazy as L+import Data.Conduit.Binary (sourceFileRange)+import qualified Data.Conduit as C+import qualified Data.Conduit.List as CL+import Control.Exception (bracket, handle, SomeException)+import qualified Network.TLS.Extra as TLSExtra+import qualified Data.Certificate.X509 as X509+import qualified Data.Certificate.PEM as PEM+import qualified Data.ByteString as B+import Control.Monad (unless)+import qualified Data.Certificate.KeyRSA as KeyRSA+import Control.Applicative ((<$>))++data TLSSettings = TLSSettings+ { certFile :: FilePath+ , keyFile :: FilePath+ }++runTLS :: TLSSettings -> Settings -> Application -> IO ()+runTLS tset set app = do+ cert <- readCertificate $ certFile tset+ pk <- readPrivateKey $ keyFile tset+ let params = TLS.defaultParams+ { TLS.pWantClientCert = False+ , TLS.pAllowedVersions = [TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12]+ , TLS.pCiphers = ciphers+ , TLS.pCertificates = [(cert, Just pk)]+ }+ bracket+ (bindPort (settingsPort set) (settingsHost set))+ sClose+ (\sock -> runSettingsConnection set (getter params sock) app)+ where+ retry :: TLS.TLSParams -> Socket -> SomeException -> IO (Connection, SockAddr)+ retry a b _ = getter a b++ getter params sock = do+ (s, sa) <- accept sock+ handle (retry params sock) $ do+ h <- socketToHandle s ReadWriteMode+ hSetBuffering h NoBuffering+ gen <- newGenIO+ ctx <- TLS.server params (gen :: SystemRandom) h+ b <- TLS.handshake ctx+ unless b $ error "Invalid handshake"+ let conn = Connection+ { connSendMany = TLS.sendData ctx . L.fromChunks+ , connSendAll = TLS.sendData ctx . L.fromChunks . return+ , connSendFile = \fp offset len _th -> C.runResourceT $ sourceFileRange fp (Just offset) (Just len) C.$$ CL.mapM_ (TLS.sendData ctx . L.fromChunks . return)+ , connClose = do+ TLS.bye ctx+ hClose h+ , connRecv = B.concat . L.toChunks <$> TLS.recvData ctx+ }+ return (conn, sa)++-- taken from stunnel example in tls-extra+ciphers :: [TLS.Cipher]+ciphers =+ [ TLSExtra.cipher_AES128_SHA1+ , TLSExtra.cipher_AES256_SHA1+ , TLSExtra.cipher_RC4_128_MD5+ , TLSExtra.cipher_RC4_128_SHA1+ ]++readCertificate :: FilePath -> IO X509.X509+readCertificate filepath = do+ content <- B.readFile filepath+ certdata <-+ case PEM.parsePEMCert content of+ Nothing -> error "no valid certificate section"+ Just x -> return x+ case X509.decodeCertificate $ L.fromChunks [certdata] of+ Left err -> error ("cannot decode certificate: " ++ err)+ Right x -> return x++readPrivateKey :: FilePath -> IO TLS.PrivateKey+readPrivateKey filepath = do+ content <- B.readFile filepath+ pkdata <-+ case PEM.parsePEMKeyRSA content of+ Nothing -> error "no valid RSA key section"+ Just x -> return (L.fromChunks [x])+ case KeyRSA.decodePrivate pkdata of+ Left err -> error ("cannot decode key: " ++ err)+ Right (_pub, x) -> return $ TLS.PrivRSA x
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ warp-tls.cabal view
@@ -0,0 +1,33 @@+Name: warp-tls+Version: 1.0.0+Synopsis: SSL support for Warp via the TLS package+License: BSD3+License-file: LICENSE+Author: Michael Snoyman+Maintainer: michael@snoyman.com+Homepage: http://github.com/yesodweb/wai+Category: Web, Yesod+Build-Type: Simple+Cabal-Version: >=1.6+Stability: Stable+Description: SSL support for Warp via the TLS package++Library+ Build-Depends: base >= 4 && < 5+ , bytestring >= 0.9 && < 0.10+ , wai >= 1.0 && < 1.1+ , warp >= 1.0 && < 1.1+ , transformers >= 0.2 && < 0.3+ , conduit+ , certificate >= 1.0.1 && < 1.1+ , cryptocipher >= 0.3 && < 0.4+ , tls-extra >= 0.4 && < 0.5+ , tls >= 0.8.1 && < 0.9+ , crypto-api >= 0.8 && < 0.9+ , network >= 2.2.1 && < 2.4+ Exposed-modules: Network.Wai.Handler.WarpTLS+ ghc-options: -Wall++source-repository head+ type: git+ location: git://github.com/yesodweb/wai.git