Improve error handling (original behaviour)

libs/wire-subsystems/src/Wire/IndexedUserStore/MigrationStore/ElasticSearch.hs

@@ -12,6 +12,7 @@ import Data.Either
 import Data.Text qualified as Text
 import Data.Text.Encoding (encodeUtf8)
 import Database.Bloodhound qualified as ES
+import Database.Bloodhound.Common.Requests qualified as ESR
 import Imports
 import Polysemy
 import Polysemy.Error
@@ -29,29 +30,30 @@ interpretIndexedUserMigrationStoreES env = interpret $ \case
 
 ensureMigrationIndexImpl :: (Member TinyLog r, Member (Embed IO) r, Member (Error MigrationException) r) => ES.BHEnv -> Sem r ()
 ensureMigrationIndexImpl env = do
-  exists <- either (\l -> logAndThrow CreateMigrationIndexFailed l) pure <$> liftIO (ES.runBH env (ES.indexExists migrationIndexName))
+  exists <-
+    either (\l -> logAndThrow CreateMigrationIndexFailed l) pure
+      <$> liftIO (ES.runBH env (ES.indexExists migrationIndexName))
   unlessM exists $ do
     Log.info $
       Log.msg (Log.val "Creating migrations index, used for tracking which migrations have run")
-    liftIO (ES.runBH env (ES.createIndexWith [] 1 migrationIndexName))
+    liftIO (ES.runBH env . ES.performBHRequest . ES.keepBHResponse $ (ESR.createIndexWith [] 1 migrationIndexName))
       >>= throwIfNotCreated CreateMigrationIndexFailed
-  liftIO (ES.runBH env (ES.putMapping @Value migrationIndexName migrationIndexMapping))
+  liftIO (ES.runBH env . ES.performBHRequest . ES.keepBHResponse $ (ESR.putMapping @Value migrationIndexName migrationIndexMapping))
     >>= throwIfNotCreated PutMappingFailed
   where
-    throwIfNotCreated :: (Member TinyLog r, Member (Error MigrationException) r) => (String -> MigrationException) -> Either ES.EsError a -> Sem r ()
-    throwIfNotCreated mkErr response =
-      -- TODO: Hopefully, it's good enough to look for errors on the left as we
-      -- don't know the structure of the right for sure...
-      case response of
-        Left e -> logAndThrow mkErr e
-        Right _ -> pure ()
+    throwIfNotCreated :: (Member TinyLog r, Member (Error MigrationException) r) => (String -> MigrationException) -> Either ES.EsError (ES.BHResponse a b, c) -> Sem r ()
+    throwIfNotCreated mkErr (Left e) = logAndThrow mkErr e
+    throwIfNotCreated mkErr (Right (resp, _)) =
+      if ES.isSuccess resp
+        then pure ()
+        else logAndThrow mkErr resp
 
-    logAndThrow :: (Member TinyLog r, Member (Error MigrationException) r) => (String -> MigrationException) -> ES.EsError -> Sem r a
-    logAndThrow mkErr response = do
+    logAndThrow :: (Member TinyLog r, Member (Error MigrationException) r, Show e) => (String -> MigrationException) -> e -> Sem r a
+    logAndThrow mkErr errMsg = do
       Log.warn $
-        Log.msg (Log.val ("An OpenSearch/ElasticSearch error appeared: " `BS.append` (encodeUtf8 . Text.pack . show) response))
+        Log.msg (Log.val ("An OpenSearch/ElasticSearch error appeared: " `BS.append` (encodeUtf8 . Text.pack . show) errMsg))
       throw $
-        mkErr (show response)
+        mkErr (show errMsg)
 
 getLatestMigrationVersionImpl :: (Member (Embed IO) r, Member (Error MigrationException) r) => ES.BHEnv -> Sem r MigrationVersion
 getLatestMigrationVersionImpl env = do