pipes-network-tls (empty) → 0.1.0.0

raw patch · 9 files changed

+997/−0 lines, 9 filesdep +basedep +bytestringdep +networksetup-changed

Dependencies added: base, bytestring, network, network-simple-tls, pipes, pipes-network, pipes-safe, tls, transformers

Files

LICENSE +30/−0
PEOPLE +5/−0
README.md +22/−0
Setup.hs +2/−0
examples/tls-echo.hs +84/−0
examples/tls-tunnel.hs +143/−0
pipes-network-tls.cabal +54/−0
src/Control/Proxy/TCP/TLS.hs +181/−0
src/Control/Proxy/TCP/TLS/Safe.hs +476/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2013, Renzo Carbonara++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 Renzo Carbonara 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.

+ PEOPLE view

@@ -0,0 +1,5 @@+The following people have participated in creating this library, either+by directly contributing code or by providing thoughtful input in+discussions about the library design.++Renzo Carbonara

+ README.md view

@@ -0,0 +1,22 @@+# pipes-network-tls++Utilities to deal with TLS-secured network connections using the+**pipes** and **pipes-safe** libraries.++Currently, only TCP sockets are supported.++Check the source or rendered Haddocks for extensive documentation.++This code is licensed under the terms of the so called **3-clause BSD+license**. Read the file named ``LICENSE`` found in this same directory+for details.++See the ``PEOPLE`` file to learn about the people involved in this+effort.++## Building the development version++Use [cabal-meta](http://hackage.haskell.org/package/cabal-meta) and+[cabal-dev](http://hackage.haskell.org/package/cabal-dev):++    cabal-meta --dev install

+ Setup.hs view

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

+ examples/tls-echo.hs view

@@ -0,0 +1,84 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import           Control.Applicative+import           Control.Proxy              ((>->))+import qualified Control.Proxy              as P+import           Control.Proxy.TCP.TLS      (contextReadS, contextWriteD)+import qualified Data.ByteString.Char8      as B+import           Data.Certificate.X509      (X509)+import           Data.Char                  (toUpper)+import           Data.Monoid                ((<>))+import qualified Network.Simple.TCP.TLS     as Z+import qualified Network.Socket             as NS+import qualified Network.TLS                as T+import           Network.TLS.Extra          as TE+import           System.Console.GetOpt+import           System.Environment         (getProgName, getArgs)+import qualified Data.CertificateStore      as C++server :: Z.Credential -> Z.HostPreference -> NS.ServiceName+       -> Maybe C.CertificateStore -> IO ()+server cred hp port mcs = do+    let ss = Z.makeServerSettings cred mcs+    Z.serve ss hp port $ \(ctx,caddr) -> do+       putStrLn $ show caddr <> " joined."+       P.runProxy $ contextReadS ctx >-> P.mapD (B.map toUpper) >-> contextWriteD ctx+       putStrLn $ show caddr <> " quit."++main :: IO ()+main = do+    args <- getArgs+    case getOpt RequireOrder options args of+      (actions, [hostname,port], _) -> do+        opts <- foldl (>>=) (return defaultOptions) actions+        let !cred = Z.Credential (optServerCert opts) (optServerKey opts) []+        server cred (Z.Host hostname) port+               (C.makeCertificateStore . pure <$> optCACert opts)+      (_,_,msgs) -> do+        pn <- getProgName+        let header = "Usage: " <> pn <> " [OPTIONS] HOSTNAME PORT"+        error $ concat msgs ++ usageInfo header options++--------------------------------------------------------------------------------+-- The boring stuff below is related to command line parsing++data Options = Options+  { optServerCert :: X509+  , optServerKey  :: T.PrivateKey+  , optCACert     :: Maybe X509+  } deriving (Show)++defaultOptions :: Options+defaultOptions = Options+  { optServerCert = error "Missing optServerCert"+  , optServerKey  = error "Missing optServerKey"+  , optCACert     = Nothing+  }++options :: [OptDescr (Options -> IO Options)]+options =+  [ Option [] ["cert"]   (ReqArg readServerCert "FILE") "Server certificate"+  , Option [] ["key"]    (ReqArg readServerKey  "FILE") "Server private key"+  , Option [] ["cacert"] (OptArg readCACert     "FILE")+    "CA certificate to verify a client certificate, if given"+  ]++readServerCert :: FilePath -> Options -> IO Options+readServerCert arg opt = do+    cert <- TE.fileReadCertificate arg+    return $ opt { optServerCert = cert }++readServerKey :: FilePath -> Options -> IO Options+readServerKey arg opt = do+    key <- TE.fileReadPrivateKey arg+    return $ opt { optServerKey = key }++readCACert :: Maybe FilePath -> Options -> IO Options+readCACert Nothing    opt = return opt+readCACert (Just arg) opt = do+    cert <- TE.fileReadCertificate arg+    return $ opt { optCACert = Just cert }+

+ examples/tls-tunnel.hs view

@@ -0,0 +1,143 @@+{-# LANGUAGE BangPatterns #-}++-- Yeah, yeah... I know. This code could be a bit more organized.++module Main (main) where++import           Control.Concurrent.Async   as A+import           Control.Applicative+import           Control.Proxy              ((>->))+import qualified Control.Proxy              as P+import qualified Control.Proxy.TCP.TLS      as Pt+import           Data.Certificate.X509      (X509)+import           Data.Maybe                 (maybeToList)+import           Data.Monoid                ((<>))+import qualified Network.Socket             as NS+import qualified Network.TLS                as T+import           Network.TLS.Extra          as TE+import           System.Certificate.X509    (getSystemCertificateStore)+import           System.Console.GetOpt+import           System.Environment         (getProgName, getArgs)+import qualified Data.CertificateStore      as C++runTlsTunnel+  :: Pt.ServerSettings       -- ^Local server settings+  -> Pt.HostPreference       -- ^Local host to bind+  -> NS.ServiceName          -- ^Local port to bind+  -> Pt.ClientSettings       -- ^Client to remote server settings.+  -> NS.HostName             -- ^Remote host name to connect to+  -> NS.ServiceName          -- ^Remote tcp port to connect to+  -> IO ()+runTlsTunnel sS sHp sPort cS cHost cPort = do+    Pt.serve sS sHp sPort $ \(sCtx, sAddr) -> do+        let sMsg = show sAddr+        putStrLn $ sMsg <> " joined."+        putStrLn $ sMsg <> " is being tunneled to " <> show (cHost, cPort)+        Pt.connect cS cHost cPort $ \(cCtx, cAddr) -> do+            let cMsg = "Secure connection to " <> show cAddr+            putStrLn $ cMsg <> " established."+            a1 <- A.async . P.runProxy $ Pt.contextReadS sCtx >-> Pt.contextWriteD cCtx+            P.runProxy $ Pt.contextReadS cCtx >-> Pt.contextWriteD sCtx+            A.wait a1+            putStrLn $ cMsg <> " closed."+        putStrLn $ sMsg <> " quit."+++main :: IO ()+main = do+    args <- getArgs+    case getOpt RequireOrder options args of+      (actions, [locHost,locPort,remHost,remPort], _) -> do+        opts <- foldl (>>=) (return defaultOptions) actions+        let !sCred = Pt.Credential (optLocalCert opts) (optLocalKey opts) []+            smcStore = C.makeCertificateStore . pure <$> optLocalCACert opts+            sS = Pt.makeServerSettings sCred smcStore+        ccStore <- case optRemoteCACert opts of+                     Nothing -> getSystemCertificateStore+                     Just ca -> return $ C.makeCertificateStore [ca]+        let !cCreds = maybeToList $ Pt.Credential <$> optRemoteCert opts+                                                  <*> optRemoteKey opts+                                                  <*> pure []+            cS = Pt.makeClientSettings cCreds (Nothing) ccStore+        runTlsTunnel sS (Pt.Host locHost) locPort cS remHost remPort+      (_,_,msgs) -> do+        pn <- getProgName+        let header = "Usage: " <> pn+              <> " [OPTIONS] LOCAL-HOST LOCAL-PORT REMOTE-HOST REMOTE-PORT"+        error $ concat msgs ++ usageInfo header options+++--------------------------------------------------------------------------------+-- The boring stuff below is related to command line parsing+++data Options = Options+  { optLocalCert    :: X509+  , optLocalKey     :: T.PrivateKey+  , optLocalCACert  :: Maybe X509+  , optRemoteCert   :: Maybe X509+  , optRemoteKey    :: Maybe T.PrivateKey+  , optRemoteCACert :: Maybe X509+  } deriving (Show)++defaultOptions :: Options+defaultOptions = Options+  { optLocalCert    = error "Missing optLocalCert"+  , optLocalKey     = error "Missing optLocalKey"+  , optLocalCACert  = Nothing+  , optRemoteCert   = Nothing+  , optRemoteKey    = Nothing+  , optRemoteCACert = Nothing+  }++options :: [OptDescr (Options -> IO Options)]+options =+  [ Option [] ["lcert"]   (ReqArg readLocalCert    "FILE")+    "Local server certificate"+  , Option [] ["lkey"]    (ReqArg readLocalKey     "FILE")+    "Local server private key"+  , Option [] ["lcacert"] (OptArg readLocalCACert  "FILE")+    "If given, request a client certificate for incomming connections\+    \ and verify it against this CA."+  , Option [] ["rcert"]   (OptArg readRemoteCert   "FILE")+    "Certificate to provide to remote server if requested"+  , Option [] ["rkey"]    (OptArg readRemoteKey    "FILE")+    "Key to use together with 'rcert', if requested"+  , Option [] ["rcacert"] (OptArg readRemoteCACert "FILE")+    "If given, verify the remote server certificate using this CA,\+    \ otherwise use the operating system default CAs."+  ]++readLocalCert :: FilePath -> Options -> IO Options+readLocalCert arg opt = do+    cert <- TE.fileReadCertificate arg+    return $ opt { optLocalCert = cert }++readLocalKey :: FilePath -> Options -> IO Options+readLocalKey arg opt = do+    key <- TE.fileReadPrivateKey arg+    return $ opt { optLocalKey = key }++readLocalCACert :: Maybe FilePath -> Options -> IO Options+readLocalCACert Nothing    opt = return opt+readLocalCACert (Just arg) opt = do+    cert <- TE.fileReadCertificate arg+    return $ opt { optLocalCACert = Just cert }++readRemoteCert :: Maybe FilePath -> Options -> IO Options+readRemoteCert Nothing    opt = return opt+readRemoteCert (Just arg) opt = do+    cert <- TE.fileReadCertificate arg+    return $ opt { optRemoteCert = Just cert }++readRemoteKey :: Maybe FilePath -> Options -> IO Options+readRemoteKey Nothing    opt = return opt+readRemoteKey (Just arg) opt = do+    key <- TE.fileReadPrivateKey arg+    return $ opt { optRemoteKey = Just key }++readRemoteCACert :: Maybe FilePath -> Options -> IO Options+readRemoteCACert Nothing    opt = return opt+readRemoteCACert (Just arg) opt = do+    cert <- TE.fileReadCertificate arg+    return $ opt { optRemoteCACert = Just cert }

+ pipes-network-tls.cabal view

@@ -0,0 +1,54 @@+name:               pipes-network-tls+version:            0.1.0.0+license:            BSD3+license-file:       LICENSE+copyright:          Copyright (c) Renzo Carbonara 2013+author:             Renzo Carbonara+maintainer:         renzocarbonaraλgmail.com+stability:          Experimental+tested-with:        GHC == 7.4.1+homepage:           https://github.com/k0001/pipes-network-tls+bug-reports:        https://github.com/k0001/pipes-network-tls/issues+category:           Pipes, Network+build-type:         Simple+synopsis:           TLS-secured network connections support for pipes.+cabal-version:      >=1.8+extra-source-files:+  README.md+  PEOPLE+  examples/tls-echo.hs+  examples/tls-tunnel.hs+description:+  Use TLS-secured network connections together with the @pipes@ ecosystem.+  .+  This package is organized using the following namespaces:+  .+  * "Control.Proxy.TCP.TLS" exports 'Control.Proxy.Proxy's and functions for+  establishing and using TLS-secured TCP connections.+  .+  * "Control.Proxy.TCP.TLS.Safe" is similar to "Control.Proxy.TCP.TLS", except+  the exported 'Control.Proxy.Proxy's themselves can obtain new TLS resources+  safely by using the facilities providied by the @pipes-safe@ package.++source-repository head+    type: git+    location: git://github.com/k0001/pipes-network-tls.git++library+    hs-source-dirs: src+    build-depends:+        base                (==4.*),+        bytestring          (>=0.9.2.1),+        network,+        network-simple-tls  (>=0.1 && <0.2),+        pipes               (>=3.3 && <3.4),+        pipes-safe          (>=1.2 && <1.3),+        pipes-network       (>=0.5 && <0.6),+        tls                 (>=1.1 && <1.2),+        transformers        (>=0.2 && <0.4)+    exposed-modules:+        Control.Proxy.TCP.TLS+        Control.Proxy.TCP.TLS.Safe+    ghc-options: -Wall -fno-warn-unused-do-bind++

+ src/Control/Proxy/TCP/TLS.hs view

@@ -0,0 +1,181 @@+-- | This module exports functions that allow you to use TLS-secured+-- TCP connections as streams, as well as utilities to connect to a+-- TLS-enabled TCP server or running your own.+--+-- If you need to safely connect to a TLS-enabled TCP server or run your own+-- /within/ a pipes pipeline, then you /must/ use the functions exported from+-- the module "Control.Proxy.TCP.TLS.Safe" instead.+--+-- This module re-exports many functions and types from "Network.Simple.TCP.TLS"+-- module in the @network-simple@ package. You might refer to that module for+-- more documentation.++module Control.Proxy.TCP.TLS (+  -- * Client side+  -- $client-side+    S.connect+  , S.ClientSettings+  , S.getDefaultClientSettings+  , S.makeClientSettings++  -- * Server side+  -- $server-side+  , S.serve+  , S.ServerSettings+  , S.makeServerSettings+  -- ** Listening+  , S.listen+  -- ** Accepting+  , S.accept+  , S.acceptFork++  -- * TLS context streams+  -- $socket-streaming+  , contextReadS+  , contextWriteD+  -- ** Timeouts+  -- $socket-streaming-timeout+  , contextReadTimeoutS+  , contextWriteTimeoutD++  -- * Exports+  , S.HostPreference(..)+  , S.Credential(..)+  , Timeout(..)+  ) where++import           Control.Monad.Trans.Class+import qualified Control.Proxy                  as P+import           Control.Proxy.TCP              (Timeout(..))+import qualified Control.Proxy.Trans.Either     as PE+import qualified Data.ByteString                as B+import           Data.Monoid+import qualified Network.Simple.TCP.TLS         as S+import qualified Network.TLS                    as T+import           System.Timeout                 (timeout)++--------------------------------------------------------------------------------++-- $client-side+--+-- Here's how you could run a simple TLS-secured TCP client:+--+-- > import Control.Proxy.TCP.TLS+-- >+-- > settings <- getDefaultClientSettings+-- > connect settings "www.example.org" "443" $ \(tlsCtx, remoteAddr) -> do+-- >   putStrLn $ "Secure connection established to " ++ show remoteAddr+-- >   -- now you may use tlsCtx as you please within this scope, possibly with+-- >   -- the contextReadS or contextWriteD proxies explained below.++--------------------------------------------------------------------------------++-- $server-side+--+-- Here's how you could run a simple TLS-secured TCP server that handles in+-- different threads each incoming connection to port @4433@ at hostname+-- @example.org@. You will need a X509 certificate and a private key appropiate+-- to be used at that hostname.+--+-- > import Control.Proxy.TCP.TLS+-- > import Network.TLS.Extra (fileReadCertificate, fileReadPrivateKey)+-- >+-- > cert <- fileReadCertificate "~/example.org.crt"+-- > pkey <- fileReadPrivateKey  "~/example.org.key"+-- > let cred = Credential cert pkey []+-- >     settings = makeServerSettings cred Nothing+-- >+-- > serve settings (Host "example.org") "4433" $ \(tlsCtx, remoteAddr) -> do+-- >   putStrLn $ "Secure connection established from " ++ show remoteAddr+-- >   -- now you may use tlsCtx as you please within this scope, possibly with+-- >   -- the contextReadS or contextWriteD proxies explained below.+--+-- If you need more control on the way your server runs, then you can use more+-- advanced functions such as 'listen', 'accept' and 'acceptFork'.++--------------------------------------------------------------------------------++-- $socket-streaming+--+-- Once you have an established TLS connection 'T.Context', then you can use the+-- following 'P.Proxy's to interact with the other connection end using streams.++-- | Receives decrypted bytes from the remote end, sending them downstream.+--+-- Up to @16384@ decrypted bytes will be received at once. The TLS connection is+-- automatically renegotiated if a /ClientHello/ message is received.+--+-- If the remote peer closes its side of the connection or EOF is reached,+-- this proxy returns.+contextReadS+  :: P.Proxy p+  => T.Context          -- ^Established TLS connection context.+  -> () -> P.Producer p B.ByteString IO ()+contextReadS ctx = P.runIdentityK loop where+    loop () = do+      mbs <- lift (S.recv ctx)+      case mbs of+        Just bs -> P.respond bs >>= loop+        Nothing -> return ()+{-# INLINABLE contextReadS #-}++-- | Encrypts and sends to the remote end the bytes received from upstream,+-- then forwards such same bytes downstream.+--+-- If the remote peer closes its side of the connection, this proxy returns.+--+-- Requests from downstream are forwarded upstream.+contextWriteD+  :: P.Proxy p+  => T.Context          -- ^Established TLS connection context.+  -> x -> p x B.ByteString x B.ByteString IO r+contextWriteD ctx = P.runIdentityK loop where+    loop x = do+      a <- P.request x+      lift (S.send ctx a)+      P.respond a >>= loop+{-# INLINABLE contextWriteD #-}++--------------------------------------------------------------------------------++-- $socket-streaming-timeout+--+-- These proxies behave like the similarly named ones above, except they support+-- timing out the interaction with the remote end.++-- | Like 'contextReadS', except it throws a 'Timeout' exception in the+-- 'PE.EitherP' proxy transformer if receiving data from the remote end takes+-- more time than specified.+contextReadTimeoutS+  :: P.Proxy p+  => Int                -- ^Timeout in microseconds (1/10^6 seconds).+  -> T.Context          -- ^Established TLS connection context.+  -> () -> P.Producer (PE.EitherP Timeout p) B.ByteString IO ()+contextReadTimeoutS wait ctx = loop where+    loop () = do+      mmbs <- lift (timeout wait (S.recv ctx))+      case mmbs of+        Just (Just bs) -> P.respond bs >>= loop+        Just Nothing   -> return ()+        Nothing        -> PE.throw ex+    ex = Timeout $ "contextReadTimeoutS: " <> show wait <> " microseconds."+{-# INLINABLE contextReadTimeoutS #-}++-- | Like 'contextWriteD', except it throws a 'Timeout' exception in the+-- 'PE.EitherP' proxy transformer if sending data to the remote end takes+-- more time than specified.+contextWriteTimeoutD+  :: P.Proxy p+  => Int                -- ^Timeout in microseconds (1/10^6 seconds).+  -> T.Context          -- ^Established TLS connection context.+  -> x -> (PE.EitherP Timeout p) x B.ByteString x B.ByteString IO r+contextWriteTimeoutD wait ctx = loop where+    loop x = do+      a <- P.request x+      m <- lift (timeout wait (S.send ctx a))+      case m of+        Just () -> P.respond a >>= loop+        Nothing -> PE.throw ex+    ex = Timeout $ "contextWriteTimeoutD: " <> show wait <> " microseconds."+{-# INLINABLE contextWriteTimeoutD #-}+

+ src/Control/Proxy/TCP/TLS/Safe.hs view

@@ -0,0 +1,476 @@+{-# LANGUAGE Rank2Types #-}++-- | This module exports functions that allow you to use TLS-secured+-- TCP connections as 'P.Proxy' streams, as well as utilities to connect to a+-- TLS-enabled TCP server or running your own, possibly within the pipeline+-- itself by relying on the facilities provided by 'P.ExceptionP' from the+-- @pipes-safe@ library.+--+-- If you don't need to establish new TLS connections within your pipeline,+-- then consider using the simpler and similar functions exported by+-- "Control.Proxy.TCP.TLS".+--+-- This module re-exports many functions and types from "Network.Simple.TCP.TLS"+-- module in the @network-simple@ package. You might refer to that module for+-- more documentation.++module Control.Proxy.TCP.TLS.Safe (+  -- * Client side+  -- $client-side+    connect+  , S.ClientSettings+  , S.getDefaultClientSettings+  , S.makeClientSettings+  -- ** Streaming+  -- $client-streaming+  , connectReadS+  , connectWriteD++  -- * Server side+  -- $server-side+  , serve+  , S.ServerSettings+  , S.makeServerSettings+  -- ** Listening+  , listen+  -- ** Accepting+  , accept+  , acceptFork+  -- ** Streaming+  -- $server-streaming+  , serveReadS+  , serveWriteD++  -- * Socket streams+  -- $socket-streaming+  , contextReadS+  , contextWriteD++  -- * Exports+  , S.HostPreference(..)+  , S.Credential(..)+  , Timeout(..)+  ) where+++import           Control.Concurrent              (ThreadId)+import qualified Control.Exception               as E+import           Control.Monad+import qualified Control.Proxy                   as P+import qualified Control.Proxy.Safe              as P+import           Control.Proxy.TCP.Safe          (listen, Timeout(..))+import qualified Data.ByteString                 as B+import           Data.Monoid+import qualified GHC.IO.Exception                as Eg+import qualified Network.Socket                  as NS+import qualified Network.Simple.TCP.TLS          as S+import qualified Network.TLS                     as T+import           System.Timeout                  (timeout)++--------------------------------------------------------------------------------++-- $client-side+--+-- Here's how you could run a simple TLS-secured TCP client:+--+-- > import Control.Proxy.TCP.TLS.Safe+-- >+-- > settings <- getDefaultClientSettings+-- > connect settings "www.example.org" "443" $ \(tlsCtx, remoteAddr) -> do+-- >   tryIO . putStrLn $ "Secure connection established to " ++ show remoteAddr+-- >   -- now you may use tlsCtx as you please within this scope, possibly with+-- >   -- the contextReadS or contextWriteD proxies explained below.+--+-- You might prefer to use the simpler but less general solutions offered by+-- 'connectReadS' and 'connectWriteD', so check those too.++--------------------------------------------------------------------------------++-- | Connect to a TLS-secured TCP server and use the connection.+--+-- A TLS handshake is performed immediately after establishing the TCP+-- connection.+--+-- The connection is properly closed when done or in case of exceptions. If you+-- need to manage the lifetime of the connection resources yourself, then use+-- 'connectTls' instead.+connect+  :: (P.Proxy p, Monad m)+  => (forall x. P.SafeIO x -> m x) -- ^Monad morphism.+  -> S.ClientSettings              -- ^TLS settings.+  -> NS.HostName                   -- ^Server hostname.+  -> NS.ServiceName                -- ^Server service port.+  -> ((T.Context, NS.SockAddr) -> P.ExceptionP p a' a b' b m r)+                          -- ^Computation to run in a different thread+                          -- once a TLS-secured connection is established. Takes+                          -- the TLS connection context and remote end address.+  -> P.ExceptionP p a' a b' b m r+connect morph cs host port  k = do+    P.bracket morph (S.connectTls cs host port)+                    (contextCloseNoVanish . fst)+                    (useTls morph k)++--------------------------------------------------------------------------------++-- $client-streaming+--+-- The following proxies allow you to easily connect to a TLS-secured TCP server+-- and immediately interact with it using streams, all at once, instead of+-- having to perform the individual steps separately.++--------------------------------------------------------------------------------++-- | Connect to a TLS-secured TCP server and send downstream the decrypted bytes+-- received from the remote end.+--+-- Up to @16384@ decrypted bytes will be received at once. The TLS connection is+-- automatically renegotiated if a /ClientHello/ message is received.+--+-- If an optional timeout is given and receiveing data from the remote end takes+-- more time that such timeout, then throw a 'Timeout' exception in the+-- 'P.ExceptionP' proxy transformer.+--+-- If the remote peer closes its side of the connection of EOF is reached, this+-- proxy returns.+--+-- The connection is closed when done or in case of exceptions.+--+-- Using this proxy you can write code like the following, which prints whatever+-- is received through a TLS-secured TCP connection to a given server listening+-- at hostname "example.org" on port 4433:+--+-- >>> settings <- getDefaultClientSettings+-- >>> let src = connectReadS Nothing settings "www.example.org" "4433"+-- >>> runSafeIO . runProxy . runEitherK $ src >-> try . printD+connectReadS+  :: P.Proxy p+  => Maybe Int          -- ^Optional timeout in microseconds (1/10^6 seconds).+  -> S.ClientSettings   -- ^TLS settings.+  -> NS.HostName+  -> NS.ServiceName     -- ^Server service port.+  -> () -> P.Producer (P.ExceptionP p) B.ByteString P.SafeIO ()+connectReadS mwait cs host port = \() -> do+   connect id cs host port $ \(ctx,_) -> do+     contextReadS mwait ctx ()++-- | Connects to a TLS-secured TCP server, encrypts and sends to the remote end+-- the bytes received from upstream, then forwards such same bytes downstream.+--+-- Requests from downstream are forwarded upstream.+--+-- If an optional timeout is given and sending data to the remote end takes+-- more time that such timeout, then throw a 'Timeout' exception in the+-- 'P.ExceptionP' proxy transformer.+--+-- The connection is properly closed when done or in case of exceptions.+--+-- Using this proxy you can write code like the following, which sends data to a+-- TLS-secured TCP server listening at hostname "example.org" on port 4433:+--+-- >>> :set -XOverloadedStrings+-- >>> settings <- getDefaultClientSettings+-- >>> let dst = connectWriteS Nothing settings "www.example.org" "4433"+-- >>> runSafeIO . runProxy . runEitherK $ fromListS ["He","llo\r\n"] >-> dst+connectWriteD+  :: P.Proxy p+  => Maybe Int          -- ^Optional timeout in microseconds (1/10^6 seconds).+  -> S.ClientSettings   -- ^TLS settings.+  -> NS.HostName        -- ^Server host name.+  -> NS.ServiceName     -- ^Server service port.+  -> x -> (P.ExceptionP p) x B.ByteString x B.ByteString P.SafeIO r+connectWriteD mwait cs hp port = \x -> do+   connect id cs hp port $ \(ctx,_) ->+     contextWriteD mwait ctx x++--------------------------------------------------------------------------------++-- $server-side+--+-- Here's how you could run a simple TLS-secured TCP server that handles in+-- different threads each incoming connection to port @4433@ at hostname+-- @example.org@. You will need a X509 certificate and a private key appropiate+-- to be used at that hostname.+--+-- > import Control.Proxy.TCP.TLS.Safe+-- > import Network.TLS.Extra (fileReadCertificate, fileReadPrivateKey)+-- >+-- > cert <- fileReadCertificate "~/example.org.crt"+-- > pkey <- fileReadPrivateKey  "~/example.org.key"+-- > let cred = Credential cert pkey []+-- >     settings = makeServerSettings cred Nothing+-- >+-- > serve settings (Host "example.org") "4433" $ \(tlsCtx, remoteAddr) -> do+-- >   tryIO . putStrLn $ "Secure connection established from " ++ show remoteAddr+-- >   -- now you may use tlsCtx as you please within this scope, possibly with+-- >   -- the contextReadS or contextWriteD proxies explained below.+--+-- You might prefer to use the simpler but less general solutions offered by+-- 'serveReadS' and 'serveWriteD', or if you need to control the way your+-- server runs, then you can use more advanced functions such as 'listen',+-- 'accept' and 'acceptFork', so check those functions too.++--------------------------------------------------------------------------------++-- | Start a TLS-secured TCP server that accepts incoming connections and+-- handles each of them concurrently, in different threads.+--+-- A TLS handshake is performed immediately after establishing each TCP+-- connection.+--+-- Any acquired network resources are properly closed and discarded when done or+-- in case of exceptions.+--+-- Note: This function binds a listening socket, accepts an connection, performs+-- a TLS handshake and then safely closes the connection. You don't need to+-- perform any of those steps manually.+serve+  :: (P.Proxy p, Monad m)+  => (forall x. P.SafeIO x -> m x) -- ^Monad morphism.+  -> S.ServerSettings              -- ^TLS settings.+  -> S.HostPreference              -- ^Preferred host to bind.+  -> NS.ServiceName                -- ^Service port to bind.+  -> ((T.Context, NS.SockAddr) -> IO ())+                          -- ^Computation to run in a different thread+                          -- once an incomming connection is accepted and a+                          -- TLS-secured communication is established. Takes the+                          -- TLS connection context and remote end address.+  -> P.ExceptionP p a' a b' b m r+serve morph ss hp port k = do+   listen morph hp port $ \(lsock,_) -> do+     forever $ acceptFork morph ss lsock k++--------------------------------------------------------------------------------++-- | Accept a single incoming TLS-secured TCP connection and use it.+--+-- A TLS handshake is performed immediately after establishing each TCP+-- connection.+--+-- The connection properly closed when done or in case of exceptions.+accept+  :: (P.Proxy p, Monad m)+  => (forall x. P.SafeIO x -> m x) -- ^Monad morphism.+  -> S.ServerSettings              -- ^TLS settings.+  -> NS.Socket                     -- ^Listening and bound socket.+  -> ((T.Context, NS.SockAddr) -> P.ExceptionP p a' a b' b m r)+                          -- ^Computation to run once an incomming connection is+                          -- accepted and a TLS-secured communication is+                          -- established. Takes the TLS connection context and+                          -- remote end address.+  -> P.ExceptionP p a' a b' b m r+accept morph ss lsock k = do+    P.bracket morph (S.acceptTls ss lsock)+                    (contextCloseNoVanish . fst)+                    (useTls morph k)+{-# INLINABLE accept #-}++-- | Like 'accept', except it uses a different thread to performs the TLS+-- handshake and run the given computation.+acceptFork+  :: (P.Proxy p, Monad m)+  => (forall x. P.SafeIO x -> m x) -- ^Monad morphism.+  -> S.ServerSettings              -- ^TLS settings.+  -> NS.Socket                     -- ^Listening and bound socket.+  -> ((T.Context, NS.SockAddr) -> IO ())+                          -- ^Computation to run in a different thread+                          -- once an incomming connection is accepted and a+                          -- TLS-secured communication is established. Takes the+                          -- TLS connection context and remote end address.+  -> P.ExceptionP p a' a b' b m ThreadId+acceptFork morph ss lsock k = P.hoist morph . P.tryIO $ S.acceptFork ss lsock k+{-# INLINABLE acceptFork #-}++--------------------------------------------------------------------------------++-- $server-streaming+--+-- The following proxies allow you to easily run a TLS-secured TCP server and+-- immediately interact with incoming connections using streams, all at once,+-- instead of having to perform the individual steps separately.++--------------------------------------------------------------------------------++-- | Binds a listening TCP socket, accepts a single TLS-secured connection and+-- sends downstream any decrypted bytes received from the remote end.+--+-- Up to @16384@ decrypted bytes will be received at once. The TLS connection is+-- automatically renegotiated if a /ClientHello/ message is received.+--+-- If an optional timeout is given and receiveing data from the remote end takes+-- more time that such timeout, then throw a 'Timeout' exception in the+-- 'P.ExceptionP' proxy transformer.+--+-- If the remote peer closes its side of the connection of EOF is reached,  this+-- proxy returns.+--+-- Both the listening and connection sockets are closed when done or in case of+-- exceptions.+--+-- Using this proxy you can write code like the following, which prints data+-- received from a TLS-secured TCP connection to the hostname "example.org" at+-- port 4433:+--+-- >>> import Network.TLS.Extra (fileReadCertificate, fileReadPrivateKey)+-- >>> cert <- fileReadCertificate "~/example.org.crt"+-- >>> pkey <- fileReadPrivateKey  "~/example.org.key"+-- >>> let settings = makeServerSettings cert pkey Nothing+-- >>> let src = serveReadS Nothing settings (Host "example.org") "4433"+-- >>> runSafeIO . runProxy . runEitherK $ src >-> try . printD+serveReadS+  :: P.Proxy p+  => Maybe Int          -- ^Optional timeout in microseconds (1/10^6 seconds).+  -> S.ServerSettings   -- ^TLS settings.+  -> S.HostPreference   -- ^Preferred host to bind.+  -> NS.ServiceName     -- ^Service port to bind.+  -> () -> P.Producer (P.ExceptionP p) B.ByteString P.SafeIO ()+serveReadS mwait ss hp port = \() -> do+   listen id hp port $ \(lsock,_) -> do+     accept id ss lsock $ \(csock,_) -> do+       contextReadS mwait csock ()++-- | Binds a listening TCP socket, accepts a single TLS-secured connection,+-- sends to the remote end the bytes received from upstream and then forwards+-- such sames bytesdownstream.+--+-- Requests from downstream are forwarded upstream.+--+-- If an optional timeout is given and sending data to the remote end takes+-- more time that such timeout, then throw a 'Timeout' exception in the+-- 'P.ExceptionP' proxy transformer.+--+-- If the remote peer closes its side of the connection, this proxy returns.+--+-- Both the listening and connection sockets are closed when done or in case of+-- exceptions.+--+-- Using this proxy you can write straightforward code like the following, which+-- sends data to an incoming TLS-secured TCP connection to the hostname+-- "example.org" at port 4433:+--+-- >>> :set -XOverloadedStrings+-- >>> import Network.TLS.Extra (fileReadCertificate, fileReadPrivateKey)+-- >>> cert <- fileReadCertificate "~/example.org.crt"+-- >>> pkey <- fileReadPrivateKey  "~/example.org.key"+-- >>> let settings = makeServerSettings cert pkey Nothing+-- >>> let dst = serveWriteD Nothing settings "example.org" "4433"+-- >>> runSafeIO . runProxy . runEitherK $ fromListS ["He","llo\r\n"] >-> dst+serveWriteD+  :: P.Proxy p+  => Maybe Int          -- ^Optional timeout in microseconds (1/10^6 seconds).+  -> S.ServerSettings   -- ^TLS settings.+  -> S.HostPreference   -- ^Preferred host to bind.+  -> NS.ServiceName     -- ^Service port to bind.+  -> x -> (P.ExceptionP p) x B.ByteString x B.ByteString P.SafeIO r+serveWriteD mwait ss hp port = \x -> do+   listen id hp port $ \(lsock,_) -> do+     accept id ss lsock $ \(csock,_) -> do+       contextWriteD mwait csock x++--------------------------------------------------------------------------------++-- $socket-streaming+--+-- Once you have a an established TLS 'T.Context', you can use the following+-- 'P.Proxy's to interact with the other connection end using pipes streams.++--------------------------------------------------------------------------------++-- | Receives decrypted bytes from the remote end, sending them downstream.+--+-- Up to @16384@ decrypted bytes will be received at once. The TLS connection is+-- automatically renegotiated if a /ClientHello/ message is received.+--+-- If an optional timeout is given and receiveing data from the remote end takes+-- more time that such timeout, then throw a 'Timeout' exception in the+-- 'P.ExceptionP' proxy transformer.+--+-- If the remote peer closes its side of the connection or EOF is reached, this+-- proxy returns.+contextReadS+  :: P.Proxy p+  => Maybe Int          -- ^Optional timeout in microseconds (1/10^6 seconds).+  -> T.Context          -- ^Established TLS connection context.+  -> () -> P.Producer (P.ExceptionP p) B.ByteString P.SafeIO ()+contextReadS Nothing ctx = loop where+    loop () = do+      mbs <- P.tryIO (S.recv ctx)+      case mbs of+        Nothing -> return ()+        Just bs -> P.respond bs >>= loop+contextReadS (Just wait) ctx = loop where+    loop () = do+      mmbs <- P.tryIO (timeout wait (S.recv ctx))+      case mmbs of+        Nothing        -> P.throw ex+        Just Nothing   -> return ()+        Just (Just bs) -> P.respond bs >>= loop+    ex = Timeout $ "contextReadS: " <> show wait <> " microseconds."+{-# INLINABLE contextReadS #-}++-- | Encrypts and sends to the remote end the bytes received from upstream,+-- then forwards such same bytes downstream.+--+-- If an optional timeout is given and sending data to the remote end takes+-- more time that such timeout, then throw a 'Timeout' exception in the+-- 'P.ExceptionP' proxy transformer.+--+-- If the remote peer closes its side of the connection, this proxy returns.+--+-- Requests from downstream are forwarded upstream.+contextWriteD+  :: P.Proxy p+  => Maybe Int          -- ^Optional timeout in microseconds (1/10^6 seconds).+  -> T.Context          -- ^Established TLS connection context.+  -> x -> (P.ExceptionP p) x B.ByteString x B.ByteString P.SafeIO r+contextWriteD Nothing ctx = loop where+    loop x = do+      a <- P.request x+      P.tryIO (S.send ctx a)+      P.respond a >>= loop+contextWriteD (Just wait) ctx = loop where+    loop x = do+      a <- P.request x+      m <- P.tryIO (timeout wait (S.send ctx a))+      case m of+        Just () -> P.respond a >>= loop+        Nothing -> P.throw ex+    ex = Timeout $ "contextWriteD: " <> show wait <> " microseconds."+{-# INLINABLE contextWriteD #-}++++--------------------------------------------------------------------------------+-- Internal stuff+++-- | Perform a TLS 'T.handshake' on the given 'T.Context', then perform the+-- given action, and at last say 'T.bye' and close the TLS connection, even in+-- case of exceptions. Like 'S.useTls', except it runs within 'P.ExceptionP'.+--+-- This function discards 'Eg.ResourceVanished' exceptions that will happen when+-- trying to say 'T.bye' if the remote end has done it before.+useTls+  :: (Monad m, P.Proxy p)+  => (forall x. P.SafeIO x -> m x) -- ^Monad morphism.+  -> ((T.Context, NS.SockAddr) -> P.ExceptionP p a' a b' b m r)+  -> (T.Context, NS.SockAddr) -> P.ExceptionP p a' a b' b m r+useTls morph k = \conn@(ctx,_) -> do+    P.bracket_ morph (T.handshake ctx) (byeNoVanish ctx) (k conn)+{-# INLINABLE useTls #-}+++-- | Like `T.bye`, except it ignores `ResourceVanished` exceptions.+byeNoVanish :: T.Context -> IO ()+byeNoVanish ctx =+    E.handle (\Eg.IOError{Eg.ioe_type=Eg.ResourceVanished} -> return ())+             (T.bye ctx)+{-# INLINABLE byeNoVanish #-}++-- | Like `T.contextClose`, except it ignores `ResourceVanished` exceptions.+contextCloseNoVanish :: T.Context -> IO ()+contextCloseNoVanish = \ctx ->+    E.handle (\Eg.IOError{Eg.ioe_type=Eg.ResourceVanished} -> return ())+             (T.contextClose ctx)+{-# INLINABLE contextCloseNoVanish #-}++