revert Json use for hits

Author: blackheaven

src/Database/Bloodhound/Raw.hs

@@ -24,8 +24,11 @@ import Data.Text qualified as T
 import Data.Vector qualified as V
 import Database.Bloodhound qualified as BH
 import Database.Bloodhound.Common.Requests qualified as Query
+import Json.Extras qualified as Json
 import Monocle.Prelude
+import Network.HTTP.Client qualified as HTTP
 import Network.HTTP.Types.Method qualified as HTTP
+import Network.HTTP.Types.Status qualified as HTTP
 
 data ScrollRequest = NoScroll | GetScroll ByteString
 
@@ -76,13 +79,28 @@ search index payload scrollRequest = do
 -- | A special purpose search implementation that uses the faster json-syntax
 searchHit ::
   MonadBH m =>
-  Aeson.FromJSON a =>
+  (Json.Value -> Either Text a) ->
   BH.IndexName ->
   BH.Search ->
-  m (BH.SearchResult a)
-searchHit index payload = do
-  let query = Query.searchByIndex index payload
-  resp <- BH.tryEsError $ BH.performBHRequest query
+  m [a]
+searchHit parseHit index payload = do
+  let query = Query.searchByIndex @Value index payload
+  resp <-
+    BH.tryEsError $
+    BH.performBHRequest @_ @BH.StatusIndependant query {
+      BH.bhRequestParser = \(BH.BHResponse rawResp) ->
+        let
+          decodeHits :: Json.Value -> Maybe [Json.Value]
+          decodeHits value = do
+            hits <- Json.getAttr "hits" =<< Json.getAttr "hits" value
+            fmap getSource <$> Json.getArray hits
+          getSource value = case Json.getAttr "_source" value of
+            Nothing -> error $ "No source found in: " <> show value
+            Just v -> v
+        in case decodeHits (Json.decodeThrow $ HTTP.responseBody rawResp) of
+            Just xs -> pure $ first (BH.EsError $ Just $ HTTP.statusCode $ HTTP.responseStatus rawResp) $ traverse parseHit xs
+            Nothing -> error $ "Could not find hits in " <> show rawResp
+    }
   case resp of
     Right xs -> pure xs
     Left e -> throwEsError "Could not find hits" e

src/Monocle/Backend/Queries.hs

@@ -64,11 +64,11 @@ doAdvanceScrollBH scroll = do
   measureQueryM (Aeson.object ["scrolling" .= ("advancing..." :: Text)]) do
     esAdvance scroll
 
-doSearchHitBH :: QEffects es => FromJSON a => BH.Search -> Eff es (BH.SearchResult a)
-doSearchHitBH payload = do
+doSearchHitBH :: QEffects es => (Json.Value -> Either Text a) -> BH.Search -> Eff es [a]
+doSearchHitBH parseHit payload = do
   measureQueryM payload do
     index <- getIndexName
-    esSearchHit index payload
+    esSearchHit parseHit index payload
 
 -- | Call the count endpoint
 doCountBH :: QEffects es => BH.Query -> Eff es Count
@@ -156,10 +156,11 @@ doSearch orderM limit = do
     SearchPB.Order_DirectionDESC -> BH.Descending
 
 -- | Get search results hits, as fast as possible
-doFastSearch :: QEffects es => FromJSON a => Word32 -> Eff es (BH.SearchResult a)
-doFastSearch limit = do
+doFastSearch :: QEffects es => (Json.Value -> Either Text a) -> Word32 -> Eff es [a]
+doFastSearch parseHit limit = do
   query <- getQueryBH
   doSearchHitBH
+    parseHit
     (BH.mkSearch query Nothing)
       { BH.size = BH.Size $ fromInteger $ toInteger $ max 50 limit
       }
@@ -448,14 +449,13 @@ data JsonChangeEvent = JsonChangeEvent
   , jceAuthor :: Json.ShortText
   }
 
-instance FromJSON JsonChangeEvent where
-  parseJSON =
-    Aeson.withObject "JsonChangeEvent" $ \o ->
-      JsonChangeEvent
-        <$> (o .: "created_at")
-        <*> (o .: "on_created_at")
-        <*> (o .: "change_id")
-        <*> ((.: "muid") =<< o .: "author")
+decodeJsonChangeEvent :: Json.Value -> Maybe JsonChangeEvent
+decodeJsonChangeEvent v = do
+  jceCreatedAt <- Json.getDate =<< Json.getAttr "created_at" v
+  jceOnCreatedAt <- Json.getDate =<< Json.getAttr "on_created_at" v
+  jceChangeId <- Json.getString =<< Json.getAttr "change_id" v
+  jceAuthor <- Json.getString =<< Json.getAttr "muid" =<< Json.getAttr "author" v
+  pure $ JsonChangeEvent {..}
 
 firstEventDuration :: FirstEvent -> Pico
 firstEventDuration FirstEvent {..} = elapsedSeconds feChangeCreatedAt feCreatedAt
@@ -468,7 +468,7 @@ firstEventOnChanges = do
   (minDate, _) <- getQueryBound
 
   -- Collect all the events
-  result <- mapMaybe BH.hitSource . BH.hits . BH.searchHits <$> doFastSearch 10000
+  result <- catMaybes <$> doFastSearch (Right . decodeJsonChangeEvent) 10000
 
   -- Group by change_id
   let changeMap :: [NonEmpty JsonChangeEvent]

src/Monocle/Effects.hs

@@ -62,6 +62,7 @@ import Control.Exception (finally, throwIO)
 import Control.Exception.Base (ErrorCall (ErrorCall))
 import Control.Monad.Catch (catches)
 import Data.Text qualified as T
+import Json.Extras qualified as Json
 import Monocle.Client qualified
 import Monocle.Config qualified
 import Network.HTTP.Client (HttpException (..))
@@ -466,17 +467,17 @@ esAdvance :: (Error ElasticError :> es, ElasticEffect :> es, FromJSON resp) => B
 esAdvance scroll = do
   runBHIOSafe "esAdvance" scroll $ BHR.advance scroll
 
-esGetDocument :: (Error ElasticError :> es, ElasticEffect :> es) =>  FromJSON a => BH.IndexName -> BH.DocId -> Eff es (Either BH.EsError (BH.EsResult a))
+esGetDocument :: (Error ElasticError :> es, ElasticEffect :> es) => FromJSON a => BH.IndexName -> BH.DocId -> Eff es (Either BH.EsError (BH.EsResult a))
 esGetDocument iname doc = do
   runBHIOUnsafe "esGetDocument" doc $ BH.getDocument iname doc
 
 esCountByIndex :: (Error ElasticError :> es, ElasticEffect :> es) => BH.IndexName -> BH.CountQuery -> Eff es (Either BH.EsError BH.CountResponse)
 esCountByIndex iname q = do
   runBHIOUnsafe "esCountByIndex" q $ BH.countByIndex iname q
 
-esSearchHit :: (Error ElasticError :> es, ElasticEffect :> es) => FromJSON a =>  BH.IndexName -> BH.Search -> Eff es (BH.SearchResult a)
-esSearchHit iname payload = do
-  runBHIOSafe "esSearchHit" payload $ BHR.searchHit iname payload
+esSearchHit :: (Error ElasticError :> es, ElasticEffect :> es) => (Json.Value -> Either Text a) -> BH.IndexName -> BH.Search -> Eff es [a]
+esSearchHit parseHit iname payload = do
+  runBHIOSafe "esSearchHit" payload $ BHR.searchHit parseHit iname payload
 
 esScanSearch :: (Error ElasticError :> es, ElasticEffect :> es) => FromJSON body => BH.IndexName -> BH.Search -> Eff es [BH.Hit body]
 esScanSearch iname search = do