{-# 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)
      ((FilePath -> IO ByteString) -> [FilePath] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 (ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
certBS) ([ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
chainCertsBS) (ByteString -> IO ByteString
forall a. a -> IO a
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 <- Backend -> ServerParams -> IO Context
forall (m :: * -> *) backend params.
(MonadIO m, HasBackend backend, TLSParams params) =>
backend -> params -> m Context
TLS.contextNew
           TLS.Backend
                    { backendFlush :: IO ()
TLS.backendFlush = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    , backendClose :: IO ()
TLS.backendClose = () -> IO ()
forall a. a -> IO a
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

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

  where
    params :: ServerParams
params = ServerParams
forall a. Default a => a
def
        { TLS.serverWantClientCert = False
        , TLS.serverSupported = def
            { TLS.supportedCiphers = TLSExtra.ciphersuite_default
            }
        , TLS.serverShared = def
            { TLS.sharedCredentials = creds
            }
        }

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

    ServerSettings -> ConnectionHandle -> IO ()
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)
            Context -> IO ()
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 a. m a -> IO a) -> IO ()) -> m ()
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ()) -> m ())
-> ((forall a. m a -> IO a) -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
  TLSConfig -> (AppData -> IO ()) -> IO ()
runTCPServerTLS TLSConfig
config ((AppData -> IO ()) -> IO ()) -> (AppData -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ m () -> IO ()
forall a. m a -> IO a
run (m () -> IO ()) -> (AppData -> m ()) -> AppData -> IO ()
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
tlsHost :: TLSConfig -> HostPreference
tlsPort :: TLSConfig -> Int
tlsNeedLocalAddr :: TLSConfig -> Bool
tlsCertData :: TLSConfig -> TlsCertData
tlsHost :: HostPreference
tlsPort :: Int
tlsCertData :: TlsCertData
tlsNeedLocalAddr :: Bool
..} GeneralApplicationStartTLS m ()
app = ((forall a. m a -> IO a) -> IO ()) -> m ()
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ()) -> m ())
-> ((forall a. m a -> IO a) -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
    Credentials
creds <- TlsCertData -> IO Credentials
readCreds TlsCertData
tlsCertData

    ServerSettings -> ConnectionHandle -> IO ()
forall a. ServerSettings -> ConnectionHandle -> IO a
runTCPServerWithHandle ServerSettings
settings (Credentials -> (m () -> IO ()) -> ConnectionHandle
wrapApp Credentials
creds m () -> IO ()
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' = Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
socket
                  }
                -- wrap up the current connection with TLS
                startTls :: (AppData -> m ()) -> m ()
startTls = \AppData -> m ()
app' -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                  Context
ctx <- Socket -> Credentials -> IO Context
serverHandshake Socket
socket Credentials
creds
                  () <- m () -> IO ()
run (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ AppData -> m ()
app' (Context -> SockAddr -> Maybe SockAddr -> AppData
tlsAppData Context
ctx SockAddr
addr Maybe SockAddr
mlocal)
                  Context -> IO ()
forall (m :: * -> *). MonadIO m => Context -> m ()
TLS.bye Context
ctx
                in
                 m () -> IO ()
run (m () -> IO ()) -> m () -> IO ()
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' = Context -> IO ByteString
forall (m :: * -> *). MonadIO m => Context -> m ByteString
TLS.recvData Context
ctx
    , appWrite' :: ByteString -> IO ()
appWrite' = Context -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
TLS.sendData Context
ctx (ByteString -> IO ())
-> (ByteString -> ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall a. a -> [a]
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' = Maybe Socket
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 (ByteString
 -> [ByteString] -> ByteString -> Either FilePath Credential)
-> IO ByteString
-> IO ([ByteString] -> ByteString -> Either FilePath Credential)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
iocert IO ([ByteString] -> ByteString -> Either FilePath Credential)
-> IO [ByteString] -> IO (ByteString -> Either FilePath Credential)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [ByteString]
iochains IO (ByteString -> Either FilePath Credential)
-> IO ByteString -> IO (Either FilePath Credential)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO ByteString
iokey)
    IO (Either FilePath Credential)
-> (Either FilePath Credential -> IO Credentials) -> IO Credentials
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Credentials)
-> (Credential -> IO Credentials)
-> Either FilePath Credential
-> IO Credentials
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (FilePath -> IO Credentials
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO Credentials)
-> (FilePath -> FilePath) -> FilePath -> IO Credentials
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"Error reading TLS credentials: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++))
        (Credentials -> IO Credentials
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Credentials -> IO Credentials)
-> (Credential -> Credentials) -> Credential -> IO Credentials
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Credential] -> Credentials
TLS.Credentials ([Credential] -> Credentials)
-> (Credential -> [Credential]) -> Credential -> Credentials
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential -> [Credential]
forall a. a -> [a]
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 [ByteString] -> [ByteString]
forall a. a -> a
id
  where
    loop :: ([ByteString] -> [ByteString]) -> Int -> IO ByteString
loop [ByteString] -> [ByteString]
front Int
rest
        | Int
rest Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = FilePath -> IO ByteString
forall a. HasCallStack => FilePath -> a
error FilePath
"Data.Conduit.Network.TLS.recvExact: rest < 0"
        | Int
rest Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []
                else ([ByteString] -> [ByteString]) -> Int -> IO ByteString
loop ([ByteString] -> [ByteString]
front ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
nextByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)) (Int -> IO ByteString) -> Int -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int
rest Int -> Int -> Int
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 = TLSSettings
forall a. Default a => a
def
    , tlsClientSockSettings :: Maybe SockSettings
tlsClientSockSettings = Maybe SockSettings
forall a. Maybe a
Nothing
    , tlsClientConnectionContext :: Maybe ConnectionContext
tlsClientConnectionContext = Maybe ConnectionContext
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 ConnectionContext
Maybe SockSettings
ByteString
TLSSettings
tlsClientPort :: TLSClientConfig -> Int
tlsClientHost :: TLSClientConfig -> ByteString
tlsClientUseTLS :: TLSClientConfig -> Bool
tlsClientTLSSettings :: TLSClientConfig -> TLSSettings
tlsClientSockSettings :: TLSClientConfig -> Maybe SockSettings
tlsClientConnectionContext :: TLSClientConfig -> Maybe ConnectionContext
tlsClientPort :: Int
tlsClientHost :: ByteString
tlsClientUseTLS :: Bool
tlsClientTLSSettings :: TLSSettings
tlsClientSockSettings :: Maybe SockSettings
tlsClientConnectionContext :: Maybe ConnectionContext
..} AppData -> m a
app = ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
    ConnectionContext
context <- IO ConnectionContext
-> (ConnectionContext -> IO ConnectionContext)
-> Maybe ConnectionContext
-> IO ConnectionContext
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ConnectionContext
NC.initConnectionContext ConnectionContext -> IO ConnectionContext
forall a. a -> IO a
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 = Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tlsClientPort
            , connectionUseSecure :: Maybe TLSSettings
NC.connectionUseSecure =
                if Bool
tlsClientUseTLS
                    then TLSSettings -> Maybe TLSSettings
forall a. a -> Maybe a
Just TLSSettings
tlsClientTLSSettings
                    else Maybe TLSSettings
forall a. Maybe a
Nothing
            , connectionUseSocks :: Maybe SockSettings
NC.connectionUseSocks = Maybe SockSettings
tlsClientSockSettings
            }
    IO Connection
-> (Connection -> IO ()) -> (Connection -> IO a) -> IO a
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 -> m a -> IO a
forall a. m a -> IO a
run (m a -> IO a) -> m a -> IO a
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 (Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tlsClientPort) HostAddress
0 -- FIXME
            , appLocalAddr' :: Maybe SockAddr
appLocalAddr' = Maybe SockAddr
forall a. Maybe a
Nothing
            , appCloseConnection' :: IO ()
appCloseConnection' = Connection -> IO ()
NC.connectionClose Connection
conn
            , appRawSocket' :: Maybe Socket
appRawSocket' = Maybe Socket
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 ConnectionContext
Maybe SockSettings
ByteString
TLSSettings
tlsClientPort :: TLSClientConfig -> Int
tlsClientHost :: TLSClientConfig -> ByteString
tlsClientUseTLS :: TLSClientConfig -> Bool
tlsClientTLSSettings :: TLSClientConfig -> TLSSettings
tlsClientSockSettings :: TLSClientConfig -> Maybe SockSettings
tlsClientConnectionContext :: TLSClientConfig -> Maybe ConnectionContext
tlsClientPort :: Int
tlsClientHost :: ByteString
tlsClientUseTLS :: Bool
tlsClientTLSSettings :: TLSSettings
tlsClientSockSettings :: Maybe SockSettings
tlsClientConnectionContext :: Maybe ConnectionContext
..} GeneralApplicationStartTLS m a
app = (UnliftIO m -> IO a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO ((UnliftIO m -> IO a) -> m a) -> (UnliftIO m -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \UnliftIO m
u -> do
    ConnectionContext
context <- IO ConnectionContext
-> (ConnectionContext -> IO ConnectionContext)
-> Maybe ConnectionContext
-> IO ConnectionContext
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ConnectionContext
NC.initConnectionContext ConnectionContext -> IO ConnectionContext
forall a. a -> IO a
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 = Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tlsClientPort
            , connectionUseSecure :: Maybe TLSSettings
NC.connectionUseSecure = Maybe TLSSettings
forall a. Maybe a
Nothing
            , connectionUseSocks :: Maybe SockSettings
NC.connectionUseSocks = Maybe SockSettings
tlsClientSockSettings
            }
    IO Connection
-> (Connection -> IO ()) -> (Connection -> IO a) -> IO a
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 -> UnliftIO m -> forall a. m a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u (m a -> IO a) -> m a -> IO a
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 (Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tlsClientPort) HostAddress
0 -- FIXME
            , appLocalAddr' :: Maybe SockAddr
appLocalAddr' = Maybe SockAddr
forall a. Maybe a
Nothing
            , appCloseConnection' :: IO ()
appCloseConnection' = Connection -> IO ()
NC.connectionClose Connection
conn
            , appRawSocket' :: Maybe Socket
appRawSocket' = Maybe Socket
forall a. Maybe a
Nothing
            }
            , \AppData -> m ()
app' -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                 ConnectionContext -> Connection -> TLSSettings -> IO ()
NC.connectionSetSecure ConnectionContext
context Connection
conn TLSSettings
tlsClientTLSSettings
                 UnliftIO m -> forall a. m a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u (m () -> IO ()) -> m () -> IO ()
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 (Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tlsClientPort) HostAddress
0 -- FIXME
                   , appLocalAddr' :: Maybe SockAddr
appLocalAddr' = Maybe SockAddr
forall a. Maybe a
Nothing
                   , appCloseConnection' :: IO ()
appCloseConnection' = Connection -> IO ()
NC.connectionClose Connection
conn
                    , appRawSocket' :: Maybe Socket
appRawSocket' = Maybe Socket
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 =
    ConduitT i ByteString m ()
forall {i}. ConduitT i ByteString m ()
loop
  where
    loop :: ConduitT i ByteString m ()
loop = do
        ByteString
bs <- IO ByteString -> ConduitT i ByteString m ByteString
forall a. IO a -> ConduitT i ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ConduitT i ByteString m ByteString)
-> IO ByteString -> ConduitT i ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Connection -> IO ByteString
NC.connectionGetChunk Connection
conn
        if ByteString -> Bool
S.null ByteString
bs
            then () -> ConduitT i ByteString m ()
forall a. a -> ConduitT i ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs ConduitT i ByteString m ()
-> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall a b.
ConduitT i ByteString m a
-> ConduitT i ByteString m b -> ConduitT i ByteString m b
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 = (ByteString -> ConduitT ByteString o m ())
-> ConduitT ByteString o m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (IO () -> ConduitT ByteString o m ()
forall a. IO a -> ConduitT ByteString o m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT ByteString o m ())
-> (ByteString -> IO ())
-> ByteString
-> ConduitT ByteString o m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ByteString -> IO ()
NC.connectionPut Connection
conn)