Haskell 网络上高效的二进制I/O

我正在尝试编写一个小的Haskell程序，该程序使用二进制网络协议，但我遇到了惊人的困难

很明显，二进制数据应该存储为

ByteString

问题：我应该只使用

hGet

/

hPut

单个多字节整数，还是通过测试整件事的

并使用它来构建一个大的

在这里，
binary
包似乎很有用。但是，
binary
只处理惰性
ByteString
值

问题：在惰性
ByteString
上的
hGet
是否确实严格读取指定的字节数？或者它尝试做一些懒惰的I/O？（我不想要懒惰的I/O！）

问题：为什么文档中没有规定这一点

代码看起来将包含很多“获取下一个整数，将其与此值进行比较，如果否，则抛出错误，否则继续下一步…”我不确定如何在不编写意大利面代码的情况下清晰地构造它

总之，我想做的很简单，但我似乎在努力寻找一种使代码看起来简单的方法。也许我只是想得太多了，错过了一些明显的东西…
关于问题1

如果句柄配置为
NoBuffering
每个
hPutStr
调用将生成一个写系统调用。这将对大量的小写操作造成巨大的性能损失。例如，请参见以下一些基准测试的答案：

另一方面，如果句柄启用了缓冲，则需要显式刷新句柄以确保发送缓冲数据

我假设您使用的是像TCP这样的流协议。使用UDP，您显然必须将每条消息作为一个原子单元形成并发送

关于问题2

读取代码对于lazy ByTestRing，似乎
hGet
将以
defaultChunkSize
的块从句柄读取，大约32k

更新：在这种情况下，hGet似乎不执行延迟IO。下面是一些测试代码。
提要：

Test.hs：

import qualified Data.ByteString.Lazy as LBS
import System.IO

main = do
  s <- LBS.hGet stdin 320000
  let s2 = LBS.take 10 s
  print $ ("Length s2 = ", s2)

导入限定数据.ByteString.Lazy作为LBS
导入系统.IO
main=do
TCP要求应用程序提供自己的消息边界标记。标记消息边界的一个简单协议是发送数据块的长度、数据块以及是否存在属于同一消息的剩余块。保存消息边界信息的报头的最佳大小取决于消息大小的分布

在开发我们自己的小消息协议时，我们将使用两个字节作为标题。字节中的最高有效位（被视为
Word16
）将保存消息中是否有剩余的块。剩下的15位将以字节为单位保存消息的长度。这将允许块大小高达32k，比典型的TCP数据包大。如果消息通常非常小，特别是小于127字节，则两字节的报头将不太理想

我们将用于代码的网络部分。我们将使用包对消息进行序列化或反序列化，该包通过testring对惰性
进行
编码
s和
解码
s

import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as B

import Network.Simple.TCP 
import Data.Bits
import Data.Binary
import Data.Functor
import Control.Monad.IO.Class

我们需要的第一个实用程序是能够将
Word16
头写入严格的
ByteString
s并再次读取它们。我们将按大端顺序写它们。或者，可以根据
Word16
的
Binary
实例编写这些代码

writeBE :: Word16 -> B.ByteString
writeBE x = B.pack . map fromIntegral $ [(x .&. 0xFF00) `shiftR` 8, x .&. 0xFF]

readBE :: B.ByteString -> Maybe Word16
readBE s =
    case map fromIntegral . B.unpack $ s of
        [w1, w0] -> Just $ w1 `shiftL` 8 .|. w0
        _        -> Nothing

主要的挑战将是发送和接收二进制软件包强加给我们的惰性
ByteString
s。因为我们一次最多只能发送32k字节，所以我们需要能够
rechunk
lazy-bytestring，将其分为块，总已知长度不超过我们的最大值。单个块可能已经超过最大值；任何不适合我们的新块的块都被分割成多个块

rechunk :: Int -> [B.ByteString] -> [(Int, [B.ByteString])]
rechunk n = go [] 0 . filter (not . B.null)
    where
        go acc l []     = [(l, reverse acc)]
        go acc l (x:xs) =
            let
                lx = B.length x
                l' = lx + l
            in
                if l' <= n
                then go (x:acc) l' xs
                else
                    let (x0, x1) = B.splitAt (n-l) x
                    in (n, reverse (x0:acc)) : go [] 0 (x1:xs)

通过testring发送一个lazy
ByteString
包括将其分成我们知道可以发送的大小的块，并发送每个块以及包含该大小的头，以及是否还有其他块

sendLazyBS :: (MonadIO m) => Socket -> L.ByteString -> m ()
sendLazyBS s = go . rechunk maxChunk . L.toChunks
    where
        maxChunk = 0x7FFF
        go [] = return ()
        go ((li, ss):xs) = do
            let l = fromIntegral li
            let h = writeBE $ if null xs then l else l .|. 0x8000
            sendMany s (h:ss)
            go xs

recvLazyBS :: (MonadIO m, Functor m) => Socket -> m (Maybe L.ByteString)
recvLazyBS s = fmap L.fromChunks <$> go [] 
    where
        go acc = do
            header <- recvExactly s 2
            maybe (return Nothing) (go' acc) (header >>= readBE . B.concat)
        go' acc h = do
            body <- recvExactly s . fromIntegral $ h .&. 0x7FFF
            let next = if h .&. 0x8000 /= 0
                       then go
                       else return . Just . concat . reverse
            maybe (return Nothing) (next . (:acc) ) body     

接收惰性
ByteString
包括读取双字节头，读取头所指示大小的块，并且只要头指示有更多块，就继续读取

sendLazyBS :: (MonadIO m) => Socket -> L.ByteString -> m ()
sendLazyBS s = go . rechunk maxChunk . L.toChunks
    where
        maxChunk = 0x7FFF
        go [] = return ()
        go ((li, ss):xs) = do
            let l = fromIntegral li
            let h = writeBE $ if null xs then l else l .|. 0x8000
            sendMany s (h:ss)
            go xs

recvLazyBS :: (MonadIO m, Functor m) => Socket -> m (Maybe L.ByteString)
recvLazyBS s = fmap L.fromChunks <$> go [] 
    where
        go acc = do
            header <- recvExactly s 2
            maybe (return Nothing) (go' acc) (header >>= readBE . B.concat)
        go' acc h = do
            body <- recvExactly s . fromIntegral $ h .&. 0x7FFF
            let next = if h .&. 0x8000 /= 0
                       then go
                       else return . Just . concat . reverse
            maybe (return Nothing) (next . (:acc) ) body     

我无法回答您所有的问题，但我相信导管和管道将帮助您避免懒惰的I/O：请检查，我没有我的旧基准测试，但是我记得，直接将您的号码
hPut
和
hGet
直接发送到套接字比通过testring
建立一个大的
并发送更有效。对于
hPut
/
hGet
，速度差可能快5倍。例如，这就是所有
blaze-*
软件包如何提高速度的原因。@GabrielGonzalez，这是因为
hPut
和
hGet
使用了已经自己进行缓冲的函数吗？哦，对不起，我有点误解了这个问题。我描述的是完全通过testring消除
中间层（例如在写入句柄或套接字时），但仔细阅读后，我发现这不是您的意思。
sendBinary :: (MonadIO m, Binary a) => Socket -> a -> m ()
sendBinary s = sendLazyBS s . encode

recvBinary :: (MonadIO m, Binary a, Functor m) => Socket -> m (Maybe a)
recvBinary s = d . fmap decodeOrFail <$> recvLazyBS s
    where
        d (Just (Right (_, _, x))) = Just x
        d _                        = Nothing