From eaa2f4cf04f1b790c80bb9983f09f2d3d1794b88 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Tue, 29 Mar 2022 08:53:30 +0100 Subject: [PATCH] terminal: send broadcast messages (#477) --- src/Simplex/Chat.hs | 45 +++++++++++++++++++----------- src/Simplex/Chat/Controller.hs | 5 +++- src/Simplex/Chat/Terminal/Input.hs | 1 + src/Simplex/Chat/View.hs | 4 +++ 4 files changed, 37 insertions(+), 18 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index fa0572a86f..b0035be242 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -38,7 +38,7 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (UTCTime, getCurrentTime) -import Data.Time.LocalTime (getCurrentTimeZone) +import Data.Time.LocalTime (getCurrentTimeZone, getZonedTime) import Data.Word (Word32) import Simplex.Chat.Controller import Simplex.Chat.Markdown @@ -319,7 +319,7 @@ processChatCommand = \case Connect (Just (ACR SCMContact cReq)) -> withUser $ \User {userId, profile} -> connectViaContact userId cReq profile Connect Nothing -> throwChatError CEInvalidConnReq - ConnectAdmin -> withUser $ \User {userId, profile} -> + ConnectSimplex -> withUser $ \User {userId, profile} -> connectViaContact userId adminContactReq profile DeleteContact cName -> withUser $ \User {userId} -> do contactId <- withStore $ \st -> getContactIdByName st userId cName @@ -350,6 +350,15 @@ processChatCommand = \case contactId <- withStore $ \st -> getContactIdByName st userId cName let mc = MCText $ safeDecodeUtf8 msg processChatCommand $ APISendMessage CTDirect contactId mc + SendMessageBroadcast msg -> withUser $ \user -> do + contacts <- withStore (`getUserContacts` user) + withChatLock . procCmd $ do + let mc = MCText $ safeDecodeUtf8 msg + cts = filter isReady contacts + forM_ cts $ \ct -> + void (sendDirectChatItem user ct (XMsgNew $ MCSimple mc) (CISndMsgContent mc) Nothing) + `catchError` (toView . CRChatError) + CRBroadcastSent mc (length cts) <$> liftIO getZonedTime SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \User {userId} -> do contactId <- withStore $ \st -> getContactIdByName st userId cName quotedItemId <- withStore $ \st -> getDirectChatItemIdByText st userId contactId msgDir (safeDecodeUtf8 quotedMsg) @@ -542,20 +551,21 @@ processChatCommand = \case unlessM (doesFileExist f) . throwChatError $ CEFileNotFound f (,) <$> getFileSize f <*> asks (fileChunkSize . config) updateProfile :: User -> Profile -> m ChatResponse - updateProfile user@User {profile = p} p'@Profile {displayName} = do - if p' == p - then pure CRUserProfileNoChange - else do - withStore $ \st -> updateUserProfile st user p' - let user' = (user :: User) {localDisplayName = displayName, profile = p'} - asks currentUser >>= atomically . (`writeTVar` Just user') - contacts <- withStore (`getUserContacts` user) - withChatLock . procCmd $ do - forM_ contacts $ \ct -> - let s = connStatus $ activeConn (ct :: Contact) - in when (s == ConnReady || s == ConnSndReady) $ - void (sendDirectContactMessage ct $ XInfo p') `catchError` (toView . CRChatError) - pure $ CRUserProfileUpdated p p' + updateProfile user@User {profile = p} p'@Profile {displayName} + | p' == p = pure CRUserProfileNoChange + | otherwise = do + withStore $ \st -> updateUserProfile st user p' + let user' = (user :: User) {localDisplayName = displayName, profile = p'} + asks currentUser >>= atomically . (`writeTVar` Just user') + contacts <- filter isReady <$> withStore (`getUserContacts` user) + withChatLock . procCmd $ do + forM_ contacts $ \ct -> + void (sendDirectContactMessage ct $ XInfo p') `catchError` (toView . CRChatError) + pure $ CRUserProfileUpdated p p' + isReady :: Contact -> Bool + isReady ct = + let s = connStatus $ activeConn (ct :: Contact) + in s == ConnReady || s == ConnSndReady getRcvFilePath :: Int64 -> Maybe FilePath -> String -> m FilePath getRcvFilePath fileId filePath fileName = case filePath of Nothing -> do @@ -1660,12 +1670,13 @@ chatCommandP = <|> A.char '@' *> (SendMessage <$> displayName <* A.space <*> A.takeByteString) <|> (">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv) <|> (">>@" <|> ">> @") *> sendMsgQuote (AMsgDirection SMDSnd) + <|> "/feed " *> (SendMessageBroadcast <$> A.takeByteString) <|> ("/file #" <|> "/f #") *> (SendGroupFile <$> displayName <* A.space <*> filePath) <|> ("/file @" <|> "/file " <|> "/f @" <|> "/f ") *> (SendFile <$> displayName <* A.space <*> filePath) <|> ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (A.space *> filePath)) <|> ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal) <|> ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal) - <|> "/simplex" $> ConnectAdmin + <|> "/simplex" $> ConnectSimplex <|> ("/address" <|> "/ad") $> CreateMyAddress <|> ("/delete_address" <|> "/da") $> DeleteMyAddress <|> ("/show_address" <|> "/sa") $> ShowMyAddress diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 8b930d0eb9..7c468b31db 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -20,6 +20,7 @@ import Data.ByteString.Char8 (ByteString) import Data.Int (Int64) import Data.Map.Strict (Map) import Data.Text (Text) +import Data.Time (ZonedTime) import Data.Version (showVersion) import GHC.Generics (Generic) import Numeric.Natural @@ -107,7 +108,7 @@ data ChatCommand | Welcome | AddContact | Connect (Maybe AConnectionRequestUri) - | ConnectAdmin + | ConnectSimplex | DeleteContact ContactName | ListContacts | CreateMyAddress @@ -118,6 +119,7 @@ data ChatCommand | RejectContact ContactName | SendMessage ContactName ByteString | SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: ByteString, message :: ByteString} + | SendMessageBroadcast ByteString | NewGroup GroupProfile | AddMember GroupName ContactName GroupMemberRole | JoinGroup GroupName @@ -152,6 +154,7 @@ data ChatResponse | CRChatItemStatusUpdated {chatItem :: AChatItem} | CRChatItemUpdated {chatItem :: AChatItem} | CRChatItemDeleted {deletedChatItem :: AChatItem, toChatItem :: AChatItem} + | CRBroadcastSent MsgContent Int ZonedTime | CRMsgIntegrityError {msgerror :: MsgErrorType} -- TODO make it chat item to support in mobile | CRCmdAccepted {corr :: CorrId} | CRCmdOk diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index 7a1a3017d4..5c7059f950 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -50,6 +50,7 @@ runInputLoop ct cc = forever $ do Right SendGroupFile {} -> True Right SendMessageQuote {} -> True Right SendGroupMessageQuote {} -> True + Right SendMessageBroadcast {} -> True _ -> False runTerminalInput :: ChatTerminal -> ChatController -> IO () diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 6929b69212..3c11927c4f 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -51,6 +51,7 @@ responseToView testView = \case CRChatItemStatusUpdated _ -> [] CRChatItemUpdated (AChatItem _ _ chat item) -> viewItemUpdate chat item CRChatItemDeleted (AChatItem _ _ chat deletedItem) (AChatItem _ _ _ toItem) -> viewItemDelete chat deletedItem toItem + CRBroadcastSent mc n ts -> viewSentBroadcast mc n ts CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr CRCmdAccepted _ -> [] CRCmdOk -> ["ok"] @@ -456,6 +457,9 @@ viewSentMessage to quote mc = sentWithTime_ . prependFirst to $ quote <> prepend where indent = if null quote then "" else " " +viewSentBroadcast :: MsgContent -> Int -> ZonedTime -> [StyledString] +viewSentBroadcast mc n ts = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts <> " ") (ttyMsgContent mc) + viewSentFileInvitation :: StyledString -> FileTransferId -> FilePath -> CIMeta d -> [StyledString] viewSentFileInvitation to fId fPath = sentWithTime_ $ ttySentFile to fId fPath