From 8e1bd696d3bfa6feba7017daa65c4474aab5da42 Mon Sep 17 00:00:00 2001
From: Sir Ckopo <chekoopa@mail.ru>
Date: Sun, 6 Sep 2020 09:35:26 +0800
Subject: [PATCH] Support xhr.timeout in `Request` (#151)

---
 src/Affjax.js   |  1 +
 src/Affjax.purs |  7 ++++++-
 test/Main.js    | 10 ++++++++++
 test/Main.purs  |  7 +++++++
 4 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/src/Affjax.js b/src/Affjax.js
index f02e0a8..4d1468b 100644
--- a/src/Affjax.js
+++ b/src/Affjax.js
@@ -79,6 +79,7 @@ exports._ajax = function () {
       };
       xhr.responseType = options.responseType;
       xhr.withCredentials = options.withCredentials;
+      xhr.timeout = options.timeout;
       xhr.send(options.content);
 
       return function (error, cancelErrback, cancelCallback) {
diff --git a/src/Affjax.purs b/src/Affjax.purs
index 8a37321..71a2e71 100644
--- a/src/Affjax.purs
+++ b/src/Affjax.purs
@@ -34,8 +34,9 @@ import Data.Function.Uncurried (Fn2, runFn2)
 import Data.HTTP.Method (Method(..), CustomMethod)
 import Data.HTTP.Method as Method
 import Data.List.NonEmpty as NEL
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Nullable (Nullable, toNullable)
+import Data.Time.Duration (Milliseconds(..))
 import Effect.Aff (Aff, try)
 import Effect.Aff.Compat as AC
 import Effect.Exception as Exn
@@ -56,6 +57,7 @@ type Request a =
   , password :: Maybe String
   , withCredentials :: Boolean
   , responseFormat :: ResponseFormat.ResponseFormat a
+  , timeout :: Maybe Milliseconds
   }
 
 -- | A record of the type `Request` that has all fields set to default
@@ -79,6 +81,7 @@ defaultRequest =
   , password: Nothing
   , withCredentials: false
   , responseFormat: ResponseFormat.ignore
+  , timeout: Nothing
   }
 
 -- | The possible errors that can occur when making an Affjax request.
@@ -197,6 +200,7 @@ request req =
     , username: toNullable req.username
     , password: toNullable req.password
     , withCredentials: req.withCredentials
+    , timeout: fromMaybe 0.0 $ (\(Milliseconds x) -> x) <$> req.timeout
     }
 
   extractContent :: RequestBody.RequestBody -> Either String Foreign
@@ -251,6 +255,7 @@ type AjaxRequest a =
   , username :: Nullable String
   , password :: Nullable String
   , withCredentials :: Boolean
+  , timeout :: Number
   }
 
 foreign import _ajax
diff --git a/test/Main.js b/test/Main.js
index 52b677b..ce51d65 100644
--- a/test/Main.js
+++ b/test/Main.js
@@ -39,6 +39,16 @@ exports.startServer = function (errback, callback) {
     });
   });
 
+  app.get('/slow', function(req, res) {
+    var date = Date.now();
+    var currentDate = null;
+    do {
+      currentDate = Date.now();
+    } while (currentDate - date < 2000);
+    res.header({'content-type': 'text/plain'});
+    res.send('I hope I am not late!');
+  });
+
   var server = app.listen(function () {
     callback({ port: server.address().port, server: server });
   });
diff --git a/test/Main.purs b/test/Main.purs
index 1953c22..c7e03e6 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -10,6 +10,7 @@ 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, finally, forkAff, killFiber, runAff)
 import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
@@ -62,6 +63,7 @@ main = void $ runAff (either (\e -> logShow e *> throwException e) (const $ log
     let mirror = prefix "/mirror"
     let doesNotExist = prefix "/does-not-exist"
     let notJson = prefix "/not-json"
+    let slow = prefix "/slow"
 
     A.log "GET /mirror: should be 200 OK"
     (AX.request $ AX.defaultRequest { url = mirror }) >>= assertRight >>= \res -> do
@@ -80,6 +82,11 @@ main = void $ runAff (either (\e -> logShow e *> throwException e) (const $ log
     AX.get ResponseFormat.string notJson >>= assertRight >>= \res -> do
       assertEq ok200 res.status
 
+    A.log "GET /slow with timeout: should return an error"
+    (AX.request $ AX.defaultRequest { url = slow, timeout = Just (Milliseconds 100.0) }) >>= assertLeft >>= case _ of
+      AX.XHRError _ → pure unit
+      other → logAny' other *> assertFail "Expected a XHRError"
+
     A.log "POST /mirror: should use the POST method"
     AX.post ResponseFormat.json mirror (Just (RequestBody.string "test")) >>= assertRight >>= \res -> do
       assertEq ok200 res.status