From 987fcfd3f24cacb4c07bdef8c4cde09f03991796 Mon Sep 17 00:00:00 2001
From: Edsko de Vries <edsko@well-typed.com>
Date: Tue, 17 Dec 2024 16:13:37 +0100
Subject: [PATCH] Disable WAI timeouts altogether

Depends on https://github.com/yesodweb/wai/pull/1017
Closes https://github.com/well-typed/grapesy/issues/123
---
 .github/workflows/haskell-ci.yml              |  6 ++++
 cabal.project                                 |  6 ++++
 cabal.project.ci                              |  6 ++++
 .../src/Network/GRPC/Common/Compression.hs    |  2 --
 grapesy/src/Network/GRPC/Util/HTTP2.hs        | 29 +++----------------
 5 files changed, 22 insertions(+), 27 deletions(-)

diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml
index e4590aba..afcd92b2 100644
--- a/.github/workflows/haskell-ci.yml
+++ b/.github/workflows/haskell-ci.yml
@@ -228,6 +228,12 @@ jobs:
           echo "package trailers-only-tutorial" >> cabal.project
           echo "    ghc-options: -Werror=missing-methods" >> cabal.project
           cat >> cabal.project <<EOF
+          source-repository-package
+            type:     git
+            location: https://github.com/kazu-yamamoto/wai.git
+            tag:      721782ad6e60f3ae4ff609b33c90e56921a4bddb
+            subdir:   time-manager
+
           source-repository-package
             type:     git
             location: https://github.com/google/proto-lens
diff --git a/cabal.project b/cabal.project
index 0985272d..c770c9f0 100644
--- a/cabal.project
+++ b/cabal.project
@@ -18,6 +18,12 @@ package grapesy
   benchmarks: True
   flags: +build-demo +build-stress-test
 
+source-repository-package
+  type: git
+  location: https://github.com/kazu-yamamoto/wai.git
+  tag: 721782ad6e60f3ae4ff609b33c90e56921a4bddb
+  subdir: time-manager
+
 -- proto-lens support for ghc 9.10
 -- https://github.com/google/proto-lens/pull/494
 source-repository-package
diff --git a/cabal.project.ci b/cabal.project.ci
index 2d11a507..9fa2d4d6 100644
--- a/cabal.project.ci
+++ b/cabal.project.ci
@@ -41,6 +41,12 @@ package conduit-tutorial
 package trailers-only-tutorial
   ghc-options: -Werror
 
+source-repository-package
+  type: git
+  location: https://github.com/kazu-yamamoto/wai.git
+  tag: 721782ad6e60f3ae4ff609b33c90e56921a4bddb
+  subdir: time-manager
+
 -- proto-lens support for ghc 9.10
 -- https://github.com/google/proto-lens/pull/494
 source-repository-package
diff --git a/grapesy/src/Network/GRPC/Common/Compression.hs b/grapesy/src/Network/GRPC/Common/Compression.hs
index ac38c4f0..5ffccf11 100644
--- a/grapesy/src/Network/GRPC/Common/Compression.hs
+++ b/grapesy/src/Network/GRPC/Common/Compression.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 -- | Public 'Compression' API
 --
 -- Intended for qualified import.
diff --git a/grapesy/src/Network/GRPC/Util/HTTP2.hs b/grapesy/src/Network/GRPC/Util/HTTP2.hs
index ef00c75d..802a8163 100644
--- a/grapesy/src/Network/GRPC/Util/HTTP2.hs
+++ b/grapesy/src/Network/GRPC/Util/HTTP2.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE CPP #-}
-
-#include "MachDeps.h"
-
 module Network.GRPC.Util.HTTP2 (
     -- * General auxiliary
     fromHeaderTable
@@ -219,26 +215,9 @@ mkTlsSettings http2Settings keyLogger =
 withTimeManager :: (Time.Manager -> IO a) -> IO a
 withTimeManager = TimeManager.withManager (disableTimeout * 1_000_000)
 
--- | Work around the fact that we cannot disable timeouts in http2/http2-tls
+-- | Disable timeouts in http2/http2-tls
 --
--- TODO: <https://github.com/well-typed/grapesy/issues/123>
--- We need a proper solution for this.
+-- A value of 0 (or lower) disables timeouts altogether as of
+-- <https://github.com/yesodweb/wai/pull/1017>.
 disableTimeout :: Int
-disableTimeout =
-#if (WORD_SIZE_IN_BITS == 64)
-    -- Set a really high timeout to effectively disable timeouts (100 years)
-    --
-    -- NOTE: We cannot use 'maxBound' here, because this value is multiplied
-    -- by @1_000_000@ in 'Network.Run.TCP.Timeout.runTCPServerWithSocket'
-    -- (in @network-run@).
-    100 * 365 * 24 * 60 * 60
-#else
-#warning "Timeout for RPC messages is set to 30 minutes on 32-bit systems."
-#warning "See https://github.com/kazu-yamamoto/http2/issues/112"
-    -- Unfortunately, the same trick does not work on 32-bit systems, where we
-    -- simply don't have enough range. The maximum timeout we can support here
-    -- is roughly 35 mins. We set it to 30 minutes exactly, to at least provide
-    -- a clue if the timeout does hit (1_800_000_000 < 2_147_483_647).
-    30 * 60
-#endif
-
+disableTimeout = 0