ngx-export-healthcheck 1.5 → 1.6
raw patch · 4 files changed
+56/−50 lines, 4 filesdep +http-client-tlsPVP ok
version bump matches the API change (PVP)
Dependencies added: http-client-tls
API changes (from Hackage documentation)
+ NgxExport.Healthcheck: instance GHC.Read.Read NgxExport.Healthcheck.TransportProtocol
Files
- Changelog.md +11/−0
- LICENSE +1/−1
- NgxExport/Healthcheck.hs +39/−45
- ngx-export-healthcheck.cabal +5/−4
Changelog.md view
@@ -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.
LICENSE view
@@ -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:
NgxExport/Healthcheck.hs view
@@ -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
ngx-export-healthcheck.cabal view
@@ -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 <https://github.com/lyokha/nginx-healthcheck-plugin>. Custom libraries are required to be linked against C module@@ -13,7 +13,7 @@ author: Alexey Radkov <alexey.radkov@gmail.com> maintainer: Alexey Radkov <alexey.radkov@gmail.com> 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