Haskell-来自PHP的Unix域套接字瓶颈？

我正在编写一个微服务框架来与一个PHP站点协同工作。我已经写了它，并在我的本地计算机（OSX）上进行了测试，效果非常好。它将获取数据，将其作为ByteString读取，使用Aeson将其解析为Haskell数据，并对该数据执行特定操作。我让它通过Unix域套接字进行通信

我在本地系统上测试了它，方法是对与Haskell程序通信的本地主机php文件执行

curl

。它能够在大约2分钟内发送/接收/打印10000次信息

当我把它转移到生产服务器上，用PHP实现了完全相同的东西时，一些奇怪的事情开始发生了。Haskell程序运行，但是它在某处被捕获，并且似乎挂起的时间越来越长。首先，它挂起的时间比它应该挂起的时间长0.1秒，而且它一直在上升。在每秒接收10多个请求大约一分钟后，挂起时间几乎为8秒。我通过比较通过套接字调用Haskell的时间和当前时间（就在数据库调用之前），确保这不是因为任何原因导致数据库运行缓慢

以下是我的主要功能：

import Network.Socket

main :: IO ()
main = do
    removeSocketFile socketName
    resource <- defaultResources
    withSocketsDo $ do
        sock <- socket AF_UNIX Stream 0
        bind sock $ SockAddrUnix socketName
        chmodSocket socketName
        putStrLn $ "Created socket file at " ++ socketName
        listen sock maxListenQueue
        catch
            (handleSocket sock resource)
            (\e -> do
                putStrLn $ show (e :: AsyncException)
                close sock
                putStrLn "Closed socket"
                removeSocketFile socketName
            )

导入网络套接字
main:：IO（）
main=do
removeSocketFile socketName
资源服务器资源->IO（）
handleSocket袜子资源=do
（conn，41;服务器资源->IO（）
processConn conn resource=do
msg我想这可能是某种内存泄漏，使它在每个请求上花费越来越多的垃圾收集器时间。。。您是否尝试查看运行时统计信息输出？（
+RTS-s
）@MathematicalOrchid我在生产服务器和自己的计算机上用RTS编译。左边是处理了大约4300个请求后的生产服务器，右边是处理了大约500个请求后的我自己的计算机（testdb）：在生产shell会话的顶部，您可以看到调用套接字的时间与调用数据库的时间相比较。当时我可以取消它，但有大约4分钟它运行得几乎完美，这是以前从未发生过的。在这4分钟内，如果它落后了，它会在几秒钟内赶上。好的，所以在这两种情况下GC看起来都很小。所以这就排除了…是的，这真的很混乱。我将尝试完全删除GHC并从源代码处重新安装它。我的朋友曾经在Ubuntu上遇到过GHC问题，当时它毫无理由地使用了100%的CPU。@MathematicalOrchid，所以我重新安装了GHC，我仍然看到同样的问题。我现在相信这是一个PHP套接字问题。当我关闭Haskell微服务程序并将其恢复为纯用PHP处理时，Haskell程序突然在1秒内处理了100个（据说）排队请求。这让我相信PHP出于某种原因限制了套接字的连接数？或者至少在创建新的套接字连接时做一些坏事。一点也不确定。
import Network.Socket
import Network.Socket.ByteString as NB
import Data.ByteString as B
import Data.Char as C

handleSocket :: Socket -> ServerResources -> IO ()
handleSocket sock resource = do
    (conn,_) <- accept sock
    forkIO $ processConn conn resource
    handleSocket sock resource

processConn :: Socket -> ServerResources -> IO ()
processConn conn resource = do
    msg <- NB.recv conn 2048
    unless (B.null msg) $ do
        let (cmd, payload) = B.break (== (fromIntegral $ C.ord ':')) msg
        delegate cmd (B.drop 1 payload) conn resource
        return ()