diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -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*. diff --git a/NgxExport/Tools/Aggregate.hs b/NgxExport/Tools/Aggregate.hs --- a/NgxExport/Tools/Aggregate.hs +++ b/NgxExport/Tools/Aggregate.hs @@ -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 diff --git a/NgxExport/Tools/EDE.hs b/NgxExport/Tools/EDE.hs --- a/NgxExport/Tools/EDE.hs +++ b/NgxExport/Tools/EDE.hs @@ -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 diff --git a/NgxExport/Tools/PCRE.hs b/NgxExport/Tools/PCRE.hs --- a/NgxExport/Tools/PCRE.hs +++ b/NgxExport/Tools/PCRE.hs @@ -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. -- diff --git a/NgxExport/Tools/Prometheus.hs b/NgxExport/Tools/Prometheus.hs --- a/NgxExport/Tools/Prometheus.hs +++ b/NgxExport/Tools/Prometheus.hs @@ -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 diff --git a/NgxExport/Tools/Resolve.hs b/NgxExport/Tools/Resolve.hs --- a/NgxExport/Tools/Resolve.hs +++ b/NgxExport/Tools/Resolve.hs @@ -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 diff --git a/NgxExport/Tools/ServiceHookAdaptor.hs b/NgxExport/Tools/ServiceHookAdaptor.hs --- a/NgxExport/Tools/ServiceHookAdaptor.hs +++ b/NgxExport/Tools/ServiceHookAdaptor.hs @@ -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 diff --git a/NgxExport/Tools/Subrequest.hs b/NgxExport/Tools/Subrequest.hs --- a/NgxExport/Tools/Subrequest.hs +++ b/NgxExport/Tools/Subrequest.hs @@ -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) 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,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 . 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 maintainer: Alexey Radkov 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