{-# 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)
((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
-> 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 <- 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
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)
Context -> IO ()
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 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
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
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' = Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
socket
}
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)
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' = 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)
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
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 = 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
}
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
, 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
})
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
, 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
, 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
}
)
)
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
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)