simplify chat protocol (#74)

* groups protocol and some group commands

* simplify chat message format, refactor types to include parsed message body

* disable chat test

migrations/20210612_initial.sql

@@ -34,14 +34,6 @@ CREATE TABLE known_servers(
   UNIQUE (user_id, host, port)
 ) WITHOUT ROWID;
 
--- CREATE TABLE contact_invitations (
---   invitation_id INTEGER PRIMARY KEY,
---   agent_inv_id BLOB UNIQUE,
---   invitation TEXT,
---   contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE RESTRICT,
---   invitation_status TEXT NOT NULL DEFAULT ''
--- );
-
 CREATE TABLE group_profiles ( -- shared group profiles
   group_profile_id INTEGER PRIMARY KEY,
   group_ref TEXT NOT NULL, -- this name must not contain spaces
@@ -54,7 +46,6 @@ CREATE TABLE groups (
   invited_by INTEGER REFERENCES contacts ON DELETE RESTRICT,
   external_group_id BLOB NOT NULL,
   local_group_ref TEXT NOT NULL UNIQUE, -- local group name without spaces
-  local_properties TEXT NOT NULL, -- local JSON group properties
   group_profile_id INTEGER REFERENCES group_profiles, -- shared group profile
   user_id INTEGER NOT NULL REFERENCES users,
   UNIQUE (invited_by, external_group_id)
@@ -64,7 +55,7 @@ CREATE TABLE group_members ( -- group members, excluding the local user
   group_member_id INTEGER PRIMARY KEY,
   group_id INTEGER NOT NULL REFERENCES groups ON DELETE RESTRICT,
   member_id BLOB NOT NULL, -- shared member ID, unique per group
-  member_role TEXT NOT NULL DEFAULT '', -- owner, admin, moderator, ''
+  member_role TEXT NOT NULL DEFAULT '', -- owner, admin, member
   member_status TEXT NOT NULL DEFAULT '', -- inv | con | full | off
   invited_by INTEGER REFERENCES contacts (contact_id) ON DELETE RESTRICT, -- NULL for the members who joined before the current user and for the group creator
   contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE RESTRICT,

package.yaml

@@ -16,6 +16,7 @@ dependencies:
   - ansi-terminal == 0.10.*
   - attoparsec == 0.13.*
   - base >= 4.7 && < 5
+  - base64-bytestring >= 1.0 && < 1.3
   - bytestring == 0.10.*
   - containers == 0.6.*
   - directory == 1.3.*

src/Simplex/Chat.hs

@@ -15,12 +15,11 @@ import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
-import qualified Data.Aeson as J
-import Data.Attoparsec.ByteString.Char8 (Parser)
+import Data.Attoparsec.ByteString.Char8 (Parser, (<?>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Lazy.Char8 as LB
+import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.List (find)
 import Data.Maybe (isJust)
@@ -58,6 +57,14 @@ data ChatCommand
   | Connect SMPQueueInfo
   | DeleteContact ContactRef
   | SendMessage ContactRef ByteString
+  | NewGroup GroupRef
+  | AddMember GroupRef ContactRef GroupMemberRole
+  | RemoveMember GroupRef ContactRef
+  | MemberRole GroupRef ContactRef GroupMemberRole
+  | LeaveGroup GroupRef
+  | DeleteGroup GroupRef
+  | ListMembers GroupRef
+  | SendGroupMessage GroupRef ByteString
   deriving (Show)
 
 cfg :: AgentConfig
@@ -142,10 +149,18 @@ processChatCommand User {userId, profile} = \case
     showContactDeleted cRef
   SendMessage cRef msg -> do
     Connection {agentConnId} <- withStore $ \st -> getContactConnection st userId cRef
-    let body = MsgBodyContent {contentType = SimplexContentType XCText, contentHash = Nothing, contentData = MBFull $ MsgData msg}
-        rawMsg = rawChatMessage ChatMessage {chatMsgId = Nothing, chatMsgEvent = XMsgNew MTText, chatMsgBody = [body], chatDAGIdx = Nothing}
+    let body = MsgBodyContent {contentType = SimplexContentType XCText, contentData = msg}
+        rawMsg = rawChatMessage ChatMessage {chatMsgId = Nothing, chatMsgEvent = XMsgNew MTText [] [body], chatDAG = Nothing}
     void . withAgent $ \smp -> sendMessage smp agentConnId $ serializeRawChatMessage rawMsg
     setActive $ ActiveC cRef
+  NewGroup _gRef -> pure ()
+  AddMember _gRef _cRef _mRole -> pure ()
+  MemberRole _gRef _cRef _mRole -> pure ()
+  RemoveMember _gRef _cRef -> pure ()
+  LeaveGroup _gRef -> pure ()
+  DeleteGroup _gRef -> pure ()
+  ListMembers _gRef -> pure ()
+  SendGroupMessage _gRef _msg -> pure ()
 
 agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
 agentSubscriber = do
@@ -163,10 +178,10 @@ processAgentMessage User {userId, profile} agentConnId agentMessage = do
     ReceivedDirectMessage Contact {localContactRef = c} ->
       case agentMessage of
         MSG meta msgBody -> do
-          ChatMessage {chatMsgEvent, chatMsgBody} <- liftEither $ parseChatMessage msgBody
+          ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
           case chatMsgEvent of
-            XMsgNew MTText -> newTextMessage c meta $ find (isSimplexContentType XCText) chatMsgBody
-            XInfo -> pure () -- TODO profile update
+            XMsgNew MTText [] body -> newTextMessage c meta $ find (isSimplexContentType XCText) body
+            XInfo _ -> pure () -- TODO profile update
             _ -> pure ()
         CON -> do
           -- TODO update connection status
@@ -191,7 +206,7 @@ processAgentMessage User {userId, profile} agentConnId agentMessage = do
   where
     newTextMessage :: ContactRef -> MsgMeta -> Maybe MsgBodyContent -> m ()
     newTextMessage c meta = \case
-      Just MsgBodyContent {contentData = MBFull (MsgData bs)} -> do
+      Just MsgBodyContent {contentData = bs} -> do
         let text = safeDecodeUtf8 bs
         showReceivedMessage c (snd $ broker meta) text (integrity meta)
         showToast ("@" <> c) text
@@ -203,21 +218,15 @@ processAgentMessage User {userId, profile} agentConnId agentMessage = do
 
     saveConnInfo :: Connection -> ConnInfo -> m ()
     saveConnInfo activeConn connInfo = do
-      ChatMessage {chatMsgEvent, chatMsgBody} <- liftEither $ parseChatMessage connInfo
+      ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
       case chatMsgEvent of
-        XInfo ->
-          case find (isSimplexContentType XCJson) chatMsgBody of
-            Just MsgBodyContent {contentData = MBFull (MsgData bs)} -> do
-              p <- liftEither . first (ChatErrorContact . CEProfile) $ J.eitherDecodeStrict' bs
-              withStore $ \st -> createDirectContact st userId activeConn p
-            _ -> pure () -- TODO show/log error?
+        XInfo p ->
+          withStore $ \st -> createDirectContact st userId activeConn p
         _ -> pure () -- TODO show/log error, other events in SMP confirmation
 
 encodeProfile :: Profile -> ByteString
 encodeProfile profile =
-  let json = LB.toStrict $ J.encode profile
-      body = MsgBodyContent {contentType = SimplexContentType XCJson, contentHash = Nothing, contentData = MBFull $ MsgData json}
-      chatMsg = ChatMessage {chatMsgId = Nothing, chatMsgEvent = XInfo, chatMsgBody = [body], chatDAGIdx = Nothing}
+  let chatMsg = ChatMessage {chatMsgId = Nothing, chatMsgEvent = XInfo profile, chatDAG = Nothing}
    in serializeRawChatMessage $ rawChatMessage chatMsg
 
 getCreateActiveUser :: SQLiteStore -> IO User
@@ -314,10 +323,23 @@ withStore action = do
 chatCommandP :: Parser ChatCommand
 chatCommandP =
   ("/help" <|> "/h") $> ChatHelp
+    <|> ("/group #" <|> "/g #") *> (NewGroup <$> groupRef)
+    <|> ("/add #" <|> "/a #") *> (AddMember <$> groupRef <* A.space <*> contactRef <* A.space <*> memberRole)
+    <|> ("/remove #" <|> "/rm #") *> (RemoveMember <$> groupRef <* A.space <*> contactRef)
+    <|> ("/delete #" <|> "/d #") *> (DeleteGroup <$> groupRef)
+    <|> ("/members #" <|> "/ms #") *> (ListMembers <$> groupRef)
+    <|> A.char '#' *> (SendGroupMessage <$> groupRef <* A.space <*> A.takeByteString)
     <|> ("/add" <|> "/a") $> AddContact
     <|> ("/connect " <|> "/c ") *> (Connect <$> smpQueueInfoP)
-    <|> ("/delete " <|> "/d ") *> (DeleteContact <$> contactRef)
+    <|> ("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> contactRef)
     <|> A.char '@' *> (SendMessage <$> contactRef <*> (A.space *> A.takeByteString))
     <|> ("/markdown" <|> "/m") $> MarkdownHelp
   where
-    contactRef = safeDecodeUtf8 <$> A.takeTill (== ' ')
+    contactRef = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' '))
+    refChar c = c > ' ' && c /= '#' && c /= '@'
+    groupRef = contactRef
+    memberRole =
+      ("owner" $> GROwner)
+        <|> ("admin" $> GRAdmin)
+        <|> ("normal" $> GRMember)
+        <?> "memberRole"