diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,11 @@ +### 1.1.0 + +- Using *Network.HTTP.Client.BrReadWithTimeout* in module + *NgxExport.Tools.Subrequest* to ensure that a request won't stall on a bad + response from a buggy server. +- In module *NgxExport.Tools.Subrequest*, *srBody* was reimplemented using lazy + bytestrings. + ### 1.0 - Module *NgxExport.Tools.Aggregate* can now be built without support from the diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2019-2021, Alexey Radkov. All rights reserved. +Copyright 2019-2022, Alexey Radkov. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: diff --git a/NgxExport/Tools/Subrequest.hs b/NgxExport/Tools/Subrequest.hs --- a/NgxExport/Tools/Subrequest.hs +++ b/NgxExport/Tools/Subrequest.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.Subrequest --- Copyright : (c) Alexey Radkov 2020-2021 +-- Copyright : (c) Alexey Radkov 2020-2022 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -50,6 +50,7 @@ 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 @@ -60,6 +61,7 @@ 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 @@ -232,7 +234,7 @@ data SubrequestConf = SubrequestConf { srMethod :: ByteString , srUri :: String - , srBody :: ByteString + , srBody :: L.ByteString , srHeaders :: RequestHeaders , srResponseTimeout :: ResponseTimeout , srUseUDS :: Bool @@ -240,16 +242,15 @@ instance FromJSON SubrequestConf where parseJSON = withObject "SubrequestConf" $ \o -> do - srMethod <- maybeEmpty $ o .:? "method" + srMethod <- maybe "" T.encodeUtf8 <$> o .:? "method" srUri <- o .: "uri" - srBody <- maybeEmpty $ o .:? "body" + srBody <- maybe "" TL.encodeUtf8 <$> o .:? "body" srHeaders <- map (mk . T.encodeUtf8 *** T.encodeUtf8) <$> o .:? "headers" .!= [] srResponseTimeout <- maybe ResponseTimeoutDefault ResponseTimeout <$> o .:? "timeout" srUseUDS <- fromMaybe False <$> o .:? "useUDS" return SubrequestConf {..} - where maybeEmpty = fmap $ maybe "" T.encodeUtf8 data BridgeConf = BridgeConf { bridgeSource :: SubrequestConf @@ -267,9 +268,9 @@ req { method = if B.null srMethod then method req else srMethod - , requestBody = if B.null srBody + , requestBody = if L.null srBody then requestBody req - else RequestBodyBS srBody + else RequestBodyLBS srBody , requestHeaders = unionBy ((==) `on` fst) srHeaders $ requestHeaders req , responseTimeout = if srResponseTimeout == ResponseTimeoutDefault @@ -291,7 +292,7 @@ readIORef httpUDSManager else return httpManager req <- parseRequestF srUri - buildResponseF <$> httpLbs (makeRequest sub req) man + buildResponseF <$> httpLbsBrReadWithTimeout (makeRequest sub req) man subrequestBody :: SubrequestConf -> IO L.ByteString subrequestBody = subrequest parseUrlThrow responseBody @@ -342,13 +343,14 @@ -- function can also be used to initiate an original HTTP request from a -- service handler. -- --- Accepts a JSON object representing an opaque type /SubrequestConf/. --- The object may contain 5 fields: /method/ (optional, default is /GET/), --- /uri/ (mandatory), /body/ (optional, default is an empty value), /headers/ --- (optional, default is an empty array), and /timeout/ (optional, default is --- the default response timeout of the HTTP manager which is normally 30 +-- Accepts a JSON object representing an opaque type /SubrequestConf/. The +-- object may contain the following fields: /method/ (optional, default is +-- /GET/), /uri/ (mandatory), /body/ (optional, default is an empty string), +-- /headers/ (optional, default is an empty list), /timeout/ (optional, default +-- is the default response timeout of the HTTP manager which is normally 30 -- seconds, use value @{\"tag\": \"Unset\"}@ to disable response timeout --- completely). +-- completely), and /useUDS/ (an optional boolean flag to enable Unix domain +-- sockets as the transport protocol, off by default). -- -- Examples of subrequest configurations: -- @@ -360,6 +362,9 @@ -- > ,"headers": [["Header1", "Value1"], ["Header2", "Value2"]] -- > } -- +-- Note that the response timeout is in effect until receiving the response +-- headers as well as in between the successive body read events. +-- -- Returns the response body if HTTP status of the response is /2xx/, otherwise -- throws an error. To avoid leakage of error messages into variable handlers, -- put the corresponding variables into the list of directive @@ -1036,9 +1041,12 @@ notForwardableResponseHeaders True (responseHeaders respIn) } - givesPopper needsPopper = needsPopper $ brRead $ responseBody respIn + tmo = fromResponseTimeout reqIn manIn + givesPopper needsPopper = needsPopper $ + brReadWithTimeout tmo reqIn $ responseBody respIn buildResponseF <$> - httpLbs (makeStreamingRequest givesPopper bridgeSink reqOut') manOut + httpLbsBrReadWithTimeout + (makeStreamingRequest givesPopper bridgeSink reqOut') manOut bridgedSubrequestBody :: BridgeConf -> IO L.ByteString bridgedSubrequestBody = bridgedSubrequest parseUrlThrow responseBody @@ -1051,7 +1059,10 @@ -- -- This is the core function of the /makeBridgedSubrequest/ handler. From -- perspective of an Nginx request, it spawns two subrequests connecting the two --- ends of a /bridge/: the /source/ and the /sink/, hence the name. +-- ends of a /bridge/: the /source/ and the /sink/, hence the name. The +-- connection between the bridge ends is implemented via 'GivesPopper' and +-- 'RequestBodyStreamChunked' which means that the server bound at the sink end +-- must be capable of processing chunked requests. -- -- Accepts a JSON object representing an opaque type /BridgeConf/ with mandatory -- fields /source/ and /sink/. @@ -1069,7 +1080,9 @@ -- > } -- -- The sink method is always /POST/ while its body is always empty independently --- of whether or not and how exactly they were specified. +-- of whether or not and how exactly they were specified. The sink response +-- timeout should be big enough to fulfill streaming of the response from the +-- source to the sink. -- -- Returns the response body of the sink if HTTP status of the response is -- /2xx/, otherwise throws an error. To avoid leakage of error messages into @@ -1106,13 +1119,14 @@ -- > , srUri = "http://127.0.0.1/sink" -- > , srBody = "" -- > , srHeaders = [] --- > , srResponseTimeout = ResponseTimeout (Sec 10) +-- > , srResponseTimeout = ResponseTimeout (Sec 30) -- > , srUseUDS = False -- > } -- > } -- -- The sink method is always /POST/ while its body is always empty independently --- of how exactly they were specified. +-- of how exactly they were specified. The sink response timeout should be big +-- enough to fulfill streaming of the response from the source to the sink. -- -- Notice that unlike JSON parsing, fields of /SubrequestConf/ comprising -- /bridgeSource/ and /bridgeSink/ are not omittable and must be listed in the diff --git a/ngx-export-tools-extra.cabal b/ngx-export-tools-extra.cabal --- a/ngx-export-tools-extra.cabal +++ b/ngx-export-tools-extra.cabal @@ -1,5 +1,5 @@ name: ngx-export-tools-extra -version: 1.0 +version: 1.1.0 synopsis: More extra tools for Nginx haskell module description: More extra tools for . @@ -43,6 +43,7 @@ , ngx-export-tools >= 0.4.8.0 , http-types >= 0.7.0 , http-client >= 0.5.3 + , http-client-brread-timeout , network >= 2.4.0.0 , aeson >= 1.0.0.0 , time