{-# 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, TransportPeer (..))
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

attachRevHTTP2Client :: IO () -> TLS 'TServer -> IO (Either HTTP2ClientError HTTP2Client)
attachRevHTTP2Client :: IO () -> TLS 'TServer -> IO (Either HTTP2ClientError HTTP2Client)
attachRevHTTP2Client IO ()
disconnected = HTTP2ClientConfig
-> TransportHost
-> ServiceName
-> IO ()
-> Int
-> TLS 'TServer
-> IO (Either HTTP2ClientError HTTP2Client)
forall (p :: TransportPeer).
TransportPeerI p =>
HTTP2ClientConfig
-> TransportHost
-> ServiceName
-> IO ()
-> Int
-> TLS p
-> IO (Either HTTP2ClientError HTTP2Client)
attachHTTP2Client HTTP2ClientConfig
config TransportHost
forall a. (IsString a, Eq a) => a
ANY_ADDR_V4 ServiceName
"0" IO ()
disconnected Int
defaultHTTP2BufferSize
  where
    config :: HTTP2ClientConfig
config = HTTP2ClientConfig
defaultHTTP2ClientConfig {bodyHeadSize = doNotPrefetchHead, connTimeout = maxBound}

attachHTTP2Server :: TLS 'TClient -> (HTTP2Request -> IO ()) -> IO ()
attachHTTP2Server :: TLS 'TClient -> (HTTP2Request -> IO ()) -> IO ()
attachHTTP2Server TLS 'TClient
tls HTTP2Request -> IO ()
processRequest =
  Int
-> ((TLS 'TClient -> IO ()) -> IO ()) -> HTTP2ServerFunc -> IO ()
forall (p :: TransportPeer) a.
Int -> ((TLS p -> IO ()) -> a) -> HTTP2ServerFunc -> a
runHTTP2ServerWith Int
defaultHTTP2BufferSize ((TLS 'TClient -> IO ()) -> TLS 'TClient -> IO ()
forall a b. (a -> b) -> a -> b
$ TLS 'TClient
tls) (HTTP2ServerFunc -> IO ()) -> HTTP2ServerFunc -> IO ()
forall a b. (a -> b) -> a -> b
$ \SessionId
sessionId Maybe SessionId
sessionALPN Request
r Response -> IO ()
sendResponse -> do
    HTTP2Body
reqBody <- Request -> Int -> IO HTTP2Body
forall a. HTTP2BodyChunk a => a -> Int -> IO HTTP2Body
getHTTP2Body Request
r Int
doNotPrefetchHead
    HTTP2Request -> IO ()
processRequest HTTP2Request {SessionId
sessionId :: SessionId
sessionId :: SessionId
sessionId, Maybe SessionId
sessionALPN :: Maybe SessionId
sessionALPN :: Maybe SessionId
sessionALPN, request :: Request
request = Request
r, HTTP2Body
reqBody :: HTTP2Body
reqBody :: HTTP2Body
reqBody, Response -> IO ()
sendResponse :: Response -> IO ()
sendResponse :: Response -> IO ()
sendResponse}

-- | Suppress storing initial chunk in bodyHead, forcing clients and servers to stream chunks
doNotPrefetchHead :: Int
doNotPrefetchHead :: Int
doNotPrefetchHead = Int
0