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!

To clarify, do you mean that you want to implement a protocol and use `conduit` in its implementation or do you mean that you would want to be able to send a bar-struct down a foo-protocol conduit and have the right header and data bytes sent down a tcp stream? — Dan Robertson, Feb 03 '18 at 09:27
The former.. I want to do something a bit like socks5, implementing it using conduit. What I’m mainly stuck on is how to do control flow based on data in the stream. — Tom Kludy, Feb 03 '18 at 14:37

score 3 · Accepted Answer · answered Feb 04 '18 at 12:23

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

Non trivial protocol using Haskell conduit

1 Answers1