diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,9 @@ +### 0.6.1.0 + +- Handler *extractRequestStatusFromFullResponse* was replaced with handler + *extractExceptionFromFullResponse*. The new handler contains the error message + if the subrequest was terminated by an exception. + ### 0.6.0.0 - Build EDE module with *prettyprinter* automatically. diff --git a/NgxExport/Tools/Subrequest.hs b/NgxExport/Tools/Subrequest.hs --- a/NgxExport/Tools/Subrequest.hs +++ b/NgxExport/Tools/Subrequest.hs @@ -29,10 +29,10 @@ -- $gettingFullResponse ,makeSubrequestFull ,makeSubrequestFullWithRead - ,extractRequestStatusFromFullResponse ,extractStatusFromFullResponse ,extractHeaderFromFullResponse ,extractBodyFromFullResponse + ,extractExceptionFromFullResponse -- * Forwarding full response data to the client -- $forwardingFullResponse ,notForwardableResponseHeaders @@ -60,7 +60,6 @@ import Data.CaseInsensitive hiding (map) import Data.Aeson import Data.Maybe -import Data.Word import Control.Arrow import Control.Exception import System.IO.Unsafe @@ -272,26 +271,28 @@ subrequestBody :: SubrequestConf -> IO L.ByteString subrequestBody = subrequest parseUrlThrow responseBody -type FullResponse = (Word8, Int, [(ByteString, ByteString)], L.ByteString) +type FullResponse = (Int, [(ByteString, ByteString)], L.ByteString, ByteString) subrequestFull :: SubrequestConf -> IO L.ByteString subrequestFull = handleAll . subrequest parseRequest buildResponse - where handleAll = handle $ \e -> return $ Binary.encode @FullResponse $ - case fromException e of - Just (HttpExceptionRequest _ c) -> - case c of - Network.HTTP.Client.ResponseTimeout -> response502 - ConnectionTimeout -> response502 - ConnectionFailure _ -> response502 - _ -> response500 - _ -> response500 - response500 = (2, 500, [], "") - response502 = (1, 502, [], "") + where handleAll = handle $ \e -> do + let msg = C8.pack $ show e + response500 = (500, [], "", msg) + response502 = (502, [], "", msg) + return $ Binary.encode @FullResponse $ + case fromException e of + Just (HttpExceptionRequest _ c) -> + case c of + Network.HTTP.Client.ResponseTimeout -> response502 + ConnectionTimeout -> response502 + ConnectionFailure _ -> response502 + _ -> response500 + _ -> response500 buildResponse r = let status = statusCode $ responseStatus r headers = map (first original) $ responseHeaders r body = responseBody r - in Binary.encode @FullResponse (0, status, headers, body) + in Binary.encode @FullResponse (status, headers, body, "") httpManager :: Manager httpManager = unsafePerformIO $ newManager defaultManagerSettings @@ -456,11 +457,10 @@ -- status, headers and the body must be extracted using handlers -- __/extractStatusFromFullResponse/__, __/extractHeaderFromFullResponse/__, -- and __/extractBodyFromFullResponse/__ which are based on functions of the --- 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. +-- same name. Handler __/extractExceptionFromFullResponse/__ and the +-- corresponding function can be used to extract the error message if an +-- exception has happened while making the subrequest: the value is empty if +-- there was no exception. -- -- Let's extend our example with these handlers. -- @@ -583,17 +583,18 @@ -- -- The same as 'makeSubrequest' except it returns a binary encoded response data -- whose parts must be extracted by handlers made of --- '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/. +-- 'extractStatusFromFullResponse', 'extractHeaderFromFullResponse', +-- 'extractBodyFromFullResponse', and 'extractExceptionFromFullResponse'. It +-- does not throw any exceptions outside. Exported on the Nginx level by handler +-- /makeSubrequestFull/. makeSubrequestFull :: ByteString -- ^ Subrequest configuration -> IO L.ByteString makeSubrequestFull = - maybe (return $ Binary.encode @FullResponse (2, 400, [], "")) - subrequestFull . - readFromByteStringAsJSON @SubrequestConf + maybe (return $ + Binary.encode @FullResponse + (400, [], "", "Unreadable subrequest data") + ) subrequestFull . readFromByteStringAsJSON @SubrequestConf ngxExportAsyncIOYY 'makeSubrequestFull @@ -601,39 +602,21 @@ -- -- The same as 'makeSubrequestWithRead' except it returns a binary encoded -- response data whose parts must be extracted by handlers made of --- '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/. +-- 'extractStatusFromFullResponse', 'extractHeaderFromFullResponse', +-- 'extractBodyFromFullResponse', and 'extractExceptionFromFullResponse'. It +-- does not throw any exceptions outside. Exported on the Nginx level by handler +-- /makeSubrequestFullWithRead/. makeSubrequestFullWithRead :: ByteString -- ^ Subrequest configuration -> IO L.ByteString makeSubrequestFullWithRead = - maybe (return $ Binary.encode @FullResponse (2, 400, [], "")) - subrequestFull . - readFromByteString @SubrequestConf + maybe (return $ + Binary.encode @FullResponse + (400, [], "", "Unreadable subrequest data") + ) 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 @@ -643,7 +626,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 @@ -662,7 +645,7 @@ -> L.ByteString extractHeaderFromFullResponse v = let (h, b) = mk *** C8.tail $ C8.break ('|' ==) v - (_, _, hs, _) = Binary.decode @FullResponse $ L.fromStrict b + (_, hs, _, _) = Binary.decode @FullResponse $ L.fromStrict b in maybe "" L.fromStrict $ lookup h $ map (first mk) hs ngxExportYY 'extractHeaderFromFullResponse @@ -676,20 +659,37 @@ :: ByteString -- ^ Encoded HTTP response -> L.ByteString extractBodyFromFullResponse = - (\(_, _, _, a) -> a) . (Binary.decode @FullResponse) . L.fromStrict + (\(_, _, a, _) -> a) . Binary.decode @FullResponse . L.fromStrict ngxExportYY 'extractBodyFromFullResponse +-- | Extracts the exception from an encoded response. +-- +-- Must be used to extract response data encoded by 'makeSubrequestFull' or +-- 'makeSubrequestFullWithRead'. Exported on the Nginx level by handler +-- /extractExceptionFromFullResponse/. +-- +-- The empty value implies that there was no exception while making the +-- subrequest. Non-/2xx/ responses are not regarded as exceptions as well. +extractExceptionFromFullResponse + :: ByteString -- ^ Encoded HTTP response + -> L.ByteString +extractExceptionFromFullResponse = L.fromStrict . + (\(_, _, _, a) -> a) . Binary.decode @FullResponse . L.fromStrict + +ngxExportYY 'extractExceptionFromFullResponse + -- $forwardingFullResponse -- -- Data encoded in the full response can be translated to 'ContentHandlerResult' -- and forwarded downstream to the client in directive /haskell_content/. --- Handler __/fromFullResponse/__ performs such a translation. Not all response --- headers are allowed being forwarded downstream, and thus the handler deletes --- response headers with names listed in set 'notForwardableResponseHeaders' as --- well as all headers with names starting with /X-Accel-/ before sending the --- response to the client. The set of not forwardable response headers can be --- customized in function 'contentFromFullResponse'. +-- Handlers __/fromFullResponse/__ and __/fromFullResponseWithException/__ +-- perform such a translation. Not all response headers are allowed being +-- forwarded downstream, and thus the handler deletes response headers with +-- names listed in set 'notForwardableResponseHeaders' as well as all headers +-- with names starting with /X-Accel-/ before sending the response to the +-- client. The set of not forwardable response headers can be customized in +-- function 'contentFromFullResponse'. -- -- Let's forward responses in location /\/full/ when argument /proxy/ in the -- client request's URI is equal to /yes/. @@ -740,17 +740,22 @@ -- | Translates encoded response to 'ContentHandlerResult'. -- -- The translated data can be forwarded to the client by a simple handler based --- on this function in directive /haskell_content/. Handler /fromFullResponse/ --- forwards the response to the client after deleting headers listed in set --- 'notForwardableResponseHeaders' and headers with names starting with --- /X-Accel-/. +-- on this function in directive /haskell_content/. Handlers /fromFullResponse/ +-- and /fromFullResponseWithException/ forward the response to the client after +-- deleting headers listed in set 'notForwardableResponseHeaders' and headers +-- with names starting with /X-Accel-/. The two handlers differ in the response +-- composing function: the former always returns the response body of the +-- subrequest while the latter returns the error message in the response body if +-- an exception has happened during the subrequest. contentFromFullResponse :: HashSet HeaderName -- ^ Set of not forwardable response headers -> Bool -- ^ Do not forward /X-Accel-.../ response headers + -> (L.ByteString -> ByteString -> L.ByteString) + -- ^ Function to compose response body and exception -> ByteString -- ^ Encoded HTTP response -> ContentHandlerResult -contentFromFullResponse headersToDelete deleteXAccel v = - let (_, st, hs, b) = Binary.decode @FullResponse $ L.fromStrict v +contentFromFullResponse headersToDelete deleteXAccel f v = + let (st, hs, b, e) = Binary.decode @FullResponse $ L.fromStrict v hs' = map (first mk) hs ct = fromMaybe "" $ lookup (mk "Content-Type") hs' hs'' = filter @@ -759,10 +764,19 @@ deleteXAccel && foldCase "X-Accel-" `B.isPrefixOf` foldedCase n ) hs' - in (b, ct, st, map (first original) hs'') + in (f b e, ct, st, map (first original) hs'') fromFullResponse :: ByteString -> ContentHandlerResult -fromFullResponse = contentFromFullResponse notForwardableResponseHeaders True +fromFullResponse = + contentFromFullResponse notForwardableResponseHeaders True const ngxExportHandler 'fromFullResponse + +fromFullResponseWithException :: ByteString -> ContentHandlerResult +fromFullResponseWithException = + contentFromFullResponse notForwardableResponseHeaders True f + where f "" = L.fromStrict + f b = const b + +ngxExportHandler 'fromFullResponseWithException 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: 0.6.0.1 +version: 0.6.1.0 synopsis: More extra tools for Nginx haskell module description: More extra tools for .