haskell - WAI/Warp ResponseSource 清理

Question

当 HTTP 客户端断开连接(或其他真实世界发生)时，无法弄清楚如何进行清理。我试图包装我的 Source成addCleanup ，但它没有被调用。

这是我的无限源流字节串的最小示例:

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Network.Wai
import Network.HTTP.Types
import Network.Wai.Handler.Warp (run)
import Data.ByteString.Lazy.Char8 ()

import Control.Monad
import Control.Monad.Trans
import Control.Concurrent (threadDelay)

import Data.Conduit
import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder.ByteString as BBBB
import qualified Data.ByteString.Char8 as BS

stream :: Source (ResourceT IO) (Flush Builder)
stream = addCleanup (\_ -> liftIO $ putStrLn "cleanup.") $ do
    liftIO $ putStrLn "source started."
    yield Flush

    forever $ do
        yield $ bchunk "whatever"
        yield Flush
        liftIO $ threadDelay 10000

app :: Application
app req = do
    liftIO $ putStrLn "in the handler."
    return $ ResponseSource status200 [("Content-Type", "text/plain")] stream

main :: IO ()
main = run 3000 app

bchunk = Chunk . BBBB.fromByteString . BS.pack

当我用 http 请求点击它时，会出现“启动”通知和 stream开始清除数据。但是，在我关闭连接后，没有“清理”。消息出现并且没有执行任何操作，从而在实际代码中泄漏资源。

Answer 1

我认为清理的首选方法是使用 allocate或 register在 Control.Monad.Trans.Resource.MonadResource 上定义的函数.这将在您的 ResponseSource 时调用您的处理程序。终止，异常(exception)与否。

从看addCleanup代码，它仅用于常规(非异常)完成。

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Network.Wai
import Network.HTTP.Types
import Network.Wai.Handler.Warp (run)
import Data.ByteString.Lazy.Char8 ()

import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Resource
import Control.Concurrent (threadDelay)

import Data.Conduit
import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder.ByteString as BBBB
import qualified Data.ByteString.Char8 as BS

stream :: MonadResource m => Source m (Flush Builder)
stream = do
  -- the release key can be used for early cleanup
  _releaseKey <- lift . register $ putStrLn "cleanup."

  liftIO $ putStrLn "source started."
  yield Flush

  forever $ do
    yield $ bchunk "whatever"
    yield Flush
    liftIO $ threadDelay 10000

app :: Application
app _ = do
  liftIO $ putStrLn "in the handler."
  return $ ResponseSource status200 [("Content-Type", "text/plain")] stream

main :: IO ()
main = run 3000 app

bchunk :: String -> Flush Builder
bchunk = Chunk . BBBB.fromByteString . BS.pack