Files
simplex-chat/src/Simplex/Chat/Remote/RevHTTP.hs
T
Alexander Bondarenko b729144773 core: use xrcp protocol for desktop/mobile connection (#3305)
* 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>
2023-11-08 20:13:52 +00:00

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