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 MB，确切的堆使用量是

enter image description here

和我的工作流程

$ 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：＆＃34;创建新经理是一项相对昂贵的操作，建议您在请求之间共享一个经理而不是＃34;

我的解决方案是为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

（我建议添加此功能）

来自`Network.Wreq`的`withSession`和内存使用情况

1 个答案: