-- SPDX-License-Identifier: Apache-2.0
--
-- Copyright (C) 2023 Bin Jin. All Rights Reserved.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Network.HProx.Impl
  ( ProxySettings(..)
  , httpProxy
  , pacProvider
  , httpGetProxy
  , httpConnectProxy
  , reverseProxy
  , forceSSL
  ) where

import           Control.Applicative        ((<|>))
import           Control.Concurrent.Async   (concurrently)
import           Control.Exception          (SomeException, try)
import           Control.Monad              (unless, void, when)
import           Control.Monad.IO.Class     (liftIO)
import qualified Data.Binary.Builder        as BB
import qualified Data.ByteString            as BS
import           Data.ByteString.Base64     (decodeLenient)
import qualified Data.ByteString.Char8      as BS8
import qualified Data.ByteString.Lazy.Char8 as LBS8
import qualified Data.CaseInsensitive       as CI
import qualified Data.Conduit.Network       as CN
import           Data.Maybe                 (fromJust, fromMaybe, isJust,
                                             isNothing)
import qualified Network.HTTP.Client        as HC
import           Network.HTTP.ReverseProxy  (ProxyDest (..), SetIpHeader (..),
                                             WaiProxyResponse (..),
                                             defaultWaiProxySettings,
                                             waiProxyToSettings, wpsSetIpHeader,
                                             wpsUpgradeToRaw)
import qualified Network.HTTP.Types         as HT
import qualified Network.HTTP.Types.Header  as HT

import           Data.Conduit
import           Network.Wai

import           Network.HProx.Util

data ProxySettings = ProxySettings
  { ProxySettings -> Maybe (ByteString -> Bool)
proxyAuth  :: Maybe (BS.ByteString -> Bool)
  , ProxySettings -> Maybe ByteString
passPrompt :: Maybe BS.ByteString
  , ProxySettings -> Maybe ByteString
wsRemote   :: Maybe BS.ByteString
  , ProxySettings -> Maybe ByteString
revRemote  :: Maybe BS.ByteString
  }

httpProxy :: ProxySettings -> HC.Manager -> Middleware
httpProxy :: ProxySettings -> Manager -> Middleware
httpProxy ProxySettings
set Manager
mgr = Middleware
pacProvider forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProxySettings -> Manager -> Middleware
httpGetProxy ProxySettings
set Manager
mgr forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProxySettings -> Middleware
httpConnectProxy ProxySettings
set

forceSSL :: ProxySettings -> Middleware
forceSSL :: ProxySettings -> Middleware
forceSSL ProxySettings
pset Application
app Request
req Response -> IO ResponseReceived
respond
    | Request -> Bool
isSecure Request
req               = Application
app Request
req Response -> IO ResponseReceived
respond
    | ProxySettings -> Request -> Bool
redirectWebsocket ProxySettings
pset Request
req = Application
app Request
req Response -> IO ResponseReceived
respond
    | Bool
otherwise                  = Application
redirectToSSL Request
req Response -> IO ResponseReceived
respond

redirectToSSL :: Application
redirectToSSL :: Application
redirectToSSL Request
req Response -> IO ResponseReceived
respond
    | Just ByteString
host <- Request -> Maybe ByteString
requestHeaderHost Request
req = Response -> IO ResponseReceived
respond forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS
        Status
HT.status301
        [(HeaderName
"Location", ByteString
"https://" ByteString -> ByteString -> ByteString
`BS.append` ByteString
host)]
        ByteString
""
    | Bool
otherwise                          = Response -> IO ResponseReceived
respond forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS
        (Int -> ByteString -> Status
HT.mkStatus Int
426 ByteString
"Upgrade Required")
        [(HeaderName
"Upgrade", ByteString
"TLS/1.0, HTTP/1.1"), (HeaderName
"Connection", ByteString
"Upgrade")]
        ByteString
""


isProxyHeader :: HT.HeaderName -> Bool
isProxyHeader :: HeaderName -> Bool
isProxyHeader HeaderName
k = ByteString
"proxy" ByteString -> ByteString -> Bool
`BS.isPrefixOf` forall s. CI s -> s
CI.foldedCase HeaderName
k

isForwardedHeader :: HT.HeaderName -> Bool
isForwardedHeader :: HeaderName -> Bool
isForwardedHeader HeaderName
k = ByteString
"x-forwarded" ByteString -> ByteString -> Bool
`BS.isPrefixOf` forall s. CI s -> s
CI.foldedCase HeaderName
k

isToStripHeader :: HT.HeaderName -> Bool
isToStripHeader :: HeaderName -> Bool
isToStripHeader HeaderName
h = HeaderName -> Bool
isProxyHeader HeaderName
h Bool -> Bool -> Bool
|| HeaderName -> Bool
isForwardedHeader HeaderName
h Bool -> Bool -> Bool
|| HeaderName
h forall a. Eq a => a -> a -> Bool
== HeaderName
"X-Real-IP" Bool -> Bool -> Bool
|| HeaderName
h forall a. Eq a => a -> a -> Bool
== HeaderName
"X-Scheme"

checkAuth :: ProxySettings -> Request -> Bool
checkAuth :: ProxySettings -> Request -> Bool
checkAuth ProxySettings{Maybe ByteString
Maybe (ByteString -> Bool)
revRemote :: Maybe ByteString
wsRemote :: Maybe ByteString
passPrompt :: Maybe ByteString
proxyAuth :: Maybe (ByteString -> Bool)
revRemote :: ProxySettings -> Maybe ByteString
wsRemote :: ProxySettings -> Maybe ByteString
passPrompt :: ProxySettings -> Maybe ByteString
proxyAuth :: ProxySettings -> Maybe (ByteString -> Bool)
..} Request
req
    | forall a. Maybe a -> Bool
isNothing Maybe (ByteString -> Bool)
proxyAuth = Bool
True
    | forall a. Maybe a -> Bool
isNothing Maybe ByteString
authRsp   = Bool
False
    | Bool
otherwise           = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (ByteString -> Bool)
proxyAuth ByteString
decodedRsp
  where
    authRsp :: Maybe ByteString
authRsp = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
HT.hProxyAuthorization (Request -> ResponseHeaders
requestHeaders Request
req)

    decodedRsp :: ByteString
decodedRsp = ByteString -> ByteString
decodeLenient forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.spanEnd (forall a. Eq a => a -> a -> Bool
/=Char
' ') forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
authRsp

redirectWebsocket :: ProxySettings -> Request -> Bool
redirectWebsocket :: ProxySettings -> Request -> Bool
redirectWebsocket ProxySettings{Maybe ByteString
Maybe (ByteString -> Bool)
revRemote :: Maybe ByteString
wsRemote :: Maybe ByteString
passPrompt :: Maybe ByteString
proxyAuth :: Maybe (ByteString -> Bool)
revRemote :: ProxySettings -> Maybe ByteString
wsRemote :: ProxySettings -> Maybe ByteString
passPrompt :: ProxySettings -> Maybe ByteString
proxyAuth :: ProxySettings -> Maybe (ByteString -> Bool)
..} Request
req = WaiProxySettings -> Request -> Bool
wpsUpgradeToRaw WaiProxySettings
defaultWaiProxySettings Request
req Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe ByteString
wsRemote

proxyAuthRequiredResponse :: ProxySettings -> Response
proxyAuthRequiredResponse :: ProxySettings -> Response
proxyAuthRequiredResponse ProxySettings{Maybe ByteString
Maybe (ByteString -> Bool)
revRemote :: Maybe ByteString
wsRemote :: Maybe ByteString
passPrompt :: Maybe ByteString
proxyAuth :: Maybe (ByteString -> Bool)
revRemote :: ProxySettings -> Maybe ByteString
wsRemote :: ProxySettings -> Maybe ByteString
passPrompt :: ProxySettings -> Maybe ByteString
proxyAuth :: ProxySettings -> Maybe (ByteString -> Bool)
..} = Status -> ResponseHeaders -> ByteString -> Response
responseLBS
    Status
HT.status407
    [(HeaderName
HT.hProxyAuthenticate, ByteString
"Basic realm=\"" ByteString -> ByteString -> ByteString
`BS.append` ByteString
prompt ByteString -> ByteString -> ByteString
`BS.append` ByteString
"\"")]
    ByteString
""
  where
    prompt :: ByteString
prompt = forall a. a -> Maybe a -> a
fromMaybe ByteString
"hprox" Maybe ByteString
passPrompt

pacProvider :: Middleware
pacProvider :: Middleware
pacProvider Application
fallback Request
req Response -> IO ResponseReceived
respond
    | Request -> [Text]
pathInfo Request
req forall a. Eq a => a -> a -> Bool
== [Text
"get", Text
"hprox.pac"],
      Just ByteString
host' <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"x-forwarded-host" (Request -> ResponseHeaders
requestHeaders Request
req) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Request -> Maybe ByteString
requestHeaderHost Request
req =
        let issecure :: Bool
issecure = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"x-forwarded-proto" (Request -> ResponseHeaders
requestHeaders Request
req) of
                Just ByteString
proto -> ByteString
proto forall a. Eq a => a -> a -> Bool
== ByteString
"https"
                Maybe ByteString
Nothing    -> Request -> Bool
isSecure Request
req
            scheme :: ByteString
scheme = if Bool
issecure then ByteString
"HTTPS" else ByteString
"PROXY"
            defaultPort :: ByteString
defaultPort = if Bool
issecure then ByteString
":443" else ByteString
":80"
            host :: ByteString
host | Word8
58 Word8 -> ByteString -> Bool
`BS.elem` ByteString
host' = ByteString
host' -- ':'
                 | Bool
otherwise          = ByteString
host' ByteString -> ByteString -> ByteString
`BS.append` ByteString
defaultPort
        in Response -> IO ResponseReceived
respond forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS
               Status
HT.status200
               [(HeaderName
"Content-Type", ByteString
"application/x-ns-proxy-autoconfig")] forall a b. (a -> b) -> a -> b
$
               [ByteString] -> ByteString
LBS8.unlines [ ByteString
"function FindProxyForURL(url, host) {"
                            , [ByteString] -> ByteString
LBS8.fromChunks [ByteString
"  return \"", ByteString
scheme, ByteString
" ", ByteString
host, ByteString
"\";"]
                            , ByteString
"}"
                            ]
    | Bool
otherwise = Application
fallback Request
req Response -> IO ResponseReceived
respond

reverseProxy :: ProxySettings -> HC.Manager -> Middleware
reverseProxy :: ProxySettings -> Manager -> Middleware
reverseProxy ProxySettings{Maybe ByteString
Maybe (ByteString -> Bool)
revRemote :: Maybe ByteString
wsRemote :: Maybe ByteString
passPrompt :: Maybe ByteString
proxyAuth :: Maybe (ByteString -> Bool)
revRemote :: ProxySettings -> Maybe ByteString
wsRemote :: ProxySettings -> Maybe ByteString
passPrompt :: ProxySettings -> Maybe ByteString
proxyAuth :: ProxySettings -> Maybe (ByteString -> Bool)
..} Manager
mgr Application
fallback
    | Bool
isReverseProxy = (Request -> IO WaiProxyResponse)
-> WaiProxySettings -> Manager -> Application
waiProxyToSettings (forall (m :: * -> *) a. Monad m => a -> m a
returnforall b c a. (b -> c) -> (a -> b) -> a -> c
.Request -> WaiProxyResponse
proxyResponseFor) WaiProxySettings
settings Manager
mgr
    | Bool
otherwise      = Application
fallback
  where
    settings :: WaiProxySettings
settings = WaiProxySettings
defaultWaiProxySettings { wpsSetIpHeader :: SetIpHeader
wpsSetIpHeader = SetIpHeader
SIHNone }

    isReverseProxy :: Bool
isReverseProxy = forall a. Maybe a -> Bool
isJust Maybe ByteString
revRemote
    (ByteString
revHost, Int
revPort) = Int -> ByteString -> (ByteString, Int)
parseHostPortWithDefault Int
80 (forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
revRemote)
    revWrapper :: Request -> ProxyDest -> WaiProxyResponse
revWrapper = if Int
revPort forall a. Eq a => a -> a -> Bool
== Int
443 then Request -> ProxyDest -> WaiProxyResponse
WPRModifiedRequestSecure else Request -> ProxyDest -> WaiProxyResponse
WPRModifiedRequest

    proxyResponseFor :: Request -> WaiProxyResponse
proxyResponseFor Request
req = Request -> ProxyDest -> WaiProxyResponse
revWrapper Request
nreq (ByteString -> Int -> ProxyDest
ProxyDest ByteString
revHost Int
revPort)
      where
        nreq :: Request
nreq = Request
req
          { requestHeaders :: ResponseHeaders
requestHeaders = ResponseHeaders
hdrs
          , requestHeaderHost :: Maybe ByteString
requestHeaderHost = forall a. a -> Maybe a
Just ByteString
revHost
          }

        hdrs :: ResponseHeaders
hdrs = (HeaderName
HT.hHost, ByteString
revHost) forall a. a -> [a] -> [a]
: [ (HeaderName
hdn, ByteString
hdv)
                                     | (HeaderName
hdn, ByteString
hdv) <- Request -> ResponseHeaders
requestHeaders Request
req
                                     , Bool -> Bool
not (HeaderName -> Bool
isToStripHeader HeaderName
hdn) Bool -> Bool -> Bool
&& HeaderName
hdn forall a. Eq a => a -> a -> Bool
/= HeaderName
HT.hHost
                                     ]

httpGetProxy :: ProxySettings -> HC.Manager -> Middleware
httpGetProxy :: ProxySettings -> Manager -> Middleware
httpGetProxy pset :: ProxySettings
pset@ProxySettings{Maybe ByteString
Maybe (ByteString -> Bool)
revRemote :: Maybe ByteString
wsRemote :: Maybe ByteString
passPrompt :: Maybe ByteString
proxyAuth :: Maybe (ByteString -> Bool)
revRemote :: ProxySettings -> Maybe ByteString
wsRemote :: ProxySettings -> Maybe ByteString
passPrompt :: ProxySettings -> Maybe ByteString
proxyAuth :: ProxySettings -> Maybe (ByteString -> Bool)
..} Manager
mgr Application
fallback = (Request -> IO WaiProxyResponse)
-> WaiProxySettings -> Manager -> Application
waiProxyToSettings (forall (m :: * -> *) a. Monad m => a -> m a
returnforall b c a. (b -> c) -> (a -> b) -> a -> c
.Request -> WaiProxyResponse
proxyResponseFor) WaiProxySettings
settings Manager
mgr
  where
    settings :: WaiProxySettings
settings = WaiProxySettings
defaultWaiProxySettings { wpsSetIpHeader :: SetIpHeader
wpsSetIpHeader = SetIpHeader
SIHNone }

    proxyResponseFor :: Request -> WaiProxyResponse
proxyResponseFor Request
req
        | ProxySettings -> Request -> Bool
redirectWebsocket ProxySettings
pset Request
req = ProxyDest -> WaiProxyResponse
wsWrapper (ByteString -> Int -> ProxyDest
ProxyDest ByteString
wsHost Int
wsPort)
        | Bool -> Bool
not Bool
isGetProxy             = Application -> WaiProxyResponse
WPRApplication Application
fallback
        | ProxySettings -> Request -> Bool
checkAuth ProxySettings
pset Request
req         = Request -> ProxyDest -> WaiProxyResponse
WPRModifiedRequest Request
nreq (ByteString -> Int -> ProxyDest
ProxyDest ByteString
host Int
port)
        | Bool
otherwise                  = Response -> WaiProxyResponse
WPRResponse (ProxySettings -> Response
proxyAuthRequiredResponse ProxySettings
pset)
      where
        (ByteString
wsHost, Int
wsPort) = Int -> ByteString -> (ByteString, Int)
parseHostPortWithDefault Int
80 (forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
wsRemote)
        wsWrapper :: ProxyDest -> WaiProxyResponse
wsWrapper = if Int
wsPort forall a. Eq a => a -> a -> Bool
== Int
443 then ProxyDest -> WaiProxyResponse
WPRProxyDestSecure else ProxyDest -> WaiProxyResponse
WPRProxyDest

        notCONNECT :: Bool
notCONNECT = Request -> ByteString
requestMethod Request
req forall a. Eq a => a -> a -> Bool
/= ByteString
"CONNECT"
        rawPath :: ByteString
rawPath = Request -> ByteString
rawPathInfo Request
req
        rawPathPrefix :: ByteString
rawPathPrefix = ByteString
"http://"
        defaultPort :: Int
defaultPort = Int
80
        hostHeader :: Maybe (ByteString, Int)
hostHeader = Int -> ByteString -> (ByteString, Int)
parseHostPortWithDefault Int
defaultPort forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Maybe ByteString
requestHeaderHost Request
req

        isRawPathProxy :: Bool
isRawPathProxy = ByteString
rawPathPrefix ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
rawPath
        hasProxyHeader :: Bool
hasProxyHeader = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HeaderName -> Bool
isProxyHeaderforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) (Request -> ResponseHeaders
requestHeaders Request
req)
        scheme :: Maybe ByteString
scheme = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-Scheme" (Request -> ResponseHeaders
requestHeaders Request
req)
        isHTTP2Proxy :: Bool
isHTTP2Proxy = HttpVersion -> Int
HT.httpMajor (Request -> HttpVersion
httpVersion Request
req) forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Maybe ByteString
scheme forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ByteString
"http" Bool -> Bool -> Bool
&& Request -> Bool
isSecure Request
req

        isGetProxy :: Bool
isGetProxy = Bool
notCONNECT Bool -> Bool -> Bool
&& (Bool
isRawPathProxy Bool -> Bool -> Bool
|| Bool
isHTTP2Proxy Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (ByteString, Int)
hostHeader Bool -> Bool -> Bool
&& Bool
hasProxyHeader)

        nreq :: Request
nreq = Request
req
          { rawPathInfo :: ByteString
rawPathInfo = ByteString
newRawPath
          , requestHeaders :: ResponseHeaders
requestHeaders = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.HeaderName -> Bool
isToStripHeaderforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ Request -> ResponseHeaders
requestHeaders Request
req
          }

        ((ByteString
host, Int
port), ByteString
newRawPath)
            | Bool
isRawPathProxy  = (Int -> ByteString -> (ByteString, Int)
parseHostPortWithDefault Int
defaultPort ByteString
hostPortP, ByteString
newRawPathP)
            | Bool
otherwise       = (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (ByteString, Int)
hostHeader, ByteString
rawPath)
          where
            (ByteString
hostPortP, ByteString
newRawPathP) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.span (forall a. Eq a => a -> a -> Bool
/=Char
'/') forall a b. (a -> b) -> a -> b
$
                Int -> ByteString -> ByteString
BS.drop (ByteString -> Int
BS.length ByteString
rawPathPrefix) ByteString
rawPath

httpConnectProxy :: ProxySettings -> Middleware
httpConnectProxy :: ProxySettings -> Middleware
httpConnectProxy ProxySettings
pset Application
fallback Request
req Response -> IO ResponseReceived
respond
    | Bool -> Bool
not Bool
isConnectProxy = Application
fallback Request
req Response -> IO ResponseReceived
respond
    | ProxySettings -> Request -> Bool
checkAuth ProxySettings
pset Request
req = Response -> IO ResponseReceived
respond Response
response
    | Bool
otherwise          = Response -> IO ResponseReceived
respond (ProxySettings -> Response
proxyAuthRequiredResponse ProxySettings
pset)
  where
    hostPort' :: Maybe (ByteString, Int)
hostPort' = ByteString -> Maybe (ByteString, Int)
parseHostPort (Request -> ByteString
rawPathInfo Request
req) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Request -> Maybe ByteString
requestHeaderHost Request
req forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe (ByteString, Int)
parseHostPort)
    isConnectProxy :: Bool
isConnectProxy = Request -> ByteString
requestMethod Request
req forall a. Eq a => a -> a -> Bool
== ByteString
"CONNECT" Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe (ByteString, Int)
hostPort'

    Just (ByteString
host, Int
port) = Maybe (ByteString, Int)
hostPort'
    settings :: ClientSettings
settings = Int -> ByteString -> ClientSettings
CN.clientSettings Int
port ByteString
host

    backup :: Response
backup = Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
HT.status500 [(HeaderName
"Content-Type", ByteString
"text/plain")]
        ByteString
"HTTP CONNECT tunneling detected, but server does not support responseRaw"

    tryAndCatchAll :: IO a -> IO (Either SomeException a)
    tryAndCatchAll :: forall a. IO a -> IO (Either SomeException a)
tryAndCatchAll = forall e a. Exception e => IO a -> IO (Either e a)
try

    response :: Response
response
        | HttpVersion -> Int
HT.httpMajor (Request -> HttpVersion
httpVersion Request
req) forall a. Ord a => a -> a -> Bool
< Int
2 = (IO ByteString -> (ByteString -> IO ()) -> IO ())
-> Response -> Response
responseRaw (Bool -> IO ByteString -> (ByteString -> IO ()) -> IO ()
handleConnect Bool
True) Response
backup
        | Bool
otherwise                          = Status -> ResponseHeaders -> StreamingBody -> Response
responseStream Status
HT.status200 [] forall {a}. (Builder -> IO a) -> IO () -> IO ()
streaming
      where
        streaming :: (Builder -> IO a) -> IO () -> IO ()
streaming Builder -> IO a
write IO ()
flush = do
            IO ()
flush
            Bool -> IO ByteString -> (ByteString -> IO ()) -> IO ()
handleConnect Bool
False (Request -> IO ByteString
getRequestBodyChunk Request
req) (\ByteString
bs -> Builder -> IO a
write (ByteString -> Builder
BB.fromByteString ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
flush)

    handleConnect :: Bool -> IO BS.ByteString -> (BS.ByteString -> IO ()) -> IO ()
    handleConnect :: Bool -> IO ByteString -> (ByteString -> IO ()) -> IO ()
handleConnect Bool
http1 IO ByteString
fromClient' ByteString -> IO ()
toClient' = forall a. ClientSettings -> (AppData -> IO a) -> IO a
CN.runTCPClient ClientSettings
settings forall a b. (a -> b) -> a -> b
$ \AppData
server ->
        let toServer :: ConduitT ByteString o IO ()
toServer = forall ad (m :: * -> *) o.
(HasReadWrite ad, MonadIO m) =>
ad -> ConduitT ByteString o m ()
CN.appSink AppData
server
            fromServer :: ConduitT i ByteString IO ()
fromServer = forall ad (m :: * -> *) i.
(HasReadWrite ad, MonadIO m) =>
ad -> ConduitT i ByteString m ()
CN.appSource AppData
server
            fromClient :: ConduitT i ByteString IO ()
fromClient = do
                ByteString
bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
fromClient'
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
bs) (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 IO ()
fromClient)
            toClient :: ConduitT ByteString o IO ()
toClient = 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
. ByteString -> IO ()
toClient')
        in do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
http1 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
"HTTP/1.1 200 OK\r\n\r\n" forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall {o}. ConduitT ByteString o IO ()
toClient
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Either SomeException a)
tryAndCatchAll forall a b. (a -> b) -> a -> b
$ forall a b. IO a -> IO b -> IO (a, b)
concurrently
                (forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (forall {i}. ConduitT i ByteString IO ()
fromClient forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall {o}. ConduitT ByteString o IO ()
toServer))
                (forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (forall {i}. ConduitT i ByteString IO ()
fromServer forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall {o}. ConduitT ByteString o IO ()
toClient))