ngx-export-tools-extra 1.2.5 → 1.2.6
raw patch · 9 files changed
+59/−60 lines, 9 filesdep ~ngx-export-toolsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ngx-export-tools
API changes (from Hackage documentation)
Files
- Changelog.md +7/−0
- NgxExport/Tools/Aggregate.hs +6/−9
- NgxExport/Tools/EDE.hs +3/−4
- NgxExport/Tools/PCRE.hs +12/−15
- NgxExport/Tools/Prometheus.hs +17/−15
- NgxExport/Tools/Resolve.hs +4/−5
- NgxExport/Tools/ServiceHookAdaptor.hs +3/−4
- NgxExport/Tools/Subrequest.hs +3/−4
- ngx-export-tools-extra.cabal +4/−4
Changelog.md view
@@ -1,3 +1,10 @@+### 1.2.6++- Refactored to avoid using *head* and *tail* as it triggers *x-partial*+ warnings in GHC *9.8.1*.+- Use declarations *voidHandler*, *voidHandler'*, and *NgxExportService* from+ package *ngx-export-tools* *1.2.2*.+ ### 1.2.5 - Module *NgxExport.Tools.Resolve*.
NgxExport/Tools/Aggregate.hs view
@@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.Aggregate--- Copyright : (c) Alexey Radkov 2019-2022+-- Copyright : (c) Alexey Radkov 2019-2023 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com@@ -37,8 +37,8 @@ import NgxExport #ifdef SNAP_AGGREGATE_SERVER+import NgxExport.Tools.Combinators import NgxExport.Tools.SimpleService-import NgxExport.Tools.SplitService #endif import NgxExport.Tools.System import NgxExport.Tools.TimeInterval@@ -126,21 +126,19 @@ -- {-\# NOINLINE stats \#-} -- -- updateStats :: ByteString -> IO C8L.ByteString--- __/updateStats/__ s = do+-- __/updateStats/__ s = voidHandler $ do -- let cbs = 'NgxExport.Tools.Read.readFromByteString' \@Int s -- modifyIORef\' stats $ \\(Stats bs rs _) -> -- let !nbs = bs + fromMaybe 0 cbs -- !nrs = rs + 1 -- !nmbs = nbs \`div\` nrs -- in Stats nbs nrs nmbs--- return \"\" -- 'NgxExport.ngxExportIOYY' \'updateStats -- -- reportStats :: Int -> Bool -> IO C8L.ByteString--- __/reportStats/__ = 'deferredService' $ \\port -> do+-- __/reportStats/__ = 'deferredService' $ \\port -> voidHandler $ do -- s <- readIORef stats -- 'reportAggregate' port (Just s) \"__/stats/__\"--- return \"\" -- 'NgxExport.Tools.SimpleService.ngxExportSimpleServiceTyped' \'reportStats \'\'Int $ -- 'PersistentService' $ Just $ Sec 5 --@@ -392,11 +390,10 @@ } deriving Read aggregateServer :: (FromJSON a, ToJSON a) =>- Aggregate a -> ByteString -> AggregateServerConf -> Bool -> IO L.ByteString-aggregateServer a u = ignitionService $ \conf -> do+ Aggregate a -> ByteString -> AggregateServerConf -> NgxExportService+aggregateServer a u = ignitionService $ \conf -> voidHandler $ do let !int = toNominalDiffTime $ asPurgeInterval conf simpleHttpServe (asConfig $ asPort conf) $ asHandler a u int- return "" asConfig :: Int -> Config Snap a asConfig p = setPort p
NgxExport/Tools/EDE.hs view
@@ -26,8 +26,8 @@ ) where import NgxExport+import NgxExport.Tools.Combinators import NgxExport.Tools.SimpleService-import NgxExport.Tools.SplitService import Text.EDE import Text.EDE.Filters@@ -224,12 +224,11 @@ templates = unsafePerformIO $ newIORef HM.empty {-# NOINLINE templates #-} -compileEDETemplates :: InputTemplates -> Bool -> IO L.ByteString-compileEDETemplates = ignitionService $ \(path, itpls) -> do+compileEDETemplates :: InputTemplates -> NgxExportService+compileEDETemplates = ignitionService $ \(path, itpls) -> voidHandler $ writeIORef templates $ foldl (\a (k, v) -> HM.insert k (unsafePerformIO $ parseIO path v) a) HM.empty itpls- return "" ngxExportSimpleServiceTyped 'compileEDETemplates ''InputTemplates SingleShotService
NgxExport/Tools/PCRE.hs view
@@ -29,8 +29,8 @@ ) where import NgxExport+import NgxExport.Tools.Combinators import NgxExport.Tools.SimpleService-import NgxExport.Tools.SplitService import qualified Data.HashMap.Strict as HM import Data.HashMap.Strict (HashMap)@@ -38,6 +38,7 @@ import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as L import Data.List+import qualified Data.List.NonEmpty as NE import Data.Maybe import Data.IORef import Text.Regex.PCRE.Light@@ -159,13 +160,13 @@ regexes = unsafePerformIO $ newIORef HM.empty {-# NOINLINE regexes #-} -declareRegexes :: InputRegexes -> Bool -> IO L.ByteString-declareRegexes = ignitionService $ const $ return ""+declareRegexes :: InputRegexes -> NgxExportService+declareRegexes = ignitionService $ voidHandler' $ return () ngxExportSimpleServiceTyped 'declareRegexes ''InputRegexes SingleShotService compileRegexes :: ByteString -> IO L.ByteString-compileRegexes = const $ do+compileRegexes = voidHandler' $ do !inputRegexes <- fromJust <$> readIORef storage_InputRegexes_declareRegexes let !compiledRegexes = foldl' (\a (!k, !v, !m) -> let !r = compile v $ mods $ C8.unpack m@@ -173,12 +174,11 @@ in hm ) HM.empty inputRegexes writeIORef regexes compiledRegexes- return "" where md 'i' = Just caseless md 's' = Just dotall md 'm' = Just multiline md _ = Nothing- mods = map head . group . sort . mapMaybe md+ mods = map NE.head . NE.group . sort . mapMaybe md ngxExportServiceHook 'compileRegexes @@ -189,11 +189,9 @@ substitutions = unsafePerformIO $ newIORef HM.empty {-# NOINLINE substitutions #-} -mapSubs :: InputSubs -> Bool -> IO L.ByteString-mapSubs = ignitionService $ \isubs -> do- writeIORef substitutions $- foldl (\a (k, v) -> HM.insert k v a) HM.empty isubs- return ""+mapSubs :: InputSubs -> NgxExportService+mapSubs = ignitionService $ voidHandler .+ writeIORef substitutions . foldl (\a (k, v) -> HM.insert k v a) HM.empty ngxExportSimpleServiceTyped 'mapSubs ''InputSubs SingleShotService @@ -212,10 +210,9 @@ doMatchRegex :: RegexF doMatchRegex r v = return $ case match r v [] of- Nothing -> ""- Just cs -> if captureCount r == 0- then head cs- else head $ tail cs+ Just (_ : c1 : _) -> c1+ Just (c0 : _) -> c0+ _ -> "" -- | Matches a value against a named regex. --
NgxExport/Tools/Prometheus.hs view
@@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.Prometheus--- Copyright : (c) Alexey Radkov 2020-2022+-- Copyright : (c) Alexey Radkov 2020-2023 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com@@ -34,8 +34,8 @@ import NgxExport import NgxExport.Tools.Read+import NgxExport.Tools.Combinators import NgxExport.Tools.SimpleService-import NgxExport.Tools.SplitService import Data.Map.Strict (Map) import qualified Data.Map.Strict as M@@ -54,6 +54,8 @@ import Data.Maybe import Data.Function import Data.List+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE import Data.Char import Data.Word import Data.Array.ST hiding (range)@@ -92,7 +94,7 @@ type AllHistogramsLayout = Map ServerName (Map MetricsName HistogramLayout) type AllOtherCounters = MetricsData -type AllMetrtics =+type AllMetrics = (ServerName, AllCounters, AllHistogramsLayout, AllOtherCounters) data MetricsType = Counter Double MetricsAnnotation@@ -103,7 +105,7 @@ | HistogramSum | HistogramCount deriving Eq -type PrometheusMetrics = Map MetricsName (MetricsHelp, [MetricsType])+type PrometheusMetrics = Map MetricsName (MetricsHelp, NonEmpty MetricsType) conf :: IORef (Maybe PrometheusConf) conf = unsafePerformIO $ newIORef Nothing@@ -437,14 +439,12 @@ -- > # TYPE hst_request_time_err counter -- > hst_request_time_err 0.0 -prometheusConf :: PrometheusConf -> Bool -> IO L.ByteString-prometheusConf = ignitionService $ \a -> do- writeIORef conf $ Just a- return ""+prometheusConf :: PrometheusConf -> NgxExportService+prometheusConf = ignitionService $ voidHandler . writeIORef conf . Just ngxExportSimpleServiceTyped 'prometheusConf ''PrometheusConf SingleShotService -toPrometheusMetrics' :: PrometheusConf -> AllMetrtics -> PrometheusMetrics+toPrometheusMetrics' :: PrometheusConf -> AllMetrics -> PrometheusMetrics toPrometheusMetrics' PrometheusConf {..} (srv, cnts, hs, ocnts) = let toValues = M.mapWithKey (\k v -> (if k `HS.member` pcScale1000@@ -504,8 +504,8 @@ in ranges `M.union` sums collect cType renameErrCounterF = M.fromAscList- . map ((fst . head) &&& map (uncurry cType . snd))- . groupBy ((==) `on` fst)+ . map (fst . NE.head &&& NE.map (uncurry cType . snd))+ . NE.groupBy ((==) `on` fst) . map (\(k, v) -> let (k', a) = second (\a' ->@@ -534,7 +534,7 @@ (\a k (h, ms) -> let k' = TL.fromStrict k in TL.concat [a, "# HELP ", k', " ", TL.fromStrict h, "\n"- , "# TYPE ", k', " ", showType $ head ms, "\n"+ , "# TYPE ", k', " ", showType $ NE.head ms, "\n" ,foldl (showCounter k') "" ms ] ) ""@@ -592,7 +592,7 @@ toPrometheusMetrics :: ByteString -> IO L.ByteString toPrometheusMetrics v = do- let cs = fromJust $ readFromByteStringAsJSON @AllMetrtics v+ let cs = fromJust $ readFromByteStringAsJSON @AllMetrics v pc <- readIORef conf return $ maybe "" (showPrometheusMetrics . flip toPrometheusMetrics' cs) pc @@ -874,8 +874,10 @@ a <- newArray bs 0 :: ST s (STUArray s Int Int) mapM_ (uncurry $ writeStatus a) $ toPairs s getElems a- toPairs = map (subtract (ord '0') . ord . C8.head . head &&& length)- . groupBy ((==) `on` C8.head)+ toPairs = map (subtract (ord '0') . ord . C8.head . NE.head+ &&& NE.length+ )+ . NE.groupBy ((==) `on` C8.head) . sort . extractValues writeStatus a i = when (i >= lb && i <= ub) . writeArray a i
NgxExport/Tools/Resolve.hs view
@@ -35,6 +35,7 @@ ) where import NgxExport+import NgxExport.Tools.Combinators import NgxExport.Tools.SimpleService import NgxExport.Tools.TimeInterval @@ -442,7 +443,7 @@ groupBy ((==) `on` srvPriority) . sortOn srvPriority withTrail = uncurry (++) . (id &&& repeat . last) -collectUpstreams :: Conf -> Bool -> IO L.ByteString+collectUpstreams :: Conf -> NgxExportService collectUpstreams Conf {..} = const $ do (wt, old) <- readIORef collectedServerData when (wt /= Unset) $ threadDelaySec $ toSec wt@@ -479,10 +480,8 @@ -- a list of fully qualified URLs such as 'http://../..' or 'https://../..' type Upconf = [Text] -signalUpconf :: Upconf -> Bool -> IO L.ByteString-signalUpconf upconf = const $ do- mapConcurrently_ getUrl upconf- return ""+signalUpconf :: Upconf -> NgxExportService+signalUpconf = voidHandler' . mapConcurrently_ getUrl ngxExportSimpleServiceTyped 'signalUpconf ''Upconf $ PersistentService Nothing
NgxExport/Tools/ServiceHookAdaptor.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.ServiceHookAdaptor--- Copyright : (c) Alexey Radkov 2021-2022+-- Copyright : (c) Alexey Radkov 2021-2023 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com@@ -26,7 +26,6 @@ import NgxExport.Tools.TimeInterval import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as L import Control.Monad -- $maintainingCustomGlobalData@@ -100,7 +99,7 @@ -- -- haskell load \/var\/lib\/nginx\/test_tools_extra_servicehookadaptor.so; ----- haskell_run_service __/simpleService_hookAdaptor/__ $hs_hook_adaptor \'\';+-- haskell_run_service __/simpleService_hookAdaptor/__ $hs_hook_adaptor noarg; -- -- haskell_service_hooks_zone hooks 32k; --@@ -183,7 +182,7 @@ -- Our secret is still intact! This is because service hooks manage new worker -- processes so well as those that were running when a hook was triggered. -hookAdaptor :: ByteString -> Bool -> IO L.ByteString+hookAdaptor :: ByteString -> NgxExportService hookAdaptor = ignitionService $ const $ forever $ threadDelaySec $ toSec $ Hr 24
NgxExport/Tools/Subrequest.hs view
@@ -47,8 +47,8 @@ import NgxExport import NgxExport.Tools.Read+import NgxExport.Tools.Combinators import NgxExport.Tools.SimpleService-import NgxExport.Tools.SplitService import NgxExport.Tools.TimeInterval import Network.HTTP.Client hiding (ResponseTimeout)@@ -475,12 +475,11 @@ newtype UDSConf = UDSConf { udsPath :: FilePath } deriving Read -configureUDS :: UDSConf -> Bool -> IO L.ByteString-configureUDS = ignitionService $ \UDSConf {..} -> do+configureUDS :: UDSConf -> NgxExportService+configureUDS = ignitionService $ \UDSConf {..} -> voidHandler $ do man <- newManager defaultManagerSettings { managerRawConnection = return $ openUDS udsPath } writeIORef httpUDSManager $ Just man- return "" where openUDS path _ _ _ = do s <- S.socket S.AF_UNIX S.Stream S.defaultProtocol S.connect s (S.SockAddrUnix path)
ngx-export-tools-extra.cabal view
@@ -1,12 +1,12 @@ name: ngx-export-tools-extra-version: 1.2.5+version: 1.2.6 synopsis: More extra tools for Nginx haskell module description: More extra tools for <https://github.com/lyokha/nginx-haskell-module Nginx haskell module>. homepage: https://github.com/lyokha/ngx-export-tools-extra license: BSD3 license-file: LICENSE-extra-source-files: Changelog.md+extra-doc-files: Changelog.md author: Alexey Radkov <alexey.radkov@gmail.com> maintainer: Alexey Radkov <alexey.radkov@gmail.com> stability: stable@@ -17,7 +17,7 @@ source-repository head type: git- location: https://github.com/lyokha/ngx-export-tools-extra+ location: https://github.com/lyokha/ngx-export-tools-extra.git flag EDE description: Build EDE module.@@ -40,7 +40,7 @@ , bytestring >= 0.10.0.0 , base64 >= 0.3.0.0 , ngx-export- , ngx-export-tools >= 1.0+ , ngx-export-tools >= 1.2.2 , http-types >= 0.7.0 , http-client >= 0.5.3 , http-client-tls >= 0.3.4