Non trivial protocol using Haskell conduit

Question

I am trying to figure out how to implement a non-trivial protocol (over TCP) using Haskell conduit. Examples of what I consider non-trivial:

• Read some header byte(s) and if they match what is expected, ignore them and continue; else, return an error to the client.
• Read N byte(s) that indicate the length of a field, then read that number of bytes into a bytestring.
• Perform a back-and-forth handshake between the client and server, like a capability negotiation. After the negotiation, invoke different server-side code depending on what was negotiated. (for example negotiating a protocol version that the server and client agree on)
• Timeout the connection, with an error sent to the client, if the client fails to negotiate the protocol quickly enough

So far I am struggling... any help or a pointer to some example code would be greatly appreciated!

Answer 1

The question is somewhat vague, but if you're looking for an example of controlling actions in a conduit based on previously parsed results, an implementation of the netstring protocol may be sufficient:

#!/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