2022-01-28 10:41:09 +00:00
{- # LANGUAGE DataKinds # -}
2022-05-17 08:37:00 +01:00
{- # LANGUAGE DeriveGeneric # -}
2021-07-12 19:00:03 +01:00
{- # LANGUAGE DuplicateRecordFields # -}
2022-01-26 16:18:27 +04:00
{- # LANGUAGE GADTs # -}
2021-06-25 18:18:24 +01:00
{- # LANGUAGE LambdaCase # -}
2021-07-12 19:00:03 +01:00
{- # LANGUAGE NamedFieldPuns # -}
2021-06-25 18:18:24 +01:00
{- # LANGUAGE OverloadedStrings # -}
2022-03-16 13:20:47 +00:00
{- # LANGUAGE ScopedTypeVariables # -}
{- # LANGUAGE TypeApplications # -}
2021-06-25 18:18:24 +01:00
2022-01-24 16:07:17 +00:00
module Simplex.Chat.View where
2022-05-17 08:37:00 +01:00
import Data.Aeson ( ToJSON )
2022-02-22 14:05:45 +00:00
import qualified Data.Aeson as J
2022-03-10 15:45:40 +04:00
import qualified Data.ByteString.Char8 as B
2022-05-17 08:37:00 +01:00
import qualified Data.ByteString.Lazy.Char8 as LB
2022-08-13 14:18:12 +01:00
import Data.Char ( toUpper )
2021-09-05 14:08:29 +01:00
import Data.Function ( on )
2021-09-04 07:32:56 +01:00
import Data.Int ( Int64 )
2022-03-10 15:45:40 +04:00
import Data.List ( groupBy , intercalate , intersperse , partition , sortOn )
2023-04-05 21:59:12 +01:00
import Data.List.NonEmpty ( NonEmpty )
2022-11-16 15:37:20 +00:00
import qualified Data.List.NonEmpty as L
2023-08-25 14:10:40 +01:00
import qualified Data.Map.Strict as M
2023-02-08 07:08:53 +00:00
import Data.Maybe ( fromMaybe , isJust , isNothing , mapMaybe )
2021-07-04 18:42:24 +01:00
import Data.Text ( Text )
2021-06-25 18:18:24 +01:00
import qualified Data.Text as T
2023-04-05 21:59:12 +01:00
import Data.Text.Encoding ( decodeLatin1 )
2023-06-08 11:23:04 +04:00
import Data.Time ( LocalTime ( .. ) , TimeOfDay ( .. ) , TimeZone ( .. ) , utcToLocalTime )
import Data.Time.Calendar ( addDays )
import Data.Time.Clock ( UTCTime )
2021-06-25 18:18:24 +01:00
import Data.Time.Format ( defaultTimeLocale , formatTime )
2022-05-17 08:37:00 +01:00
import GHC.Generics ( Generic )
import qualified Network.HTTP.Types as Q
2021-09-04 07:32:56 +01:00
import Numeric ( showFFloat )
2023-01-16 09:13:46 +00:00
import Simplex.Chat ( defaultChatConfig , maxImageSize )
2022-05-17 08:37:00 +01:00
import Simplex.Chat.Call
2021-06-25 18:18:24 +01:00
import Simplex.Chat.Controller
2022-01-24 16:07:17 +00:00
import Simplex.Chat.Help
2021-06-25 18:18:24 +01:00
import Simplex.Chat.Markdown
2022-02-09 20:58:02 +04:00
import Simplex.Chat.Messages hiding ( NewChatItem ( .. ) )
2023-06-17 11:03:22 +01:00
import Simplex.Chat.Messages.CIContent
2022-01-24 16:07:17 +00:00
import Simplex.Chat.Protocol
2022-10-21 19:14:12 +03:00
import Simplex.Chat.Store ( AutoAccept ( .. ) , StoreError ( .. ) , UserContactLink ( .. ) )
2021-06-25 18:18:24 +01:00
import Simplex.Chat.Styled
2021-07-04 18:42:24 +01:00
import Simplex.Chat.Types
2023-07-21 21:32:28 +01:00
import Simplex.Chat.Types.Preferences
2023-04-05 21:59:12 +01:00
import qualified Simplex.FileTransfer.Protocol as XFTP
2023-08-25 14:10:40 +01:00
import Simplex.Messaging.Agent.Client ( ProtocolTestFailure ( .. ) , ProtocolTestStep ( .. ) , SubscriptionsInfo ( .. ) )
2022-07-25 14:04:27 +01:00
import Simplex.Messaging.Agent.Env.SQLite ( NetworkConfig ( .. ) )
2021-06-25 18:18:24 +01:00
import Simplex.Messaging.Agent.Protocol
2023-08-16 21:21:12 +04:00
import Simplex.Messaging.Agent.Store.SQLite.DB ( SlowQueryStats ( .. ) )
2022-05-17 08:37:00 +01:00
import qualified Simplex.Messaging.Crypto as C
2023-09-01 19:43:27 +01:00
import Simplex.Messaging.Crypto.File ( CryptoFile ( .. ) , CryptoFileArgs ( .. ) )
2022-04-22 20:32:19 +01:00
import Simplex.Messaging.Encoding
2022-01-11 08:50:44 +00:00
import Simplex.Messaging.Encoding.String
2022-05-17 08:37:00 +01:00
import Simplex.Messaging.Parsers ( dropPrefix , taggedObjectJSON )
2023-05-23 13:51:23 +04:00
import Simplex.Messaging.Protocol ( AProtoServerWithAuth ( .. ) , AProtocolType , ProtoServerWithAuth , ProtocolServer ( .. ) , ProtocolTypeI , SProtocolType ( .. ) )
2021-12-08 13:09:51 +00:00
import qualified Simplex.Messaging.Protocol as SMP
2022-08-13 14:18:12 +01:00
import Simplex.Messaging.Transport.Client ( TransportHost ( .. ) )
2023-01-16 09:13:46 +00:00
import Simplex.Messaging.Util ( bshow , tshow )
2021-06-25 18:18:24 +01:00
import System.Console.ANSI.Types
2022-11-14 08:42:54 +00:00
type CurrentTime = UTCTime
2022-01-24 16:07:17 +00:00
2023-05-08 20:07:51 +04:00
serializeChatResponse :: Maybe User -> CurrentTime -> TimeZone -> ChatResponse -> String
serializeChatResponse user_ ts tz = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz
2022-11-14 08:42:54 +00:00
2023-05-08 20:07:51 +04:00
responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> ChatResponse -> [ StyledString ]
2023-07-13 23:48:25 +01:00
responseToView user_ ChatConfig { logLevel , showReactions , showReceipts , testView } liveItems ts tz = \ case
2022-08-18 11:35:31 +04:00
CRActiveUser User { profile } -> viewUserProfile $ fromLocalProfile profile
2023-01-04 21:06:28 +04:00
CRUsersList users -> viewUsersList users
2022-02-21 12:05:00 +00:00
CRChatStarted -> [ " chat started " ]
2022-06-06 16:23:47 +01:00
CRChatRunning -> [ " chat is running " ]
CRChatStopped -> [ " chat stopped " ]
2022-06-26 15:04:44 +01:00
CRChatSuspended -> [ " chat suspended " ]
2023-01-13 12:24:54 +00:00
CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [ plain . bshow $ J . encode chats ]
2023-06-08 11:07:21 +04:00
CRChats chats -> viewChats ts tz chats
2023-01-13 12:24:54 +00:00
CRApiChat u chat -> ttyUser u $ if testView then testViewChat chat else [ plain . bshow $ J . encode chat ]
2022-04-04 19:51:49 +01:00
CRApiParsedMarkdown ft -> [ plain . bshow $ J . encode ft ]
2023-04-05 21:59:12 +01:00
CRUserProtoServers u userServers -> ttyUser u $ viewUserServers userServers testView
CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
2023-01-13 12:24:54 +00:00
CRChatItemTTL u ttl -> ttyUser u $ viewChatItemTTL ttl
2022-07-25 14:04:27 +01:00
CRNetworkConfig cfg -> viewNetworkConfig cfg
2023-01-13 12:24:54 +00:00
CRContactInfo u ct cStats customUserProfile -> ttyUser u $ viewContactInfo ct cStats customUserProfile
2023-08-06 11:56:40 +01:00
CRGroupInfo u g s -> ttyUser u $ viewGroupInfo g s
2023-01-13 12:24:54 +00:00
CRGroupMemberInfo u g m cStats -> ttyUser u $ viewGroupMemberInfo g m cStats
2023-06-19 16:07:17 +04:00
CRContactSwitchStarted { } -> [ " switch started " ]
CRGroupMemberSwitchStarted { } -> [ " switch started " ]
2023-06-16 19:05:53 +04:00
CRContactSwitchAborted { } -> [ " switch aborted " ]
CRGroupMemberSwitchAborted { } -> [ " switch aborted " ]
2023-01-13 12:24:54 +00:00
CRContactSwitch u ct progress -> ttyUser u $ viewContactSwitch ct progress
CRGroupMemberSwitch u g m progress -> ttyUser u $ viewGroupMemberSwitch g m progress
2023-07-05 19:44:21 +04:00
CRContactRatchetSyncStarted { } -> [ " connection synchronization started " ]
CRGroupMemberRatchetSyncStarted { } -> [ " connection synchronization started " ]
CRContactRatchetSync u ct progress -> ttyUser u $ viewContactRatchetSync ct progress
CRGroupMemberRatchetSync u g m progress -> ttyUser u $ viewGroupMemberRatchetSync g m progress
CRContactVerificationReset u ct -> ttyUser u $ viewContactVerificationReset ct
CRGroupMemberVerificationReset u g m -> ttyUser u $ viewGroupMemberVerificationReset g m
2023-01-13 12:24:54 +00:00
CRConnectionVerified u verified code -> ttyUser u [ plain $ if verified then " connection verified " else " connection not verified, current code is " <> code ]
CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView
CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
2023-06-08 11:07:21 +04:00
CRNewChatItem u ( AChatItem _ _ chat item ) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts tz <> viewItemReactions item
CRChatItems u chatItems -> ttyUser u $ concatMap ( \ ( AChatItem _ _ chat item ) -> viewChatItem chat item True ts tz <> viewItemReactions item ) chatItems
2023-05-08 20:07:51 +04:00
CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz
2023-01-13 12:24:54 +00:00
CRChatItemId u itemId -> ttyUser u [ plain $ maybe " no item " show itemId ]
2023-07-13 23:48:25 +01:00
CRChatItemStatusUpdated u ci -> ttyUser u $ viewChatItemStatusUpdated ci ts tz testView showReceipts
2023-06-08 11:07:21 +04:00
CRChatItemUpdated u ( AChatItem _ _ chat item ) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts tz
2023-05-11 16:00:01 +04:00
CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci
2023-06-08 11:07:21 +04:00
CRChatItemDeleted u ( AChatItem _ _ chat deletedItem ) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView
2023-05-17 01:22:00 +02:00
CRChatItemReaction u added ( ACIReaction _ _ chat reaction ) -> ttyUser u $ unmutedReaction chat reaction $ viewItemReaction showReactions chat reaction added ts tz
2023-01-13 12:24:54 +00:00
CRChatItemDeletedNotFound u Contact { localDisplayName = c } _ -> ttyUser u [ ttyFrom $ c <> " > [deleted - original message not found] " ]
2023-06-17 10:34:04 +01:00
CRBroadcastSent u mc s f t -> ttyUser u $ viewSentBroadcast mc s f ts tz t
2023-01-13 12:24:54 +00:00
CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr
2022-02-21 12:05:00 +00:00
CRCmdAccepted _ -> []
2023-01-13 12:24:54 +00:00
CRCmdOk u_ -> ttyUser' u_ [ " ok " ]
2022-01-24 16:07:17 +00:00
CRChatHelp section -> case section of
2022-02-21 12:05:00 +00:00
HSMain -> chatHelpInfo
HSFiles -> filesHelpInfo
HSGroups -> groupsHelpInfo
2023-03-04 22:33:17 +00:00
HSContacts -> contactsHelpInfo
2022-02-21 12:05:00 +00:00
HSMyAddress -> myAddressHelpInfo
2023-08-08 17:25:28 +04:00
HSIncognito -> incognitoHelpInfo
2022-04-03 09:44:23 +01:00
HSMessages -> messagesHelpInfo
2022-02-21 12:05:00 +00:00
HSMarkdown -> markdownInfo
2022-07-26 07:29:28 +01:00
HSSettings -> settingsInfo
2023-03-19 11:49:30 +00:00
HSDatabase -> databaseHelpInfo
2022-02-21 12:05:00 +00:00
CRWelcome user -> chatWelcome user
2023-01-13 12:24:54 +00:00
CRContactsList u cs -> ttyUser u $ viewContactsList cs
CRUserContactLink u UserContactLink { connReqContact , autoAccept } -> ttyUser u $ connReqContact_ " Your chat address: " connReqContact <> autoAcceptStatus_ autoAccept
CRUserContactLinkUpdated u UserContactLink { autoAccept } -> ttyUser u $ autoAcceptStatus_ autoAccept
CRContactRequestRejected u UserContactRequest { localDisplayName = c } -> ttyUser u [ ttyContact c <> " : contact request rejected " ]
CRGroupCreated u g -> ttyUser u $ viewGroupCreated g
CRGroupMembers u g -> ttyUser u $ viewGroupMembers g
CRGroupsList u gs -> ttyUser u $ viewGroupsList gs
2023-05-26 13:52:06 +04:00
CRSentGroupInvitation u g c _ ->
ttyUser u $
if viaGroupLink . contactConn $ c
then [ ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link " ]
else [ " invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c ]
2023-01-13 12:24:54 +00:00
CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus
2023-04-21 13:36:44 +04:00
CRFileTransferStatusXFTP u ci -> ttyUser u $ viewFileTransferStatusXFTP ci
2023-01-13 12:24:54 +00:00
CRUserProfile u p -> ttyUser u $ viewUserProfile p
CRUserProfileNoChange u -> ttyUser u [ " user profile did not change " ]
2023-03-29 17:39:04 +01:00
CRUserPrivacy u u' -> ttyUserPrefix u $ viewUserPrivacy u u'
2023-03-27 18:34:48 +01:00
CRVersionInfo info _ _ -> viewVersionInfo logLevel info
2023-08-08 17:25:28 +04:00
CRInvitation u cReq _ -> ttyUser u $ viewConnReqInvitation cReq
CRConnectionIncognitoUpdated u c -> ttyUser u $ viewConnectionIncognitoUpdated c
2023-01-13 12:24:54 +00:00
CRSentConfirmation u -> ttyUser u [ " confirmation sent! " ]
CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
CRContactDeleted u c -> ttyUser u [ ttyContact' c <> " : contact is deleted " ]
CRChatCleared u chatInfo -> ttyUser u $ viewChatCleared chatInfo
CRAcceptingContactRequest u c -> ttyUser u [ ttyFullContact c <> " : accepting contact request... " ]
CRContactAlreadyExists u c -> ttyUser u [ ttyFullContact c <> " : contact already exists " ]
CRContactRequestAlreadyAccepted u c -> ttyUser u [ ttyFullContact c <> " : sent you a duplicate contact request, but you are already connected, no action needed " ]
CRUserContactLinkCreated u cReq -> ttyUser u $ connReqContact_ " Your new chat address is created! " cReq
CRUserContactLinkDeleted u -> ttyUser u viewUserContactLinkDeleted
CRUserAcceptedGroupSent u _g _ -> ttyUser u [] -- [ttyGroup' g <> ": joining the group..."]
CRUserDeletedMember u g m -> ttyUser u [ ttyGroup' g <> " : you removed " <> ttyMember m <> " from the group " ]
CRLeftMemberUser u g -> ttyUser u $ [ ttyGroup' g <> " : you left the group " ] <> groupPreserved g
CRGroupDeletedUser u g -> ttyUser u [ ttyGroup' g <> " : you deleted the group " ]
2023-03-13 10:30:32 +00:00
CRRcvFileDescrReady _ _ -> []
CRRcvFileDescrNotReady _ _ -> []
2023-05-15 12:28:53 +02:00
CRRcvFileProgressXFTP { } -> []
2023-09-01 19:43:27 +01:00
CRRcvFileAccepted u ci -> ttyUser u $ savingFile' testView ci
2023-01-13 12:24:54 +00:00
CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
2023-03-29 17:18:44 +04:00
CRSndFileCancelled u _ ftm fts -> ttyUser u $ viewSndFileCancelled ftm fts
CRRcvFileCancelled u _ ft -> ttyUser u $ receivingFile_ " cancelled " ft
2023-08-22 16:13:57 +01:00
CRUserProfileUpdated u p p' summary -> ttyUser u $ viewUserProfileUpdated p p' summary
2023-06-17 10:34:04 +01:00
CRUserProfileImage u p -> ttyUser u $ viewUserProfileImage p
2023-01-13 12:24:54 +00:00
CRContactPrefsUpdated { user = u , fromContact , toContact } -> ttyUser u $ viewUserContactPrefsUpdated u fromContact toContact
CRContactAliasUpdated u c -> ttyUser u $ viewContactAliasUpdated c
CRConnectionAliasUpdated u c -> ttyUser u $ viewConnectionAliasUpdated c
CRContactUpdated { user = u , fromContact = c , toContact = c' } -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
CRContactsMerged u intoCt mergedCt -> ttyUser u $ viewContactsMerged intoCt mergedCt
CRReceivedContactRequest u UserContactRequest { localDisplayName = c , profile } -> ttyUser u $ viewReceivedContactRequest c profile
CRRcvFileStart u ci -> ttyUser u $ receivingFile_' " started " ci
CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' " completed " ci
2023-03-29 17:18:44 +04:00
CRRcvFileSndCancelled u _ ft -> ttyUser u $ viewRcvFileSndCancelled ft
2023-04-18 12:48:36 +04:00
CRRcvFileError u ci -> ttyUser u $ receivingFile_' " error " ci
2023-01-13 12:24:54 +00:00
CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ " started " ft
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ " completed " ft
2023-04-18 12:48:36 +04:00
CRSndFileStartXFTP { } -> []
CRSndFileProgressXFTP { } -> []
CRSndFileCompleteXFTP u ci _ -> ttyUser u $ uploadingFile " completed " ci
CRSndFileCancelledXFTP { } -> []
CRSndFileError u ci -> ttyUser u $ uploadingFile " error " ci
2023-01-11 11:00:28 +04:00
CRSndFileRcvCancelled u _ ft @ SndFileTransfer { recipientDisplayName = c } ->
2023-01-14 15:45:13 +04:00
ttyUser u [ ttyContact c <> " cancelled receiving " <> sndFile ft ]
2023-01-13 12:24:54 +00:00
CRContactConnecting u _ -> ttyUser u []
CRContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView
CRContactAnotherClient u c -> ttyUser u [ ttyContact' c <> " : contact is connected to another client " ]
CRSubscriptionEnd u acEntity -> ttyUser u [ sShow ( connId ( entityConnection acEntity :: Connection ) ) <> " : END " ]
2023-01-20 15:02:27 +04:00
CRContactsDisconnected srv cs -> [ plain $ " server disconnected " <> showSMPServer srv <> " ( " <> contactList cs <> " ) " ]
CRContactsSubscribed srv cs -> [ plain $ " server connected " <> showSMPServer srv <> " ( " <> contactList cs <> " ) " ]
2023-02-04 23:13:20 +00:00
CRContactSubError u c e -> ttyUser u [ ttyContact' c <> " : contact error " <> sShow e ]
2023-01-14 15:45:13 +04:00
CRContactSubSummary u summary ->
ttyUser u $ [ sShow ( length subscribed ) <> " contacts connected (use " <> highlight' " /cs " <> " for the list) " | not ( null subscribed ) ] <> viewErrorsSummary errors " contact errors "
2022-02-25 16:29:36 +04:00
where
2022-02-26 20:21:32 +00:00
( errors , subscribed ) = partition ( isJust . contactError ) summary
2023-01-14 15:45:13 +04:00
CRUserContactSubSummary u summary ->
ttyUser u $
map addressSS addresses
<> ( [ sShow ( length groupLinksSubscribed ) <> " group links active " | not ( null groupLinksSubscribed ) ] <> viewErrorsSummary groupLinkErrors " group link errors " )
2022-10-13 17:12:22 +04:00
where
( addresses , groupLinks ) = partition ( \ UserContactSubStatus { userContact } -> isNothing . userContactGroupId $ userContact ) summary
addressSS UserContactSubStatus { userContactError } = maybe ( " Your address is active! To show: " <> highlight' " /sa " ) ( \ e -> " User address error: " <> sShow e <> " , to delete your address: " <> highlight' " /da " ) userContactError
( groupLinkErrors , groupLinksSubscribed ) = partition ( isJust . userContactError ) groupLinks
2023-01-14 15:45:13 +04:00
CRGroupInvitation u g -> ttyUser u [ groupInvitation' g ]
2023-08-01 20:54:51 +01:00
CRReceivedGroupInvitation { user = u , groupInfo = g , contact = c , memberRole = r } -> ttyUser u $ viewReceivedGroupInvitation g c r
2023-01-13 12:24:54 +00:00
CRUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g
CRJoinedGroupMember u g m -> ttyUser u $ viewJoinedGroupMember g m
2022-08-13 14:18:12 +01:00
CRHostConnected p h -> [ plain $ " connected to " <> viewHostEvent p h ]
CRHostDisconnected p h -> [ plain $ " disconnected from " <> viewHostEvent p h ]
2023-01-13 12:24:54 +00:00
CRJoinedGroupMemberConnecting u g host m -> ttyUser u [ ttyGroup' g <> " : " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...) " ]
2023-06-09 16:43:53 +04:00
CRConnectedToGroupMember u g m _ -> ttyUser u [ ttyGroup' g <> " : " <> connectedMember m <> " is connected " ]
2023-01-13 12:24:54 +00:00
CRMemberRole u g by m r r' -> ttyUser u $ viewMemberRoleChanged g by m r r'
CRMemberRoleUser u g m r r' -> ttyUser u $ viewMemberRoleUserChanged g m r r'
CRDeletedMemberUser u g by -> ttyUser u $ [ ttyGroup' g <> " : " <> ttyMember by <> " removed you from the group " ] <> groupPreserved g
CRDeletedMember u g by m -> ttyUser u [ ttyGroup' g <> " : " <> ttyMember by <> " removed " <> ttyMember m <> " from the group " ]
CRLeftMember u g m -> ttyUser u [ ttyGroup' g <> " : " <> ttyMember m <> " left the group " ]
2023-01-14 15:45:13 +04:00
CRGroupEmpty u g -> ttyUser u [ ttyFullGroup g <> " : group is empty " ]
CRGroupRemoved u g -> ttyUser u [ ttyFullGroup g <> " : you are no longer a member or group deleted " ]
2023-01-13 12:24:54 +00:00
CRGroupDeleted u g m -> ttyUser u [ ttyGroup' g <> " : " <> ttyMember m <> " deleted the group " , " use " <> highlight ( " /d # " <> groupName' g ) <> " to delete the local copy of the group " ]
CRGroupUpdated u g g' m -> ttyUser u $ viewGroupUpdated g g' m
CRGroupProfile u g -> ttyUser u $ viewGroupProfile g
2023-08-01 20:54:51 +01:00
CRGroupDescription u g -> ttyUser u $ viewGroupDescription g
2023-03-06 09:51:42 +00:00
CRGroupLinkCreated u g cReq mRole -> ttyUser u $ groupLink_ " Group link is created! " g cReq mRole
CRGroupLink u g cReq mRole -> ttyUser u $ groupLink_ " Group link: " g cReq mRole
2023-01-13 12:24:54 +00:00
CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
2023-01-04 21:06:28 +04:00
CRAcceptingGroupJoinRequest _ g c -> [ ttyFullContact c <> " : accepting request to join group " <> ttyGroup' g <> " ... " ]
2023-01-14 15:45:13 +04:00
CRMemberSubError u g m e -> ttyUser u [ ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e ]
CRMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary ( filter ( isJust . memberError ) summary ) " group member errors "
CRGroupSubscribed u g -> ttyUser u $ viewGroupSubscribed g
CRPendingSubSummary u _ -> ttyUser u []
CRSndFileSubError u SndFileTransfer { fileId , fileName } e ->
ttyUser u [ " sent file " <> sShow fileId <> " ( " <> plain fileName <> " ) error: " <> sShow e ]
CRRcvFileSubError u RcvFileTransfer { fileId , fileInvitation = FileInvitation { fileName } } e ->
ttyUser u [ " received file " <> sShow fileId <> " ( " <> plain fileName <> " ) error: " <> sShow e ]
2023-01-19 16:00:41 +00:00
CRCallInvitation RcvCallInvitation { user , contact , callType , sharedKey } -> ttyUser user $ viewCallInvitation contact callType sharedKey
2023-01-13 12:24:54 +00:00
CRCallOffer { user = u , contact , callType , offer , sharedKey } -> ttyUser u $ viewCallOffer contact callType offer sharedKey
CRCallAnswer { user = u , contact , answer } -> ttyUser u $ viewCallAnswer contact answer
CRCallExtraInfo { user = u , contact } -> ttyUser u [ " call extra info from " <> ttyContact' contact ]
CRCallEnded { user = u , contact } -> ttyUser u [ " call with " <> ttyContact' contact <> " ended " ]
2023-01-16 15:06:03 +04:00
CRCallInvitations _ -> []
2022-01-24 16:07:17 +00:00
CRUserContactLinkSubscribed -> [ " Your address is active! To show: " <> highlight' " /sa " ]
CRUserContactLinkSubError e -> [ " user address error: " <> sShow e , " to delete your address: " <> highlight' " /da " ]
2023-01-13 12:24:54 +00:00
CRNewContactConnection u _ -> ttyUser u []
CRContactConnectionDeleted u PendingContactConnection { pccConnId } -> ttyUser u [ " connection : " <> sShow pccConnId <> " deleted " ]
2022-04-22 20:32:19 +01:00
CRNtfTokenStatus status -> [ " device token status: " <> plain ( smpEncode status ) ]
2022-06-25 17:02:16 +01:00
CRNtfToken _ status mode -> [ " device token status: " <> plain ( smpEncode status ) <> " , notifications mode: " <> plain ( strEncode mode ) ]
2022-06-19 14:44:13 +01:00
CRNtfMessages { } -> []
2022-09-17 16:06:27 +01:00
CRSQLResult rows -> map plain rows
2023-08-12 18:27:10 +01:00
CRSlowSQLQueries { chatQueries , agentQueries } ->
2023-08-16 21:21:12 +04:00
let viewQuery SlowSQLQuery { query , queryStats = SlowQueryStats { count , timeMax , timeAvg } } =
2023-09-01 19:43:27 +01:00
( " count: " <> sShow count )
2023-08-16 21:21:12 +04:00
<> ( " :: max: " <> sShow timeMax <> " ms " )
<> ( " :: avg: " <> sShow timeAvg <> " ms " )
<> ( " :: " <> plain ( T . unwords $ T . lines query ) )
2023-08-12 18:27:10 +01:00
in ( " Chat queries " : map viewQuery chatQueries ) <> [ " " ] <> ( " Agent queries " : map viewQuery agentQueries )
2022-10-22 21:22:44 +01:00
CRDebugLocks { chatLockName , agentLocks } ->
[ maybe " no chat lock " ( ( " chat lock: " <> ) . plain ) chatLockName ,
plain $ " agent locks: " <> LB . unpack ( J . encode agentLocks )
]
2022-12-26 22:24:34 +00:00
CRAgentStats stats -> map ( plain . intercalate " , " ) stats
2023-08-25 14:10:40 +01:00
CRAgentSubs { activeSubs , distinctActiveSubs , pendingSubs , distinctPendingSubs } ->
[ plain $ " Subscriptions: active = " <> show ( sum activeSubs ) <> " , distinct active = " <> show ( sum distinctActiveSubs ) <> " , pending = " <> show ( sum pendingSubs ) <> " , distinct pending = " <> show ( sum distinctPendingSubs ) ]
<> ( " active subscriptions: " : listSubs activeSubs )
<> ( " distinct active subscriptions: " : listSubs distinctActiveSubs )
<> ( " pending subscriptions: " : listSubs pendingSubs )
<> ( " distinct pending subscriptions: " : listSubs distinctPendingSubs )
where
listSubs = map ( \ ( srv , count ) -> plain $ srv <> " : " <> tshow count ) . M . assocs
CRAgentSubsDetails SubscriptionsInfo { activeSubscriptions , pendingSubscriptions } ->
( " active subscriptions: " : map sShow activeSubscriptions )
<> ( " pending subscriptions: " : map sShow pendingSubscriptions )
2023-01-07 19:47:51 +04:00
CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
2023-01-24 20:07:35 +04:00
CRAgentRcvQueueDeleted acId srv aqId err_ ->
2023-09-01 19:43:27 +01:00
[ ( " completed deleting rcv queue, agent connection id: " <> sShow acId )
2023-01-24 20:07:35 +04:00
<> ( " , server: " <> sShow srv )
<> ( " , agent queue id: " <> sShow aqId )
<> maybe " " ( \ e -> " , error: " <> sShow e ) err_
| logLevel <= CLLInfo
]
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 " " ]
2023-01-16 16:10:43 +04:00
CRMessageError u prefix err -> ttyUser u [ plain prefix <> " : " <> plain err | prefix == " error " || logLevel <= CLLWarning ]
2023-03-22 15:58:01 +00:00
CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError logLevel e
2023-01-16 16:10:43 +04:00
CRChatError u e -> ttyUser' u $ viewChatError logLevel e
2023-05-23 15:54:44 +04:00
CRArchiveImported archiveErrs -> if null archiveErrs then [ " ok " ] else [ " archive import errors: " <> plain ( show archiveErrs ) ]
2023-05-10 15:18:50 +04:00
CRTimedAction _ _ -> []
2022-01-24 16:07:17 +00:00
where
2023-01-13 12:24:54 +00:00
ttyUser :: User -> [ StyledString ] -> [ StyledString ]
2023-03-22 15:58:01 +00:00
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
2023-01-13 12:24:54 +00:00
where
userPrefix = case user_ of
Just User { userId = activeUserId } -> if userId /= activeUserId then prefix else " "
_ -> prefix
prefix = " [user: " <> highlight u <> " ] "
ttyUser' :: Maybe User -> [ StyledString ] -> [ StyledString ]
ttyUser' = maybe id ttyUser
2023-03-22 15:58:01 +00:00
ttyUserPrefix' :: Maybe User -> [ StyledString ] -> [ StyledString ]
ttyUserPrefix' = maybe id ttyUserPrefix
2022-02-09 20:58:02 +04:00
testViewChats :: [ AChat ] -> [ StyledString ]
testViewChats chats = [ sShow $ map toChatView chats ]
where
2022-04-24 09:05:54 +01:00
toChatView :: AChat -> ( Text , Text , Maybe ConnStatus )
2023-02-08 22:29:36 +04:00
toChatView ( AChat _ ( Chat ( DirectChat Contact { localDisplayName , activeConn } ) items _ ) ) = ( " @ " <> localDisplayName , toCIPreview items Nothing , Just $ connStatus activeConn )
toChatView ( AChat _ ( Chat ( GroupChat GroupInfo { membership , localDisplayName } ) items _ ) ) = ( " # " <> localDisplayName , toCIPreview items ( Just membership ) , Nothing )
toChatView ( AChat _ ( Chat ( ContactRequest UserContactRequest { localDisplayName } ) items _ ) ) = ( " <@ " <> localDisplayName , toCIPreview items Nothing , Nothing )
toChatView ( AChat _ ( Chat ( ContactConnection PendingContactConnection { pccConnId , pccConnStatus } ) items _ ) ) = ( " : " <> T . pack ( show pccConnId ) , toCIPreview items Nothing , Just pccConnStatus )
toCIPreview :: [ CChatItem c ] -> Maybe GroupMember -> Text
toCIPreview ( ci : _ ) membership_ = testViewItem ci membership_
toCIPreview _ _ = " "
2022-02-09 20:58:02 +04:00
testViewChat :: AChat -> [ StyledString ]
2023-02-08 22:29:36 +04:00
testViewChat ( AChat _ Chat { chatInfo , chatItems } ) = [ sShow $ map toChatView chatItems ]
2022-02-09 20:58:02 +04:00
where
2022-04-10 13:30:58 +04:00
toChatView :: CChatItem c -> ( ( Int , Text ) , Maybe ( Int , Text ) , Maybe String )
2022-11-30 19:42:33 +04:00
toChatView ci @ ( CChatItem dir ChatItem { quotedItem , file } ) =
2023-02-08 22:29:36 +04:00
( ( msgDirectionInt $ toMsgDirection dir , testViewItem ci ( chatInfoMembership chatInfo ) ) , qItem , fPath )
2022-04-10 13:30:58 +04:00
where
qItem = case quotedItem of
Nothing -> Nothing
Just CIQuote { chatDir = quoteDir , content } ->
Just ( msgDirectionInt $ quoteMsgDirection quoteDir , msgContentText content )
fPath = case file of
2023-09-01 19:43:27 +01:00
Just CIFile { fileSource = Just ( CryptoFile fp _ ) } -> Just fp
2022-04-10 13:30:58 +04:00
_ -> Nothing
2023-02-08 22:29:36 +04:00
testViewItem :: CChatItem c -> Maybe GroupMember -> Text
testViewItem ( CChatItem _ ci @ ChatItem { meta = CIMeta { itemText } } ) membership_ =
let deleted_ = maybe " " ( \ t -> " [ " <> t <> " ] " ) ( chatItemDeletedText ci membership_ )
in itemText <> deleted_
2022-02-25 16:29:36 +04:00
viewErrorsSummary :: [ a ] -> StyledString -> [ StyledString ]
2022-03-19 09:04:53 +00:00
viewErrorsSummary summary s = [ ttyError ( T . pack . show $ length summary ) <> s <> " (run with -c option to show each error) " | not ( null summary ) ]
2022-04-25 09:17:12 +01:00
contactList :: [ ContactRef ] -> String
contactList cs = T . unpack . T . intercalate " , " $ map ( \ ContactRef { localDisplayName = n } -> " @ " <> n ) cs
2022-09-05 15:23:38 +01:00
unmuted :: ChatInfo c -> ChatItem c d -> [ StyledString ] -> [ StyledString ]
2023-05-15 12:28:53 +02:00
unmuted chat ChatItem { chatDir } = unmuted' chat chatDir
unmutedReaction :: ChatInfo c -> CIReaction c d -> [ StyledString ] -> [ StyledString ]
unmutedReaction chat CIReaction { chatDir } = unmuted' chat chatDir
unmuted' :: ChatInfo c -> CIDirection c d -> [ StyledString ] -> [ StyledString ]
unmuted' chat chatDir s
| muted chat chatDir = []
2022-12-16 15:56:16 +04:00
| otherwise = s
2022-12-15 15:17:29 +04:00
2023-02-08 22:29:36 +04:00
chatItemDeletedText :: ChatItem c d -> Maybe GroupMember -> Maybe Text
chatItemDeletedText ci membership_ = deletedStateToText <$> chatItemDeletedState ci
2023-02-08 07:08:53 +00:00
where
deletedStateToText = \ CIDeletedState { markedDeleted , deletedByMember } ->
if markedDeleted
then " marked deleted " <> byMember deletedByMember
else " deleted " <> byMember deletedByMember
2023-02-08 22:29:36 +04:00
byMember m_ = case ( m_ , membership_ ) of
( Just GroupMember { groupMemberId = mId , localDisplayName = n } , Just GroupMember { groupMemberId = membershipId } ) ->
" by " <> if mId == membershipId then " you " else n
_ -> " "
2023-02-08 07:08:53 +00:00
2023-01-16 22:57:31 +04:00
viewUsersList :: [ UserInfo ] -> [ StyledString ]
2023-03-22 15:58:01 +00:00
viewUsersList = mapMaybe userInfo . sortOn ldn
2023-01-04 21:06:28 +04:00
where
2023-01-16 22:57:31 +04:00
ldn ( UserInfo User { localDisplayName = n } _ ) = T . toLower n
2023-03-22 15:58:01 +00:00
userInfo ( UserInfo User { localDisplayName = n , profile = LocalProfile { fullName } , activeUser , showNtfs , viewPwdHash } count )
| activeUser || isNothing viewPwdHash = Just $ ttyFullName n fullName <> infoStr
| otherwise = Nothing
2023-01-16 22:57:31 +04:00
where
2023-03-22 15:58:01 +00:00
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 ]
2023-01-04 21:06:28 +04:00
2023-05-15 12:28:53 +02:00
muted :: ChatInfo c -> CIDirection c d -> Bool
muted chat chatDir = case ( chat , chatDir ) of
2022-12-15 15:17:29 +04:00
( DirectChat Contact { chatSettings = DisableNtfs } , CIDirectRcv ) -> True
( GroupChat GroupInfo { chatSettings = DisableNtfs } , CIGroupRcv _ ) -> True
_ -> False
2021-06-25 18:18:24 +01:00
2022-08-18 11:35:31 +04:00
viewGroupSubscribed :: GroupInfo -> [ StyledString ]
2022-12-19 11:16:50 +00:00
viewGroupSubscribed g = [ membershipIncognito g <> ttyFullGroup g <> " : connected to server(s) " ]
2022-08-18 11:35:31 +04:00
2022-08-13 11:53:53 +01:00
showSMPServer :: SMPServer -> String
showSMPServer = B . unpack . strEncode . host
2022-08-13 14:18:12 +01:00
viewHostEvent :: AProtocolType -> TransportHost -> String
viewHostEvent p h = map toUpper ( B . unpack $ strEncode p ) <> " host " <> B . unpack ( strEncode h )
2023-06-08 11:07:21 +04:00
viewChats :: CurrentTime -> TimeZone -> [ AChat ] -> [ StyledString ]
viewChats ts tz = concatMap chatPreview . reverse
2023-01-16 12:10:47 +00:00
where
chatPreview ( AChat _ ( Chat chat items _ ) ) = case items of
2023-06-08 11:07:21 +04:00
CChatItem _ ci : _ -> case viewChatItem chat ci True ts tz of
2023-01-16 12:10:47 +00:00
s : _ -> [ let s' = sTake 120 s in if sLength s' < sLength s then s' <> " ... " else s' ]
_ -> chatName
_ -> chatName
where
chatName = case chat of
DirectChat ct -> [ " " <> ttyToContact' ct ]
GroupChat g -> [ " " <> ttyToGroup g ]
_ -> []
2023-06-08 11:07:21 +04:00
viewChatItem :: forall c d . MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [ StyledString ]
viewChatItem chat ci @ ChatItem { chatDir , meta = meta , content , quotedItem , file } doShow ts tz =
2022-11-30 19:42:33 +04:00
withItemDeleted <$> case chat of
DirectChat c -> case chatDir of
CIDirectSnd -> case content of
2022-12-19 11:16:50 +00:00
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc
2022-11-30 19:42:33 +04:00
CISndGroupEvent { } -> showSndItemProhibited to
_ -> showSndItem to
where
to = ttyToContact' c
CIDirectRcv -> case content of
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
2023-06-08 11:07:21 +04:00
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
2022-11-30 19:42:33 +04:00
CIRcvGroupEvent { } -> showRcvItemProhibited from
_ -> showRcvItem from
where
2022-12-19 11:16:50 +00:00
from = ttyFromContact c
2022-03-13 19:34:03 +00:00
where
2022-11-30 19:42:33 +04:00
quote = maybe [] ( directQuote chatDir ) quotedItem
GroupChat g -> case chatDir of
CIGroupSnd -> case content of
2022-12-19 11:16:50 +00:00
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc
2022-11-30 19:42:33 +04:00
CISndGroupInvitation { } -> showSndItemProhibited to
_ -> showSndItem to
where
to = ttyToGroup g
CIGroupRcv m -> case content of
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
2023-06-08 11:07:21 +04:00
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
2022-11-30 19:42:33 +04:00
CIRcvGroupInvitation { } -> showRcvItemProhibited from
2023-06-22 20:38:09 +04:00
CIRcvModerated { } -> receivedWithTime_ ts tz ( ttyFromGroup g m ) quote meta [ plainContent content ] False
2022-11-30 19:42:33 +04:00
_ -> showRcvItem from
where
2022-12-19 11:16:50 +00:00
from = ttyFromGroup g m
2022-03-13 19:34:03 +00:00
where
2022-11-30 19:42:33 +04:00
quote = maybe [] ( groupQuote g ) quotedItem
_ -> []
2022-04-10 13:30:58 +04:00
where
2023-02-08 22:29:36 +04:00
withItemDeleted item = case chatItemDeletedText ci ( chatInfoMembership chat ) of
Nothing -> item
Just t -> item <> styled ( colored Red ) ( " [ " <> t <> " ] " )
2022-04-19 12:29:03 +04:00
withSndFile = withFile viewSentFileInvitation
withRcvFile = withFile viewReceivedFileInvitation
2023-06-08 11:07:21 +04:00
withFile view dir l = maybe l ( \ f -> l <> view dir f ts tz meta ) file
2022-04-19 12:29:03 +04:00
sndMsg = msg viewSentMessage
rcvMsg = msg viewReceivedMessage
2022-05-05 11:52:32 +01:00
msg view dir quote mc = case ( msgContentText mc , file , quote ) of
( " " , Just _ , [] ) -> []
2023-06-08 11:07:21 +04:00
( " " , Just CIFile { fileName } , _ ) -> view dir quote ( MCText $ T . pack fileName ) ts tz meta
_ -> view dir quote mc ts tz meta
showSndItem to = showItem $ sentWithTime_ ts tz [ to <> plainContent content ] meta
showRcvItem from = showItem $ receivedWithTime_ ts tz from [] meta [ plainContent content ] False
showSndItemProhibited to = showItem $ sentWithTime_ ts tz [ to <> plainContent content <> " " <> prohibited ] meta
showRcvItemProhibited from = showItem $ receivedWithTime_ ts tz from [] meta [ plainContent content <> " " <> prohibited ] False
2022-07-20 16:56:55 +04:00
showItem ss = if doShow then ss else []
plainContent = plain . ciContentToText
2022-11-30 19:42:33 +04:00
prohibited = styled ( colored Red ) ( " [unexpected chat item created, please report to developers] " :: String )
2022-03-23 11:37:51 +00:00
2023-05-08 20:07:51 +04:00
viewChatItemInfo :: AChatItem -> ChatItemInfo -> TimeZone -> [ StyledString ]
2023-05-18 17:52:58 +02:00
viewChatItemInfo ( AChatItem _ msgDir _ ChatItem { meta = CIMeta { itemTs , itemTimed , createdAt } } ) ChatItemInfo { itemVersions } tz =
2023-05-15 21:07:03 +04:00
[ " sent at: " <> ts itemTs ]
<> receivedAt
<> toBeDeletedAt
<> versions
2023-05-08 20:07:51 +04:00
where
ts = styleTime . localTs tz
2023-05-15 21:07:03 +04:00
receivedAt = case msgDir of
SMDRcv -> [ " received at: " <> ts createdAt ]
SMDSnd -> []
2023-05-18 17:52:58 +02:00
toBeDeletedAt = case itemTimed >>= timedDeleteAt' of
2023-05-15 21:07:03 +04:00
Just d -> [ " to be deleted at: " <> ts d ]
Nothing -> []
2023-05-08 20:07:51 +04:00
versions =
if null itemVersions
then []
else [ " message history: " ] <> concatMap version itemVersions
version ChatItemVersion { msgContent , itemVersionTs } = prependFirst ( ts itemVersionTs <> styleTime " : " ) $ ttyMsgContent msgContent
localTs :: TimeZone -> UTCTime -> String
localTs tz ts = do
let localTime = utcToLocalTime tz ts
formattedTime = formatTime defaultTimeLocale " %Y-%m-%d %H:%M:%S " localTime
formattedTime
2023-07-13 23:48:25 +01:00
viewChatItemStatusUpdated :: AChatItem -> CurrentTime -> TimeZone -> Bool -> Bool -> [ StyledString ]
viewChatItemStatusUpdated ( AChatItem _ _ chat item @ ChatItem { meta = CIMeta { itemStatus } } ) ts tz testView showReceipts =
case itemStatus of
2023-07-26 14:49:35 +04:00
CISSndRcvd rcptStatus SSPPartial ->
if testView && showReceipts
then prependFirst ( viewDeliveryReceiptPartial rcptStatus <> " " ) $ viewChatItem chat item False ts tz
else []
CISSndRcvd rcptStatus SSPComplete ->
2023-07-13 23:48:25 +01:00
if testView && showReceipts
then prependFirst ( viewDeliveryReceipt rcptStatus <> " " ) $ viewChatItem chat item False ts tz
else []
_ -> []
2023-07-26 14:49:35 +04:00
viewDeliveryReceiptPartial :: MsgReceiptStatus -> StyledString
viewDeliveryReceiptPartial = \ case
MROk -> " % "
MRBadMsgHash -> ttyError' " %! "
2023-07-13 23:48:25 +01:00
viewDeliveryReceipt :: MsgReceiptStatus -> StyledString
viewDeliveryReceipt = \ case
MROk -> " ⩗ "
MRBadMsgHash -> ttyError' " ⩗! "
2023-06-08 11:07:21 +04:00
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [ StyledString ]
viewItemUpdate chat ChatItem { chatDir , meta = meta @ CIMeta { itemEdited , itemLive } , content , quotedItem } liveItems ts tz = case chat of
2022-12-19 11:16:50 +00:00
DirectChat c -> case chatDir of
2022-03-23 11:37:51 +00:00
CIDirectRcv -> case content of
2022-12-19 11:16:50 +00:00
CIRcvMsgContent mc
| itemLive == Just True && not liveItems -> []
2023-06-08 11:07:21 +04:00
| otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
2022-03-23 11:37:51 +00:00
_ -> []
2022-03-13 19:34:03 +00:00
where
2022-12-19 11:16:50 +00:00
from = if itemEdited then ttyFromContactEdited c else ttyFromContact c
CIDirectSnd -> case content of
2023-06-08 11:07:21 +04:00
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
2022-12-19 11:16:50 +00:00
_ -> []
where
to = if itemEdited then ttyToContactEdited' c else ttyToContact' c
where
quote = maybe [] ( directQuote chatDir ) quotedItem
2022-03-23 11:37:51 +00:00
GroupChat g -> case chatDir of
2022-12-19 11:16:50 +00:00
CIGroupRcv m -> case content of
CIRcvMsgContent mc
| itemLive == Just True && not liveItems -> []
2023-06-08 11:07:21 +04:00
| otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
2022-03-23 11:37:51 +00:00
_ -> []
where
2022-12-19 11:16:50 +00:00
from = if itemEdited then ttyFromGroupEdited g m else ttyFromGroup g m
CIGroupSnd -> case content of
2023-06-08 11:07:21 +04:00
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
2022-12-19 11:16:50 +00:00
_ -> []
where
to = if itemEdited then ttyToGroupEdited g else ttyToGroup g
where
quote = maybe [] ( groupQuote g ) quotedItem
2022-03-28 20:35:57 +04:00
_ -> []
2023-07-13 23:48:25 +01:00
hideLive :: CIMeta c d -> [ StyledString ] -> [ StyledString ]
2022-12-19 11:16:50 +00:00
hideLive CIMeta { itemLive = Just True } _ = []
hideLive _ s = s
2023-05-11 16:00:01 +04:00
viewItemNotChanged :: AChatItem -> [ StyledString ]
viewItemNotChanged ( AChatItem _ msgDir _ _ ) = case msgDir of
SMDSnd -> [ " message didn't change " ]
SMDRcv -> []
2023-06-08 11:07:21 +04:00
viewItemDelete :: ChatInfo c -> ChatItem c d -> Maybe AChatItem -> Bool -> Bool -> CurrentTime -> TimeZone -> Bool -> [ StyledString ]
viewItemDelete chat ci @ ChatItem { chatDir , meta , content = deletedContent } toItem byUser timed ts tz testView
2023-02-08 07:08:53 +00:00
| timed = [ plain ( " timed message deleted: " <> T . unpack ( ciContentToText deletedContent ) ) | testView ]
| byUser = [ plain $ " message " <> T . unpack ( fromMaybe " deleted " deletedText_ ) ] -- deletedText_ Nothing should be impossible here
2022-11-30 19:42:33 +04:00
| otherwise = case chat of
2022-12-19 11:16:50 +00:00
DirectChat c -> case ( chatDir , deletedContent ) of
2023-06-08 11:07:21 +04:00
( CIDirectRcv , CIRcvMsgContent mc ) -> viewReceivedMessage ( ttyFromContactDeleted c deletedText_ ) [] mc ts tz meta
2022-11-30 19:42:33 +04:00
_ -> prohibited
2023-05-19 14:52:51 +02:00
GroupChat g -> case ciMsgContent deletedContent of
Just mc ->
let m = chatItemMember g ci
2023-06-08 11:07:21 +04:00
in viewReceivedMessage ( ttyFromGroupDeleted g m deletedText_ ) [] mc ts tz meta
2022-11-30 19:42:33 +04:00
_ -> prohibited
_ -> prohibited
where
2023-02-08 07:08:53 +00:00
deletedText_ :: Maybe Text
deletedText_ = case toItem of
Nothing -> Just " deleted "
2023-05-19 14:52:51 +02:00
Just ( AChatItem _ _ _ ci' ) -> chatItemDeletedText ci' $ chatInfoMembership chat
2022-11-30 19:42:33 +04:00
prohibited = [ styled ( colored Red ) ( " [unexpected message deletion, please report to developers] " :: String ) ]
2022-03-23 11:37:51 +00:00
2023-05-16 10:34:25 +02:00
viewItemReaction :: forall c d . Bool -> ChatInfo c -> CIReaction c d -> Bool -> CurrentTime -> TimeZone -> [ StyledString ]
viewItemReaction showReactions chat CIReaction { chatDir , chatItem = CChatItem md ChatItem { chatDir = itemDir , content } , sentAt , reaction } added ts tz =
2023-05-15 12:28:53 +02:00
case ( chat , chatDir ) of
2023-05-19 14:52:51 +02:00
( DirectChat c , CIDirectRcv ) -> case ciMsgContent content of
Just mc -> view from $ reactionMsg mc
2023-05-15 12:28:53 +02:00
_ -> []
where
from = ttyFromContact c
reactionMsg mc = quoteText mc $ if toMsgDirection md == MDSnd then " >> " else " > "
2023-05-19 14:52:51 +02:00
( GroupChat g , CIGroupRcv m ) -> case ciMsgContent content of
Just mc -> view from $ reactionMsg mc
2023-05-15 12:28:53 +02:00
_ -> []
where
from = ttyFromGroup g m
reactionMsg mc = quoteText mc . ttyQuotedMember . Just $ sentByMember' g itemDir
( _ , CIDirectSnd ) -> [ sentText ]
( _ , CIGroupSnd ) -> [ sentText ]
where
2023-05-16 10:34:25 +02:00
view from msg
2023-06-08 11:07:21 +04:00
| showReactions = viewReceivedReaction from msg reactionText ts tz sentAt
2023-05-16 10:34:25 +02:00
| otherwise = []
2023-05-15 12:28:53 +02:00
reactionText = plain $ ( if added then " + " else " - " ) <> [ emoji ]
2023-05-17 01:22:00 +02:00
emoji = case reaction of
MREmoji ( MREmojiChar c ) -> c
_ -> '?'
2023-05-15 12:28:53 +02:00
sentText = plain $ ( if added then " added " else " removed " ) <> [ emoji ]
viewItemReactions :: ChatItem c d -> [ StyledString ]
viewItemReactions ChatItem { reactions } = [ " " <> viewReactions reactions | not ( null reactions ) ]
where
viewReactions = mconcat . intersperse " " . map viewReaction
2023-05-17 01:22:00 +02:00
viewReaction CIReactionCount { reaction = MRUnknown { } } = " ? "
2023-05-15 12:28:53 +02:00
viewReaction CIReactionCount { reaction = MREmoji ( MREmojiChar emoji ) , userReacted , totalReacted } =
plain [ emoji , ' ' ] <> ( if userReacted then styled Italic else plain ) ( show totalReacted )
2022-03-23 11:37:51 +00:00
directQuote :: forall d' . MsgDirectionI d' => CIDirection 'CTDirect d' -> CIQuote 'CTDirect -> [ StyledString ]
directQuote _ CIQuote { content = qmc , chatDir = quoteDir } =
quoteText qmc $ if toMsgDirection ( msgDirection @ d' ) == quoteMsgDirection quoteDir then " >> " else " > "
groupQuote :: GroupInfo -> CIQuote 'CTGroup -> [ StyledString ]
groupQuote g CIQuote { content = qmc , chatDir = quoteDir } = quoteText qmc . ttyQuotedMember $ sentByMember g quoteDir
sentByMember :: GroupInfo -> CIQDirection 'CTGroup -> Maybe GroupMember
sentByMember GroupInfo { membership } = \ case
CIQGroupSnd -> Just membership
CIQGroupRcv m -> m
2023-05-15 12:28:53 +02:00
sentByMember' :: GroupInfo -> CIDirection 'CTGroup d -> GroupMember
sentByMember' GroupInfo { membership } = \ case
CIGroupSnd -> membership
CIGroupRcv m -> m
2022-03-23 11:37:51 +00:00
quoteText :: MsgContent -> StyledString -> [ StyledString ]
quoteText qmc sentBy = prependFirst ( sentBy <> " " ) $ msgPreview qmc
msgPreview :: MsgContent -> [ StyledString ]
msgPreview = msgPlain . preview . msgContentText
where
preview t
2022-03-30 08:57:42 +01:00
| T . length t <= 120 = t
| otherwise = T . take 120 t <> " ... "
2022-01-26 16:18:27 +04:00
2023-06-08 11:07:21 +04:00
viewRcvIntegrityError :: StyledString -> MsgErrorType -> CurrentTime -> TimeZone -> CIMeta c 'MDRcv -> [ StyledString ]
viewRcvIntegrityError from msgErr ts tz meta = receivedWithTime_ ts tz from [] meta ( viewMsgIntegrityError msgErr ) False
2022-05-28 19:13:07 +01:00
2022-02-02 11:43:52 +00:00
viewMsgIntegrityError :: MsgErrorType -> [ StyledString ]
2023-04-16 12:35:45 +02:00
viewMsgIntegrityError err = [ ttyError $ msgIntegrityError err ]
2022-02-02 11:43:52 +00:00
2022-01-21 11:09:33 +00:00
viewInvalidConnReq :: [ StyledString ]
viewInvalidConnReq =
[ " " ,
" Connection link is invalid, possibly it was created in a previous version. " ,
" Please ask your contact to check " <> highlight' " /version " <> " and update if needed. " ,
plain updateStr
]
2021-08-22 15:56:36 +01:00
2022-01-21 11:09:33 +00:00
viewConnReqInvitation :: ConnReqInvitation -> [ StyledString ]
viewConnReqInvitation cReq =
2021-12-08 13:09:51 +00:00
[ " pass this invitation link to your contact (via another channel): " ,
2021-06-25 18:18:24 +01:00
" " ,
2022-01-11 08:50:44 +00:00
( plain . strEncode ) cReq ,
2021-06-25 18:18:24 +01:00
" " ,
2021-12-08 13:09:51 +00:00
" and ask them to connect: " <> highlight' " /c <invitation_link_above> "
2021-06-25 18:18:24 +01:00
]
2022-05-17 11:22:09 +04:00
viewChatCleared :: AChatInfo -> [ StyledString ]
viewChatCleared ( AChatInfo _ chatInfo ) = case chatInfo of
DirectChat ct -> [ ttyContact' ct <> " : all messages are removed locally ONLY " ]
GroupChat gi -> [ ttyGroup' gi <> " : all messages are removed locally ONLY " ]
_ -> []
2022-01-21 11:09:33 +00:00
viewContactsList :: [ Contact ] -> [ StyledString ]
viewContactsList =
2021-12-10 11:45:58 +00:00
let ldn = T . toLower . ( localDisplayName :: Contact -> ContactName )
2022-12-19 11:16:50 +00:00
in map ( \ ct -> ctIncognito ct <> ttyFullContact ct <> muted' ct <> alias ct ) . sortOn ldn
2022-09-05 15:23:38 +01:00
where
2022-12-15 15:17:29 +04:00
muted' Contact { chatSettings , localDisplayName = ldn }
2022-09-05 15:23:38 +01:00
| enableNtfs chatSettings = " "
| otherwise = " (muted, you can " <> highlight ( " /unmute @ " <> ldn ) <> " ) "
2022-09-27 20:45:46 +01:00
alias Contact { profile = LocalProfile { localAlias } }
| localAlias == " " = " "
| otherwise = " (alias: " <> plain localAlias <> " ) "
2021-12-10 11:45:58 +00:00
2022-01-21 11:09:33 +00:00
viewUserContactLinkDeleted :: [ StyledString ]
viewUserContactLinkDeleted =
2021-12-08 13:09:51 +00:00
[ " Your chat address is deleted - accepted contacts will remain connected. " ,
" To create a new chat address use " <> highlight' " /ad "
]
connReqContact_ :: StyledString -> ConnReqContact -> [ StyledString ]
connReqContact_ intro cReq =
[ intro ,
" " ,
2022-01-11 08:50:44 +00:00
( plain . strEncode ) cReq ,
2021-12-08 13:09:51 +00:00
" " ,
" Anybody can send you contact requests with: " <> highlight' " /c <contact_link_above> " ,
" to show it again: " <> highlight' " /sa " ,
2023-06-20 10:15:28 +04:00
" to share with your contacts: " <> highlight' " /profile_address on " ,
2021-12-08 13:09:51 +00:00
" to delete it: " <> highlight' " /da " <> " (accepted contacts will remain connected) "
]
2022-10-21 19:14:12 +03:00
autoAcceptStatus_ :: Maybe AutoAccept -> [ StyledString ]
autoAcceptStatus_ = \ case
Just AutoAccept { acceptIncognito , autoReply } ->
( " auto_accept on " <> if acceptIncognito then " , incognito " else " " ) :
maybe [] ( ( [ " auto reply: " ] <> ) . ttyMsgContent ) autoReply
_ -> [ " auto_accept off " ]
2022-06-27 19:41:25 +01:00
2023-03-06 09:51:42 +00:00
groupLink_ :: StyledString -> GroupInfo -> ConnReqContact -> GroupMemberRole -> [ StyledString ]
groupLink_ intro g cReq mRole =
2022-10-13 17:12:22 +04:00
[ intro ,
" " ,
( plain . strEncode ) cReq ,
" " ,
2023-03-06 09:51:42 +00:00
" Anybody can connect to you and join group as " <> showRole mRole <> " with: " <> highlight' " /c <group_link_above> " ,
2022-10-13 17:12:22 +04:00
" to show it again: " <> highlight ( " /show link # " <> groupName' g ) ,
" to delete it: " <> highlight ( " /delete link # " <> groupName' g ) <> " (joined members will remain connected to you) "
]
viewGroupLinkDeleted :: GroupInfo -> [ StyledString ]
viewGroupLinkDeleted g =
[ " Group link is deleted - joined members will remain connected. " ,
" To create a new group link use " <> highlight ( " /create link # " <> groupName' g )
]
2022-08-18 11:35:31 +04:00
viewSentInvitation :: Maybe Profile -> Bool -> [ StyledString ]
viewSentInvitation incognitoProfile testView =
case incognitoProfile of
Just profile ->
if testView
then incognitoProfile' profile : message
else message
where
message = [ " connection request sent incognito! " ]
Nothing -> [ " connection request sent! " ]
2022-01-21 11:09:33 +00:00
viewReceivedContactRequest :: ContactName -> Profile -> [ StyledString ]
viewReceivedContactRequest c Profile { fullName } =
2021-12-08 13:09:51 +00:00
[ ttyFullName c fullName <> " wants to connect to you! " ,
" to accept: " <> highlight ( " /ac " <> c ) ,
" to reject: " <> highlight ( " /rc " <> c ) <> " (the sender will NOT be notified) "
]
2022-08-27 19:56:03 +04:00
viewGroupCreated :: GroupInfo -> [ StyledString ]
2022-12-09 18:22:03 +00:00
viewGroupCreated g @ GroupInfo { localDisplayName = n } =
2022-08-27 19:56:03 +04:00
[ " group " <> ttyFullGroup g <> " is created " ,
2022-12-09 18:22:03 +00:00
" to add members use " <> highlight ( " /a " <> n <> " <name> " ) <> " or " <> highlight ( " /create link # " <> n )
2022-08-27 19:56:03 +04:00
]
2021-07-16 07:40:55 +01:00
2022-01-26 16:18:27 +04:00
viewCannotResendInvitation :: GroupInfo -> ContactName -> [ StyledString ]
viewCannotResendInvitation GroupInfo { localDisplayName = gn } c =
[ ttyContact c <> " is already invited to group " <> ttyGroup gn ,
" to re-send invitation: " <> highlight ( " /rm " <> gn <> " " <> c ) <> " , " <> highlight ( " /a " <> gn <> " " <> c )
2022-01-06 23:39:58 +04:00
]
2022-12-03 18:06:21 +00:00
viewDirectMessagesProhibited :: MsgDirection -> Contact -> [ StyledString ]
2022-12-09 15:26:43 +00:00
viewDirectMessagesProhibited MDSnd c = [ " direct messages to indirect contact " <> ttyContact' c <> " are prohibited " ]
viewDirectMessagesProhibited MDRcv c = [ " received prohibited direct message from indirect contact " <> ttyContact' c <> " (discarded) " ]
2022-12-03 18:06:21 +00:00
2022-08-27 19:56:03 +04:00
viewUserJoinedGroup :: GroupInfo -> [ StyledString ]
viewUserJoinedGroup g @ GroupInfo { membership = membership @ GroupMember { memberProfile } } =
if memberIncognito membership
then [ ttyGroup' g <> " : you joined the group incognito as " <> incognitoProfile' ( fromLocalProfile memberProfile ) ]
2022-08-18 11:35:31 +04:00
else [ ttyGroup' g <> " : you joined the group " ]
2022-08-27 19:56:03 +04:00
viewJoinedGroupMember :: GroupInfo -> GroupMember -> [ StyledString ]
viewJoinedGroupMember g m =
[ ttyGroup' g <> " : " <> ttyMember m <> " joined the group " ]
2022-08-18 11:35:31 +04:00
2022-08-27 19:56:03 +04:00
viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [ StyledString ]
viewReceivedGroupInvitation g @ GroupInfo { membership = membership @ GroupMember { memberProfile } } c role =
ttyFullGroup g <> " : " <> ttyContact' c <> " invites you to join the group as " <> plain ( strEncode role ) :
if memberIncognito membership
then [ " use " <> highlight ( " /j " <> groupName' g ) <> " to join incognito as " <> incognitoProfile' ( fromLocalProfile memberProfile ) ]
else [ " use " <> highlight ( " /j " <> groupName' g ) <> " to accept " ]
2021-07-16 07:40:55 +01:00
2022-01-26 16:18:27 +04:00
groupPreserved :: GroupInfo -> [ StyledString ]
2022-01-27 22:01:15 +00:00
groupPreserved g = [ " use " <> highlight ( " /d # " <> groupName' g ) <> " to delete the group " ]
2021-08-02 20:10:24 +01:00
2021-07-24 10:26:28 +01:00
connectedMember :: GroupMember -> StyledString
connectedMember m = case memberCategory m of
GCPreMember -> " member " <> ttyFullMember m
GCPostMember -> " new member " <> ttyMember m -- without fullName as as it was shown in joinedGroupMemberConnecting
_ -> " member " <> ttyMember m -- these case is not used
2022-10-03 09:00:47 +01:00
viewMemberRoleChanged :: GroupInfo -> GroupMember -> GroupMember -> GroupMemberRole -> GroupMemberRole -> [ StyledString ]
viewMemberRoleChanged g @ GroupInfo { membership } by m r r'
| r == r' = [ ttyGroup' g <> " : member role did not change " ]
| groupMemberId' membership == memId = view " your role "
| groupMemberId' by == memId = view " the role "
| otherwise = view $ " the role of " <> ttyMember m
where
memId = groupMemberId' m
view s = [ ttyGroup' g <> " : " <> ttyMember by <> " changed " <> s <> " from " <> showRole r <> " to " <> showRole r' ]
viewMemberRoleUserChanged :: GroupInfo -> GroupMember -> GroupMemberRole -> GroupMemberRole -> [ StyledString ]
viewMemberRoleUserChanged g @ GroupInfo { membership } m r r'
| r == r' = [ ttyGroup' g <> " : member role did not change " ]
| groupMemberId' membership == groupMemberId' m = view " your role "
| otherwise = view $ " the role of " <> ttyMember m
where
view s = [ ttyGroup' g <> " : you changed " <> s <> " from " <> showRole r <> " to " <> showRole r' ]
showRole :: GroupMemberRole -> StyledString
showRole = plain . strEncode
2022-01-21 11:09:33 +00:00
viewGroupMembers :: Group -> [ StyledString ]
2022-01-26 16:18:27 +04:00
viewGroupMembers ( Group GroupInfo { membership } members ) = map groupMember . filter ( not . removedOrLeft ) $ membership : members
2021-07-27 08:08:05 +01:00
where
removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
2022-12-19 11:16:50 +00:00
groupMember m = memIncognito m <> ttyFullMember m <> " : " <> role m <> " , " <> category m <> status m
2022-01-11 08:50:44 +00:00
role m = plain . strEncode $ memberRole ( m :: GroupMember )
2021-07-27 08:08:05 +01:00
category m = case memberCategory m of
GCUserMember -> " you, "
GCInviteeMember -> " invited, "
GCHostMember -> " host, "
_ -> " "
status m = case memberStatus m of
GSMemRemoved -> " removed "
GSMemLeft -> " left "
GSMemInvited -> " not yet joined "
GSMemConnected -> " connected "
GSMemComplete -> " connected "
GSMemCreator -> " created group "
_ -> " "
2022-08-18 11:35:31 +04:00
viewContactConnected :: Contact -> Maybe Profile -> Bool -> [ StyledString ]
viewContactConnected ct @ Contact { localDisplayName } userIncognitoProfile testView =
case userIncognitoProfile of
Just profile ->
if testView
then incognitoProfile' profile : message
else message
where
message =
[ ttyFullContact ct <> " : contact is connected, your incognito profile for this contact is " <> incognitoProfile' profile ,
2022-12-09 18:22:03 +00:00
" use " <> highlight ( " /i " <> localDisplayName ) <> " to print out this incognito profile again "
2022-08-18 11:35:31 +04:00
]
Nothing ->
[ ttyFullContact ct <> " : contact is connected " ]
2023-08-06 11:56:40 +01:00
viewGroupsList :: [ ( GroupInfo , GroupSummary ) ] -> [ StyledString ]
2022-01-21 11:09:33 +00:00
viewGroupsList [] = [ " you have no groups! " , " to create: " <> highlight' " /g <name> " ]
2022-01-24 16:07:17 +00:00
viewGroupsList gs = map groupSS $ sortOn ldn_ gs
2021-12-18 10:23:47 +00:00
where
2023-08-06 11:56:40 +01:00
ldn_ = T . toLower . ( localDisplayName :: GroupInfo -> GroupName ) . fst
groupSS ( g @ GroupInfo { localDisplayName = ldn , groupProfile = GroupProfile { fullName } , membership , chatSettings } , GroupSummary { currentMembers } ) =
2022-01-26 16:18:27 +04:00
case memberStatus membership of
2022-08-27 19:56:03 +04:00
GSMemInvited -> groupInvitation' g
2022-12-19 11:16:50 +00:00
s -> membershipIncognito g <> ttyGroup ldn <> optFullName ldn fullName <> viewMemberStatus s
2022-07-31 18:54:49 +01:00
where
viewMemberStatus = \ case
GSMemRemoved -> delete " you are removed "
GSMemLeft -> delete " you left "
GSMemGroupDeleted -> delete " group deleted "
2022-09-05 15:23:38 +01:00
_
2023-08-06 11:56:40 +01:00
| enableNtfs chatSettings -> " ( " <> memberCount <> " ) "
| otherwise -> " ( " <> memberCount <> " , muted, you can " <> highlight ( " /unmute # " <> ldn ) <> " ) "
2022-07-31 18:54:49 +01:00
delete reason = " ( " <> reason <> " , delete local copy: " <> highlight ( " /d # " <> ldn ) <> " ) "
2023-08-06 11:56:40 +01:00
memberCount = sShow currentMembers <> " member " <> if currentMembers == 1 then " " else " s "
2022-01-21 11:09:33 +00:00
2022-08-27 19:56:03 +04:00
groupInvitation' :: GroupInfo -> StyledString
groupInvitation' GroupInfo { localDisplayName = ldn , groupProfile = GroupProfile { fullName } , membership = membership @ GroupMember { memberProfile } } =
highlight ( " # " <> ldn )
<> optFullName ldn fullName
<> " - you are invited ( "
<> highlight ( " /j " <> ldn )
<> joinText
<> highlight ( " /d # " <> ldn )
2022-01-06 14:24:33 +04:00
<> " to delete invitation) "
2022-08-18 11:35:31 +04:00
where
2022-08-27 19:56:03 +04:00
joinText =
if memberIncognito membership
then " to join as " <> incognitoProfile' ( fromLocalProfile memberProfile ) <> " , "
else " to join, "
2021-12-10 11:45:58 +00:00
2022-01-21 11:09:33 +00:00
viewContactsMerged :: Contact -> Contact -> [ StyledString ]
2022-01-24 16:07:17 +00:00
viewContactsMerged _into @ Contact { localDisplayName = c1 } _merged @ Contact { localDisplayName = c2 } =
2021-07-27 08:08:05 +01:00
[ " contact " <> ttyContact c2 <> " is merged into " <> ttyContact c1 ,
" use " <> ttyToContact c1 <> highlight' " <message> " <> " to send messages "
]
2022-01-21 11:09:33 +00:00
viewUserProfile :: Profile -> [ StyledString ]
viewUserProfile Profile { displayName , fullName } =
2021-08-22 15:56:36 +01:00
[ " user profile: " <> ttyFullName displayName fullName ,
2021-09-04 07:32:56 +01:00
" use " <> highlight' " /p <display name> [<full name>] " <> " to change it " ,
2021-08-22 15:56:36 +01:00
" (the updated profile will be sent to all your contacts) "
]
2023-03-29 17:39:04 +01:00
viewUserPrivacy :: User -> User -> [ StyledString ]
viewUserPrivacy User { userId } User { userId = userId' , localDisplayName = n' , showNtfs , viewPwdHash } =
[ ( if userId == userId' then " current " else " " ) <> " user " <> plain n' <> " : " ,
" messages are " <> if showNtfs then " shown " else " hidden (use /tail to view) " ,
" profile is " <> if isJust viewPwdHash then " hidden " else " visible "
2023-03-22 15:58:01 +00:00
]
2023-04-05 21:59:12 +01:00
viewUserServers :: AUserProtoServers -> Bool -> [ StyledString ]
2023-05-16 19:37:45 +02:00
viewUserServers ( AUPS UserProtoServers { serverProtocol = p , protoServers , presetServers } ) testView =
2023-05-23 13:51:23 +04:00
customServers
<> if testView
2023-05-16 19:37:45 +02:00
then []
else
[ " " ,
" use " <> highlight ( srvCmd <> " test <srv> " ) <> " to test " <> pName <> " server connection " ,
" use " <> highlight ( srvCmd <> " <srv1[,srv2,...]> " ) <> " to configure " <> pName <> " servers " ,
" use " <> highlight ( srvCmd <> " default " ) <> " to remove configured " <> pName <> " servers and use presets "
]
2023-05-23 13:51:23 +04:00
<> case p of
SPSMP -> [ " (chat option " <> highlight' " -s " <> " ( " <> highlight' " --server " <> " ) has precedence over saved SMP servers for chat session) " ]
SPXFTP -> [ " (chat option " <> highlight' " -xftp-servers " <> " has precedence over saved XFTP servers for chat session) " ]
2022-03-10 15:45:40 +04:00
where
2023-04-05 21:59:12 +01:00
srvCmd = " / " <> strEncode p
pName = protocolName p
2023-03-09 11:01:22 +00:00
customServers =
2023-04-05 21:59:12 +01:00
if null protoServers
2023-05-16 19:37:45 +02:00
then ( " no " <> pName <> " servers saved, using presets: " ) : viewServers id presetServers
else viewServers ( \ ServerCfg { server } -> server ) protoServers
2022-07-20 14:57:16 +01:00
2023-04-05 21:59:12 +01:00
protocolName :: ProtocolTypeI p => SProtocolType p -> StyledString
protocolName = plain . map toUpper . T . unpack . decodeLatin1 . strEncode
viewServerTestResult :: AProtoServerWithAuth -> Maybe ProtocolTestFailure -> [ StyledString ]
viewServerTestResult ( AProtoServerWithAuth p _ ) = \ case
Just ProtocolTestFailure { testStep , testError } ->
2022-11-15 18:31:29 +00:00
result
2023-04-05 21:59:12 +01:00
<> [ pName <> " server requires authorization to create queues, check password " | testStep == TSCreateQueue && testError == SMP SMP . AUTH ]
<> [ pName <> " server requires authorization to upload files, check password " | testStep == TSCreateFile && testError == XFTP XFTP . AUTH ]
<> [ " Possibly, certificate fingerprint in " <> pName <> " server address is incorrect " | testStep == TSConnect && brokerErr ]
2022-11-15 18:31:29 +00:00
where
2023-04-05 21:59:12 +01:00
result = [ pName <> " server test failed at " <> plain ( drop 2 $ show testStep ) <> " , error: " <> plain ( strEncode testError ) ]
2022-12-02 15:01:26 +00:00
brokerErr = case testError of
BROKER _ NETWORK -> True
_ -> False
2023-04-05 21:59:12 +01:00
_ -> [ pName <> " server test passed " ]
where
pName = protocolName p
2022-11-15 18:31:29 +00:00
2022-09-28 20:47:06 +04:00
viewChatItemTTL :: Maybe Int64 -> [ StyledString ]
viewChatItemTTL = \ case
Nothing -> [ " old messages are not being deleted " ]
Just ttl
| ttl == 86400 -> deletedAfter " one day "
| ttl == 7 * 86400 -> deletedAfter " one week "
| ttl == 30 * 86400 -> deletedAfter " one month "
| otherwise -> deletedAfter $ sShow ttl <> " second(s) "
where
deletedAfter ttlStr = [ " old messages are set to be deleted after: " <> ttlStr ]
2022-07-25 14:04:27 +01:00
viewNetworkConfig :: NetworkConfig -> [ StyledString ]
viewNetworkConfig NetworkConfig { socksProxy , tcpTimeout } =
2022-07-26 07:29:28 +01:00
[ plain $ maybe " direct network connection " ( ( " using SOCKS5 proxy " <> ) . show ) socksProxy ,
" TCP timeout: " <> sShow tcpTimeout ,
2022-11-15 18:31:29 +00:00
" use " <> highlight' " /network socks=<on/off/[ipv4]:port>[ timeout=<seconds>] " <> " to change settings "
2022-07-26 07:29:28 +01:00
]
2022-07-25 14:04:27 +01:00
2022-08-18 11:35:31 +04:00
viewContactInfo :: Contact -> ConnectionStats -> Maybe Profile -> [ StyledString ]
2023-04-27 17:19:21 +04:00
viewContactInfo ct @ Contact { contactId , profile = LocalProfile { localAlias , contactLink } } stats incognitoProfile =
2023-09-01 19:43:27 +01:00
[ " contact ID: " <> sShow contactId ]
<> viewConnectionStats stats
2023-04-27 17:19:21 +04:00
<> maybe [] ( \ l -> [ " contact address: " <> ( plain . strEncode ) l ] ) contactLink
2022-08-18 11:35:31 +04:00
<> maybe
[ " you've shared main profile with this contact " ]
( \ p -> [ " you've shared incognito profile with this contact: " <> incognitoProfile' p ] )
incognitoProfile
2022-12-09 15:26:43 +00:00
<> [ " alias: " <> plain localAlias | localAlias /= " " ]
<> [ viewConnectionVerified ( contactSecurityCode ct ) ]
2022-07-20 14:57:16 +01:00
2023-08-06 11:56:40 +01:00
viewGroupInfo :: GroupInfo -> GroupSummary -> [ StyledString ]
viewGroupInfo GroupInfo { groupId } s =
[ " group ID: " <> sShow groupId ,
" current members: " <> sShow ( currentMembers s )
]
2022-08-27 19:56:03 +04:00
viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> [ StyledString ]
2022-12-09 15:26:43 +00:00
viewGroupMemberInfo GroupInfo { groupId } m @ GroupMember { groupMemberId , memberProfile = LocalProfile { localAlias } } stats =
2022-07-20 14:57:16 +01:00
[ " group ID: " <> sShow groupId ,
" member ID: " <> sShow groupMemberId
]
<> maybe [ " member not connected " ] viewConnectionStats stats
2022-12-09 15:26:43 +00:00
<> [ " alias: " <> plain localAlias | localAlias /= " " ]
<> [ viewConnectionVerified ( memberSecurityCode m ) | isJust stats ]
viewConnectionVerified :: Maybe SecurityCode -> StyledString
viewConnectionVerified ( Just _ ) = " connection verified " -- TODO show verification time?
viewConnectionVerified _ = " connection not verified, use " <> highlight' " /code " <> " command to see security code "
2022-07-20 14:57:16 +01:00
viewConnectionStats :: ConnectionStats -> [ StyledString ]
2023-06-16 19:05:53 +04:00
viewConnectionStats ConnectionStats { rcvQueuesInfo , sndQueuesInfo } =
[ " receiving messages via: " <> viewRcvQueuesInfo rcvQueuesInfo | not $ null rcvQueuesInfo ]
<> [ " sending messages via: " <> viewSndQueuesInfo sndQueuesInfo | not $ null sndQueuesInfo ]
2022-07-20 14:57:16 +01:00
2023-05-16 19:37:45 +02:00
viewServers :: ProtocolTypeI p => ( a -> ProtoServerWithAuth p ) -> NonEmpty a -> [ StyledString ]
viewServers f = map ( plain . B . unpack . strEncode . f ) . L . toList
2022-03-10 15:45:40 +04:00
2023-06-16 19:05:53 +04:00
viewRcvQueuesInfo :: [ RcvQueueInfo ] -> StyledString
viewRcvQueuesInfo = plain . intercalate " , " . map showQueueInfo
where
showQueueInfo RcvQueueInfo { rcvServer , rcvSwitchStatus , canAbortSwitch } =
let switchCanBeAborted = if canAbortSwitch then " , can be aborted " else " "
in showSMPServer rcvServer
<> maybe " " ( \ s -> " ( " <> showSwitchStatus s <> switchCanBeAborted <> " ) " ) rcvSwitchStatus
showSwitchStatus = \ case
RSSwitchStarted -> " switch started "
RSSendingQADD -> " switch started "
RSSendingQUSE -> " switch confirmed "
RSReceivedMessage -> " switch secured "
viewSndQueuesInfo :: [ SndQueueInfo ] -> StyledString
viewSndQueuesInfo = plain . intercalate " , " . map showQueueInfo
where
showQueueInfo SndQueueInfo { sndServer , sndSwitchStatus } =
showSMPServer sndServer
<> maybe " " ( \ s -> " ( " <> showSwitchStatus s <> " ) " ) sndSwitchStatus
showSwitchStatus = \ case
SSSendingQKEY -> " switch started "
SSSendingQTEST -> " switch secured "
2022-07-26 07:29:28 +01:00
2022-11-01 13:26:08 +00:00
viewContactSwitch :: Contact -> SwitchProgress -> [ StyledString ]
viewContactSwitch _ ( SwitchProgress _ SPConfirmed _ ) = []
2023-06-16 19:05:53 +04:00
viewContactSwitch _ ( SwitchProgress _ SPSecured _ ) = []
2022-11-01 13:26:08 +00:00
viewContactSwitch ct ( SwitchProgress qd phase _ ) = case qd of
QDRcv -> [ ttyContact' ct <> " : you " <> viewSwitchPhase phase ]
QDSnd -> [ ttyContact' ct <> " " <> viewSwitchPhase phase <> " for you " ]
viewGroupMemberSwitch :: GroupInfo -> GroupMember -> SwitchProgress -> [ StyledString ]
viewGroupMemberSwitch _ _ ( SwitchProgress _ SPConfirmed _ ) = []
2023-06-16 19:05:53 +04:00
viewGroupMemberSwitch _ _ ( SwitchProgress _ SPSecured _ ) = []
2022-11-01 13:26:08 +00:00
viewGroupMemberSwitch g m ( SwitchProgress qd phase _ ) = case qd of
QDRcv -> [ ttyGroup' g <> " : you " <> viewSwitchPhase phase <> " for " <> ttyMember m ]
QDSnd -> [ ttyGroup' g <> " : " <> ttyMember m <> " " <> viewSwitchPhase phase <> " for you " ]
2023-07-05 19:44:21 +04:00
viewContactRatchetSync :: Contact -> RatchetSyncProgress -> [ StyledString ]
viewContactRatchetSync ct @ Contact { localDisplayName = c } RatchetSyncProgress { ratchetSyncStatus = rss } =
[ ttyContact' ct <> " : " <> ( plain . ratchetSyncStatusToText ) rss ]
<> help
where
help = [ " use " <> highlight ( " /sync " <> c ) <> " to synchronize " | rss ` elem ` [ RSAllowed , RSRequired ] ]
viewGroupMemberRatchetSync :: GroupInfo -> GroupMember -> RatchetSyncProgress -> [ StyledString ]
viewGroupMemberRatchetSync g m @ GroupMember { localDisplayName = n } RatchetSyncProgress { ratchetSyncStatus = rss } =
[ ttyGroup' g <> " " <> ttyMember m <> " : " <> ( plain . ratchetSyncStatusToText ) rss ]
<> help
where
help = [ " use " <> highlight ( " /sync # " <> groupName' g <> " " <> n ) <> " to synchronize " | rss ` elem ` [ RSAllowed , RSRequired ] ]
viewContactVerificationReset :: Contact -> [ StyledString ]
viewContactVerificationReset ct =
[ ttyContact' ct <> " : security code changed " ]
viewGroupMemberVerificationReset :: GroupInfo -> GroupMember -> [ StyledString ]
viewGroupMemberVerificationReset g m =
[ ttyGroup' g <> " " <> ttyMember m <> " : security code changed " ]
2022-12-09 15:26:43 +00:00
viewContactCode :: Contact -> Text -> Bool -> [ StyledString ]
viewContactCode ct @ Contact { localDisplayName = c } = viewSecurityCode ( ttyContact' ct ) ( " /verify " <> c <> " <code from your contact> " )
viewGroupMemberCode :: GroupInfo -> GroupMember -> Text -> Bool -> [ StyledString ]
viewGroupMemberCode g m @ GroupMember { localDisplayName = n } = viewSecurityCode ( ttyGroup' g <> " " <> ttyMember m ) ( " /verify # " <> groupName' g <> " " <> n <> " <code from your contact> " )
viewSecurityCode :: StyledString -> Text -> Text -> Bool -> [ StyledString ]
viewSecurityCode name cmd code testView
| testView = [ plain code ]
| otherwise = [ name <> " security code: " , plain code , " pass this code to your contact and use " <> highlight cmd <> " to verify " ]
2022-11-01 13:26:08 +00:00
viewSwitchPhase :: SwitchPhase -> StyledString
2023-06-16 19:05:53 +04:00
viewSwitchPhase = \ case
SPStarted -> " started changing address "
SPConfirmed -> " confirmed changing address "
SPSecured -> " secured new address "
SPCompleted -> " changed address "
2022-11-01 13:26:08 +00:00
2023-08-22 16:13:57 +01:00
viewUserProfileUpdated :: Profile -> Profile -> UserProfileUpdateSummary -> [ StyledString ]
viewUserProfileUpdated Profile { displayName = n , fullName , image , contactLink , preferences } Profile { displayName = n' , fullName = fullName' , image = image' , contactLink = contactLink' , preferences = prefs' } summary =
2022-11-04 17:05:21 +00:00
profileUpdated <> viewPrefsUpdated preferences prefs'
2022-01-24 16:07:17 +00:00
where
2023-08-22 16:13:57 +01:00
UserProfileUpdateSummary { updateSuccesses = s , updateFailures = f } = summary
2022-11-04 17:05:21 +00:00
profileUpdated
2023-04-27 17:19:21 +04:00
| n == n' && fullName == fullName' && image == image' && contactLink == contactLink' = []
| n == n' && fullName == fullName' && image == image' = [ if isNothing contactLink' then " contact address removed " else " new contact address set " ]
2022-11-04 17:05:21 +00:00
| n == n' && fullName == fullName' = [ if isNothing image' then " profile image removed " else " profile image updated " ]
| n == n' = [ " user full name " <> ( if T . null fullName' || fullName' == n' then " removed " else " changed to " <> plain fullName' ) <> notified ]
| otherwise = [ " user profile is changed to " <> ttyFullName n' fullName' <> notified ]
2023-06-17 10:34:04 +01:00
notified = " (your " <> sShow s <> " contacts are notified " <> failures <> " ) "
failures
| f > 0 = " , " <> sShow f <> " failures "
| otherwise = " "
viewUserProfileImage :: Profile -> [ StyledString ]
viewUserProfileImage Profile { image } = case image of
Just ( ImageData img ) -> [ " Profile image: " , plain img ]
_ -> [ " No profile image " ]
2021-08-22 15:56:36 +01:00
2022-11-15 10:31:44 +04:00
viewUserContactPrefsUpdated :: User -> Contact -> Contact -> [ StyledString ]
viewUserContactPrefsUpdated user ct ct' @ Contact { mergedPreferences = cups }
2022-11-04 17:05:21 +00:00
| null prefs = [ " your preferences for " <> ttyContact' ct' <> " did not change " ]
| otherwise = ( " you updated preferences for " <> ttyContact' ct' <> " : " ) : prefs
where
prefs = viewContactPreferences user ct ct' cups
2022-11-15 10:31:44 +04:00
viewContactPrefsUpdated :: User -> Contact -> Contact -> [ StyledString ]
viewContactPrefsUpdated user ct ct' @ Contact { mergedPreferences = cups }
2022-11-04 17:05:21 +00:00
| null prefs = []
| otherwise = ( ttyContact' ct' <> " updated preferences for you: " ) : prefs
where
prefs = viewContactPreferences user ct ct' cups
viewContactPreferences :: User -> Contact -> Contact -> ContactUserPreferences -> [ StyledString ]
viewContactPreferences user ct ct' cups =
mapMaybe ( viewContactPref ( mergeUserChatPrefs user ct ) ( mergeUserChatPrefs user ct' ) ( preferences' ct ) cups ) allChatFeatures
2022-12-13 14:52:34 +00:00
viewContactPref :: FullPreferences -> FullPreferences -> Maybe Preferences -> ContactUserPreferences -> AChatFeature -> Maybe StyledString
viewContactPref userPrefs userPrefs' ctPrefs cups ( ACF f )
2022-11-04 17:05:21 +00:00
| userPref == userPref' && ctPref == contactPreference = Nothing
2023-04-17 19:13:10 +02:00
| otherwise = Just . plain $ chatFeatureNameText' f <> " : " <> prefEnabledToText ( chatFeature f ) enabled ( prefParam userPref' ) <> " (you allow: " <> countactUserPrefText userPreference <> " , contact allows: " <> preferenceText contactPreference <> " ) "
2022-11-04 17:05:21 +00:00
where
2022-12-13 14:52:34 +00:00
userPref = getPreference f userPrefs
userPref' = getPreference f userPrefs'
ctPref = getPreference f ctPrefs
ContactUserPreference { enabled , userPreference , contactPreference } = getContactUserPreference f cups
2022-11-04 17:05:21 +00:00
viewPrefsUpdated :: Maybe Preferences -> Maybe Preferences -> [ StyledString ]
viewPrefsUpdated ps ps'
| null prefs = []
| otherwise = " updated preferences: " : prefs
where
prefs = mapMaybe viewPref allChatFeatures
2022-12-13 14:52:34 +00:00
viewPref ( ACF f )
2022-11-04 17:05:21 +00:00
| pref ps == pref ps' = Nothing
2022-12-22 14:56:29 +00:00
| otherwise = Just . plain $ chatFeatureNameText' f <> " allowed: " <> preferenceText ( pref ps' )
2022-11-04 17:05:21 +00:00
where
2022-12-13 14:52:34 +00:00
pref pss = getPreference f $ mergePreferences pss Nothing
2022-11-01 17:32:49 +03:00
2022-12-22 14:56:29 +00:00
countactUserPrefText :: FeatureI f => ContactUserPref ( FeaturePreference f ) -> Text
countactUserPrefText cup = case cup of
CUPUser p -> " default ( " <> preferenceText p <> " ) "
CUPContact p -> preferenceText p
2022-11-04 17:05:21 +00:00
2022-07-29 19:04:32 +01:00
viewGroupUpdated :: GroupInfo -> GroupInfo -> Maybe GroupMember -> [ StyledString ]
viewGroupUpdated
2022-12-10 08:27:32 +00:00
GroupInfo { localDisplayName = n , groupProfile = GroupProfile { fullName , description , image , groupPreferences = gps } }
g' @ GroupInfo { localDisplayName = n' , groupProfile = GroupProfile { fullName = fullName' , description = description' , image = image' , groupPreferences = gps' } }
2022-11-18 16:07:40 +04:00
m = do
let update = groupProfileUpdated <> groupPrefsUpdated
if null update
then []
else memberUpdated <> update
2022-07-29 19:04:32 +01:00
where
2022-11-18 16:07:40 +04:00
memberUpdated = maybe [] ( \ m' -> [ ttyMember m' <> " updated group " <> ttyGroup n <> " : " ] ) m
2022-12-10 08:27:32 +00:00
groupProfileUpdated =
[ " changed to " <> ttyFullGroup g' | n /= n' ]
<> [ " full name " <> if T . null fullName' || fullName' == n' then " removed " else " changed to: " <> plain fullName' | n == n' && fullName /= fullName' ]
<> [ " profile image " <> maybe " removed " ( const " updated " ) image' | image /= image' ]
<> ( if description == description' then [] else maybe [ " description removed " ] ( ( bold' " description changed to: " : ) . map plain . T . lines ) description' )
2022-11-18 16:07:40 +04:00
groupPrefsUpdated
| null prefs = []
2022-12-10 08:27:32 +00:00
| otherwise = bold' " updated group preferences: " : prefs
2022-11-18 16:07:40 +04:00
where
2022-11-29 15:19:20 +00:00
prefs = mapMaybe viewPref allGroupFeatures
2022-12-14 08:30:24 +00:00
viewPref ( AGF f )
2022-11-18 16:07:40 +04:00
| pref gps == pref gps' = Nothing
2022-12-22 14:56:29 +00:00
| otherwise = Just . plain $ groupPreferenceText ( pref gps' )
2022-11-18 16:07:40 +04:00
where
2022-12-14 08:30:24 +00:00
pref = getGroupPreference f . mergeGroupPreferences
2022-12-10 08:27:32 +00:00
viewGroupProfile :: GroupInfo -> [ StyledString ]
viewGroupProfile g @ GroupInfo { groupProfile = GroupProfile { description , image , groupPreferences = gps } } =
[ ttyFullGroup g ]
<> maybe [] ( const [ " has profile image " ] ) image
<> maybe [] ( ( bold' " description: " : ) . map plain . T . lines ) description
<> ( bold' " group preferences: " : map viewPref allGroupFeatures )
where
2022-12-22 14:56:29 +00:00
viewPref ( AGF f ) = plain $ groupPreferenceText ( pref gps )
2022-12-10 08:27:32 +00:00
where
2022-12-14 08:30:24 +00:00
pref = getGroupPreference f . mergeGroupPreferences
2022-12-10 08:27:32 +00:00
2023-08-01 20:54:51 +01:00
viewGroupDescription :: GroupInfo -> [ StyledString ]
viewGroupDescription GroupInfo { groupProfile = GroupProfile { description } } =
maybe [ " No welcome message! " ] ( ( bold' " Welcome message: " : ) . map plain . T . lines ) description
2022-12-10 08:27:32 +00:00
bold' :: String -> StyledString
bold' = styled Bold
2022-11-18 16:07:40 +04:00
2022-08-24 19:03:43 +04:00
viewContactAliasUpdated :: Contact -> [ StyledString ]
viewContactAliasUpdated Contact { localDisplayName = n , profile = LocalProfile { localAlias } }
| localAlias == " " = [ " contact " <> ttyContact n <> " alias removed " ]
| otherwise = [ " contact " <> ttyContact n <> " alias updated: " <> plain localAlias ]
2022-09-27 20:45:46 +01:00
viewConnectionAliasUpdated :: PendingContactConnection -> [ StyledString ]
viewConnectionAliasUpdated PendingContactConnection { pccConnId , localAlias }
| localAlias == " " = [ " connection " <> sShow pccConnId <> " alias removed " ]
| otherwise = [ " connection " <> sShow pccConnId <> " alias updated: " <> plain localAlias ]
2023-08-08 17:25:28 +04:00
viewConnectionIncognitoUpdated :: PendingContactConnection -> [ StyledString ]
viewConnectionIncognitoUpdated PendingContactConnection { pccConnId , customUserProfileId }
| isJust customUserProfileId = [ " connection " <> sShow pccConnId <> " changed to incognito " ]
| otherwise = [ " connection " <> sShow pccConnId <> " changed to non incognito " ]
2022-01-21 11:09:33 +00:00
viewContactUpdated :: Contact -> Contact -> [ StyledString ]
viewContactUpdated
2023-04-27 17:19:21 +04:00
Contact { localDisplayName = n , profile = LocalProfile { fullName , contactLink } }
Contact { localDisplayName = n' , profile = LocalProfile { fullName = fullName' , contactLink = contactLink' } }
| n == n' && fullName == fullName' && contactLink == contactLink' = []
| n == n' && fullName == fullName' =
if isNothing contactLink'
then [ ttyContact n <> " removed contact address " ]
else [ ttyContact n <> " set new contact address, use " <> highlight ( " /info " <> n ) <> " to view " ]
2021-08-22 15:56:36 +01:00
| n == n' = [ " contact " <> ttyContact n <> fullNameUpdate ]
| otherwise =
2022-10-18 00:35:29 +04:00
[ " contact " <> ttyContact n <> " changed to " <> ttyFullName n' fullName' ,
" use " <> ttyToContact n' <> highlight' " <message> " <> " to send messages "
]
2021-08-22 15:56:36 +01:00
where
fullNameUpdate = if T . null fullName' || fullName' == n' then " removed full name " else " updated full name: " <> plain fullName'
2023-06-08 11:07:21 +04:00
viewReceivedMessage :: StyledString -> [ StyledString ] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [ StyledString ]
2022-12-19 11:16:50 +00:00
viewReceivedMessage = viewReceivedMessage_ False
2021-09-04 07:32:56 +01:00
2023-06-08 11:07:21 +04:00
viewReceivedUpdatedMessage :: StyledString -> [ StyledString ] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [ StyledString ]
2022-12-19 11:16:50 +00:00
viewReceivedUpdatedMessage = viewReceivedMessage_ True
2023-06-08 11:07:21 +04:00
viewReceivedMessage_ :: Bool -> StyledString -> [ StyledString ] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [ StyledString ]
viewReceivedMessage_ updated from quote mc ts tz meta = receivedWithTime_ ts tz from quote meta ( ttyMsgContent mc ) updated
2022-12-19 11:16:50 +00:00
2023-06-08 11:07:21 +04:00
viewReceivedReaction :: StyledString -> [ StyledString ] -> StyledString -> CurrentTime -> TimeZone -> UTCTime -> [ StyledString ]
viewReceivedReaction from styledMsg reactionText ts tz reactionTs =
prependFirst ( ttyMsgTime ts tz reactionTs <> " " <> from ) ( styledMsg <> [ " " <> reactionText ] )
2023-05-15 12:28:53 +02:00
2023-06-08 11:07:21 +04:00
receivedWithTime_ :: CurrentTime -> TimeZone -> StyledString -> [ StyledString ] -> CIMeta c d -> [ StyledString ] -> Bool -> [ StyledString ]
receivedWithTime_ ts tz from quote CIMeta { itemId , itemTs , itemEdited , itemDeleted , itemLive } styledMsg updated = do
prependFirst ( ttyMsgTime ts tz itemTs <> " " <> from ) ( quote <> prependFirst ( indent <> live ) styledMsg )
2021-06-25 18:18:24 +01:00
where
2022-03-13 19:34:03 +00:00
indent = if null quote then " " else " "
2022-12-19 11:16:50 +00:00
live
2023-02-08 07:08:53 +00:00
| itemEdited || isJust itemDeleted = " "
2022-12-19 11:16:50 +00:00
| otherwise = case itemLive of
Just True
| updated -> ttyFrom " [LIVE] "
| otherwise -> ttyFrom " [LIVE started] " <> " use " <> highlight' ( " /show [on/off/ " <> show itemId <> " ] " )
Just False -> ttyFrom " [LIVE ended] "
_ -> " "
2022-11-14 08:42:54 +00:00
2023-06-08 11:07:21 +04:00
ttyMsgTime :: CurrentTime -> TimeZone -> UTCTime -> StyledString
2023-06-08 11:23:04 +04:00
ttyMsgTime now tz time =
let fmt = if recent now tz time then " %H:%M " else " %m-%d "
localTime = utcToLocalTime tz time
2022-11-14 08:42:54 +00:00
in styleTime $ formatTime defaultTimeLocale fmt localTime
2023-06-08 11:23:04 +04:00
recent :: CurrentTime -> TimeZone -> UTCTime -> Bool
recent now tz time = do
let localNow = utcToLocalTime tz now
localNowDay = localDay localNow
localTime = utcToLocalTime tz time
localTimeDay = localDay localTime
previousDay18 = LocalTime ( addDays ( - 1 ) localNowDay ) ( TimeOfDay 18 0 0 )
currentDay12 = LocalTime localNowDay ( TimeOfDay 12 0 0 )
localNowDay == localTimeDay
|| ( localNow < currentDay12 && localTime >= previousDay18 && localTimeDay < localNowDay )
2023-06-08 11:07:21 +04:00
viewSentMessage :: StyledString -> [ StyledString ] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [ StyledString ]
viewSentMessage to quote mc ts tz meta @ CIMeta { itemEdited , itemDeleted , itemLive } = sentWithTime_ ts tz ( prependFirst to $ quote <> prependFirst ( indent <> live ) ( ttyMsgContent mc ) ) meta
2022-03-13 19:34:03 +00:00
where
indent = if null quote then " " else " "
2022-12-19 11:16:50 +00:00
live
2023-02-08 07:08:53 +00:00
| itemEdited || isJust itemDeleted = " "
2022-12-19 11:16:50 +00:00
| otherwise = case itemLive of
Just True -> ttyTo " [LIVE started] "
Just False -> ttyTo " [LIVE] "
_ -> " "
2022-01-21 11:09:33 +00:00
2023-06-17 10:34:04 +01:00
viewSentBroadcast :: MsgContent -> Int -> Int -> CurrentTime -> TimeZone -> UTCTime -> [ StyledString ]
viewSentBroadcast mc s f ts tz time = prependFirst ( highlight' " /feed " <> " ( " <> sShow s <> failures <> " ) " <> ttyMsgTime ts tz time <> " " ) ( ttyMsgContent mc )
where
failures
| f > 0 = " , " <> sShow f <> " failures "
| otherwise = " "
2022-03-29 08:53:30 +01:00
2023-06-08 11:07:21 +04:00
viewSentFileInvitation :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [ StyledString ]
2023-09-01 19:43:27 +01:00
viewSentFileInvitation to CIFile { fileId , fileSource , fileStatus } ts tz = case fileSource of
Just ( CryptoFile fPath _ ) -> sentWithTime_ ts tz $ ttySentFile fPath
2022-04-19 12:29:03 +04:00
_ -> const []
2022-10-14 13:06:33 +01:00
where
ttySentFile fPath = [ " /f " <> to <> ttyFilePath fPath ] <> cancelSending
cancelSending = case fileStatus of
2023-03-13 10:30:32 +00:00
CIFSSndTransfer _ _ -> []
2022-10-14 13:06:33 +01:00
_ -> [ " use " <> highlight ( " /fc " <> show fileId ) <> " to cancel sending " ]
2022-01-21 11:09:33 +00:00
2023-06-08 11:07:21 +04:00
sentWithTime_ :: CurrentTime -> TimeZone -> [ StyledString ] -> CIMeta c d -> [ StyledString ]
sentWithTime_ ts tz styledMsg CIMeta { itemTs } =
prependFirst ( ttyMsgTime ts tz itemTs <> " " ) styledMsg
2021-09-05 14:08:29 +01:00
2022-01-24 16:07:17 +00:00
ttyMsgContent :: MsgContent -> [ StyledString ]
2022-03-13 19:34:03 +00:00
ttyMsgContent = msgPlain . msgContentText
2021-09-05 14:08:29 +01:00
2021-06-25 18:18:24 +01:00
prependFirst :: StyledString -> [ StyledString ] -> [ StyledString ]
prependFirst s [] = [ s ]
prependFirst s ( s' : ss ) = ( s <> s' ) : ss
2021-07-04 18:42:24 +01:00
msgPlain :: Text -> [ StyledString ]
2022-02-22 14:05:45 +00:00
msgPlain = map ( styleMarkdownList . parseMarkdownList ) . T . lines
2021-07-04 18:42:24 +01:00
2022-01-24 16:07:17 +00:00
viewRcvFileSndCancelled :: RcvFileTransfer -> [ StyledString ]
viewRcvFileSndCancelled ft @ RcvFileTransfer { senderDisplayName = c } =
[ ttyContact c <> " cancelled sending " <> rcvFile ft ]
2021-09-04 07:32:56 +01:00
2023-03-29 17:18:44 +04:00
viewSndFileCancelled :: FileTransferMeta -> [ SndFileTransfer ] -> [ StyledString ]
viewSndFileCancelled FileTransferMeta { fileId , fileName } fts =
2021-09-05 14:08:29 +01:00
case filter ( \ SndFileTransfer { fileStatus = s } -> s /= FSCancelled && s /= FSComplete ) fts of
2022-04-05 10:01:08 +04:00
[] -> [ " cancelled sending " <> fileTransferStr fileId fileName ]
ts -> [ " cancelled sending " <> fileTransferStr fileId fileName <> " to " <> listRecipients ts ]
2021-09-04 07:32:56 +01:00
2021-09-05 14:08:29 +01:00
sendingFile_ :: StyledString -> SndFileTransfer -> [ StyledString ]
sendingFile_ status ft @ SndFileTransfer { recipientDisplayName = c } =
[ status <> " sending " <> sndFile ft <> " to " <> ttyContact c ]
2021-09-04 07:32:56 +01:00
2023-04-18 12:48:36 +04:00
uploadingFile :: StyledString -> AChatItem -> [ StyledString ]
uploadingFile status ( AChatItem _ _ ( DirectChat Contact { localDisplayName = c } ) ChatItem { file = Just CIFile { fileId , fileName } , chatDir = CIDirectSnd } ) =
[ status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyContact c ]
uploadingFile status ( AChatItem _ _ ( GroupChat g ) ChatItem { file = Just CIFile { fileId , fileName } , chatDir = CIGroupSnd } ) =
[ status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyGroup' g ]
uploadingFile status _ = [ status <> " uploading file " ] -- shouldn't happen
2023-03-30 19:45:18 +04:00
2021-09-05 14:08:29 +01:00
sndFile :: SndFileTransfer -> StyledString
2022-01-26 21:20:08 +00:00
sndFile SndFileTransfer { fileId , fileName } = fileTransferStr fileId fileName
2021-09-05 14:08:29 +01:00
2023-06-08 11:07:21 +04:00
viewReceivedFileInvitation :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [ StyledString ]
viewReceivedFileInvitation from file ts tz meta = receivedWithTime_ ts tz from [] meta ( receivedFileInvitation_ file ) False
2022-04-10 13:30:58 +04:00
receivedFileInvitation_ :: CIFile d -> [ StyledString ]
2022-10-14 13:06:33 +01:00
receivedFileInvitation_ CIFile { fileId , fileName , fileSize , fileStatus } =
[ " sends file " <> ttyFilePath fileName <> " ( " <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes) " ]
<> case fileStatus of
CIFSRcvAccepted -> []
_ -> [ " use " <> highlight ( " /fr " <> show fileId <> " [<dir>/ | <path>] " ) <> " to receive it " ]
2021-09-04 07:32:56 +01:00
humanReadableSize :: Integer -> StyledString
humanReadableSize size
| size < kB = sShow size <> " bytes "
| size < mB = hrSize kB " KiB "
| size < gB = hrSize mB " MiB "
| otherwise = hrSize gB " GiB "
where
hrSize sB name = plain $ unwords [ showFFloat ( Just 1 ) ( fromIntegral size / ( fromIntegral sB :: Double ) ) " " , name ]
kB = 1024
mB = kB * 1024
gB = mB * 1024
2023-09-01 19:43:27 +01:00
savingFile' :: Bool -> AChatItem -> [ StyledString ]
savingFile' testView ( AChatItem _ _ chat ChatItem { file = Just CIFile { fileId , fileSource = Just ( CryptoFile filePath cfArgs_ ) } , chatDir } ) =
let from = case ( chat , chatDir ) of
( DirectChat Contact { localDisplayName = c } , CIDirectRcv ) -> " from " <> ttyContact c
( _ , CIGroupRcv GroupMember { localDisplayName = m } ) -> " from " <> ttyContact m
_ -> " "
in [ " saving file " <> sShow fileId <> from <> " to " <> plain filePath ] <> cfArgsStr
where
cfArgsStr = case cfArgs_ of
Just cfArgs @ ( CFArgs key nonce )
| testView -> [ plain $ LB . unpack $ J . encode cfArgs ]
| otherwise -> [ plain $ " encryption key: " <> strEncode key <> " , nonce: " <> strEncode nonce ]
_ -> []
savingFile' _ _ = [ " saving file " ] -- shouldn't happen
2022-04-29 15:56:56 +04:00
2022-04-15 09:36:38 +04:00
receivingFile_' :: StyledString -> AChatItem -> [ StyledString ]
receivingFile_' status ( AChatItem _ _ ( DirectChat Contact { localDisplayName = c } ) ChatItem { file = Just CIFile { fileId , fileName } , chatDir = CIDirectRcv } ) =
[ status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact c ]
receivingFile_' status ( AChatItem _ _ _ ChatItem { file = Just CIFile { fileId , fileName } , chatDir = CIGroupRcv GroupMember { localDisplayName = m } } ) =
[ status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact m ]
receivingFile_' status _ = [ status <> " receiving file " ] -- shouldn't happen
2021-09-05 14:08:29 +01:00
receivingFile_ :: StyledString -> RcvFileTransfer -> [ StyledString ]
receivingFile_ status ft @ RcvFileTransfer { senderDisplayName = c } =
[ status <> " receiving " <> rcvFile ft <> " from " <> ttyContact c ]
2021-09-04 07:32:56 +01:00
2021-09-05 14:08:29 +01:00
rcvFile :: RcvFileTransfer -> StyledString
2022-01-26 21:20:08 +00:00
rcvFile RcvFileTransfer { fileId , fileInvitation = FileInvitation { fileName } } = fileTransferStr fileId fileName
2021-09-05 14:08:29 +01:00
2022-01-26 21:20:08 +00:00
fileTransferStr :: Int64 -> String -> StyledString
fileTransferStr fileId fileName = " file " <> sShow fileId <> " ( " <> ttyFilePath fileName <> " ) "
2021-09-04 07:32:56 +01:00
2022-01-21 11:09:33 +00:00
viewFileTransferStatus :: ( FileTransfer , [ Integer ] ) -> [ StyledString ]
2022-04-05 10:01:08 +04:00
viewFileTransferStatus ( FTSnd FileTransferMeta { fileId , fileName , cancelled } [] , _ ) =
2022-10-14 13:06:33 +01:00
[ " sending " <> fileTransferStr fileId fileName <> " : no file transfers " ]
<> [ " file transfer cancelled " | cancelled ]
2022-04-05 10:01:08 +04:00
viewFileTransferStatus ( FTSnd FileTransferMeta { cancelled } fts @ ( ft : _ ) , chunksNum ) =
recipientStatuses <> [ " file transfer cancelled " | cancelled ]
2021-09-05 14:08:29 +01:00
where
2022-04-05 10:01:08 +04:00
recipientStatuses =
case concatMap recipientsTransferStatus $ groupBy ( ( == ) ` on ` fs ) $ sortOn fs fts of
[ recipientsStatus ] -> [ " sending " <> sndFile ft <> " " <> recipientsStatus ]
recipientsStatuses -> ( " sending " <> sndFile ft <> " : " ) : map ( " " <> ) recipientsStatuses
2021-09-05 14:08:29 +01:00
fs = fileStatus :: SndFileTransfer -> FileStatus
2022-04-05 10:01:08 +04:00
recipientsTransferStatus [] = []
recipientsTransferStatus ts @ ( SndFileTransfer { fileStatus , fileSize , chunkSize } : _ ) = [ sndStatus <> " : " <> listRecipients ts ]
2021-09-05 14:08:29 +01:00
where
sndStatus = case fileStatus of
FSNew -> " not accepted "
FSAccepted -> " just started "
FSConnected -> " in progress ( " <> sShow ( sum chunksNum * chunkSize * 100 ` div ` ( toInteger ( length chunksNum ) * fileSize ) ) <> " %) "
FSComplete -> " complete "
FSCancelled -> " cancelled "
2022-01-21 11:09:33 +00:00
viewFileTransferStatus ( FTRcv ft @ RcvFileTransfer { fileId , fileInvitation = FileInvitation { fileSize } , fileStatus , chunkSize } , chunksNum ) =
2021-09-05 14:08:29 +01:00
[ " receiving " <> rcvFile ft <> " " <> rcvStatus ]
2021-09-04 07:32:56 +01:00
where
rcvStatus = case fileStatus of
2021-09-05 14:08:29 +01:00
RFSNew -> " not accepted yet, use " <> highlight ( " /fr " <> show fileId ) <> " to receive file "
2021-09-04 07:32:56 +01:00
RFSAccepted _ -> " just started "
2021-09-05 14:08:29 +01:00
RFSConnected _ -> " progress " <> fileProgress chunksNum chunkSize fileSize
RFSComplete RcvFileInfo { filePath } -> " complete, path: " <> plain filePath
2022-05-11 16:18:28 +04:00
RFSCancelled ( Just RcvFileInfo { filePath } ) -> " cancelled, received part path: " <> plain filePath
RFSCancelled Nothing -> " cancelled "
2021-09-05 14:08:29 +01:00
2023-04-21 13:36:44 +04:00
viewFileTransferStatusXFTP :: AChatItem -> [ StyledString ]
2023-09-01 19:43:27 +01:00
viewFileTransferStatusXFTP ( AChatItem _ _ _ ChatItem { file = Just CIFile { fileId , fileName , fileSize , fileStatus , fileSource } } ) =
2023-04-21 13:36:44 +04:00
case fileStatus of
CIFSSndStored -> [ " sending " <> fstr <> " just started " ]
CIFSSndTransfer progress total -> [ " sending " <> fstr <> " in progress " <> fileProgressXFTP progress total fileSize ]
CIFSSndCancelled -> [ " sending " <> fstr <> " cancelled " ]
CIFSSndComplete -> [ " sending " <> fstr <> " complete " ]
CIFSSndError -> [ " sending " <> fstr <> " error " ]
CIFSRcvInvitation -> [ " receiving " <> fstr <> " not accepted yet, use " <> highlight ( " /fr " <> show fileId ) <> " to receive file " ]
CIFSRcvAccepted -> [ " receiving " <> fstr <> " just started " ]
CIFSRcvTransfer progress total -> [ " receiving " <> fstr <> " progress " <> fileProgressXFTP progress total fileSize ]
2023-09-01 19:43:27 +01:00
CIFSRcvComplete -> [ " receiving " <> fstr <> " complete " <> maybe " " ( \ ( CryptoFile fp _ ) -> " , path: " <> plain fp ) fileSource ]
2023-04-21 13:36:44 +04:00
CIFSRcvCancelled -> [ " receiving " <> fstr <> " cancelled " ]
CIFSRcvError -> [ " receiving " <> fstr <> " error " ]
2023-07-31 11:54:39 +04:00
CIFSInvalid text -> [ fstr <> " invalid status: " <> plain text ]
2023-04-21 13:36:44 +04:00
where
fstr = fileTransferStr fileId fileName
viewFileTransferStatusXFTP _ = [ " no file status " ]
2022-04-05 10:01:08 +04:00
listRecipients :: [ SndFileTransfer ] -> StyledString
listRecipients = mconcat . intersperse " , " . map ( ttyContact . recipientDisplayName )
2021-09-04 07:32:56 +01:00
fileProgress :: [ Integer ] -> Integer -> Integer -> StyledString
fileProgress chunksNum chunkSize fileSize =
sShow ( sum chunksNum * chunkSize * 100 ` div ` fileSize ) <> " % of " <> humanReadableSize fileSize
2023-04-21 13:36:44 +04:00
fileProgressXFTP :: Int64 -> Int64 -> Integer -> StyledString
fileProgressXFTP progress total fileSize =
sShow ( progress * 100 ` div ` total ) <> " % of " <> humanReadableSize fileSize
2021-09-04 07:32:56 +01:00
2022-05-17 08:37:00 +01:00
viewCallInvitation :: Contact -> CallType -> Maybe C . Key -> [ StyledString ]
viewCallInvitation ct @ Contact { contactId } callType @ CallType { media } sharedKey =
2022-05-18 07:01:32 +01:00
[ ttyContact' ct <> " wants to connect with you via WebRTC " <> callMediaStr callType <> " call " <> encryptedCallText callType ,
2022-05-17 08:37:00 +01:00
" To accept the call, please open the link below in your browser " <> supporedBrowsers callType ,
" " ,
" https://simplex.chat/call# " <> plain queryString
]
where
aesKey = B . unpack . strEncode . C . unKey <$> sharedKey
queryString =
Q . renderSimpleQuery
False
[ ( " command " , LB . toStrict . J . encode $ WCCallStart { media , aesKey , useWorker = True } ) ,
( " contact_id " , B . pack $ show contactId )
]
viewCallOffer :: Contact -> CallType -> WebRTCSession -> Maybe C . Key -> [ StyledString ]
viewCallOffer ct @ Contact { contactId } callType @ CallType { media } WebRTCSession { rtcSession = offer , rtcIceCandidates = iceCandidates } sharedKey =
2022-05-18 07:01:32 +01:00
[ ttyContact' ct <> " accepted your WebRTC " <> callMediaStr callType <> " call " <> encryptedCallText callType ,
2022-05-17 08:37:00 +01:00
" To connect, please open the link below in your browser " <> supporedBrowsers callType ,
" " ,
" https://simplex.chat/call# " <> plain queryString
]
where
aesKey = B . unpack . strEncode . C . unKey <$> sharedKey
queryString =
Q . renderSimpleQuery
False
[ ( " command " , LB . toStrict . J . encode $ WCCallOffer { offer , iceCandidates , media , aesKey , useWorker = True } ) ,
( " contact_id " , B . pack $ show contactId )
]
viewCallAnswer :: Contact -> WebRTCSession -> [ StyledString ]
viewCallAnswer ct WebRTCSession { rtcSession = answer , rtcIceCandidates = iceCandidates } =
[ ttyContact' ct <> " continued the WebRTC call " ,
" To connect, please paste the data below in your browser window you opened earlier and click Connect button " ,
" " ,
plain . LB . toStrict . J . encode $ WCCallAnswer { answer , iceCandidates }
]
callMediaStr :: CallType -> StyledString
callMediaStr CallType { media } = case media of
CMVideo -> " video "
CMAudio -> " audio "
2022-05-18 07:01:32 +01:00
encryptedCallText :: CallType -> StyledString
encryptedCallText callType
| encryptedCall callType = " (e2e encrypted) "
| otherwise = " (not e2e encrypted) "
2022-05-17 08:37:00 +01:00
supporedBrowsers :: CallType -> StyledString
2022-05-18 07:01:32 +01:00
supporedBrowsers callType
| encryptedCall callType = " (only Chrome and Safari support e2e encryption for WebRTC, Safari may require enabling WebRTC insertable streams) "
2022-05-17 08:37:00 +01:00
| otherwise = " "
data WCallCommand
= WCCallStart { media :: CallMedia , aesKey :: Maybe String , useWorker :: Bool }
| WCCallOffer { offer :: Text , iceCandidates :: Text , media :: CallMedia , aesKey :: Maybe String , useWorker :: Bool }
| WCCallAnswer { answer :: Text , iceCandidates :: Text }
deriving ( Generic )
instance ToJSON WCallCommand where
toEncoding = J . genericToEncoding . taggedObjectJSON $ dropPrefix " WCCall "
toJSON = J . genericToJSON . taggedObjectJSON $ dropPrefix " WCCall "
2023-01-22 15:16:45 +00:00
viewVersionInfo :: ChatLogLevel -> CoreVersionInfo -> [ StyledString ]
2023-04-14 13:03:41 +02:00
viewVersionInfo logLevel CoreVersionInfo { version , simplexmqVersion , simplexmqCommit } =
2023-01-22 15:16:45 +00:00
map plain $
if logLevel <= CLLInfo
2023-04-14 13:03:41 +02:00
then [ versionString version , updateStr , " simplexmq: " <> simplexmqVersion <> parens simplexmqCommit ]
2023-01-22 15:16:45 +00:00
else [ versionString version , updateStr ]
where
parens s = " ( " <> s <> " ) "
2023-01-16 09:13:46 +00:00
viewChatError :: ChatLogLevel -> ChatError -> [ StyledString ]
viewChatError logLevel = \ case
2021-07-16 07:40:55 +01:00
ChatError err -> case err of
2022-02-06 16:18:01 +00:00
CENoActiveUser -> [ " error: active user is required " ]
2023-01-20 10:48:25 +00:00
CENoConnectionUser agentConnId -> [ " error: message user not found, conn id: " <> sShow agentConnId | logLevel <= CLLError ]
2023-03-13 10:30:32 +00:00
CENoSndFileUser aFileId -> [ " error: snd file user not found, file id: " <> sShow aFileId | logLevel <= CLLError ]
CENoRcvFileUser aFileId -> [ " error: rcv file user not found, file id: " <> sShow aFileId | logLevel <= CLLError ]
2022-02-06 16:18:01 +00:00
CEActiveUserExists -> [ " error: active user already exists " ]
2023-01-31 12:24:18 +00:00
CEUserExists name -> [ " user with the name " <> ttyContact name <> " already exists " ]
2023-03-22 15:58:01 +00:00
CEUserUnknown -> [ " user does not exist or incorrect password " ]
2023-01-05 20:38:31 +04:00
CEDifferentActiveUser commandUserId activeUserId -> [ " error: different active user, command user id: " <> sShow commandUserId <> " , active user id: " <> sShow activeUserId ]
2023-01-18 17:08:48 +04:00
CECantDeleteActiveUser _ -> [ " cannot delete active user " ]
CECantDeleteLastUser _ -> [ " cannot delete last user " ]
2023-03-22 15:58:01 +00:00
CECantHideLastUser _ -> [ " cannot hide the only not hidden user " ]
2023-03-29 19:28:06 +01:00
CEHiddenUserAlwaysMuted _ -> [ " hidden user always muted when inactive " ]
CEEmptyUserPassword _ -> [ " user password is required " ]
2023-03-22 15:58:01 +00:00
CEUserAlreadyHidden _ -> [ " user is already hidden " ]
CEUserNotHidden _ -> [ " user is not hidden " ]
2022-02-06 16:18:01 +00:00
CEChatNotStarted -> [ " error: chat not started " ]
2022-06-06 16:23:47 +01:00
CEChatNotStopped -> [ " error: chat not stopped " ]
2022-08-31 18:07:34 +01:00
CEChatStoreChanged -> [ " error: chat store changed, please restart chat " ]
2022-01-24 16:07:17 +00:00
CEInvalidConnReq -> viewInvalidConnReq
2023-05-26 17:36:06 +04:00
CEInvalidChatMessage Connection { connId } msgMeta_ msg e ->
[ plain $
( " chat message error: " <> e <> " ( " <> T . unpack ( T . take 120 msg ) <> " ) " )
<> ( " , connection id: " <> show connId )
<> maybe " " ( \ MsgMetaJSON { rcvId } -> " , agent msg rcv id: " <> show rcvId ) msgMeta_
]
2022-02-14 18:49:42 +04:00
CEContactNotReady c -> [ ttyContact' c <> " : not ready " ]
2023-01-07 19:47:51 +04:00
CEContactDisabled Contact { localDisplayName = c } -> [ ttyContact c <> " : disabled, to enable: " <> highlight ( " /enable " <> c ) <> " , to delete: " <> highlight ( " /d " <> c ) ]
2023-01-16 09:13:46 +00:00
CEConnectionDisabled Connection { connId , connType } -> [ plain $ " connection " <> textEncode connType <> " ( " <> tshow connId <> " ) is disabled " | logLevel <= CLLWarning ]
2021-07-16 07:40:55 +01:00
CEGroupDuplicateMember c -> [ " contact " <> ttyContact c <> " is already in the group " ]
CEGroupDuplicateMemberId -> [ " cannot add member - duplicate member ID " ]
2023-02-08 07:08:53 +00:00
CEGroupUserRole g role ->
( : [] ) . ( ttyGroup' g <> ) $ case role of
GRAuthor -> " : you don't have permission to send messages "
_ -> " : you have insufficient permissions for this action, the required role is " <> plain ( strEncode role )
2023-03-06 09:51:42 +00:00
CEGroupMemberInitialRole g role -> [ ttyGroup' g <> " : initial role for group member cannot be " <> plain ( strEncode role ) <> " , use member or observer " ]
2022-08-27 19:56:03 +04:00
CEContactIncognitoCantInvite -> [ " you're using your main profile for this group - prohibited to invite contacts to whom you are connected incognito " ]
CEGroupIncognitoCantInvite -> [ " you've connected to this group using an incognito profile - prohibited to invite contacts " ]
2021-07-24 10:26:28 +01:00
CEGroupContactRole c -> [ " contact " <> ttyContact c <> " has insufficient permissions for this group action " ]
2022-01-27 22:01:15 +00:00
CEGroupNotJoined g -> [ " you did not join this group, use " <> highlight ( " /join # " <> groupName' g ) ]
2023-02-01 13:57:39 +00:00
CEGroupMemberNotActive -> [ " your group connection is not active yet, try later " ]
2022-01-05 20:46:35 +04:00
CEGroupMemberUserRemoved -> [ " you are no longer a member of the group " ]
2022-07-12 19:20:56 +04:00
CEGroupMemberNotFound -> [ " group doesn't have this member " ]
2022-01-24 16:07:17 +00:00
CEGroupMemberIntroNotFound c -> [ " group member intro not found for " <> ttyContact c ]
CEGroupCantResendInvitation g c -> viewCannotResendInvitation g c
2021-07-16 07:40:55 +01:00
CEGroupInternal s -> [ " chat group bug: " <> plain s ]
2021-09-04 07:32:56 +01:00
CEFileNotFound f -> [ " file not found: " <> plain f ]
2023-04-21 13:46:56 +04:00
CEFileSize f -> [ " file size exceeds the limit: " <> plain f ]
2022-10-14 13:06:33 +01:00
CEFileAlreadyReceiving f -> [ " file is already being received: " <> plain f ]
2022-05-11 16:18:28 +04:00
CEFileCancelled f -> [ " file cancelled: " <> plain f ]
2023-03-30 14:10:13 +04:00
CEFileCancel fileId e -> [ " error cancelling file " <> sShow fileId <> " : " <> sShow e ]
2021-09-04 07:32:56 +01:00
CEFileAlreadyExists f -> [ " file already exists: " <> plain f ]
CEFileRead f e -> [ " cannot read file " <> plain f , sShow e ]
CEFileWrite f e -> [ " cannot write file " <> plain f , sShow e ]
CEFileSend fileId e -> [ " error sending file " <> sShow fileId <> " : " <> sShow e ]
CEFileRcvChunk e -> [ " error receiving file: " <> plain e ]
CEFileInternal e -> [ " file error: " <> plain e ]
2022-10-01 14:29:02 +04:00
CEFileImageType _ -> [ " image type must be jpg, send as a file using " <> highlight' " /f " ]
CEFileImageSize _ -> [ " max image size: " <> sShow maxImageSize <> " bytes, resize it or send as a file using " <> highlight' " /f " ]
2022-05-21 18:17:15 +04:00
CEFileNotReceived fileId -> [ " file " <> sShow fileId <> " not received " ]
2023-03-30 18:36:39 +04:00
CEXFTPRcvFile fileId aFileId e -> [ " error receiving XFTP file " <> sShow fileId <> " , agent file id " <> sShow aFileId <> " : " <> sShow e | logLevel == CLLError ]
CEXFTPSndFile fileId aFileId e -> [ " error sending XFTP file " <> sShow fileId <> " , agent file id " <> sShow aFileId <> " : " <> sShow e | logLevel == CLLError ]
2023-04-18 18:51:14 +04:00
CEFallbackToSMPProhibited fileId -> [ " recipient tried to accept file " <> sShow fileId <> " via old protocol, prohibited " ]
2022-11-27 13:54:34 +00:00
CEInlineFileProhibited _ -> [ " A small file sent without acceptance - you can enable receiving such files with -f option. " ]
2022-03-13 19:34:03 +00:00
CEInvalidQuote -> [ " cannot reply to this message " ]
2022-03-28 20:35:57 +04:00
CEInvalidChatItemUpdate -> [ " cannot update this item " ]
CEInvalidChatItemDelete -> [ " cannot delete this item " ]
2022-05-03 10:22:35 +01:00
CEHasCurrentCall -> [ " call already in progress " ]
CENoCurrentCall -> [ " no call in progress " ]
CECallContact _ -> []
CECallState _ -> []
2022-12-03 18:06:21 +00:00
CEDirectMessagesProhibited dir ct -> viewDirectMessagesProhibited dir ct
2022-01-11 08:50:44 +00:00
CEAgentVersion -> [ " unsupported agent version " ]
2022-07-17 15:51:17 +01:00
CEAgentNoSubResult connId -> [ " no subscription result for connection: " <> sShow connId ]
2023-04-05 21:59:12 +01:00
CEServerProtocol p -> [ plain $ " Servers for protocol " <> strEncode p <> " cannot be configured by the users " ]
2022-01-24 16:07:17 +00:00
CECommandError e -> [ " bad chat command: " <> plain e ]
2022-09-14 19:45:21 +04:00
CEAgentCommandError e -> [ " agent command error: " <> plain e ]
2023-03-14 11:42:44 +04:00
CEInvalidFileDescription e -> [ " invalid file description: " <> plain e ]
2023-08-08 17:25:28 +04:00
CEConnectionIncognitoChangeProhibited -> [ " incognito mode change prohibited " ]
2022-12-15 15:17:29 +04:00
CEInternalError e -> [ " internal chat error: " <> plain e ]
2023-05-23 18:38:40 +04:00
CEException e -> [ " exception: " <> plain e ]
2021-09-04 07:32:56 +01:00
-- e -> ["chat error: " <> sShow e]
2021-07-12 19:00:03 +01:00
ChatErrorStore err -> case err of
2021-07-14 20:11:41 +01:00
SEDuplicateName -> [ " this display name is already used by user, contact or group " ]
2023-01-04 21:06:28 +04:00
SEUserNotFoundByName u -> [ " no user " <> ttyContact u ]
2022-01-29 16:06:08 +04:00
SEContactNotFoundByName c -> [ " no contact " <> ttyContact c ]
2021-07-12 19:00:03 +01:00
SEContactNotReady c -> [ " contact " <> ttyContact c <> " is not active yet " ]
2022-01-29 16:06:08 +04:00
SEGroupNotFoundByName g -> [ " no group " <> ttyGroup g ]
2021-07-16 07:40:55 +01:00
SEGroupAlreadyJoined -> [ " you already joined this group " ]
2021-09-04 07:32:56 +01:00
SEFileNotFound fileId -> fileNotFound fileId
SESndFileNotFound fileId -> fileNotFound fileId
SERcvFileNotFound fileId -> fileNotFound fileId
2021-12-08 13:09:51 +00:00
SEDuplicateContactLink -> [ " you already have chat address, to show: " <> highlight' " /sa " ]
SEUserContactLinkNotFound -> [ " no chat address, to create: " <> highlight' " /ad " ]
2022-01-31 21:53:53 +04:00
SEContactRequestNotFoundByName c -> [ " no contact request from " <> ttyContact c ]
2022-04-05 10:01:08 +04:00
SEFileIdNotFoundBySharedMsgId _ -> [] -- recipient tried to accept cancelled file
2023-01-16 09:13:46 +00:00
SEConnectionNotFound agentConnId -> [ " event connection not found, agent ID: " <> sShow agentConnId | logLevel <= CLLWarning ] -- mutes delete group error
2023-05-08 20:07:51 +04:00
SEChatItemNotFoundByText text -> [ " message not found by text: " <> plain text ]
2022-10-13 17:12:22 +04:00
SEDuplicateGroupLink g -> [ " you already have link for this group, to show: " <> highlight ( " /show link # " <> groupName' g ) ]
SEGroupLinkNotFound g -> [ " no group link, to create: " <> highlight ( " /create link # " <> groupName' g ) ]
2021-09-04 07:32:56 +01:00
e -> [ " chat db error: " <> sShow e ]
2022-08-31 18:07:34 +01:00
ChatErrorDatabase err -> case err of
2022-09-05 14:54:39 +01:00
DBErrorEncrypted -> [ " error: chat database is already encrypted " ]
DBErrorPlaintext -> [ " error: chat database is not encrypted " ]
2022-09-07 17:20:47 +01:00
DBErrorExport e -> [ " error encrypting database: " <> sqliteError' e ]
DBErrorOpen e -> [ " error opening database after encryption: " <> sqliteError' e ]
2022-08-31 18:07:34 +01:00
e -> [ " chat database error: " <> sShow e ]
2023-01-07 19:47:51 +04:00
ChatErrorAgent err entity_ -> case err of
2023-06-16 19:05:53 +04:00
CMD PROHIBITED -> [ withConnEntity <> " error: command is prohibited " ]
2022-04-21 11:50:24 +04:00
SMP SMP . AUTH ->
2023-01-06 13:11:21 +04:00
[ withConnEntity
<> " error: connection authorization failed - this could happen if connection was deleted, \
\ secured with different credentials , or due to a bug - please re - create the connection "
2022-04-21 11:50:24 +04:00
]
2023-01-16 09:13:46 +00:00
AGENT A_DUPLICATE -> [ withConnEntity <> " error: AGENT A_DUPLICATE " | logLevel == CLLDebug ]
AGENT A_PROHIBITED -> [ withConnEntity <> " error: AGENT A_PROHIBITED " | logLevel <= CLLWarning ]
CONN NOT_FOUND -> [ withConnEntity <> " error: CONN NOT_FOUND " | logLevel <= CLLWarning ]
e -> [ withConnEntity <> " smp agent error: " <> sShow e | logLevel <= CLLWarning ]
2023-01-06 13:11:21 +04:00
where
2023-01-07 19:47:51 +04:00
withConnEntity = case entity_ of
Just entity @ ( RcvDirectMsgConnection conn contact_ ) -> case contact_ of
Just Contact { contactId } ->
" [ " <> connEntityLabel entity <> " , contactId: " <> sShow contactId <> " , connId: " <> cId conn <> " ] "
2023-01-06 13:11:21 +04:00
Nothing ->
2023-01-07 19:47:51 +04:00
" [ " <> connEntityLabel entity <> " , connId: " <> cId conn <> " ] "
Just entity @ ( RcvGroupMsgConnection conn GroupInfo { groupId } GroupMember { groupMemberId } ) ->
" [ " <> connEntityLabel entity <> " , groupId: " <> sShow groupId <> " , memberId: " <> sShow groupMemberId <> " , connId: " <> cId conn <> " ] "
Just entity @ ( RcvFileConnection conn RcvFileTransfer { fileId } ) ->
" [ " <> connEntityLabel entity <> " , fileId: " <> sShow fileId <> " , connId: " <> cId conn <> " ] "
Just entity @ ( SndFileConnection conn SndFileTransfer { fileId } ) ->
" [ " <> connEntityLabel entity <> " , fileId: " <> sShow fileId <> " , connId: " <> cId conn <> " ] "
Just entity @ ( UserContactConnection conn UserContact { userContactLinkId } ) ->
" [ " <> connEntityLabel entity <> " , userContactLinkId: " <> sShow userContactLinkId <> " , connId: " <> cId conn <> " ] "
2023-01-06 13:11:21 +04:00
Nothing -> " "
cId conn = sShow ( connId ( conn :: Connection ) )
2021-09-04 07:32:56 +01:00
where
fileNotFound fileId = [ " file " <> sShow fileId <> " not found " ]
2022-09-07 17:20:47 +01:00
sqliteError' = \ case
SQLiteErrorNotADatabase -> " wrong passphrase or invalid database file "
SQLiteError e -> sShow e
2021-06-25 18:18:24 +01:00
2023-01-07 19:47:51 +04:00
viewConnectionEntityDisabled :: ConnectionEntity -> [ StyledString ]
viewConnectionEntityDisabled entity = case entity of
RcvDirectMsgConnection _ ( Just Contact { localDisplayName = c } ) -> [ " [ " <> entityLabel <> " ] connection is disabled, to enable: " <> highlight ( " /enable " <> c ) <> " , to delete: " <> highlight ( " /d " <> c ) ]
RcvGroupMsgConnection _ GroupInfo { localDisplayName = g } GroupMember { localDisplayName = m } -> [ " [ " <> entityLabel <> " ] connection is disabled, to enable: " <> highlight ( " /enable # " <> g <> " " <> m ) ]
_ -> [ " [ " <> entityLabel <> " ] connection is disabled " ]
where
entityLabel = connEntityLabel entity
connEntityLabel :: ConnectionEntity -> StyledString
connEntityLabel = \ case
RcvDirectMsgConnection _ ( Just Contact { localDisplayName = c } ) -> plain c
RcvDirectMsgConnection _ Nothing -> " rcv direct msg "
RcvGroupMsgConnection _ GroupInfo { localDisplayName = g } GroupMember { localDisplayName = m } -> plain $ " # " <> g <> " " <> m
RcvFileConnection _ RcvFileTransfer { fileInvitation = FileInvitation { fileName } } -> plain $ " rcv file " <> T . pack fileName
SndFileConnection _ SndFileTransfer { fileName } -> plain $ " snd file " <> T . pack fileName
UserContactConnection _ UserContact { } -> " contact address "
2021-07-14 20:11:41 +01:00
ttyContact :: ContactName -> StyledString
2022-03-13 19:34:03 +00:00
ttyContact = styled $ colored Green
2021-06-25 18:18:24 +01:00
2022-01-26 16:18:27 +04:00
ttyContact' :: Contact -> StyledString
ttyContact' Contact { localDisplayName = c } = ttyContact c
2021-07-16 07:40:55 +01:00
ttyFullContact :: Contact -> StyledString
2022-08-18 11:35:31 +04:00
ttyFullContact Contact { localDisplayName , profile = LocalProfile { fullName } } =
2021-07-24 10:26:28 +01:00
ttyFullName localDisplayName fullName
ttyMember :: GroupMember -> StyledString
ttyMember GroupMember { localDisplayName } = ttyContact localDisplayName
ttyFullMember :: GroupMember -> StyledString
2022-08-18 11:35:31 +04:00
ttyFullMember GroupMember { localDisplayName , memberProfile = LocalProfile { fullName } } =
2021-07-24 10:26:28 +01:00
ttyFullName localDisplayName fullName
ttyFullName :: ContactName -> Text -> StyledString
ttyFullName c fullName = ttyContact c <> optFullName c fullName
2021-07-16 07:40:55 +01:00
2021-07-14 20:11:41 +01:00
ttyToContact :: ContactName -> StyledString
2022-12-19 11:16:50 +00:00
ttyToContact c = ttyTo $ " @ " <> c <> " "
2022-03-28 20:35:57 +04:00
2022-03-13 19:34:03 +00:00
ttyToContact' :: Contact -> StyledString
2022-12-19 11:16:50 +00:00
ttyToContact' ct @ Contact { localDisplayName = c } = ctIncognito ct <> ttyToContact c
ttyToContactEdited' :: Contact -> StyledString
ttyToContactEdited' ct @ Contact { localDisplayName = c } = ctIncognito ct <> ttyTo ( " @ " <> c <> " [edited] " )
2022-03-13 19:34:03 +00:00
ttyQuotedContact :: Contact -> StyledString
ttyQuotedContact Contact { localDisplayName = c } = ttyFrom $ c <> " > "
2022-03-16 13:20:47 +00:00
ttyQuotedMember :: Maybe GroupMember -> StyledString
ttyQuotedMember ( Just GroupMember { localDisplayName = c } ) = " > " <> ttyFrom c
ttyQuotedMember _ = " > " <> ttyFrom " ? "
2022-03-13 19:34:03 +00:00
2022-12-19 11:16:50 +00:00
ttyFromContact :: Contact -> StyledString
ttyFromContact ct @ Contact { localDisplayName = c } = ctIncognito ct <> ttyFrom ( c <> " > " )
ttyFromContactEdited :: Contact -> StyledString
ttyFromContactEdited ct @ Contact { localDisplayName = c } = ctIncognito ct <> ttyFrom ( c <> " > [edited] " )
2023-02-08 07:08:53 +00:00
ttyFromContactDeleted :: Contact -> Maybe Text -> StyledString
ttyFromContactDeleted ct @ Contact { localDisplayName = c } deletedText_ =
ctIncognito ct <> ttyFrom ( c <> " > " <> maybe " " ( \ t -> " [ " <> t <> " ] " ) deletedText_ )
2021-06-25 18:18:24 +01:00
2021-07-14 20:11:41 +01:00
ttyGroup :: GroupName -> StyledString
2022-02-22 14:05:45 +00:00
ttyGroup g = styled ( colored Blue ) $ " # " <> g
2021-06-25 18:18:24 +01:00
2022-01-26 16:18:27 +04:00
ttyGroup' :: GroupInfo -> StyledString
2022-01-27 22:01:15 +00:00
ttyGroup' = ttyGroup . groupName'
2022-01-26 16:18:27 +04:00
2022-01-24 16:07:17 +00:00
ttyGroups :: [ GroupName ] -> StyledString
ttyGroups [] = " "
ttyGroups [ g ] = ttyGroup g
ttyGroups ( g : gs ) = ttyGroup g <> " , " <> ttyGroups gs
2022-01-26 16:18:27 +04:00
ttyFullGroup :: GroupInfo -> StyledString
ttyFullGroup GroupInfo { localDisplayName = g , groupProfile = GroupProfile { fullName } } =
ttyGroup g <> optFullName g fullName
2021-07-16 07:40:55 +01:00
2022-12-19 11:16:50 +00:00
ttyFromGroup :: GroupInfo -> GroupMember -> StyledString
ttyFromGroup g m = membershipIncognito g <> ttyFrom ( fromGroup_ g m )
2022-03-13 19:34:03 +00:00
2022-12-19 11:16:50 +00:00
ttyFromGroupEdited :: GroupInfo -> GroupMember -> StyledString
ttyFromGroupEdited g m = membershipIncognito g <> ttyFrom ( fromGroup_ g m <> " [edited] " )
2022-03-23 11:37:51 +00:00
2023-02-08 07:08:53 +00:00
ttyFromGroupDeleted :: GroupInfo -> GroupMember -> Maybe Text -> StyledString
ttyFromGroupDeleted g m deletedText_ =
membershipIncognito g <> ttyFrom ( fromGroup_ g m <> maybe " " ( \ t -> " [ " <> t <> " ] " ) deletedText_ )
2022-12-19 11:16:50 +00:00
fromGroup_ :: GroupInfo -> GroupMember -> Text
fromGroup_ GroupInfo { localDisplayName = g } GroupMember { localDisplayName = m } =
" # " <> g <> " " <> m <> " > "
2022-03-28 20:35:57 +04:00
2022-03-13 19:34:03 +00:00
ttyFrom :: Text -> StyledString
ttyFrom = styled $ colored Yellow
2022-12-19 11:16:50 +00:00
ttyTo :: Text -> StyledString
ttyTo = styled $ colored Cyan
2021-07-24 10:26:28 +01:00
2022-01-26 16:18:27 +04:00
ttyToGroup :: GroupInfo -> StyledString
2022-12-19 11:16:50 +00:00
ttyToGroup g @ GroupInfo { localDisplayName = n } =
membershipIncognito g <> ttyTo ( " # " <> n <> " " )
ttyToGroupEdited :: GroupInfo -> StyledString
ttyToGroupEdited g @ GroupInfo { localDisplayName = n } =
membershipIncognito g <> ttyTo ( " # " <> n <> " [edited] " )
2021-07-24 10:26:28 +01:00
2021-09-05 14:08:29 +01:00
ttyFilePath :: FilePath -> StyledString
ttyFilePath = plain
2021-07-24 10:26:28 +01:00
optFullName :: ContactName -> Text -> StyledString
2022-07-14 22:04:23 +04:00
optFullName localDisplayName fullName = plain $ optionalFullName localDisplayName fullName
2021-07-16 07:40:55 +01:00
2022-12-19 11:16:50 +00:00
ctIncognito :: Contact -> StyledString
ctIncognito ct = if contactConnIncognito ct then incognitoPrefix else " "
membershipIncognito :: GroupInfo -> StyledString
membershipIncognito = memIncognito . membership
memIncognito :: GroupMember -> StyledString
memIncognito m = if memberIncognito m then incognitoPrefix else " "
2022-08-18 11:35:31 +04:00
incognitoPrefix :: StyledString
incognitoPrefix = styleIncognito' " i "
incognitoProfile' :: Profile -> StyledString
incognitoProfile' Profile { displayName } = styleIncognito displayName
2021-07-16 07:40:55 +01:00
highlight :: StyledFormat a => a -> StyledString
2022-03-13 19:34:03 +00:00
highlight = styled $ colored Cyan
2021-07-16 07:40:55 +01:00
highlight' :: String -> StyledString
highlight' = highlight
2022-08-18 11:35:31 +04:00
styleIncognito :: StyledFormat a => a -> StyledString
styleIncognito = styled $ colored Magenta
styleIncognito' :: String -> StyledString
styleIncognito' = styleIncognito
2021-06-25 18:18:24 +01:00
styleTime :: String -> StyledString
styleTime = Styled [ SetColor Foreground Vivid Black ]
2022-03-13 19:34:03 +00:00
ttyError :: StyledFormat a => a -> StyledString
ttyError = styled $ colored Red
ttyError' :: String -> StyledString
ttyError' = ttyError