WAI/经纱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终止时(异常与否)调用处理程序。

从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