``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 

（我会建议添加此功能）