使用Haskell管道的非平凡协议

时间:2018-02-03 06:14:22

标签: haskell conduit network-conduit

我试图弄清楚如何使用Haskell管道实现一个非平凡的协议(通过TCP)。我认为非平凡的例子:

  • 读取一些标题字节,如果它们符合预期,则忽略它们并继续;否则,向客户端返回错误。
  • 读取指示字段长度的N个字节,然后将该字节数读入字节串。
  • 在客户端和服务器之间执行来回握手,就像进行功能协商一样。协商之后,根据协商的内容调用不同的服务器端代码。 (例如,协商服务器和客户端达成一致的协议版本)
  • 如果客户端未能足够快地协商协议,则超时连接,并向客户端发送错误

到目前为止,我正在努力...任何帮助或指向一些示例代码的指针都将非常感激!

1 个答案:

答案 0 :(得分:2)

这个问题有些模糊,但是如果你正在寻找一个根据以前解析过的结果来控制管道中的动作的例子,那么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