Capture response format decode failures in the response

Previously this would have caused the whole request to fail, obscuring
any kind of response information we did receive (status code, etc).

Author: garyb

README.md

@@ -34,12 +34,13 @@ import Data.Argonaut.Core as J
 import Data.Either (Either(..))
 import Data.HTTP.Method (Method(..))
 import Effect.Aff (launchAff)
-import Effect.Class (liftEffect)
-import Effect.Console (log)
+import Effect.Class.Console (log)
 
 main = launchAff $ do
   res <- AX.request ResponseFormat.json (AX.defaultRequest { url = "/api", method = Left GET })
-  liftEffect $ log $ "GET /api response: " <> J.stringify res.response
+  case res.body of
+    Left err -> log $ "GET /api response failed to decode: " <> AX.printResponseFormatError err
+    Right json -> log $ "GET /api response: " <> J.stringify json
 ```
 
 (`defaultRequest` is a record value that has all the required fields pre-set for convenient overriding when making a request.)
@@ -51,10 +52,14 @@ import Affjax.RequestBody as RequestBody
 
 main = launchAff $ do
   res1 <- AX.get ResponseFormat.json "/api"
-  liftEffect $ log $ "GET /api response: " <> J.stringify res1.response
+  case res1.body of
+    Left err -> log $ "GET /api response failed to decode: " <> AX.printResponseFormatError err
+    Right json -> log $ "GET /api response: " <> J.stringify json
 
   res2 <- AX.post ResponseFormat.json "/api" (RequestBody.json (J.fromString "test"))
-  liftEffect $ log $ "POST /api response: " <> J.stringify res2.response
+  case res2.body of
+    Left err -> log $ "POST /api response failed to decode: " <> AX.printResponseFormatError err
+    Right json -> log $ "POST /api response: " <> J.stringify json
 ```
 
 See the module documentation for a full list of these helpers.

src/Affjax.js

@@ -68,7 +68,7 @@ exports._ajax = function () {
               var i = header.indexOf(":");
               return mkHeader(header.substring(0, i))(header.substring(i + 2));
             }),
-          response: platformSpecific.getResponse(xhr)
+          body: platformSpecific.getResponse(xhr)
         });
       };
       xhr.responseType = options.responseType;

src/Affjax.purs

@@ -12,12 +12,14 @@ module Affjax
   , RetryPolicy(..)
   , defaultRetryPolicy
   , retry
+  , module Affjax.ResponseFormat
   ) where
 
 import Prelude
 
 import Affjax.RequestBody as RequestBody
 import Affjax.RequestHeader (RequestHeader(..), requestHeaderName, requestHeaderValue)
+import Affjax.ResponseFormat (ResponseFormatError(..), printResponseFormatError)
 import Affjax.ResponseFormat as ResponseFormat
 import Affjax.ResponseHeader (ResponseHeader, responseHeader)
 import Affjax.StatusCode (StatusCode(..))
@@ -26,7 +28,6 @@ import Control.Parallel (parOneOf)
 import Data.Argonaut.Core (Json)
 import Data.Argonaut.Core as J
 import Data.Argonaut.Parser (jsonParser)
-import Data.Array (intercalate)
 import Data.Array as Arr
 import Data.Either (Either(..), either)
 import Data.Foldable (any)
@@ -36,6 +37,7 @@ import Data.Function.Uncurried (Fn2, runFn2)
 import Data.HTTP.Method (Method(..), CustomMethod)
 import Data.HTTP.Method as Method
 import Data.Int (toNumber)
+import Data.List.NonEmpty as NEL
 import Data.Maybe (Maybe(..))
 import Data.Nullable (Nullable, toNullable)
 import Data.Time.Duration (Milliseconds(..))
@@ -44,7 +46,7 @@ import Effect.Aff.Compat as AC
 import Effect.Class (liftEffect)
 import Effect.Exception (Error, error)
 import Effect.Ref as Ref
-import Foreign (F, Foreign, ForeignError(..), fail, renderForeignError, unsafeReadTagged, unsafeToForeign)
+import Foreign (F, Foreign, ForeignError(..), fail, unsafeReadTagged, unsafeToForeign)
 import Math as Math
 
 -- | A record that contains all the information to perform an HTTP request.
@@ -87,77 +89,77 @@ type Response a =
   { status :: StatusCode
   , statusText :: String
   , headers :: Array ResponseHeader
-  , response :: a
+  , body :: a
   }
 
 -- | Type alias for URL strings to aid readability of types.
 type URL = String
 
 -- | Makes a `GET` request to the specified URL.
-get :: forall a. ResponseFormat.ResponseFormat a -> URL -> Aff (Response a)
+get :: forall a. ResponseFormat.ResponseFormat a -> URL -> Aff (Response (Either ResponseFormatError a))
 get rt u = request rt $ defaultRequest { url = u }
 
 -- | Makes a `POST` request to the specified URL, sending data.
-post :: forall a. ResponseFormat.ResponseFormat a -> URL -> RequestBody.RequestBody -> Aff (Response a)
+post :: forall a. ResponseFormat.ResponseFormat a -> URL -> RequestBody.RequestBody -> Aff (Response (Either ResponseFormatError a))
 post rt u c = request rt $ defaultRequest { method = Left POST, url = u, content = Just c }
 
 -- | Makes a `POST` request to the specified URL with the option to send data.
-post' :: forall a. ResponseFormat.ResponseFormat a -> URL -> Maybe RequestBody.RequestBody -> Aff (Response a)
+post' :: forall a. ResponseFormat.ResponseFormat a -> URL -> Maybe RequestBody.RequestBody -> Aff (Response (Either ResponseFormatError a))
 post' rt u c = request rt $ defaultRequest { method = Left POST, url = u, content = c }
 
 -- | Makes a `POST` request to the specified URL, sending data and ignoring the
 -- | response.
 post_ :: URL -> RequestBody.RequestBody -> Aff (Response Unit)
-post_ = post ResponseFormat.ignore
+post_ url = map (_ { body = unit }) <<< post ResponseFormat.ignore url
 
 -- | Makes a `POST` request to the specified URL with the option to send data,
 -- | and ignores the response.
 post_' :: URL -> Maybe RequestBody.RequestBody -> Aff (Response Unit)
-post_' = post' ResponseFormat.ignore
+post_' url = map (_ { body = unit }) <<< post' ResponseFormat.ignore url
 
 -- | Makes a `PUT` request to the specified URL, sending data.
-put :: forall a. ResponseFormat.ResponseFormat a -> URL -> RequestBody.RequestBody -> Aff (Response a)
+put :: forall a. ResponseFormat.ResponseFormat a -> URL -> RequestBody.RequestBody -> Aff (Response (Either ResponseFormatError a))
 put rt u c = request rt $ defaultRequest { method = Left PUT, url = u, content = Just c }
 
 -- | Makes a `PUT` request to the specified URL with the option to send data.
-put' :: forall a. ResponseFormat.ResponseFormat a -> URL -> Maybe RequestBody.RequestBody -> Aff (Response a)
+put' :: forall a. ResponseFormat.ResponseFormat a -> URL -> Maybe RequestBody.RequestBody -> Aff (Response (Either ResponseFormatError a))
 put' rt u c = request rt $ defaultRequest { method = Left PUT, url = u, content = c }
 
 -- | Makes a `PUT` request to the specified URL, sending data and ignoring the
 -- | response.
 put_ :: URL -> RequestBody.RequestBody -> Aff (Response Unit)
-put_ = put  ResponseFormat.ignore
+put_ url = map (_ { body = unit }) <<< put ResponseFormat.ignore url
 
 -- | Makes a `PUT` request to the specified URL with the option to send data,
 -- | and ignores the response.
 put_' :: URL -> Maybe RequestBody.RequestBody -> Aff (Response Unit)
-put_' = put'  ResponseFormat.ignore
+put_' url = map (_ { body = unit }) <<< put' ResponseFormat.ignore url
 
 -- | Makes a `DELETE` request to the specified URL.
-delete :: forall a. ResponseFormat.ResponseFormat a -> URL -> Aff (Response a)
+delete :: forall a. ResponseFormat.ResponseFormat a -> URL -> Aff (Response (Either ResponseFormatError a))
 delete rt u = request rt $ defaultRequest { method = Left DELETE, url = u }
 
 -- | Makes a `DELETE` request to the specified URL and ignores the response.
 delete_ :: URL -> Aff (Response Unit)
-delete_ = delete ResponseFormat.ignore
+delete_ = map (_ { body = unit }) <<< delete ResponseFormat.ignore
 
 -- | Makes a `PATCH` request to the specified URL, sending data.
-patch :: forall a. ResponseFormat.ResponseFormat a -> URL -> RequestBody.RequestBody -> Aff (Response a)
+patch :: forall a. ResponseFormat.ResponseFormat a -> URL -> RequestBody.RequestBody -> Aff (Response (Either ResponseFormatError a))
 patch rt u c = request rt $ defaultRequest { method = Left PATCH, url = u, content = Just c }
 
 -- | Makes a `PATCH` request to the specified URL with the option to send data.
-patch' :: forall a. ResponseFormat.ResponseFormat a -> URL -> Maybe RequestBody.RequestBody -> Aff (Response a)
+patch' :: forall a. ResponseFormat.ResponseFormat a -> URL -> Maybe RequestBody.RequestBody -> Aff (Response (Either ResponseFormatError a))
 patch' rt u c = request rt $ defaultRequest { method = Left PATCH, url = u, content = c }
 
 -- | Makes a `PATCH` request to the specified URL, sending data and ignoring the
 -- | response.
 patch_ :: URL -> RequestBody.RequestBody -> Aff (Response Unit)
-patch_ = patch ResponseFormat.ignore
+patch_ url = map (_ { body = unit }) <<< patch ResponseFormat.ignore url
 
 -- | Makes a `PATCH` request to the specified URL with the option to send data,
 -- | and ignores the response.
 patch_' :: URL -> Maybe RequestBody.RequestBody -> Aff (Response Unit)
-patch_' = patch' ResponseFormat.ignore
+patch_' url = map (_ { body = unit }) <<< patch' ResponseFormat.ignore url
 
 -- | A sequence of retry delays, in milliseconds.
 type RetryDelayCurve = Int -> Milliseconds
@@ -236,12 +238,14 @@ retry policy run req = do
 -- | ```purescript
 -- | get json "/resource"
 -- | ```
-request :: forall a. ResponseFormat.ResponseFormat a -> RequestOptions -> Aff (Response a)
+request :: forall a. ResponseFormat.ResponseFormat a -> RequestOptions -> Aff (Response (Either ResponseFormatError a))
 request rt req = do
   res <- AC.fromEffectFnAff $ runFn2 _ajax responseHeader req'
-  case runExcept (fromResponse' res.response) of
-    Left err -> throwError $ error $ intercalate "\n" (map renderForeignError err)
-    Right res' -> pure (res { response = res' })
+  case runExcept (fromResponse' res.body) of
+    Left err -> do
+      pure (res { body = Left (ResponseFormatError (NEL.head err) res.body) })
+    Right res' -> do
+      pure (res { body = Right res' })
   where
 
   req' :: AjaxRequest a

src/Affjax/ResponseFormat.purs

@@ -7,6 +7,8 @@ import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Maybe (Maybe(..))
 import Data.MediaType (MediaType)
 import Data.MediaType.Common (applicationJSON)
+import Foreign (Foreign, ForeignError)
+import Foreign as Foreign
 import Web.DOM.Document (Document)
 import Web.File.Blob (Blob)
 
@@ -54,3 +56,12 @@ toMediaType =
   case _ of
     Json _ -> Just applicationJSON
     _ -> Nothing
+
+-- | Used when an error occurs when attempting to decode into a particular
+-- | response format. The error that occurred when decoding is included, along
+-- | with the value that decoding was attempted on.
+data ResponseFormatError = ResponseFormatError ForeignError Foreign
+
+printResponseFormatError :: ResponseFormatError → String
+printResponseFormatError (ResponseFormatError err _) =
+  Foreign.renderForeignError err

test/DocExamples.purs

@@ -8,17 +8,25 @@ import Affjax.ResponseFormat as ResponseFormat
 import Data.Argonaut.Core as J
 import Data.Either (Either(..))
 import Data.HTTP.Method (Method(..))
+import Effect (Effect)
 import Effect.Aff (launchAff)
-import Effect.Class (liftEffect)
-import Effect.Console (log)
+import Effect.Class.Console (log)
 
-main = launchAff $ do
+main :: Effect Unit
+main = void $ launchAff $ do
   res <- AX.request ResponseFormat.json (AX.defaultRequest { url = "/api", method = Left GET })
-  liftEffect $ log $ "GET /api response: " <> J.stringify res.response
+  case res.body of
+    Left err -> log $ "GET /api response failed to decode: " <> AX.printResponseFormatError err
+    Right json -> log $ "GET /api response: " <> J.stringify json
 
-main' = launchAff $ do
+main' :: Effect Unit
+main' = void $ launchAff $ do
   res1 <- AX.get ResponseFormat.json "/api"
-  liftEffect $ log $ "GET /api response: " <> J.stringify res1.response
+  case res1.body of
+    Left err -> log $ "GET /api response failed to decode: " <> AX.printResponseFormatError err
+    Right json -> log $ "GET /api response: " <> J.stringify json
 
   res2 <- AX.post ResponseFormat.json "/api" (RequestBody.json (J.fromString "test"))
-  liftEffect $ log $ "POST /api response: " <> J.stringify res2.response
+  case res2.body of
+    Left err -> log $ "POST /api response failed to decode: " <> AX.printResponseFormatError err
+    Right json -> log $ "POST /api response: " <> J.stringify json

test/Main.purs

@@ -78,8 +78,9 @@ main = void $ runAff (either (\e -> logShow e *> throwException e) (const $ log
     (attempt $ AX.request ResponseFormat.ignore $ AX.defaultRequest { url = doesNotExist }) >>= assertRight >>= \res -> do
       assertEq notFound404 res.status
 
-    A.log "GET /not-json: invalid JSON with Foreign response should throw an error"
-    void $ assertLeft =<< attempt (AX.get ResponseFormat.json doesNotExist)
+    A.log "GET /not-json: invalid JSON with Foreign response should return an error"
+    attempt (AX.get ResponseFormat.json doesNotExist) >>= assertRight >>= \res -> do
+      void $ assertLeft res.body
 
     A.log "GET /not-json: invalid JSON with String response should be ok"
     (attempt $ AX.get ResponseFormat.string notJson) >>= assertRight >>= \res -> do
@@ -88,14 +89,16 @@ main = void $ runAff (either (\e -> logShow e *> throwException e) (const $ log
     A.log "POST /mirror: should use the POST method"
     (attempt $ AX.post ResponseFormat.json mirror (RequestBody.string "test")) >>= assertRight >>= \res -> do
       assertEq ok200 res.status
-      assertEq (Just "POST") (J.toString =<< FO.lookup "method" =<< J.toObject res.response)
+      json <- assertRight res.body
+      assertEq (Just "POST") (J.toString =<< FO.lookup "method" =<< J.toObject json)
 
     A.log "PUT with a request body"
     let content = "the quick brown fox jumps over the lazy dog"
     (attempt $ AX.put ResponseFormat.json mirror (RequestBody.string content)) >>= assertRight >>= \res -> do
       assertEq ok200 res.status
-      assertEq (Just "PUT") (J.toString =<< FO.lookup "method" =<< J.toObject res.response)
-      assertEq (Just content) (J.toString =<< FO.lookup "body" =<< J.toObject res.response)
+      json <- assertRight res.body
+      assertEq (Just "PUT") (J.toString =<< FO.lookup "method" =<< J.toObject json)
+      assertEq (Just content) (J.toString =<< FO.lookup "body" =<< J.toObject json)
 
     A.log "Testing CORS, HTTPS"
     (attempt $ AX.get ResponseFormat.json "https://cors-test.appspot.com/test") >>= assertRight >>= \res -> do