mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-04-29 21:17:38 +00:00
b729144773
* WIP: start working on /connect remote ctrl OOB is broken, requires fixing simplexmq bits. * WIP: pull CtrlCryptoHandle from xrcp * place xrcp stubs * WIP: start switching to RemoteControl.Client types * fix http2 sha * fix sha256map.nix * fix cabal.project * update RC test * WIP: add new remote session * fix compilation * simplify * attach HTTP2 server to TLS * starting host session in controller (WIP) * more WIP * compiles * compiles2 * wip * pass startRemote' test * async to poll for events from host, test to send messages fails * move xrcp handshake test to simplexmq * detect session stops * fix connectRemoteCtrl * use step type * app info * WIP: pairing stores * plug in hello/appInfo/pairings * negotiate app version * update simplexmw, remove KEM secrets from DB * fix file tests * tone down http2 shutdown errors * Add stored session test * bump simplexmq tag * update simplexmq * refactor, fix * removed unused errors * rename fields, remove unused file * rename errors --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
33 lines
1.5 KiB
Haskell
33 lines
1.5 KiB
Haskell
{-# LANGUAGE BlockArguments #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Simplex.Chat.Remote.RevHTTP where
|
|
|
|
import Simplex.Messaging.Transport (TLS)
|
|
import Simplex.Messaging.Transport.HTTP2 (defaultHTTP2BufferSize, getHTTP2Body)
|
|
import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2ClientError (..), attachHTTP2Client, bodyHeadSize, connTimeout, defaultHTTP2ClientConfig)
|
|
import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..), runHTTP2ServerWith)
|
|
import Simplex.RemoteControl.Discovery
|
|
import UnliftIO
|
|
|
|
attachRevHTTP2Client :: IO () -> TLS -> IO (Either HTTP2ClientError HTTP2Client)
|
|
attachRevHTTP2Client disconnected = attachHTTP2Client config ANY_ADDR_V4 "0" disconnected defaultHTTP2BufferSize
|
|
where
|
|
config = defaultHTTP2ClientConfig {bodyHeadSize = doNotPrefetchHead, connTimeout = maxBound}
|
|
|
|
attachHTTP2Server :: MonadUnliftIO m => TLS -> (HTTP2Request -> m ()) -> m ()
|
|
attachHTTP2Server tls processRequest = do
|
|
withRunInIO $ \unlift ->
|
|
runHTTP2ServerWith defaultHTTP2BufferSize ($ tls) $ \sessionId r sendResponse -> do
|
|
reqBody <- getHTTP2Body r doNotPrefetchHead
|
|
unlift $ processRequest HTTP2Request {sessionId, request = r, reqBody, sendResponse}
|
|
|
|
-- | Suppress storing initial chunk in bodyHead, forcing clients and servers to stream chunks
|
|
doNotPrefetchHead :: Int
|
|
doNotPrefetchHead = 0
|