diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,10 @@ +### 1.2.8 + +- Module *NgxExport.Tools.Subrequest*. + + Allow setting custom HTTP managers in subrequest configurations. + + In subrequest configurations, field *useUDS* / *srUseUDS* is no longer + accepted, use *"manager": "uds"* / *srManager = UDS* instead. + ### 1.2.7 - Support package *base64* *1.0*. diff --git a/NgxExport/Tools/Resolve.hs b/NgxExport/Tools/Resolve.hs --- a/NgxExport/Tools/Resolve.hs +++ b/NgxExport/Tools/Resolve.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.Resolve --- Copyright : (c) Alexey Radkov 2022-2023 +-- Copyright : (c) Alexey Radkov 2022-2024 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -244,7 +244,7 @@ -- } -- @ -- --- ==== File /nginx.conf/: location /upstrand/ +-- ==== File /nginx.conf/: location /\/upstrand/ -- @ -- location \/upstrand { -- proxy_pass http:\/\/__/$upstrand\_utest/__; diff --git a/NgxExport/Tools/Subrequest.hs b/NgxExport/Tools/Subrequest.hs --- a/NgxExport/Tools/Subrequest.hs +++ b/NgxExport/Tools/Subrequest.hs @@ -1,10 +1,10 @@ {-# LANGUAGE TemplateHaskell, OverloadedStrings, RecordWildCards #-} -{-# LANGUAGE TypeApplications, TupleSections, NumDecimals #-} +{-# LANGUAGE TypeApplications, TupleSections, LambdaCase, NumDecimals #-} ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.Subrequest --- Copyright : (c) Alexey Radkov 2020-2023 +-- Copyright : (c) Alexey Radkov 2020-2024 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -25,6 +25,9 @@ -- * Internal HTTP subrequests via Unix domain sockets -- $internalHTTPSubrequests + -- * HTTP subrequests with a custom HTTP manager + -- $subrequestsWithCustomManager + ,registerCustomManager -- * Getting full response data from HTTP subrequests -- $gettingFullResponse ,makeSubrequestFull @@ -67,6 +70,8 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy.Encoding as TL import qualified Data.Binary as Binary +import qualified Data.HashMap.Strict as HM +import Data.HashMap.Strict (HashMap) import Data.HashSet (HashSet) import qualified Data.HashSet as HS import Data.CaseInsensitive hiding (map) @@ -101,7 +106,7 @@ -- import Data.ByteString (ByteString) -- import qualified Data.ByteString.Lazy as L -- --- makeRequest :: ByteString -> Bool -> IO L.ByteString +-- makeRequest :: ByteString -> 'NgxExportService' -- __/makeRequest/__ = const . 'makeSubrequest' -- -- 'ngxExportSimpleService' \'makeRequest $ 'PersistentService' $ Just $ 'Sec' 10 @@ -232,16 +237,25 @@ instance Exception UDSNotConfiguredError +newtype ManagerNotConfiguredError = + ManagerNotConfiguredError ByteString deriving Show + +instance Exception ManagerNotConfiguredError + data ResponseTimeout = ResponseTimeoutDefault | ResponseTimeout TimeInterval deriving (Eq, Read) +data ConnectionManager = Default + | UDS + | Custom ByteString deriving (Eq, Read) + data SubrequestConf = SubrequestConf { srMethod :: ByteString , srUri :: String , srBody :: L.ByteString , srHeaders :: RequestHeaders , srResponseTimeout :: ResponseTimeout - , srUseUDS :: Bool + , srManager :: ConnectionManager } deriving Read instance FromJSON SubrequestConf where @@ -253,7 +267,11 @@ o .:? "headers" .!= [] srResponseTimeout <- maybe ResponseTimeoutDefault ResponseTimeout <$> o .:? "timeout" - srUseUDS <- fromMaybe False <$> o .:? "useUDS" + srManager <- maybe Default (\case + "default" -> Default + "uds" -> UDS + v -> Custom $ T.encodeUtf8 v + ) <$> o .:? "manager" return SubrequestConf {..} data BridgeConf = BridgeConf { bridgeSource :: SubrequestConf @@ -336,11 +354,21 @@ httpUDSManager = unsafePerformIO $ newIORef Nothing {-# NOINLINE httpUDSManager #-} +httpCustomManager :: IORef (HashMap ByteString Manager) +httpCustomManager = unsafePerformIO $ newIORef HM.empty +{-# NOINLINE httpCustomManager #-} + getManager :: SubrequestConf -> IO Manager -getManager SubrequestConf {..} - | srUseUDS = - fromMaybe (throw UDSNotConfiguredError) <$> readIORef httpUDSManager - | otherwise = return httpManager +getManager SubrequestConf {..} = + case srManager of + Default -> + return httpManager + UDS -> + fromMaybe (throw UDSNotConfiguredError) <$> + readIORef httpUDSManager + Custom k -> + fromMaybe (throw $ ManagerNotConfiguredError k) . HM.lookup k <$> + readIORef httpCustomManager -- | Makes an HTTP request. -- @@ -355,8 +383,9 @@ -- /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), and /useUDS/ (an optional boolean flag to enable Unix domain --- sockets as the transport protocol, off by default). +-- completely), and /manager/ (an optional value which links to an HTTP manager +-- that will serve connections, default is /default/ which links to the internal +-- TLS-aware manager). -- -- Examples of subrequest configurations: -- @@ -397,12 +426,14 @@ -- > , srBody = "" -- > , srHeaders = [("Header1", "Value1"), ("Header2", "Value2")] -- > , srResponseTimeout = ResponseTimeout (Sec 10) --- > , srUseUDS = False +-- > , srManager = Default -- > } -- -- Notice that unlike JSON parsing, fields of /SubrequestConf/ are not -- omittable and must be listed in the order shown in the example. Empty --- /srMethod/ implies /GET/. +-- /srMethod/ implies /GET/. Values of /srManager/ can be /Default/, /UDS/, or +-- /Custom \"key\"/ where /key/ is an arbitrary key bound to a custom HTTP +-- manager. makeSubrequestWithRead :: ByteString -- ^ Subrequest configuration -> IO L.ByteString @@ -419,8 +450,8 @@ -- compared with various types of local data communication channels) nor very -- secure. Unix domain sockets is a better alternative in this sense. This -- module has support for them by providing configuration service --- __/simpleService_configureUDS/__ where path to the socket can be set, and an --- extra field /srUseUDS/ in data /SubrequestConf/. +-- __/simpleService_configureUDS/__ where path to the socket can be set, and +-- setting field /manager/ to value /uds/ in the subrequest configuration. -- -- To extend the previous example for using with Unix domain sockets, the -- following declarations should be added. @@ -440,7 +471,7 @@ -- haskell_run_async __/makeSubrequest/__ $hs_subrequest -- \'{\"uri\": \"http:\/\/backend_proxy\/\" -- ,\"headers\": [[\"Custom-Header\", \"$arg_a\"]] --- ,\"__/useUDS/__\": __/true/__ +-- ,\"__/manager/__\": \"__uds__\" -- }\'; -- -- if ($hs_subrequest = \'\') { @@ -487,6 +518,103 @@ ngxExportSimpleServiceTyped 'configureUDS ''UDSConf SingleShotService +-- $subrequestsWithCustomManager +-- +-- To serve subrequests, a custom HTTP manager can be implemented and then +-- registered in a custom service handler with 'registerCustomManager'. To +-- enable this manager in a subrequest configuration, use field /manager/ +-- with the key that was bound to the manager in 'registerCustomManager'. +-- +-- For example, let's implement a custom UDS manager which will serve +-- connections via Unix Domain Sockets as in the previous section. +-- +-- ==== File /test_tools_extra_subrequest_custom_manager.hs/ +-- @ +-- {-\# LANGUAGE TemplateHaskell, OverloadedStrings \#-} +-- +-- module TestToolsExtraSubrequestCustomManager where +-- +-- import NgxExport.Tools +-- import NgxExport.Tools.Subrequest +-- +-- import Data.ByteString (ByteString) +-- import qualified Data.ByteString.Lazy as L +-- +-- import Network.HTTP.Client +-- import qualified Network.Socket as S +-- import qualified Network.Socket.ByteString as SB +-- import qualified Data.ByteString.Char8 as C8 +-- +-- configureUdsManager :: ByteString -> 'NgxExportService' +-- __/configureUdsManager/__ = 'ignitionService' $ \\path -> 'voidHandler' $ do +-- man <- newManager defaultManagerSettings +-- { managerRawConnection = return $ openUDS path } +-- 'registerCustomManager' \"__myuds__\" man +-- where openUDS path _ _ _ = do +-- s <- S.socket S.AF_UNIX S.Stream S.defaultProtocol +-- S.connect s (S.SockAddrUnix $ C8.unpack path) +-- makeConnection (SB.recv s 4096) (SB.sendAll s) (S.close s) +-- +-- 'ngxExportSimpleService' \'configureUdsManager 'SingleShotService' +-- @ +-- +-- ==== File /nginx.conf/: configuring the custom manager +-- @ +-- haskell_run_service __/simpleService_configureUdsManager/__ $hs_service_myuds +-- \'\/tmp\/myuds.sock\'; +-- @ +-- +-- ==== File /nginx.conf/: new location /\/myuds/ in server /main/ +-- @ +-- location \/myuds { +-- haskell_run_async __/makeSubrequest/__ $hs_subrequest +-- \'{\"uri\": \"http:\/\/backend_proxy_myuds\/\" +-- ,\"headers\": [[\"Custom-Header\", \"$arg_a\"]] +-- ,\"__/manager/__\": \"__myuds__\" +-- }\'; +-- +-- if ($hs_subrequest = \'\') { +-- echo_status 404; +-- echo \"Failed to perform subrequest\"; +-- break; +-- } +-- +-- echo -n $hs_subrequest; +-- } +-- @ +-- +-- ==== File /nginx.conf/: new virtual server /backend_proxy_myuds/ +-- @ +-- server { +-- listen unix:\/tmp\/myuds.sock; +-- server_name backend_proxy_myuds; +-- +-- location \/ { +-- proxy_pass http:\/\/backend; +-- } +-- } +-- @ + +-- | Registers a custom HTTP manager with a given key. +-- +-- The right place to register a custom manager is a custom service handler that +-- runs just after the start of an Nginx worker process. Registered managers can +-- then be referred to from subrequest configurations by the key in field +-- /manager/ (in JSON-encoded configurations) or as /srManager = Custom \"key\"/ +-- (in /read/-encoded configurations). +-- +-- Below is an example of a JSON-encoded subrequest configuration. +-- +-- > {"uri": "http://example.com/", "manager": "mymanager"} +-- +-- Note that keys /default/ and /uds/ have special meaning in field /manager/: +-- they denote internal HTTP and UDS managers respectively. +registerCustomManager + :: ByteString -- ^ Key + -> Manager -- ^ Manager + -> IO () +registerCustomManager = (modifyIORef' httpCustomManager .) . HM.insert + -- $gettingFullResponse -- -- Handlers /makeSubrequest/ and /makeSubrequestWithRead/ return response body @@ -904,7 +1032,7 @@ -- } -- ,\"__/sink/__\": -- {\"uri\": \"http:\/\/sink_proxy\/echo\" --- ,\"useUDS\": true +-- ,\"manager\": \"uds\" -- } -- }\'; -- @@ -1074,7 +1202,7 @@ -- > } -- > ,"sink": -- > {"uri": "http://sink_proxy/" --- > ,"useUDS": true +-- > ,"manager": "uds" -- > } -- > } -- @@ -1111,7 +1239,7 @@ -- > , srBody = "" -- > , srHeaders = [("Header1", "Value1"), ("Header2", "Value2")] -- > , srResponseTimeout = ResponseTimeout (Sec 10) --- > , srUseUDS = False +-- > , srManager = Default -- > } -- > , bridgeSink = SubrequestConf -- > { srMethod = "" @@ -1119,7 +1247,7 @@ -- > , srBody = "" -- > , srHeaders = [] -- > , srResponseTimeout = ResponseTimeout (Sec 30) --- > , srUseUDS = False +-- > , srManager = Default -- > } -- > } -- 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.2.7 +version: 1.2.8 synopsis: More extra tools for Nginx Haskell module description: More extra tools for .