From 4392e81e3d6d068eef4712fa2f69c0e084f44408 Mon Sep 17 00:00:00 2001
From: mirokuratczyk <miro.kuratczyk@gmail.com>
Date: Mon, 6 Apr 2020 17:52:27 -0400
Subject: [PATCH] Fix decodeUtf8

Use decodeUtf8' so MonadFail can be utilized.
This makes decoding errors easier to trace.
---
 Data/Bson/Binary.hs | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/Data/Bson/Binary.hs b/Data/Bson/Binary.hs
index 87f30ad..336b1b4 100644
--- a/Data/Bson/Binary.hs
+++ b/Data/Bson/Binary.hs
@@ -139,7 +139,12 @@ putCString x = do
   putWord8 0
 
 getCString :: Get Text
-getCString = TE.decodeUtf8 . SC.concat . LC.toChunks <$> getLazyByteStringNul
+getCString = do
+  b <- SC.concat . LC.toChunks <$> getLazyByteStringNul
+  case TE.decodeUtf8' b of
+    Left err -> 
+      fail $ "Data.Bson.Binary.getCString: decodeUtf8 failed: " ++ show err
+    Right x -> return x
 
 putString :: Text -> Put
 putString x = let b = TE.encodeUtf8 x in do
@@ -152,7 +157,10 @@ getString = do
   len <- subtract 1 <$> getInt32
   b <- getByteString (fromIntegral len)
   getWord8
-  return $ TE.decodeUtf8 b
+  case TE.decodeUtf8' b of
+    Left err -> 
+      fail $ "Data.Bson.Binary.getString: decodeUtf8 failed: " ++ show err
+    Right x -> return x
 
 putDocument :: Document -> Put
 putDocument es = let b = runPut (mapM_ putField es) in do