From 82c7ce694d106a3ce2ab25ffee3037defe356c9f Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 6 Jun 2026 08:33:18 +0100 Subject: [PATCH] refactor --- src/Simplex/Chat/Badges.hs | 9 +++++---- src/Simplex/Chat/Store/ContactRequest.hs | 12 +++++------- src/Simplex/Chat/Store/Direct.hs | 15 ++++++--------- src/Simplex/Chat/Store/Groups.hs | 6 ++---- src/Simplex/Chat/Store/Shared.hs | 3 +-- 5 files changed, 19 insertions(+), 26 deletions(-) diff --git a/src/Simplex/Chat/Badges.hs b/src/Simplex/Chat/Badges.hs index e636f931af..6be7d9d8b4 100644 --- a/src/Simplex/Chat/Badges.hs +++ b/src/Simplex/Chat/Badges.hs @@ -221,17 +221,18 @@ instance FromField BadgeType where fromField = fromTextField_ textDecode instance ToField BadgeType where toField = toField . textEncode -type BadgeRow = (Maybe ByteString, Maybe ByteString, Maybe UTCTime, Maybe Text, BoolInt) +type BadgeRow = (Maybe ByteString, Maybe ByteString, Maybe UTCTime, Maybe Text, Maybe BoolInt) badgeToRow :: Maybe SupporterBadge -> Bool -> BadgeRow badgeToRow (Just SupporterBadge {proof = BBSProof p, presHeader = BBSPresHeader ph, badgeExpiry, badgeType}) verified = - (Just p, Just ph, badgeExpiry, Just (textEncode badgeType), BI verified) -badgeToRow _ _ = (Nothing, Nothing, Nothing, Nothing, BI False) + (Just p, Just ph, badgeExpiry, Just (textEncode badgeType), Just (BI verified)) +badgeToRow _ _ = (Nothing, Nothing, Nothing, Nothing, Just (BI False)) rowToBadge :: UTCTime -> BadgeRow -> Maybe LocalBadge -rowToBadge now (Just p, Just ph, badgeExpiry, Just btText, (BI verified)) = do +rowToBadge now (Just p, Just ph, badgeExpiry, Just btText, verified_) = do bt <- textDecode btText let b = SupporterBadge {proof = BBSProof p, presHeader = BBSPresHeader ph, badgeExpiry, badgeType = bt} + verified = maybe False unBI verified_ Just LocalBadge {badgeStatus = mkBadgeStatus now verified b, badge = b} rowToBadge _ _ = Nothing diff --git a/src/Simplex/Chat/Store/ContactRequest.hs b/src/Simplex/Chat/Store/ContactRequest.hs index a416855cc2..a658ec0ba7 100644 --- a/src/Simplex/Chat/Store/ContactRequest.hs +++ b/src/Simplex/Chat/Store/ContactRequest.hs @@ -162,13 +162,12 @@ createOrUpdateContactRequest createContactRequest = do currentTs <- liftIO $ getCurrentTime badgeVerified <- liftIO $ verifyBadge_ srvBadgePublicKey badge - let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified ExceptT $ withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do liftIO $ DB.execute db "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)" - ((displayName, fullName, shortDescr, image, contactLink, userId, preferences, currentTs, currentTs) :. (bProof, bPresHeader, bExpiry, bType, bVerified)) + ((displayName, fullName, shortDescr, image, contactLink, userId, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified) profileId <- liftIO $ insertedRowId db liftIO $ DB.execute @@ -222,15 +221,14 @@ createOrUpdateContactRequest updateContactRequest :: UserContactRequest -> ExceptT StoreError IO RequestStage updateContactRequest ucr@UserContactRequest {contactRequestId, contactId_, localDisplayName = oldLdn, profile = Profile {displayName = oldDisplayName}} = do currentTs <- liftIO getCurrentTime - badgeVerified <- liftIO $ verifyBadge_ srvBadgePublicKey badge - let badgeRow = badgeToRow badge badgeVerified - liftIO $ updateProfile currentTs badgeRow + liftIO $ updateProfile currentTs updateRequest currentTs ucr' <- getContactRequest db user contactRequestId re_ <- getRequestEntity ucr' pure $ RSCurrentRequest (Just ucr) ucr' re_ where - updateProfile currentTs (bProof, bPresHeader, bExpiry, bType, bVerified) = + updateProfile currentTs = do + badgeVerified <- liftIO $ verifyBadge_ srvBadgePublicKey badge DB.execute db [sql| @@ -253,7 +251,7 @@ createOrUpdateContactRequest AND contact_request_id = ? ) |] - ((displayName, fullName, shortDescr, image, contactLink, currentTs) :. (bProof, bPresHeader, bExpiry, bType, bVerified) :. (userId, contactRequestId)) + ((displayName, fullName, shortDescr, image, contactLink, currentTs) :. badgeToRow badge badgeVerified :. (userId, contactRequestId)) updateRequest currentTs = if displayName == oldDisplayName then diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index d628fcef8b..afa462de96 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -706,8 +706,7 @@ updateContactProfile_ db userId profileId profile badgeVerified = do updateContactProfile_' db userId profileId profile badgeVerified currentTs updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> UTCTime -> IO () -updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge} badgeVerified updatedAt = do - let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified +updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge} badgeVerified updatedAt = DB.execute db [sql| @@ -716,7 +715,7 @@ updateContactProfile_' db userId profileId Profile {displayName, fullName, short badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ? WHERE user_id = ? AND contact_profile_id = ? |] - ((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. (bProof, bPresHeader, bExpiry, bType, bVerified) :. (userId, profileId)) + ((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. (userId, profileId)) -- update only member profile fields (when member doesn't have associated contact - we can reset contactLink and prefs) updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> IO () @@ -725,8 +724,7 @@ updateMemberContactProfileReset_ db userId profileId profile badgeVerified = do updateMemberContactProfileReset_' db userId profileId profile badgeVerified currentTs updateMemberContactProfileReset_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> UTCTime -> IO () -updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image, badge} badgeVerified updatedAt = do - let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified +updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image, badge} badgeVerified updatedAt = DB.execute db [sql| @@ -735,7 +733,7 @@ updateMemberContactProfileReset_' db userId profileId Profile {displayName, full badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ? WHERE user_id = ? AND contact_profile_id = ? |] - ((displayName, fullName, shortDescr, image, updatedAt) :. (bProof, bPresHeader, bExpiry, bType, bVerified) :. (userId, profileId)) + ((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. (userId, profileId)) -- update only member profile fields (when member has associated contact - we keep contactLink and prefs) updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> IO () @@ -744,8 +742,7 @@ updateMemberContactProfile_ db userId profileId profile badgeVerified = do updateMemberContactProfile_' db userId profileId profile badgeVerified currentTs updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Bool -> UTCTime -> IO () -updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, badge} badgeVerified updatedAt = do - let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified +updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, badge} badgeVerified updatedAt = DB.execute db [sql| @@ -754,7 +751,7 @@ updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ? WHERE user_id = ? AND contact_profile_id = ? |] - ((displayName, fullName, shortDescr, image, updatedAt) :. (bProof, bPresHeader, bExpiry, bType, bVerified) :. (userId, profileId)) + ((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. (userId, profileId)) updateContactLDN_ :: DB.Connection -> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO () updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt = do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 9fd00bb900..8a874bec10 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -1730,13 +1730,12 @@ createJoiningMember memberKey_ = do currentTs <- liftIO getCurrentTime badgeVerified <- liftIO $ verifyBadge_ srvBadgePublicKey badge - let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do liftIO $ DB.execute db "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)" - ((displayName, fullName, shortDescr, image, contactLink, userId, preferences, currentTs, currentTs) :. (bProof, bPresHeader, bExpiry, bType, bVerified)) + ((displayName, fullName, shortDescr, image, contactLink, userId, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified) profileId <- liftIO $ insertedRowId db case cReqMemberId_ of Just memberId -> do @@ -2094,11 +2093,10 @@ createNewMemberProfile_ :: DB.Connection -> User -> Profile -> UTCTime -> Except createNewMemberProfile_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, badge, preferences} createdAt = ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do badgeVerified <- verifyBadge_ srvBadgePublicKey badge - let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified DB.execute db "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)" - ((displayName, fullName, shortDescr, image, contactLink, userId, preferences, createdAt, createdAt) :. (bProof, bPresHeader, bExpiry, bType, bVerified)) + ((displayName, fullName, shortDescr, image, contactLink, userId, preferences, createdAt, createdAt) :. badgeToRow badge badgeVerified) profileId <- insertedRowId db pure $ Right (ldn, profileId) diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index d61724e59a..deacba9dc5 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -416,11 +416,10 @@ createContact_ :: DB.Connection -> User -> Profile -> Preferences -> Maybe (ACre createContact_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs = ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do badgeVerified <- verifyBadge_ srvBadgePublicKey badge - let (bProof, bPresHeader, bExpiry, bType, bVerified) = badgeToRow badge badgeVerified DB.execute db "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" - ((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. (bProof, bPresHeader, bExpiry, bType, bVerified)) + ((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified) profileId <- insertedRowId db DB.execute db