chat item status, CRChatItemUpdated api response (#269)

cabal.project

@@ -3,7 +3,7 @@ packages: .
 source-repository-package
     type: git
     location: git://github.com/simplex-chat/simplexmq.git
-    tag: 137ff7043d49feb3b350f56783c9b64a62bc636a
+    tag: c9994c3a2ca945b9b67e250163cf8d560d2ed554
 
 source-repository-package
     type: git

sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "git://github.com/simplex-chat/simplexmq.git"."137ff7043d49feb3b350f56783c9b64a62bc636a" = "1jlxpmg40qkvisbf03082yrw6k2ah9dsw8pn1jqc0cyz5250qc49";
+  "git://github.com/simplex-chat/simplexmq.git"."c9994c3a2ca945b9b67e250163cf8d560d2ed554" = "0lc4jb46ys0hllv5p3i3x2rw8j4s8xxmz66kp893a23ki68ljyhp";
   "git://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";
   "git://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj";
   "git://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97";

simplex-chat.cabal

@@ -26,6 +26,7 @@ library
       Simplex.Chat.Messages
       Simplex.Chat.Migrations.M20220101_initial
       Simplex.Chat.Migrations.M20220122_v1_1
+      Simplex.Chat.Migrations.M20220205_chat_item_status
       Simplex.Chat.Mobile
       Simplex.Chat.Options
       Simplex.Chat.Protocol

src/Simplex/Chat.hs

@@ -51,7 +51,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Protocol (MsgBody)
+import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Util (tryError)
 import System.Exit (exitFailure, exitSuccess)
@@ -73,9 +73,11 @@ defaultChatConfig =
           { tcpPort = undefined, -- agent does not listen to TCP
             smpServers = undefined, -- filled in from options
             dbFile = undefined, -- filled in from options
-            dbPoolSize = 1
+            dbPoolSize = 1,
+            yesToMigrations = False
           },
       dbPoolSize = 1,
+      yesToMigrations = False,
       tbqSize = 16,
       fileChunkSize = 15780
     }
@@ -218,7 +220,7 @@ processChatCommand = \case
         deleteConnection a (aConnId conn) `catchError` \(_ :: AgentErrorType) -> pure ()
       withStore $ \st -> deleteUserContactLink st userId
       pure CRUserContactLinkDeleted
-  ShowMyAddress -> CRUserContactLink <$> (withUser $ \User {userId} -> withStore (`getUserContactLink` userId))
+  ShowMyAddress -> CRUserContactLink <$> withUser (\User {userId} -> withStore (`getUserContactLink` userId))
   AcceptContact cName -> withUser $ \User {userId} -> do
     connReqId <- withStore $ \st -> getContactRequestIdByName st userId cName
     processChatCommand $ APIAcceptContact connReqId
@@ -298,7 +300,7 @@ processChatCommand = \case
       mapM_ deleteMemberConnection members
       withStore $ \st -> deleteGroup st user g
       pure $ CRGroupDeletedUser gInfo
-  ListMembers gName -> CRGroupMembers <$> (withUser $ \user -> withStore (\st -> getGroupByName st user gName))
+  ListMembers gName -> CRGroupMembers <$> withUser (\user -> withStore (\st -> getGroupByName st user gName))
   ListGroups -> CRGroupsList <$> withUser (\user -> withStore (`getUserGroupDetails` user))
   SendGroupMessage gName msg -> withUser $ \user -> do
     groupId <- withStore $ \st -> getGroupIdByName st user gName
@@ -312,7 +314,7 @@ processChatCommand = \case
     SndFileTransfer {fileId} <- withStore $ \st ->
       createSndFileTransfer st userId contact f fileInv agentConnId chSize
     ci <- sendDirectChatItem userId contact (XFile fileInv) (CISndFileInvitation fileId f)
-    withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId ci
+    withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci
     setActive $ ActiveC cName
     pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci
   SendGroupFile gName f -> withUser $ \user@User {userId} -> withChatLock $ do
@@ -546,7 +548,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
       _ -> Nothing
 
     processDirectMessage :: ACommand 'Agent -> Connection -> Maybe Contact -> m ()
-    processDirectMessage agentMsg conn = \case
+    processDirectMessage agentMsg conn@Connection {connId} = \case
       Nothing -> case agentMsg of
         CONF confId connInfo -> do
           saveConnInfo conn connInfo
@@ -558,9 +560,10 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
           withAckMessage agentConnId meta $ pure ()
           ackMsgDeliveryEvent conn meta
         SENT msgId ->
+          -- ? updateDirectChatItem
           sentMsgDeliveryEvent conn msgId
         -- TODO print errors
-        MERR _ _ -> pure ()
+        MERR _ _ -> pure () -- ? updateDirectChatItem
         ERR _ -> pure ()
         -- TODO add debugging output
         _ -> pure ()
@@ -609,8 +612,14 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
               when (memberIsReady m) $ do
                 notifyMemberConnected gInfo m
                 when (memberCategory m == GCPreMember) $ probeMatchingContacts ct
-        SENT msgId ->
+        SENT msgId -> do
           sentMsgDeliveryEvent conn msgId
+          chatItemId_ <- withStore $ \st -> getChatItemIdByAgentMsgId st connId msgId
+          case chatItemId_ of
+            Nothing -> pure ()
+            Just chatItemId -> do
+              chatItem <- withStore $ \st -> updateDirectChatItem st chatItemId CISSndSent
+              toView $ CRChatItemUpdated (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
         END -> do
           toView $ CRContactAnotherClient ct
           showToast (c <> "> ") "connected to another client"
@@ -623,7 +632,13 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
           showToast (c <> "> ") "is active"
           setActive $ ActiveC c
         -- TODO print errors
-        MERR _ _ -> pure ()
+        MERR msgId err -> do
+          chatItemId_ <- withStore $ \st -> getChatItemIdByAgentMsgId st connId msgId
+          case chatItemId_ of
+            Nothing -> pure ()
+            Just chatItemId -> do
+              chatItem <- withStore $ \st -> updateDirectChatItem st chatItemId (agentErrToItemStatus err)
+              toView $ CRChatItemUpdated (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
         ERR _ -> pure ()
         -- TODO add debugging output
         _ -> pure ()
@@ -821,6 +836,10 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
     sentMsgDeliveryEvent Connection {connId} msgId =
       withStore $ \st -> createSndMsgDeliveryEvent st connId msgId MDSSndSent
 
+    agentErrToItemStatus :: AgentErrorType -> CIStatus 'MDSnd
+    agentErrToItemStatus (SMP AUTH) = CISSndErrorAuth
+    agentErrToItemStatus err = CISSndError err
+
     badRcvFileChunk :: RcvFileTransfer -> String -> m ()
     badRcvFileChunk ft@RcvFileTransfer {fileStatus} err =
       case fileStatus of
@@ -879,7 +898,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
       chSize <- asks $ fileChunkSize . config
       ft@RcvFileTransfer {fileId} <- withStore $ \st -> createRcvFileTransfer st userId ct fInv chSize
       ci <- saveRcvDirectChatItem userId ct msgId msgMeta (CIRcvFileInvitation ft)
-      withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId ci
+      withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci
       toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
       checkIntegrity msgMeta $ toView . CRMsgIntegrityError
       showToast (c <> "> ") "wants to send a file"
@@ -890,7 +909,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
       chSize <- asks $ fileChunkSize . config
       ft@RcvFileTransfer {fileId} <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize
       ci <- saveRcvGroupChatItem userId gInfo m msgId msgMeta (CIRcvFileInvitation ft)
-      withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId ci
+      withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci
       toView . CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci
       checkIntegrity msgMeta $ toView . CRMsgIntegrityError
       let g = groupName' gInfo
@@ -1248,11 +1267,11 @@ saveRcvGroupChatItem userId g m msgId MsgMeta {broker = (_, brokerTs)} ciContent
   ciMeta <- saveChatItem userId (CDGroupRcv g m) $ mkNewChatItem ciContent msgId brokerTs createdAt
   pure $ ChatItem (CIGroupRcv m) ciMeta ciContent
 
-saveChatItem :: ChatMonad m => UserId -> ChatDirection c d -> NewChatItem d -> m CIMeta
+saveChatItem :: (ChatMonad m, MsgDirectionI d) => UserId -> ChatDirection c d -> NewChatItem d -> m (CIMeta d)
 saveChatItem userId cd ci@NewChatItem {itemTs, itemText, createdAt} = do
   tz <- liftIO getCurrentTimeZone
   ciId <- withStore $ \st -> createNewChatItem st userId cd ci
-  pure $ mkCIMeta ciId itemText tz itemTs createdAt
+  pure $ mkCIMeta ciId itemText ciStatusNew tz itemTs createdAt
 
 mkNewChatItem :: forall d. MsgDirectionI d => CIContent d -> MessageId -> UTCTime -> UTCTime -> NewChatItem d
 mkNewChatItem itemContent msgId itemTs createdAt =
@@ -1262,6 +1281,7 @@ mkNewChatItem itemContent msgId itemTs createdAt =
       itemTs,
       itemContent,
       itemText = ciContentToText itemContent,
+      itemStatus = ciStatusNew,
       createdAt
     }
 

src/Simplex/Chat/Controller.hs

@@ -47,6 +47,7 @@ updateStr = "To update run: curl -o- https://raw.githubusercontent.com/simplex-c
 data ChatConfig = ChatConfig
   { agentConfig :: AgentConfig,
     dbPoolSize :: Int,
+    yesToMigrations :: Bool,
     tbqSize :: Natural,
     fileChunkSize :: Integer
   }
@@ -130,6 +131,7 @@ data ChatResponse
   | CRApiChats {chats :: [AChat]}
   | CRApiChat {chat :: AChat}
   | CRNewChatItem {chatItem :: AChatItem}
+  | CRChatItemUpdated {chatItem :: AChatItem}
   | CRMsgIntegrityError {msgerror :: MsgErrorType} -- TODO make it chat item to support in mobile
   | CRCmdAccepted {corr :: CorrId}
   | CRChatHelp {helpSection :: HelpSection}

src/Simplex/Chat/Messages.hs

@@ -15,6 +15,7 @@ module Simplex.Chat.Messages where
 
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
@@ -30,12 +31,13 @@ import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics (Generic)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
-import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..))
+import Simplex.Chat.Util (eitherToMaybe, safeDecodeUtf8)
+import Simplex.Messaging.Agent.Protocol (AgentErrorType, AgentMsgId, MsgMeta (..))
 import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, sumTypeJSON)
 import Simplex.Messaging.Protocol (MsgBody)
-import Simplex.Chat.Util (safeDecodeUtf8)
+import Simplex.Messaging.Util ((<$?>))
 
 data ChatType = CTDirect | CTGroup | CTContactRequest
   deriving (Show, Generic)
@@ -73,7 +75,7 @@ jsonChatInfo = \case
 
 data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
   { chatDir :: CIDirection c d,
-    meta :: CIMeta,
+    meta :: CIMeta d,
     content :: CIContent d
   }
   deriving (Show, Generic)
@@ -115,7 +117,7 @@ jsonCIDirection = \case
   CIGroupSnd -> JCIGroupSnd
   CIGroupRcv m -> JCIGroupRcv m
 
-data CChatItem c = forall d. CChatItem (SMsgDirection d) (ChatItem c d)
+data CChatItem c = forall d. MsgDirectionI d => CChatItem (SMsgDirection d) (ChatItem c d)
 
 deriving instance Show (CChatItem c)
 
@@ -123,8 +125,8 @@ instance ToJSON (CChatItem c) where
   toJSON (CChatItem _ ci) = J.toJSON ci
   toEncoding (CChatItem _ ci) = J.toEncoding ci
 
-chatItemId :: ChatItem c d -> ChatItemId
+chatItemId' :: ChatItem c d -> ChatItemId
-chatItemId ChatItem {meta = CIMeta {itemId}} = itemId
+chatItemId' ChatItem {meta = CIMeta {itemId}} = itemId
 
 data ChatDirection (c :: ChatType) (d :: MsgDirection) where
   CDDirectSnd :: Contact -> ChatDirection 'CTDirect 'MDSnd
@@ -138,6 +140,7 @@ data NewChatItem d = NewChatItem
     itemTs :: ChatItemTs,
     itemContent :: CIContent d,
     itemText :: Text,
+    itemStatus :: CIStatus d,
     createdAt :: UTCTime
   }
   deriving (Show)
@@ -174,21 +177,91 @@ instance ToJSON (JSONAnyChatItem c d) where
   toJSON = J.genericToJSON J.defaultOptions
   toEncoding = J.genericToEncoding J.defaultOptions
 
-data CIMeta = CIMeta
+data CIMeta (d :: MsgDirection) = CIMeta
   { itemId :: ChatItemId,
     itemTs :: ChatItemTs,
     itemText :: Text,
+    itemStatus :: CIStatus d,
     localItemTs :: ZonedTime,
     createdAt :: UTCTime
   }
-  deriving (Show, Generic, FromJSON)
+  deriving (Show, Generic)
 
-mkCIMeta :: ChatItemId -> Text -> TimeZone -> ChatItemTs -> UTCTime -> CIMeta
+mkCIMeta :: ChatItemId -> Text -> CIStatus d -> TimeZone -> ChatItemTs -> UTCTime -> CIMeta d
-mkCIMeta itemId itemText tz itemTs createdAt =
+mkCIMeta itemId itemText itemStatus tz itemTs createdAt =
   let localItemTs = utcToZonedTime tz itemTs
-   in CIMeta {itemId, itemTs, itemText, localItemTs, createdAt}
+   in CIMeta {itemId, itemTs, itemText, itemStatus, localItemTs, createdAt}
 
-instance ToJSON CIMeta where toEncoding = J.genericToEncoding J.defaultOptions
+instance ToJSON (CIMeta d) where toEncoding = J.genericToEncoding J.defaultOptions
+
+data CIStatus (d :: MsgDirection) where
+  CISSndNew :: CIStatus 'MDSnd
+  CISSndSent :: CIStatus 'MDSnd
+  CISSndErrorAuth :: CIStatus 'MDSnd
+  CISSndError :: AgentErrorType -> CIStatus 'MDSnd
+  CISRcvNew :: CIStatus 'MDRcv
+  CISRcvRead :: CIStatus 'MDRcv
+
+deriving instance Show (CIStatus d)
+
+ciStatusNew :: forall d. MsgDirectionI d => CIStatus d
+ciStatusNew = case msgDirection @d of
+  SMDSnd -> CISSndNew
+  SMDRcv -> CISRcvNew
+
+instance ToJSON (CIStatus d) where
+  toJSON = J.toJSON . jsonCIStatus
+  toEncoding = J.toEncoding . jsonCIStatus
+
+instance MsgDirectionI d => ToField (CIStatus d) where toField = toField . decodeLatin1 . strEncode
+
+instance FromField ACIStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+data ACIStatus = forall d. MsgDirectionI d => ACIStatus (SMsgDirection d) (CIStatus d)
+
+instance MsgDirectionI d => StrEncoding (CIStatus d) where
+  strEncode = \case
+    CISSndNew -> "snd_new"
+    CISSndSent -> "snd_sent"
+    CISSndErrorAuth -> "snd_error_auth"
+    CISSndError e -> "snd_error " <> strEncode e
+    CISRcvNew -> "rcv_new"
+    CISRcvRead -> "rcv_read"
+  strP = (\(ACIStatus _ st) -> checkDirection st) <$?> strP
+
+instance StrEncoding ACIStatus where
+  strEncode (ACIStatus _ s) = strEncode s
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "snd_new" -> pure $ ACIStatus SMDSnd CISSndNew
+      "snd_sent" -> pure $ ACIStatus SMDSnd CISSndSent
+      "snd_error_auth" -> pure $ ACIStatus SMDSnd CISSndErrorAuth
+      "snd_error" -> ACIStatus SMDSnd <$> (A.space *> strP)
+      "rcv_new" -> pure $ ACIStatus SMDRcv CISRcvNew
+      "rcv_read" -> pure $ ACIStatus SMDRcv CISRcvRead
+      _ -> fail "bad status"
+
+data JSONCIStatus
+  = JCISSndNew
+  | JCISSndSent
+  | JCISSndErrorAuth
+  | JCISSndError {agentError :: AgentErrorType}
+  | JCISRcvNew
+  | JCISRcvRead
+  deriving (Show, Generic)
+
+instance ToJSON JSONCIStatus where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIS"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIS"
+
+jsonCIStatus :: CIStatus d -> JSONCIStatus
+jsonCIStatus = \case
+  CISSndNew -> JCISSndNew
+  CISSndSent -> JCISSndSent
+  CISSndErrorAuth -> JCISSndErrorAuth
+  CISSndError e -> JCISSndError e
+  CISRcvNew -> JCISRcvNew
+  CISRcvRead -> JCISRcvRead
 
 type ChatItemId = Int64
 
@@ -420,3 +493,8 @@ msgDeliveryStatusT' s =
     case testEquality d (msgDirection @d) of
       Just Refl -> Just st
       _ -> Nothing
+
+checkDirection :: forall t d d'. (MsgDirectionI d, MsgDirectionI d') => t d' -> Either String (t d)
+checkDirection x = case testEquality (msgDirection @d) (msgDirection @d') of
+  Just Refl -> Right x
+  Nothing -> Left "bad direction"

src/Simplex/Chat/Migrations/M20220205_chat_item_status.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20220205_chat_item_status where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220205_chat_item_status :: Query
+m20220205_chat_item_status =
+  [sql|
+PRAGMA ignore_check_constraints=ON;
+
+ALTER TABLE chat_items ADD COLUMN item_status TEXT CHECK (item_status NOT NULL);
+
+UPDATE chat_items SET item_status = 'rcv_read' WHERE item_sent = 0;
+
+UPDATE chat_items SET item_status = 'snd_sent' WHERE item_sent = 1;
+
+PRAGMA ignore_check_constraints=OFF;
+|]

src/Simplex/Chat/Mobile.hs

@@ -53,6 +53,13 @@ mobileChatOpts =
       logging = False
     }
 
+defaultMobileConfig :: ChatConfig
+defaultMobileConfig =
+  defaultChatConfig
+    { yesToMigrations = True,
+      agentConfig = agentConfig defaultChatConfig {yesToMigrations = True}
+    }
+
 type CJSONString = CString
 
 getActiveUser_ :: SQLiteStore -> IO (Maybe User)
@@ -61,9 +68,9 @@ getActiveUser_ st = find activeUser <$> getUsers st
 chatInit :: String -> IO ChatController
 chatInit dbFilePrefix = do
   let f = chatStoreFile dbFilePrefix
-  chatStore <- createStore f $ dbPoolSize defaultChatConfig
+  chatStore <- createStore f (dbPoolSize defaultMobileConfig) (yesToMigrations defaultMobileConfig)
   user_ <- getActiveUser_ chatStore
-  newChatController chatStore user_ defaultChatConfig mobileChatOpts {dbFilePrefix} . const $ pure ()
+  newChatController chatStore user_ defaultMobileConfig mobileChatOpts {dbFilePrefix} . const $ pure ()
 
 chatSendCmd :: ChatController -> String -> IO JSONString
 chatSendCmd cc s = LB.unpack . J.encode . APIResponse Nothing <$> runReaderT (execChatCommand $ B.pack s) cc

src/Simplex/Chat/Store.hs

@@ -13,6 +13,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Simplex.Chat.Store
@@ -113,6 +114,8 @@ module Simplex.Chat.Store
     getChatPreviews,
     getDirectChat,
     getGroupChat,
+    getChatItemIdByAgentMsgId,
+    updateDirectChatItem,
   )
 where
 
@@ -125,6 +128,7 @@ import Control.Monad.IO.Unlift
 import Crypto.Random (ChaChaDRG, randomBytesGenerate)
 import Data.Aeson (ToJSON)
 import qualified Data.Aeson as J
+import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import Data.Either (rights)
@@ -138,6 +142,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
 import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)
+import Data.Type.Equality
 import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), SQLError, (:.) (..))
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
@@ -145,6 +150,7 @@ import GHC.Generics (Generic)
 import Simplex.Chat.Messages
 import Simplex.Chat.Migrations.M20220101_initial
 import Simplex.Chat.Migrations.M20220122_v1_1
+import Simplex.Chat.Migrations.M20220205_chat_item_status
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Util (eitherToMaybe)
@@ -160,7 +166,8 @@ import UnliftIO.STM
 schemaMigrations :: [(String, Query)]
 schemaMigrations =
   [ ("20220101_initial", m20220101_initial),
-    ("20220122_v1_1", m20220122_v1_1)
+    ("20220122_v1_1", m20220122_v1_1),
+    ("20220205_chat_item_status", m20220205_chat_item_status)
   ]
 
 -- | The list of migrations in ascending order by date
@@ -169,7 +176,7 @@ migrations = sortBy (compare `on` name) $ map migration schemaMigrations
   where
     migration (name, query) = Migration {name = name, up = fromQuery query}
 
-createStore :: FilePath -> Int -> IO SQLiteStore
+createStore :: FilePath -> Int -> Bool -> IO SQLiteStore
 createStore dbFilePath poolSize = createSQLiteStore dbFilePath poolSize migrations
 
 chatStoreFile :: FilePath -> FilePath
@@ -181,7 +188,7 @@ checkConstraint err action = action `E.catch` (pure . Left . handleSQLError err)
 handleSQLError :: StoreError -> SQLError -> StoreError
 handleSQLError err e
   | DB.sqlError e == DB.ErrorConstraint = err
-  | otherwise = SEInternal $ show e
+  | otherwise = SEInternalError $ show e
 
 insertedRowId :: DB.Connection -> IO Int64
 insertedRowId db = fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
@@ -851,7 +858,7 @@ getConnectionEntity st User {userId, userContactId} agentConnId =
       Nothing ->
         if connType == ConnContact
           then pure $ RcvDirectMsgConnection c Nothing
-          else throwError $ SEInternal $ "connection " <> show connType <> " without entity"
+          else throwError $ SEInternalError $ "connection " <> show connType <> " without entity"
       Just entId ->
         case connType of
           ConnMember -> uncurry (RcvGroupMsgConnection c) <$> getGroupAndMember_ db entId c
@@ -891,10 +898,10 @@ getConnectionEntity st User {userId, userContactId} agentConnId =
     toContact' contactId activeConn [(localDisplayName, displayName, fullName, viaGroup, createdAt)] =
       let profile = Profile {displayName, fullName}
        in Right $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup, createdAt}
-    toContact' _ _ _ = Left $ SEInternal "referenced contact not found"
+    toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
     getGroupAndMember_ :: DB.Connection -> Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
     getGroupAndMember_ db groupMemberId c = ExceptT $ do
-      firstRow (toGroupAndMember c) (SEInternal "referenced group member not found") $
+      firstRow (toGroupAndMember c) (SEInternalError "referenced group member not found") $
         DB.query
           db
           [sql|
@@ -1925,8 +1932,8 @@ createMsgDeliveryEvent_ db msgDeliveryId msgDeliveryStatus createdAt = do
 
 getMsgDeliveryId_ :: DB.Connection -> Int64 -> AgentMsgId -> IO (Either StoreError Int64)
 getMsgDeliveryId_ db connId agentMsgId =
-  toMsgDeliveryId
+  firstRow fromOnly (SENoMsgDelivery connId agentMsgId) $
-    <$> DB.query
+    DB.query
       db
       [sql|
         SELECT msg_delivery_id
@@ -1935,10 +1942,6 @@ getMsgDeliveryId_ db connId agentMsgId =
         LIMIT 1
       |]
       (connId, agentMsgId)
-  where
-    toMsgDeliveryId :: [Only Int64] -> Either StoreError Int64
-    toMsgDeliveryId [Only msgDeliveryId] = Right msgDeliveryId
-    toMsgDeliveryId _ = Left $ SENoMsgDelivery connId agentMsgId
 
 createPendingGroupMessage :: MonadUnliftIO m => SQLiteStore -> Int64 -> MessageId -> Maybe Int64 -> m ()
 createPendingGroupMessage st groupMemberId messageId introId_ =
@@ -1975,20 +1978,20 @@ 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 :: (MonadUnliftIO m, MsgDirectionI d) => SQLiteStore -> UserId -> ChatDirection c d -> NewChatItem d -> m ChatItemId
-createNewChatItem st userId chatDirection NewChatItem {createdByMsgId, itemSent, itemTs, itemContent, itemText, createdAt} =
+createNewChatItem st userId chatDirection NewChatItem {createdByMsgId, itemSent, itemTs, itemContent, itemText, itemStatus, createdAt} =
   liftIO . withTransaction st $ \db -> do
     let (contactId_, groupId_, groupMemberId_) = ids
     DB.execute
       db
       [sql|
         INSERT INTO chat_items (
-          user_id, contact_id, group_id, group_member_id,
+          user_id, contact_id, group_id, group_member_id, created_by_msg_id,
-          created_by_msg_id, item_sent, item_ts, item_content, item_text, created_at, updated_at
+          item_sent, item_ts, item_content, item_text, item_status, created_at, updated_at
-        ) VALUES (?,?,?,?,?,?,?,?,?,?,?)
+        ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
       |]
-      ( (userId, contactId_, groupId_, groupMemberId_)
+      ( (userId, contactId_, groupId_, groupMemberId_, createdByMsgId)
-          :. (createdByMsgId, itemSent, itemTs, itemContent, itemText, createdAt, createdAt)
+          :. (itemSent, itemTs, itemContent, itemText, itemStatus, createdAt, createdAt)
       )
     ciId <- insertedRowId db
     case createdByMsgId of
@@ -2038,7 +2041,7 @@ getDirectChatPreviews_ db User {userId} = do
           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,
           -- ChatItem
-          ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at
+          ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.item_status, ci.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
@@ -2083,7 +2086,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
           mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id,
           pu.display_name, pu.full_name,
           -- ChatItem
-          ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at,
+          ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.item_status, ci.created_at,
           -- Maybe GroupMember - sender
           m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
           m.member_status, m.invited_by, m.local_display_name, m.contact_id,
@@ -2145,20 +2148,22 @@ getDirectChat st user contactId pagination =
 getDirectChatLast_ :: DB.Connection -> User -> Int64 -> Int -> ExceptT StoreError IO (Chat 'CTDirect)
 getDirectChatLast_ db User {userId} contactId count = do
   contact <- ExceptT $ getContact_ db userId contactId
-  chatItems <- liftIO getDirectChatItemsLast_
+  chatItems <- ExceptT getDirectChatItemsLast_
   pure $ Chat (DirectChat contact) (reverse chatItems)
   where
-    getDirectChatItemsLast_ :: IO [CChatItem 'CTDirect]
+    getDirectChatItemsLast_ :: IO (Either StoreError [CChatItem 'CTDirect])
     getDirectChatItemsLast_ = do
       tz <- getCurrentTimeZone
-      map (toDirectChatItem tz)
+      mapM (toDirectChatItem tz)
         <$> DB.query
           db
           [sql|
-            SELECT chat_item_id, item_ts, item_content, item_text, created_at
+            SELECT
-            FROM chat_items
+              -- ChatItem
-            WHERE user_id = ? AND contact_id = ?
+              ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.item_status, ci.created_at
-            ORDER BY chat_item_id DESC
+            FROM chat_items ci
+            WHERE ci.user_id = ? AND ci.contact_id = ?
+            ORDER BY ci.chat_item_id DESC
             LIMIT ?
           |]
           (userId, contactId, count)
@@ -2166,20 +2171,22 @@ getDirectChatLast_ db User {userId} contactId count = do
 getDirectChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> ExceptT StoreError IO (Chat 'CTDirect)
 getDirectChatAfter_ db User {userId} contactId afterChatItemId count = do
   contact <- ExceptT $ getContact_ db userId contactId
-  chatItems <- liftIO getDirectChatItemsAfter_
+  chatItems <- ExceptT getDirectChatItemsAfter_
   pure $ Chat (DirectChat contact) chatItems
   where
-    getDirectChatItemsAfter_ :: IO [CChatItem 'CTDirect]
+    getDirectChatItemsAfter_ :: IO (Either StoreError [CChatItem 'CTDirect])
     getDirectChatItemsAfter_ = do
       tz <- getCurrentTimeZone
-      map (toDirectChatItem tz)
+      mapM (toDirectChatItem tz)
         <$> DB.query
           db
           [sql|
-            SELECT chat_item_id, item_ts, item_content, item_text, created_at
+            SELECT
-            FROM chat_items
+              -- ChatItem
-            WHERE user_id = ? AND contact_id = ? AND chat_item_id > ?
+              ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.item_status, ci.created_at
-            ORDER BY chat_item_id ASC
+            FROM chat_items ci
+            WHERE ci.user_id = ? AND ci.contact_id = ? AND ci.chat_item_id > ?
+            ORDER BY ci.chat_item_id ASC
             LIMIT ?
           |]
           (userId, contactId, afterChatItemId, count)
@@ -2187,20 +2194,22 @@ getDirectChatAfter_ db User {userId} contactId afterChatItemId count = do
 getDirectChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> ExceptT StoreError IO (Chat 'CTDirect)
 getDirectChatBefore_ db User {userId} contactId beforeChatItemId count = do
   contact <- ExceptT $ getContact_ db userId contactId
-  chatItems <- liftIO getDirectChatItemsBefore_
+  chatItems <- ExceptT getDirectChatItemsBefore_
   pure $ Chat (DirectChat contact) (reverse chatItems)
   where
-    getDirectChatItemsBefore_ :: IO [CChatItem 'CTDirect]
+    getDirectChatItemsBefore_ :: IO (Either StoreError [CChatItem 'CTDirect])
     getDirectChatItemsBefore_ = do
       tz <- getCurrentTimeZone
-      map (toDirectChatItem tz)
+      mapM (toDirectChatItem tz)
         <$> DB.query
           db
           [sql|
-            SELECT chat_item_id, item_ts, item_content, item_text, created_at
+            SELECT
-            FROM chat_items
+              -- ChatItem
-            WHERE user_id = ? AND contact_id = ? AND chat_item_id < ?
+              ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.item_status, ci.created_at
-            ORDER BY chat_item_id DESC
+            FROM chat_items ci
+            WHERE ci.user_id = ? AND ci.contact_id = ? AND ci.chat_item_id < ?
+            ORDER BY ci.chat_item_id DESC
             LIMIT ?
           |]
           (userId, contactId, beforeChatItemId, count)
@@ -2266,7 +2275,7 @@ getGroupChatLast_ db user@User {userId, userContactId} groupId count = do
           [sql|
             SELECT
               -- ChatItem
-              ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at,
+              ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.item_status, ci.created_at,
               -- GroupMember
               m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
               m.member_status, m.invited_by, m.local_display_name, m.contact_id,
@@ -2295,7 +2304,7 @@ getGroupChatAfter_ db user@User {userId, userContactId} groupId afterChatItemId
           [sql|
             SELECT
               -- ChatItem
-              ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at,
+              ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.item_status, ci.created_at,
               -- GroupMember
               m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
               m.member_status, m.invited_by, m.local_display_name, m.contact_id,
@@ -2324,7 +2333,7 @@ getGroupChatBefore_ db user@User {userId, userContactId} groupId beforeChatItemI
           [sql|
             SELECT
               -- ChatItem
-              ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at,
+              ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.item_status, ci.created_at,
               -- GroupMember
               m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
               m.member_status, m.invited_by, m.local_display_name, m.contact_id,
@@ -2373,20 +2382,75 @@ getGroupIdByName_ db User {userId} gName =
   firstRow fromOnly (SEGroupNotFoundByName gName) $
     DB.query db "SELECT group_id FROM groups WHERE user_id = ? AND local_display_name = ?" (userId, gName)
 
-type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, UTCTime)
+getChatItemIdByAgentMsgId :: StoreMonad m => SQLiteStore -> Int64 -> AgentMsgId -> m (Maybe ChatItemId)
+getChatItemIdByAgentMsgId st connId msgId =
+  liftIO . withTransaction st $ \db ->
+    join . listToMaybe . map fromOnly
+      <$> DB.query
+        db
+        [sql|
+          SELECT chat_item_id
+          FROM chat_item_messages
+          WHERE message_id = (
+            SELECT message_id
+            FROM msg_deliveries
+            WHERE connection_id = ? AND agent_msg_id = ?
+            LIMIT 1
+          )
+        |]
+        (connId, msgId)
 
-type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe UTCTime)
+updateDirectChatItem :: (StoreMonad m, MsgDirectionI d) => SQLiteStore -> ChatItemId -> CIStatus d -> m (ChatItem 'CTDirect d)
+updateDirectChatItem st itemId itemStatus =
+  liftIOEither . withTransaction st $ \db -> do
+    ci <- getDirectChatItem_ db itemId
+    DB.execute db "UPDATE chat_items SET item_status = ? WHERE chat_item_id = ?" (itemStatus, itemId)
+    pure ci
 
-toDirectChatItem :: TimeZone -> ChatItemRow -> CChatItem 'CTDirect
+getDirectChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> ChatItemId -> IO (Either StoreError (ChatItem 'CTDirect d))
-toDirectChatItem tz (itemId, itemTs, itemContent, itemText, createdAt) =
+getDirectChatItem_ db itemId = do
-  let ciMeta = mkCIMeta itemId itemText tz itemTs createdAt
+  tz <- getCurrentTimeZone
-   in case itemContent of
+  join
-        ACIContent d@SMDSnd ciContent -> CChatItem d $ ChatItem CIDirectSnd ciMeta ciContent
+    <$> firstRow
-        ACIContent d@SMDRcv ciContent -> CChatItem d $ ChatItem CIDirectRcv ciMeta ciContent
+      (correctDir <=< toDirectChatItem tz)
+      (SEChatItemNotFound itemId)
+      ( DB.query
+          db
+          [sql|
+            SELECT
+              -- ChatItem
+              ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.item_status, ci.created_at
+            FROM chat_items ci
+            WHERE ci.chat_item_id = ?
+          |]
+          (Only itemId)
+      )
+  where
+    correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
+    correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
+
+type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, UTCTime)
+
+type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe UTCTime)
+
+toDirectChatItem :: TimeZone -> ChatItemRow -> Either StoreError (CChatItem 'CTDirect)
+toDirectChatItem tz (itemId, itemTs, itemContent, itemText, itemStatus, createdAt) =
+  case (itemContent, itemStatus) of
+    (ACIContent d@SMDSnd ciContent, ACIStatus d'@SMDSnd ciStatus) -> case testEquality d d' of
+      Just Refl -> Right $ CChatItem d (ChatItem CIDirectSnd (ciMeta ciStatus) ciContent)
+      _ -> badItem
+    (ACIContent d@SMDRcv ciContent, ACIStatus d'@SMDRcv ciStatus) -> case testEquality d d' of
+      Just Refl -> Right $ CChatItem d (ChatItem CIDirectRcv (ciMeta ciStatus) ciContent)
+      _ -> badItem
+    _ -> badItem
+  where
+    badItem = Left $ SEBadChatItem itemId
+    ciMeta :: CIStatus d -> CIMeta d
+    ciMeta status = mkCIMeta itemId itemText status tz itemTs createdAt
 
 toDirectChatItemList :: TimeZone -> MaybeChatItemRow -> [CChatItem 'CTDirect]
-toDirectChatItemList tz (Just itemId, Just itemTs, Just itemContent, Just itemText, Just createdAt) =
+toDirectChatItemList tz (Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, Just createdAt) =
-  [toDirectChatItem tz (itemId, itemTs, itemContent, itemText, createdAt)]
+  either (const []) (: []) $ toDirectChatItem tz (itemId, itemTs, itemContent, itemText, itemStatus, createdAt)
 toDirectChatItemList _ _ = []
 
 type GroupChatItemRow = ChatItemRow :. MaybeGroupMemberRow
@@ -2394,17 +2458,24 @@ type GroupChatItemRow = ChatItemRow :. MaybeGroupMemberRow
 type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow
 
 toGroupChatItem :: TimeZone -> Int64 -> GroupChatItemRow -> Either StoreError (CChatItem 'CTGroup)
-toGroupChatItem tz userContactId ((itemId, itemTs, itemContent, itemText, createdAt) :. memberRow_) =
+toGroupChatItem tz userContactId ((itemId, itemTs, itemContent, itemText, itemStatus, createdAt) :. memberRow_) = do
-  let ciMeta = mkCIMeta itemId itemText tz itemTs createdAt
+  let member_ = toMaybeGroupMember userContactId memberRow_
-      member_ = toMaybeGroupMember userContactId memberRow_
+  case (itemContent, itemStatus, member_) of
-   in case (itemContent, member_) of
+    (ACIContent d@SMDSnd ciContent, ACIStatus d'@SMDSnd ciStatus, Nothing) -> case testEquality d d' of
-        (ACIContent d@SMDSnd ciContent, Nothing) -> Right $ CChatItem d (ChatItem CIGroupSnd ciMeta ciContent)
+      Just Refl -> Right $ CChatItem d (ChatItem CIGroupSnd (ciMeta ciStatus) ciContent)
-        (ACIContent d@SMDRcv ciContent, Just member) -> Right $ CChatItem d (ChatItem (CIGroupRcv member) ciMeta ciContent)
+      _ -> badItem
-        _ -> Left $ SEBadChatItem itemId
+    (ACIContent d@SMDRcv ciContent, ACIStatus d'@SMDRcv ciStatus, Just member) -> case testEquality d d' of
+      Just Refl -> Right $ CChatItem d (ChatItem (CIGroupRcv member) (ciMeta ciStatus) ciContent)
+      _ -> badItem
+    _ -> badItem
+  where
+    badItem = Left $ SEBadChatItem itemId
+    ciMeta :: CIStatus d -> CIMeta d
+    ciMeta status = mkCIMeta itemId itemText status tz itemTs createdAt
 
 toGroupChatItemList :: TimeZone -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
-toGroupChatItemList tz userContactId ((Just itemId, Just itemTs, Just itemContent, Just itemText, Just createdAt) :. memberRow_) =
+toGroupChatItemList tz userContactId ((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, Just createdAt) :. memberRow_) =
-  either (const []) (: []) $ toGroupChatItem tz userContactId ((itemId, itemTs, itemContent, itemText, createdAt) :. memberRow_)
+  either (const []) (: []) $ toGroupChatItem tz userContactId ((itemId, itemTs, itemContent, itemText, itemStatus, createdAt) :. memberRow_)
 toGroupChatItemList _ _ _ = []
 
 -- | Saves unique local display name based on passed displayName, suffixed with _N if required.
@@ -2459,7 +2530,7 @@ createWithRandomBytes size gVar create = tryCreate 3
         Right x -> pure $ Right x
         Left e
           | DB.sqlError e == DB.ErrorConstraint -> tryCreate (n - 1)
-          | otherwise -> pure . Left . SEInternal $ show e
+          | otherwise -> pure . Left . SEInternalError $ show e
 
 randomBytes :: TVar ChaChaDRG -> Int -> IO ByteString
 randomBytes gVar n = B64.encode <$> (atomically . stateTVar gVar $ randomBytesGenerate n)
@@ -2488,9 +2559,10 @@ data StoreError
   | SEConnectionNotFound {agentConnId :: AgentConnId}
   | SEIntroNotFound
   | SEUniqueID
-  | SEInternal {message :: String}
+  | SEInternalError {message :: String}
   | SENoMsgDelivery {connId :: Int64, agentMsgId :: AgentMsgId}
-  | SEBadChatItem {itemId :: Int64}
+  | SEBadChatItem {itemId :: ChatItemId}
+  | SEChatItemNotFound {itemId :: ChatItemId}
   deriving (Show, Exception, Generic)
 
 instance ToJSON StoreError where

src/Simplex/Chat/Terminal.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Chat.Terminal where
 
@@ -18,7 +19,7 @@ import Simplex.Messaging.Util (raceAny_)
 import UnliftIO (async, waitEither_)
 
 simplexChat :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
-simplexChat cfg opts t
+simplexChat cfg@ChatConfig {dbPoolSize, yesToMigrations} opts t
   | logging opts = do
     setLogLevel LogInfo -- LogError
     withGlobalLogging logCfg initRun
@@ -27,7 +28,7 @@ simplexChat cfg opts t
     initRun = do
       sendNotification' <- initializeNotifications
       let f = chatStoreFile $ dbFilePrefix opts
-      st <- createStore f $ dbPoolSize cfg
+      st <- createStore f dbPoolSize yesToMigrations
       u <- getCreateActiveUser st
       ct <- newChatTerminal t
       cc <- newChatController st (Just u) cfg opts sendNotification'

src/Simplex/Chat/View.hs

@@ -39,6 +39,7 @@ responseToView cmd = \case
   CRApiChats chats -> r [sShow chats]
   CRApiChat chat -> r [sShow chat]
   CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item
+  CRChatItemUpdated _ -> []
   CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr
   CRCmdAccepted _ -> r []
   CRChatHelp section -> case section of
@@ -308,10 +309,10 @@ viewContactUpdated
     where
       fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName'
 
-viewReceivedMessage :: StyledString -> CIMeta -> MsgContent -> [StyledString]
+viewReceivedMessage :: StyledString -> CIMeta d -> MsgContent -> [StyledString]
 viewReceivedMessage from meta mc = receivedWithTime_ from meta (ttyMsgContent mc)
 
-receivedWithTime_ :: StyledString -> CIMeta -> [StyledString] -> [StyledString]
+receivedWithTime_ :: StyledString -> CIMeta d -> [StyledString] -> [StyledString]
 receivedWithTime_ from CIMeta {localItemTs, createdAt} styledMsg = do
   prependFirst (formattedTime <> " " <> from) styledMsg -- ++ showIntegrity mOk
   where
@@ -326,13 +327,13 @@ receivedWithTime_ from CIMeta {localItemTs, createdAt} styledMsg = do
               else "%H:%M"
        in styleTime $ formatTime defaultTimeLocale format localTime
 
-viewSentMessage :: StyledString -> MsgContent -> CIMeta -> [StyledString]
+viewSentMessage :: StyledString -> MsgContent -> CIMeta d -> [StyledString]
 viewSentMessage to = sentWithTime_ . prependFirst to . ttyMsgContent
 
-viewSentFileInvitation :: StyledString -> FileTransferId -> FilePath -> CIMeta -> [StyledString]
+viewSentFileInvitation :: StyledString -> FileTransferId -> FilePath -> CIMeta d -> [StyledString]
 viewSentFileInvitation to fId fPath = sentWithTime_ $ ttySentFile to fId fPath
 
-sentWithTime_ :: [StyledString] -> CIMeta -> [StyledString]
+sentWithTime_ :: [StyledString] -> CIMeta d -> [StyledString]
 sentWithTime_ styledMsg CIMeta {localItemTs} =
   prependFirst (ttyMsgTime localItemTs <> " ") styledMsg
 
@@ -371,7 +372,7 @@ sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} =
 sndFile :: SndFileTransfer -> StyledString
 sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName
 
-viewReceivedFileInvitation :: StyledString -> CIMeta -> RcvFileTransfer -> [StyledString]
+viewReceivedFileInvitation :: StyledString -> CIMeta d -> RcvFileTransfer -> [StyledString]
 viewReceivedFileInvitation from meta ft = receivedWithTime_ from meta (receivedFileInvitation_ ft)
 
 receivedFileInvitation_ :: RcvFileTransfer -> [StyledString]

stack.yaml

@@ -48,7 +48,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: 137ff7043d49feb3b350f56783c9b64a62bc636a
+    commit: c9994c3a2ca945b9b67e250163cf8d560d2ed554
   # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
   - github: simplex-chat/aeson
     commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7

tests/ChatClient.hs

@@ -75,7 +75,7 @@ cfg =
 
 virtualSimplexChat :: FilePath -> Profile -> IO TestCC
 virtualSimplexChat dbFilePrefix profile = do
-  st <- createStore (dbFilePrefix <> "_chat.db") 1
+  st <- createStore (dbFilePrefix <> "_chat.db") 1 False
   Right user <- runExceptT $ createUser st profile True
   t <- withVirtualTerminal termSettings pure
   ct <- newChatTerminal t

tests/MobileTests.hs

@@ -35,7 +35,7 @@ testChatApiNoUser = withTmpFiles $ do
 testChatApi :: IO ()
 testChatApi = withTmpFiles $ do
   let f = chatStoreFile testDBPrefix
-  st <- createStore f 1
+  st <- createStore f 1 True
   Right _ <- runExceptT $ createUser st aliceProfile True
   cc <- chatInit testDBPrefix
   chatSendCmd cc "/u" `shouldReturn` activeUser