{-# 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
import Network.HTTP.Client hiding (ResponseTimeout)
import qualified Network.HTTP.Client (HttpExceptionContent (ResponseTimeout))
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.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
showList :: [SubrequestParseError] -> ShowS
$cshowList :: [SubrequestParseError] -> ShowS
show :: SubrequestParseError -> String
$cshow :: SubrequestParseError -> String
showsPrec :: Int -> SubrequestParseError -> ShowS
$cshowsPrec :: Int -> 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
showList :: [BridgeParseError] -> ShowS
$cshowList :: [BridgeParseError] -> ShowS
show :: BridgeParseError -> String
$cshow :: BridgeParseError -> String
showsPrec :: Int -> BridgeParseError -> ShowS
$cshowsPrec :: Int -> 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
showList :: [UDSNotConfiguredError] -> ShowS
$cshowList :: [UDSNotConfiguredError] -> ShowS
show :: UDSNotConfiguredError -> String
$cshow :: UDSNotConfiguredError -> String
showsPrec :: Int -> UDSNotConfiguredError -> ShowS
$cshowsPrec :: Int -> 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
/= :: ResponseTimeout -> ResponseTimeout -> Bool
$c/= :: ResponseTimeout -> ResponseTimeout -> Bool
== :: ResponseTimeout -> ResponseTimeout -> Bool
$c== :: 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
readListPrec :: ReadPrec [ResponseTimeout]
$creadListPrec :: ReadPrec [ResponseTimeout]
readPrec :: ReadPrec ResponseTimeout
$creadPrec :: ReadPrec ResponseTimeout
readList :: ReadS [ResponseTimeout]
$creadList :: ReadS [ResponseTimeout]
readsPrec :: Int -> ReadS ResponseTimeout
$creadsPrec :: Int -> ReadS ResponseTimeout
Read)
data SubrequestConf =
SubrequestConf { SubrequestConf -> ByteString
srMethod :: ByteString
, SubrequestConf -> String
srUri :: String
, SubrequestConf -> ByteString
srBody :: 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
readListPrec :: ReadPrec [SubrequestConf]
$creadListPrec :: ReadPrec [SubrequestConf]
readPrec :: ReadPrec SubrequestConf
$creadPrec :: ReadPrec SubrequestConf
readList :: ReadS [SubrequestConf]
$creadList :: ReadS [SubrequestConf]
readsPrec :: Int -> ReadS SubrequestConf
$creadsPrec :: Int -> ReadS 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 "SubrequestConf" ((Object -> Parser SubrequestConf)
-> Value -> Parser SubrequestConf)
-> (Object -> Parser SubrequestConf)
-> Value
-> Parser SubrequestConf
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
ByteString
srMethod <- Parser (Maybe Text) -> Parser ByteString
maybeEmpty (Parser (Maybe Text) -> Parser ByteString)
-> Parser (Maybe Text) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "method"
String
srUri <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "uri"
ByteString
srBody <- Parser (Maybe Text) -> Parser ByteString
maybeEmpty (Parser (Maybe Text) -> Parser ByteString)
-> Parser (Maybe Text) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "body"
RequestHeaders
srHeaders <- ((Text, Text) -> Header) -> [(Text, Text)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString)
-> (Text -> ByteString) -> Text -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> CI ByteString)
-> (Text -> ByteString) -> (Text, Text) -> Header
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 -> Text -> Parser (Maybe [(Text, Text)])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "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 -> Text -> Parser (Maybe TimeInterval)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "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 -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "useUDS"
SubrequestConf -> Parser SubrequestConf
forall (m :: * -> *) a. Monad m => a -> m a
return SubrequestConf :: ByteString
-> String
-> ByteString
-> RequestHeaders
-> ResponseTimeout
-> Bool
-> SubrequestConf
SubrequestConf {..}
where maybeEmpty :: Parser (Maybe Text) -> Parser ByteString
maybeEmpty = (Maybe Text -> ByteString)
-> Parser (Maybe Text) -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe Text -> ByteString)
-> Parser (Maybe Text) -> Parser ByteString)
-> (Maybe Text -> ByteString)
-> Parser (Maybe Text)
-> Parser ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> (Text -> ByteString) -> Maybe Text -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" Text -> ByteString
T.encodeUtf8
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
readListPrec :: ReadPrec [BridgeConf]
$creadListPrec :: ReadPrec [BridgeConf]
readPrec :: ReadPrec BridgeConf
$creadPrec :: ReadPrec BridgeConf
readList :: ReadS [BridgeConf]
$creadList :: ReadS [BridgeConf]
readsPrec :: Int -> ReadS BridgeConf
$creadsPrec :: Int -> ReadS 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 "BridgeConf" ((Object -> Parser BridgeConf) -> Value -> Parser BridgeConf)
-> (Object -> Parser BridgeConf) -> Value -> Parser BridgeConf
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
SubrequestConf
bridgeSource <- Object
o Object -> Text -> Parser SubrequestConf
forall a. FromJSON a => Object -> Text -> Parser a
.: "source"
SubrequestConf
bridgeSink <- Object
o Object -> Text -> Parser SubrequestConf
forall a. FromJSON a => Object -> Text -> Parser a
.: "sink"
BridgeConf -> Parser BridgeConf
forall (m :: * -> *) a. Monad m => a -> m a
return BridgeConf :: SubrequestConf -> SubrequestConf -> BridgeConf
BridgeConf {..}
makeRequest :: SubrequestConf -> Request -> Request
makeRequest :: SubrequestConf -> Request -> Request
makeRequest SubrequestConf {..} req :: 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
B.null ByteString
srBody
then Request -> RequestBody
requestBody Request
req
else ByteString -> RequestBody
RequestBodyBS ByteString
srBody
, requestHeaders :: RequestHeaders
requestHeaders = (Header -> Header -> Bool)
-> RequestHeaders -> RequestHeaders -> RequestHeaders
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy (CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==) (CI ByteString -> CI ByteString -> Bool)
-> (Header -> CI ByteString) -> Header -> Header -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Header -> CI ByteString
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 v :: TimeInterval
v)
| Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
* 1e6
where t :: Int
t = TimeInterval -> Int
toSec TimeInterval
v
setTimeout _ = 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 parseRequestF :: String -> IO Request
parseRequestF buildResponseF :: Response ByteString -> ByteString
buildResponseF sub :: SubrequestConf
sub@SubrequestConf {..} = 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 (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)
httpLbs (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
$ \e :: 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
msg)
response500 :: (Int, [a], ByteString, ByteString)
response500 = Int -> (Int, [a], ByteString, ByteString)
forall t a. t -> (t, [a], ByteString, ByteString)
responseXXX 500
response502 :: (Int, [a], ByteString, ByteString)
response502 = Int -> (Int, [a], ByteString, ByteString)
forall t a. t -> (t, [a], ByteString, ByteString)
responseXXX 502
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Binary FullResponse => FullResponse -> ByteString
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 _ c :: HttpExceptionContent
c) ->
case HttpExceptionContent
c of
Network.HTTP.Client.ResponseTimeout -> FullResponse
forall a. (Int, [a], ByteString, ByteString)
response502
ConnectionTimeout -> FullResponse
forall a. (Int, [a], ByteString, ByteString)
response502
ConnectionFailure _ -> FullResponse
forall a. (Int, [a], ByteString, ByteString)
response502
StatusCodeException r :: Response ()
r _ ->
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
_ -> FullResponse
forall a. (Int, [a], ByteString, ByteString)
response500
_ -> FullResponse
forall a. (Int, [a], ByteString, ByteString)
response500
buildFullResponse :: Response L.ByteString -> L.ByteString
buildFullResponse :: Response ByteString -> ByteString
buildFullResponse r :: 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 = (Header -> (ByteString, ByteString))
-> RequestHeaders -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((CI ByteString -> ByteString) -> Header -> (ByteString, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first CI ByteString -> 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 FullResponse -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse (Int
status, [(ByteString, ByteString)]
headers, ByteString
body, "")
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
.
FromJSON SubrequestConf => ByteString -> Maybe SubrequestConf
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
.
Read SubrequestConf => ByteString -> Maybe SubrequestConf
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
readListPrec :: ReadPrec [UDSConf]
$creadListPrec :: ReadPrec [UDSConf]
readPrec :: ReadPrec UDSConf
$creadPrec :: ReadPrec UDSConf
readList :: ReadS [UDSConf]
$creadList :: ReadS [UDSConf]
readsPrec :: Int -> ReadS UDSConf
$creadsPrec :: Int -> ReadS 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 {..} -> 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 (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 (m :: * -> *) a. Monad m => a -> m a
return ""
where openUDS :: String -> p -> p -> p -> IO Connection
openUDS path :: String
path _ _ _ = 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 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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$
FullResponse -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse
(400, [], "", "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
. FromJSON SubrequestConf => ByteString -> Maybe SubrequestConf
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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$
FullResponse -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse
(400, [], "", "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
. Read SubrequestConf => ByteString -> Maybe SubrequestConf
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
.
(\(a :: Int
a, _, _, _) -> Int
a) (FullResponse -> Int)
-> (ByteString -> FullResponse) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary FullResponse => ByteString -> FullResponse
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
v :: ByteString
v =
let (h :: CI ByteString
h, b :: ByteString
b) = ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString)
-> (ByteString -> ByteString) -> (ByteString, ByteString) -> Header
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ByteString -> ByteString
C8.tail ((ByteString, ByteString) -> Header)
-> (ByteString, ByteString) -> Header
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.break ('|' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ByteString
v
(_, hs :: [(ByteString, ByteString)]
hs, _, _) = Binary FullResponse => ByteString -> FullResponse
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
L.fromStrict (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
h (RequestHeaders -> Maybe ByteString)
-> RequestHeaders -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ((ByteString, ByteString) -> Header)
-> [(ByteString, ByteString)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> CI ByteString) -> (ByteString, ByteString) -> Header
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk) [(ByteString, ByteString)]
hs
extractBodyFromFullResponse
:: ByteString
-> L.ByteString
extractBodyFromFullResponse :: ByteString -> ByteString
extractBodyFromFullResponse =
(\(_, _, a :: ByteString
a, _) -> ByteString
a) (FullResponse -> ByteString)
-> (ByteString -> FullResponse) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary FullResponse => ByteString -> FullResponse
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
.
(\(_, _, _, a :: ByteString
a) -> ByteString
a) (FullResponse -> ByteString)
-> (ByteString -> FullResponse) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary FullResponse => ByteString -> FullResponse
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
= [CI ByteString] -> HashSet (CI ByteString)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([CI ByteString] -> HashSet (CI ByteString))
-> [CI ByteString] -> HashSet (CI ByteString)
forall a b. (a -> b) -> a -> b
$
(ByteString -> CI ByteString) -> [ByteString] -> [CI ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk ["Connection"
,"Content-Length"
,"Content-Type"
,"Date"
,"Keep-Alive"
,"Last-Modified"
,"Server"
,"Transfer-Encoding"
,"X-Pad"
]
deleteHeaders :: HashSet HeaderName -> Bool -> ResponseHeaders ->
ResponseHeaders
headersToDelete :: HashSet (CI ByteString)
headersToDelete deleteXAccel :: Bool
deleteXAccel =
(Header -> Bool) -> RequestHeaders -> RequestHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (\(n :: CI ByteString
n, _) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
CI ByteString
n CI ByteString -> HashSet (CI ByteString) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet (CI ByteString)
headersToDelete Bool -> Bool -> Bool
||
Bool
deleteXAccel Bool -> Bool -> Bool
&&
ByteString -> ByteString
forall s. FoldCase s => s -> s
foldCase "X-Accel-" ByteString -> ByteString -> Bool
`B.isPrefixOf` CI ByteString -> ByteString
forall s. CI s -> s
foldedCase CI ByteString
n
)
contentFromFullResponse
:: HashSet HeaderName
-> Bool
-> (L.ByteString -> ByteString -> L.ByteString)
-> ByteString
-> ContentHandlerResult
contentFromFullResponse :: HashSet (CI ByteString)
-> Bool
-> (ByteString -> ByteString -> ByteString)
-> ByteString
-> ContentHandlerResult
contentFromFullResponse headersToDelete :: HashSet (CI ByteString)
headersToDelete deleteXAccel :: Bool
deleteXAccel f :: ByteString -> ByteString -> ByteString
f v :: ByteString
v =
let (st :: Int
st, hs :: [(ByteString, ByteString)]
hs, b :: ByteString
b, e :: ByteString
e) = Binary FullResponse => ByteString -> FullResponse
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) -> Header)
-> [(ByteString, ByteString)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> CI ByteString) -> (ByteString, ByteString) -> Header
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> CI ByteString
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 "" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "Content-Type") RequestHeaders
hs'
hs'' :: RequestHeaders
hs'' = HashSet (CI ByteString) -> Bool -> RequestHeaders -> RequestHeaders
deleteHeaders HashSet (CI ByteString)
headersToDelete Bool
deleteXAccel RequestHeaders
hs'
in (ByteString -> ByteString -> ByteString
f ByteString
b ByteString
e, ByteString
ct, Int
st, (Header -> (ByteString, ByteString))
-> RequestHeaders -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((CI ByteString -> ByteString) -> Header -> (ByteString, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first CI ByteString -> ByteString
forall s. CI s -> s
original) RequestHeaders
hs'')
fromFullResponse :: ByteString -> ContentHandlerResult
fromFullResponse :: ByteString -> ContentHandlerResult
fromFullResponse =
HashSet (CI ByteString)
-> Bool
-> (ByteString -> ByteString -> ByteString)
-> ByteString
-> ContentHandlerResult
contentFromFullResponse HashSet (CI ByteString)
notForwardableResponseHeaders Bool
True ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const
ngxExportHandler 'fromFullResponse
fromFullResponseWithException :: ByteString -> ContentHandlerResult
fromFullResponseWithException :: ByteString -> ContentHandlerResult
fromFullResponseWithException =
HashSet (CI ByteString)
-> Bool
-> (ByteString -> ByteString -> ByteString)
-> ByteString
-> ContentHandlerResult
contentFromFullResponse HashSet (CI ByteString)
notForwardableResponseHeaders Bool
True ByteString -> ByteString -> ByteString
f
where f :: ByteString -> ByteString -> ByteString
f "" = ByteString -> ByteString
L.fromStrict
f b :: 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 ()
givesPopper conf :: SubrequestConf
conf req :: Request
req =
SubrequestConf -> Request -> Request
makeRequest SubrequestConf
conf { srMethod :: ByteString
srMethod = "POST" , srBody :: ByteString
srBody = "" }
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 parseRequestF :: String -> IO Request
parseRequestF buildResponseF :: Response ByteString -> ByteString
buildResponseF BridgeConf {..} = 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 (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 (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
$ \respIn :: Response (IO ByteString)
respIn -> do
let reqOut' :: Request
reqOut' = Request
reqOut { requestHeaders :: RequestHeaders
requestHeaders =
HashSet (CI ByteString) -> Bool -> RequestHeaders -> RequestHeaders
deleteHeaders
HashSet (CI ByteString)
notForwardableResponseHeaders
Bool
True (Response (IO ByteString) -> RequestHeaders
forall body. Response body -> RequestHeaders
responseHeaders Response (IO ByteString)
respIn)
}
givesPopper :: (IO ByteString -> t) -> t
givesPopper needsPopper :: IO ByteString -> t
needsPopper = IO ByteString -> t
needsPopper (IO ByteString -> t) -> IO ByteString -> t
forall a b. (a -> b) -> a -> b
$ IO ByteString -> IO ByteString
brRead (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)
httpLbs (GivesPopper () -> SubrequestConf -> Request -> Request
makeStreamingRequest GivesPopper ()
forall t. (IO ByteString -> t) -> t
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
.
FromJSON BridgeConf => ByteString -> Maybe BridgeConf
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
.
Read BridgeConf => ByteString -> Maybe BridgeConf
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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$
FullResponse -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse
(400, [], "", "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
. FromJSON BridgeConf => ByteString -> Maybe BridgeConf
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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$
FullResponse -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse
(400, [], "", "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
. Read BridgeConf => ByteString -> Maybe BridgeConf
forall a. Read a => ByteString -> Maybe a
readFromByteString @BridgeConf
ngxExportAsyncIOYY 'makeBridgedSubrequestFullWithRead