WAI/Warp ResponseSource清理

Question

當HTTP客戶端斷開連接（或其他現實世界發生）時無法弄清楚如何清理。我試圖把我的Source換成addCleanup，但它沒有被調用。

這裏是我的infinte來源串流字節串的小例子：

{-# 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開始puring數據。但是，我關閉連接後，沒有「清理」。消息出現，並且沒有執行任何操作，從而泄漏實際代碼中的資源

Answer 1

我認爲清理的首選方法是使用Control.Monad.Trans.Resource.MonadResource上定義的allocate或register函數。當您的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