warp-tls-1.4.1.4/0000755000000000000000000000000012210664013011611 5ustar0000000000000000warp-tls-1.4.1.4/LICENSE0000644000000000000000000000207512210664013012622 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. warp-tls-1.4.1.4/warp-tls.cabal0000644000000000000000000000345012210664013014350 0ustar0000000000000000Name: warp-tls Version: 1.4.1.4 Synopsis: HTTP over SSL/TLS support for Warp via the TLS package License: MIT 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: HTTP over SSL/TLS support for Warp via the TLS package. flag tls_1_1_3 default: True Library Build-Depends: base >= 4 && < 5 , bytestring >= 0.9 , wai >= 1.3 && < 1.5 , warp >= 1.3.5 && < 1.4 , transformers >= 0.2 , conduit >= 0.5 && < 1.1 , network-conduit >= 0.6 && < 1.1 , certificate >= 1.2 , pem >= 0.1 , cryptocipher >= 0.3 , tls-extra >= 0.6 , tls >= 1.1 , crypto-random-api >= 0.2 , network >= 2.2.1 , cprng-aes >= 0.3.4 if flag(tls_1_1_3) build-depends: tls >= 1.1.3 , cprng-aes >= 0.5.0 else build-depends: tls < 1.1.3 , cprng-aes < 0.5.0 Exposed-modules: Network.Wai.Handler.WarpTLS ghc-options: -Wall source-repository head type: git location: git://github.com/yesodweb/wai.git warp-tls-1.4.1.4/Setup.lhs0000644000000000000000000000016212210664013013420 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain warp-tls-1.4.1.4/Network/0000755000000000000000000000000012210664013013242 5ustar0000000000000000warp-tls-1.4.1.4/Network/Wai/0000755000000000000000000000000012210664013013762 5ustar0000000000000000warp-tls-1.4.1.4/Network/Wai/Handler/0000755000000000000000000000000012210664013015337 5ustar0000000000000000warp-tls-1.4.1.4/Network/Wai/Handler/WarpTLS.hs0000644000000000000000000001751112210664013017174 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable #-} -- | HTTP over SSL/TLS support for Warp via the TLS package. module Network.Wai.Handler.WarpTLS ( -- * Settings TLSSettings , certFile , keyFile , onInsecure , tlsLogging , defaultTlsSettings , tlsSettings , OnInsecure (..) -- * Runner , runTLS , runTLSSocket -- * Exception , WarpTLSException (..) ) where import qualified Network.TLS as TLS import Network.Wai.Handler.Warp import Network.Wai import Network.Socket 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, finally) import qualified Network.TLS.Extra as TLSExtra import qualified Data.Certificate.X509 as X509 import qualified Data.ByteString as B import qualified Data.Certificate.KeyRSA as KeyRSA import Data.Conduit.Network (bindPort) import Data.Either (rights) import Control.Applicative ((<$>)) import qualified Data.PEM as PEM import Data.Conduit.Network (sourceSocket, sinkSocket, acceptSafe) import Data.Maybe (fromMaybe) import qualified Data.IORef as I import Crypto.Random.AESCtr (makeSystem) import Control.Exception (Exception, throwIO) import Data.Typeable (Typeable) import qualified Data.Conduit.Binary as CB #if MIN_VERSION_tls(1, 1, 3) import qualified Crypto.Random.AESCtr #endif data TLSSettings = TLSSettings { certFile :: FilePath -- ^ File containing the certificate. , keyFile :: FilePath -- ^ File containing the key , onInsecure :: OnInsecure -- ^ Do we allow insecure connections with this server as well? Default -- is a simple text response stating that a secure connection is required. -- -- Since 1.4.0 , tlsLogging :: TLS.Logging -- ^ The level of logging to turn on. -- -- Default: 'TLS.defaultLogging'. -- -- Since 1.4.0 } -- | An action when a plain HTTP comes to HTTP over TLS/SSL port. data OnInsecure = DenyInsecure L.ByteString | AllowInsecure -- | A smart constructor for 'TLSSettings'. tlsSettings :: FilePath -- ^ Certificate file -> FilePath -- ^ Key file -> TLSSettings tlsSettings cert key = defaultTlsSettings { certFile = cert , keyFile = key } -- | Default 'TLSSettings'. Use this to create 'TLSSettings' with the field record name. defaultTlsSettings :: TLSSettings defaultTlsSettings = TLSSettings { certFile = "certificate.pem" , keyFile = "key.pem" , onInsecure = DenyInsecure "This server only accepts secure HTTPS connections." , tlsLogging = TLS.defaultLogging } -- | Running 'Application' with 'TLSSettings' and 'Settings' using -- specified 'Socket'. runTLSSocket :: TLSSettings -> Settings -> Socket -> Application -> IO () runTLSSocket TLSSettings {..} set sock app = do certs <- readCertificates certFile pk <- readPrivateKey keyFile let params = TLS.updateServerParams (\sp -> sp { TLS.serverWantClientCert = False }) $ TLS.defaultParamsServer { TLS.pAllowedVersions = [TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12] , TLS.pCiphers = ciphers , TLS.pCertificates = zip certs $ (Just pk):repeat Nothing , TLS.pLogging = tlsLogging } runSettingsConnectionMaker set (getter params) app where getter params = do (s, sa) <- acceptSafe sock let mkConn = do (fromClient, firstBS) <- sourceSocket s C.$$+ CL.peek let toClient = sinkSocket s ifromClient <- I.newIORef fromClient let getNext sink = do fromClient' <- I.readIORef ifromClient (fromClient'', bs) <- fromClient' C.$$++ sink I.writeIORef ifromClient fromClient'' return bs if maybe False ((== 0x16) . fst) (firstBS >>= B.uncons) then do #if MIN_VERSION_tls(1, 1, 3) gen <- Crypto.Random.AESCtr.makeSystem #else gen <- makeSystem #endif ctx <- TLS.contextNew TLS.Backend { TLS.backendFlush = return () , TLS.backendClose = sClose s , TLS.backendSend = \bs -> C.yield bs C.$$ toClient , TLS.backendRecv = getNext . fmap (B.concat . L.toChunks) . CB.take } params gen TLS.handshake ctx let conn = Connection { connSendMany = TLS.sendData ctx . L.fromChunks , connSendAll = TLS.sendData ctx . L.fromChunks . return , connSendFile = \fp offset len _th headers _cleaner -> do TLS.sendData ctx $ L.fromChunks headers C.runResourceT $ sourceFileRange fp (Just offset) (Just len) C.$$ CL.mapM_ (TLS.sendData ctx . L.fromChunks . return) , connClose = TLS.bye ctx `finally` TLS.contextClose ctx , connRecv = TLS.recvData ctx } return conn else case onInsecure of AllowInsecure -> let conn = (socketConnection s) { connRecv = getNext $ fmap (fromMaybe B.empty) C.await } in return conn DenyInsecure lbs -> do let src = do C.yield "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\n\r\n" mapM_ C.yield $ L.toChunks lbs src C.$$ sinkSocket s sClose s throwIO InsecureConnectionDenied return (mkConn, sa) data WarpTLSException = InsecureConnectionDenied deriving (Show, Typeable) instance Exception WarpTLSException -- | Running 'Application' with 'TLSSettings' and 'Settings'. runTLS :: TLSSettings -> Settings -> Application -> IO () runTLS tset set app = bracket (bindPort (settingsPort set) (settingsHost set)) sClose (\sock -> runTLSSocket tset set sock app) -- 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 ] readCertificates :: FilePath -> IO [X509.X509] readCertificates filepath = do certs <- rights . parseCerts . PEM.pemParseBS <$> B.readFile filepath case certs of []-> error "no valid certificate found" x -> return x where parseCerts (Right pems) = map (X509.decodeCertificate . L.fromChunks . (:[]) . PEM.pemContent) $ filter (flip elem ["CERTIFICATE", "TRUSTED CERTIFICATE"] . PEM.pemName) pems parseCerts (Left err) = error $ "cannot parse PEM file: " ++ err readPrivateKey :: FilePath -> IO TLS.PrivateKey readPrivateKey filepath = do pk <- rights . parseKey . PEM.pemParseBS <$> B.readFile filepath case pk of [] -> error "no valid RSA key found" (x:_) -> return x where parseKey (Right pems) = map (fmap (TLS.PrivRSA . snd) . KeyRSA.decodePrivate . L.fromChunks . (:[]) . PEM.pemContent) $ filter ((== "RSA PRIVATE KEY") . PEM.pemName) pems parseKey (Left err) = error $ "Cannot parse PEM file: " ++ err