在Haskell中，当web客户端断开连接时，如何中止计算

我有一个基于Haskell的web服务，它执行的计算对于某些输入来说可能需要很长时间才能完成。（“很长”在这里的意思是超过一分钟）

因为执行该计算占用了服务器上所有可用的CPU，所以当传入请求到达时，我将其放入队列（实际上是一个堆栈，原因与典型客户机有关，但这不是重点），并在当前运行的计算完成时为其提供服务

我的问题是，客户端并不总是等待足够长的时间，有时会超时，断开连接，然后尝试另一台服务器（好吧，他们再试一次，碰到了elb，通常会得到不同的实例）。此外，由于外部因素，web客户端要求的计算有时会过时，web客户端将被杀死

在这种情况下，我真的希望能够在我从堆栈中提取下一个请求并开始（昂贵的）计算之前检测到web客户端已经离开。不幸的是，我的经验使我相信，在这个框架中，没有办法问“客户端的TCP连接仍然连接吗？”并且我还没有找到任何其他web框架的文档来说明“客户端断开连接”的情况

那么，是否有一个Haskell web框架可以轻松检测web客户端是否已断开连接？或者，如果做不到这一点，是否有一种方法至少可以让它成为可能

（我理解，在所有情况下，如果不向另一端发送数据，可能无法绝对确定TCP客户端是否仍然存在；但是，当客户端实际向服务器发送RST数据包，并且服务器的框架不让应用程序代码确定连接已断开时，这就是一个问题）

---

---

顺便说一句，虽然有人可能会怀疑

onClose

处理程序会允许您这样做，但只有当响应准备就绪并写入客户端时才会触发，因此作为中止正在进行的计算的一种方式是没有用的。似乎也没有办法访问已接受的套接字，以便设置

so\u KEEPALIVE

或类似设置。（有几种方法可以访问初始侦听套接字，但不是公认的方法）

假设“web服务”是指基于HTTP（S）的客户端，一种选择是使用RESTful方法。服务可以接受请求并返回

202 Accepted

，而不是假设客户端将保持连接。如大纲所示：

请求已被接受处理，但处理尚未完成[…]

202号答复故意不作承诺。它的目的是允许服务器接受其他进程的请求（可能是一个面向批处理的进程，每天只运行一次），而不需要用户代理与服务器的连接持续到进程完成为止。与此响应一起返回的实体应该包括请求当前状态的指示，以及指向状态监视器的指针，或者用户可以预期何时完成请求的一些估计

服务器立即响应

202接受的

响应，还包括一个URL，客户端可以使用该URL轮询状态。一个选项是将此URL放在响应的

位置

标题中，但也可以将URL放在响应主体的链接中

客户端可以轮询状态URL以获取状态。计算完成后，状态资源可以提供指向已完成结果的链接

如果担心客户端轮询太难，可以将缓存头添加到状态资源和最终结果中

概述了一般概念，而有很多很好的细节

我并不是说你不能用HTTP或TCP/IP做一些事情（我不知道），但是如果你不能，那么上面的方法就是一个解决类似问题的有效方法

---

显然，这完全独立于编程语言，但这是我的经验。

因此我找到了一个适合我的答案，它可能适合其他人

事实上，您可以充分利用Warp的内部构件来完成这一点，但是接下来剩下的是Warp的基本版本，如果需要日志等，则需要在其中添加其他包

另外，请注意，所谓的“半关闭”连接（当客户端关闭其发送端，但仍在等待数据时）将被检测为关闭，从而中断您的计算。我不知道有哪个HTTP客户机处理半封闭的连接，但需要注意的是

无论如何，我所做的是首先复制由

Network.Wai.Handler.Warp

和

Network.Wai.Handler.Warp.Internal

公开的函数

runSettings

和

runSettingsSocket

，并制作了调用我提供的函数而不是

WarpI.socketConnection

的版本，这样我就有了签名：

runSettings' :: Warp.Settings -> (Socket -> IO (IO WarpI.Connection))
             -> Wai.Application -> IO ()

这需要复制一些助手方法，如

setSocketCloseOnExec

和

windowsThreadBlockHack

。那里的双

IO

签名可能看起来很奇怪，但这正是您想要的-外部

IO

在主线程（调用

accept

）中运行，内部

IO

在

accept

返回后分叉的每个连接线程中运行。原始的

Warp

功能

runSettings

相当于：

\set -> runSettings' set (WarpI.socketConnection >=> return . return)

然后我做了：

data ClientDisappeared = ClientDisappeared deriving (Show, Eq, Enum, Ord)
instance Exception ClientDisappeared

runSettingsSignalDisconnect :: Warp.Settings -> Wai.Application -> IO ()
runSettingsSignalDisconnect set =
  runSettings' set (WarpI.socketConnection >=> return . wrapConn)
  where
    -- Fork a 'monitor' thread that does nothing but attempt to
    -- perform a read from conn in a loop 1/sec, and wrap the receive
    -- methods on conn so that they first consume from the stuff read
    -- by the monitoring thread. If the monitoring thread sees
    -- end-of-file (signaled by an empty string read), raise
    -- ClientDisappered on the per-connection thread.
    wrapConn conn = do
      tid <- myThreadId
      nxtBstr <- newEmptyMVar :: IO (MVar ByteString)
      semaphore <- newMVar ()
      readerCount <- newIORef (0 :: Int)
      monitorThread <- forkIO (monitor tid nxtBstr semaphore readerCount)
      return $ conn {
        WarpI.connClose = throwTo monitorThread ClientDisappeared
                          >> WarpI.connClose conn
        , WarpI.connRecv = newRecv nxtBstr semaphore readerCount
        , WarpI.connRecvBuf = newRecvBuf nxtBstr semaphore readerCount
        }
      where
        newRecv :: MVar ByteString -> MVar () -> IORef Int
                -> IO ByteString
        newRecv nxtBstr sem readerCount =
          bracket_
          (atomicModifyIORef' readerCount $ \x -> (succ x, ()))
          (atomicModifyIORef' readerCount $ \x -> (pred x, ()))
          (withMVar sem $ \_ -> do w <- tryTakeMVar nxtBstr
                                   case w of
                                     Just w' -> return w'
                                     Nothing -> WarpI.connRecv conn
          )

        newRecvBuf :: MVar ByteString -> MVar () -> IORef Int
                   -> WarpI.Buffer -> WarpI.BufSize -> IO Bool
        newRecvBuf nxtBstr sem readerCount buf bufSize =
          bracket_
          (atomicModifyIORef' readerCount $ \x -> (succ x, ()))
          (atomicModifyIORef' readerCount $ \x -> (pred x, ()))
          (withMVar sem $ \_ -> do
              (fulfilled, buf', bufSize') <-
                if bufSize == 0 then return (False, buf, bufSize)
                else
                  do w <- tryTakeMVar nxtBstr
                     case w of
                       Nothing -> return (False, buf, bufSize)
                       Just w' -> do
                         let wlen = B.length w'
                         if wlen > bufSize
                           then do BU.unsafeUseAsCString w' $ \cw' ->
                                     copyBytes buf (castPtr cw') bufSize
                                   putMVar nxtBstr (B.drop bufSize w')
                                   return (True, buf, 0)
                           else do BU.unsafeUseAsCString w' $ \cw' ->
                                     copyBytes buf (castPtr cw') wlen
                                   return (wlen == bufSize, plusPtr buf wlen,
                                           bufSize - wlen)
              if fulfilled then return True
                else WarpI.connRecvBuf conn buf' bufSize'
          )
        dropClientDisappeared :: ClientDisappeared -> IO ()
        dropClientDisappeared _ = return ()
        monitor tid nxtBstr sem st =
          catch (monitor' tid nxtBstr sem st) dropClientDisappeared

        monitor' tid nxtBstr sem st = do
          (hitEOF, readerCount) <- withMVar sem $ \_ -> do
            w <- tryTakeMVar nxtBstr
            case w of
              -- No one picked up our bytestring from last time
              Just w' -> putMVar nxtBstr w' >> return (False, 0)
              Nothing -> do
                w <- WarpI.connRecv conn
                putMVar nxtBstr w
                readerCount <- readIORef st
                return (B.null w, readerCount)
          if hitEOF && (readerCount == 0)
            -- Don't signal if main thread is also trying to read -
            -- in that case, main thread will see EOF directly
            then throwTo tid ClientDisappeared
            else do threadDelay oneSecondInMicros
                    monitor' tid nxtBstr sem st
        oneSecondInMicros = 1000000

data clientEnglished=clientEnglished派生（显示、等式、枚举、Ord）
实例异常ClientException消失
runSettingsSignalDisconnect:：Warp.Settings->Wai.Application->IO（）
运行设置信号断开连接集=
“运行设置”集（WarpI.socketConnection>=>return.wrapConn）
哪里
--Fork是一个“monitor”线程，它不执行任何操作，只尝试
--表演