refactor

2026-09-28 04:48:58 +00:00 · 2026-09-11 21:03:13 +00:00
parent 39a52834f3
commit 583c3c28a4
10 changed files with 146 additions and 88 deletions
@@ -465,7 +465,7 @@ toMaybeGroupLink _ = Nothing

 -- group with its registration and its join link (user_contact_links) in one query
 groupReqQuery :: Query
-groupReqQuery = "SELECT " <> groupInfoQueryFields <> groupRegFields <> groupLinkFields <> groupInfoQueryFrom <> groupLinkJoin <> groupRegFromCond
+groupReqQuery = groupInfoQueryFields <> groupRegFields <> groupLinkFields <> groupInfoQueryFrom <> groupLinkJoin <> groupRegFromCond
  where
    groupRegFields = ", r.group_id, r.user_group_reg_id, r.contact_id, r.owner_member_id, r.group_reg_status, r.group_promoted, r.created_at "
    groupLinkFields = ", uc.user_contact_link_id, uc.conn_req_contact, uc.short_link_contact, uc.short_link_data_set, uc.short_link_large_data_set, uc.group_link_id, uc.group_link_member_role "
@@ -21,7 +21,10 @@ implementing:
 - The feed item's own reactions come from `getFeedCIReactions` inside
  `getFeedChatItem`, as the direct and group item getters do.
 - `CRBroadcastSent` and `viewSentBroadcast` are removed; the broadcast bot
-  matches `CRNewChatItems` and replies "Message is sent to the feed".
+  matches `CRNewChatItems` and replies "Message is being delivered to all contacts".
+- `contactQuery`, `contactQueryFields` and `contactQueryFrom` are defined in
+  `Store/Direct.hs` after `getContact_`, not in `Store/Shared.hs`, and keep
+  `SELECT` inside the fields fragment as `groupInfoQueryFields` does.
 - Tests create the feed with `createCCFeed` (as `createCCNoteFolder`), since
  test users are created by `createUserRecordAt` directly.

@@ -93,8 +93,7 @@ Feed job statements move to `src/Simplex/Chat/Store/Feeds.hs`:
 `src/Simplex/Chat/Library/Subscriber.hs`:

 - `runDeliveryJobWorker` loses its `case deliveryKey` and handles groups only
- add `runFeedJobWorker` with the same `jobLoop`/`withWork_` shape
- extract the shared shape as `jobWorkerLoop :: Int64 -> Worker -> CM () -> CM ()` plus `jobOperation`, parameterised by the read, the processor and the error writer
+- add `runFeedJobWorker` with the same `forever`/`withWork_` shape; `runDeliveryJobWorker` keeps its master shape
 - `getDeliveryJobWorker` handles `DeliveryWorkerKey`; add `getFeedJobWorker` for `FeedJobKey`
 - `startDeliveryJobWorkers` reads group scopes; add `startFeedJobWorkers` reading feed scopes
 - `startFeedWorkers` uses `getFeedJobWorker`
@@ -81,11 +81,10 @@ import Simplex.Chat.Store.ContactRequest
 import Simplex.Chat.Store.Connections
 import Simplex.Chat.Store.Delivery
 import Simplex.Chat.Store.Direct
+import Simplex.Chat.Store.Feeds
 import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Groups
 import Simplex.Chat.Store.Messages
-import Simplex.Chat.Store.Feeds hiding (detachFeedInstances)
-import qualified Simplex.Chat.Store.Feeds as Store
 import Simplex.Chat.Store.NoteFolders
 import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Store.Shared
@@ -818,7 +817,7 @@ processChatCommand cxt nm = \case
                    when changed $
                      addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
                    let edited = itemLive /= Just True
-                    when (itemFeed == Just CIFLinked) $ Store.detachFeedInstances db [itemId]
+                    when (itemFeed == Just CIFLinked) $ detachFeedInstances db [itemId]
                    updateDirectChatItem' db user contactId (detachedInstance ci) (CISndMsgContent mc) edited live Nothing $ Just msgId
                  startUpdatedTimedItemThread user (ChatRef CTDirect contactId Nothing) ci ci'
                  pure $ CRChatItemUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci')
@@ -854,7 +853,7 @@ processChatCommand cxt nm = \case
                        when changed $
                          addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
                        let edited = itemLive /= Just True
-                        when (itemFeed == Just CIFLinked) $ Store.detachFeedInstances db [itemId]
+                        when (itemFeed == Just CIFLinked) $ detachFeedInstances db [itemId]
                        ci' <- updateGroupChatItem db user groupId (detachedInstance ci) (CISndMsgContent mc) edited live $ Just msgId
                        updateGroupCIMentions db gInfo ci' ciMentions
                      startUpdatedTimedItemThread user (ChatRef CTGroup groupId scope) ci ci'
@@ -901,12 +900,12 @@ processChatCommand cxt nm = \case
  APIDeleteChatItem (ChatRef cType chatId scope) itemIds mode -> withUser $ \user -> case cType of
    CTDirect -> withContactLock "deleteChatItem" chatId $ do
      (ct, items) <- getCommandDirectChatItems user chatId itemIds
-      let markDeleted items' = do
-            items'' <- detachFeedInstances items'
-            markDirectCIsDeleted user ct items'' =<< liftIO getCurrentTime
+      let markDeleted = do
+            items' <- detachFeedItems items
+            markDirectCIsDeleted user ct items' =<< liftIO getCurrentTime
      deletions <- case mode of
        CIDMInternal -> deleteDirectCIs user ct items
-        CIDMInternalMark -> markDeleted items
+        CIDMInternalMark -> markDeleted
        CIDMHistory -> throwChatError CEInvalidChatItemDelete
        CIDMBroadcast -> do
          assertDeletable items
@@ -917,7 +916,7 @@ processChatCommand cxt nm = \case
            sendDirectContactMessages user ct events'
          if featureAllowed SCFFullDelete forUser ct
            then deleteDirectCIs user ct items
-            else markDeleted items
+            else markDeleted
      pure $ CRChatItemsDeleted user deletions True False
    CTGroup -> withGroupLock "deleteChatItem" chatId $ do
      (gInfo, items) <- getCommandGroupChatItems user chatId itemIds
@@ -928,7 +927,7 @@ processChatCommand cxt nm = \case
          | publicGroupEditor gInfo (membership gInfo) -> throwChatError CEInvalidChatItemDelete
          | otherwise -> deleteGroupCIs user gInfo chatScopeInfo items Nothing =<< liftIO getCurrentTime
        CIDMInternalMark -> do
-          items' <- detachFeedInstances items
+          items' <- detachFeedItems items
          markGroupCIsDeleted user gInfo chatScopeInfo items' Nothing =<< liftIO getCurrentTime
        CIDMBroadcast -> do
          recipients <- getGroupRecipients cxt user gInfo chatScopeInfo groupKnockingVersion
@@ -4249,11 +4248,11 @@ processChatCommand cxt nm = \case
        ciIds <- concat <$> withStore' (\db -> forM items $ \(CChatItem _ ci) -> markMessageReportsDeleted db user gInfo ci membership deletedTs)
        unless (null ciIds) $ toView $ CEvtGroupChatItemsDeleted user gInfo ciIds True (Just membership)
      let m = if moderation then Just membership else Nothing
-          fullDelete = groupFeatureUserAllowed SGFFullDelete gInfo
-      items' <- if fullDelete && not moderation then pure items else detachFeedInstances items
-      if fullDelete
-        then deleteGroupCIs user gInfo chatScopeInfo items' m deletedTs
-        else markGroupCIsDeleted user gInfo chatScopeInfo items' m deletedTs
+      if groupFeatureUserAllowed SGFFullDelete gInfo
+        then deleteGroupCIs user gInfo chatScopeInfo items m deletedTs
+        else do
+          items' <- detachFeedItems items
+          markGroupCIsDeleted user gInfo chatScopeInfo items' m deletedTs
    updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse
    updateGroupProfileByName = updateGroupProfileByName_ Nothing
    updateGroupProfileByName_ :: Maybe GroupFeature -> GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse
@@ -70,7 +70,7 @@ import Simplex.Chat.Delivery (FeedJobAction (..))
 import Simplex.Chat.Store
 import Simplex.Chat.Store.ContactRequest
 import Simplex.Chat.Store.Direct
-import qualified Simplex.Chat.Store.Feeds as Store
+import Simplex.Chat.Store.Feeds
 import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Groups
 import Simplex.Chat.Store.Messages
@@ -529,9 +529,9 @@ itemsFilesInfo = mapMaybe itemFileInfo
      SMDSnd | isJust itemFeed -> Nothing
      _ -> mkCIFileInfo <$> file

-detachFeedInstances :: forall c. [CChatItem c] -> CM [CChatItem c]
-detachFeedInstances items = do
-  unless (null linkedIds) $ withStore' $ \db -> Store.detachFeedInstances db linkedIds
+detachFeedItems :: forall c. [CChatItem c] -> CM [CChatItem c]
+detachFeedItems items = do
+  unless (null linkedIds) $ withStore' $ \db -> detachFeedInstances db linkedIds
  pure $ map detached items
  where
    linkedIds = mapMaybe linkedItemId items
@@ -2270,13 +2270,17 @@ createSndMessage chatMsgEvent connOrGroupId =
  liftEither . runIdentity =<< lift (createSndMessages $ Identity (connOrGroupId, Nothing, chatMsgEvent))

 createSndMessages :: forall e t. (MsgEncodingI e, Traversable t) => t (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent e) -> CM' (t (Either ChatError SndMessage))
-createSndMessages = createSndMessages_ Nothing
-
-createFeedMessage :: Feed -> Maybe SharedMsgId -> ChatItemId -> ChatMsgEvent 'Json -> CM SndMessage
-createFeedMessage feed sharedMsgId_ feedItemId event = do
-  mkMsg <- feedMessageMaker
-  createdAt <- liftIO getCurrentTime
-  withStore $ \db -> mkMsg db feed sharedMsgId_ feedItemId event createdAt
+createSndMessages idsEvents = do
+  g <- asks random
+  vr <- chatVersionRange'
+  withStoreBatch $ \db -> fmap (createMsg db g vr) idsEvents
+  where
+    createMsg :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent e) -> IO (Either ChatError SndMessage)
+    createMsg db g vr (connOrGroupId, msgSigning_, evnt) = runExceptT $ do
+      withExceptT ChatErrorStore $ createNewSndMessage db g connOrGroupId Nothing evnt msgSigning_ encodeMessage
+      where
+        encodeMessage sharedMsgId =
+          encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr, msgId = Just sharedMsgId, chatMsgEvent = evnt}

 feedMessageMaker :: CM (DB.Connection -> Feed -> Maybe SharedMsgId -> ChatItemId -> ChatMsgEvent 'Json -> UTCTime -> ExceptT StoreError IO SndMessage)
 feedMessageMaker = do
@@ -2294,7 +2298,7 @@ createFeedFileDescrJobs feed feedItemId events = do
  createdAt <- liftIO getCurrentTime
  withStore $ \db -> do
    msgs <- mapM (\evt -> mkMsg db feed Nothing feedItemId evt createdAt) events
-    liftIO $ Store.createFeedJobs db (feedId' feed) feedItemId $ FJAFileDescr (L.map msgId' msgs)
+    liftIO $ createFeedJobs db (feedId' feed) feedItemId $ FJAFileDescr (L.map msgId' msgs)

 feedId' :: Feed -> FeedId
 feedId' Feed {feedId} = feedId
@@ -2305,19 +2309,6 @@ msgId' SndMessage {msgId} = msgId
 aFeedItem :: Feed -> CChatItem 'CTFeed -> AChatItem
 aFeedItem feed (CChatItem md ci) = AChatItem SCTFeed md (FeedChat feed) ci

-createSndMessages_ :: forall e t. (MsgEncodingI e, Traversable t) => Maybe SharedMsgId -> t (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent e) -> CM' (t (Either ChatError SndMessage))
-createSndMessages_ sharedMsgId_ idsEvents = do
-  g <- asks random
-  vr <- chatVersionRange'
-  withStoreBatch $ \db -> fmap (createMsg db g vr) idsEvents
-  where
-    createMsg :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent e) -> IO (Either ChatError SndMessage)
-    createMsg db g vr (connOrGroupId, msgSigning_, evnt) = runExceptT $ do
-      withExceptT ChatErrorStore $ createNewSndMessage db g connOrGroupId sharedMsgId_ evnt msgSigning_ encodeMessage
-      where
-        encodeMessage sharedMsgId =
-          encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr, msgId = Just sharedMsgId, chatMsgEvent = evnt}
-
 groupMsgSigning :: Bool -> GroupInfo -> ChatMsgEvent e -> Maybe MsgSigning
 groupMsgSigning sign GroupInfo {membership = GroupMember {memberId}, groupKeys} evt = case groupKeys of
  Just gks@GroupKeys {memberPrivKey} | shouldSign -> Just $ MsgSigning CBGroup bindingData KRMember memberPrivKey
@@ -4198,16 +4198,22 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
    user <- getUserByGroupId db groupId
    gInfo <- getGroupInfo db cxt user groupId
    pure (user, gInfo)
-  jobWorkerLoop delay doWork $
-    withWork_ a doWork (withStore' $ \db -> getNextDeliveryJob db deliveryKey) $ \job ->
-      processDeliveryJob cxt user gInfo job
-        `catchAllErrors` \e -> do
-          withStore' $ \db -> setDeliveryJobErrStatus db (deliveryJobId job) (tshow e)
-          eToView e
+  forever $ do
+    unless (delay == 0) $ liftIO $ threadDelay' delay
+    lift $ waitForWork doWork
+    runDeliveryJobOperation cxt user gInfo
  where
    (groupId, workerScope) = deliveryKey
-    processDeliveryJob :: StoreCxt -> User -> GroupInfo -> MessageDeliveryJob -> CM ()
-    processDeliveryJob cxt user gInfo job =
+    runDeliveryJobOperation :: StoreCxt -> User -> GroupInfo -> CM ()
+    runDeliveryJobOperation cxt user gInfo = do
+      withWork_ a doWork (withStore' $ \db -> getNextDeliveryJob db deliveryKey) $ \job ->
+        processDeliveryJob job
+          `catchAllErrors` \e -> do
+            withStore' $ \db -> setDeliveryJobErrStatus db (deliveryJobId job) (tshow e)
+            eToView e
+      where
+        processDeliveryJob :: MessageDeliveryJob -> CM ()
+        processDeliveryJob job =
          case jobScopeImpliedSpec jobScope of
            DJDeliveryJob _includePending
              | not (relayServesGroup gInfo) -> do
@@ -4382,12 +4388,6 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
                              Nothing -> VRValue Nothing msgBody -- sending to one member, do not reference body
                              Just 1 -> VRValue (Just 1) msgBody
                              Just _ -> VRRef 1
-jobWorkerLoop :: Int64 -> TMVar () -> CM () -> CM ()
-jobWorkerLoop delay doWork operation = forever $ do
-  unless (delay == 0) $ liftIO $ threadDelay' delay
-  lift $ waitForWork doWork
-  operation
-
 runFeedJobWorker :: AgentClient -> FeedJobKey -> Worker -> CM ()
 runFeedJobWorker a feedKey@(feedId, scope) Worker {doWork} = do
  delay <- asks $ deliveryWorkerDelay . config
@@ -4397,7 +4397,9 @@ runFeedJobWorker a feedKey@(feedId, scope) Worker {doWork} = do
    feed <- getFeed db user feedId
    pure (user, feed)
  bucketSize <- asks $ feedBucketSize . config
-  jobWorkerLoop delay doWork $
+  forever $ do
+    unless (delay == 0) $ liftIO $ threadDelay' delay
+    lift $ waitForWork doWork
    withWork_ a doWork (withStore' $ \db -> getNextFeedJob db feedKey) $ \job ->
      processFeedJob cxt user feed bucketSize job `catchAllErrors` jobError user feed job
  where
@@ -976,11 +976,12 @@ getContact_ db cxt user@User {userId} contactId deleted = do
      (userId, contactId, BI deleted)

 contactQuery :: Query
-contactQuery = "SELECT " <> contactQueryFields <> " " <> contactQueryFrom
+contactQuery = contactQueryFields <> " " <> contactQueryFrom

 contactQueryFields :: Query
 contactQueryFields =
  [sql|
+        SELECT
          -- Contact
          ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.description, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite, ct.drop_feed,
          cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id, cr2.rejection_supported,
@@ -111,12 +111,11 @@ deleteFeedCIs db User {userId} Feed {feedId} = do
 getFeedContactsByCursor :: DB.Connection -> StoreCxt -> User -> ChatItemId -> Maybe ContactId -> Int -> IO [(Contact, Maybe ChatItemId)]
 getFeedContactsByCursor db cxt user@User {userId} feedItemId cursorId_ count = do
  currentTs <- getCurrentTime
-  map (\(Only itemId_ :. row) -> (toContact currentTs cxt user [] row, itemId_))
+  map (\(row :. Only itemId_) -> (toContact currentTs cxt user [] row, itemId_))
    <$> DB.query
      db
-      ( "SELECT i.chat_item_id, "
-          <> contactQueryFields
-          <> " "
+      ( contactQueryFields
+          <> ", i.chat_item_id "
          <> contactQueryFrom
          <> " LEFT JOIN chat_items i ON i.feed_item_id = ? AND i.contact_id = ct.contact_id"
          <> " WHERE ct.user_id = ? AND ct.deleted = 0 AND ct.is_user = 0 AND ct.contact_id > ?"
@@ -127,12 +126,11 @@ getFeedContactsByCursor db cxt user@User {userId} feedItemId cursorId_ count = d
 getFeedCustomerGroupsByCursor :: DB.Connection -> StoreCxt -> User -> ChatItemId -> Maybe GroupId -> Int -> IO [(GroupInfo, Maybe ChatItemId)]
 getFeedCustomerGroupsByCursor db cxt User {userId, userContactId} feedItemId cursorId_ count = do
  currentTs <- getCurrentTime
-  map (\(Only itemId_ :. row) -> (toGroupInfo currentTs cxt userContactId [] row, itemId_))
+  map (\(row :. Only itemId_) -> (toGroupInfo currentTs cxt userContactId [] row, itemId_))
    <$> DB.query
      db
-      ( "SELECT i.chat_item_id, "
-          <> groupInfoQueryFields
-          <> " "
+      ( groupInfoQueryFields
+          <> ", i.chat_item_id "
          <> groupInfoQueryFrom
          <> " LEFT JOIN chat_items i ON i.feed_item_id = ? AND i.group_id = g.group_id"
          <> " WHERE g.user_id = ? AND mu.contact_id = ? AND g.business_chat = ? AND g.group_id > ?"
@@ -182,12 +180,11 @@ instanceSpecCond = \case
 getFeedContactInstancesByCursor :: DB.Connection -> StoreCxt -> User -> ChatItemId -> FeedJobAction -> Maybe ContactId -> Int -> IO [(Contact, ChatItemId)]
 getFeedContactInstancesByCursor db cxt user@User {userId} feedItemId spec cursorId_ count = do
  currentTs <- getCurrentTime
-  map (\(Only itemId :. row) -> (toContact currentTs cxt user [] row, itemId))
+  map (\(row :. Only itemId) -> (toContact currentTs cxt user [] row, itemId))
    <$> DB.query
      db
-      ( "SELECT i.chat_item_id, "
-          <> contactQueryFields
-          <> " "
+      ( contactQueryFields
+          <> ", i.chat_item_id "
          <> contactQueryFrom
          <> " JOIN chat_items i ON i.contact_id = ct.contact_id"
          <> " WHERE i.user_id = ? AND i.feed_item_id = ? AND i.contact_id > ?"
@@ -199,12 +196,11 @@ getFeedContactInstancesByCursor db cxt user@User {userId} feedItemId spec cursor
 getFeedGroupInstancesByCursor :: DB.Connection -> StoreCxt -> User -> ChatItemId -> FeedJobAction -> Maybe GroupId -> Int -> IO [(GroupInfo, ChatItemId)]
 getFeedGroupInstancesByCursor db cxt User {userId, userContactId} feedItemId spec cursorId_ count = do
  currentTs <- getCurrentTime
-  map (\(Only itemId :. row) -> (toGroupInfo currentTs cxt userContactId [] row, itemId))
+  map (\(row :. Only itemId) -> (toGroupInfo currentTs cxt userContactId [] row, itemId))
    <$> DB.query
      db
-      ( "SELECT i.chat_item_id, "
-          <> groupInfoQueryFields
-          <> " "
+      ( groupInfoQueryFields
+          <> ", i.chat_item_id "
          <> groupInfoQueryFrom
          <> " JOIN chat_items i ON i.group_id = g.group_id"
          <> " WHERE i.user_id = ? AND mu.contact_id = ? AND i.feed_item_id = ? AND i.group_id > ?"
@@ -47,7 +47,6 @@ module Simplex.Chat.Store.Messages
    insertChatItemMessage_,
    getFeedChat,
    getFeedChatItem,
-    getFeedCIReactions,
    getFeedChatItemIdByText,
    updateFeedChatItem',
    updateFeedChatItemStatus,
@@ -1346,20 +1345,21 @@ getDirectChatLast_ db user ct contentFilter count search = do
 safeGetDirectItem :: DB.Connection -> User -> Contact -> UTCTime -> ChatItemId -> IO (CChatItem 'CTDirect)
 safeGetDirectItem db user ct currentTs itemId =
  runExceptT (getDirectCIWithReactions db user ct itemId)
-    >>= pure <$> safeToChatItem CIDirectSnd currentTs itemId
+    >>= pure <$> safeToDirectItem currentTs itemId

-safeToChatItem :: CIDirection c 'MDSnd -> UTCTime -> ChatItemId -> Either StoreError (CChatItem c) -> CChatItem c
-safeToChatItem chatDir currentTs itemId = \case
+safeToDirectItem :: UTCTime -> ChatItemId -> Either StoreError (CChatItem 'CTDirect) -> CChatItem 'CTDirect
+safeToDirectItem currentTs itemId = \case
  Right ci -> ci
-  Left e@(SEBadChatItem _ (Just itemTs)) -> badChatItem itemTs e
-  Left e -> badChatItem currentTs e
+  Left e@(SEBadChatItem _ (Just itemTs)) -> badDirectItem itemTs e
+  Left e -> badDirectItem currentTs e
  where
-    badChatItem ts e =
+    badDirectItem :: UTCTime -> StoreError -> CChatItem 'CTDirect
+    badDirectItem ts e =
      let errorText = T.pack $ show e
       in CChatItem
            SMDSnd
            ChatItem
-              { chatDir,
+              { chatDir = CIDirectSnd,
                meta = dummyMeta itemId ts errorText,
                content = CIInvalidJSON errorText,
                mentions = M.empty,
@@ -1697,7 +1697,29 @@ getChatItemIDs db User {userId} cInfo contentFilter range count search = case cI
 safeGetGroupItem :: DB.Connection -> User -> GroupInfo -> UTCTime -> ChatItemId -> IO (CChatItem 'CTGroup)
 safeGetGroupItem db user g currentTs itemId =
  runExceptT (getGroupCIWithReactions db user g itemId)
-    >>= pure <$> safeToChatItem CIGroupSnd currentTs itemId
+    >>= pure <$> safeToGroupItem currentTs itemId
+
+safeToGroupItem :: UTCTime -> ChatItemId -> Either StoreError (CChatItem 'CTGroup) -> CChatItem 'CTGroup
+safeToGroupItem currentTs itemId = \case
+  Right ci -> ci
+  Left e@(SEBadChatItem _ (Just itemTs)) -> badGroupItem itemTs e
+  Left e -> badGroupItem currentTs e
+  where
+    badGroupItem :: UTCTime -> StoreError -> CChatItem 'CTGroup
+    badGroupItem ts e =
+      let errorText = T.pack $ show e
+       in CChatItem
+            SMDSnd
+            ChatItem
+              { chatDir = CIGroupSnd,
+                meta = dummyMeta itemId ts errorText,
+                content = CIInvalidJSON errorText,
+                mentions = M.empty,
+                formattedText = Nothing,
+                quotedItem = Nothing,
+                reactions = [],
+                file = Nothing
+              }

 getGroupMemberChatItemLast :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO (CChatItem 'CTGroup)
 getGroupMemberChatItemLast db user@User {userId} groupId groupMemberId = do
@@ -1915,7 +1937,29 @@ getLocalChatLast_ db user nf contentFilter count search = do
 safeGetLocalItem :: DB.Connection -> User -> NoteFolder -> UTCTime -> ChatItemId -> IO (CChatItem 'CTLocal)
 safeGetLocalItem db user NoteFolder {noteFolderId} currentTs itemId =
  runExceptT (getLocalChatItem db user noteFolderId itemId)
-    >>= pure <$> safeToChatItem CILocalSnd currentTs itemId
+    >>= pure <$> safeToLocalItem currentTs itemId
+
+safeToLocalItem :: UTCTime -> ChatItemId -> Either StoreError (CChatItem 'CTLocal) -> CChatItem 'CTLocal
+safeToLocalItem currentTs itemId = \case
+  Right ci -> ci
+  Left e@(SEBadChatItem _ (Just itemTs)) -> badLocalItem itemTs e
+  Left e -> badLocalItem currentTs e
+  where
+    badLocalItem :: UTCTime -> StoreError -> CChatItem 'CTLocal
+    badLocalItem ts e =
+      let errorText = T.pack $ show e
+       in CChatItem
+            SMDSnd
+            ChatItem
+              { chatDir = CILocalSnd,
+                meta = dummyMeta itemId ts errorText,
+                content = CIInvalidJSON errorText,
+                mentions = M.empty,
+                formattedText = Nothing,
+                quotedItem = Nothing,
+                reactions = [],
+                file = Nothing
+              }

 getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal)
 getLocalChatAfter_ db user nf@NoteFolder {noteFolderId} contentFilter afterId count search = do
@@ -3385,7 +3429,29 @@ getFeedCIReactions db User {userId} itemSharedMsgId =
 safeGetFeedItem :: DB.Connection -> User -> Feed -> UTCTime -> ChatItemId -> IO (CChatItem 'CTFeed)
 safeGetFeedItem db user Feed {feedId} currentTs itemId =
  runExceptT (getFeedChatItem db user feedId itemId)
-    >>= pure <$> safeToChatItem CIFeedSnd currentTs itemId
+    >>= pure <$> safeToFeedItem currentTs itemId
+
+safeToFeedItem :: UTCTime -> ChatItemId -> Either StoreError (CChatItem 'CTFeed) -> CChatItem 'CTFeed
+safeToFeedItem currentTs itemId = \case
+  Right ci -> ci
+  Left e@(SEBadChatItem _ (Just itemTs)) -> badFeedItem itemTs e
+  Left e -> badFeedItem currentTs e
+  where
+    badFeedItem :: UTCTime -> StoreError -> CChatItem 'CTFeed
+    badFeedItem ts e =
+      let errorText = T.pack $ show e
+       in CChatItem
+            SMDSnd
+            ChatItem
+              { chatDir = CIFeedSnd,
+                meta = dummyMeta itemId ts errorText,
+                content = CIInvalidJSON errorText,
+                mentions = M.empty,
+                formattedText = Nothing,
+                quotedItem = Nothing,
+                reactions = [],
+                file = Nothing
+              }

 getFeedChat :: DB.Connection -> User -> FeedId -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTFeed, Maybe NavigationInfo)
 getFeedChat db user feedId contentFilter pagination search_ = do
@@ -799,11 +799,12 @@ toBusinessChatInfo businessDomain (Just chatType, Just businessId, Just customer
 toBusinessChatInfo _ _ = Nothing

 groupInfoQuery :: Query
-groupInfoQuery = "SELECT " <> groupInfoQueryFields <> " " <> groupInfoQueryFrom
+groupInfoQuery = groupInfoQueryFields <> " " <> groupInfoQueryFrom

 groupInfoQueryFields :: Query
 groupInfoQueryFields =
  [sql|
+    SELECT
      -- GroupInfo
      g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, gp.description, gp.image, gp.group_type, gp.group_link, gp.public_group_id,
      gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding, gp.group_domain_proof,