{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE KindSignatures #-}
module Data.Conduit.Network.TLS
(
ApplicationStartTLS
, GeneralApplicationStartTLS
, TLSConfig
, tlsConfigBS
, tlsConfig
, tlsConfigChainBS
, tlsConfigChain
, tlsHost
, tlsPort
, tlsNeedLocalAddr
, tlsAppData
, runTCPServerTLS
, runGeneralTCPServerTLS
, runTCPServerStartTLS
, TLSClientConfig
, tlsClientConfig
, runTLSClient
, runTLSClientStartTLS
, tlsClientPort
, tlsClientHost
, tlsClientUseTLS
, tlsClientTLSSettings
, tlsClientSockSettings
, tlsClientConnectionContext
, 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
-> FilePath
-> FilePath
-> 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
tlsConfigBS :: HostPreference
-> Int
-> S.ByteString
-> S.ByteString
-> 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
tlsConfigChain :: HostPreference
-> Int
-> FilePath
-> [FilePath]
-> FilePath
-> 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
tlsConfigChainBS :: HostPreference
-> Int
-> S.ByteString
-> [S.ByteString]
-> S.ByteString
-> 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
settings :: ServerSettings
settings = Int -> HostPreference -> ServerSettings
serverSettings Int
tlsPort HostPreference
tlsHost
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
type GeneralApplicationStartTLS m a = (AppData, (AppData -> m ()) -> m ()) -> m a
type ApplicationStartTLS = GeneralApplicationStartTLS IO ()
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
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
settings :: ServerSettings
settings = Int -> HostPreference -> ServerSettings
serverSettings Int
tlsPort HostPreference
tlsHost
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
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
}
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)
tlsAppData :: TLS.Context
-> SockAddr
-> Maybe SockAddr
-> 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)
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
data TLSClientConfig = TLSClientConfig
{ TLSClientConfig -> Int
tlsClientPort :: Int
, TLSClientConfig -> ByteString
tlsClientHost :: S.ByteString
, TLSClientConfig -> Bool
tlsClientUseTLS :: Bool
, TLSClientConfig -> TLSSettings
tlsClientTLSSettings :: NC.TLSSettings
, TLSClientConfig -> Maybe SockSettings
tlsClientSockSettings :: Maybe NC.SockSettings
, TLSClientConfig -> Maybe ConnectionContext
tlsClientConnectionContext :: Maybe NC.ConnectionContext
}
tlsClientConfig :: Int
-> S.ByteString
-> 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
}
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
, 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
})
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
, 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
, 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
}
)
)
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
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)