FRPでチャットサーバ

FRPのライブラリの一つであるsodiumを触りつつチャットサーバを書いてみた。また、sodiumを使わないバージョンのコードも書いてみたので比べてみる。なおここではbehaviourは全く使っておらずEventの機能のみを使った。

機能

  • 特定のportでクライアントからの接続を待ち受ける
  • メッセージは全クライアントへのブロードキャストのみ
  • exitと打つと抜ける

まずsodiumを使ったコードはこちら。
sodiumのEventとしてChatEventというデータ型を定義し、新規クライアント接続とメッセージの送信を表現した。

data ChatEvent = Join String | Message String String

chat :: IO ()
chat = do
  let port = 8888
  (event, push) <- sync newEvent
  sock <- listenOn $ PortNumber port
  print $ "start listening port " <> show port
  forever $ do
    (handle, host, port) <- accept sock
    let name = host <> show port
    unlisten <- sync $ listen event (handler handle)
    sync $ push $ Join name
    forkFinally (talk name handle push) (\_ -> hClose handle)
  where
    talk :: String -> Handle -> (ChatEvent -> Reactive ()) -> IO ()
    talk name h push = forever $ do
      msg <- hGetLine h
      print $ "get msg from handle " <> msg
      sync $ push $ Message name msg

    handler :: Handle -> ChatEvent -> IO ()
    handler h (Join name) = hPutStrLn h $ "Join " <> name
    handler h (Message name msg)
      | msg == "exit\r" = do
          print $ "handle is closed: " <> name
          hClose h
      | otherwise = hPutStrLn h $ "from " <> name <> ": " <> msg


次にsodiumを使わないで書いたコード。
接続したクライアントの情報管理のためServerというデータ型を導入した。各クライアントの名前とハンドルをMapで管理し、スレッドセーフに更新するためTVarに包んだ。

data Server = Server { clients :: TVar (M.Map String Handle) }

normalChat :: IO ()
normalChat = do
  let port = 8889
  sock <- listenOn $ PortNumber port
  print $ "start listening port " <> show port
  tvar <- newTVarIO M.empty
  let server = Server tvar
  forever $ do
    (handle, host, port) <- accept sock
    let name = host <> show port
    print $ "connected from " <> name
    atomically $ addClient server handle name
    forkFinally (talk server handle name) (\_ -> hClose handle)
  where
    talk :: Server -> Handle -> String -> IO ()
    talk server@Server{..} h name = do
      msg <- hGetLine h
      case msg of
        "exit\r" -> do
          print $ "handle is closed: " <> name
          hClose h
        _ -> do
          clientMap <- atomically $ readTVar clients
          void $ flip M.traverseWithKey clientMap $ \_ handle ->
            hPutStrLn handle $ name <> ": " <> msg
          talk server h name

    addClient :: Server -> Handle -> String -> STM ()
    addClient Server{..} h name = do
      clientMap <- readTVar clients
      let newClientMap = M.insert name h clientMap
      writeTVar clients newClientMap

基本的な構造は同じになるように書いた。
メインスレッドではクライアントからの接続をforeverで待ち受ける。接続してきたクライアントに対してはtalkという関数でメッセージの入力を待ち受け、入力があればブロードキャスト。

sodiumを使っていない場合、新しい接続があるたびにTVar内のMapへクライアントの情報を追加する。メッセージのブロードキャストはMapの各要素を取り出してすべてのハンドルに出力を行う必要がある。

sodiumを使う場合、新規クライアントの追加はeventに対してhandlerを登録するだけで実現できる。また、メッセージのブロードキャストはeventをpushするだけでよい。それによって登録してある各ハンドラーが起動し各クライアントにメッセージが投げられる。

sodiumを使うことによってメッセージの入力と出力を簡単に分離することができコード全体が簡潔になった。また、各クライアントの接続はeventに対するhandlerの登録として表現できることで、自前のデータ構造やSTMも使わずに済んだ。

sodiumにはbehaviourという構成要素もあるので、次はそれも使って何ができるか試してみたい。