android-apps-mirrors/SimpleX-Chat
0
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-06-28 20:29:53 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

core: calculate local item ts in view instead of having it in type (#2551)

Browse source
This commit is contained in:
spaced4ndy 2023-06-08 11:07:21 +04:00 • committed by GitHub
parent 925813b14c
commit fb72dfcdee
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
5 changed files with 101 additions and 113 deletions
Download patch file Download diff file Expand all files Collapse all files

7
src/Simplex/Chat.hs
View file

@ -46,7 +46,7 @@ import Data.Text.Encoding (encodeUtf8)
import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime) import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds) import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds)
import Data.Time.Clock.System (SystemTime, systemToUTCTime) import Data.Time.Clock.System (SystemTime, systemToUTCTime)
import Data.Time.LocalTime (getCurrentTimeZone, getZonedTime) import Data.Time.LocalTime (getCurrentTimeZone)
import Data.Word (Word32) import Data.Word (Word32)
import qualified Database.SQLite.Simple as DB import qualified Database.SQLite.Simple as DB
import Simplex.Chat.Archive import Simplex.Chat.Archive
@ -1260,7 +1260,7 @@ processChatCommand = \case
saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc)
) )
`catchError` (toView . CRChatError (Just user)) `catchError` (toView . CRChatError (Just user))
CRBroadcastSent user mc (length cts) <$> liftIO getZonedTime CRBroadcastSent user mc (length cts) <$> liftIO getCurrentTime
SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do
contactId <- withStore $ \db -> getContactIdByName db user cName contactId <- withStore $ \db -> getContactIdByName db user cName
quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg
@ -4420,10 +4420,9 @@ saveRcvChatItem' user cd msg sharedMsgId_ MsgMeta {broker = (_, brokerTs)} conte
mkChatItem :: forall c d. MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> UTCTime -> IO (ChatItem c d) mkChatItem :: forall c d. MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> UTCTime -> IO (ChatItem c d)
mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs currentTs = do mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs currentTs = do
tz <- getCurrentTimeZone
let itemText = ciContentToText content let itemText = ciContentToText content
itemStatus = ciCreateStatus content itemStatus = ciCreateStatus content
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) tz currentTs itemTs currentTs currentTs meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs currentTs currentTs
pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file} pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file}
deleteDirectCI :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> Bool -> Bool -> m ChatResponse deleteDirectCI :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> Bool -> Bool -> m ChatResponse

4
src/Simplex/Chat/Controller.hs
View file

@ -32,7 +32,7 @@ import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map) import Data.Map.Strict (Map)
import Data.String import Data.String
import Data.Text (Text) import Data.Text (Text)
import Data.Time (NominalDiffTime, ZonedTime) import Data.Time (NominalDiffTime)
import Data.Time.Clock (UTCTime) import Data.Time.Clock (UTCTime)
import Data.Version (showVersion) import Data.Version (showVersion)
import GHC.Generics (Generic) import GHC.Generics (Generic)
@ -413,7 +413,7 @@ data ChatResponse
| CRChatItemReaction {user :: User, added :: Bool, reaction :: ACIReaction} | CRChatItemReaction {user :: User, added :: Bool, reaction :: ACIReaction}
| CRChatItemDeleted {user :: User, deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool} | CRChatItemDeleted {user :: User, deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool}
| CRChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId} | CRChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId}
| CRBroadcastSent User MsgContent Int ZonedTime | CRBroadcastSent User MsgContent Int UTCTime
| CRMsgIntegrityError {user :: User, msgError :: MsgErrorType} | CRMsgIntegrityError {user :: User, msgError :: MsgErrorType}
| CRCmdAccepted {corr :: CorrId} | CRCmdAccepted {corr :: CorrId}
| CRCmdOk {user_ :: Maybe User} | CRCmdOk {user_ :: Maybe User}

11
src/Simplex/Chat/Messages.hs
View file

@ -26,7 +26,6 @@ import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay) import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay)
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime)
import Data.Type.Equality import Data.Type.Equality
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.FromField (FromField (..))
@ -341,19 +340,17 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
itemTimed :: Maybe CITimed, itemTimed :: Maybe CITimed,
itemLive :: Maybe Bool, itemLive :: Maybe Bool,
editable :: Bool, editable :: Bool,
localItemTs :: ZonedTime,
createdAt :: UTCTime, createdAt :: UTCTime,
updatedAt :: UTCTime updatedAt :: UTCTime
} }
deriving (Show, Generic) deriving (Show, Generic)
mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> TimeZone -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta c d mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta c d
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive tz currentTs itemTs createdAt updatedAt = mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs createdAt updatedAt =
let localItemTs = utcToZonedTime tz itemTs let editable = case itemContent of
editable = case itemContent of
CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted
_ -> False _ -> False
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, localItemTs, createdAt, updatedAt} in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, createdAt, updatedAt}
instance ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOptions instance ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOptions

62
src/Simplex/Chat/Store.hs
View file

@ -320,7 +320,6 @@ import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time (addUTCTime) import Data.Time (addUTCTime)
import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay) import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay)
import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)
import Data.Type.Equality import Data.Type.Equality
import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), SQLError, (:.) (..)) import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), SQLError, (:.) (..))
import qualified Database.SQLite.Simple as DB import qualified Database.SQLite.Simple as DB
@ -3787,9 +3786,8 @@ getChatPreviews db user withPCC = do
getDirectChatPreviews_ :: DB.Connection -> User -> IO [AChat] getDirectChatPreviews_ :: DB.Connection -> User -> IO [AChat]
getDirectChatPreviews_ db user@User {userId} = do getDirectChatPreviews_ db user@User {userId} = do
tz <- getCurrentTimeZone
currentTs <- getCurrentTime currentTs <- getCurrentTime
map (toDirectChatPreview tz currentTs) map (toDirectChatPreview currentTs)
<$> DB.query <$> DB.query
db db
[sql| [sql|
@ -3843,18 +3841,17 @@ getDirectChatPreviews_ db user@User {userId} = do
|] |]
(CISRcvNew, userId, ConnReady, ConnSndReady) (CISRcvNew, userId, ConnReady, ConnSndReady)
where where
toDirectChatPreview :: TimeZone -> UTCTime -> ContactRow :. ConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat toDirectChatPreview :: UTCTime -> ContactRow :. ConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat
toDirectChatPreview tz currentTs (contactRow :. connRow :. statsRow :. ciRow_) = toDirectChatPreview currentTs (contactRow :. connRow :. statsRow :. ciRow_) =
let contact = toContact user $ contactRow :. connRow let contact = toContact user $ contactRow :. connRow
ci_ = toDirectChatItemList tz currentTs ciRow_ ci_ = toDirectChatItemList currentTs ciRow_
stats = toChatStats statsRow stats = toChatStats statsRow
in AChat SCTDirect $ Chat (DirectChat contact) ci_ stats in AChat SCTDirect $ Chat (DirectChat contact) ci_ stats
getGroupChatPreviews_ :: DB.Connection -> User -> IO [AChat] getGroupChatPreviews_ :: DB.Connection -> User -> IO [AChat]
getGroupChatPreviews_ db User {userId, userContactId} = do getGroupChatPreviews_ db User {userId, userContactId} = do
tz <- getCurrentTimeZone
currentTs <- getCurrentTime currentTs <- getCurrentTime
map (toGroupChatPreview tz currentTs) map (toGroupChatPreview currentTs)
<$> DB.query <$> DB.query
db db
[sql| [sql|
@ -3915,10 +3912,10 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|] |]
(CISRcvNew, userId, userContactId) (CISRcvNew, userId, userContactId)
where where
toGroupChatPreview :: TimeZone -> UTCTime -> GroupInfoRow :. ChatStatsRow :. MaybeGroupChatItemRow -> AChat toGroupChatPreview :: UTCTime -> GroupInfoRow :. ChatStatsRow :. MaybeGroupChatItemRow -> AChat
toGroupChatPreview tz currentTs (groupInfoRow :. statsRow :. ciRow_) = toGroupChatPreview currentTs (groupInfoRow :. statsRow :. ciRow_) =
let groupInfo = toGroupInfo userContactId groupInfoRow let groupInfo = toGroupInfo userContactId groupInfoRow
ci_ = toGroupChatItemList tz currentTs userContactId ciRow_ ci_ = toGroupChatItemList currentTs userContactId ciRow_
stats = toChatStats statsRow stats = toChatStats statsRow
in AChat SCTGroup $ Chat (GroupChat groupInfo) ci_ stats in AChat SCTGroup $ Chat (GroupChat groupInfo) ci_ stats
@ -4026,9 +4023,8 @@ getDirectChatLast_ db user ct@Contact {contactId} count search = do
-- the last items in reverse order (the last item in the conversation is the first in the returned list) -- the last items in reverse order (the last item in the conversation is the first in the returned list)
getDirectChatItemsLast :: DB.Connection -> User -> ContactId -> Int -> String -> ExceptT StoreError IO [CChatItem 'CTDirect] getDirectChatItemsLast :: DB.Connection -> User -> ContactId -> Int -> String -> ExceptT StoreError IO [CChatItem 'CTDirect]
getDirectChatItemsLast db User {userId} contactId count search = ExceptT $ do getDirectChatItemsLast db User {userId} contactId count search = ExceptT $ do
tz <- getCurrentTimeZone
currentTs <- getCurrentTime currentTs <- getCurrentTime
mapM (toDirectChatItem tz currentTs) mapM (toDirectChatItem currentTs)
<$> DB.query <$> DB.query
db db
[sql| [sql|
@ -4056,9 +4052,8 @@ getDirectChatAfter_ db User {userId} ct@Contact {contactId} afterChatItemId coun
where where
getDirectChatItemsAfter_ :: IO (Either StoreError [CChatItem 'CTDirect]) getDirectChatItemsAfter_ :: IO (Either StoreError [CChatItem 'CTDirect])
getDirectChatItemsAfter_ = do getDirectChatItemsAfter_ = do
tz <- getCurrentTimeZone
currentTs <- getCurrentTime currentTs <- getCurrentTime
mapM (toDirectChatItem tz currentTs) mapM (toDirectChatItem currentTs)
<$> DB.query <$> DB.query
db db
[sql| [sql|
@ -4087,9 +4082,8 @@ getDirectChatBefore_ db User {userId} ct@Contact {contactId} beforeChatItemId co
where where
getDirectChatItemsBefore_ :: IO (Either StoreError [CChatItem 'CTDirect]) getDirectChatItemsBefore_ :: IO (Either StoreError [CChatItem 'CTDirect])
getDirectChatItemsBefore_ = do getDirectChatItemsBefore_ = do
tz <- getCurrentTimeZone
currentTs <- getCurrentTime currentTs <- getCurrentTime
mapM (toDirectChatItem tz currentTs) mapM (toDirectChatItem currentTs)
<$> DB.query <$> DB.query
db db
[sql| [sql|
@ -4523,9 +4517,8 @@ getDirectChatItemIdBySharedMsgId_ db userId contactId sharedMsgId =
getDirectChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect) getDirectChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem db User {userId} contactId itemId = ExceptT $ do getDirectChatItem db User {userId} contactId itemId = ExceptT $ do
tz <- getCurrentTimeZone
currentTs <- getCurrentTime currentTs <- getCurrentTime
join <$> firstRow (toDirectChatItem tz currentTs) (SEChatItemNotFound itemId) getItem join <$> firstRow (toDirectChatItem currentTs) (SEChatItemNotFound itemId) getItem
where where
getItem = getItem =
DB.query DB.query
@ -4684,9 +4677,8 @@ getGroupMemberCIBySharedMsgId db user@User {userId} groupId memberId sharedMsgId
getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup) getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
tz <- getCurrentTimeZone
currentTs <- getCurrentTime currentTs <- getCurrentTime
join <$> firstRow (toGroupChatItem tz currentTs userContactId) (SEChatItemNotFound itemId) getItem join <$> firstRow (toGroupChatItem currentTs userContactId) (SEChatItemNotFound itemId) getItem
where where
getItem = getItem =
DB.query DB.query
@ -5135,8 +5127,8 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir
CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent) CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
-- this function can be changed so it never fails, not only avoid failure on invalid json -- this function can be changed so it never fails, not only avoid failure on invalid json
toDirectChatItem :: TimeZone -> UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect) toDirectChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
toDirectChatItem tz currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. quoteRow) = toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. quoteRow) =
chatItem $ fromRight invalid $ dbParseACIContent itemContentText chatItem $ fromRight invalid $ dbParseACIContent itemContentText
where where
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
@ -5163,14 +5155,14 @@ toDirectChatItem tz currentTs (((itemId, itemTs, AMsgDirection msgDir, itemConte
ciMeta content status = ciMeta content status =
let itemDeleted' = if itemDeleted then Just (CIDeleted @'CTDirect deletedTs) else Nothing let itemDeleted' = if itemDeleted then Just (CIDeleted @'CTDirect deletedTs) else Nothing
itemEdited' = fromMaybe False itemEdited itemEdited' = fromMaybe False itemEdited
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive tz currentTs itemTs createdAt updatedAt in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt
ciTimed :: Maybe CITimed ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
toDirectChatItemList :: TimeZone -> UTCTime -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect] toDirectChatItemList :: UTCTime -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect]
toDirectChatItemList tz currentTs (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) = toDirectChatItemList currentTs (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) =
either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) either (const []) (: []) $ toDirectChatItem currentTs (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow)
toDirectChatItemList _ _ _ = [] toDirectChatItemList _ _ = []
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
@ -5185,8 +5177,8 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
direction _ _ = Nothing direction _ _ = Nothing
-- this function can be changed so it never fails, not only avoid failure on invalid json -- this function can be changed so it never fails, not only avoid failure on invalid json
toGroupChatItem :: TimeZone -> UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup) toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
toGroupChatItem tz currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
chatItem $ fromRight invalid $ dbParseACIContent itemContentText chatItem $ fromRight invalid $ dbParseACIContent itemContentText
where where
member_ = toMaybeGroupMember userContactId memberRow_ member_ = toMaybeGroupMember userContactId memberRow_
@ -5219,14 +5211,14 @@ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, AMsgDirection msgD
then Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_) then Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
else Nothing else Nothing
itemEdited' = fromMaybe False itemEdited itemEdited' = fromMaybe False itemEdited
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive tz currentTs itemTs createdAt updatedAt in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt
ciTimed :: Maybe CITimed ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
toGroupChatItemList :: TimeZone -> UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup] toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
toGroupChatItemList _ _ _ _ = [] toGroupChatItemList _ _ _ = []
getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p] getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p]
getProtocolServers db User {userId} = getProtocolServers db User {userId} =

130
src/Simplex/Chat/View.hs
View file

@ -26,7 +26,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1) import Data.Text.Encoding (decodeLatin1)
import Data.Time.Clock (DiffTime, UTCTime) import Data.Time.Clock (DiffTime, UTCTime)
import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.Format (defaultTimeLocale, formatTime)
import Data.Time.LocalTime (TimeZone, ZonedTime (..), localDay, localTimeOfDay, timeOfDayToTime, utcToLocalTime, utcToZonedTime) import Data.Time.LocalTime (TimeZone, localDay, localTimeOfDay, timeOfDayToTime, utcToLocalTime)
import Data.Word (Word32) import Data.Word (Word32)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import qualified Network.HTTP.Types as Q import qualified Network.HTTP.Types as Q
@ -70,7 +70,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts
CRChatStopped -> ["chat stopped"] CRChatStopped -> ["chat stopped"]
CRChatSuspended -> ["chat suspended"] CRChatSuspended -> ["chat suspended"]
CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [plain . bshow $ J.encode chats] CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [plain . bshow $ J.encode chats]
CRChats chats -> viewChats ts chats CRChats chats -> viewChats ts tz chats
CRApiChat u chat -> ttyUser u $ if testView then testViewChat chat else [plain . bshow $ J.encode chat] CRApiChat u chat -> ttyUser u $ if testView then testViewChat chat else [plain . bshow $ J.encode chat]
CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft] CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
CRUserProtoServers u userServers -> ttyUser u $ viewUserServers userServers testView CRUserProtoServers u userServers -> ttyUser u $ viewUserServers userServers testView
@ -84,17 +84,17 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts
CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code] 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 CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView
CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts <> viewItemReactions item 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 <> viewItemReactions item) chatItems CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems
CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId] CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
CRChatItemStatusUpdated u _ -> ttyUser u [] CRChatItemStatusUpdated u _ -> ttyUser u []
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts tz
CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci
CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts testView CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView
CRChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction chat reaction $ viewItemReaction showReactions chat reaction added ts tz CRChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction chat reaction $ viewItemReaction showReactions chat reaction added ts tz
CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"] CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"]
CRBroadcastSent u mc n t -> ttyUser u $ viewSentBroadcast mc n ts t CRBroadcastSent u mc n t -> ttyUser u $ viewSentBroadcast mc n ts tz t
CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr
CRCmdAccepted _ -> [] CRCmdAccepted _ -> []
CRCmdOk u_ -> ttyUser' u_ ["ok"] CRCmdOk u_ -> ttyUser' u_ ["ok"]
@ -352,11 +352,11 @@ showSMPServer = B.unpack . strEncode . host
viewHostEvent :: AProtocolType -> TransportHost -> String viewHostEvent :: AProtocolType -> TransportHost -> String
viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h) viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h)
viewChats :: CurrentTime -> [AChat] -> [StyledString] viewChats :: CurrentTime -> TimeZone -> [AChat] -> [StyledString]
viewChats ts = concatMap chatPreview . reverse viewChats ts tz = concatMap chatPreview . reverse
where where
chatPreview (AChat _ (Chat chat items _)) = case items of chatPreview (AChat _ (Chat chat items _)) = case items of
CChatItem _ ci : _ -> case viewChatItem chat ci True ts of CChatItem _ ci : _ -> case viewChatItem chat ci True ts tz of
s : _ -> [let s' = sTake 120 s in if sLength s' < sLength s then s' <> "..." else s'] s : _ -> [let s' = sTake 120 s in if sLength s' < sLength s then s' <> "..." else s']
_ -> chatName _ -> chatName
_ -> chatName _ -> chatName
@ -366,8 +366,8 @@ viewChats ts = concatMap chatPreview . reverse
GroupChat g -> [" " <> ttyToGroup g] GroupChat g -> [" " <> ttyToGroup g]
_ -> [] _ -> []
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> [StyledString] 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 = viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} doShow ts tz =
withItemDeleted <$> case chat of withItemDeleted <$> case chat of
DirectChat c -> case chatDir of DirectChat c -> case chatDir of
CIDirectSnd -> case content of CIDirectSnd -> case content of
@ -378,8 +378,8 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
to = ttyToContact' c to = ttyToContact' c
CIDirectRcv -> case content of CIDirectRcv -> case content of
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts meta CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts meta CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts tz meta
CIRcvGroupEvent {} -> showRcvItemProhibited from CIRcvGroupEvent {} -> showRcvItemProhibited from
_ -> showRcvItem from _ -> showRcvItem from
where where
@ -395,8 +395,8 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
to = ttyToGroup g to = ttyToGroup g
CIGroupRcv m -> case content of CIGroupRcv m -> case content of
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts meta CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts meta CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts tz meta
CIRcvGroupInvitation {} -> showRcvItemProhibited from CIRcvGroupInvitation {} -> showRcvItemProhibited from
_ -> showRcvItem from _ -> showRcvItem from
where where
@ -410,17 +410,17 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
Just t -> item <> styled (colored Red) (" [" <> t <> "]") Just t -> item <> styled (colored Red) (" [" <> t <> "]")
withSndFile = withFile viewSentFileInvitation withSndFile = withFile viewSentFileInvitation
withRcvFile = withFile viewReceivedFileInvitation withRcvFile = withFile viewReceivedFileInvitation
withFile view dir l = maybe l (\f -> l <> view dir f ts meta) file withFile view dir l = maybe l (\f -> l <> view dir f ts tz meta) file
sndMsg = msg viewSentMessage sndMsg = msg viewSentMessage
rcvMsg = msg viewReceivedMessage rcvMsg = msg viewReceivedMessage
msg view dir quote mc = case (msgContentText mc, file, quote) of msg view dir quote mc = case (msgContentText mc, file, quote) of
("", Just _, []) -> [] ("", Just _, []) -> []
("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) ts meta ("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) ts tz meta
_ -> view dir quote mc ts meta _ -> view dir quote mc ts tz meta
showSndItem to = showItem $ sentWithTime_ ts [to <> plainContent content] meta showSndItem to = showItem $ sentWithTime_ ts tz [to <> plainContent content] meta
showRcvItem from = showItem $ receivedWithTime_ ts from [] meta [plainContent content] False showRcvItem from = showItem $ receivedWithTime_ ts tz from [] meta [plainContent content] False
showSndItemProhibited to = showItem $ sentWithTime_ ts [to <> plainContent content <> " " <> prohibited] meta showSndItemProhibited to = showItem $ sentWithTime_ ts tz [to <> plainContent content <> " " <> prohibited] meta
showRcvItemProhibited from = showItem $ receivedWithTime_ ts from [] meta [plainContent content <> " " <> prohibited] False showRcvItemProhibited from = showItem $ receivedWithTime_ ts tz from [] meta [plainContent content <> " " <> prohibited] False
showItem ss = if doShow then ss else [] showItem ss = if doShow then ss else []
plainContent = plain . ciContentToText plainContent = plain . ciContentToText
prohibited = styled (colored Red) ("[unexpected chat item created, please report to developers]" :: String) prohibited = styled (colored Red) ("[unexpected chat item created, please report to developers]" :: String)
@ -451,18 +451,18 @@ localTs tz ts = do
formattedTime = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" localTime formattedTime = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" localTime
formattedTime formattedTime
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> [StyledString] 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 = case chat of viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}, content, quotedItem} liveItems ts tz = case chat of
DirectChat c -> case chatDir of DirectChat c -> case chatDir of
CIDirectRcv -> case content of CIDirectRcv -> case content of
CIRcvMsgContent mc CIRcvMsgContent mc
| itemLive == Just True && not liveItems -> [] | itemLive == Just True && not liveItems -> []
| otherwise -> viewReceivedUpdatedMessage from quote mc ts meta | otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
_ -> [] _ -> []
where where
from = if itemEdited then ttyFromContactEdited c else ttyFromContact c from = if itemEdited then ttyFromContactEdited c else ttyFromContact c
CIDirectSnd -> case content of CIDirectSnd -> case content of
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts meta CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
_ -> [] _ -> []
where where
to = if itemEdited then ttyToContactEdited' c else ttyToContact' c to = if itemEdited then ttyToContactEdited' c else ttyToContact' c
@ -472,12 +472,12 @@ viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}
CIGroupRcv m -> case content of CIGroupRcv m -> case content of
CIRcvMsgContent mc CIRcvMsgContent mc
| itemLive == Just True && not liveItems -> [] | itemLive == Just True && not liveItems -> []
| otherwise -> viewReceivedUpdatedMessage from quote mc ts meta | otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
_ -> [] _ -> []
where where
from = if itemEdited then ttyFromGroupEdited g m else ttyFromGroup g m from = if itemEdited then ttyFromGroupEdited g m else ttyFromGroup g m
CIGroupSnd -> case content of CIGroupSnd -> case content of
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts meta CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
_ -> [] _ -> []
where where
to = if itemEdited then ttyToGroupEdited g else ttyToGroup g to = if itemEdited then ttyToGroupEdited g else ttyToGroup g
@ -494,18 +494,18 @@ viewItemNotChanged (AChatItem _ msgDir _ _) = case msgDir of
SMDSnd -> ["message didn't change"] SMDSnd -> ["message didn't change"]
SMDRcv -> [] SMDRcv -> []
viewItemDelete :: ChatInfo c -> ChatItem c d -> Maybe AChatItem -> Bool -> Bool -> CurrentTime -> Bool -> [StyledString] 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 testView viewItemDelete chat ci@ChatItem {chatDir, meta, content = deletedContent} toItem byUser timed ts tz testView
| timed = [plain ("timed message deleted: " <> T.unpack (ciContentToText deletedContent)) | testView] | timed = [plain ("timed message deleted: " <> T.unpack (ciContentToText deletedContent)) | testView]
| byUser = [plain $ "message " <> T.unpack (fromMaybe "deleted" deletedText_)] -- deletedText_ Nothing should be impossible here | byUser = [plain $ "message " <> T.unpack (fromMaybe "deleted" deletedText_)] -- deletedText_ Nothing should be impossible here
| otherwise = case chat of | otherwise = case chat of
DirectChat c -> case (chatDir, deletedContent) of DirectChat c -> case (chatDir, deletedContent) of
(CIDirectRcv, CIRcvMsgContent mc) -> viewReceivedMessage (ttyFromContactDeleted c deletedText_) [] mc ts meta (CIDirectRcv, CIRcvMsgContent mc) -> viewReceivedMessage (ttyFromContactDeleted c deletedText_) [] mc ts tz meta
_ -> prohibited _ -> prohibited
GroupChat g -> case ciMsgContent deletedContent of GroupChat g -> case ciMsgContent deletedContent of
Just mc -> Just mc ->
let m = chatItemMember g ci let m = chatItemMember g ci
in viewReceivedMessage (ttyFromGroupDeleted g m deletedText_) [] mc ts meta in viewReceivedMessage (ttyFromGroupDeleted g m deletedText_) [] mc ts tz meta
_ -> prohibited _ -> prohibited
_ -> prohibited _ -> prohibited
where where
@ -534,7 +534,7 @@ viewItemReaction showReactions chat CIReaction {chatDir, chatItem = CChatItem md
(_, CIGroupSnd) -> [sentText] (_, CIGroupSnd) -> [sentText]
where where
view from msg view from msg
| showReactions = viewReceivedReaction from msg reactionText ts $ utcToZonedTime tz sentAt | showReactions = viewReceivedReaction from msg reactionText ts tz sentAt
| otherwise = [] | otherwise = []
reactionText = plain $ (if added then "+ " else "- ") <> [emoji] reactionText = plain $ (if added then "+ " else "- ") <> [emoji]
emoji = case reaction of emoji = case reaction of
@ -577,11 +577,11 @@ msgPreview = msgPlain . preview . msgContentText
| T.length t <= 120 = t | T.length t <= 120 = t
| otherwise = T.take 120 t <> "..." | otherwise = T.take 120 t <> "..."
viewRcvIntegrityError :: StyledString -> MsgErrorType -> CurrentTime -> CIMeta c 'MDRcv -> [StyledString] viewRcvIntegrityError :: StyledString -> MsgErrorType -> CurrentTime -> TimeZone -> CIMeta c 'MDRcv -> [StyledString]
viewRcvIntegrityError from msgErr ts meta = receivedWithTime_ ts from [] meta (viewMsgIntegrityError msgErr) False viewRcvIntegrityError from msgErr ts tz meta = receivedWithTime_ ts tz from [] meta (viewMsgIntegrityError msgErr) False
viewRcvDecryptionError :: StyledString -> MsgDecryptError -> Word32 -> CurrentTime -> CIMeta c 'MDRcv -> [StyledString] viewRcvDecryptionError :: StyledString -> MsgDecryptError -> Word32 -> CurrentTime -> TimeZone -> CIMeta c 'MDRcv -> [StyledString]
viewRcvDecryptionError from err n ts meta = receivedWithTime_ ts from [] meta [ttyError $ msgDecryptErrorText err n] False viewRcvDecryptionError from err n ts tz meta = receivedWithTime_ ts tz from [] meta [ttyError $ msgDecryptErrorText err n] False
viewMsgIntegrityError :: MsgErrorType -> [StyledString] viewMsgIntegrityError :: MsgErrorType -> [StyledString]
viewMsgIntegrityError err = [ttyError $ msgIntegrityError err] viewMsgIntegrityError err = [ttyError $ msgIntegrityError err]
@ -1079,22 +1079,22 @@ viewContactUpdated
where where
fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName' fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName'
viewReceivedMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta c d -> [StyledString] viewReceivedMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
viewReceivedMessage = viewReceivedMessage_ False viewReceivedMessage = viewReceivedMessage_ False
viewReceivedUpdatedMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta c d -> [StyledString] viewReceivedUpdatedMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
viewReceivedUpdatedMessage = viewReceivedMessage_ True viewReceivedUpdatedMessage = viewReceivedMessage_ True
viewReceivedMessage_ :: Bool -> StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta c d -> [StyledString] viewReceivedMessage_ :: Bool -> StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
viewReceivedMessage_ updated from quote mc ts meta = receivedWithTime_ ts from quote meta (ttyMsgContent mc) updated viewReceivedMessage_ updated from quote mc ts tz meta = receivedWithTime_ ts tz from quote meta (ttyMsgContent mc) updated
viewReceivedReaction :: StyledString -> [StyledString] -> StyledString -> CurrentTime -> ZonedTime -> [StyledString] viewReceivedReaction :: StyledString -> [StyledString] -> StyledString -> CurrentTime -> TimeZone -> UTCTime -> [StyledString]
viewReceivedReaction from styledMsg reactionText ts reactionTs = viewReceivedReaction from styledMsg reactionText ts tz reactionTs =
prependFirst (ttyMsgTime ts reactionTs <> " " <> from) (styledMsg <> [" " <> reactionText]) prependFirst (ttyMsgTime ts tz reactionTs <> " " <> from) (styledMsg <> [" " <> reactionText])
receivedWithTime_ :: CurrentTime -> StyledString -> [StyledString] -> CIMeta c d -> [StyledString] -> Bool -> [StyledString] receivedWithTime_ :: CurrentTime -> TimeZone -> StyledString -> [StyledString] -> CIMeta c d -> [StyledString] -> Bool -> [StyledString]
receivedWithTime_ ts from quote CIMeta {localItemTs, itemId, itemEdited, itemDeleted, itemLive} styledMsg updated = do receivedWithTime_ ts tz from quote CIMeta {itemId, itemTs, itemEdited, itemDeleted, itemLive} styledMsg updated = do
prependFirst (ttyMsgTime ts localItemTs <> " " <> from) (quote <> prependFirst (indent <> live) styledMsg) prependFirst (ttyMsgTime ts tz itemTs <> " " <> from) (quote <> prependFirst (indent <> live) styledMsg)
where where
indent = if null quote then "" else " " indent = if null quote then "" else " "
live live
@ -1106,19 +1106,19 @@ receivedWithTime_ ts from quote CIMeta {localItemTs, itemId, itemEdited, itemDel
Just False -> ttyFrom "[LIVE ended] " Just False -> ttyFrom "[LIVE ended] "
_ -> "" _ -> ""
ttyMsgTime :: CurrentTime -> ZonedTime -> StyledString ttyMsgTime :: CurrentTime -> TimeZone -> UTCTime -> StyledString
ttyMsgTime ts t = ttyMsgTime currentTime tz time =
let localTime = zonedTimeToLocalTime t let localTime = utcToLocalTime tz time
tz = zonedTimeZone t localCurrentTime = utcToLocalTime tz currentTime
fmt = fmt =
if (localDay localTime < localDay (zonedTimeToLocalTime $ utcToZonedTime tz ts)) if (localDay localTime < localDay localCurrentTime)
&& (timeOfDayToTime (localTimeOfDay localTime) > (6 * 60 * 60 :: DiffTime)) && (timeOfDayToTime (localTimeOfDay localTime) > (6 * 60 * 60 :: DiffTime))
then "%m-%d" -- if message is from yesterday or before and 6 hours has passed since midnight then "%m-%d" -- if message is from yesterday or before and 6 hours has passed since midnight
else "%H:%M" else "%H:%M"
in styleTime $ formatTime defaultTimeLocale fmt localTime in styleTime $ formatTime defaultTimeLocale fmt localTime
viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta c d -> [StyledString] viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
viewSentMessage to quote mc ts meta@CIMeta {itemEdited, itemDeleted, itemLive} = sentWithTime_ ts (prependFirst to $ quote <> prependFirst (indent <> live) (ttyMsgContent mc)) meta viewSentMessage to quote mc ts tz meta@CIMeta {itemEdited, itemDeleted, itemLive} = sentWithTime_ ts tz (prependFirst to $ quote <> prependFirst (indent <> live) (ttyMsgContent mc)) meta
where where
indent = if null quote then "" else " " indent = if null quote then "" else " "
live live
@ -1128,12 +1128,12 @@ viewSentMessage to quote mc ts meta@CIMeta {itemEdited, itemDeleted, itemLive} =
Just False -> ttyTo "[LIVE] " Just False -> ttyTo "[LIVE] "
_ -> "" _ -> ""
viewSentBroadcast :: MsgContent -> Int -> CurrentTime -> ZonedTime -> [StyledString] viewSentBroadcast :: MsgContent -> Int -> CurrentTime -> TimeZone -> UTCTime -> [StyledString]
viewSentBroadcast mc n ts t = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts t <> " ") (ttyMsgContent mc) viewSentBroadcast mc n ts tz time = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts tz time <> " ") (ttyMsgContent mc)
viewSentFileInvitation :: StyledString -> CIFile d -> CurrentTime -> CIMeta c d -> [StyledString] viewSentFileInvitation :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts = case filePath of viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts tz = case filePath of
Just fPath -> sentWithTime_ ts $ ttySentFile fPath Just fPath -> sentWithTime_ ts tz $ ttySentFile fPath
_ -> const [] _ -> const []
where where
ttySentFile fPath = ["/f " <> to <> ttyFilePath fPath] <> cancelSending ttySentFile fPath = ["/f " <> to <> ttyFilePath fPath] <> cancelSending
@ -1141,9 +1141,9 @@ viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts = case filePa
CIFSSndTransfer _ _ -> [] CIFSSndTransfer _ _ -> []
_ -> ["use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"] _ -> ["use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"]
sentWithTime_ :: CurrentTime -> [StyledString] -> CIMeta c d -> [StyledString] sentWithTime_ :: CurrentTime -> TimeZone -> [StyledString] -> CIMeta c d -> [StyledString]
sentWithTime_ ts styledMsg CIMeta {localItemTs} = sentWithTime_ ts tz styledMsg CIMeta {itemTs} =
prependFirst (ttyMsgTime ts localItemTs <> " ") styledMsg prependFirst (ttyMsgTime ts tz itemTs <> " ") styledMsg
ttyMsgContent :: MsgContent -> [StyledString] ttyMsgContent :: MsgContent -> [StyledString]
ttyMsgContent = msgPlain . msgContentText ttyMsgContent = msgPlain . msgContentText
@ -1179,8 +1179,8 @@ uploadingFile status _ = [status <> " uploading file"] -- shouldn't happen
sndFile :: SndFileTransfer -> StyledString sndFile :: SndFileTransfer -> StyledString
sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName
viewReceivedFileInvitation :: StyledString -> CIFile d -> CurrentTime -> CIMeta c d -> [StyledString] viewReceivedFileInvitation :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
viewReceivedFileInvitation from file ts meta = receivedWithTime_ ts from [] meta (receivedFileInvitation_ file) False viewReceivedFileInvitation from file ts tz meta = receivedWithTime_ ts tz from [] meta (receivedFileInvitation_ file) False
receivedFileInvitation_ :: CIFile d -> [StyledString] receivedFileInvitation_ :: CIFile d -> [StyledString]
receivedFileInvitation_ CIFile {fileId, fileName, fileSize, fileStatus} = receivedFileInvitation_ CIFile {fileId, fileName, fileSize, fileStatus} =