Commands to list and create chatrooms

2 files changed, 40 insertions, 0 deletions

diff --git a/README.md b/README.md
index 82bd329..0d9919d 100644
--- a/README.md
+++ b/README.md
@@ -93,6 +93,19 @@ Show message history of the selected conversation.
 `/details`  
 Show information about the selected conversations, contact or peer.
 
+### Chatrooms
+
+Currently only public unmoderated chatrooms are supported, which means that any
+network peer is allowed to read and post to the chatroom. Individual messages
+are signed, so message author can not be forged.
+
+`/chatrooms`
+: List known chatrooms.
+
+`/chatroom-create-public [<name>]`
+: Create public unmoderated chatroom. Room name can be passed as command
+  argument or entered interactively.
+
 ### Add contacts
 
 To ensure the identity of the contact and prevent man-in-the-middle attack,
diff --git a/main/Main.hs b/main/Main.hs
index 0eb414c..091f076 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -37,6 +37,7 @@ import System.IO
 
 import Erebos.Attach
 import Erebos.Contact
+import Erebos.Chatroom
 import Erebos.Conversation
 #ifdef ENABLE_ICE_SUPPORT
 import Erebos.Discovery
@@ -425,6 +426,8 @@ commands =
     , ("attach", cmdAttach)
     , ("attach-accept", cmdAttachAccept)
     , ("attach-reject", cmdAttachReject)
+    , ("chatrooms", cmdChatrooms)
+    , ("chatroom-create-public", cmdChatroomCreatePublic)
     , ("contacts", cmdContacts)
     , ("contact-add", cmdContactAdd)
     , ("contact-accept", cmdContactAccept)
@@ -530,6 +533,30 @@ cmdAttachAccept = attachAccept =<< getSelectedPeer
 cmdAttachReject :: Command
 cmdAttachReject = attachReject =<< getSelectedPeer
 
+cmdChatrooms :: Command
+cmdChatrooms = do
+    chatrooms <- listChatrooms
+    forM_ chatrooms $ \case
+        rstate | Just room <- roomStateRoom rstate -> do
+            liftIO $ T.putStrLn $ T.concat
+                [ fromMaybe (T.pack "<unnamed>") $ roomName room
+                ]
+        _ -> return ()
+
+cmdChatroomCreatePublic :: Command
+cmdChatroomCreatePublic = do
+    name <- asks ciLine >>= \case
+        line | not (null line) -> return $ T.pack line
+        _ -> liftIO $ do
+            T.putStr $ T.pack "Name: "
+            hFlush stdout
+            T.getLine
+
+    void $ createChatroom
+        (if T.null name then Nothing else Just name)
+        Nothing
+
+
 cmdContacts :: Command
 cmdContacts = do
     args <- words <$> asks ciLine