使用Haskell Conduit实现的非平凡协议

Question

我正尝试使用Haskell conduit实现一个非平凡协议（在TCP上）。我认为以下情况是非平凡的示例：

• 读取一些标头字节，如果它们匹配预期，则忽略它们并继续；否则，向客户端返回错误。
• 读取指定长度N的字节以指示字段的长度，然后将该数量的字节读入一个字节串。
• 执行来回握手，例如能力协商。在协商后，根据协商结果调用不同的服务器端代码。 （例如，协商服务器和客户端都同意的协议版本）
• 如果客户端无法快速协商协议，则断开连接并向客户端发送错误消息。

到目前为止，我还在努力中......任何帮助或指向一些示例代码的指针都将不胜感激！

- Tom Kludy

---

请澄清一下，您的意思是要实现一个协议并在其实现中使用“conduit”，还是希望能够通过foo-protocol管道发送一个bar-struct，并将正确的标头和数据字节发送到tcp流中？ - Dan Robertson

前者...我想做一些类似于socks5的东西，使用conduit实现。我主要卡在如何根据流中的数据进行控制流上。 - Tom Kludy

Answer 1

问题有些模糊，但如果您正在寻找在管道中基于先前解析结果控制操作的示例，则对netstring协议的实现可能足够：

#!/usr/bin/env stack
-- stack --resolver lts-10.3 script
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Conduit
import Data.ByteString (ByteString)
import Data.Word8 (_colon, _comma, _0, _9, Word8)
import Control.Exception.Safe (throwString)

netstring :: forall m. MonadThrow m => ConduitM ByteString ByteString m ()
netstring = do
  len <- takeWhileCE (/= _colon) .| foldMCE addDigit 0
  mchar1 <- headCE
  case mchar1 of
    Just c
      | c == _colon -> return ()
      | otherwise -> throwString $ "Didn't find a colon: " ++ show c
    Nothing -> throwString "Missing colon"
  takeCE len
  mchar2 <- headCE
  case mchar2 of
    Just c
      | c == _comma -> return ()
      | otherwise -> throwString $ "Didn't end with a comma: " ++ show c
    Nothing -> throwString "Missing trailing comma"
  where
    addDigit :: Int -> Word8 -> m Int
    addDigit total char
      | char < _0 || char > _9 = throwString "Invalid character in len"
    addDigit total char = return $! total * 10 + fromIntegral (char - _0)

main :: IO ()
main = do
  let bs = "5:hello,6: world,"
  res <- runConduit
       $ yield bs
      .| ((,) <$> (netstring .| foldC) <*> (netstring .| foldC))
  print res

- Michael Snoyman