index: encode crawler error body by the api

This change also replace bytestring-base64 with the
more general purpose base64 library.

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

src/Macroscope/Test.hs

@@ -1,7 +1,6 @@
 -- | Tests for the macroscope process
 module Macroscope.Test where
 
-import Data.ByteString.Base64.Lazy qualified as B64
 import Effectful.Env
 import Effectful.Prometheus
 import Effectful.Reader.Static qualified as E
@@ -62,7 +61,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\"]"
+          e.crawlerErrorBody @?= "[\"Oops\"]"
           (from <$> e.crawlerErrorEntity) @?= Just (Project "opendev/neutron")
         _ -> error $ "Expected one error, got: " <> show errorResponse
 

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

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

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

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

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