使用 Data.Binary 编码二进制编码的大小

Question

我正在使用有线协议，它礼貌地将消息的总长度（以字节为单位）编码为消息前 4 个字节中的 Int32le。这似乎是一个非常常见的用例，但我在Data.Binary 中没有看到明显的功能。有没有标准的方法来处理编码成这样的格式？

还有，当我有你的时候，有没有一种标准的方法可以用Network.Socket 读取这样的协议？我想我读取了前 4 个字节，然后将它们解码，然后使用该数字读取消息的其余部分。

---

关于上下文，这里是the BSON spec。我们正在尝试将压缩向量写入the current BSON library 不支持的自定义二进制字段（binary 元素中的 0x80-0xFF），因此我们需要做一些我们自己的编码。

Answer 1

我会这样做。我不确定您认为哪个部分需要额外的实用功能。

服务器/发送者：

import Data.Binary
import Data.Binary.Put
import qualified Data.ByteString.Lazy as BS
import Network.Run.TCP
import Network.Socket
import Network.Socket.ByteString.Lazy

sendWithLength :: Binary a => Socket -> a -> IO ()
sendWithLength s payload = do
  let payloadBS = encode payload
  let payloadLen = BS.length payloadBS
  let payloadLenBS = runPut $ putInt32le $ fromIntegral payloadLen
  sendAll s payloadLenBS
  sendAll s payloadBS

handleClient :: Socket -> IO ()
handleClient s = do
  sendWithLength s "Hello, World!"
  sendWithLength s ([123, 45, 678] :: [Int])

main :: IO ()
main = runTCPServer Nothing "3000" handleClient

客户/接收方：

import Data.Binary
import Data.Binary.Get
import qualified Data.ByteString.Lazy as BS
import Data.Int
import Network.Run.TCP
import Network.Socket
import Network.Socket.ByteString.Lazy

-- Like recv, but doesn't return a partial result unless the socket reaches
-- EOF.
recvAll :: Socket -> Int64 -> IO BS.ByteString
recvAll s n = do
  bytes <- recv s n
  let len = BS.length bytes
  if BS.null bytes || BS.length bytes == n
    then
      return bytes
    else do
      bytes' <- recvAll s (n - len)
      return $ bytes <> bytes'

recvWithLength :: Binary a => Socket -> IO a
recvWithLength s = do
  payloadLenBS <- recvAll s 4
  let payloadLen = fromIntegral $ runGet getInt32le payloadLenBS
  payloadBS <- recvAll s payloadLen
  let payload = decode payloadBS
  return payload

handleServer :: Socket -> IO ()
handleServer s = do
  payload1 <- recvWithLength s
  putStrLn payload1
  payload2 <- recvWithLength s
  print (payload2 :: [Int])

main :: IO ()
main = runTCPClient "127.0.0.1" "3000" handleServer

顺便说一句，Network.Run.TCP 来自the network-run package。