Add JSON decoding failure type with bytes

flipstone · May 6, 2024 · 8aaa386 · 8aaa386
1 parent 3ac6574
commit 8aaa386
Show file tree

Hide file tree

Showing 156 changed files with 333 additions and 318 deletions.
diff --git a/json-fleece-aeson-beeline/src/Fleece/Aeson/Beeline.hs b/json-fleece-aeson-beeline/src/Fleece/Aeson/Beeline.hs
@@ -2,9 +2,11 @@
 
 module Fleece.Aeson.Beeline
   ( JSON (JSON)
+  , JSONDecodingError (..)
   ) where
 
 import qualified Beeline.HTTP.Client as BHC
+import qualified Control.Exception as Exc
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS8
 import qualified Data.ByteString.Lazy as LBS
@@ -18,6 +20,14 @@ import qualified Fleece.Aeson as FA
 data JSON
   = JSON
 
+data JSONDecodingError = JSONDecodingError
+  { jsonDecodingErrorBytes :: BS.ByteString
+  , jsonDecodingErrorMessage :: String
+  }
+  deriving (Show)
+
+instance Exc.Exception JSONDecodingError
+
 instance BHC.ContentTypeEncoder JSON where
   type EncodeSchema JSON = FA.Encoder
 
@@ -29,16 +39,18 @@ instance BHC.ContentTypeEncoder JSON where
 
 instance BHC.ContentTypeDecoder JSON where
   type DecodeSchema JSON = FA.Decoder
-  type DecodingError JSON = BHC.ContentTypeDecodingError
+  type DecodingError JSON = JSONDecodingError
 
   toResponseContentType JSON _ =
     jsonContentType
 
   parseResponse JSON schema reader = do
-    bytes <- HTTP.brConsume reader
+    chunks <- HTTP.brConsume reader
+    let
+      bytes = LBS.fromChunks chunks
     pure $
-      case FA.decode schema (LBS.fromChunks bytes) of
-        Left err -> Left (BHC.ContentTypeDecodingError err)
+      case FA.decode schema bytes of
+        Left err -> Left JSONDecodingError {jsonDecodingErrorBytes = BS.toStrict bytes, jsonDecodingErrorMessage = err}
         Right response -> Right response
 
 jsonContentType :: BS.ByteString

diff --git a/json-fleece-codegen-util/src/Fleece/CodeGenUtil.hs b/json-fleece-codegen-util/src/Fleece/CodeGenUtil.hs
@@ -748,7 +748,7 @@ generateOperationCode typeMap codeGenOperation = do
       HC.lines
         . (HC.indent 2 beelineOperation :)
         $ fmap (HC.indent 4)
-        $ [ beelineContentTypeDecodingError
+        $ [ fleeceJSONDecodingError
           , pathParamsTypeNameAsCode
           , maybe
               beelineNoQueryParams
@@ -883,7 +883,7 @@ generateOperationCode typeMap codeGenOperation = do
             <> ", "
             <> beelineResponseBodySchema
             <> " "
-            <> beelineContentTypeDecodingError
+            <> fleeceJSONDecodingError
             <> " "
             <> HC.typeNameToCode Nothing responsesTypeName
             <> ")]"
@@ -2055,6 +2055,10 @@ fleeceAesonBeelineConstructor =
     . HC.varNameToCodeDefaultQualification
     . HC.toConstructorVarName "Fleece.Aeson.Beeline" (Just "FA")
 
+fleeceJSONDecodingError :: HC.FromCode c => c
+fleeceJSONDecodingError =
+  fleeceAesonBeelineConstructor "JSONDecodingError"
+
 methodToBeelineFunction :: HC.FromCode c => T.Text -> CodeGen c
 methodToBeelineFunction method =
   fmap beelineRoutingVar $
@@ -2243,10 +2247,6 @@ beelineAnyStatus :: HC.FromCode c => c
 beelineAnyStatus =
   beelineHTTPConstructor "AnyStatus"
 
-beelineContentTypeDecodingError :: HC.FromCode c => c
-beelineContentTypeDecodingError =
-  beelineHTTPConstructor "ContentTypeDecodingError"
-
 beelineStatusRange :: HC.FromCode c => c
 beelineStatusRange =
   beelineHTTPType "StatusRange"

diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Animal.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Animal.hs
@@ -23,7 +23,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -59,7 +59,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON AnimalFullResponse.animalFullResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))

diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Animal/Search/GET.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Animal/Search/GET.hs
@@ -24,7 +24,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -63,7 +63,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON AnimalBaseResponse.animalBaseResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))

diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Animal/Search/POST.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Animal/Search/POST.hs
@@ -24,7 +24,7 @@ import qualified StarTrek.Types.AnimalBaseResponse as AnimalBaseResponse
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -64,7 +64,7 @@ data Responses
   = Response200 AnimalBaseResponse.AnimalBaseResponse
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON AnimalBaseResponse.animalBaseResponseSchema))
   ]
diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/AstronomicalObject.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/AstronomicalObject.hs
@@ -23,7 +23,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -59,7 +59,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON AstronomicalObjectFullResponse.astronomicalObjectFullResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))

diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/AstronomicalObject/Search/GET.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/AstronomicalObject/Search/GET.hs
@@ -24,7 +24,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -63,7 +63,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON AstronomicalObjectBaseResponse.astronomicalObjectBaseResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))

diff --git a/...-fleece-openapi3/examples/star-trek/StarTrek/Operations/AstronomicalObject/Search/POST.hs b/...-fleece-openapi3/examples/star-trek/StarTrek/Operations/AstronomicalObject/Search/POST.hs
@@ -24,7 +24,7 @@ import qualified StarTrek.Types.AstronomicalObjectBaseResponse as AstronomicalOb
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -64,7 +64,7 @@ data Responses
   = Response200 AstronomicalObjectBaseResponse.AstronomicalObjectBaseResponse
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON AstronomicalObjectBaseResponse.astronomicalObjectBaseResponseSchema))
   ]
diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Book.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Book.hs
@@ -23,7 +23,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -59,7 +59,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON BookFullResponse.bookFullResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))

diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Book/Search/GET.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Book/Search/GET.hs
@@ -24,7 +24,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -63,7 +63,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON BookBaseResponse.bookBaseResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))

diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Book/Search/POST.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Book/Search/POST.hs
@@ -24,7 +24,7 @@ import qualified StarTrek.Types.BookBaseResponse as BookBaseResponse
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -64,7 +64,7 @@ data Responses
   = Response200 BookBaseResponse.BookBaseResponse
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON BookBaseResponse.bookBaseResponseSchema))
   ]
diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookCollection.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookCollection.hs
@@ -23,7 +23,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -59,7 +59,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON BookCollectionFullResponse.bookCollectionFullResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))

diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookCollection/Search/GET.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookCollection/Search/GET.hs
@@ -24,7 +24,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -63,7 +63,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON BookCollectionBaseResponse.bookCollectionBaseResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))

diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookCollection/Search/POST.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookCollection/Search/POST.hs
@@ -24,7 +24,7 @@ import qualified StarTrek.Types.BookCollectionBaseResponse as BookCollectionBase
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -64,7 +64,7 @@ data Responses
   = Response200 BookCollectionBaseResponse.BookCollectionBaseResponse
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON BookCollectionBaseResponse.bookCollectionBaseResponseSchema))
   ]
diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookSeries.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookSeries.hs
@@ -23,7 +23,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -59,7 +59,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON BookSeriesFullResponse.bookSeriesFullResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))

diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookSeries/Search/GET.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookSeries/Search/GET.hs
@@ -24,7 +24,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -63,7 +63,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON BookSeriesBaseResponse.bookSeriesBaseResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))

diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookSeries/Search/POST.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/BookSeries/Search/POST.hs
@@ -24,7 +24,7 @@ import qualified StarTrek.Types.BookSeriesBaseResponse as BookSeriesBaseResponse
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -64,7 +64,7 @@ data Responses
   = Response200 BookSeriesBaseResponse.BookSeriesBaseResponse
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON BookSeriesBaseResponse.bookSeriesBaseResponseSchema))
   ]
diff --git a/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Character.hs b/json-fleece-openapi3/examples/star-trek/StarTrek/Operations/Character.hs
@@ -23,7 +23,7 @@ import qualified StarTrek.Types.Error as Error
 
 operation ::
   H.Operation
-    H.ContentTypeDecodingError
+    FA.JSONDecodingError
     H.NoPathParams
     QueryParams
     H.NoHeaderParams
@@ -59,7 +59,7 @@ data Responses
   | OtherResponse Error.Error
   deriving (Eq, Show)
 
-responseSchemas :: [(H.StatusRange, H.ResponseBodySchema H.ContentTypeDecodingError Responses)]
+responseSchemas :: [(H.StatusRange, H.ResponseBodySchema FA.JSONDecodingError Responses)]
 responseSchemas =
   [ (H.Status 200, fmap Response200 (H.responseBody FA.JSON CharacterFullResponse.characterFullResponseSchema))
   , (H.AnyStatus, fmap OtherResponse (H.responseBody FA.JSON Error.errorSchema))