log-elasticsearch 0.10.1.0 → 0.10.2.0

raw patch · 4 files changed

+54/−25 lines, 4 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• log-elasticsearch.cabal +1/−1
• src/Log/Backend/ElasticSearch/V1.hs +25/−12
• src/Log/Backend/ElasticSearch/V5.hs +25/−12

@@ -1,3 +1,6 @@+# log-elasticsearch-0.10.2.0 (2020-02-03)+* Modify data keys in deterministic manner in case of ES insertion failure+ # log-elasticsearch-0.10.1.0 (2019-05-15) * Add a Generic instance for ElasticSearchConfig. 

@@ -1,5 +1,5 @@ name:                log-elasticsearch-version:             0.10.1.0+version:             0.10.2.0 synopsis:            Structured logging solution (Elasticsearch back end)  description:         Elasticsearch back end for the 'log' library suite.

@@ -37,7 +37,6 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import Prelude import System.IO-import TextShow import qualified Data.Aeson.Encoding as Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64@@ -144,19 +143,33 @@           $ "ElasticSearch: unexpected response: " <> jsonToBSL replyBody         Just (hasErrors, items) -> when hasErrors $ do           -- If any message failed to be inserted because of type mismatch, go-          -- back to them, replace their data with elastic search error and put-          -- old data into its own namespace to work around insertion errors.+          -- back to them, log the insertion failure and add type suffix to each+          -- of the keys in their "data" fields to work around type errors.           let failed = V.findIndices (H.member "error") items-          dummyMsgs <- V.forM failed $ \n -> do-            dataNamespace <- liftIO genRandomWord-            let modifyData oldData = object [-                    "__es_error" .= H.lookup "error" (items V.! n)-                  , "__es_modified" .= True-                  , ("__data_" <> showt dataNamespace) .= oldData-                  ]-            return . second (H.adjust modifyData "data") $ jsonMsgs V.! n+              newMsgs = (`V.map` failed) $ \n ->+                let modifyData :: Bool -> Value -> Value+                    modifyData addError (Object hm) = Object $+                      let newData = H.foldlWithKey' keyAddValueTypeSuffix H.empty hm+                      in if addError+                         then newData `H.union` H.fromList+                              [ "__es_error" .= H.lookup "error" (items V.! n)+                              , "__es_modified" .= True+                              ]+                         else newData+                    modifyData _ v = v++                    keyAddValueTypeSuffix acc k v = H.insert+                      (case v of+                          Object{} -> k <> "_object"+                          Array{}  -> k <> "_array"+                          String{} -> k <> "_string"+                          Number{} -> k <> "_number"+                          Bool{}   -> k <> "_bool"+                          Null{}   -> k <> "_null"+                      ) (modifyData False v) acc+                in second (H.adjust (modifyData True) "data") $ jsonMsgs V.! n           -- Attempt to put modified messages and ignore any further errors.-          void $ bulk (V.map (toBulk index baseID) dummyMsgs))+          void $ bulk (V.map (toBulk index baseID) newMsgs))     (elasticSearchSync indexRef)   where     mapping = MappingName esMapping

@@ -37,7 +37,6 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import Prelude import System.IO-import TextShow import qualified Data.Aeson.Encoding as Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64@@ -144,19 +143,33 @@           $ "ElasticSearch: unexpected response: " <> jsonToBSL replyBody         Just (hasErrors, items) -> when hasErrors $ do           -- If any message failed to be inserted because of type mismatch, go-          -- back to them, replace their data with elastic search error and put-          -- old data into its own namespace to work around insertion errors.+          -- back to them, log the insertion failure and add type suffix to each+          -- of the keys in their "data" fields to work around type errors.           let failed = V.findIndices (H.member "error") items-          dummyMsgs <- V.forM failed $ \n -> do-            dataNamespace <- liftIO genRandomWord-            let modifyData oldData = object [-                    "__es_error" .= H.lookup "error" (items V.! n)-                  , "__es_modified" .= True-                  , ("__data_" <> showt dataNamespace) .= oldData-                  ]-            return . second (H.adjust modifyData "data") $ jsonMsgs V.! n+              newMsgs = (`V.map` failed) $ \n ->+                let modifyData :: Bool -> Value -> Value+                    modifyData addError (Object hm) = Object $+                      let newData = H.foldlWithKey' keyAddValueTypeSuffix H.empty hm+                      in if addError+                         then newData `H.union` H.fromList+                              [ "__es_error" .= H.lookup "error" (items V.! n)+                              , "__es_modified" .= True+                              ]+                         else newData+                    modifyData _ v = v++                    keyAddValueTypeSuffix acc k v = H.insert+                      (case v of+                          Object{} -> k <> "_object"+                          Array{}  -> k <> "_array"+                          String{} -> k <> "_string"+                          Number{} -> k <> "_number"+                          Bool{}   -> k <> "_bool"+                          Null{}   -> k <> "_null"+                      ) (modifyData False v) acc+                in second (H.adjust (modifyData True) "data") $ jsonMsgs V.! n           -- Attempt to put modified messages and ignore any further errors.-          void $ bulk (V.map (toBulk index baseID) dummyMsgs))+          void $ bulk (V.map (toBulk index baseID) newMsgs))     (elasticSearchSync indexRef)   where     mapping = MappingName esMapping