diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,8 @@ +### 0.3.0.0 + +- Added module *NgxExport.Tools.Subrequest* for making HTTP (sub)requests + easily. + ### 0.2.2.0 - Added Cabal flag *EDE* to detect automatically if EDE module can be built. diff --git a/NgxExport/Tools/Aggregate.hs b/NgxExport/Tools/Aggregate.hs --- a/NgxExport/Tools/Aggregate.hs +++ b/NgxExport/Tools/Aggregate.hs @@ -76,7 +76,7 @@ -- {-\# LANGUAGE TemplateHaskell, DeriveGeneric, TypeApplications \#-} -- {-\# LANGUAGE OverloadedStrings, BangPatterns \#-} -- --- module TestToolsExtra where +-- module TestToolsExtraAggregate where -- -- import NgxExport -- import NgxExport.Tools @@ -421,6 +421,7 @@ ,ngxExportSimpleServiceTyped fName ''AggregateServerConf SingleShotService ] + -- | Reports data to an aggregate service. -- -- If reported data is 'Nothing' then data collected on the aggregate service diff --git a/NgxExport/Tools/EDE.hs b/NgxExport/Tools/EDE.hs --- a/NgxExport/Tools/EDE.hs +++ b/NgxExport/Tools/EDE.hs @@ -85,15 +85,14 @@ -- 'ngxExportIOYY' \'renderEDETemplateFromFreeValue -- -- urlDecode :: ByteString -> L.ByteString --- __/urlDecode/__ = L.fromStrict . URI.urlDecode False +-- urlDecode = L.fromStrict . URI.urlDecode False -- -- 'ngxExportYY' \'urlDecode -- @ -- --- Besides the two exporters imported from the EDE module, two additional --- exporters were defined here: /renderEDETemplateFromFreeValue/ and --- /urlDecode/. We are going to use them for parsing JSON values from HTTP --- cookies. +-- Besides the two handlers imported from the EDE module, two additional +-- handlers were defined here: /renderEDETemplateFromFreeValue/ and /urlDecode/. +-- We are going to use them for parsing JSON values from HTTP cookies. -- -- ==== File /nginx.conf/ -- @ @@ -144,9 +143,9 @@ -- } -- -- location \/cookie { --- haskell_run __/urlDecode/__ $hs_cookie_user $cookie_user; +-- haskell_run urlDecode $hs_cookie_user $cookie_user; -- haskell_run __/renderEDETemplateFromFreeValue/__ $hs_user_from_cookie --- user|$hs_cookie_user; +-- __/user/__|$hs_cookie_user; -- rewrite ^ \/internal\/user\/$hs_user_from_cookie last; -- } -- } @@ -240,9 +239,9 @@ -- | Renders an EDE template from a JSON object. -- --- This is the core function of the /renderEDETemplate/ exporter. Accepts a --- JSON object written in a 'L.ByteString' and a key to find a compiled EDE --- template declared by the /compileEDETemplates/ exporter. +-- This is the core function of the /renderEDETemplate/ handler. Accepts a JSON +-- object written in a 'L.ByteString' and a key to find a compiled EDE template +-- declared by the /compileEDETemplates/ handler. renderEDETemplate :: L.ByteString -- ^ JSON object -> ByteString -- ^ Key to find the EDE template -> IO L.ByteString diff --git a/NgxExport/Tools/Subrequest.hs b/NgxExport/Tools/Subrequest.hs new file mode 100644 --- /dev/null +++ b/NgxExport/Tools/Subrequest.hs @@ -0,0 +1,253 @@ +{-# LANGUAGE TemplateHaskell, OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} + +----------------------------------------------------------------------------- +-- | +-- Module : NgxExport.Tools.Subrequest +-- Copyright : (c) Alexey Radkov 2020 +-- License : BSD-style +-- +-- Maintainer : alexey.radkov@gmail.com +-- Stability : experimental +-- Portability : non-portable (requires Template Haskell) +-- +-- Easy HTTP subrequests from the more extra tools collection for +-- . +-- +----------------------------------------------------------------------------- + + +module NgxExport.Tools.Subrequest ( + -- * Making HTTP subrequests + -- $makingHTTPSubrequests + subrequest + ) where + +import NgxExport +import NgxExport.Tools + +import Network.HTTP.Client +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as L +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Text (Text) +import Data.CaseInsensitive (mk) +import Data.Aeson +import Control.Arrow +import Control.Exception +import System.IO.Unsafe + +-- $makingHTTPSubrequests +-- +-- Using asynchronous variable handlers and services together with the HTTP +-- client from "Network.HTTP.Client" allows making HTTP subrequests easily. +-- This module provides such functionality by exporting asynchronous variable +-- handler __/subrequest/__ and function 'subrequest' to build custom handlers. +-- +-- Below is a simple example. +-- +-- ==== File /test_tools_extra_subrequest.hs/ +-- @ +-- {-\# LANGUAGE TemplateHaskell \#-} +-- +-- module TestToolsExtraSubrequest where +-- +-- import NgxExport +-- import NgxExport.Tools +-- import NgxExport.Tools.Subrequest +-- +-- import Data.ByteString (ByteString) +-- import qualified Data.ByteString.Lazy as L +-- +-- subrequestFromService :: ByteString -> Bool -> IO L.ByteString +-- __/subrequestFromService/__ = const . 'subrequest' +-- +-- 'ngxExportSimpleService' \'subrequestFromService $ +-- 'PersistentService' $ Just $ 'Sec' 10 +-- @ +-- +-- Handler /subrequestFromService/ will be used in a /periodical/ service which +-- will retrieve data from a specified URI every 10 seconds. +-- +-- ==== File /nginx.conf/ +-- @ +-- user nobody; +-- worker_processes 2; +-- +-- events { +-- worker_connections 1024; +-- } +-- +-- http { +-- default_type application\/octet-stream; +-- sendfile on; +-- +-- haskell load \/var\/lib\/nginx\/test_tools_extra_subrequest.so; +-- +-- upstream backend { +-- server 127.0.0.1:8020; +-- } +-- +-- haskell_run_service __/simpleService_subrequestFromService/__ $hs_service_httpbin +-- \'{\"uri\": \"http:\/\/httpbin.org\"}\'; +-- +-- haskell_var_empty_on_error $hs_subrequest; +-- +-- server { +-- listen 8010; +-- server_name main; +-- error_log \/tmp\/nginx-test-haskell-error.log; +-- access_log \/tmp\/nginx-test-haskell-access.log; +-- +-- location \/ { +-- haskell_run_async __/subrequest/__ $hs_subrequest +-- \'{\"uri\": \"http:\/\/127.0.0.1:8020\/proxy\", +-- \"headers\": [[\"Custom-Header\", \"$arg_a\"]]}\'; +-- +-- if ($hs_subrequest = \'\') { +-- echo_status 500; +-- echo \"Failed to perform subrequest\"; +-- } +-- +-- echo -n $hs_subrequest; +-- } +-- +-- location \/proxy { +-- internal; +-- proxy_pass http:\/\/backend; +-- } +-- +-- location \/httpbin { +-- echo $hs_service_httpbin; +-- } +-- } +-- +-- server { +-- listen 8020; +-- server_name backend; +-- +-- location\ / { +-- set $custom_header $http_custom_header; +-- echo \"In backend, Custom-Header is \'$custom_header\'\"; +-- } +-- } +-- } +-- @ +-- +-- Configurations of subrequests are defined via JSON objects which contain URI +-- and other relevant data such as HTTP method, request body and headers. In +-- this configuration we are running a periodical service which gets contents of +-- /httpbin.org/ every 10 seconds, and doing a subrequest to a virtual server +-- /backend/ on every request to /location \//. In this subrequest, an HTTP +-- header /Custom-Header/ is sent to the backend with value equal to the value +-- of argument /a/ from the client request's URI. +-- +-- It is worth noting that making HTTP subrequests to the own Nginx service +-- (e.g. via /127.0.0.1/) allows for leveraging well-known advantages of Nginx +-- such as load-balancing via upstreams as it is happening in this example. +-- +-- ==== A simple test +-- +-- > $ curl -s 'http://localhost:8010/httpbin' | head +-- > +-- > +-- > +-- > +-- > +-- > httpbin.org +-- > rel="stylesheet"> +-- > +-- > +-- +-- > $ curl 'http://localhost:8010/?a=Value' +-- > In backend, Custom-Header is 'Value' +-- +-- Let's do a nasty thing. By injecting a comma into the argument /a/ we shall +-- break parsing JSON. +-- +-- > $ curl -D- 'http://localhost:8010/?a=Value"' +-- > HTTP/1.1 500 Internal Server Error +-- > Server: nginx/1.17.9 +-- > Date: Mon, 30 Mar 2020 14:42:42 GMT +-- > Content-Type: application/octet-stream +-- > Transfer-Encoding: chunked +-- > Connection: keep-alive +-- > +-- > Failed to perform subrequest + +type ReqHeaders = [(Text, Text)] + +data SubrequestParseError = SubrequestParseError deriving Show +instance Exception SubrequestParseError + +data SubrequestConf = + SubrequestConf { srMethod :: Text + , srUri :: String + , srBody :: Text + , srHeaders :: ReqHeaders + } +instance FromJSON SubrequestConf where + parseJSON = withObject "SubrequestConf" $ \o -> do + srMethod <- o .:? "method" .!= "GET" + srUri <- o .: "uri" + srBody <- o .:? "body" .!= "" + srHeaders <- o .:? "headers" .!= [] + return SubrequestConf {..} + +doSubrequest :: SubrequestConf -> IO L.ByteString +doSubrequest SubrequestConf {..} = do + req <- parseUrlThrow srUri + let req' = if T.null srMethod + then req + else req { method = T.encodeUtf8 srMethod } + req'' = if T.null srBody + then req' + else req' { requestBody = + RequestBodyBS $ T.encodeUtf8 srBody } + req''' = if null srHeaders + then req'' + -- TODO: implement caching of frequent header values + else req'' { requestHeaders = + map (mk . T.encodeUtf8 *** T.encodeUtf8) + srHeaders } + responseBody <$> httpLbs req''' httpManager + +httpManager :: Manager +httpManager = unsafePerformIO $ newManager defaultManagerSettings +{-# NOINLINE httpManager #-} + +-- | Makes an HTTP request. +-- +-- This is the core function of the /subrequest/ handler. From perspective of +-- an Nginx request, it spawns a subrequest, hence the name. However, this +-- 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 4 fields: /method/ (optional, default is /GET/), +-- /uri/ (mandatory), /body/ (optional, default is an empty value), and +-- /headers/ (optional, default is an empty array). +-- +-- Examples of subrequest configurations: +-- +-- > {"uri": "http://example.com/"} +-- +-- > {"uri": "http://127.0.0.1/subreq", "method": "POST", "body": "some value"} +-- +-- > {"uri": "http://127.0.0.1/subreq", +-- > "headers": [["Header1", "Value1"], ["Header2", "Value2"]]} +-- +-- 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 the directive +-- /haskell_var_empty_on_error/. +subrequest + :: ByteString -- ^ Subrequest configuration + -> IO L.ByteString +subrequest = maybe (throwIO SubrequestParseError) doSubrequest . + readFromByteStringAsJSON @SubrequestConf + +ngxExportAsyncIOYY 'subrequest + 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.2.2.1 +version: 0.3.0.0 synopsis: More extra tools for Nginx haskell module description: More extra tools for . @@ -16,8 +16,8 @@ cabal-version: >= 1.8 source-repository head - Type: git - Location: https://github.com/lyokha/ngx-export-tools-extra + type: git + location: https://github.com/lyokha/ngx-export-tools-extra flag EDE description: Build EDE module. @@ -38,6 +38,7 @@ , aeson >= 1.0.0.0 , http-types >= 0.7.0 , http-client + , case-insensitive , containers , unordered-containers , enclosed-exceptions @@ -58,6 +59,7 @@ , trifecta <= 2 exposed-modules: NgxExport.Tools.Aggregate + , NgxExport.Tools.Subrequest if flag(EDE) exposed-modules: NgxExport.Tools.EDE