ngx-export-tools-extra 1.2.9.1 → 1.2.10

raw patch · 5 files changed

+82/−35 lines, 5 filesdep +hashabledep ~ngx-export-toolsPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable

Dependency ranges changed: ngx-export-tools

API changes (from Hackage documentation)

Files

• Changelog.md +13/−0
• NgxExport/Tools/PCRE.hs +1/−1
• NgxExport/Tools/Resolve.hs +53/−21
• NgxExport/Tools/Subrequest.hs +12/−11
• ngx-export-tools-extra.cabal +3/−2

@@ -1,3 +1,16 @@+### 1.2.10++- Module *NgxExport.Tools.Resolve*.+  + Parameterize collected server data by query data to avoid getting wrong+    values when multiple instances of the resolve service are running.+  + Use exporters from *ngx-export-tools ≥ 1.2.5* which do not share+    configurations between multiple instances of the resolve service.+  + Append port numbers to values of collected host names as Nginx directive+    *server* accepts such a notation.+- Module *NgxExport.Tools.PCRE*.+  + Replace *SingleShotService* mode declaration in service *declareRegexes* by+    *rareService* declaration from *ngx-export-tools ≥ 1.2.5*.+ ### 1.2.9.1  - Module *NgxExport.Tools.Resolve*.

@@ -163,7 +163,7 @@ declareRegexes :: InputRegexes -> NgxExportService declareRegexes = voidService -ngxExportSimpleServiceTyped 'declareRegexes ''InputRegexes SingleShotService+ngxExportSimpleServiceTyped 'declareRegexes ''InputRegexes rareService  compileRegexes :: ByteString -> IO L.ByteString compileRegexes = voidHandler' $ do

@@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell, RecordWildCards, BangPatterns, NumDecimals #-}-{-# LANGUAGE DeriveFoldable, TupleSections, LambdaCase, OverloadedStrings #-}+{-# LANGUAGE DerivingStrategies, DeriveAnyClass, DeriveFoldable #-}+{-# LANGUAGE DeriveGeneric, TupleSections, LambdaCase, OverloadedStrings #-}  ----------------------------------------------------------------------------- -- |@@ -46,10 +47,14 @@ import           Network.HTTP.Client import           Network.HTTP.Client.TLS (newTlsManager) import           Network.HTTP.Client.BrReadWithTimeout+import           Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as L import           Data.Map.Strict (Map) import qualified Data.Map.Strict as M+import qualified Data.HashMap.Strict as HM+import           Data.HashMap.Strict (HashMap)+import           Data.Hashable import           Data.IORef import           Data.Text (Text) import qualified Data.Text as T@@ -67,6 +72,8 @@ import           Control.Monad import           System.IO.Unsafe import           System.Timeout+import           Unsafe.Coerce+import           GHC.Generics  -- $dynamicUpstreams --@@ -304,7 +311,8 @@ data WeightedList a = Singleton a               -- ^ List with a single element                     | PlainList [a]             -- ^ Plain list without weights                     | WeightedList [(a, Word)]  -- ^ Weighted list-                    deriving (Read, Foldable)+                    deriving (Read, Eq, Generic, Foldable)+                    deriving anyclass Hashable  -- | Weighted list of domain names. type NameList = WeightedList Name@@ -316,11 +324,24 @@ -- the given upstreams. data PriorityPolicy a = SinglePriority a  -- ^ All items go to a single element                       | PriorityList [a]  -- ^ Distribute items by priorities-                      deriving Read+                      deriving (Read, Eq, Generic)+                      deriving anyclass Hashable  -- | Priority policy of upstream names. type UNamePriorityPolicy = PriorityPolicy UName +-- FIXME: an awkward hack to avoid using orphan instance Hashable Name,+-- make sure that HashUQuery and UQuery have the same internal representation!+data UQueryGen a = UQueryAGen (WeightedList a) UNamePriorityPolicy+                 | UQerySRVGen a UNamePriorityPolicy+                 deriving (Read, Eq, Generic)+                 deriving anyclass Hashable++type HashUQuery = UQueryGen ByteString++hashUQuery :: UQuery -> HashUQuery+hashUQuery = unsafeCoerce+ -- | Upstream configuration. -- -- Includes DNS query model and parameters for Nginx /server/ description.@@ -360,8 +381,9 @@ -- | Collected server data. type CollectedServerData = Map UName [ServerData] -collectedServerData :: IORef (TimeInterval, CollectedServerData)-collectedServerData = unsafePerformIO $ newIORef (Unset, M.empty)+collectedServerData ::+    IORef (TimeInterval, HashMap HashUQuery CollectedServerData)+collectedServerData = unsafePerformIO $ newIORef (Unset, HM.empty) {-# NOINLINE collectedServerData #-}  httpManager :: Manager@@ -438,9 +460,9 @@ ipv4ToServerData :: UData -> UNamePriorityPolicy -> Name -> Maybe Word ->     IPv4 -> ServerData ipv4ToServerData UData {..} policy (Name n) weight a =-    let (n', port) = C8.span (':' /=) n+    let port = snd $ C8.span (':' /=) n         showAddr i p = showIPv4 i ++ C8.unpack p-    in ServerData (T.pack $ showAddr a port) (T.decodeUtf8 n')+    in ServerData (T.pack $ showAddr a port) (T.decodeUtf8 n)            (case policy of                   SinglePriority _ -> fromIntegral <$> weight                   PriorityList _ -> Nothing@@ -522,25 +544,35 @@     (wt, old) <- readIORef collectedServerData     when (wt /= Unset) $ threadDelaySec $ toSec wt     let (lTTL, hTTL) = (toTTL waitOnException, toTTL maxWait)-    srv <- handleCollectErrors $-        mapConcurrently (withTimeout . collectServerData lTTL) upstreams-    let nwt = fromTTL $ max (TTL 1) $ min hTTL $ minimumTTL lTTL $ map fst srv-        new = mconcat $ map snd srv-    if new == old+    srv <- handleCollectErrors waitOnException $+        mapConcurrently (\u@UData {..} -> (hashUQuery uQuery, ) <$>+                            withTimeout responseTimeout+                                (collectServerData lTTL u)+                        ) upstreams+    let nwt = fromTTL $ max (TTL 1) $ min hTTL $ minimumTTL lTTL $+            map (fst . snd) srv+        new = HM.fromList $ map (second snd) srv+    -- FIXME: when there are multiple instances of the service, a healthy+    -- instance may overwrite a short TTL written by an unhealthy instance which+    -- causes the latter restarts later, and vice versa, an unhealthy instance+    -- may write a short TTL which causes a healthy instance restarts sooner+    if new `HM.isSubmapOf` old         then do             when (nwt /= wt) $-                modifyIORef' collectedServerData $ first $ const nwt+                atomicModifyIORef' collectedServerData $+                    (, ()) . first (const nwt)             return ""         else do-            writeIORef collectedServerData (nwt, new)-            return $ encode new+            atomicModifyIORef' collectedServerData $+                (, ()) . (const nwt *** (new `HM.union`))+            return $ encode $ M.unions $ HM.elems new     where toTTL = TTL . fromIntegral . toSec           fromTTL (TTL ttl) = Sec $ fromIntegral ttl-          handleCollectErrors = handleAny $ \e -> do-              writeIORef collectedServerData (waitOnException, M.empty)+          handleCollectErrors t = handleAny $ \e -> do+              atomicModifyIORef' collectedServerData $ (, ()) . first (const t)               throwIO e-          withTimeout act = do-              r <- timeout (toTimeout responseTimeout) act+          withTimeout t act = do+              r <- timeout (toTimeout t) act               case r of                   Nothing -> throwIO $                       userError "Collection of server data was timed out"@@ -548,7 +580,7 @@           toTimeout Unset = -1           toTimeout v = toSec v * 1e6 -ngxExportSimpleServiceTyped 'collectUpstreams ''Conf $+ngxExportSimpleServiceTyped' 'collectUpstreams ''Conf $     PersistentService Nothing  -- a list of fully qualified URLs such as 'http://../..' or 'https://../..'@@ -557,6 +589,6 @@ signalUpconf :: Upconf -> NgxExportService signalUpconf = voidHandler' . mapConcurrently_ getUrl -ngxExportSimpleServiceTyped 'signalUpconf ''Upconf $+ngxExportSimpleServiceTyped' 'signalUpconf ''Upconf $     PersistentService Nothing 

@@ -54,7 +54,7 @@ import           NgxExport.Tools.SimpleService import           NgxExport.Tools.TimeInterval -import           Network.HTTP.Client hiding (ResponseTimeout)+import           Network.HTTP.Client hiding (ResponseTimeout, path) import qualified Network.HTTP.Client (HttpExceptionContent (ResponseTimeout)) import           Network.HTTP.Client.TLS (newTlsManager) import           Network.HTTP.Client.BrReadWithTimeout@@ -212,8 +212,8 @@ -- > $ curl 'http://localhost:8010/?a=Value' -- > In backend, Custom-Header is 'Value' ----- Let's do a nasty thing. By injecting a comma into the argument /a/ we shall--- break JSON parsing.+-- Let's do a nasty thing. By injecting a double quote into the argument /a/ we+-- shall break JSON parsing. -- -- > $ curl -D- 'http://localhost:8010/?a=Value"' -- > HTTP/1.1 404 Not Found@@ -540,7 +540,7 @@ -- import           Data.ByteString (ByteString) -- import qualified Data.ByteString.Lazy as L ----- import           Network.HTTP.Client+-- import           Network.HTTP.Client hiding (path) -- import qualified Network.Socket as S -- import qualified Network.Socket.ByteString as SB -- import qualified Data.ByteString.Char8 as C8@@ -696,7 +696,7 @@ -- -- ==== A simple test ----- > $ curl -D- 'http://localhost:8010/full/?a=Value"'+-- > $ curl -D- 'http://localhost:8010/full?a=Value"' -- > HTTP/1.1 400 Bad Request -- > Server: nginx/1.17.9 -- > Date: Sat, 04 Apr 2020 12:44:36 GMT@@ -706,9 +706,10 @@ -- > -- > Bad request ----- Good. Now we see that adding a comma into a JSON field is a bad request.+-- Good. Now we see that injecting a double quote into a JSON field makes a bad+-- request. ----- > $ curl -D- 'http://localhost:8010/full/?a=Value'+-- > $ curl -D- 'http://localhost:8010/full?a=Value' -- > HTTP/1.1 500 Internal Server Error -- > Server: nginx/1.17.9 -- > Date: Sat, 04 Apr 2020 12:47:11 GMT@@ -722,7 +723,7 @@ -- argument /$arg_p/. Skipping this makes URI look unparsable -- (/http:\/\/127.0.0.1:\//) which leads to the error. ----- > $ curl -D- 'http://localhost:8010/full/?a=Value&p=8020'+-- > $ curl -D- 'http://localhost:8010/full?a=Value&p=8020' -- > HTTP/1.1 200 OK -- > Server: nginx/1.17.9 -- > Date: Sat, 04 Apr 2020 12:52:03 GMT@@ -739,7 +740,7 @@ -- -- Let's try another port. ----- > $ curl -D- 'http://localhost:8010/full/?a=Value&p=8021'+-- > $ curl -D- 'http://localhost:8010/full?a=Value&p=8021' -- > HTTP/1.1 502 Bad Gateway -- > Server: nginx/1.17.9 -- > Date: Sat, 04 Apr 2020 12:56:02 GMT@@ -883,7 +884,7 @@ -- -- ==== A simple test ----- > $ curl -D- 'http://localhost:8010/full/?a=Value&p=8020&proxy=yes'+-- > $ curl -D- 'http://localhost:8010/full?a=Value&p=8020&proxy=yes' -- > HTTP/1.1 200 OK -- > Server: nginx/1.17.9 -- > Date: Fri, 24 Jul 2020 13:14:33 GMT@@ -897,7 +898,7 @@ -- Now let's get an error message in the response after feeding a wrong port -- value. ----- > $ curl -D- 'http://localhost:8010/full/?a=Value&p=8021&proxy=yes&exc=yes'+-- > $ curl -D- 'http://localhost:8010/full?a=Value&p=8021&proxy=yes&exc=yes' -- > HTTP/1.1 502 Bad Gateway -- > Server: nginx/1.19.4 -- > Date: Mon, 14 Dec 2020 08:24:22 GMT

@@ -1,5 +1,5 @@ name:                       ngx-export-tools-extra-version:                    1.2.9.1+version:                    1.2.10 synopsis:                   More extra tools for Nginx Haskell module description:                More extra tools for         <https://github.com/lyokha/nginx-haskell-module Nginx Haskell module>.@@ -40,7 +40,7 @@                           , bytestring >= 0.10.0.0                           , base64 >= 0.3.0.0                           , ngx-export-                          , ngx-export-tools >= 1.2.3.1+                          , ngx-export-tools >= 1.2.5                           , http-types >= 0.7.0                           , http-client >= 0.5.3                           , http-client-tls >= 0.3.4@@ -55,6 +55,7 @@                           , case-insensitive                           , containers                           , unordered-containers+                          , hashable                           , array                           , text                           , safe