network-conduit-tls 1.0.1.1 → 1.0.2

raw patch · 2 files changed

+120/−4 lines, 2 filesdep +connectiondep +data-defaultdep +monad-control

Dependencies added: connection, data-default, monad-control

Files

• Data/Conduit/Network/TLS.hs +116/−3
• network-conduit-tls.cabal +4/−1

@@ -1,8 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE KindSignatures #-} module Data.Conduit.Network.TLS-    ( TLSConfig+    ( -- * Server+      TLSConfig     , tlsConfig     , tlsHost     , tlsPort@@ -11,6 +15,16 @@     , tlsNeedLocalAddr     , tlsAppData     , runTCPServerTLS+      -- * Client+    , TLSClientConfig+    , tlsClientConfig+    , runTLSClient+    , tlsClientPort+    , tlsClientHost+    , tlsClientUseTLS+    , tlsClientTLSSettings+    , tlsClientSockSettings+    , tlsClientConnectionContext     ) where  import Prelude hiding (FilePath, readFile)@@ -28,14 +42,15 @@ import Data.Conduit.Network (HostPreference, Application, bindPort, sinkSocket, acceptSafe) import Data.Conduit.Network.Internal (AppData (..)) import Data.Conduit.Network.TLS.Internal-import Data.Conduit (($$), yield)+import Data.Conduit (($$), yield, awaitForever, Producer, Consumer) import qualified Data.Conduit.List as CL import Data.Either (rights)-import Network.Socket (sClose, getSocketName, SockAddr)+import Network.Socket (sClose, getSocketName, SockAddr (SockAddrInet)) import Network.Socket.ByteString (recv, sendAll) import Control.Exception (bracket, finally) import Control.Concurrent (forkIO) import Control.Monad.Trans.Class (lift)+import Control.Monad.IO.Class (liftIO, MonadIO) import qualified Network.TLS.Extra as TLSExtra #if MIN_VERSION_tls(1, 1, 0) import Crypto.Random.API (getSystemRandomGen, SystemRandom)@@ -44,9 +59,13 @@ #endif import Network.Socket (Socket) import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8 #if MIN_VERSION_tls(1, 1, 3) import qualified Crypto.Random.AESCtr #endif+import qualified Network.Connection as NC+import Control.Monad.Trans.Control+import Data.Default  tlsConfig :: HostPreference           -> Int -- ^ port@@ -195,3 +214,97 @@             if S.length next == 0                 then return $ S.concat $ front []                 else loop (front . (next:)) $ rest - S.length next++-- | Settings type for TLS client connection.+--+-- Since 1.0.2+data TLSClientConfig (m :: * -> *) = TLSClientConfig+    { tlsClientPort :: Int+    -- ^+    --+    -- Since 1.0.2+    , tlsClientHost :: S.ByteString+    -- ^+    --+    -- Since 1.0.2+    , tlsClientUseTLS :: Bool+    -- ^ Default is True. If set to @False@, will make a non-TLS connection.+    --+    -- Since 1.0.2+    , tlsClientTLSSettings :: NC.TLSSettings+    -- ^ TLS settings to use. If not provided, defaults will be provided.+    --+    -- Since 1.0.2+    , tlsClientSockSettings :: Maybe NC.SockSettings+    -- ^ Socks configuration; default is @Nothing@. If absent, Socks will not be used.+    --+    -- Since 1.0.2+    , tlsClientConnectionContext :: Maybe NC.ConnectionContext+    -- ^ Connection context. Default is @Nothing@, which will generate a new+    -- context automatically. If you will be making many connections, it's+    -- recommended to call 'NC.initConnectionContext' yourself.+    --+    -- Since 1.0.2+    }++-- | Smart constructor for @TLSClientConfig@.+--+-- Since 1.0.2+tlsClientConfig :: Int -- ^ port+                -> S.ByteString -- ^ host+                -> TLSClientConfig m+tlsClientConfig port host = TLSClientConfig+    { tlsClientPort = port+    , tlsClientHost = host+    , tlsClientUseTLS = True+    , tlsClientTLSSettings = def+    , tlsClientSockSettings = Nothing+    , tlsClientConnectionContext = Nothing+    }++-- | Run an application with the given configuration.+--+-- Since 1.0.2+runTLSClient :: (MonadIO m, MonadBaseControl IO m)+             => TLSClientConfig m+             -> Application m+             -> m ()+runTLSClient TLSClientConfig {..} app = do+    context <- maybe (liftIO NC.initConnectionContext) return tlsClientConnectionContext+    let params = NC.ConnectionParams+            { NC.connectionHostname = S8.unpack tlsClientHost+            , NC.connectionPort = fromIntegral tlsClientPort+            , NC.connectionUseSecure =+                if tlsClientUseTLS+                    then Just tlsClientTLSSettings+                    else Nothing+            , NC.connectionUseSocks = tlsClientSockSettings+            }+    control $ \run -> bracket+        (NC.connectTo context params)+        NC.connectionClose+        (\conn -> run $ app AppData+            { appSource = sourceConnection conn+            , appSink = sinkConnection conn+            , appSockAddr = SockAddrInet (fromIntegral tlsClientPort) 0 -- FIXME+            , appLocalAddr = Nothing+            })++-- | Read from a 'NC.Connection'.+--+-- Since 1.0.2+sourceConnection :: MonadIO m => NC.Connection -> Producer m S.ByteString+sourceConnection conn =+    loop+  where+    loop = do+        bs <- liftIO $ NC.connectionGetChunk conn+        if S.null bs+            then return ()+            else yield bs >> loop++-- | Write to a 'NC.Connection'.+--+-- Since 1.0.2+sinkConnection :: MonadIO m => NC.Connection -> Consumer S.ByteString m ()+sinkConnection conn = awaitForever (liftIO . NC.connectionPut conn)

@@ -1,5 +1,5 @@ name:                network-conduit-tls-version:             1.0.1.1+version:             1.0.2 synopsis:            Create TLS-aware network code with conduits description:         Uses the tls package for a pure-Haskell implementation. homepage:            https://github.com/snoyberg/conduit@@ -30,3 +30,6 @@                     , crypto-api      >= 0.10                     , crypto-random-api >= 0.2                     , cprng-aes+                    , connection+                    , monad-control+                    , data-default