Merge branch 'master' into chat-relays

src/Simplex/Chat/Controller.hs

@@ -278,7 +278,7 @@ data ChatCommand
   | SetUserContactReceipts UserMsgReceiptSettings
   | APISetUserGroupReceipts UserId UserMsgReceiptSettings
   | SetUserGroupReceipts UserMsgReceiptSettings
-  | APISetUserAutoAcceptMemberContacts UserId Bool
+  | APISetUserAutoAcceptMemberContacts {userId :: UserId, onOff :: Bool}
   | SetUserAutoAcceptMemberContacts Bool
   | APIHideUser UserId UserPwd
   | APIUnhideUser UserId UserPwd
@@ -365,6 +365,8 @@ data ChatCommand
   | APISetConnectionAlias {connectionId :: Int64, localAlias :: LocalAlias}
   | APISetUserUIThemes UserId (Maybe UIThemeEntityOverrides)
   | APISetChatUIThemes ChatRef (Maybe UIThemeEntityOverrides)
+  | APISetGroupCustomData {groupId :: GroupId, customData :: Maybe CustomData}
+  | APISetContactCustomData {contactId :: ContactId, customData :: Maybe CustomData}
   | APIGetNtfToken
   | APIRegisterToken DeviceToken NotificationsMode
   | APIVerifyToken DeviceToken C.CbNonce ByteString

src/Simplex/Chat/Library/Commands.hs

@@ -1435,6 +1435,16 @@ processChatCommand vr nm = \case
         liftIO $ setGroupUIThemes db user g uiThemes
       ok user
     _ -> throwCmdError "not supported"
+  APISetGroupCustomData groupId customData_ -> withUser $ \user -> do
+    withFastStore $ \db -> do
+      g <- getGroupInfo db vr user groupId
+      liftIO $ setGroupCustomData db user g customData_
+    ok user
+  APISetContactCustomData contactId customData_ -> withUser $ \user -> do
+    withFastStore $ \db -> do
+      ct <- getContact db vr user contactId
+      liftIO $ setContactCustomData db user ct customData_
+    ok user
   APIGetNtfToken -> withUser' $ \_ -> crNtfToken <$> withAgent getNtfToken
   APIRegisterToken token mode -> withUser $ \_ ->
     CRNtfTokenStatus <$> withAgent (\a -> registerNtfToken a nm token mode)
@@ -4693,6 +4703,8 @@ chatCommandP =
       "/_set prefs @" *> (APISetContactPrefs <$> A.decimal <* A.space <*> jsonP),
       "/_set theme user " *> (APISetUserUIThemes <$> A.decimal <*> optional (A.space *> jsonP)),
       "/_set theme " *> (APISetChatUIThemes <$> chatRefP <*> optional (A.space *> jsonP)),
+      "/_set custom #" *> (APISetGroupCustomData <$> A.decimal <*> optional (A.space *> jsonP)),
+      "/_set custom @" *> (APISetContactCustomData <$> A.decimal <*> optional (A.space *> jsonP)),
       "/_ntf get" $> APIGetNtfToken,
       "/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP),
       "/_ntf verify " *> (APIVerifyToken <$> strP <* A.space <*> strP <* A.space <*> strP),
@@ -4809,7 +4821,7 @@ chatCommandP =
       "/clear " *> char_ '@' *> (ClearContact <$> displayNameP),
       ("/members " <|> "/ms ") *> char_ '#' *> (ListMembers <$> displayNameP),
       "/member support chats #" *> (ListMemberSupportChats <$> displayNameP),
-      "/_groups" *> (APIListGroups <$> A.decimal <*> optional (" @" *> A.decimal) <*> optional (A.space *> textP)),
+      "/_groups " *> (APIListGroups <$> A.decimal <*> optional (" @" *> A.decimal) <*> optional (A.space *> textP)),
       ("/groups" <|> "/gs") *> (ListGroups <$> optional (" @" *> displayNameP) <*> optional (A.space *> textP)),
       "/_group_profile #" *> (APIUpdateGroupProfile <$> A.decimal <* A.space <*> jsonP),
       ("/group_profile " <|> "/gp ") *> char_ '#' *> (UpdateGroupNames <$> displayNameP <* A.space <*> groupProfile),

src/Simplex/Chat/Markdown.hs

@@ -53,6 +53,7 @@ data Format
   | StrikeThrough
   | Snippet
   | Secret
+  | Small
   | Colored {color :: FormatColor}
   | Uri
   -- showText is Nothing for the usual Uri without text
@@ -202,7 +203,7 @@ markdownP = mconcat <$> A.many' fragmentP
           '~' -> formattedP '~' StrikeThrough
           '`' -> formattedP '`' Snippet
           '#' -> A.char '#' *> secretP
-          '!' -> coloredP <|> wordP
+          '!' -> styledP <|> wordP
           '@' -> mentionP <|> wordP
           '/' -> commandP <|> wordP
           '[' -> sowLinkP <|> wordP
@@ -228,13 +229,13 @@ markdownP = mconcat <$> A.many' fragmentP
       | otherwise = markdown Secret $ T.init ss
       where
         ss = b <> s <> a
-    coloredP :: Parser Markdown
-    coloredP = do
-      clr <- A.char '!' *> colorP <* A.space
+    styledP :: Parser Markdown
+    styledP = do
+      f <- A.char '!' *> ((A.char '-' $> Small) <|> (colored <$> colorP)) <* A.space
       s <- ((<>) <$> A.takeWhile1 (\c -> c /= ' ' && c /= '!') <*> A.takeTill (== '!')) <* A.char '!'
       if T.null s || T.last s == ' '
-        then fail "not colored"
-        else pure $ markdown (colored clr) s
+        then fail "not styled"
+        else pure $ markdown f s
     mentionP = prefixedStringP '@' displayNameTextP_ Mention
     commandP = prefixedStringP '/' commandTextP Command
     prefixedStringP pfx parser format = do
@@ -441,6 +442,7 @@ markdownText (FormattedText f_ t) = case f_ of
     StrikeThrough -> around '~'
     Snippet -> around '`'
     Secret -> around '#'
+    Small -> "!- " <> t <> "!"
     Colored (FormatColor c) -> color c
     Uri -> t
     HyperLink {} -> t

src/Simplex/Chat/Styled.hs

@@ -75,6 +75,7 @@ sgr = \case
   StrikeThrough -> [SetSwapForegroundBackground True]
   Colored (FormatColor c) -> [SetColor Foreground Vivid c]
   Secret -> [SetColor Foreground Dull Black, SetColor Background Dull Black]
+  Small -> [SetConsoleIntensity FaintIntensity]
   _ -> []
 
 unStyle :: StyledString -> String