diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index b8af2d6cbd..894d142925 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -31,12 +31,11 @@ import Data.Int (Int64) import Data.List (find) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Maybe (fromJust, isJust, mapMaybe) +import Data.Maybe (isJust, mapMaybe) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock (UTCTime, getCurrentTime) -import Data.Time.LocalTime (utcToLocalZonedTime) import Data.Word (Word32) import Simplex.Chat.Controller import Simplex.Chat.Messages @@ -287,7 +286,9 @@ processChatCommand user@User {userId, profile} = \case setActive $ ActiveG gName -- this is a hack as we have multiple direct messages instead of one per group let ciContent = CISndFileInvitation fileId f - ciMeta@CIMetaProps {itemId} <- saveChatItem userId (CDSndGroup gInfo) Nothing ciContent + createdAt <- liftIO getCurrentTime + let ci = mkNewChatItem ciContent 0 createdAt createdAt + ciMeta@CIMetaProps {itemId} <- saveChatItem userId (CDSndGroup gInfo) ci withStore $ \st -> updateFileTransferChatItemId st fileId itemId pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) $ SndGroupChatItem (CISndMeta ciMeta) ciContent ReceiveFile fileId filePath_ -> do @@ -1161,54 +1162,44 @@ saveRcvMSG Connection {connId} agentMsgMeta msgBody = do sendDirectChatItem :: ChatMonad m => UserId -> Contact -> ChatMsgEvent -> CIContent 'MDSnd -> m (ChatItem 'CTDirect 'MDSnd) sendDirectChatItem userId contact@Contact {activeConn} chatMsgEvent ciContent = do msgId <- sendDirectMessage activeConn chatMsgEvent - ciMeta <- saveChatItem userId (CDDirect contact) (Just msgId) ciContent + createdAt <- liftIO getCurrentTime + ciMeta <- saveChatItem userId (CDDirect contact) $ mkNewChatItem ciContent msgId createdAt createdAt pure $ DirectChatItem (CISndMeta ciMeta) ciContent sendGroupChatItem :: ChatMonad m => UserId -> Group -> ChatMsgEvent -> CIContent 'MDSnd -> m (ChatItem 'CTGroup 'MDSnd) sendGroupChatItem userId (Group g ms) chatMsgEvent ciContent = do msgId <- sendGroupMessage ms chatMsgEvent - ciMeta <- saveChatItem userId (CDSndGroup g) (Just msgId) ciContent + createdAt <- liftIO getCurrentTime + ciMeta <- saveChatItem userId (CDSndGroup g) $ mkNewChatItem ciContent msgId createdAt createdAt pure $ SndGroupChatItem (CISndMeta ciMeta) ciContent saveRcvDirectChatItem :: ChatMonad m => UserId -> Contact -> MessageId -> MsgMeta -> CIContent 'MDRcv -> m (ChatItem 'CTDirect 'MDRcv) -saveRcvDirectChatItem userId ct msgId MsgMeta {integrity} ciContent = do - ciMeta <- saveChatItem userId (CDDirect ct) (Just msgId) ciContent - pure $ DirectChatItem (CIRcvMeta ciMeta integrity) ciContent +saveRcvDirectChatItem userId ct msgId MsgMeta {broker = (_, brokerTs)} ciContent = do + createdAt <- liftIO getCurrentTime + ciMeta <- saveChatItem userId (CDDirect ct) $ mkNewChatItem ciContent msgId brokerTs createdAt + pure $ DirectChatItem (CIRcvMeta ciMeta) ciContent saveRcvGroupChatItem :: ChatMonad m => UserId -> GroupInfo -> GroupMember -> MessageId -> MsgMeta -> CIContent 'MDRcv -> m (ChatItem 'CTGroup 'MDRcv) -saveRcvGroupChatItem userId g m msgId MsgMeta {integrity} ciContent = do - ciMeta <- saveChatItem userId (CDRcvGroup g m) (Just msgId) ciContent - pure $ RcvGroupChatItem m (CIRcvMeta ciMeta integrity) ciContent +saveRcvGroupChatItem userId g m msgId MsgMeta {broker = (_, brokerTs)} ciContent = do + createdAt <- liftIO getCurrentTime + ciMeta <- saveChatItem userId (CDRcvGroup g m) $ mkNewChatItem ciContent msgId brokerTs createdAt + pure $ RcvGroupChatItem m (CIRcvMeta ciMeta) ciContent -saveChatItem :: ChatMonad m => UserId -> ChatDirection c d -> Maybe MessageId -> CIContent d -> m CIMetaProps -saveChatItem userId chatDirection msgId_ ciContent = do - ci@NewChatItem {itemTs, createdAt} <- mkNewChatItem msgId_ MDRcv Nothing ciContent - ciId <- withStore $ \st -> createNewChatItem st userId chatDirection ci - liftIO $ mkCIMetaProps ciId itemTs createdAt +saveChatItem :: (MsgDirectionI d, ChatMonad m) => UserId -> ChatDirection c d -> NewChatItem d -> m CIMetaProps +saveChatItem userId cd ci@NewChatItem {itemTs, itemText, createdAt} = do + ciId <- withStore $ \st -> createNewChatItem st userId cd ci + liftIO $ mkCIMetaProps ciId itemTs itemText createdAt -mkNewChatItem :: ChatMonad m => Maybe MessageId -> MsgDirection -> Maybe UTCTime -> CIContent d -> m (NewChatItem d) -mkNewChatItem createdByMsgId_ itemSent brokerTs_ itemContent = do - (itemTs, createdAt) <- timestamps - pure - NewChatItem - { createdByMsgId_, - itemSent, - itemTs, - itemContent, - itemText = ciContentToText itemContent, - createdAt - } - where - timestamps = do - createdAt <- liftIO getCurrentTime - if isJust brokerTs_ - then pure (fromJust brokerTs_, createdAt) -- if rcv use brokerTs - else pure (createdAt, createdAt) -- if snd use createdAt - -mkCIMetaProps :: ChatItemId -> ChatItemTs -> UTCTime -> IO CIMetaProps -mkCIMetaProps itemId itemTs createdAt = do - localItemTs <- utcToLocalZonedTime itemTs - pure CIMetaProps {itemId, itemTs, localItemTs, createdAt} +mkNewChatItem :: forall d. MsgDirectionI d => CIContent d -> MessageId -> UTCTime -> UTCTime -> NewChatItem d +mkNewChatItem itemContent msgId itemTs createdAt = + NewChatItem + { createdByMsgId = if msgId == 0 then Nothing else Just msgId, + itemSent = msgDirection @d, + itemTs, + itemContent, + itemText = ciContentToText itemContent, + createdAt + } allowAgentConnection :: ChatMonad m => Connection -> ConfirmationId -> ChatMsgEvent -> m () allowAgentConnection conn confId msg = do diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 349d231b72..4d5c4d9344 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -20,9 +20,9 @@ import qualified Data.ByteString.Lazy.Char8 as LB import Data.Int (Int64) import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (decodeLatin1) +import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Time.Clock (UTCTime) -import Data.Time.LocalTime (ZonedTime) +import Data.Time.LocalTime (ZonedTime, utcToLocalZonedTime) import Data.Type.Equality import Data.Typeable (Typeable) import Database.SQLite.Simple.FromField (FromField (..)) @@ -31,7 +31,7 @@ import GHC.Generics (Generic) import Simplex.Chat.Protocol import Simplex.Chat.Types import Simplex.Chat.Util (enumJSON, singleFieldJSON) -import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgIntegrity, MsgMeta (..)) +import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..)) import Simplex.Messaging.Agent.Store.SQLite (fromTextField_) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix) @@ -79,7 +79,7 @@ data JSONChatItem d | JCItemRcvGroup {dir :: MsgDirection, member :: GroupMember, meta :: CIMeta d, content :: CIContent d} deriving (Generic) -instance ToJSON (JSONChatItem d) where +instance MsgDirectionI d => ToJSON (JSONChatItem d) where toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "JCItem" toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "JCItem" @@ -102,9 +102,9 @@ deriving instance Show (CChatItem c) chatItemId :: ChatItem c d -> ChatItemId chatItemId = \case DirectChatItem (CISndMeta CIMetaProps {itemId}) _ -> itemId - DirectChatItem (CIRcvMeta CIMetaProps {itemId} _) _ -> itemId + DirectChatItem (CIRcvMeta CIMetaProps {itemId}) _ -> itemId SndGroupChatItem (CISndMeta CIMetaProps {itemId}) _ -> itemId - RcvGroupChatItem _ (CIRcvMeta CIMetaProps {itemId} _) _ -> itemId + RcvGroupChatItem _ (CIRcvMeta CIMetaProps {itemId}) _ -> itemId data ChatDirection (c :: ChatType) (d :: MsgDirection) where CDDirect :: Contact -> ChatDirection 'CTDirect d @@ -112,8 +112,8 @@ data ChatDirection (c :: ChatType) (d :: MsgDirection) where CDRcvGroup :: GroupInfo -> GroupMember -> ChatDirection 'CTGroup 'MDRcv data NewChatItem d = NewChatItem - { createdByMsgId_ :: Maybe MessageId, - itemSent :: MsgDirection, + { createdByMsgId :: Maybe MessageId, + itemSent :: SMsgDirection d, itemTs :: ChatItemTs, itemContent :: CIContent d, itemText :: Text, @@ -148,7 +148,7 @@ instance MsgDirectionI d => ToJSON (JSONAnyChatItem c d) where data CIMeta (d :: MsgDirection) where CISndMeta :: CIMetaProps -> CIMeta 'MDSnd - CIRcvMeta :: CIMetaProps -> MsgIntegrity -> CIMeta 'MDRcv + CIRcvMeta :: CIMetaProps -> CIMeta 'MDRcv deriving instance Show (CIMeta d) @@ -158,7 +158,7 @@ instance ToJSON (CIMeta d) where data JSONCIMeta = JCIMetaSnd {meta :: CIMetaProps} - | JCIMetaRcv {meta :: CIMetaProps, integrity :: MsgIntegrity} + | JCIMetaRcv {meta :: CIMetaProps} deriving (Generic) instance ToJSON JSONCIMeta where @@ -168,16 +168,22 @@ instance ToJSON JSONCIMeta where jsonCIMeta :: CIMeta d -> JSONCIMeta jsonCIMeta = \case CISndMeta meta -> JCIMetaSnd meta - CIRcvMeta meta integrity -> JCIMetaRcv meta integrity + CIRcvMeta meta -> JCIMetaRcv meta data CIMetaProps = CIMetaProps { itemId :: ChatItemId, itemTs :: ChatItemTs, + itemText :: Text, localItemTs :: ZonedTime, createdAt :: UTCTime } deriving (Show, Generic, FromJSON) +mkCIMetaProps :: ChatItemId -> ChatItemTs -> Text -> UTCTime -> IO CIMetaProps +mkCIMetaProps itemId itemTs itemText createdAt = do + localItemTs <- utcToLocalZonedTime itemTs + pure CIMetaProps {itemId, itemTs, itemText, localItemTs, createdAt} + instance ToJSON CIMetaProps where toEncoding = J.genericToEncoding J.defaultOptions type ChatItemId = Int64 @@ -191,34 +197,55 @@ data CIContent (d :: MsgDirection) where deriving instance Show (CIContent d) -instance ToField (CIContent d) where toField = toField . decodeLatin1 . LB.toStrict . J.encode - -instance ToJSON (CIContent d) where - toJSON = J.toJSON . jsonCIContent - toEncoding = J.toEncoding . jsonCIContent - -data JSONCIContent - = JCIMsgContent {msgContent :: MsgContent} - | JCISndFileInvitation {fileId :: FileTransferId, filePath :: FilePath} - | JCIRcvFileInvitation {rcvFileTransfer :: RcvFileTransfer} - deriving (Generic) - -instance ToJSON JSONCIContent where - toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "JCI" - toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "JCI" - -jsonCIContent :: CIContent d -> JSONCIContent -jsonCIContent = \case - CIMsgContent mc -> JCIMsgContent mc - CISndFileInvitation fId fPath -> JCISndFileInvitation fId fPath - CIRcvFileInvitation ft -> JCIRcvFileInvitation ft - ciContentToText :: CIContent d -> Text ciContentToText = \case CIMsgContent mc -> msgContentText mc CISndFileInvitation fId fPath -> "you sent file #" <> T.pack (show fId) <> ": " <> T.pack fPath CIRcvFileInvitation RcvFileTransfer {fileInvitation = FileInvitation {fileName}} -> "file " <> T.pack fileName +instance MsgDirectionI d => ToField (CIContent d) where + toField = toField . decodeLatin1 . LB.toStrict . J.encode + +instance MsgDirectionI d => ToJSON (CIContent d) where + toJSON = J.toJSON . jsonCIContent + toEncoding = J.toEncoding . jsonCIContent + +data ACIContent = forall d. ACIContent (SMsgDirection d) (CIContent d) + +instance FromJSON ACIContent where + parseJSON = fmap aciContentJSON . J.parseJSON + +instance FromField ACIContent where fromField = fromTextField_ $ J.decode . LB.fromStrict . encodeUtf8 + +data JSONCIContent + = JCIMsgContent {msgDir :: MsgDirection, msgContent :: MsgContent} + | JCISndFileInvitation {fileId :: FileTransferId, filePath :: FilePath} + | JCIRcvFileInvitation {rcvFileTransfer :: RcvFileTransfer} + deriving (Generic) + +instance FromJSON JSONCIContent where + parseJSON = J.genericParseJSON . singleFieldJSON $ dropPrefix "JCI" + +instance ToJSON JSONCIContent where + toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "JCI" + toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "JCI" + +jsonCIContent :: forall d. MsgDirectionI d => CIContent d -> JSONCIContent +jsonCIContent = \case + CIMsgContent mc -> JCIMsgContent md mc + CISndFileInvitation fId fPath -> JCISndFileInvitation fId fPath + CIRcvFileInvitation ft -> JCIRcvFileInvitation ft + where + md = toMsgDirection $ msgDirection @d + +aciContentJSON :: JSONCIContent -> ACIContent +aciContentJSON = \case + JCIMsgContent md mc -> case md of + MDSnd -> ACIContent SMDSnd $ CIMsgContent mc + MDRcv -> ACIContent SMDRcv $ CIMsgContent mc + JCISndFileInvitation fId fPath -> ACIContent SMDSnd $ CISndFileInvitation fId fPath + JCIRcvFileInvitation ft -> ACIContent SMDRcv $ CIRcvFileInvitation ft + data SChatType (c :: ChatType) where SCTDirect :: SChatType 'CTDirect SCTGroup :: SChatType 'CTGroup @@ -263,6 +290,8 @@ instance ToJSON MsgDirection where toJSON = J.genericToJSON . enumJSON $ dropPrefix "MD" toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MD" +instance ToField MsgDirection where toField = toField . msgDirectionInt + data SMsgDirection (d :: MsgDirection) where SMDRcv :: SMsgDirection 'MDRcv SMDSnd :: SMsgDirection 'MDSnd @@ -274,6 +303,13 @@ instance TestEquality SMsgDirection where testEquality SMDSnd SMDSnd = Just Refl testEquality _ _ = Nothing +instance ToField (SMsgDirection d) where toField = toField . msgDirectionInt . toMsgDirection + +toMsgDirection :: SMsgDirection d -> MsgDirection +toMsgDirection = \case + SMDRcv -> MDRcv + SMDSnd -> MDSnd + class MsgDirectionI (d :: MsgDirection) where msgDirection :: SMsgDirection d @@ -281,19 +317,12 @@ instance MsgDirectionI 'MDRcv where msgDirection = SMDRcv instance MsgDirectionI 'MDSnd where msgDirection = SMDSnd -toMsgDirection :: SMsgDirection d -> MsgDirection -toMsgDirection = \case - SMDRcv -> MDRcv - SMDSnd -> MDSnd - -instance ToField MsgDirection where toField = toField . msgDirectionInt - msgDirectionInt :: MsgDirection -> Int msgDirectionInt = \case MDRcv -> 0 MDSnd -> 1 -msgDirectionIntP :: Int -> Maybe MsgDirection +msgDirectionIntP :: Int64 -> Maybe MsgDirection msgDirectionIntP = \case 0 -> Just MDRcv 1 -> Just MDSnd @@ -322,6 +351,8 @@ data MsgMetaJSON = MsgMetaJSON instance ToJSON MsgMetaJSON where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} +-- instance FromJson MsgMetaJSON where fromEncoding = J.genericFromEncoding JSONKeyOptions + msgMetaToJson :: MsgMeta -> MsgMetaJSON msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId, serverTs), sndMsgId = sndId} = MsgMetaJSON diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 6711a41dd4..29823e02c0 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -105,6 +105,7 @@ module Simplex.Chat.Store deletePendingGroupMessage, createNewChatItem, getChatPreviews, + getDirectChat, ) where @@ -124,7 +125,7 @@ import Data.Function (on) import Data.Functor (($>)) import Data.Int (Int64) import Data.List (find, sortBy) -import Data.Maybe (fromJust, isJust, listToMaybe) +import Data.Maybe (listToMaybe) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (UTCTime, getCurrentTime) @@ -1809,8 +1810,8 @@ deletePendingGroupMessage st groupMemberId messageId = liftIO . withTransaction st $ \db -> DB.execute db "DELETE FROM pending_group_messages WHERE group_member_id = ? AND message_id = ?" (groupMemberId, messageId) -createNewChatItem :: MonadUnliftIO m => SQLiteStore -> UserId -> ChatDirection c d -> NewChatItem d -> m ChatItemId -createNewChatItem st userId chatDirection NewChatItem {createdByMsgId_, itemSent, itemTs, itemContent, itemText, createdAt} = +createNewChatItem :: (MsgDirectionI d, MonadUnliftIO m) => SQLiteStore -> UserId -> ChatDirection c d -> NewChatItem d -> m ChatItemId +createNewChatItem st userId chatDirection NewChatItem {createdByMsgId, itemSent, itemTs, itemContent, itemText, createdAt} = liftIO . withTransaction st $ \db -> do let (contactId_, groupId_, groupMemberId_) = ids DB.execute @@ -1822,11 +1823,13 @@ createNewChatItem st userId chatDirection NewChatItem {createdByMsgId_, itemSent ) VALUES (?,?,?,?,?,?,?,?,?,?,?) |] ( (userId, contactId_, groupId_, groupMemberId_) - :. (createdByMsgId_, itemSent, itemTs, itemContent, itemText, createdAt, createdAt) + :. (createdByMsgId, itemSent, itemTs, itemContent, itemText, createdAt, createdAt) ) ciId <- insertedRowId db - when (isJust createdByMsgId_) $ - DB.execute db "INSERT INTO chat_item_messages (chat_item_id, message_id) VALUES (?,?)" (ciId, fromJust createdByMsgId_) + case createdByMsgId of + Nothing -> pure () + Just msgId -> + DB.execute db "INSERT INTO chat_item_messages (chat_item_id, message_id) VALUES (?,?)" (ciId, msgId) pure ciId where ids :: (Maybe Int64, Maybe Int64, Maybe Int64) @@ -1898,15 +1901,63 @@ getGroupChatPreviews_ db User {userId, userContactId} = groupInfo = GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName}, membership} in AChatPreview SCTGroup (GroupChat groupInfo) Nothing --- getDirectChatItemList :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> m ChatItemList --- getDirectChatItemList st userId contactId = --- liftIO . withTransaction st $ \db -> --- DB.query --- db --- [sql| --- ... --- |] --- (userId, contactId) +getDirectChat :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Chat 'CTDirect) +getDirectChat st user contactId = + liftIOEither . withTransaction st $ \db -> runExceptT $ do + contact <- getContact_' db user contactId + chatItems <- liftIO $ getDirectChatItems_ db user contactId + pure $ Chat (DirectChat contact) chatItems + +getContact_' :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Contact +getContact_' db User {userId} contactId = + ExceptT $ + toContact + <$> DB.query + db + [sql| + SELECT + -- Contact + ct.contact_id, ct.local_display_name, ct.via_group, + -- Contact {profile} + cp.display_name, cp.full_name, + -- Contact {activeConn} + c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.conn_status, c.conn_type, + c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at + FROM contacts ct + JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id + JOIN connections c ON c.contact_id = ct.contact_id + WHERE ct.user_id = ? AND ct.contact_id = ? + |] + (userId, contactId) + where + toContact :: [ContactRow] -> Either StoreError Contact + toContact (contactRow : _) = Right $ toContact' contactRow + toContact _ = Left $ SEContactNotFoundById contactId + +getDirectChatItems_ :: DB.Connection -> User -> Int64 -> IO [CChatItem 'CTDirect] +getDirectChatItems_ db User {userId} contactId = do + chatItems_ <- + liftIO $ + DB.query + db + [sql| + SELECT + -- CChatItem + ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at + FROM chat_items ci + LEFT JOIN messages m ON m.message_id == ci.created_by_msg_id + LEFT JOIN msg_deliveries md ON md.message_id = m.message_id + WHERE ci.user_id = ? AND ci.contact_id = ? + |] + (userId, contactId) + liftIO $ mapM toDirectChatItem chatItems_ + where + toDirectChatItem :: (Int64, ChatItemTs, ACIContent, Text, UTCTime) -> IO (CChatItem 'CTDirect) + toDirectChatItem (itemId, itemTs, itemContent, itemText, createdAt) = do + ciMeta <- liftIO $ mkCIMetaProps itemId itemTs itemText createdAt + pure $ case itemContent of + ACIContent SMDRcv ciContent -> CChatItem SMDRcv (DirectChatItem (CIRcvMeta ciMeta) ciContent) + ACIContent SMDSnd ciContent -> CChatItem SMDSnd (DirectChatItem (CISndMeta ciMeta) ciContent) -- getGroupChatItemList :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> m ChatItemList -- getGroupChatItemList st userId groupId = @@ -1985,6 +2036,7 @@ randomBytes gVar n = B64.encode <$> (atomically . stateTVar gVar $ randomBytesGe data StoreError = SEDuplicateName + | SEContactNotFoundById Int64 | SEContactNotFound {contactName :: ContactName} | SEContactNotReady {contactName :: ContactName} | SEDuplicateContactLink diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 507a51f803..6d027ed45b 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -121,9 +121,9 @@ viewChatItem chat item = case (chat, item) of CISndMeta meta -> case content of CIMsgContent mc -> viewSentMessage to mc meta CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta - CIRcvMeta meta mOk -> case content of - CIMsgContent mc -> viewReceivedMessage from meta mc mOk - CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft mOk + CIRcvMeta meta -> case content of + CIMsgContent mc -> viewReceivedMessage from meta mc -- mOk + CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft -- mOk where to = ttyToContact' c from = ttyFromContact' c @@ -132,9 +132,9 @@ viewChatItem chat item = case (chat, item) of CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta where to = ttyToGroup g - (GroupChat g, RcvGroupChatItem c (CIRcvMeta meta mOk) content) -> case content of - CIMsgContent mc -> viewReceivedMessage from meta mc mOk - CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft mOk + (GroupChat g, RcvGroupChatItem c (CIRcvMeta meta) content) -> case content of + CIMsgContent mc -> viewReceivedMessage from meta mc -- mOk + CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft -- mOk where from = ttyFromGroup' g c where @@ -289,12 +289,12 @@ viewContactUpdated where fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName' -viewReceivedMessage :: StyledString -> CIMetaProps -> MsgContent -> MsgIntegrity -> [StyledString] +viewReceivedMessage :: StyledString -> CIMetaProps -> MsgContent -> [StyledString] viewReceivedMessage from meta mc = receivedWithTime_ from meta (ttyMsgContent mc) -receivedWithTime_ :: StyledString -> CIMetaProps -> [StyledString] -> MsgIntegrity -> [StyledString] -receivedWithTime_ from CIMetaProps {localItemTs, createdAt} styledMsg mOk = do - prependFirst (formattedTime <> " " <> from) styledMsg ++ showIntegrity mOk +receivedWithTime_ :: StyledString -> CIMetaProps -> [StyledString] -> [StyledString] +receivedWithTime_ from CIMetaProps {localItemTs, createdAt} styledMsg = do + prependFirst (formattedTime <> " " <> from) styledMsg -- ++ showIntegrity mOk where formattedTime :: StyledString formattedTime = @@ -363,7 +363,7 @@ sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} = sndFile :: SndFileTransfer -> StyledString sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName -viewReceivedFileInvitation :: StyledString -> CIMetaProps -> RcvFileTransfer -> MsgIntegrity -> [StyledString] +viewReceivedFileInvitation :: StyledString -> CIMetaProps -> RcvFileTransfer -> [StyledString] viewReceivedFileInvitation from meta ft = receivedWithTime_ from meta (receivedFileInvitation_ ft) receivedFileInvitation_ :: RcvFileTransfer -> [StyledString]