mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
Merge branch 'master' into xftp
This commit is contained in:
@@ -19,7 +19,7 @@ import Control.Monad.Except
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Reader
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
@@ -176,7 +176,7 @@ data ChatController = ChatController
|
||||
logFilePath :: Maybe FilePath
|
||||
}
|
||||
|
||||
data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSMarkdown | HSMessages | HSSettings
|
||||
data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSMarkdown | HSMessages | HSSettings | HSDatabase
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON HelpSection where
|
||||
@@ -187,10 +187,18 @@ data ChatCommand
|
||||
= ShowActiveUser
|
||||
| CreateActiveUser Profile Bool
|
||||
| ListUsers
|
||||
| APISetActiveUser UserId
|
||||
| SetActiveUser UserName
|
||||
| APIDeleteUser UserId Bool
|
||||
| DeleteUser UserName Bool
|
||||
| APISetActiveUser UserId (Maybe UserPwd)
|
||||
| SetActiveUser UserName (Maybe UserPwd)
|
||||
| APIHideUser UserId UserPwd
|
||||
| APIUnhideUser UserId (Maybe UserPwd)
|
||||
| APIMuteUser UserId (Maybe UserPwd)
|
||||
| APIUnmuteUser UserId (Maybe UserPwd)
|
||||
| HideUser UserPwd
|
||||
| UnhideUser
|
||||
| MuteUser
|
||||
| UnmuteUser
|
||||
| APIDeleteUser UserId Bool (Maybe UserPwd)
|
||||
| DeleteUser UserName Bool (Maybe UserPwd)
|
||||
| StartChat {subscribeConnections :: Bool, enableExpireChatItems :: Bool}
|
||||
| APIStopChat
|
||||
| APIActivateChat
|
||||
@@ -201,6 +209,7 @@ data ChatCommand
|
||||
| APISetXFTPConfig (Maybe XFTPFileConfig)
|
||||
| SetIncognito Bool
|
||||
| APIExportArchive ArchiveConfig
|
||||
| ExportArchive
|
||||
| APIImportArchive ArchiveConfig
|
||||
| APIDeleteStorage
|
||||
| APIStorageEncryption DBEncryptionConfig
|
||||
@@ -412,6 +421,7 @@ data ChatResponse
|
||||
| CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
|
||||
| CRUserProfile {user :: User, profile :: Profile}
|
||||
| CRUserProfileNoChange {user :: User}
|
||||
| CRUserPrivacy {user :: User}
|
||||
| CRVersionInfo {versionInfo :: CoreVersionInfo}
|
||||
| CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation}
|
||||
| CRSentConfirmation {user :: User}
|
||||
@@ -535,6 +545,16 @@ instance ToJSON ChatResponse where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
|
||||
|
||||
newtype UserPwd = UserPwd {unUserPwd :: Text}
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance FromJSON UserPwd where
|
||||
parseJSON v = UserPwd <$> parseJSON v
|
||||
|
||||
instance ToJSON UserPwd where
|
||||
toJSON (UserPwd p) = toJSON p
|
||||
toEncoding (UserPwd p) = toEncoding p
|
||||
|
||||
newtype AgentQueueId = AgentQueueId QueueId
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -715,11 +735,17 @@ data ChatErrorType
|
||||
| CENoConnectionUser {agentConnId :: AgentConnId}
|
||||
| CENoSndFileUser {agentSndFileId :: AgentSndFileId}
|
||||
| CENoRcvFileUser {agentRcvFileId :: AgentRcvFileId}
|
||||
| CEUserUnknown
|
||||
| CEActiveUserExists -- TODO delete
|
||||
| CEUserExists {contactName :: ContactName}
|
||||
| CEDifferentActiveUser {commandUserId :: UserId, activeUserId :: UserId}
|
||||
| CECantDeleteActiveUser {userId :: UserId}
|
||||
| CECantDeleteLastUser {userId :: UserId}
|
||||
| CECantHideLastUser {userId :: UserId}
|
||||
| CECantUnmuteHiddenUser {userId :: UserId}
|
||||
| CEEmptyUserPassword {userId :: UserId}
|
||||
| CEUserAlreadyHidden {userId :: UserId}
|
||||
| CEUserNotHidden {userId :: UserId}
|
||||
| CEChatNotStarted
|
||||
| CEChatNotStopped
|
||||
| CEChatStoreChanged
|
||||
@@ -797,7 +823,9 @@ instance ToJSON SQLiteError where
|
||||
throwDBError :: ChatMonad m => DatabaseError -> m ()
|
||||
throwDBError = throwError . ChatErrorDatabase
|
||||
|
||||
type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
|
||||
type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m)
|
||||
|
||||
type ChatMonad m = (ChatMonad' m, MonadError ChatError m)
|
||||
|
||||
chatCmdError :: Maybe User -> String -> ChatResponse
|
||||
chatCmdError user = CRChatCmdError user . ChatError . CECommandError
|
||||
|
||||
@@ -11,6 +11,7 @@ module Simplex.Chat.Help
|
||||
messagesHelpInfo,
|
||||
markdownInfo,
|
||||
settingsInfo,
|
||||
databaseHelpInfo,
|
||||
)
|
||||
where
|
||||
|
||||
@@ -85,7 +86,7 @@ chatHelpInfo =
|
||||
green "Create your address: " <> highlight "/address",
|
||||
"",
|
||||
green "Other commands:",
|
||||
indent <> highlight "/help <topic> " <> " - help on: " <> listHighlight ["groups", "contacts", "messages", "files", "address", "settings"],
|
||||
indent <> highlight "/help <topic> " <> " - help on: " <> listHighlight ["groups", "contacts", "messages", "files", "address", "settings", "db"],
|
||||
indent <> highlight "/profile " <> " - show / update user profile",
|
||||
indent <> highlight "/delete <contact>" <> " - delete contact and all messages with them",
|
||||
indent <> highlight "/chats " <> " - most recent chats",
|
||||
@@ -276,3 +277,17 @@ settingsInfo =
|
||||
indent <> highlight "/get stats " <> " - get usage statistics",
|
||||
indent <> highlight "/reset stats " <> " - reset usage statistics"
|
||||
]
|
||||
|
||||
databaseHelpInfo :: [StyledString]
|
||||
databaseHelpInfo =
|
||||
map
|
||||
styleMarkdown
|
||||
[ green "Database export:",
|
||||
indent <> highlight "/db export " <> " - create database export file that can be imported in mobile apps",
|
||||
indent <> highlight "/files_folder <path> " <> " - set files folder path to include app files in the exported archive",
|
||||
"",
|
||||
green "Database encryption:",
|
||||
indent <> highlight "/db encrypt <key> " <> " - encrypt chat database with key/passphrase",
|
||||
indent <> highlight "/db key <current> <new>" <> " - change the key of the encrypted app database",
|
||||
indent <> highlight "/db decrypt <key> " <> " - decrypt chat database"
|
||||
]
|
||||
|
||||
@@ -0,0 +1,14 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20230317_hidden_profiles where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20230317_hidden_profiles :: Query
|
||||
m20230317_hidden_profiles =
|
||||
[sql|
|
||||
ALTER TABLE users ADD COLUMN view_pwd_hash BLOB;
|
||||
ALTER TABLE users ADD COLUMN view_pwd_salt BLOB;
|
||||
ALTER TABLE users ADD COLUMN show_ntfs INTEGER NOT NULL DEFAULT 1;
|
||||
|]
|
||||
+3
-3
@@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20230304_file_description where
|
||||
module Simplex.Chat.Migrations.M20230318_file_description where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
@@ -8,8 +8,8 @@ import Database.SQLite.Simple.QQ (sql)
|
||||
-- this table includes file descriptions for the recipients for both sent and received files
|
||||
-- in the latter case the user is the recipient
|
||||
|
||||
m20230304_file_description :: Query
|
||||
m20230304_file_description =
|
||||
m20230318_file_description :: Query
|
||||
m20230318_file_description =
|
||||
[sql|
|
||||
CREATE TABLE xftp_file_descriptions (
|
||||
file_descr_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
@@ -30,7 +30,10 @@ CREATE TABLE users(
|
||||
active_user INTEGER NOT NULL DEFAULT 0,
|
||||
created_at TEXT CHECK(created_at NOT NULL),
|
||||
updated_at TEXT CHECK(updated_at NOT NULL),
|
||||
agent_user_id INTEGER CHECK(agent_user_id NOT NULL), -- 1 for active user
|
||||
agent_user_id INTEGER CHECK(agent_user_id NOT NULL),
|
||||
view_pwd_hash BLOB,
|
||||
view_pwd_salt BLOB,
|
||||
show_ntfs INTEGER NOT NULL DEFAULT 1, -- 1 for active user
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
|
||||
@@ -12,12 +12,15 @@ import Control.Monad.Except
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson (ToJSON (..))
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.ByteString.Base64.URL as U
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Functor (($>))
|
||||
import Data.List (find)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Word (Word8)
|
||||
import Database.SQLite.Simple (SQLError (..))
|
||||
import qualified Database.SQLite.Simple as DB
|
||||
@@ -65,6 +68,8 @@ foreign export ccall "chat_parse_markdown" cChatParseMarkdown :: CString -> IO C
|
||||
|
||||
foreign export ccall "chat_parse_server" cChatParseServer :: CString -> IO CJSONString
|
||||
|
||||
foreign export ccall "chat_password_hash" cChatPasswordHash :: CString -> CString -> IO CString
|
||||
|
||||
foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
|
||||
|
||||
foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
|
||||
@@ -122,6 +127,12 @@ cChatParseMarkdown s = newCAString . chatParseMarkdown =<< peekCAString s
|
||||
cChatParseServer :: CString -> IO CJSONString
|
||||
cChatParseServer s = newCAString . chatParseServer =<< peekCAString s
|
||||
|
||||
cChatPasswordHash :: CString -> CString -> IO CString
|
||||
cChatPasswordHash cPwd cSalt = do
|
||||
pwd <- peekCAString cPwd
|
||||
salt <- peekCAString cSalt
|
||||
newCAString $ chatPasswordHash pwd salt
|
||||
|
||||
mobileChatOpts :: String -> String -> ChatOpts
|
||||
mobileChatOpts dbFilePrefix dbKey =
|
||||
ChatOpts
|
||||
@@ -242,6 +253,12 @@ chatParseServer = LB.unpack . J.encode . toServerAddress . strDecode . B.pack
|
||||
enc :: StrEncoding a => a -> String
|
||||
enc = B.unpack . strEncode
|
||||
|
||||
chatPasswordHash :: String -> String -> String
|
||||
chatPasswordHash pwd salt = either (const "") passwordHash salt'
|
||||
where
|
||||
salt' = U.decode $ B.pack salt
|
||||
passwordHash = B.unpack . U.encode . C.sha512Hash . (encodeUtf8 (T.pack pwd) <>)
|
||||
|
||||
data APIResponse = APIResponse {corr :: Maybe CorrId, resp :: ChatResponse}
|
||||
deriving (Generic)
|
||||
|
||||
|
||||
+30
-10
@@ -41,6 +41,7 @@ module Simplex.Chat.Store
|
||||
getUserByContactRequestId,
|
||||
getUserFileInfo,
|
||||
deleteUserRecord,
|
||||
updateUserPrivacy,
|
||||
createDirectConnection,
|
||||
createConnReqConnection,
|
||||
getProfileById,
|
||||
@@ -289,6 +290,7 @@ import Data.Functor (($>))
|
||||
import Data.Int (Int64)
|
||||
import Data.List (sortBy, sortOn)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe, mapMaybe)
|
||||
import Data.Ord (Down (..))
|
||||
import Data.Text (Text)
|
||||
@@ -357,7 +359,8 @@ import Simplex.Chat.Migrations.M20230118_recreate_smp_servers
|
||||
import Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
|
||||
import Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
|
||||
import Simplex.Chat.Migrations.M20230303_group_link_role
|
||||
import Simplex.Chat.Migrations.M20230304_file_description
|
||||
import Simplex.Chat.Migrations.M20230317_hidden_profiles
|
||||
import Simplex.Chat.Migrations.M20230318_file_description
|
||||
import Simplex.Chat.Migrations.M20230321_agent_file_deleted
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
@@ -426,7 +429,8 @@ schemaMigrations =
|
||||
("20230129_drop_chat_items_group_idx", m20230129_drop_chat_items_group_idx),
|
||||
("20230206_item_deleted_by_group_member_id", m20230206_item_deleted_by_group_member_id),
|
||||
("20230303_group_link_role", m20230303_group_link_role),
|
||||
("20230304_file_description", m20230304_file_description),
|
||||
("20230317_hidden_profiles", m20230317_hidden_profiles),
|
||||
("20230318_file_description", m20230318_file_description),
|
||||
("20230321_agent_file_deleted", m20230321_agent_file_deleted)
|
||||
]
|
||||
|
||||
@@ -463,8 +467,8 @@ createUserRecord db (AgentUserId auId) Profile {displayName, fullName, image, pr
|
||||
when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, created_at, updated_at) VALUES (?,?,?,0,?,?)"
|
||||
(auId, displayName, activeUser, currentTs, currentTs)
|
||||
"INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, show_ntfs, created_at, updated_at) VALUES (?,?,?,0,?,?,?)"
|
||||
(auId, displayName, activeUser, True, currentTs, currentTs)
|
||||
userId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
@@ -481,7 +485,7 @@ createUserRecord db (AgentUserId auId) Profile {displayName, fullName, image, pr
|
||||
(profileId, displayName, userId, True, currentTs, currentTs)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
|
||||
pure $ toUser (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, userPreferences)
|
||||
pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, userPreferences, True) :. (Nothing, Nothing)
|
||||
|
||||
getUsersInfo :: DB.Connection -> IO [UserInfo]
|
||||
getUsersInfo db = getUsers db >>= mapM getUserInfo
|
||||
@@ -519,16 +523,19 @@ getUsers db =
|
||||
userQuery :: Query
|
||||
userQuery =
|
||||
[sql|
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.local_display_name, ucp.full_name, ucp.image, ucp.preferences
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.local_display_name, ucp.full_name, ucp.image, ucp.preferences, u.show_ntfs, u.view_pwd_hash, u.view_pwd_salt
|
||||
FROM users u
|
||||
JOIN contacts uct ON uct.contact_id = u.contact_id
|
||||
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
|
||||
|]
|
||||
|
||||
toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe Preferences) -> User
|
||||
toUser (userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, userPreferences) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, preferences = userPreferences, localAlias = ""}
|
||||
in User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences = mergePreferences Nothing userPreferences}
|
||||
toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe Preferences, Bool) :. (Maybe B64UrlByteString, Maybe B64UrlByteString) -> User
|
||||
toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, userPreferences, showNtfs) :. (viewPwdHash_, viewPwdSalt_)) =
|
||||
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, viewPwdHash}
|
||||
where
|
||||
profile = LocalProfile {profileId, displayName, fullName, image, preferences = userPreferences, localAlias = ""}
|
||||
fullPreferences = mergePreferences Nothing userPreferences
|
||||
viewPwdHash = UserPwdHash <$> viewPwdHash_ <*> viewPwdSalt_
|
||||
|
||||
setActiveUser :: DB.Connection -> UserId -> IO ()
|
||||
setActiveUser db userId = do
|
||||
@@ -605,6 +612,19 @@ deleteUserRecord :: DB.Connection -> User -> IO ()
|
||||
deleteUserRecord db User {userId} =
|
||||
DB.execute db "DELETE FROM users WHERE user_id = ?" (Only userId)
|
||||
|
||||
updateUserPrivacy :: DB.Connection -> User -> IO ()
|
||||
updateUserPrivacy db User {userId, showNtfs, viewPwdHash} =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE users
|
||||
SET view_pwd_hash = ?, view_pwd_salt = ?, show_ntfs = ?
|
||||
WHERE user_id = ?
|
||||
|]
|
||||
(hashSalt viewPwdHash :. (showNtfs, userId))
|
||||
where
|
||||
hashSalt = L.unzip . fmap (\UserPwdHash {hash, salt} -> (hash, salt))
|
||||
|
||||
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> IO PendingContactConnection
|
||||
createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId = do
|
||||
createdAt <- getCurrentTime
|
||||
|
||||
@@ -110,11 +110,38 @@ data User = User
|
||||
localDisplayName :: ContactName,
|
||||
profile :: LocalProfile,
|
||||
fullPreferences :: FullPreferences,
|
||||
activeUser :: Bool
|
||||
activeUser :: Bool,
|
||||
viewPwdHash :: Maybe UserPwdHash,
|
||||
showNtfs :: Bool
|
||||
}
|
||||
deriving (Show, Generic, FromJSON)
|
||||
|
||||
instance ToJSON User where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
instance ToJSON User where
|
||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
newtype B64UrlByteString = B64UrlByteString ByteString
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance FromField B64UrlByteString where fromField f = B64UrlByteString <$> fromField f
|
||||
|
||||
instance ToField B64UrlByteString where toField (B64UrlByteString m) = toField m
|
||||
|
||||
instance StrEncoding B64UrlByteString where
|
||||
strEncode (B64UrlByteString m) = strEncode m
|
||||
strP = B64UrlByteString <$> strP
|
||||
|
||||
instance FromJSON B64UrlByteString where
|
||||
parseJSON = strParseJSON "B64UrlByteString"
|
||||
|
||||
instance ToJSON B64UrlByteString where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
data UserPwdHash = UserPwdHash {hash :: B64UrlByteString, salt :: B64UrlByteString}
|
||||
deriving (Eq, Show, Generic, FromJSON)
|
||||
|
||||
instance ToJSON UserPwdHash where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data UserInfo = UserInfo
|
||||
{ user :: User,
|
||||
|
||||
@@ -99,6 +99,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
|
||||
HSMessages -> messagesHelpInfo
|
||||
HSMarkdown -> markdownInfo
|
||||
HSSettings -> settingsInfo
|
||||
HSDatabase -> databaseHelpInfo
|
||||
CRWelcome user -> chatWelcome user
|
||||
CRContactsList u cs -> ttyUser u $ viewContactsList cs
|
||||
CRUserContactLink u UserContactLink {connReqContact, autoAccept} -> ttyUser u $ connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept
|
||||
@@ -115,6 +116,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
|
||||
CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus
|
||||
CRUserProfile u p -> ttyUser u $ viewUserProfile p
|
||||
CRUserProfileNoChange u -> ttyUser u ["user profile did not change"]
|
||||
CRUserPrivacy u -> ttyUserPrefix u $ viewUserPrivacy u
|
||||
CRVersionInfo info -> viewVersionInfo logLevel info
|
||||
CRInvitation u cReq -> ttyUser u $ viewConnReqInvitation cReq
|
||||
CRSentConfirmation u -> ttyUser u ["confirmation sent!"]
|
||||
@@ -235,12 +237,16 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
|
||||
CRAgentConnDeleted acId -> ["completed deleting connection, agent connection id: " <> sShow acId | logLevel <= CLLInfo]
|
||||
CRAgentUserDeleted auId -> ["completed deleting user" <> if logLevel <= CLLInfo then ", agent user id: " <> sShow auId else ""]
|
||||
CRMessageError u prefix err -> ttyUser u [plain prefix <> ": " <> plain err | prefix == "error" || logLevel <= CLLWarning]
|
||||
CRChatCmdError u e -> ttyUser' u $ viewChatError logLevel e
|
||||
CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError logLevel e
|
||||
CRChatError u e -> ttyUser' u $ viewChatError logLevel e
|
||||
where
|
||||
ttyUser :: User -> [StyledString] -> [StyledString]
|
||||
ttyUser _ [] = []
|
||||
ttyUser User {userId, localDisplayName = u} ss = prependFirst userPrefix ss
|
||||
ttyUser user@User {showNtfs, activeUser} ss
|
||||
| showNtfs || activeUser = ttyUserPrefix user ss
|
||||
| otherwise = []
|
||||
ttyUserPrefix :: User -> [StyledString] -> [StyledString]
|
||||
ttyUserPrefix _ [] = []
|
||||
ttyUserPrefix User {userId, localDisplayName = u} ss = prependFirst userPrefix ss
|
||||
where
|
||||
userPrefix = case user_ of
|
||||
Just User {userId = activeUserId} -> if userId /= activeUserId then prefix else ""
|
||||
@@ -248,6 +254,8 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
|
||||
prefix = "[user: " <> highlight u <> "] "
|
||||
ttyUser' :: Maybe User -> [StyledString] -> [StyledString]
|
||||
ttyUser' = maybe id ttyUser
|
||||
ttyUserPrefix' :: Maybe User -> [StyledString] -> [StyledString]
|
||||
ttyUserPrefix' = maybe id ttyUserPrefix
|
||||
testViewChats :: [AChat] -> [StyledString]
|
||||
testViewChats chats = [sShow $ map toChatView chats]
|
||||
where
|
||||
@@ -299,14 +307,19 @@ chatItemDeletedText ci membership_ = deletedStateToText <$> chatItemDeletedState
|
||||
_ -> ""
|
||||
|
||||
viewUsersList :: [UserInfo] -> [StyledString]
|
||||
viewUsersList = map userInfo . sortOn ldn
|
||||
viewUsersList = mapMaybe userInfo . sortOn ldn
|
||||
where
|
||||
ldn (UserInfo User {localDisplayName = n} _) = T.toLower n
|
||||
userInfo (UserInfo User {localDisplayName = n, profile = LocalProfile {fullName}, activeUser} count) =
|
||||
ttyFullName n fullName <> active <> unread
|
||||
userInfo (UserInfo User {localDisplayName = n, profile = LocalProfile {fullName}, activeUser, showNtfs, viewPwdHash} count)
|
||||
| activeUser || isNothing viewPwdHash = Just $ ttyFullName n fullName <> infoStr
|
||||
| otherwise = Nothing
|
||||
where
|
||||
active = if activeUser then highlight' " (active)" else ""
|
||||
unread = if count /= 0 then plain $ " (unread: " <> show count <> ")" else ""
|
||||
infoStr = if null info then "" else " (" <> mconcat (intersperse ", " info) <> ")"
|
||||
info =
|
||||
[highlight' "active" | activeUser]
|
||||
<> [highlight' "hidden" | isJust viewPwdHash]
|
||||
<> ["muted" | not showNtfs]
|
||||
<> [plain ("unread: " <> show count) | count /= 0]
|
||||
|
||||
muted :: ChatInfo c -> ChatItem c d -> Bool
|
||||
muted chat ChatItem {chatDir} = case (chat, chatDir) of
|
||||
@@ -728,6 +741,12 @@ viewUserProfile Profile {displayName, fullName} =
|
||||
"(the updated profile will be sent to all your contacts)"
|
||||
]
|
||||
|
||||
viewUserPrivacy :: User -> [StyledString]
|
||||
viewUserPrivacy User {showNtfs, viewPwdHash} =
|
||||
[ "user messages are " <> if showNtfs then "shown" else "hidden (use /tail to view)",
|
||||
"user profile is " <> if isJust viewPwdHash then "hidden" else "visible"
|
||||
]
|
||||
|
||||
-- TODO make more generic messages or split
|
||||
viewSMPServers :: ProtocolTypeI p => [ServerCfg p] -> Bool -> [StyledString]
|
||||
viewSMPServers servers testView =
|
||||
@@ -1218,9 +1237,15 @@ viewChatError logLevel = \case
|
||||
CENoRcvFileUser aFileId -> ["error: rcv file user not found, file id: " <> sShow aFileId | logLevel <= CLLError]
|
||||
CEActiveUserExists -> ["error: active user already exists"]
|
||||
CEUserExists name -> ["user with the name " <> ttyContact name <> " already exists"]
|
||||
CEUserUnknown -> ["user does not exist or incorrect password"]
|
||||
CEDifferentActiveUser commandUserId activeUserId -> ["error: different active user, command user id: " <> sShow commandUserId <> ", active user id: " <> sShow activeUserId]
|
||||
CECantDeleteActiveUser _ -> ["cannot delete active user"]
|
||||
CECantDeleteLastUser _ -> ["cannot delete last user"]
|
||||
CECantHideLastUser _ -> ["cannot hide the only not hidden user"]
|
||||
CECantUnmuteHiddenUser _ -> ["cannot unmute hidden user"]
|
||||
CEEmptyUserPassword _ -> ["cannot set empty password"]
|
||||
CEUserAlreadyHidden _ -> ["user is already hidden"]
|
||||
CEUserNotHidden _ -> ["user is not hidden"]
|
||||
CEChatNotStarted -> ["error: chat not started"]
|
||||
CEChatNotStopped -> ["error: chat not stopped"]
|
||||
CEChatStoreChanged -> ["error: chat store changed, please restart chat"]
|
||||
|
||||
Reference in New Issue
Block a user