{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE KindSignatures #-}
module Data.Conduit.Network.TLS
    ( -- * Common
      ApplicationStartTLS
    , GeneralApplicationStartTLS
      -- * Server
    , TLSConfig
    , tlsConfigBS
    , tlsConfig
    , tlsConfigChainBS
    , tlsConfigChain
    , tlsHost
    , tlsPort
--    , tlsCertificate
--    , tlsKey
    , tlsNeedLocalAddr
    , tlsAppData
    , runTCPServerTLS
    , runGeneralTCPServerTLS
    , runTCPServerStartTLS
      -- * Client
    , TLSClientConfig
    , tlsClientConfig
    , runTLSClient
    , runTLSClientStartTLS
    , tlsClientPort
    , tlsClientHost
    , tlsClientUseTLS
    , tlsClientTLSSettings
    , tlsClientSockSettings
    , tlsClientConnectionContext
      -- * Misc
    , sourceConnection
    , sinkConnection
    ) where

import Control.Applicative ((<$>), (<*>))
import qualified Data.ByteString.Lazy as L
import qualified Network.TLS as TLS
import Data.Conduit.Network (runTCPServerWithHandle, serverSettings)
import Data.Streaming.Network.Internal (AppData (..), HostPreference)
import Data.Streaming.Network (safeRecv)
import Data.Conduit.Network.TLS.Internal
import Data.Conduit (yield, awaitForever, ConduitT)
import Network.Socket (SockAddr (SockAddrInet))
import qualified Network.Socket as NS
import Network.Socket.ByteString (sendAll)
import Control.Exception (bracket)
import Control.Monad.IO.Unlift (liftIO, MonadIO, MonadUnliftIO, withRunInIO, withUnliftIO, unliftIO)
import qualified Network.TLS.Extra as TLSExtra
import Network.Socket (Socket)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Network.Connection as NC
import Data.Default.Class (def)

makeCertDataPath :: FilePath -> [FilePath] -> FilePath -> TlsCertData
makeCertDataPath :: FilePath -> [FilePath] -> FilePath -> TlsCertData
makeCertDataPath FilePath
certPath [FilePath]
chainCertPaths FilePath
keyPath =
    IO ByteString -> IO [ByteString] -> IO ByteString -> TlsCertData
TlsCertData
      (FilePath -> IO ByteString
S.readFile FilePath
certPath)
      (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO ByteString
S.readFile [FilePath]
chainCertPaths)
      (FilePath -> IO ByteString
S.readFile FilePath
keyPath)

makeCertDataBS :: S.ByteString -> [S.ByteString] -> S.ByteString ->
                  TlsCertData
makeCertDataBS :: ByteString -> [ByteString] -> ByteString -> TlsCertData
makeCertDataBS ByteString
certBS [ByteString]
chainCertsBS ByteString
keyBS =
    IO ByteString -> IO [ByteString] -> IO ByteString -> TlsCertData
TlsCertData (forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
certBS) (forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
chainCertsBS) (forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
keyBS)

tlsConfig :: HostPreference
          -> Int -- ^ port
          -> FilePath -- ^ certificate
          -> FilePath -- ^ key
          -> TLSConfig
tlsConfig :: HostPreference -> Int -> FilePath -> FilePath -> TLSConfig
tlsConfig HostPreference
a Int
b FilePath
c FilePath
d = HostPreference
-> Int -> FilePath -> [FilePath] -> FilePath -> TLSConfig
tlsConfigChain HostPreference
a Int
b FilePath
c [] FilePath
d


-- | allow to build a server config directly from raw bytestring data (exact same
-- string as if the certificates were read from the filesystem).
-- this enables to plug another backend to fetch certifcates (other than FS)
tlsConfigBS :: HostPreference
            -> Int          -- ^ port
            -> S.ByteString -- ^ Certificate raw data
            -> S.ByteString -- ^ Key file raw data
            -> TLSConfig
tlsConfigBS :: HostPreference -> Int -> ByteString -> ByteString -> TLSConfig
tlsConfigBS HostPreference
a Int
b ByteString
c ByteString
d = HostPreference
-> Int -> ByteString -> [ByteString] -> ByteString -> TLSConfig
tlsConfigChainBS HostPreference
a Int
b ByteString
c [] ByteString
d

-- | Like 'tlsConfig', but also allow specifying chain certificates.
--
-- Since 1.1.1
tlsConfigChain :: HostPreference
               -> Int -- ^ Port
               -> FilePath -- ^ Certificate
               -> [FilePath] -- ^ Chain certificates
               -> FilePath -- ^ Key
               -> TLSConfig
tlsConfigChain :: HostPreference
-> Int -> FilePath -> [FilePath] -> FilePath -> TLSConfig
tlsConfigChain HostPreference
a Int
b FilePath
c [FilePath]
d FilePath
e = HostPreference -> Int -> TlsCertData -> Bool -> TLSConfig
TLSConfig HostPreference
a Int
b (FilePath -> [FilePath] -> FilePath -> TlsCertData
makeCertDataPath FilePath
c [FilePath]
d FilePath
e) Bool
False


-- | Like 'tlsConfigBS', but also allow specifying chain certificates.
--
-- Since 1.1.1
tlsConfigChainBS :: HostPreference
                 -> Int          -- ^ Port
                 -> S.ByteString -- ^ Certificate raw data
                 -> [S.ByteString] -- ^ Chain certificate raw data
                 -> S.ByteString -- ^ Key file raw data
                 -> TLSConfig
tlsConfigChainBS :: HostPreference
-> Int -> ByteString -> [ByteString] -> ByteString -> TLSConfig
tlsConfigChainBS HostPreference
a Int
b ByteString
c [ByteString]
d ByteString
e = HostPreference -> Int -> TlsCertData -> Bool -> TLSConfig
TLSConfig HostPreference
a Int
b (ByteString -> [ByteString] -> ByteString -> TlsCertData
makeCertDataBS ByteString
c [ByteString]
d ByteString
e) Bool
False

serverHandshake :: Socket -> TLS.Credentials -> IO (TLS.Context)
serverHandshake :: Socket -> Credentials -> IO Context
serverHandshake Socket
socket Credentials
creds = do
    Context
ctx <- forall (m :: * -> *) backend params.
(MonadIO m, HasBackend backend, TLSParams params) =>
backend -> params -> m Context
TLS.contextNew
           TLS.Backend
                    { backendFlush :: IO ()
TLS.backendFlush = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    , backendClose :: IO ()
TLS.backendClose = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    , backendSend :: ByteString -> IO ()
TLS.backendSend = Socket -> ByteString -> IO ()
sendAll Socket
socket
                    , backendRecv :: Int -> IO ByteString
TLS.backendRecv = Socket -> Int -> IO ByteString
recvExact Socket
socket
                    }
            ServerParams
params

    forall (m :: * -> *). MonadIO m => Context -> m ()
TLS.handshake Context
ctx
    forall (m :: * -> *) a. Monad m => a -> m a
return Context
ctx

  where
    params :: ServerParams
params = forall a. Default a => a
def
        { serverWantClientCert :: Bool
TLS.serverWantClientCert = Bool
False
        , serverSupported :: Supported
TLS.serverSupported = forall a. Default a => a
def
            { supportedCiphers :: [Cipher]
TLS.supportedCiphers = [Cipher]
TLSExtra.ciphersuite_default
            }
        , serverShared :: Shared
TLS.serverShared = forall a. Default a => a
def
            { sharedCredentials :: Credentials
TLS.sharedCredentials = Credentials
creds
            }
        }

runTCPServerTLS :: TLSConfig -> (AppData -> IO ()) -> IO ()
runTCPServerTLS :: TLSConfig -> (AppData -> IO ()) -> IO ()
runTCPServerTLS TLSConfig{Bool
Int
HostPreference
TlsCertData
tlsCertData :: TLSConfig -> TlsCertData
tlsNeedLocalAddr :: Bool
tlsCertData :: TlsCertData
tlsPort :: Int
tlsHost :: HostPreference
tlsNeedLocalAddr :: TLSConfig -> Bool
tlsPort :: TLSConfig -> Int
tlsHost :: TLSConfig -> HostPreference
..} AppData -> IO ()
app = do
    Credentials
creds <- TlsCertData -> IO Credentials
readCreds TlsCertData
tlsCertData

    forall a. ServerSettings -> ConnectionHandle -> IO a
runTCPServerWithHandle ServerSettings
settings (Credentials -> ConnectionHandle
wrapApp Credentials
creds)

    where
      -- convert tls settings to regular conduit network ones
      settings :: ServerSettings
settings = Int -> HostPreference -> ServerSettings
serverSettings Int
tlsPort HostPreference
tlsHost  -- (const $ return () ) tlsNeedLocalAddr

      wrapApp :: Credentials -> ConnectionHandle
wrapApp Credentials
creds = ConnectionHandle
app'
        where
          app' :: ConnectionHandle
app' Socket
socket SockAddr
addr Maybe SockAddr
mlocal = do
            Context
ctx <- Socket -> Credentials -> IO Context
serverHandshake Socket
socket Credentials
creds
            AppData -> IO ()
app (Context -> SockAddr -> Maybe SockAddr -> AppData
tlsAppData Context
ctx SockAddr
addr Maybe SockAddr
mlocal)
            forall (m :: * -> *). MonadIO m => Context -> m ()
TLS.bye Context
ctx

-- |
--
-- @since 1.2.2
type GeneralApplicationStartTLS m a = (AppData, (AppData -> m ()) -> m ()) -> m a

type ApplicationStartTLS = GeneralApplicationStartTLS IO ()

-- | Like 'runTCPServerTLS', but monad can be any instance of 'MonadUnliftIO'.
--
-- Note that any changes to the monadic state performed by individual
-- client handlers will be discarded. If you have mutable state you want
-- to share among multiple handlers, you need to use some kind of mutable
-- variables.
--
-- Since 1.1.2
runGeneralTCPServerTLS :: MonadUnliftIO m => TLSConfig -> (AppData -> m ()) -> m ()
runGeneralTCPServerTLS :: forall (m :: * -> *).
MonadUnliftIO m =>
TLSConfig -> (AppData -> m ()) -> m ()
runGeneralTCPServerTLS TLSConfig
config AppData -> m ()
app = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
  TLSConfig -> (AppData -> IO ()) -> IO ()
runTCPServerTLS TLSConfig
config forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppData -> m ()
app

-- | run a server un-crypted but also pass a call-back to trigger a StartTLS handshake
-- on the underlying connection
--
-- Sample usage:
-- 
-- > runTCPServerStartTLS serverConfig $ \(appData,startTLS) -> do
-- >   abortTLS <- doSomethingInClear appData
-- >   unless abortTLS $ startTls $ \appDataTls -> do
-- >     doSomethingSSL appDataTls
runTCPServerStartTLS :: MonadUnliftIO m => TLSConfig -> GeneralApplicationStartTLS m () -> m ()
runTCPServerStartTLS :: forall (m :: * -> *).
MonadUnliftIO m =>
TLSConfig -> GeneralApplicationStartTLS m () -> m ()
runTCPServerStartTLS TLSConfig{Bool
Int
HostPreference
TlsCertData
tlsNeedLocalAddr :: Bool
tlsCertData :: TlsCertData
tlsPort :: Int
tlsHost :: HostPreference
tlsCertData :: TLSConfig -> TlsCertData
tlsNeedLocalAddr :: TLSConfig -> Bool
tlsPort :: TLSConfig -> Int
tlsHost :: TLSConfig -> HostPreference
..} GeneralApplicationStartTLS m ()
app = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
    Credentials
creds <- TlsCertData -> IO Credentials
readCreds TlsCertData
tlsCertData

    forall a. ServerSettings -> ConnectionHandle -> IO a
runTCPServerWithHandle ServerSettings
settings (Credentials -> (m () -> IO ()) -> ConnectionHandle
wrapApp Credentials
creds forall a. m a -> IO a
run)

    where
      -- convert tls settings to regular conduit network ones
      settings :: ServerSettings
settings = Int -> HostPreference -> ServerSettings
serverSettings Int
tlsPort HostPreference
tlsHost  -- (const $ return () ) tlsNeedLocalAddr

      wrapApp :: Credentials -> (m () -> IO ()) -> ConnectionHandle
wrapApp Credentials
creds m () -> IO ()
run = ConnectionHandle
clearapp
        where clearapp :: ConnectionHandle
clearapp Socket
socket SockAddr
addr Maybe SockAddr
mlocal = let
                -- setup app data for the clear part of the connection
                clearData :: AppData
clearData = AppData
                  { appRead' :: IO ByteString
appRead' = Socket -> Int -> IO ByteString
safeRecv Socket
socket Int
4096
                  , appWrite' :: ByteString -> IO ()
appWrite' = Socket -> ByteString -> IO ()
sendAll Socket
socket
                  , appSockAddr' :: SockAddr
appSockAddr' = SockAddr
addr
                  , appLocalAddr' :: Maybe SockAddr
appLocalAddr' = Maybe SockAddr
mlocal
                  , appCloseConnection' :: IO ()
appCloseConnection' = Socket -> IO ()
NS.close Socket
socket
                  , appRawSocket' :: Maybe Socket
appRawSocket' = forall a. a -> Maybe a
Just Socket
socket
                  }
                -- wrap up the current connection with TLS
                startTls :: (AppData -> m ()) -> m ()
startTls = \AppData -> m ()
app' -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                  Context
ctx <- Socket -> Credentials -> IO Context
serverHandshake Socket
socket Credentials
creds
                  () <- m () -> IO ()
run forall a b. (a -> b) -> a -> b
$ AppData -> m ()
app' (Context -> SockAddr -> Maybe SockAddr -> AppData
tlsAppData Context
ctx SockAddr
addr Maybe SockAddr
mlocal)
                  forall (m :: * -> *). MonadIO m => Context -> m ()
TLS.bye Context
ctx
                in
                 m () -> IO ()
run forall a b. (a -> b) -> a -> b
$ GeneralApplicationStartTLS m ()
app (AppData
clearData, (AppData -> m ()) -> m ()
startTls)

-- | Create an @AppData@ from an existing tls @Context@ value. This is a lower level function, allowing you to create a connection in any way you want.
--
-- Sample usage:
--
-- > import Network.Simple.TCP.TLS
-- >
-- > myapp :: Application IO
-- > ...
-- > main = do
-- >     cset <- getDefaultClientSettings
-- >     connect cset "host" "port" $
-- >         (\(ctx, addr) -> myapp $ tlsAppData ctx addr Nothing)
--
-- Since 1.0.1
tlsAppData :: TLS.Context       -- ^ a TLS context
           -> SockAddr          -- ^ remote address
           -> Maybe SockAddr    -- ^ local address
           -> AppData
tlsAppData :: Context -> SockAddr -> Maybe SockAddr -> AppData
tlsAppData Context
ctx SockAddr
addr Maybe SockAddr
mlocal = AppData
    { appRead' :: IO ByteString
appRead' = forall (m :: * -> *). MonadIO m => Context -> m ByteString
TLS.recvData Context
ctx
    , appWrite' :: ByteString -> IO ()
appWrite' = forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
TLS.sendData Context
ctx forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
    , appSockAddr' :: SockAddr
appSockAddr' = SockAddr
addr
    , appLocalAddr' :: Maybe SockAddr
appLocalAddr' = Maybe SockAddr
mlocal
    , appCloseConnection' :: IO ()
appCloseConnection' = Context -> IO ()
TLS.contextClose Context
ctx
    , appRawSocket' :: Maybe Socket
appRawSocket' = forall a. Maybe a
Nothing
    }

readCreds :: TlsCertData -> IO TLS.Credentials
readCreds :: TlsCertData -> IO Credentials
readCreds (TlsCertData IO ByteString
iocert IO [ByteString]
iochains IO ByteString
iokey) =
    (ByteString
-> [ByteString] -> ByteString -> Either FilePath Credential
TLS.credentialLoadX509ChainFromMemory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
iocert forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [ByteString]
iochains forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO ByteString
iokey)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (forall a. HasCallStack => FilePath -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"Error reading TLS credentials: " forall a. [a] -> [a] -> [a]
++))
        (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Credential] -> Credentials
TLS.Credentials forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | TLS requires exactly the number of bytes requested to be returned.
recvExact :: Socket -> Int -> IO S.ByteString
recvExact :: Socket -> Int -> IO ByteString
recvExact Socket
socket =
    ([ByteString] -> [ByteString]) -> Int -> IO ByteString
loop forall a. a -> a
id
  where
    loop :: ([ByteString] -> [ByteString]) -> Int -> IO ByteString
loop [ByteString] -> [ByteString]
front Int
rest
        | Int
rest forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. HasCallStack => FilePath -> a
error FilePath
"Data.Conduit.Network.TLS.recvExact: rest < 0"
        | Int
rest forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []
        | Bool
otherwise = do
            ByteString
next <- Socket -> Int -> IO ByteString
safeRecv Socket
socket Int
rest
            if ByteString -> Int
S.length ByteString
next forall a. Eq a => a -> a -> Bool
== Int
0
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []
                else ([ByteString] -> [ByteString]) -> Int -> IO ByteString
loop ([ByteString] -> [ByteString]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
nextforall a. a -> [a] -> [a]
:)) forall a b. (a -> b) -> a -> b
$ Int
rest forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
next

-- | Settings type for TLS client connection.
--
-- Since 1.0.2
data TLSClientConfig = TLSClientConfig
    { TLSClientConfig -> Int
tlsClientPort :: Int
    -- ^
    --
    -- Since 1.0.2
    , TLSClientConfig -> ByteString
tlsClientHost :: S.ByteString
    -- ^
    --
    -- Since 1.0.2
    , TLSClientConfig -> Bool
tlsClientUseTLS :: Bool
    -- ^ Default is True. If set to @False@, will make a non-TLS connection.
    --
    -- Since 1.0.2
    , TLSClientConfig -> TLSSettings
tlsClientTLSSettings :: NC.TLSSettings
    -- ^ TLS settings to use. If not provided, defaults will be provided.
    --
    -- Since 1.0.2
    , TLSClientConfig -> Maybe SockSettings
tlsClientSockSettings :: Maybe NC.SockSettings
    -- ^ Socks configuration; default is @Nothing@. If absent, Socks will not be used.
    --
    -- Since 1.0.2
    , TLSClientConfig -> Maybe ConnectionContext
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
tlsClientConfig :: Int -> ByteString -> TLSClientConfig
tlsClientConfig Int
port ByteString
host = TLSClientConfig
    { tlsClientPort :: Int
tlsClientPort = Int
port
    , tlsClientHost :: ByteString
tlsClientHost = ByteString
host
    , tlsClientUseTLS :: Bool
tlsClientUseTLS = Bool
True
    , tlsClientTLSSettings :: TLSSettings
tlsClientTLSSettings = forall a. Default a => a
def
    , tlsClientSockSettings :: Maybe SockSettings
tlsClientSockSettings = forall a. Maybe a
Nothing
    , tlsClientConnectionContext :: Maybe ConnectionContext
tlsClientConnectionContext = forall a. Maybe a
Nothing
    }

-- | Run an application with the given configuration.
--
-- Since 1.0.2
runTLSClient :: MonadUnliftIO m
             => TLSClientConfig
             -> (AppData -> m a)
             -> m a
runTLSClient :: forall (m :: * -> *) a.
MonadUnliftIO m =>
TLSClientConfig -> (AppData -> m a) -> m a
runTLSClient TLSClientConfig {Bool
Int
Maybe SockSettings
Maybe ConnectionContext
ByteString
TLSSettings
tlsClientConnectionContext :: Maybe ConnectionContext
tlsClientSockSettings :: Maybe SockSettings
tlsClientTLSSettings :: TLSSettings
tlsClientUseTLS :: Bool
tlsClientHost :: ByteString
tlsClientPort :: Int
tlsClientConnectionContext :: TLSClientConfig -> Maybe ConnectionContext
tlsClientSockSettings :: TLSClientConfig -> Maybe SockSettings
tlsClientTLSSettings :: TLSClientConfig -> TLSSettings
tlsClientUseTLS :: TLSClientConfig -> Bool
tlsClientHost :: TLSClientConfig -> ByteString
tlsClientPort :: TLSClientConfig -> Int
..} AppData -> m a
app = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
    ConnectionContext
context <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ConnectionContext
NC.initConnectionContext forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConnectionContext
tlsClientConnectionContext
    let params :: ConnectionParams
params = NC.ConnectionParams
            { connectionHostname :: FilePath
NC.connectionHostname = ByteString -> FilePath
S8.unpack ByteString
tlsClientHost
            , connectionPort :: PortNumber
NC.connectionPort = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tlsClientPort
            , connectionUseSecure :: Maybe TLSSettings
NC.connectionUseSecure =
                if Bool
tlsClientUseTLS
                    then forall a. a -> Maybe a
Just TLSSettings
tlsClientTLSSettings
                    else forall a. Maybe a
Nothing
            , connectionUseSocks :: Maybe SockSettings
NC.connectionUseSocks = Maybe SockSettings
tlsClientSockSettings
            }
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (ConnectionContext -> ConnectionParams -> IO Connection
NC.connectTo ConnectionContext
context ConnectionParams
params)
        Connection -> IO ()
NC.connectionClose
        (\Connection
conn -> forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ AppData -> m a
app AppData
            { appRead' :: IO ByteString
appRead' = Connection -> IO ByteString
NC.connectionGetChunk Connection
conn
            , appWrite' :: ByteString -> IO ()
appWrite' = Connection -> ByteString -> IO ()
NC.connectionPut Connection
conn
            , appSockAddr' :: SockAddr
appSockAddr' = PortNumber -> HostAddress -> SockAddr
SockAddrInet (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tlsClientPort) HostAddress
0 -- FIXME
            , appLocalAddr' :: Maybe SockAddr
appLocalAddr' = forall a. Maybe a
Nothing
            , appCloseConnection' :: IO ()
appCloseConnection' = Connection -> IO ()
NC.connectionClose Connection
conn
            , appRawSocket' :: Maybe Socket
appRawSocket' = forall a. Maybe a
Nothing
            })


-- | Run an application with the given configuration. starting with a clear connection
--   but provide also a call back to trigger a StartTLS handshake on the connection
--
-- Since 1.0.2
runTLSClientStartTLS :: MonadUnliftIO m
                     => TLSClientConfig
                     -> GeneralApplicationStartTLS m a
                     -> m a
runTLSClientStartTLS :: forall (m :: * -> *) a.
MonadUnliftIO m =>
TLSClientConfig -> GeneralApplicationStartTLS m a -> m a
runTLSClientStartTLS TLSClientConfig {Bool
Int
Maybe SockSettings
Maybe ConnectionContext
ByteString
TLSSettings
tlsClientConnectionContext :: Maybe ConnectionContext
tlsClientSockSettings :: Maybe SockSettings
tlsClientTLSSettings :: TLSSettings
tlsClientUseTLS :: Bool
tlsClientHost :: ByteString
tlsClientPort :: Int
tlsClientConnectionContext :: TLSClientConfig -> Maybe ConnectionContext
tlsClientSockSettings :: TLSClientConfig -> Maybe SockSettings
tlsClientTLSSettings :: TLSClientConfig -> TLSSettings
tlsClientUseTLS :: TLSClientConfig -> Bool
tlsClientHost :: TLSClientConfig -> ByteString
tlsClientPort :: TLSClientConfig -> Int
..} GeneralApplicationStartTLS m a
app = forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO forall a b. (a -> b) -> a -> b
$ \UnliftIO m
u -> do
    ConnectionContext
context <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ConnectionContext
NC.initConnectionContext forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConnectionContext
tlsClientConnectionContext
    let params :: ConnectionParams
params = NC.ConnectionParams
            { connectionHostname :: FilePath
NC.connectionHostname = ByteString -> FilePath
S8.unpack ByteString
tlsClientHost
            , connectionPort :: PortNumber
NC.connectionPort = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tlsClientPort
            , connectionUseSecure :: Maybe TLSSettings
NC.connectionUseSecure = forall a. Maybe a
Nothing
            , connectionUseSocks :: Maybe SockSettings
NC.connectionUseSocks = Maybe SockSettings
tlsClientSockSettings
            }
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ConnectionContext -> ConnectionParams -> IO Connection
NC.connectTo ConnectionContext
context ConnectionParams
params) Connection -> IO ()
NC.connectionClose
        (\Connection
conn -> forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u forall a b. (a -> b) -> a -> b
$ GeneralApplicationStartTLS m a
app (
            AppData
            { appRead' :: IO ByteString
appRead' = Connection -> IO ByteString
NC.connectionGetChunk Connection
conn
            , appWrite' :: ByteString -> IO ()
appWrite' = Connection -> ByteString -> IO ()
NC.connectionPut Connection
conn
            , appSockAddr' :: SockAddr
appSockAddr' = PortNumber -> HostAddress -> SockAddr
SockAddrInet (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tlsClientPort) HostAddress
0 -- FIXME
            , appLocalAddr' :: Maybe SockAddr
appLocalAddr' = forall a. Maybe a
Nothing
            , appCloseConnection' :: IO ()
appCloseConnection' = Connection -> IO ()
NC.connectionClose Connection
conn
            , appRawSocket' :: Maybe Socket
appRawSocket' = forall a. Maybe a
Nothing
            }
            , \AppData -> m ()
app' -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                 ConnectionContext -> Connection -> TLSSettings -> IO ()
NC.connectionSetSecure ConnectionContext
context Connection
conn TLSSettings
tlsClientTLSSettings
                 forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u forall a b. (a -> b) -> a -> b
$ AppData -> m ()
app' AppData
                   { appRead' :: IO ByteString
appRead' = Connection -> IO ByteString
NC.connectionGetChunk Connection
conn
                   , appWrite' :: ByteString -> IO ()
appWrite' = Connection -> ByteString -> IO ()
NC.connectionPut Connection
conn
                   , appSockAddr' :: SockAddr
appSockAddr' = PortNumber -> HostAddress -> SockAddr
SockAddrInet (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tlsClientPort) HostAddress
0 -- FIXME
                   , appLocalAddr' :: Maybe SockAddr
appLocalAddr' = forall a. Maybe a
Nothing
                   , appCloseConnection' :: IO ()
appCloseConnection' = Connection -> IO ()
NC.connectionClose Connection
conn
                    , appRawSocket' :: Maybe Socket
appRawSocket' = forall a. Maybe a
Nothing
                   }
            )
            )


-- | Read from a 'NC.Connection'.
--
-- @since 1.3.0
sourceConnection :: MonadIO m => NC.Connection -> ConduitT i S.ByteString m ()
sourceConnection :: forall (m :: * -> *) i.
MonadIO m =>
Connection -> ConduitT i ByteString m ()
sourceConnection Connection
conn =
    forall {i}. ConduitT i ByteString m ()
loop
  where
    loop :: ConduitT i ByteString m ()
loop = do
        ByteString
bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Connection -> IO ByteString
NC.connectionGetChunk Connection
conn
        if ByteString -> Bool
S.null ByteString
bs
            then forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT i ByteString m ()
loop

-- | Write to a 'NC.Connection'.
--
-- @since 1.3.0
sinkConnection :: MonadIO m => NC.Connection -> ConduitT S.ByteString o m ()
sinkConnection :: forall (m :: * -> *) o.
MonadIO m =>
Connection -> ConduitT ByteString o m ()
sinkConnection Connection
conn = forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ByteString -> IO ()
NC.connectionPut Connection
conn)