diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,14 @@ +### 1.6 + +- Added support for *https* transport protocol. + + **Breaking changes**: endpoint configuration gets a new field *epProto*, + see updated examples in the project's *README.md*. +- A new approach to building custom handlers with Cabal Nix-style local builds + and [*ngx-export-distribution*](https://hackage.haskell.org/package/ngx-export-distribution), + see details in the project's *simple/*, *periodic/*, and *prometheus/* + subdirectories. +- Improvement: using a single http manager for all service keys. + ### 1.5 - Refactoring of type imports. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2022, Alexey Radkov. All rights reserved. +Copyright 2022-2023, 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/Healthcheck.hs b/NgxExport/Healthcheck.hs --- a/NgxExport/Healthcheck.hs +++ b/NgxExport/Healthcheck.hs @@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Healthcheck --- Copyright : (c) Alexey Radkov 2022 +-- Copyright : (c) Alexey Radkov 2022-2023 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -21,6 +21,7 @@ import NgxExport import NgxExport.Healthcheck.Types as Types import Network.HTTP.Client +import Network.HTTP.Client.TLS (newTlsManager) import Network.HTTP.Client.BrReadWithTimeout import Network.HTTP.Types.Status import Data.Map (Map) @@ -80,9 +81,12 @@ } deriving Read data Endpoint = Endpoint { epUrl :: Url + , epProto :: TransportProtocol , epPassRule :: PassRule } deriving Read +data TransportProtocol = Http | Https deriving Read + data PassRule = DefaultPassRule | PassRuleByHttpStatus [HttpStatus] deriving Read @@ -111,8 +115,8 @@ active = unsafePerformIO $ newIORef [] {-# NOINLINE active #-} -httpManager :: IORef (Map ServiceKey Manager) -httpManager = unsafePerformIO $ newIORef M.empty +httpManager :: Manager +httpManager = unsafePerformIO newTlsManager {-# NOINLINE httpManager #-} data StatsServerConf = StatsServerConf { ssPort :: Int @@ -141,21 +145,23 @@ #endif . fromIntegral . toSec -getUrl :: ServiceKey -> Url -> IO HttpStatus -getUrl skey url = do - httpManager' <- M.lookup skey <$> readIORef httpManager - if isJust httpManager' - then -- using httpNoBody here makes Nginx backends claim about closed - -- keepalive connections! - getResponseStatus url $ - flip httpLbsBrReadWithTimeout $ fromJust httpManager' - else undefined - where getResponseStatus u = - fmap (statusCode . responseStatus) . (parseRequest u >>=) +getUrl :: Url -> TimeInterval -> IO HttpStatus +getUrl url ((1e6 *) . toSec -> tmo) = do + -- Note: using here httpNoBody makes Nginx backends claim about closed + -- keepalive connections! + request <- parseRequest url + statusCode . responseStatus <$> + httpLbsBrReadWithTimeout + (request { responseTimeout = responseTimeoutMicro tmo }) + httpManager -query :: ServiceKey -> Url -> Peer -> IO (Peer, HttpStatus) -query skey url = runKleisli $ arr id &&& Kleisli (getUrl skey . flip mkAddr url) - where mkAddr = (("http://" ++) .) . (++) . T.unpack +query :: Url -> TransportProtocol -> TimeInterval -> Peer -> + IO (Peer, HttpStatus) +query url proto tmo p = + (p, ) <$> getUrl (mkAddr p url) tmo + where mkAddr = ((fromProto proto ++) .) . (++) . T.unpack + fromProto Http = "http://" + fromProto Https = "https://" catchBadResponse :: Peer -> IO (Peer, HttpStatus) -> IO (Peer, HttpStatus) catchBadResponse p = handle $ \(_ :: SomeException) -> return (p, 0) @@ -190,17 +196,14 @@ "Peers were not initialized for service set " ++ T.unpack skey ++ "!" reportStats :: Int -> (Int32, ServiceKey, MUpstream Peers) -> IO () -reportStats ssp v@(_, skey, _) = do - httpManager' <- M.lookup skey <$> readIORef httpManager - if isJust httpManager' - then handle (\(_ :: SomeException) -> return ()) $ do - req <- parseRequest "POST http://127.0.0.1" - let !req' = req { requestBody = RequestBodyLBS $ encode v - , port = ssp - , Network.HTTP.Client.path = "report" - } - void $ httpNoBody req' $ fromJust httpManager' - else undefined +reportStats ssp v = do + handle (\(_ :: SomeException) -> return ()) $ do + req <- parseRequest "POST http://127.0.0.1" + let !req' = req { requestBody = RequestBodyLBS $ encode v + , port = ssp + , Network.HTTP.Client.path = "report" + } + void $ httpNoBody req' httpManager checkPeers :: ByteString -> Bool -> IO L.ByteString checkPeers cf fstRun = do @@ -217,26 +220,16 @@ ) return . M.lookup skey' let !us = upstreams cf'' ep = endpoint cf'' - int = toSec $ interval cf'' - pto = toSec $ peerTimeout cf'' + int = interval cf'' + pto = peerTimeout cf'' !ssp = sendStatsPort cf'' if fstRun then do peers' <- lookupServiceKey skey' <$> readIORef peers let peers'' = foldr (flip (M.insertWith $ const id) []) peers' us atomicModifyIORef' peers $ (, ()) . M.insert skey' peers'' - readIORef httpManager >>= - maybe (atomicModifyIORef' httpManager $ - (, ()) . M.insert skey' - (unsafePerformIO $ - newManager defaultManagerSettings - { managerResponseTimeout = - responseTimeoutMicro $ pto * 1e6 - } - ) - ) (void . return) . M.lookup skey' atomicModifyIORef' active $ (, ()) . (skey' :) - else threadDelaySec int + else threadDelaySec $ toSec int peers' <- lookupServiceKey skey' <$> readIORef peers throwWhenPeersUninitialized skey' peers' when (isJust ssp) $ do @@ -246,14 +239,15 @@ let concatResult = L.fromStrict . B.concat if isJust ep then do - let ep' = fromJust ep - url = epUrl ep' - rule = epPassRule ep' + let ep' = fromJust ep + url = epUrl ep' + proto = epProto ep' + rule = epPassRule ep' (map (flip B.append "\0\n" . T.encodeUtf8) -> peers'') <- forConcurrently us $ \u -> do let !ps = fromJust $ M.lookup u peers' ps' <- forConcurrently ps $ \p -> - catchBadResponse p $ query skey' url p + catchBadResponse p $ query url proto pto p let (psGood, psBad) = both (map fst) $ partition (byPassRule rule . (\st -> defaultPassRuleParams diff --git a/ngx-export-healthcheck.cabal b/ngx-export-healthcheck.cabal --- a/ngx-export-healthcheck.cabal +++ b/ngx-export-healthcheck.cabal @@ -1,7 +1,7 @@ name: ngx-export-healthcheck -version: 1.5 -synopsis: Active health checks and monitor of Nginx upstreams -description: Active health checks and monitor of Nginx upstreams. +version: 1.6 +synopsis: Active health checks and monitoring of Nginx upstreams +description: Active health checks and monitoring of Nginx upstreams. . This is a part of . Custom libraries are required to be linked against C module @@ -13,7 +13,7 @@ author: Alexey Radkov maintainer: Alexey Radkov stability: stable -copyright: 2022 Alexey Radkov +copyright: 2022-2023 Alexey Radkov category: Network build-type: Simple cabal-version: 1.20 @@ -26,6 +26,7 @@ build-depends: base >=4.8 && <5 , ngx-export >= 1.7.1 , http-client + , http-client-tls >= 0.3.4 , http-client-brread-timeout , http-types , containers