``withSession` from Network.Wreq`和內存使用情況

Question

我使用Network.Wreq進行基準測試，工作正常，但是我會減少每次會話模擬的內存使用量（如果可能的話）。

我最小的例子只比較產卵過程（並執行一些簡單的IO）與產卵創建withSession上下文（在這種情況下，我的模擬用戶執行請求到我的網站）與該會話無關。

相關的代碼可以是

let doNothing n _ = let job = randomDelay (1000000, 5000000) >> print n >> job in job 
    spawnProcs 0 = hPutStrLn stderr "done" 
    spawnProcs n = do forkOS 
         $ S.withSession  -- **** UNIQUE RELEVANT (I think) DIFFERENCE **** 
         $ doNothing n 
         spawnProcs (n - 1) 

（末尾完成最小示例）

根據經驗，每個withSession取約2兆字節，確切的堆的使用是

和我的工作流程

$ ghc -O3 -threaded -rtsopts -fforce-recomp minimal.hs 2>&1 | more 
[1 of 1] Compiling Main    (minimal.hs, minimal.o) 
Linking minimal ... 
$ /usr/bin/time -f "%M Kbytes" ./minimal 800 0 +RTS -hT -N4 | wc -c 
done 
42640 Kbytes 
29535 
$ /usr/bin/time -f "%M Kbytes" ./minimal 400 1 +RTS -hT -N4 | wc -c 
done 
988016 Kbytes 
15879 

歡迎任何建議！ :)

謝謝！

（完整代碼）

import Network.Wreq 
import System.IO 
import System.Environment 
import Control.Applicative 
import Control.Concurrent 
import qualified Network.Wreq.Session as S 
import System.Random 

randomDelay :: (Int, Int) -> IO() 
randomDelay i = randomRIO i >>= threadDelay 

onlySpawn n = do 
    let doNothing n = let job = randomDelay (1000000, 5000000) >> print n >> job in job 
     spawnProcs 0 = hPutStrLn stderr "done" 
     spawnProcs n = do forkOS $ doNothing n 
          spawnProcs (n - 1) 
    spawnProcs n 

withSessionSpawn n = do 
    let doNothing n _ = let job = randomDelay (1000000, 5000000) >> print n >> job in job 
     spawnProcs 0 = hPutStrLn stderr "done" 
     spawnProcs n = do forkOS 
          $ S.withSession  -- **** UNIQUE RELEVANT (I think) DIFFERENCE **** 
          $ doNothing n 
          spawnProcs (n - 1) 
    spawnProcs n 

main = do 
    (n:t:_) <- (map read) <$> getArgs 
    case t of 
     0 -> onlySpawn n 
     1 -> withSessionSpawn n 
    threadDelay 30000000 -- 30 seconds and exit 

Answer 1

好吧，我認爲這個問題是Network.HTTP.Client必須如何使用。

在module Network.Wreq.Session文件

withSession :: (Session -> IO a) -> IO a 
withSession = withSessionWith defaultManagerSettings 

withSessionWith :: HTTP.ManagerSettings -> (Session -> IO a) -> IO a 
withSessionWith settings act = do 
    mv <- newMVar $ HTTP.createCookieJar [] 
    HTTP.withManager settings $ \mgr -> 
    act Session { seshCookies = mv 
       , seshManager = mgr 
       , seshRun = runWith 
       } 

然後，一個Manager爲每個仿真創建的（我認爲是不可能的共享Manager）。

從Network.HTTP.Client：「創建一個新的管理系統是一個相對昂貴的操作，建議您共享請求之間的一個經理，而不是」

我的解決辦法是增加一個新的功能，以module Network.Wreq.Session文件能夠分享Manager

withSessionWithMgr :: HTTP.Manager -> (Session -> IO a) -> IO a 
withSessionWithMgr mgr act = do 
    mv <- newMVar $ HTTP.createCookieJar [] 
    act Session { seshCookies = mv 
       , seshManager = mgr 
       , seshRun = runWith 
       } 

現在，我們可以添加其他測試功能

withSessionSpawnWithMgr n mgr = do 
    let doNothing n _ = let job = randomDelay (1000000, 5000000) >> print n >> job in job 
     spawnProcs 0 = hPutStrLn stderr "done" 
     spawnProcs n = do forkOS $ withSessionWithMgr mgr $ doNothing n 
          spawnProcs (n - 1) 
    spawnProcs n 

main = do 
    (n:t:_) <- (map read) <$> getArgs 
    case t of 
     0 -> onlySpawn n 
     1 -> withSessionSpawn n 
     2 -> newManager defaultManagerSettings >>= withSessionSpawnWithMgr n 
    threadDelay 30000000 -- 30 seconds and exit 

和內存使用率是最低

$ time -f "%M Kbytes" ./w 800 0 +RTS -hT -N4 | wc -c 
done 
42496 Kbytes 
1748 
$ time -f "%M Kbytes" ./w 800 1 +RTS -hT -N4 | wc -c 
done 
1895616 Kbytes 
5888 
$ time -f "%M Kbytes" ./w 800 2 +RTS -hT -N4 | wc -c 
done 
40284 Kbytes 
1661 

（我會建議添加此功能）