diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# log-elasticsearch-0.12.2.0 (2022-04-04) +* Add support for aeson 2.0.1.0. +* Add support for GHC 9.2. +* Drop support for GHC 8.0 and 8.2. + # log-elasticsearch-0.12.1.1 (2021-10-11) * Make compatible with log-base-0.11.0.0. diff --git a/log-elasticsearch.cabal b/log-elasticsearch.cabal --- a/log-elasticsearch.cabal +++ b/log-elasticsearch.cabal @@ -1,5 +1,5 @@ name: log-elasticsearch -version: 0.12.1.1 +version: 0.12.2.0 synopsis: Structured logging solution (Elasticsearch back end) description: Elasticsearch back end for the 'log' library suite. @@ -18,8 +18,7 @@ build-type: Simple cabal-version: >=1.10 extra-source-files: CHANGELOG.md, README.md -tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.4 - || ==9.0.1 +tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.2 Source-repository head Type: git @@ -29,8 +28,8 @@ exposed-modules: Log.Backend.ElasticSearch Log.Backend.ElasticSearch.Internal Log.Backend.ElasticSearch.Lens - build-depends: base >= 4.8 && <5, - aeson >=1.0.0.0 && <1.6, + build-depends: base >= 4.13 && <5, + aeson >= 1.0, aeson-pretty >=0.8.2, base64-bytestring, bytestring, diff --git a/src/Log/Backend/ElasticSearch.hs b/src/Log/Backend/ElasticSearch.hs --- a/src/Log/Backend/ElasticSearch.hs +++ b/src/Log/Backend/ElasticSearch.hs @@ -29,7 +29,6 @@ import Log.Internal.Logger import Network.HTTP.Client import Prelude -import qualified Data.HashMap.Strict as H import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL @@ -38,6 +37,7 @@ import qualified Data.Vector as V import Log.Backend.ElasticSearch.Internal +import qualified Log.Internal.Aeson.Compat as AC ---------------------------------------- -- | Create an 'elasticSearchLogger' for the duration of the given @@ -111,15 +111,15 @@ let newMsgs = let modifyData :: Maybe Value -> Value -> Value modifyData merr (Object hm) = Object $ - let newData = H.foldlWithKey' keyAddValueTypeSuffix H.empty hm + let newData = AC.foldrWithKey keyAddValueTypeSuffix AC.empty hm in case merr of -- We have the error message, i.e. we're at the top -- level object, so add it to the data. - Just err -> newData `H.union` H.singleton "__es_error" err + Just err -> newData `AC.union` AC.singleton "__es_error" err Nothing -> newData modifyData _ v = v - keyAddValueTypeSuffix acc k v = H.insert + keyAddValueTypeSuffix k v acc = AC.insert (case v of Object{} -> k <> "_object" Array{} -> k <> "_array" @@ -154,25 +154,28 @@ -> Maybe (Bool, V.Vector Object) checkForBulkErrors jsonMsgs replyBody = do Object response <- pure replyBody - Bool hasErrors <- "errors" `H.lookup` response - Array jsonItems <- "items" `H.lookup` response + Bool hasErrors <- "errors" `AC.lookup` response + Array jsonItems <- "items" `AC.lookup` response items <- F.forM jsonItems $ \v -> do Object item <- pure v - Object index_ <- "index" `H.lookup` item + Object index_ <- "index" `AC.lookup` item -- ES <= 2.x returns 'create' for some reason, so consider both. - <|> "create" `H.lookup` item + <|> "create" `AC.lookup` item pure index_ guard $ V.length items == V.length jsonMsgs pure (hasErrors, items) adjustFailedMessagesWith :: (Maybe err -> obj -> obj) - -> V.Vector (H.HashMap T.Text obj) - -> V.Vector (H.HashMap T.Text err) - -> V.Vector (H.HashMap T.Text obj) + -> V.Vector (AC.KeyMap obj) + -> V.Vector (AC.KeyMap err) + -> V.Vector (AC.KeyMap obj) adjustFailedMessagesWith f jsonMsgs responses = - let failed = V.imapMaybe (\n item -> (n, ) <$> "error" `H.lookup` item) responses - in (`V.map` failed) $ \(n, err) -> H.adjust (f $ Just err) "data" $ jsonMsgs V.! n + let failed = V.imapMaybe (\n item -> (n, ) <$> "error" `AC.lookup` item) responses + adjust act key m = case AC.lookup key m of + Nothing -> m + Just v -> AC.insert key (act v) m + in (`V.map` failed) $ \(n, err) -> adjust (f $ Just err) "data" $ jsonMsgs V.! n printEsError msg body = T.putStrLn $ "elasticSearchLogger: " <> msg <> " " <> prettyJson body @@ -194,7 +197,7 @@ . T.toLazyText . encodePrettyToTextBuilder' defConfig { confIndent = Spaces 2 } - toJsonMsg :: LogMessage -> H.HashMap T.Text Value + toJsonMsg :: LogMessage -> Object toJsonMsg msg = let Object jMsg = toJSON msg in jMsg ---------------------------------------- diff --git a/src/Log/Backend/ElasticSearch/Internal.hs b/src/Log/Backend/ElasticSearch/Internal.hs --- a/src/Log/Backend/ElasticSearch/Internal.hs +++ b/src/Log/Backend/ElasticSearch/Internal.hs @@ -34,11 +34,11 @@ import Prelude import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Lazy.Char8 as BSL -import qualified Data.HashMap.Strict as H import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Vector as V +import qualified Log.Internal.Aeson.Compat as AC -- | Configuration for the Elasticsearch 'Logger'. See -- @@ -86,8 +86,8 @@ parseEsVersion :: Value -> Maybe EsVersion parseEsVersion js = do Object props <- pure js - Object version <- "version" `H.lookup` props - String number <- "number" `H.lookup` version + Object version <- "version" `AC.lookup` props + String number <- "number" `AC.lookup` version [v1, v2, v3] <- mapM (maybeRead . T.unpack) $ T.splitOn "." number pure $ EsVersion v1 v2 v3 where @@ -130,7 +130,7 @@ ] , "mappings" .= if version >= esV7 then logsMapping - else object [ esMapping .= logsMapping ] + else object [ AC.fromText esMapping .= logsMapping ] ] where logsMapping = object @@ -170,7 +170,7 @@ -> EsEnv -> ElasticSearchConfig -> T.Text - -> V.Vector (H.HashMap T.Text Value) + -> V.Vector Object -> IO (Response Value) bulkIndex version env conf index objs = do dispatch env methodPost route . Just . BSB.toLazyByteString $ foldMap ixOp objs