Made EsProtocolException more helpful

src/Bloodhound/Import.hs

@@ -79,3 +79,6 @@ deleteSeveral ks hm = foldr HM.delete hm ks
 oPath :: ToJSON a => NonEmpty Text -> a -> Value
 oPath (k :| []) v   = object [k .= v]
 oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
+
+tshow :: Show a => a -> Text
+tshow = T.pack . show

src/Database/V5/Bloodhound/Client.hs

@@ -639,19 +639,24 @@ existentialQuery url = do
 -- categories. If they don't, a 'EsProtocolException' will be
 -- thrown. If you encounter this, please report the full body it
 -- reports along with your Elasticsearch verison.
-parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
+parseEsResponse :: ( MonadThrow m
+                   , FromJSON a
+                   )
+                => Reply
                 -> m (Either EsError a)
 parseEsResponse reply
   | respIsTwoHunna reply = case eitherDecode body of
                              Right a -> return (Right a)
-                             Left _ -> tryParseError
+                             Left err ->
-  | otherwise = tryParseError
+                               tryParseError err
+  | otherwise = tryParseError "Non-200 status code"
   where body = responseBody reply
-        tryParseError = case eitherDecode body of
+        tryParseError originalError
-                          Right e -> return (Left e)
+          = case eitherDecode body of
-                          -- this case should not be possible
+              Right e -> return (Left e)
-                          Left _ -> explode
+              -- Failed to parse the error message.
-        explode = throwM (EsProtocolException body)
+              Left err -> explode ("Original error was: " <> originalError <> " Error parse failure was: " <> err)
+        explode errorMsg = throwM (EsProtocolException (T.pack errorMsg) body)
 
 -- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
 --   in IO
@@ -711,16 +716,15 @@ listIndices =
   parse . responseBody =<< get =<< url
   where
     url = joinPath ["_cat/indices?format=json"]
-    parse body = maybe (throwM (EsProtocolException body)) return $ do
+    parse body = either (\msg -> (throwM (EsProtocolException (T.pack msg) body))) return $ do
-      vals <- decode body
+      vals <- eitherDecode body
       forM vals $ \val ->
         case val of
-          Object obj -> do
+          Object obj ->
-            indexVal <- HM.lookup "index" obj
+            case HM.lookup "index" obj of
-            case indexVal of
+              (Just (String txt)) -> Right (IndexName txt)
-              String txt -> Just (IndexName txt)
+              v -> Left $ "indexVal in listIndices failed on non-string, was: " <> show v
-              _ -> Nothing
+          v -> Left $ "One of the values parsed in listIndices wasn't an object, it was: " <> show v
-          _ -> Nothing
 
 -- | 'updateIndexAliases' updates the server's index alias
 -- table. Operations are atomic. Explained in further detail at

src/Database/V5/Bloodhound/Internal/Client.hs

@@ -693,8 +693,9 @@ sure that your mappings are correct, then this error may be an indication of an
 incompatibility between Bloodhound and Elasticsearch. Please open a bug report
 and be sure to include the exception body.
 -}
-newtype EsProtocolException = EsProtocolException
+data EsProtocolException = EsProtocolException
-  { esProtoExBody :: LByteString
+  { esProtoExMessage :: !Text
+  , esProtoExBody :: !LByteString
   } deriving (Eq, Show)
 
 instance Exception EsProtocolException