diff --git a/README.md b/README.md index 4b7142a..29498f0 100644 --- a/README.md +++ b/README.md @@ -36,11 +36,11 @@ import Data.HTTP.Method (Method(..)) import Effect.Aff (launchAff) import Effect.Class.Console (log) -main = launchAff $ do - res <- AX.request (AX.defaultRequest { url = "/api", method = Left GET, responseFormat = ResponseFormat.json }) - 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 = void $ launchAff $ do + result <- AX.request (AX.defaultRequest { url = "/api", method = Left GET, responseFormat = ResponseFormat.json }) + case result of + Left err -> log $ "GET /api response failed to decode: " <> AX.printError err + Right response -> log $ "GET /api response: " <> J.stringify response.body ``` (`defaultRequest` is a record value that has all the required fields pre-set for convenient overriding when making a request.) @@ -49,29 +49,22 @@ There are also a number of helpers for common `get`, `post`, `put`, `delete`, an ```purescript import Affjax.RequestBody as RequestBody - -main = launchAff $ do - res1 <- AX.get ResponseFormat.json "/api" - 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")) - 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 +import Data.Maybe (Maybe(..)) + +main = void $ launchAff $ do + result1 <- AX.get ResponseFormat.json "/api" + case result1 of + Left err -> log $ "GET /api response failed to decode: " <> AX.printError err + Right response -> log $ "GET /api response: " <> J.stringify response.body + + result2 <- AX.post ResponseFormat.json "/api" (Just (RequestBody.json (J.fromString "test"))) + case result2 of + Left err -> log $ "POST /api response failed to decode: " <> AX.printError err + Right response -> log $ "POST /api response: " <> J.stringify response.body ``` See the [main module documentation](https://pursuit.purescript.org/packages/purescript-affjax/docs/Affjax) for a full list of these helpers and their variations. -## Error handling - -There are two ways an Affjax request can fail: there's either some problem with the request itself, or the result that comes back is not as expected. - -For the first case, these errors will be things like the URL being invalid or the server not existing, and will occur in the `Aff` error channel. The [`try`](https://pursuit.purescript.org/packages/purescript-aff/docs/Effect.Aff#v:try) function can lift these errors out of the error channel so the result of a request becomes `Aff (Either Error (Response _))`. - -The latter case occurs when we did get a response for the request, but the result that came back could not be handled in the way that was expected. In these situations the `body` value of the `Response` will be a `Left` value with the error message describing what went wrong. - ## Module documentation Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-affjax). diff --git a/bower.json b/bower.json index 182355f..6d01443 100644 --- a/bower.json +++ b/bower.json @@ -28,7 +28,7 @@ "purescript-arraybuffer-types": "^2.0.0", "purescript-web-xhr": "^3.0.0", "purescript-foreign": "^5.0.0", - "purescript-form-urlencoded": "^4.0.0", + "purescript-form-urlencoded": "^5.0.0", "purescript-http-methods": "^4.0.0", "purescript-integers": "^4.0.0", "purescript-math": "^2.1.1", diff --git a/src/Affjax.purs b/src/Affjax.purs index 17fefec..8a37321 100644 --- a/src/Affjax.purs +++ b/src/Affjax.purs @@ -1,18 +1,15 @@ module Affjax ( Request, defaultRequest , Response + , Error(..) + , printError , URL , request , get - , post, post_, post', post_' - , put, put_, put', put_' + , post, post_ + , put, put_ , delete, delete_ - , patch, patch_, patch', patch_' - , RetryDelayCurve - , RetryPolicy(..) - , defaultRetryPolicy - , retry - , module Affjax.ResponseFormat + , patch, patch_ ) where import Prelude @@ -20,36 +17,29 @@ import Prelude import Affjax.RequestBody as RequestBody import Affjax.RequestHeader (RequestHeader(..)) import Affjax.RequestHeader as RequestHeader -import Affjax.ResponseFormat (ResponseFormatError(..), printResponseFormatError) import Affjax.ResponseFormat as ResponseFormat import Affjax.ResponseHeader (ResponseHeader(..)) -import Affjax.StatusCode (StatusCode(..)) -import Control.Monad.Except (runExcept, throwError) -import Control.Parallel (parOneOf) +import Affjax.StatusCode (StatusCode) +import Control.Monad.Except (runExcept) import Data.Argonaut.Core (Json) import Data.Argonaut.Core as J import Data.Argonaut.Parser (jsonParser) import Data.Array as Arr import Data.ArrayBuffer.Types (ArrayView) -import Data.Either (Either(..), either) +import Data.Either (Either(..), either, note) import Data.Foldable (any) import Data.FormURLEncoded as FormURLEncoded import Data.Function (on) 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(..)) -import Effect.Aff (Aff, try, delay) +import Effect.Aff (Aff, try) 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, unsafeReadTagged, unsafeToForeign) -import Math as Math +import Effect.Exception as Exn +import Foreign (F, Foreign, ForeignError(..), fail, renderForeignError, unsafeReadTagged, unsafeToForeign) import Web.DOM (Document) import Web.File.Blob (Blob) import Web.XHR.FormData (FormData) @@ -91,6 +81,21 @@ defaultRequest = , responseFormat: ResponseFormat.ignore } +-- | The possible errors that can occur when making an Affjax request. +data Error + = RequestContentError String + | ResponseBodyError ForeignError (Response Foreign) + | XHRError Exn.Error + +printError :: Error -> String +printError = case _ of + RequestContentError err -> + "There was a problem with the request content: " <> err + ResponseBodyError err _ -> + "There was a problem with the response body: " <> renderForeignError err + XHRError err -> + "There was a problem making the request: " <> Exn.message err + -- | The type of records that represents a received HTTP response. type Response a = { status :: StatusCode @@ -103,131 +108,44 @@ type Response a = type URL = String -- | Makes a `GET` request to the specified URL. -get :: forall a. ResponseFormat.ResponseFormat a -> URL -> Aff (Response (Either ResponseFormatError a)) +get :: forall a. ResponseFormat.ResponseFormat a -> URL -> Aff (Either Error (Response a)) get rf u = request (defaultRequest { url = u, responseFormat = rf }) --- | Makes a `POST` request to the specified URL, sending data. -post :: forall a. ResponseFormat.ResponseFormat a -> URL -> RequestBody.RequestBody -> Aff (Response (Either ResponseFormatError a)) -post rf u c = request (defaultRequest { method = Left POST, url = u, content = Just c, responseFormat = rf }) - -- | 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 (Either ResponseFormatError a)) -post' rf u c = request (defaultRequest { method = Left POST, url = u, content = c, responseFormat = rf }) - --- | Makes a `POST` request to the specified URL, sending data and ignoring the --- | response. -post_ :: URL -> RequestBody.RequestBody -> Aff (Response Unit) -post_ url = map (_ { body = unit }) <<< post ResponseFormat.ignore url +post :: forall a. ResponseFormat.ResponseFormat a -> URL -> Maybe RequestBody.RequestBody -> Aff (Either Error (Response a)) +post rf u c = request (defaultRequest { method = Left POST, url = u, content = c, responseFormat = rf }) --- | 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_' 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 (Either ResponseFormatError a)) -put rf u c = request (defaultRequest { method = Left PUT, url = u, content = Just c, responseFormat = rf }) +-- | Makes a `POST` request to the specified URL with the option to send data +-- | and ignores the response body. +post_ :: URL -> Maybe RequestBody.RequestBody -> Aff (Either Error Unit) +post_ url = map void <<< post ResponseFormat.ignore url -- | 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 (Either ResponseFormatError a)) -put' rf u c = request (defaultRequest { method = Left PUT, url = u, content = c, responseFormat = rf }) - --- | Makes a `PUT` request to the specified URL, sending data and ignoring the --- | response. -put_ :: URL -> RequestBody.RequestBody -> Aff (Response Unit) -put_ url = map (_ { body = unit }) <<< put ResponseFormat.ignore url +put :: forall a. ResponseFormat.ResponseFormat a -> URL -> Maybe RequestBody.RequestBody -> Aff (Either Error (Response a)) +put rf u c = request (defaultRequest { method = Left PUT, url = u, content = c, responseFormat = rf }) --- | 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_' 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 body. +put_ :: URL -> Maybe RequestBody.RequestBody -> Aff (Either Error Unit) +put_ url = map void <<< put ResponseFormat.ignore url -- | Makes a `DELETE` request to the specified URL. -delete :: forall a. ResponseFormat.ResponseFormat a -> URL -> Aff (Response (Either ResponseFormatError a)) +delete :: forall a. ResponseFormat.ResponseFormat a -> URL -> Aff (Either Error (Response a)) delete rf u = request (defaultRequest { method = Left DELETE, url = u, responseFormat = rf }) --- | Makes a `DELETE` request to the specified URL and ignores the response. -delete_ :: URL -> Aff (Response Unit) -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 (Either ResponseFormatError a)) -patch rf u c = request (defaultRequest { method = Left PATCH, url = u, content = Just c, responseFormat = rf }) +-- | Makes a `DELETE` request to the specified URL and ignores the response +-- | body. +delete_ :: URL -> Aff (Either Error Unit) +delete_ = map void <<< delete ResponseFormat.ignore -- | 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 (Either ResponseFormatError a)) -patch' rf u c = request (defaultRequest { method = Left PATCH, url = u, content = c, responseFormat = rf }) - --- | Makes a `PATCH` request to the specified URL, sending data and ignoring the --- | response. -patch_ :: URL -> RequestBody.RequestBody -> Aff (Response Unit) -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_' url = map (_ { body = unit }) <<< patch' ResponseFormat.ignore url - --- | A sequence of retry delays, in milliseconds. -type RetryDelayCurve = Int -> Milliseconds - --- | Expresses a policy for retrying HTTP requests with backoff. -type RetryPolicy = - { timeout :: Maybe Milliseconds -- ^ the timeout in milliseconds, optional - , delayCurve :: RetryDelayCurve - , shouldRetryWithStatusCode :: StatusCode -> Boolean -- ^ whether a non-200 status code should trigger a retry - } - --- | A sensible default for retries: no timeout, maximum delay of 30s, initial delay of 0.1s, exponential backoff, and no status code triggers a retry. -defaultRetryPolicy :: RetryPolicy -defaultRetryPolicy = - { timeout : Nothing - , delayCurve : \n -> Milliseconds $ max (30.0 * 1000.0) $ 100.0 * (Math.pow 2.0 $ toNumber (n - 1)) - , shouldRetryWithStatusCode : const false - } - --- | Either we have a failure (which may be an exception or a failed response), or we have a successful response. -type RetryState e a = Either (Either e a) a - --- | Retry a request using a `RetryPolicy`. After the timeout, the last received response is returned; if it was not possible to communicate with the server due to an error, then this is bubbled up. -retry :: forall a b. RetryPolicy -> (Request a -> Aff (Response b)) -> Request a -> Aff (Response b) -retry policy run req = do - -- failureRef is either an exception or a failed request - failureRef <- liftEffect $ Ref.new Nothing - let loop = go failureRef - case policy.timeout of - Nothing -> loop 1 - Just timeout -> do - result <- parOneOf [ Just <$> loop 1, Nothing <$ delay timeout ] - case result of - Nothing -> do - failure <- liftEffect $ Ref.read failureRef - case failure of - Nothing -> throwError $ error "Timeout" - Just failure' -> either throwError pure failure' - Just resp -> pure resp - where - retryState - :: Either Error (Response b) - -> RetryState Error (Response b) - retryState (Left exn) = Left $ Left exn - retryState (Right resp) = - case resp.status of - StatusCode 200 -> Right resp - code -> - if policy.shouldRetryWithStatusCode code then - Left $ Right resp - else - Right resp +patch :: forall a. ResponseFormat.ResponseFormat a -> URL -> RequestBody.RequestBody -> Aff (Either Error (Response a)) +patch rf u c = request (defaultRequest { method = Left PATCH, url = u, content = Just c, responseFormat = rf }) - go failureRef n = do - result <- retryState <$> try (run req) - case result of - Left err -> do - liftEffect $ Ref.write (Just err) failureRef - delay (policy.delayCurve n) - go failureRef (n + 1) - Right resp -> pure resp +-- | Makes a `PATCH` request to the specified URL with the option to send data +-- | and ignores the response body. +patch_ :: URL -> RequestBody.RequestBody -> Aff (Either Error Unit) +patch_ url = map void <<< patch ResponseFormat.ignore url -- | Makes an HTTP request. -- | @@ -246,37 +164,58 @@ retry policy run req = do -- | ```purescript -- | get json "/resource" -- | ``` -request :: forall a. Request a -> Aff (Response (Either ResponseFormatError a)) -request req = do - res <- AC.fromEffectFnAff $ runFn2 _ajax ResponseHeader req' - 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' }) +request :: forall a. Request a -> Aff (Either Error (Response a)) +request req = + case req.content of + Nothing -> + send (toNullable Nothing) + Just content -> + case extractContent content of + Right c -> + send (toNullable (Just c)) + Left err -> + pure $ Left (RequestContentError err) where - req' :: AjaxRequest a - req' = + send :: Nullable Foreign -> Aff (Either Error (Response a)) + send content = + try (AC.fromEffectFnAff (runFn2 _ajax ResponseHeader (ajaxRequest content))) <#> case _ of + Right res -> + case runExcept (fromResponse res.body) of + Left err -> Left (ResponseBodyError (NEL.head err) res) + Right body -> Right (res { body = body }) + Left err -> + Left (XHRError err) + + ajaxRequest :: Nullable Foreign -> AjaxRequest a + ajaxRequest = { method: Method.print req.method , url: req.url , headers: (\h -> { field: RequestHeader.name h, value: RequestHeader.value h }) <$> headers req.content - , content: toNullable (extractContent <$> req.content) + , content: _ , responseType: ResponseFormat.toResponseType req.responseFormat , username: toNullable req.username , password: toNullable req.password , withCredentials: req.withCredentials } - extractContent :: RequestBody.RequestBody -> Foreign + extractContent :: RequestBody.RequestBody -> Either String Foreign extractContent = case _ of - RequestBody.ArrayView f → f (unsafeToForeign :: forall a. ArrayView a -> Foreign) - RequestBody.Blob x → (unsafeToForeign :: Blob -> Foreign) x - RequestBody.Document x → (unsafeToForeign :: Document -> Foreign) x - RequestBody.String x → (unsafeToForeign :: String -> Foreign) x - RequestBody.FormData x → (unsafeToForeign :: FormData -> Foreign) x - RequestBody.FormURLEncoded x → (unsafeToForeign :: String -> Foreign) (FormURLEncoded.encode x) - RequestBody.Json x → (unsafeToForeign :: String -> Foreign) (J.stringify x) + RequestBody.ArrayView f -> + Right $ f (unsafeToForeign :: forall a. ArrayView a -> Foreign) + RequestBody.Blob x -> + Right $ (unsafeToForeign :: Blob -> Foreign) x + RequestBody.Document x -> + Right $ (unsafeToForeign :: Document -> Foreign) x + RequestBody.String x -> + Right $ (unsafeToForeign :: String -> Foreign) x + RequestBody.FormData x -> + Right $ (unsafeToForeign :: FormData -> Foreign) x + RequestBody.FormURLEncoded x -> do + note "Body contains values that cannot be encoded as application/x-www-form-urlencoded" + $ (unsafeToForeign :: String -> Foreign) <$> FormURLEncoded.encode x + RequestBody.Json x -> + Right $ (unsafeToForeign :: String -> Foreign) (J.stringify x) headers :: Maybe RequestBody.RequestBody -> Array RequestHeader headers reqContent = @@ -294,8 +233,8 @@ request req = do "" -> pure J.jsonEmptyObject str -> either (fail <<< ForeignError) pure (jsonParser str) - fromResponse' :: Foreign -> F a - fromResponse' = case req.responseFormat of + fromResponse :: Foreign -> F a + fromResponse = case req.responseFormat of ResponseFormat.ArrayBuffer _ -> unsafeReadTagged "ArrayBuffer" ResponseFormat.Blob _ -> unsafeReadTagged "Blob" ResponseFormat.Document _ -> unsafeReadTagged "Document" diff --git a/test/DocExamples.purs b/test/DocExamples.purs index 8f8372c..1352797 100644 --- a/test/DocExamples.purs +++ b/test/DocExamples.purs @@ -8,25 +8,26 @@ import Affjax.ResponseFormat as ResponseFormat import Data.Argonaut.Core as J import Data.Either (Either(..)) import Data.HTTP.Method (Method(..)) +import Data.Maybe (Maybe(..)) import Effect (Effect) import Effect.Aff (launchAff) import Effect.Class.Console (log) main :: Effect Unit main = void $ launchAff $ do - res <- AX.request (AX.defaultRequest { url = "/api", method = Left GET, responseFormat = ResponseFormat.json }) - 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 + result <- AX.request (AX.defaultRequest { url = "/api", method = Left GET, responseFormat = ResponseFormat.json }) + case result of + Left err -> log $ "GET /api response failed to decode: " <> AX.printError err + Right response -> log $ "GET /api response: " <> J.stringify response.body main' :: Effect Unit main' = void $ launchAff $ do - res1 <- AX.get ResponseFormat.json "/api" - 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 + result1 <- AX.get ResponseFormat.json "/api" + case result1 of + Left err -> log $ "GET /api response failed to decode: " <> AX.printError err + Right response -> log $ "GET /api response: " <> J.stringify response.body - res2 <- AX.post ResponseFormat.json "/api" (RequestBody.json (J.fromString "test")) - 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 + result2 <- AX.post ResponseFormat.json "/api" (Just (RequestBody.json (J.fromString "test"))) + case result2 of + Left err -> log $ "POST /api response failed to decode: " <> AX.printError err + Right response -> log $ "POST /api response: " <> J.stringify response.body diff --git a/test/Main.purs b/test/Main.purs index 9691725..1953c22 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -10,9 +10,8 @@ import Control.Monad.Error.Class (throwError) import Data.Argonaut.Core as J import Data.Either (Either(..), either) import Data.Maybe (Maybe(..)) -import Data.Time.Duration (Milliseconds(..)) import Effect (Effect) -import Effect.Aff (Aff, attempt, finally, forkAff, killFiber, runAff) +import Effect.Aff (Aff, finally, forkAff, killFiber, runAff) import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff) import Effect.Class (liftEffect) import Effect.Class.Console as A @@ -38,12 +37,12 @@ assertMsg msg false = assertFail msg assertRight :: forall a b. Either a b -> Aff b assertRight x = case x of - Left y -> logAny' y >>= \_ -> assertFail "Expected a Right value" + Left y -> logAny' y *> assertFail "Expected a Right value" Right y -> pure y assertLeft :: forall a b. Either a b -> Aff a assertLeft x = case x of - Right y -> logAny' y >>= \_ -> assertFail "Expected a Left value" + Right y -> logAny' y *> assertFail "Expected a Left value" Left y -> pure y assertEq :: forall a. Eq a => Show a => a -> a -> Aff Unit @@ -55,8 +54,6 @@ main = void $ runAff (either (\e -> logShow e *> throwException e) (const $ log let ok200 = StatusCode 200 let notFound404 = StatusCode 404 - let retryPolicy = AX.defaultRetryPolicy { timeout = Just (Milliseconds 500.0), shouldRetryWithStatusCode = \_ -> true } - { server, port } ← fromEffectFnAff startServer finally (fromEffectFnAff (stopServer server)) do A.log ("Test server running on port " <> show port) @@ -66,45 +63,40 @@ main = void $ runAff (either (\e -> logShow e *> throwException e) (const $ log let doesNotExist = prefix "/does-not-exist" let notJson = prefix "/not-json" - A.log "GET /does-not-exist: should be 404 Not found after retries" - (attempt $ AX.retry retryPolicy AX.request $ AX.defaultRequest { url = doesNotExist }) >>= assertRight >>= \res -> do - assertEq notFound404 res.status - A.log "GET /mirror: should be 200 OK" - (attempt $ AX.request $ AX.defaultRequest { url = mirror }) >>= assertRight >>= \res -> do + (AX.request $ AX.defaultRequest { url = mirror }) >>= assertRight >>= \res -> do assertEq ok200 res.status A.log "GET /does-not-exist: should be 404 Not found" - (attempt $ AX.request $ AX.defaultRequest { url = doesNotExist }) >>= assertRight >>= \res -> do + (AX.request $ AX.defaultRequest { url = doesNotExist }) >>= assertRight >>= \res -> do assertEq notFound404 res.status 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 + AX.get ResponseFormat.json doesNotExist >>= assertLeft >>= case _ of + AX.ResponseBodyError _ _ → pure unit + other → logAny' other *> assertFail "Expected a ResponseBodyError" A.log "GET /not-json: invalid JSON with String response should be ok" - (attempt $ AX.get ResponseFormat.string notJson) >>= assertRight >>= \res -> do + AX.get ResponseFormat.string notJson >>= assertRight >>= \res -> do assertEq ok200 res.status A.log "POST /mirror: should use the POST method" - (attempt $ AX.post ResponseFormat.json mirror (RequestBody.string "test")) >>= assertRight >>= \res -> do + AX.post ResponseFormat.json mirror (Just (RequestBody.string "test")) >>= assertRight >>= \res -> do assertEq ok200 res.status - json <- assertRight res.body - assertEq (Just "POST") (J.toString =<< FO.lookup "method" =<< J.toObject json) + assertEq (Just "POST") (J.toString =<< FO.lookup "method" =<< J.toObject res.body) 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 + AX.put ResponseFormat.json mirror (Just (RequestBody.string content)) >>= assertRight >>= \res -> do assertEq ok200 res.status - 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) + assertEq (Just "PUT") (J.toString =<< FO.lookup "method" =<< J.toObject res.body) + assertEq (Just content) (J.toString =<< FO.lookup "body" =<< J.toObject res.body) A.log "Testing CORS, HTTPS" - (attempt $ AX.get ResponseFormat.json "https://cors-test.appspot.com/test") >>= assertRight >>= \res -> do + AX.get ResponseFormat.json "https://cors-test.appspot.com/test" >>= assertRight >>= \res -> do assertEq ok200 res.status -- assertEq (Just "test=test") (lookupHeader "Set-Cookie" res.headers) A.log "Testing cancellation" - forkAff (AX.post_ mirror (RequestBody.string "do it now")) >>= killFiber (error "Pull the cord!") + forkAff (AX.post_ mirror (Just (RequestBody.string "do it now"))) >>= killFiber (error "Pull the cord!") assertMsg "Should have been canceled" true