{-# LANGUAGE TemplateHaskell, OverloadedStrings, RecordWildCards #-}
{-# LANGUAGE TypeApplications, TupleSections, NumDecimals #-}
module NgxExport.Tools.Subrequest (
makeSubrequest
,makeSubrequestWithRead
,makeSubrequestFull
,makeSubrequestFullWithRead
,extractStatusFromFullResponse
,extractHeaderFromFullResponse
,extractBodyFromFullResponse
,extractExceptionFromFullResponse
,notForwardableResponseHeaders
,contentFromFullResponse
,makeBridgedSubrequest
,makeBridgedSubrequestWithRead
,makeBridgedSubrequestFull
,makeBridgedSubrequestFullWithRead
) where
import NgxExport
import NgxExport.Tools.Read
import NgxExport.Tools.SimpleService
import NgxExport.Tools.SplitService
import NgxExport.Tools.TimeInterval
import Network.HTTP.Client hiding (ResponseTimeout)
import qualified Network.HTTP.Client (HttpExceptionContent (ResponseTimeout))
import Network.HTTP.Client.BrReadWithTimeout
import Network.HTTP.Types
import qualified Network.Socket as S
import qualified Network.Socket.ByteString as SB
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C8L
import Data.IORef
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Binary as Binary
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import Data.CaseInsensitive hiding (map)
import Data.Function
import Data.Aeson
import Data.Maybe
import Data.List
import Control.Arrow
import Control.Exception
import System.IO.Unsafe
data SubrequestParseError = SubrequestParseError deriving Int -> SubrequestParseError -> ShowS
[SubrequestParseError] -> ShowS
SubrequestParseError -> String
(Int -> SubrequestParseError -> ShowS)
-> (SubrequestParseError -> String)
-> ([SubrequestParseError] -> ShowS)
-> Show SubrequestParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubrequestParseError -> ShowS
showsPrec :: Int -> SubrequestParseError -> ShowS
$cshow :: SubrequestParseError -> String
show :: SubrequestParseError -> String
$cshowList :: [SubrequestParseError] -> ShowS
showList :: [SubrequestParseError] -> ShowS
Show
instance Exception SubrequestParseError
data BridgeParseError = BridgeParseError deriving Int -> BridgeParseError -> ShowS
[BridgeParseError] -> ShowS
BridgeParseError -> String
(Int -> BridgeParseError -> ShowS)
-> (BridgeParseError -> String)
-> ([BridgeParseError] -> ShowS)
-> Show BridgeParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BridgeParseError -> ShowS
showsPrec :: Int -> BridgeParseError -> ShowS
$cshow :: BridgeParseError -> String
show :: BridgeParseError -> String
$cshowList :: [BridgeParseError] -> ShowS
showList :: [BridgeParseError] -> ShowS
Show
instance Exception BridgeParseError
data UDSNotConfiguredError = UDSNotConfiguredError deriving Int -> UDSNotConfiguredError -> ShowS
[UDSNotConfiguredError] -> ShowS
UDSNotConfiguredError -> String
(Int -> UDSNotConfiguredError -> ShowS)
-> (UDSNotConfiguredError -> String)
-> ([UDSNotConfiguredError] -> ShowS)
-> Show UDSNotConfiguredError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UDSNotConfiguredError -> ShowS
showsPrec :: Int -> UDSNotConfiguredError -> ShowS
$cshow :: UDSNotConfiguredError -> String
show :: UDSNotConfiguredError -> String
$cshowList :: [UDSNotConfiguredError] -> ShowS
showList :: [UDSNotConfiguredError] -> ShowS
Show
instance Exception UDSNotConfiguredError
data ResponseTimeout = ResponseTimeoutDefault
| ResponseTimeout TimeInterval deriving (ResponseTimeout -> ResponseTimeout -> Bool
(ResponseTimeout -> ResponseTimeout -> Bool)
-> (ResponseTimeout -> ResponseTimeout -> Bool)
-> Eq ResponseTimeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseTimeout -> ResponseTimeout -> Bool
== :: ResponseTimeout -> ResponseTimeout -> Bool
$c/= :: ResponseTimeout -> ResponseTimeout -> Bool
/= :: ResponseTimeout -> ResponseTimeout -> Bool
Eq, ReadPrec [ResponseTimeout]
ReadPrec ResponseTimeout
Int -> ReadS ResponseTimeout
ReadS [ResponseTimeout]
(Int -> ReadS ResponseTimeout)
-> ReadS [ResponseTimeout]
-> ReadPrec ResponseTimeout
-> ReadPrec [ResponseTimeout]
-> Read ResponseTimeout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ResponseTimeout
readsPrec :: Int -> ReadS ResponseTimeout
$creadList :: ReadS [ResponseTimeout]
readList :: ReadS [ResponseTimeout]
$creadPrec :: ReadPrec ResponseTimeout
readPrec :: ReadPrec ResponseTimeout
$creadListPrec :: ReadPrec [ResponseTimeout]
readListPrec :: ReadPrec [ResponseTimeout]
Read)
data SubrequestConf =
SubrequestConf { SubrequestConf -> ByteString
srMethod :: ByteString
, SubrequestConf -> String
srUri :: String
, SubrequestConf -> ByteString
srBody :: L.ByteString
, :: RequestHeaders
, SubrequestConf -> ResponseTimeout
srResponseTimeout :: ResponseTimeout
, SubrequestConf -> Bool
srUseUDS :: Bool
} deriving ReadPrec [SubrequestConf]
ReadPrec SubrequestConf
Int -> ReadS SubrequestConf
ReadS [SubrequestConf]
(Int -> ReadS SubrequestConf)
-> ReadS [SubrequestConf]
-> ReadPrec SubrequestConf
-> ReadPrec [SubrequestConf]
-> Read SubrequestConf
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SubrequestConf
readsPrec :: Int -> ReadS SubrequestConf
$creadList :: ReadS [SubrequestConf]
readList :: ReadS [SubrequestConf]
$creadPrec :: ReadPrec SubrequestConf
readPrec :: ReadPrec SubrequestConf
$creadListPrec :: ReadPrec [SubrequestConf]
readListPrec :: ReadPrec [SubrequestConf]
Read
instance FromJSON SubrequestConf where
parseJSON :: Value -> Parser SubrequestConf
parseJSON = String
-> (Object -> Parser SubrequestConf)
-> Value
-> Parser SubrequestConf
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SubrequestConf" ((Object -> Parser SubrequestConf)
-> Value -> Parser SubrequestConf)
-> (Object -> Parser SubrequestConf)
-> Value
-> Parser SubrequestConf
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
ByteString
srMethod <- ByteString -> (Text -> ByteString) -> Maybe Text -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" Text -> ByteString
T.encodeUtf8 (Maybe Text -> ByteString)
-> Parser (Maybe Text) -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"method"
String
srUri <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uri"
ByteString
srBody <- ByteString -> (Text -> ByteString) -> Maybe Text -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" Text -> ByteString
TL.encodeUtf8 (Maybe Text -> ByteString)
-> Parser (Maybe Text) -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body"
RequestHeaders
srHeaders <- ((Text, Text) -> (HeaderName, ByteString))
-> [(Text, Text)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk (ByteString -> HeaderName)
-> (Text -> ByteString) -> Text -> HeaderName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> HeaderName)
-> (Text -> ByteString) -> (Text, Text) -> (HeaderName, ByteString)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Text -> ByteString
T.encodeUtf8) ([(Text, Text)] -> RequestHeaders)
-> Parser [(Text, Text)] -> Parser RequestHeaders
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Object
o Object -> Key -> Parser (Maybe [(Text, Text)])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"headers" Parser (Maybe [(Text, Text)])
-> [(Text, Text)] -> Parser [(Text, Text)]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
ResponseTimeout
srResponseTimeout <- ResponseTimeout
-> (TimeInterval -> ResponseTimeout)
-> Maybe TimeInterval
-> ResponseTimeout
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ResponseTimeout
ResponseTimeoutDefault TimeInterval -> ResponseTimeout
ResponseTimeout (Maybe TimeInterval -> ResponseTimeout)
-> Parser (Maybe TimeInterval) -> Parser ResponseTimeout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Object
o Object -> Key -> Parser (Maybe TimeInterval)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"timeout"
Bool
srUseUDS <- Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"useUDS"
SubrequestConf -> Parser SubrequestConf
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return SubrequestConf {Bool
String
RequestHeaders
ByteString
ByteString
ResponseTimeout
srMethod :: ByteString
srUri :: String
srBody :: ByteString
srHeaders :: RequestHeaders
srResponseTimeout :: ResponseTimeout
srUseUDS :: Bool
srMethod :: ByteString
srUri :: String
srBody :: ByteString
srHeaders :: RequestHeaders
srResponseTimeout :: ResponseTimeout
srUseUDS :: Bool
..}
data BridgeConf =
BridgeConf { BridgeConf -> SubrequestConf
bridgeSource :: SubrequestConf
, BridgeConf -> SubrequestConf
bridgeSink :: SubrequestConf
} deriving ReadPrec [BridgeConf]
ReadPrec BridgeConf
Int -> ReadS BridgeConf
ReadS [BridgeConf]
(Int -> ReadS BridgeConf)
-> ReadS [BridgeConf]
-> ReadPrec BridgeConf
-> ReadPrec [BridgeConf]
-> Read BridgeConf
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BridgeConf
readsPrec :: Int -> ReadS BridgeConf
$creadList :: ReadS [BridgeConf]
readList :: ReadS [BridgeConf]
$creadPrec :: ReadPrec BridgeConf
readPrec :: ReadPrec BridgeConf
$creadListPrec :: ReadPrec [BridgeConf]
readListPrec :: ReadPrec [BridgeConf]
Read
instance FromJSON BridgeConf where
parseJSON :: Value -> Parser BridgeConf
parseJSON = String
-> (Object -> Parser BridgeConf) -> Value -> Parser BridgeConf
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BridgeConf" ((Object -> Parser BridgeConf) -> Value -> Parser BridgeConf)
-> (Object -> Parser BridgeConf) -> Value -> Parser BridgeConf
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
SubrequestConf
bridgeSource <- Object
o Object -> Key -> Parser SubrequestConf
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
SubrequestConf
bridgeSink <- Object
o Object -> Key -> Parser SubrequestConf
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sink"
BridgeConf -> Parser BridgeConf
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BridgeConf {SubrequestConf
bridgeSource :: SubrequestConf
bridgeSink :: SubrequestConf
bridgeSource :: SubrequestConf
bridgeSink :: SubrequestConf
..}
makeRequest :: SubrequestConf -> Request -> Request
makeRequest :: SubrequestConf -> Request -> Request
makeRequest SubrequestConf {Bool
String
RequestHeaders
ByteString
ByteString
ResponseTimeout
srMethod :: SubrequestConf -> ByteString
srUri :: SubrequestConf -> String
srBody :: SubrequestConf -> ByteString
srHeaders :: SubrequestConf -> RequestHeaders
srResponseTimeout :: SubrequestConf -> ResponseTimeout
srUseUDS :: SubrequestConf -> Bool
srMethod :: ByteString
srUri :: String
srBody :: ByteString
srHeaders :: RequestHeaders
srResponseTimeout :: ResponseTimeout
srUseUDS :: Bool
..} Request
req =
Request
req { method :: ByteString
method = if ByteString -> Bool
B.null ByteString
srMethod
then Request -> ByteString
method Request
req
else ByteString
srMethod
, requestBody :: RequestBody
requestBody = if ByteString -> Bool
L.null ByteString
srBody
then Request -> RequestBody
requestBody Request
req
else ByteString -> RequestBody
RequestBodyLBS ByteString
srBody
, requestHeaders :: RequestHeaders
requestHeaders = ((HeaderName, ByteString) -> (HeaderName, ByteString) -> Bool)
-> RequestHeaders -> RequestHeaders -> RequestHeaders
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy (HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (HeaderName -> HeaderName -> Bool)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst) RequestHeaders
srHeaders (RequestHeaders -> RequestHeaders)
-> RequestHeaders -> RequestHeaders
forall a b. (a -> b) -> a -> b
$
Request -> RequestHeaders
requestHeaders Request
req
, responseTimeout :: ResponseTimeout
responseTimeout = if ResponseTimeout
srResponseTimeout ResponseTimeout -> ResponseTimeout -> Bool
forall a. Eq a => a -> a -> Bool
== ResponseTimeout
ResponseTimeoutDefault
then Request -> ResponseTimeout
responseTimeout Request
req
else ResponseTimeout -> ResponseTimeout
setTimeout ResponseTimeout
srResponseTimeout
}
where setTimeout :: ResponseTimeout -> ResponseTimeout
setTimeout (ResponseTimeout TimeInterval
v)
| Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ResponseTimeout
responseTimeoutNone
| Bool
otherwise = Int -> ResponseTimeout
responseTimeoutMicro (Int -> ResponseTimeout) -> Int -> ResponseTimeout
forall a b. (a -> b) -> a -> b
$ Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1e6
where t :: Int
t = TimeInterval -> Int
toSec TimeInterval
v
setTimeout ResponseTimeout
_ = ResponseTimeout
forall a. HasCallStack => a
undefined
subrequest :: (String -> IO Request) ->
(Response L.ByteString -> L.ByteString) -> SubrequestConf ->
IO L.ByteString
subrequest :: (String -> IO Request)
-> (Response ByteString -> ByteString)
-> SubrequestConf
-> IO ByteString
subrequest String -> IO Request
parseRequestF Response ByteString -> ByteString
buildResponseF sub :: SubrequestConf
sub@SubrequestConf {Bool
String
RequestHeaders
ByteString
ByteString
ResponseTimeout
srMethod :: SubrequestConf -> ByteString
srUri :: SubrequestConf -> String
srBody :: SubrequestConf -> ByteString
srHeaders :: SubrequestConf -> RequestHeaders
srResponseTimeout :: SubrequestConf -> ResponseTimeout
srUseUDS :: SubrequestConf -> Bool
srMethod :: ByteString
srUri :: String
srBody :: ByteString
srHeaders :: RequestHeaders
srResponseTimeout :: ResponseTimeout
srUseUDS :: Bool
..} = do
Manager
man <- if Bool
srUseUDS
then Manager -> Maybe Manager -> Manager
forall a. a -> Maybe a -> a
fromMaybe (UDSNotConfiguredError -> Manager
forall a e. Exception e => e -> a
throw UDSNotConfiguredError
UDSNotConfiguredError) (Maybe Manager -> Manager) -> IO (Maybe Manager) -> IO Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
IORef (Maybe Manager) -> IO (Maybe Manager)
forall a. IORef a -> IO a
readIORef IORef (Maybe Manager)
httpUDSManager
else Manager -> IO Manager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Manager
httpManager
Request
req <- String -> IO Request
parseRequestF String
srUri
Response ByteString -> ByteString
buildResponseF (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
httpLbsBrReadWithTimeout (SubrequestConf -> Request -> Request
makeRequest SubrequestConf
sub Request
req) Manager
man
subrequestBody :: SubrequestConf -> IO L.ByteString
subrequestBody :: SubrequestConf -> IO ByteString
subrequestBody = (String -> IO Request)
-> (Response ByteString -> ByteString)
-> SubrequestConf
-> IO ByteString
subrequest String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow Response ByteString -> ByteString
forall body. Response body -> body
responseBody
type FullResponse = (Int, [(ByteString, ByteString)], L.ByteString, ByteString)
handleFullResponse :: IO L.ByteString -> IO L.ByteString
handleFullResponse :: IO ByteString -> IO ByteString
handleFullResponse = (SomeException -> IO ByteString) -> IO ByteString -> IO ByteString
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ((SomeException -> IO ByteString)
-> IO ByteString -> IO ByteString)
-> (SomeException -> IO ByteString)
-> IO ByteString
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \SomeException
e -> do
let msg :: ByteString
msg = String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
responseXXX :: t -> (t, [a], ByteString, ByteString)
responseXXX = (, [], ByteString
"", ByteString
msg)
response500 :: (Int, [a], ByteString, ByteString)
response500 = Int -> (Int, [a], ByteString, ByteString)
forall {t} {a}. t -> (t, [a], ByteString, ByteString)
responseXXX Int
500
response502 :: (Int, [a], ByteString, ByteString)
response502 = Int -> (Int, [a], ByteString, ByteString)
forall {t} {a}. t -> (t, [a], ByteString, ByteString)
responseXXX Int
502
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
$ forall a. Binary a => a -> ByteString
Binary.encode @FullResponse (FullResponse -> ByteString) -> FullResponse -> ByteString
forall a b. (a -> b) -> a -> b
$
case SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just (HttpExceptionRequest Request
_ HttpExceptionContent
c) ->
case HttpExceptionContent
c of
HttpExceptionContent
Network.HTTP.Client.ResponseTimeout -> FullResponse
forall {a}. (Int, [a], ByteString, ByteString)
response502
HttpExceptionContent
ConnectionTimeout -> FullResponse
forall {a}. (Int, [a], ByteString, ByteString)
response502
ConnectionFailure SomeException
_ -> FullResponse
forall {a}. (Int, [a], ByteString, ByteString)
response502
StatusCodeException Response ()
r ByteString
_ ->
let status :: Int
status = Status -> Int
statusCode (Status -> Int) -> Status -> Int
forall a b. (a -> b) -> a -> b
$ Response () -> Status
forall body. Response body -> Status
responseStatus Response ()
r
in Int -> FullResponse
forall {t} {a}. t -> (t, [a], ByteString, ByteString)
responseXXX Int
status
HttpExceptionContent
_ -> FullResponse
forall {a}. (Int, [a], ByteString, ByteString)
response500
Maybe HttpException
_ -> FullResponse
forall {a}. (Int, [a], ByteString, ByteString)
response500
buildFullResponse :: Response L.ByteString -> L.ByteString
buildFullResponse :: Response ByteString -> ByteString
buildFullResponse Response ByteString
r =
let status :: Int
status = Status -> Int
statusCode (Status -> Int) -> Status -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
r
headers :: [(ByteString, ByteString)]
headers = ((HeaderName, ByteString) -> (ByteString, ByteString))
-> RequestHeaders -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((HeaderName -> ByteString)
-> (HeaderName, ByteString) -> (ByteString, ByteString)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first HeaderName -> ByteString
forall s. CI s -> s
original) (RequestHeaders -> [(ByteString, ByteString)])
-> RequestHeaders -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Response ByteString -> RequestHeaders
forall body. Response body -> RequestHeaders
responseHeaders Response ByteString
r
body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
r
in forall a. Binary a => a -> ByteString
Binary.encode @FullResponse (Int
status, [(ByteString, ByteString)]
headers, ByteString
body, ByteString
"")
subrequestFull :: SubrequestConf -> IO L.ByteString
subrequestFull :: SubrequestConf -> IO ByteString
subrequestFull = IO ByteString -> IO ByteString
handleFullResponse (IO ByteString -> IO ByteString)
-> (SubrequestConf -> IO ByteString)
-> SubrequestConf
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO Request)
-> (Response ByteString -> ByteString)
-> SubrequestConf
-> IO ByteString
subrequest String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest Response ByteString -> ByteString
buildFullResponse
httpManager :: Manager
httpManager :: Manager
httpManager = IO Manager -> Manager
forall a. IO a -> a
unsafePerformIO (IO Manager -> Manager) -> IO Manager -> Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
{-# NOINLINE httpManager #-}
httpUDSManager :: IORef (Maybe Manager)
httpUDSManager :: IORef (Maybe Manager)
httpUDSManager = IO (IORef (Maybe Manager)) -> IORef (Maybe Manager)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Maybe Manager)) -> IORef (Maybe Manager))
-> IO (IORef (Maybe Manager)) -> IORef (Maybe Manager)
forall a b. (a -> b) -> a -> b
$ Maybe Manager -> IO (IORef (Maybe Manager))
forall a. a -> IO (IORef a)
newIORef Maybe Manager
forall a. Maybe a
Nothing
{-# NOINLINE httpUDSManager #-}
makeSubrequest
:: ByteString
-> IO L.ByteString
makeSubrequest :: ByteString -> IO ByteString
makeSubrequest =
IO ByteString
-> (SubrequestConf -> IO ByteString)
-> Maybe SubrequestConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SubrequestParseError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO SubrequestParseError
SubrequestParseError) SubrequestConf -> IO ByteString
subrequestBody (Maybe SubrequestConf -> IO ByteString)
-> (ByteString -> Maybe SubrequestConf)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. FromJSON a => ByteString -> Maybe a
readFromByteStringAsJSON @SubrequestConf
ngxExportAsyncIOYY 'makeSubrequest
makeSubrequestWithRead
:: ByteString
-> IO L.ByteString
makeSubrequestWithRead :: ByteString -> IO ByteString
makeSubrequestWithRead =
IO ByteString
-> (SubrequestConf -> IO ByteString)
-> Maybe SubrequestConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SubrequestParseError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO SubrequestParseError
SubrequestParseError) SubrequestConf -> IO ByteString
subrequestBody (Maybe SubrequestConf -> IO ByteString)
-> (ByteString -> Maybe SubrequestConf)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Read a => ByteString -> Maybe a
readFromByteString @SubrequestConf
ngxExportAsyncIOYY 'makeSubrequestWithRead
newtype UDSConf = UDSConf { UDSConf -> String
udsPath :: FilePath } deriving ReadPrec [UDSConf]
ReadPrec UDSConf
Int -> ReadS UDSConf
ReadS [UDSConf]
(Int -> ReadS UDSConf)
-> ReadS [UDSConf]
-> ReadPrec UDSConf
-> ReadPrec [UDSConf]
-> Read UDSConf
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UDSConf
readsPrec :: Int -> ReadS UDSConf
$creadList :: ReadS [UDSConf]
readList :: ReadS [UDSConf]
$creadPrec :: ReadPrec UDSConf
readPrec :: ReadPrec UDSConf
$creadListPrec :: ReadPrec [UDSConf]
readListPrec :: ReadPrec [UDSConf]
Read
configureUDS :: UDSConf -> Bool -> IO L.ByteString
configureUDS :: UDSConf -> Bool -> IO ByteString
configureUDS = (UDSConf -> IO ByteString) -> UDSConf -> Bool -> IO ByteString
forall a. (a -> IO ByteString) -> a -> Bool -> IO ByteString
ignitionService ((UDSConf -> IO ByteString) -> UDSConf -> Bool -> IO ByteString)
-> (UDSConf -> IO ByteString) -> UDSConf -> Bool -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \UDSConf {String
udsPath :: UDSConf -> String
udsPath :: String
..} -> do
Manager
man <- ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
{ managerRawConnection :: IO (Maybe HostAddress -> String -> Int -> IO Connection)
managerRawConnection = (Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection))
-> (Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall a b. (a -> b) -> a -> b
$ String -> Maybe HostAddress -> String -> Int -> IO Connection
forall {p} {p} {p}. String -> p -> p -> p -> IO Connection
openUDS String
udsPath }
IORef (Maybe Manager) -> Maybe Manager -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Manager)
httpUDSManager (Maybe Manager -> IO ()) -> Maybe Manager -> IO ()
forall a b. (a -> b) -> a -> b
$ Manager -> Maybe Manager
forall a. a -> Maybe a
Just Manager
man
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""
where openUDS :: String -> p -> p -> p -> IO Connection
openUDS String
path p
_ p
_ p
_ = do
Socket
s <- Family -> SocketType -> CInt -> IO Socket
S.socket Family
S.AF_UNIX SocketType
S.Stream CInt
S.defaultProtocol
Socket -> SockAddr -> IO ()
S.connect Socket
s (String -> SockAddr
S.SockAddrUnix String
path)
IO ByteString -> (ByteString -> IO ()) -> IO () -> IO Connection
makeConnection (Socket -> Int -> IO ByteString
SB.recv Socket
s Int
4096) (Socket -> ByteString -> IO ()
SB.sendAll Socket
s) (Socket -> IO ()
S.close Socket
s)
ngxExportSimpleServiceTyped 'configureUDS ''UDSConf SingleShotService
makeSubrequestFull
:: ByteString
-> IO L.ByteString
makeSubrequestFull :: ByteString -> IO ByteString
makeSubrequestFull =
IO ByteString
-> (SubrequestConf -> IO ByteString)
-> Maybe SubrequestConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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
$
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse
(Int
400, [], ByteString
"", ByteString
"Unreadable subrequest data")
) SubrequestConf -> IO ByteString
subrequestFull (Maybe SubrequestConf -> IO ByteString)
-> (ByteString -> Maybe SubrequestConf)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Maybe a
readFromByteStringAsJSON @SubrequestConf
ngxExportAsyncIOYY 'makeSubrequestFull
makeSubrequestFullWithRead
:: ByteString
-> IO L.ByteString
makeSubrequestFullWithRead :: ByteString -> IO ByteString
makeSubrequestFullWithRead =
IO ByteString
-> (SubrequestConf -> IO ByteString)
-> Maybe SubrequestConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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
$
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse
(Int
400, [], ByteString
"", ByteString
"Unreadable subrequest data")
) SubrequestConf -> IO ByteString
subrequestFull (Maybe SubrequestConf -> IO ByteString)
-> (ByteString -> Maybe SubrequestConf)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => ByteString -> Maybe a
readFromByteString @SubrequestConf
ngxExportAsyncIOYY 'makeSubrequestFullWithRead
extractStatusFromFullResponse
:: ByteString
-> L.ByteString
= String -> ByteString
C8L.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (ByteString -> Int) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\(Int
a, [(ByteString, ByteString)]
_, ByteString
_, ByteString
_) -> Int
a) (FullResponse -> Int)
-> (ByteString -> FullResponse) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => ByteString -> a
Binary.decode @FullResponse (ByteString -> FullResponse)
-> (ByteString -> ByteString) -> ByteString -> FullResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict
extractHeaderFromFullResponse
:: ByteString
-> L.ByteString
ByteString
v =
let (HeaderName
h, ByteString
b) = ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk (ByteString -> HeaderName)
-> (ByteString -> ByteString)
-> (ByteString, ByteString)
-> (HeaderName, ByteString)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** HasCallStack => ByteString -> ByteString
ByteString -> ByteString
C8.tail ((ByteString, ByteString) -> (HeaderName, ByteString))
-> (ByteString, ByteString) -> (HeaderName, ByteString)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.break (Char
'|' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ByteString
v
(Int
_, [(ByteString, ByteString)]
hs, ByteString
_, ByteString
_) = forall a. Binary a => ByteString -> a
Binary.decode @FullResponse (ByteString -> FullResponse) -> ByteString -> FullResponse
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict ByteString
b
in ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ByteString -> ByteString
L.fromStrict (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
h (RequestHeaders -> Maybe ByteString)
-> RequestHeaders -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ((ByteString, ByteString) -> (HeaderName, ByteString))
-> [(ByteString, ByteString)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> HeaderName)
-> (ByteString, ByteString) -> (HeaderName, ByteString)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk) [(ByteString, ByteString)]
hs
extractBodyFromFullResponse
:: ByteString
-> L.ByteString
extractBodyFromFullResponse :: ByteString -> ByteString
extractBodyFromFullResponse =
(\(Int
_, [(ByteString, ByteString)]
_, ByteString
a, ByteString
_) -> ByteString
a) (FullResponse -> ByteString)
-> (ByteString -> FullResponse) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => ByteString -> a
Binary.decode @FullResponse (ByteString -> FullResponse)
-> (ByteString -> ByteString) -> ByteString -> FullResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict
ngxExportYY 'extractBodyFromFullResponse
extractExceptionFromFullResponse
:: ByteString
-> L.ByteString
= ByteString -> ByteString
L.fromStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\(Int
_, [(ByteString, ByteString)]
_, ByteString
_, ByteString
a) -> ByteString
a) (FullResponse -> ByteString)
-> (ByteString -> FullResponse) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => ByteString -> a
Binary.decode @FullResponse (ByteString -> FullResponse)
-> (ByteString -> ByteString) -> ByteString -> FullResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict
notForwardableResponseHeaders :: HashSet HeaderName
= [HeaderName] -> HashSet HeaderName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([HeaderName] -> HashSet HeaderName)
-> [HeaderName] -> HashSet HeaderName
forall a b. (a -> b) -> a -> b
$
(ByteString -> HeaderName) -> [ByteString] -> [HeaderName]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk [ByteString
"Connection"
,ByteString
"Content-Length"
,ByteString
"Content-Type"
,ByteString
"Date"
,ByteString
"Keep-Alive"
,ByteString
"Last-Modified"
,ByteString
"Server"
,ByteString
"Transfer-Encoding"
,ByteString
"X-Pad"
]
deleteHeaders :: HashSet HeaderName -> Bool -> ResponseHeaders ->
ResponseHeaders
HashSet HeaderName
headersToDelete Bool
deleteXAccel =
((HeaderName, ByteString) -> Bool)
-> RequestHeaders -> RequestHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
n, ByteString
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
HeaderName
n HeaderName -> HashSet HeaderName -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet HeaderName
headersToDelete Bool -> Bool -> Bool
||
Bool
deleteXAccel Bool -> Bool -> Bool
&&
ByteString -> ByteString
forall s. FoldCase s => s -> s
foldCase ByteString
"X-Accel-" ByteString -> ByteString -> Bool
`B.isPrefixOf` HeaderName -> ByteString
forall s. CI s -> s
foldedCase HeaderName
n
)
contentFromFullResponse
:: HashSet HeaderName
-> Bool
-> (L.ByteString -> ByteString -> L.ByteString)
-> ByteString
-> ContentHandlerResult
contentFromFullResponse :: HashSet HeaderName
-> Bool
-> (ByteString -> ByteString -> ByteString)
-> ByteString
-> ContentHandlerResult
contentFromFullResponse HashSet HeaderName
headersToDelete Bool
deleteXAccel ByteString -> ByteString -> ByteString
f ByteString
v =
let (Int
st, [(ByteString, ByteString)]
hs, ByteString
b, ByteString
e) = forall a. Binary a => ByteString -> a
Binary.decode @FullResponse (ByteString -> FullResponse) -> ByteString -> FullResponse
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict ByteString
v
hs' :: RequestHeaders
hs' = ((ByteString, ByteString) -> (HeaderName, ByteString))
-> [(ByteString, ByteString)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> HeaderName)
-> (ByteString, ByteString) -> (HeaderName, ByteString)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk) [(ByteString, ByteString)]
hs
ct :: ByteString
ct = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk ByteString
"Content-Type") RequestHeaders
hs'
hs'' :: RequestHeaders
hs'' = HashSet HeaderName -> Bool -> RequestHeaders -> RequestHeaders
deleteHeaders HashSet HeaderName
headersToDelete Bool
deleteXAccel RequestHeaders
hs'
in (ByteString -> ByteString -> ByteString
f ByteString
b ByteString
e, ByteString
ct, Int
st, ((HeaderName, ByteString) -> (ByteString, ByteString))
-> RequestHeaders -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((HeaderName -> ByteString)
-> (HeaderName, ByteString) -> (ByteString, ByteString)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first HeaderName -> ByteString
forall s. CI s -> s
original) RequestHeaders
hs'')
fromFullResponse :: ByteString -> ContentHandlerResult
fromFullResponse :: ByteString -> ContentHandlerResult
fromFullResponse =
HashSet HeaderName
-> Bool
-> (ByteString -> ByteString -> ByteString)
-> ByteString
-> ContentHandlerResult
contentFromFullResponse HashSet HeaderName
notForwardableResponseHeaders Bool
True ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const
ngxExportHandler 'fromFullResponse
fromFullResponseWithException :: ByteString -> ContentHandlerResult
fromFullResponseWithException :: ByteString -> ContentHandlerResult
fromFullResponseWithException =
HashSet HeaderName
-> Bool
-> (ByteString -> ByteString -> ByteString)
-> ByteString
-> ContentHandlerResult
contentFromFullResponse HashSet HeaderName
notForwardableResponseHeaders Bool
True ByteString -> ByteString -> ByteString
f
where f :: ByteString -> ByteString -> ByteString
f ByteString
"" = ByteString -> ByteString
L.fromStrict
f ByteString
b = ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const ByteString
b
ngxExportHandler 'fromFullResponseWithException
makeStreamingRequest :: GivesPopper () -> SubrequestConf -> Request -> Request
makeStreamingRequest :: GivesPopper () -> SubrequestConf -> Request -> Request
makeStreamingRequest GivesPopper ()
givesPopper SubrequestConf
conf Request
req =
SubrequestConf -> Request -> Request
makeRequest SubrequestConf
conf { srMethod :: ByteString
srMethod = ByteString
"POST" , srBody :: ByteString
srBody = ByteString
"" }
Request
req { requestBody :: RequestBody
requestBody = GivesPopper () -> RequestBody
RequestBodyStreamChunked GivesPopper ()
givesPopper }
bridgedSubrequest :: (String -> IO Request) ->
(Response L.ByteString -> L.ByteString) -> BridgeConf ->
IO L.ByteString
bridgedSubrequest :: (String -> IO Request)
-> (Response ByteString -> ByteString)
-> BridgeConf
-> IO ByteString
bridgedSubrequest String -> IO Request
parseRequestF Response ByteString -> ByteString
buildResponseF BridgeConf {SubrequestConf
bridgeSource :: BridgeConf -> SubrequestConf
bridgeSink :: BridgeConf -> SubrequestConf
bridgeSource :: SubrequestConf
bridgeSink :: SubrequestConf
..} = do
Manager
manIn <- if SubrequestConf -> Bool
srUseUDS SubrequestConf
bridgeSource
then Manager -> Maybe Manager -> Manager
forall a. a -> Maybe a -> a
fromMaybe (UDSNotConfiguredError -> Manager
forall a e. Exception e => e -> a
throw UDSNotConfiguredError
UDSNotConfiguredError) (Maybe Manager -> Manager) -> IO (Maybe Manager) -> IO Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
IORef (Maybe Manager) -> IO (Maybe Manager)
forall a. IORef a -> IO a
readIORef IORef (Maybe Manager)
httpUDSManager
else Manager -> IO Manager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Manager
httpManager
Manager
manOut <- if SubrequestConf -> Bool
srUseUDS SubrequestConf
bridgeSink
then Manager -> Maybe Manager -> Manager
forall a. a -> Maybe a -> a
fromMaybe (UDSNotConfiguredError -> Manager
forall a e. Exception e => e -> a
throw UDSNotConfiguredError
UDSNotConfiguredError) (Maybe Manager -> Manager) -> IO (Maybe Manager) -> IO Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
IORef (Maybe Manager) -> IO (Maybe Manager)
forall a. IORef a -> IO a
readIORef IORef (Maybe Manager)
httpUDSManager
else Manager -> IO Manager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Manager
httpManager
Request
reqIn <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ SubrequestConf -> String
srUri SubrequestConf
bridgeSource
Request
reqOut <- String -> IO Request
parseRequestF (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ SubrequestConf -> String
srUri SubrequestConf
bridgeSink
Request
-> Manager
-> (Response (IO ByteString) -> IO ByteString)
-> IO ByteString
forall a.
Request -> Manager -> (Response (IO ByteString) -> IO a) -> IO a
withResponse (SubrequestConf -> Request -> Request
makeRequest SubrequestConf
bridgeSource Request
reqIn) Manager
manIn ((Response (IO ByteString) -> IO ByteString) -> IO ByteString)
-> (Response (IO ByteString) -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Response (IO ByteString)
respIn -> do
let reqOut' :: Request
reqOut' = Request
reqOut { requestHeaders :: RequestHeaders
requestHeaders =
HashSet HeaderName -> Bool -> RequestHeaders -> RequestHeaders
deleteHeaders
HashSet HeaderName
notForwardableResponseHeaders
Bool
True (Response (IO ByteString) -> RequestHeaders
forall body. Response body -> RequestHeaders
responseHeaders Response (IO ByteString)
respIn)
}
tmo :: Int
tmo = Request -> Manager -> Int
fromResponseTimeout Request
reqIn Manager
manIn
givesPopper :: (IO ByteString -> b) -> b
givesPopper IO ByteString -> b
needsPopper = IO ByteString -> b
needsPopper (IO ByteString -> b) -> IO ByteString -> b
forall a b. (a -> b) -> a -> b
$
Int -> Request -> IO ByteString -> IO ByteString
brReadWithTimeout Int
tmo Request
reqIn (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Response (IO ByteString) -> IO ByteString
forall body. Response body -> body
responseBody Response (IO ByteString)
respIn
Response ByteString -> ByteString
buildResponseF (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Request -> Manager -> IO (Response ByteString)
httpLbsBrReadWithTimeout
(GivesPopper () -> SubrequestConf -> Request -> Request
makeStreamingRequest GivesPopper ()
forall {b}. (IO ByteString -> b) -> b
givesPopper SubrequestConf
bridgeSink Request
reqOut') Manager
manOut
bridgedSubrequestBody :: BridgeConf -> IO L.ByteString
bridgedSubrequestBody :: BridgeConf -> IO ByteString
bridgedSubrequestBody = (String -> IO Request)
-> (Response ByteString -> ByteString)
-> BridgeConf
-> IO ByteString
bridgedSubrequest String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow Response ByteString -> ByteString
forall body. Response body -> body
responseBody
bridgedSubrequestFull :: BridgeConf -> IO L.ByteString
bridgedSubrequestFull :: BridgeConf -> IO ByteString
bridgedSubrequestFull =
IO ByteString -> IO ByteString
handleFullResponse (IO ByteString -> IO ByteString)
-> (BridgeConf -> IO ByteString) -> BridgeConf -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO Request)
-> (Response ByteString -> ByteString)
-> BridgeConf
-> IO ByteString
bridgedSubrequest String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest Response ByteString -> ByteString
buildFullResponse
makeBridgedSubrequest
:: ByteString
-> IO L.ByteString
makeBridgedSubrequest :: ByteString -> IO ByteString
makeBridgedSubrequest =
IO ByteString
-> (BridgeConf -> IO ByteString)
-> Maybe BridgeConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BridgeParseError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO BridgeParseError
BridgeParseError) BridgeConf -> IO ByteString
bridgedSubrequestBody (Maybe BridgeConf -> IO ByteString)
-> (ByteString -> Maybe BridgeConf) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. FromJSON a => ByteString -> Maybe a
readFromByteStringAsJSON @BridgeConf
ngxExportAsyncIOYY 'makeBridgedSubrequest
makeBridgedSubrequestWithRead
:: ByteString
-> IO L.ByteString
makeBridgedSubrequestWithRead :: ByteString -> IO ByteString
makeBridgedSubrequestWithRead =
IO ByteString
-> (BridgeConf -> IO ByteString)
-> Maybe BridgeConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BridgeParseError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO BridgeParseError
BridgeParseError) BridgeConf -> IO ByteString
bridgedSubrequestBody (Maybe BridgeConf -> IO ByteString)
-> (ByteString -> Maybe BridgeConf) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Read a => ByteString -> Maybe a
readFromByteString @BridgeConf
ngxExportAsyncIOYY 'makeBridgedSubrequestWithRead
makeBridgedSubrequestFull
:: ByteString
-> IO L.ByteString
makeBridgedSubrequestFull :: ByteString -> IO ByteString
makeBridgedSubrequestFull =
IO ByteString
-> (BridgeConf -> IO ByteString)
-> Maybe BridgeConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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
$
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse
(Int
400, [], ByteString
"", ByteString
"Unreadable bridged subrequest data")
) BridgeConf -> IO ByteString
bridgedSubrequestFull (Maybe BridgeConf -> IO ByteString)
-> (ByteString -> Maybe BridgeConf) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Maybe a
readFromByteStringAsJSON @BridgeConf
ngxExportAsyncIOYY 'makeBridgedSubrequestFull
makeBridgedSubrequestFullWithRead
:: ByteString
-> IO L.ByteString
makeBridgedSubrequestFullWithRead :: ByteString -> IO ByteString
makeBridgedSubrequestFullWithRead =
IO ByteString
-> (BridgeConf -> IO ByteString)
-> Maybe BridgeConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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
$
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse
(Int
400, [], ByteString
"", ByteString
"Unreadable bridged subrequest data")
) BridgeConf -> IO ByteString
bridgedSubrequestFull (Maybe BridgeConf -> IO ByteString)
-> (ByteString -> Maybe BridgeConf) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => ByteString -> Maybe a
readFromByteString @BridgeConf
ngxExportAsyncIOYY 'makeBridgedSubrequestFullWithRead