ngx-export-tools-extra 0.5.3.0 → 0.5.4.0
raw patch · 3 files changed
+66/−33 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ NgxExport.Tools.Subrequest: extractRequestStatusFromFullResponse :: ByteString -> ByteString
Files
- Changelog.md +5/−0
- NgxExport/Tools/Subrequest.hs +60/−32
- ngx-export-tools-extra.cabal +1/−1
Changelog.md view
@@ -1,3 +1,8 @@+### 0.5.4.0++- Added handler *extractRequestStatusFromFullResponse* to retrieve completion+ status of a subrequest.+ ### 0.5.3.0 - Handlers *makeSubrequestFull* and *makeSubrequestFullWithRead* no longer throw
NgxExport/Tools/Subrequest.hs view
@@ -26,6 +26,7 @@ -- $gettingFullResponse ,makeSubrequestFull ,makeSubrequestFullWithRead+ ,extractRequestStatusFromFullResponse ,extractStatusFromFullResponse ,extractHeaderFromFullResponse ,extractBodyFromFullResponse@@ -53,6 +54,7 @@ import Data.CaseInsensitive (FoldCase (foldCase), mk, original) import Data.Aeson import Data.Maybe+import Data.Word import Control.Arrow import Control.Exception import System.IO.Unsafe@@ -225,10 +227,11 @@ return SubrequestConf {..} where maybeEmpty = fmap $ maybe "" T.encodeUtf8 -subrequest :: (Response L.ByteString -> L.ByteString) ->- (String -> IO Request) -> SubrequestConf -> IO L.ByteString-subrequest fromResponse parseUrlF SubrequestConf {..} = do- req <- parseUrlF srUri+subrequest :: (String -> IO Request) ->+ (Response L.ByteString -> L.ByteString) -> SubrequestConf ->+ IO L.ByteString+subrequest parseRequestF buildResponseF SubrequestConf {..} = do+ req <- parseRequestF srUri let req' = if B.null srMethod then req else req { method = srMethod }@@ -242,7 +245,7 @@ then req''' else req''' { responseTimeout = setTimeout srResponseTimeout }- fromResponse <$> httpLbs req'''' httpManager+ buildResponseF <$> httpLbs req'''' httpManager where setTimeout (ResponseTimeout v) | t == 0 = responseTimeoutNone | otherwise = responseTimeoutMicro $ t * 1e6@@ -250,30 +253,30 @@ setTimeout _ = undefined subrequestBody :: SubrequestConf -> IO L.ByteString-subrequestBody = subrequest responseBody parseUrlThrow+subrequestBody = subrequest parseUrlThrow responseBody -type FullResponse = (Int, [(ByteString, L.ByteString)], L.ByteString)+type FullResponse = (Word8, Int, [(ByteString, ByteString)], L.ByteString) subrequestFull :: SubrequestConf -> IO L.ByteString-subrequestFull = handleAll . subrequest buildResponse parseRequest+subrequestFull = handleAll . subrequest parseRequest buildResponse where handleAll = handle $ \e -> return $ Binary.encode @FullResponse $ case fromException e of Just (HttpExceptionRequest _ c) -> case c of StatusCodeException r _ ->- (statusCode $ responseStatus r, [], "")+ (0, statusCode $ responseStatus r, [], "") Network.HTTP.Client.ResponseTimeout -> response502 ConnectionTimeout -> response502 ConnectionFailure _ -> response502 _ -> response500 _ -> response500- response500 = (500, [], "")- response502 = (502, [], "")+ response500 = (2, 500, [], "")+ response502 = (1, 502, [], "") buildResponse r = let status = statusCode $ responseStatus r headers = map (first original) $ responseHeaders r body = responseBody r- in Binary.encode (status, headers, body)+ in Binary.encode @FullResponse (0, status, headers, body) httpManager :: Manager httpManager = unsafePerformIO $ newManager defaultManagerSettings@@ -356,7 +359,11 @@ -- status, headers and the body must be extracted using handlers -- __/extractStatusFromFullResponse/__, __/extractHeaderFromFullResponse/__, -- and __/extractBodyFromFullResponse/__ which are based on functions of the--- same name.+-- same name. Handler __/extractRequestStatusFromFullResponse/__ and the+-- corresponding function can be used to extract the request status: /0/ means+-- that the request was completed without technical errors, /1/ means that the+-- request failed due to connection errors including timeouts, and /2/ means+-- that the request failed due to other errors. -- -- Let's extend our example with these handlers. --@@ -478,16 +485,17 @@ -- -- The same as 'makeSubrequest' except it returns a binary encoded response data -- whose parts must be extracted by handlers made of--- 'extractStatusFromFullResponse', 'extractHeaderFromFullResponse', and--- 'extractBodyFromFullResponse'. It also does not throw errors when HTTP status--- of the response is not /2xx/. Exported on the Nginx level by handler--- /makeSubrequestFull/.+-- 'extractRequestStatusFromFullResponse', 'extractStatusFromFullResponse',+-- 'extractHeaderFromFullResponse', and 'extractBodyFromFullResponse'. It also+-- does not throw errors when HTTP status of the response is not /2xx/.+-- Exported on the Nginx level by handler /makeSubrequestFull/. makeSubrequestFull :: ByteString -- ^ Subrequest configuration -> IO L.ByteString makeSubrequestFull =- maybe (return $ Binary.encode @FullResponse (400, [], "")) subrequestFull .- readFromByteStringAsJSON @SubrequestConf+ maybe (return $ Binary.encode @FullResponse (2, 400, [], ""))+ subrequestFull .+ readFromByteStringAsJSON @SubrequestConf ngxExportAsyncIOYY 'makeSubrequestFull @@ -495,19 +503,39 @@ -- -- The same as 'makeSubrequestWithRead' except it returns a binary encoded -- response data whose parts must be extracted by handlers made of--- 'extractStatusFromFullResponse', 'extractHeaderFromFullResponse', and--- 'extractBodyFromFullResponse'. It also does not throw errors when HTTP status--- of the response is not /2xx/. Exported on the Nginx level by handler--- /makeSubrequestFullWithRead/.+-- 'extractRequestStatusFromFullResponse', 'extractStatusFromFullResponse',+-- 'extractHeaderFromFullResponse', and 'extractBodyFromFullResponse'. It also+-- does not throw errors when HTTP status of the response is not /2xx/.+-- Exported on the Nginx level by handler /makeSubrequestFullWithRead/. makeSubrequestFullWithRead :: ByteString -- ^ Subrequest configuration -> IO L.ByteString makeSubrequestFullWithRead =- maybe (return $ Binary.encode @FullResponse (400, [], "")) subrequestFull .- readFromByteString @SubrequestConf+ maybe (return $ Binary.encode @FullResponse (2, 400, [], ""))+ subrequestFull .+ readFromByteString @SubrequestConf ngxExportAsyncIOYY 'makeSubrequestFullWithRead +-- | Extracts the request status from an encoded response.+--+-- Must be used to extract response data encoded by 'makeSubrequestFull' or+-- 'makeSubrequestFullWithRead'. Exported on the Nginx level by handler+-- /extractRequestStatusFromFullResponse/.+--+-- The request status may be one of the following values:+--+-- - /0/ — the request was completed without technical errors,+-- - /1/ — the request failed due to connection errors including timeouts,+-- - /2/ — the request failed due to other errors.+extractRequestStatusFromFullResponse+ :: ByteString -- ^ Encoded HTTP response+ -> L.ByteString+extractRequestStatusFromFullResponse = C8L.pack . show .+ (\(a, _, _, _) -> a) . (Binary.decode @FullResponse) . L.fromStrict++ngxExportYY 'extractRequestStatusFromFullResponse+ -- | Extracts the HTTP status from an encoded response. -- -- Must be used to extract response data encoded by 'makeSubrequestFull' or@@ -517,7 +545,7 @@ :: ByteString -- ^ Encoded HTTP response -> L.ByteString extractStatusFromFullResponse = C8L.pack . show .- (\(a, _, _) -> a) . (Binary.decode @FullResponse) . L.fromStrict+ (\(_, a, _, _) -> a) . (Binary.decode @FullResponse) . L.fromStrict ngxExportYY 'extractStatusFromFullResponse @@ -536,9 +564,9 @@ -> L.ByteString extractHeaderFromFullResponse v = let (h, b) = mk *** C8.tail $ C8.break ('|' ==) v- hs = (\(_, a, _) -> map (first mk) a) $+ hs = (\(_, _, a, _) -> map (first mk) a) $ Binary.decode @FullResponse $ L.fromStrict b- in fromMaybe L.empty $ lookup h hs+ in maybe "" L.fromStrict $ lookup h hs ngxExportYY 'extractHeaderFromFullResponse @@ -551,7 +579,7 @@ :: ByteString -- ^ Encoded HTTP response -> L.ByteString extractBodyFromFullResponse =- (\(_, _, a) -> a) . (Binary.decode @FullResponse) . L.fromStrict+ (\(_, _, _, a) -> a) . (Binary.decode @FullResponse) . L.fromStrict ngxExportYY 'extractBodyFromFullResponse @@ -625,15 +653,15 @@ -> ByteString -- ^ Encoded HTTP response -> ContentHandlerResult contentFromFullResponse headersToDelete deleteXAccel v =- let (st, hs, b) = Binary.decode @FullResponse $ L.fromStrict v+ let (_, st, hs, b) = Binary.decode @FullResponse $ L.fromStrict v hs' = map (first mk) hs- ct = L.toStrict $ fromMaybe "" $ lookup (mk "Content-Type") hs'+ ct = fromMaybe "" $ lookup (mk "Content-Type") hs' hs'' = filter (\(n, _) -> not $ mk n `HS.member` headersToDelete || deleteXAccel && foldCase "X-Accel-" `B.isPrefixOf` foldCase n ) hs- in (b, ct, st, map (second L.toStrict) hs'')+ in (b, ct, st, hs'') fromFullResponse :: ByteString -> ContentHandlerResult fromFullResponse = contentFromFullResponse notForwardableResponseHeaders True
ngx-export-tools-extra.cabal view
@@ -1,5 +1,5 @@ name: ngx-export-tools-extra-version: 0.5.3.0+version: 0.5.4.0 synopsis: More extra tools for Nginx haskell module description: More extra tools for <https://github.com/lyokha/nginx-haskell-module Nginx haskell module>.