From 7fb6b8f43231d00bc7b290a25aa05c27a3ea1dd0 Mon Sep 17 00:00:00 2001 From: Tristan Cacqueray Date: Sat, 23 Dec 2023 14:05:44 +0000 Subject: [PATCH] index: encode crawler error body by the api This change also replace bytestring-base64 with the more general purpose base64 library. --- monocle.cabal | 2 +- src/Macroscope/Test.hs | 4 ++-- src/Macroscope/Worker.hs | 4 ++-- src/Monocle/Api/Jwt.hs | 6 +++--- src/Monocle/Backend/Documents.hs | 8 ++++++-- src/Monocle/Backend/Index.hs | 2 +- src/Monocle/Prelude.hs | 7 +++---- 7 files changed, 18 insertions(+), 15 deletions(-) diff --git a/monocle.cabal b/monocle.cabal index 70b2cabe3..9e29a44d7 100644 --- a/monocle.cabal +++ b/monocle.cabal @@ -120,8 +120,8 @@ library , aeson-casing , aeson-pretty , attoparsec >= 0.13 + , base64 >= 0.4 , cgroup-rts-threads - , base64-bytestring >= 1.1 , blaze-markup >= 0.8.2.8 , blaze-html >= 0.9.1.2 , binary >= 0.8 diff --git a/src/Macroscope/Test.hs b/src/Macroscope/Test.hs index dac14bb19..f30bb5c12 100644 --- a/src/Macroscope/Test.hs +++ b/src/Macroscope/Test.hs @@ -1,7 +1,7 @@ -- | Tests for the macroscope process module Macroscope.Test where -import Data.ByteString.Base64.Lazy qualified as B64 +import Data.ByteString.Lazy.Base64 qualified as B64 import Effectful.Env import Effectful.Prometheus import Effectful.Reader.Static qualified as E @@ -62,7 +62,7 @@ testCrawlingPoint = do case errorResponse of CrawlerPB.ErrorsResponse (Just (CrawlerPB.ErrorsResponseResultSuccess (CrawlerPB.ErrorsList (toList -> [e])))) -> liftIO do e.crawlerErrorMessage @?= "decode" - (B64.decode . encodeUtf8 $ e.crawlerErrorBody) @?= Right "[\"Oops\"]" + (B64.decodeBase64 . encodeUtf8 $ e.crawlerErrorBody) @?= Right "[\"Oops\"]" (from <$> e.crawlerErrorEntity) @?= Just (Project "opendev/neutron") _ -> error $ "Expected one error, got: " <> show errorResponse diff --git a/src/Macroscope/Worker.hs b/src/Macroscope/Worker.hs index 75d6af2c9..831d55400 100644 --- a/src/Macroscope/Worker.hs +++ b/src/Macroscope/Worker.hs @@ -105,8 +105,8 @@ processStream entity logFunc postFunc = go (0 :: Word) [] [] -- We got a new document let doc = case edoc of Right x -> x - Left (DecodeError ts err) -> DTError $ CrawlerError "decode" (encodeBlob err) (Just $ from ts) (Just $ from entity) - Left (GraphError ts err) -> DTError $ CrawlerError "graph" (encodeBlob err) (Just $ from ts) (Just $ from entity) + Left (DecodeError ts err) -> DTError $ CrawlerError "decode" (encodeJSON err) (Just $ from ts) (Just $ from entity) + Left (GraphError ts err) -> DTError $ CrawlerError "graph" (encodeJSON err) (Just $ from ts) (Just $ from entity) let newAcc = doc : acc if count == 499 then do diff --git a/src/Monocle/Api/Jwt.hs b/src/Monocle/Api/Jwt.hs index f46bbd23e..2f0a08c5b 100644 --- a/src/Monocle/Api/Jwt.hs +++ b/src/Monocle/Api/Jwt.hs @@ -105,7 +105,7 @@ instance FromJSON OIDCState instance ToJSON OIDCState decodeOIDCState :: ByteString -> Maybe OIDCState -decodeOIDCState bs = case B64.decode bs of +decodeOIDCState bs = case B64.decodeBase64 bs of Right json -> decode $ from json Left _ -> Nothing @@ -114,7 +114,7 @@ mkSessionStore OIDCEnv {sessionStoreStorage} stateM uriM = do let sessionStoreGenerate = do rb <- liftIO genRandomB64 let s = OIDCState (decodeUtf8 rb) uriM - pure (B64.encode $ BSL.toStrict $ encode s) + pure (B64.encodeBase64' $ BSL.toStrict $ encode s) sessionStoreSave = storeSave sessionStoreGet = storeGet sessionStoreDelete = case stateM of @@ -132,7 +132,7 @@ mkSessionStore OIDCEnv {sessionStoreStorage} stateM uriM = do -- | Generate a random fixed size string of 42 char base64 encoded genRandomB64 :: IO ByteString -genRandomB64 = B64.encode . hash <$> genRandom +genRandomB64 = B64.encodeBase64' . hash <$> genRandom -- | Generate a random fixed size string of 1024 Bytes genRandom :: IO ByteString diff --git a/src/Monocle/Backend/Documents.hs b/src/Monocle/Backend/Documents.hs index c172fc792..464b9e3bb 100644 --- a/src/Monocle/Backend/Documents.hs +++ b/src/Monocle/Backend/Documents.hs @@ -22,6 +22,7 @@ module Monocle.Backend.Documents where import Data.Aeson (Value (String), defaultOptions, genericParseJSON, genericToJSON, withObject, withText, (.:)) import Data.Aeson.Casing (aesonPrefix, snakeCase) import Data.Aeson.Types qualified +import Data.Text.Encoding.Base64 qualified as B64 import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM) import Data.Vector qualified as V import Monocle.Entity @@ -236,7 +237,7 @@ instance ToJSON EError where , ("entity_type", String (entityTypeName (from e.erEntity))) , ("entity_value", String $ entityValue e.erEntity) , ("message", String e.erMessage) - , ("body", String e.erBody) + , ("body", String (B64.encodeBase64 e.erBody)) ] instance FromJSON EError where @@ -247,7 +248,10 @@ instance FromJSON EError where etype <- v .: "entity_type" erEntity <- parseEntity evalue etype erMessage <- v .: "message" - erBody <- v .: "body" + ebody <- v .: "body" + erBody <- case B64.decodeBase64 ebody of + Right x -> pure x + Left e -> fail ("Body decode failed: " <> from e) pure EError {..} -- | Helper to encode entity diff --git a/src/Monocle/Backend/Index.hs b/src/Monocle/Backend/Index.hs index 90600dd66..ec2ff821f 100644 --- a/src/Monocle/Backend/Index.hs +++ b/src/Monocle/Backend/Index.hs @@ -632,7 +632,7 @@ upsertDocs = runAddDocsBulkOPs toBulkUpsert -- | Generate a Text suitable for ElasticSearch Document ID from Text getDocID :: Text -> Text -getDocID = decodeUtf8 . B64.encode . hash . encodeUtf8 +getDocID = B64.encodeBase64 . hash . encodeUtf8 -- | Generate an DocID from Text getBHDocID :: Text -> BH.DocId diff --git a/src/Monocle/Prelude.hs b/src/Monocle/Prelude.hs index 8a0b30b61..76941d46e 100644 --- a/src/Monocle/Prelude.hs +++ b/src/Monocle/Prelude.hs @@ -16,7 +16,7 @@ module Monocle.Prelude ( setEnv, headMaybe, (:::), - encodeBlob, + encodeJSON, -- * secret Secret, @@ -223,7 +223,6 @@ import Data.Aeson.Encode.Pretty qualified as Aeson import Data.Aeson.Key qualified as AesonKey import Data.Aeson.Lens (_Integer, _Object) import Data.Aeson.Types (Pair) -import Data.ByteString.Base64.Lazy qualified as B64 import Data.Fixed (Deci, Fixed (..), HasResolution (resolution), Pico) import Data.Map qualified as Map import Data.Tagged @@ -607,5 +606,5 @@ streamingFromListT = S.unfoldr go res <- ListT.uncons listT pure $ res `orDie` () -encodeBlob :: ToJSON a => a -> LText -encodeBlob = decodeUtf8 . B64.encode . encode +encodeJSON :: ToJSON a => a -> LText +encodeJSON = decodeUtf8 . encode