network-conduit-tls (empty) → 0.5.0

raw patch · 4 files changed

+173/−0 lines, 4 filesdep +basedep +bytestringdep +certificatesetup-changed

Dependencies added: base, bytestring, certificate, conduit, crypto-api, network, network-conduit, pem, system-fileio, system-filepath, tls, tls-extra, transformers, yaml

Files

Data/Conduit/Network/TLS.hs +112/−0
LICENSE +30/−0
Setup.hs +2/−0
network-conduit-tls.cabal +29/−0

+ Data/Conduit/Network/TLS.hs view

@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Data.Conduit.Network.TLS+    ( TLSConfig (..)+    , runTCPServerTLS+    ) where++import Prelude hiding (FilePath, readFile)+import Data.Yaml (FromJSON (parseJSON), (.:), (.:?), (.!=), Value (Object))+import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero, forever)+import Data.String (fromString)+import Filesystem.Path.CurrentOS ((</>), FilePath)+import Filesystem (readFile)+import qualified Data.ByteString.Lazy as L+import qualified Data.Certificate.KeyRSA as KeyRSA+import qualified Data.PEM as PEM+import qualified Network.TLS as TLS+import qualified Data.Certificate.X509 as X509+import Data.Conduit.Network (HostPreference, Application, bindPort, sinkSocket, acceptSafe)+import Data.Conduit.Network.Internal (AppData (..))+import Data.Conduit (($$), yield)+import qualified Data.Conduit.List as CL+import Data.Either (rights)+import Network.Socket (sClose)+import Network.Socket.ByteString (recv)+import Control.Exception (bracket, finally)+import Control.Concurrent (forkIO)+import Control.Monad.Trans.Class (lift)+import qualified Network.TLS.Extra as TLSExtra+import Crypto.Random (newGenIO, SystemRandom)++data TLSConfig = TLSConfig+    { tlsHost :: HostPreference+    , tlsPort :: Int+    , tlsCertificate :: FilePath+    , tlsKey :: FilePath+    }++runTCPServerTLS :: TLSConfig -> Application IO -> IO ()+runTCPServerTLS TLSConfig{..} app = do+    certs <- readCertificates tlsCertificate+    key <- readPrivateKey tlsKey+    bracket+        (bindPort tlsPort tlsHost)+        sClose+        (forever . serve certs key)+  where+    serve certs key lsocket = do+        (socket, addr) <- acceptSafe lsocket+        _ <- forkIO $ handle socket addr+        return ()+      where+        handle socket addr = do+            gen <- newGenIO+            ctx <- TLS.serverWith+                params+                (gen :: SystemRandom)+                socket+                (return ()) -- flush+                (\bs -> yield bs $$ sinkSocket socket)+                (recv socket)++            TLS.handshake ctx++            let ad = AppData+                    { appSource =+                        let src = lift (TLS.recvData ctx) >>= yield >> src+                         in src+                    , appSink = CL.mapM_ $ TLS.sendData ctx . L.fromChunks . return+                    , appSockAddr = addr+                    }+++            app ad `finally` sClose socket++        params = TLS.defaultParams+            { TLS.pWantClientCert = False+            , TLS.pAllowedVersions = [TLS.SSL3,TLS.TLS10,TLS.TLS11,TLS.TLS12]+            , TLS.pCiphers         = ciphers+            , TLS.pCertificates    = zip certs $ Just key : repeat Nothing+            }++-- 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 <$> readFile filepath+    case certs of+        []    -> error "no valid certificate found"+        (_:_) -> return certs+    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 <$> 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

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c)2011, Michael Snoyman++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.++    * Neither the name of Michael Snoyman nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ network-conduit-tls.cabal view

@@ -0,0 +1,29 @@+name:                network-conduit-tls+version:             0.5.0+synopsis:            Create TLS-aware network code with conduits+description:         Uses the tls package for a pure-Haskell implementation.+homepage:            https://github.com/snoyberg/conduit+license:             MIT+license-file:        LICENSE+author:              Michael Snoyman+maintainer:          michael@snoyman.com+category:            Network+build-type:          Simple+cabal-version:       >=1.8++library+  exposed-modules:    Data.Conduit.Network.TLS+  build-depends:      base            >= 4        && < 5+                    , yaml            >= 0.8+                    , system-filepath >= 0.4+                    , system-fileio   >= 0.3+                    , bytestring      >= 0.9+                    , certificate     >= 1.2+                    , pem             >= 0.1+                    , tls             >= 0.9+                    , network-conduit >= 0.6+                    , conduit         >= 0.5+                    , network+                    , transformers+                    , tls-extra       >= 0.4+                    , crypto-api      >= 0.10