ngx-export-tools-extra 1.2.8.1 → 1.2.9

raw patch · 6 files changed

+156/−69 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Changelog.md +16/−0
• NgxExport/Tools/Aggregate.hs +0/−6
• NgxExport/Tools/PCRE.hs +1/−1
• NgxExport/Tools/Resolve.hs +132/−56
• NgxExport/Tools/Subrequest.hs +6/−5
• ngx-export-tools-extra.cabal +1/−1

@@ -1,3 +1,19 @@+### 1.2.9++- Module *NgxExport.Tools.Resolve*.+  + Correctly print IP addresses in the server data collected in *A* queries.+  + Allow setting weights to names in *QueryA* data.+  + Allow priority policies in *QueryA* data.+  + Now, if the number of upstreams in the priority list is greater than the+    number of variations of weights collected in *SRV* queries or set in+    *QueryA* data, the remainder of upstreams get servers with the lowest+    weight rather than not being specified at all in the collected data.+  + Now, with the *PriorityList* policy, weights of servers in the collected+    data are deliberately not specified.+  + Names in the *QueryA* name list may contain suffix *:port* where *port* is+    a port number, this suffix is ignored at resolving step in *collectA* and+    only appended to values of the collected server addresses.+ ### 1.2.8.1  - Module *NgxExport.Tools.PCRE*.

@@ -381,9 +381,6 @@ -- have already been terminated. The inactive PIDs get checked every -- /asPurgeInterval/, and data which correspond to PIDs with timestamps older -- than /asPurgeInterval/ get removed.------ Be aware that due to limitations of Template Haskell, this name must be--- imported unqualified! data AggregateServerConf =     AggregateServerConf { asPort          :: Int                         , asPurgeInterval :: TimeInterval@@ -509,9 +506,6 @@                 ]             ] #ifdef SNAP_AGGREGATE_SERVER-        -- FIXME: name AggregateServerConf must be imported from the user's-        -- module unqualified (see details in NgxExport/Tools/SimpleService.hs,-        -- function ngxExportSimpleService')!         ,ngxExportSimpleServiceTyped             fName ''AggregateServerConf SingleShotService #endif

@@ -308,7 +308,7 @@ -- -- > $ curl 'http://localhost:8010/erase/area?user=peter|98' -- > User without area: peter--- > $ curl 'http://localhost:8010/swap?kv=kid|v0012a+-- > $ curl 'http://localhost:8010/swap?kv=kid|v0012a' -- > Swap kid|v0012a = v0012a|kid  -- | Type of functions to perform /functional/ substitutions.

@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell, RecordWildCards, BangPatterns, NumDecimals #-}-{-# LANGUAGE TupleSections, OverloadedStrings #-}+{-# LANGUAGE DeriveFoldable, TupleSections, LambdaCase, OverloadedStrings #-}  ----------------------------------------------------------------------------- -- |@@ -24,7 +24,10 @@                                 UName                                ,SAddress                                ,UQuery (..)+                               ,WeightedList (..)+                               ,NameList                                ,PriorityPolicy (..)+                               ,UNamePriorityPolicy                                ,UData (..)                                ,ServerData (..)                                ,CollectedServerData@@ -75,9 +78,9 @@ -- __/collectUpstreams/__ and signals about this in service callback -- __/signalUpconf/__. Collecting upstreams encompasses DNS queries of /A/ and -- /SRV/ records. The queries are configured independently for each managed--- upstream. With /SRV/ queries, the module allows configuration of complex--- hierarchies of priorities given that compound upstream containers named--- /upstrands/ are in use (they are implemented in+-- upstream. With both /A/ and /SRV/ queries, the module allows configuration+-- of complex hierarchies of priorities given that compound upstream containers+-- named /upstrands/ are in use (they are implemented in -- [nginx-combined-upstreams-module](https://github.com/lyokha/nginx-combined-upstreams-module)). -- -- Additionally, the module exports a number of functions and data types which@@ -222,22 +225,28 @@ -- priority list may contain more than two upstreams, in which case upstreams -- at the beginning of the list will take higher priorities found in the -- collected servers, while the last upstream will take the remainder of the--- priorities.+-- priorities. Generally, given the number of upstreams in the priority list is+-- /N/ and the number of all variations of server priorities collected in the+-- response is /M/, and /N/ is less than /M/, then the remainder of servers with+-- the lowest priorities will inhabit the last upstream in the priority list,+-- and vice versa, if /N/ is greater than /M/, then more than one upstreams at+-- the end of the priority list will contain the same servers of the lowest+-- priority. -- -- Upstreams in the priority list can be put inside of an /upstrand/ to form the -- main and the backup layers of servers. -- -- ==== File /nginx.conf/: upstrand /utest/ -- @---     upstream utest1 {+--     upstream __/utest1/__ { --         zone utest1 64k; --         upconf_round_robin; --         server localhost:9000; --     } -- --     __/upstrand utest/__ {---         upstream utest;---         upstream utest1;+--         upstream __/utest/__;+--         upstream __/utest1/__; --         order per_request; --         next_upstream_statuses error timeout 5xx; --         next_upstream_timeout 60s;@@ -259,17 +268,38 @@  -- | DNS query model of the upstream(s). ----- There are 3 ways to get the list of server addresses:+-- There are 4 ways to get the list of server addresses: ----- - query /A/ records for a list of domain names,--- - query an /SRV/ record for a single service name and then query /A/ records---   for the collected list of domain names,+-- - query /A/ records on a weighted list of domain names, -- - the same as the previous, but distribute collected servers among a list of+--   upstreams according to the weights set in the name list,+-- - query an /SRV/ record on a single service name and then query /A/ records+--   on the collected list of domain names,+-- - the same as the previous, but distribute collected servers among a list of --   upstreams according to the collected priorities.-data UQuery = QueryA [Name] UName                   -- ^ Query /A/ records-            | QuerySRV Name (PriorityPolicy UName)  -- ^ Query an /SRV/ record+--+-- Note that+--+-- - names in /QueryA/ name list may contain suffix /:port/ (a port number)+--   which is ignored in 'collectA' and only appended to values of 'sAddr'+--   collected by 'collectServerData',+-- - when priority policy is 'PriorityList', vaues of 'sWeight' collected by+--   'collectServerData' are deliberately /Nothing/.+data UQuery = QueryA NameList UNamePriorityPolicy  -- ^ Query /A/ records+            | QuerySRV Name UNamePriorityPolicy    -- ^ Query an /SRV/ record             deriving Read +-- | Weighted list.+--+-- A list of elements optionally annotated by weight values.+data WeightedList a = Singleton a               -- ^ List with a single element+                    | PlainList [a]             -- ^ Plain list without weights+                    | WeightedList [(a, Word)]  -- ^ Weighted list+                    deriving (Read, Foldable)++-- | Weighted list of domain names.+type NameList = WeightedList Name+ -- | Priority policy. -- -- Specifies how to distribute collected items by priorities. In particular,@@ -279,14 +309,17 @@                       | PriorityList [a]  -- ^ Distribute items by priorities                       deriving Read +-- | Priority policy of upstream names.+type UNamePriorityPolicy = PriorityPolicy UName+ -- | Upstream configuration. -- -- Includes DNS query model and parameters for Nginx /server/ description. -- Values of /uMaxFails/ and /uFailTimeout/ get assigned to each collected--- server as /max_fails/ and /fail_timeout/ respectively. The weight of an--- individual server gets picked from the value of 'srvWeight' collected in--- /SRV/ queries. Note that setting of parameters /max_conns/, /backup/ and--- /down/ is not supported.+-- server as /max_fails/ and /fail_timeout/ respectively. For /SRV/ queries,+-- weights of individual servers will be picked from the values of 'srvWeight'+-- collected in the query. Note that setting of parameters /max_conns/,+-- /backup/ and /down/ is not supported. data UData = UData { uQuery       :: UQuery  -- ^ DNS query model                    , uMaxFails    :: Int     -- ^ /max_fails/                    , uFailTimeout :: Int     -- ^ /fail_timeout/@@ -348,8 +381,8 @@     :: TTL                      -- ^ Fallback TTL value     -> Name                     -- ^ Domain name     -> IO (TTL, [IPv4])-collectA lTTL name = do-    !srv <- queryA name+collectA lTTL (Name n) = do+    !srv <- queryA $ Name $ C8.takeWhile (':' /=) n     return (minimumTTL lTTL $ map fst srv, map snd srv)  -- | Queries an /SRV/ record for the given service name.@@ -368,22 +401,17 @@ collectSRV lTTL name = do     !srv <- querySRV name     !srv' <- mapConcurrently-                 ((\s@SRV {..} -> do-                     (t, is) <- collectA lTTL srvTarget-                     return (t-                            ,map (\v ->-                                     s { srvTarget =-                                           (removeTrailingDot srvTarget, v)-                                       }-                                 ) is-                            )+                 ((\s@SRV {..} ->+                     second (map $ \v -> (, v) . removeTrailingDot <$> s) <$>+                         collectA lTTL srvTarget                   ) . snd                  ) srv     return (min (minimumTTL lTTL $ map fst srv)                 (minimumTTL lTTL $ map fst srv')            ,concatMap snd srv'            )-    where removeTrailingDot (Name v) = Name $ maybe v fst $ C8.unsnoc v+    where removeTrailingDot (Name v) = Name $+              maybe v (\case (v', '.') -> v'; _ -> v) $ C8.unsnoc v  showIPv4 :: IPv4 -> String showIPv4 (IPv4 w) =@@ -393,17 +421,43 @@   shows ( w                    .&. 0xff)   "" -ipv4ToServerData :: UData -> Name -> IPv4 -> ServerData-ipv4ToServerData UData {..} (Name n) i =-    ServerData (T.pack $ show i) (T.decodeUtf8 n)-        Nothing (Just uMaxFails) (Just uFailTimeout)+partitionByPriority :: (Eq b, Ord b) => (a -> b) -> [a] -> [[a]]+partitionByPriority f = groupBy ((==) `on` f) . sortOn f -srvToServerData :: UData -> SRV (Name, IPv4) -> ServerData-srvToServerData UData {..} SRV {..} =+zipWithPriorityList :: UNamePriorityPolicy -> [a] -> [(UName, a)]+zipWithPriorityList (PriorityList []) _ = []+zipWithPriorityList (PriorityList _) [] = []+zipWithPriorityList (PriorityList pl) vs =+    let (lpl, lastp) = lengthAndLast pl+        (lvs, lastv) = lengthAndLast vs+    in uncurry zip $ if lpl > lvs+                         then (pl, vs ++ repeat lastv)+                         else (pl ++ repeat lastp, vs)+    where lengthAndLast =+              foldl' (\(l, _) v -> (succ l, v)) (0 :: Int, undefined)+zipWithPriorityList _ _ = undefined++ipv4ToServerData :: UData -> UNamePriorityPolicy -> Name -> Maybe Word ->+    IPv4 -> ServerData+ipv4ToServerData UData {..} policy (Name n) weight a =+    let (n', port) = C8.span (':' /=) n+        showAddr i p = showIPv4 i ++ C8.unpack p+    in ServerData (T.pack $ showAddr a port) (T.decodeUtf8 n')+           (case policy of+                  SinglePriority _ -> fromIntegral <$> weight+                  PriorityList _ -> Nothing+           ) (Just uMaxFails) (Just uFailTimeout)++srvToServerData :: UData -> UNamePriorityPolicy -> SRV (Name, IPv4) ->+    ServerData+srvToServerData UData {..} policy SRV {..} =     let (Name n, a) = srvTarget         showAddr i p = showIPv4 i ++ ':' : show p     in ServerData (T.pack $ showAddr a srvPort) (T.decodeUtf8 n)-          (Just $ fromIntegral srvWeight) (Just uMaxFails) (Just uFailTimeout)+          (case policy of+               SinglePriority _ -> Just $ fromIntegral srvWeight+               PriorityList _ -> Nothing+          ) (Just uMaxFails) (Just uFailTimeout)  -- | Collects server data for the given upstream configuration. --@@ -415,33 +469,55 @@     :: TTL                      -- ^ Fallback TTL value     -> UData                    -- ^ Upstream configuration     -> IO (TTL, CollectedServerData)-collectServerData lTTL (UData (QueryA [] _) _ _) =-    return (lTTL, M.empty)-collectServerData lTTL ud@(UData (QueryA ns u) _ _) = do-    a <- mapConcurrently (\n -> (n, ) <$> collectA lTTL n) ns+collectServerData lTTL (UData (QueryA ns p) _ _)+    | null ns = return (lTTL, M.empty)+    | PriorityList [] <- p = return (lTTL, M.empty)+collectServerData lTTL ud@(UData (QueryA+                                     (WeightedList ns) p@(PriorityList _)+                                 ) _ _+                          ) = do+    a <- mapConcurrently (\nw@(n, _) -> (nw, ) <$> collectA lTTL n) ns     return $-        minimum *** M.singleton u . concat $-            foldr (\(n, (t, s)) (ts, ss) ->-                      -- sort is required because resolver may rotate servers-                      -- which means that the same data may differ after every-                      -- single check; this note regards to other clauses of-                      -- this function as well-                      (t : ts, sort (map (ipv4ToServerData ud n) s) : ss)+        minimum ***+            M.fromList . zipWithPriorityList p+            . map (map snd) . partitionByPriority fst . concat $+                foldr (\((n, w), (t, s)) (ts, ss) ->+                          (t : ts+                           -- sort is required because resolver may rotate+                           -- servers which means that the same data may differ+                           -- after every single check; this note regards to+                           -- other clauses of this function as well+                          ,sort (map ((w ,) .+                                         ipv4ToServerData ud p n (Just w)+                                     ) s+                                ) : ss+                          )+                      ) ([], []) a+collectServerData lTTL ud@(UData (QueryA ns p) _ _) = do+    let ns' = case ns of+                  Singleton n -> pure (n, Nothing)+                  PlainList ns'' -> map (, Nothing) ns''+                  WeightedList ns'' -> map (second Just) ns''+    a <- mapConcurrently (\nw@(n, _) -> (nw, ) <$> collectA lTTL n) ns'+    let f = case p of+                SinglePriority u -> M.singleton u+                PriorityList pl -> \v -> M.fromList $ map (, v) pl+    return $+        minimum *** f . concat $+            foldr (\((n, w), (t, s)) (ts, ss) ->+                      (t : ts, sort (map (ipv4ToServerData ud p n w) s) : ss)                   ) ([], []) a-collectServerData lTTL ud@(UData (QuerySRV n (SinglePriority u)) _ _) = do+collectServerData lTTL ud@(UData (QuerySRV n p@(SinglePriority u)) _ _) = do     (wt, srv) <- collectSRV lTTL n-    return (wt, M.singleton u $ sort $ map (srvToServerData ud) srv)+    return (wt, M.singleton u $ sort $ map (srvToServerData ud p) srv) collectServerData lTTL (UData (QuerySRV _ (PriorityList [])) _ _) =     return (lTTL, M.empty)-collectServerData lTTL ud@(UData (QuerySRV n (PriorityList pl)) _ _ ) = do+collectServerData lTTL ud@(UData (QuerySRV n p@(PriorityList _)) _ _ ) = do     (wt, srv) <- collectSRV lTTL n-    let srv' = zip (withTrail pl) $ partitionByPriority srv+    let srv' = zipWithPriorityList p $ partitionByPriority srvPriority srv     return (wt-           ,M.fromList $ map (second $ sort . map (srvToServerData ud)) srv'+           ,M.fromList $ map (second $ sort . map (srvToServerData ud p)) srv'            )-    where partitionByPriority =-              groupBy ((==) `on` srvPriority) . sortOn srvPriority-          withTrail = uncurry (++) . (id &&& repeat . last)  collectUpstreams :: Conf -> NgxExportService collectUpstreams Conf {..} = const $ do

@@ -597,11 +597,12 @@  -- | 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).+-- The right place to register a custom manager is a custom service handler or+-- the initialization hook (see 'ngxExportInitHook') which runs soon 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. --

@@ -1,5 +1,5 @@ name:                       ngx-export-tools-extra-version:                    1.2.8.1+version:                    1.2.9 synopsis:                   More extra tools for Nginx Haskell module description:                More extra tools for         <https://github.com/lyokha/nginx-haskell-module Nginx Haskell module>.