dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-11 13:15:05 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into master-ghc8107

Browse Source
This commit is contained in:
Evgeny Poberezkin
2023-11-26 18:53:40 +00:00
parent 5cc537f14c d29f1bb0cf
commit b8da5e225b
44 changed files with 704 additions and 636 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Store/Profiles.hs
+27 -25
View File
@@ -8,6 +8,7 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Profiles
( AutoAccept (..),
@@ -63,9 +64,9 @@ import Control.Monad.IO.Class
import qualified Data.Aeson.TH as J
import Data.Functor (($>))
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Maybe (fromMaybe)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
@@ -86,7 +87,7 @@ import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON)
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode)
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (safeDecodeUtf8, eitherToMaybe)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User
createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime
@@ -245,19 +246,19 @@ updateUserGroupReceipts db User {userId} UserMsgReceiptSettings {enable, clearOv
updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User
updateUserProfile db user p'
| displayName == newName = do
liftIO $ updateContactProfile_ db userId profileId p'
pure user {profile, fullPreferences}
liftIO $ updateContactProfile_ db userId profileId p'
pure user {profile, fullPreferences}
| otherwise =
checkConstraint SEDuplicateName . liftIO $ do
currentTs <- getCurrentTime
DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newName, currentTs, userId)
DB.execute
db
"INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(newName, newName, userId, currentTs, currentTs)
updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId userContactId localDisplayName newName currentTs
pure user {localDisplayName = newName, profile, fullPreferences}
checkConstraint SEDuplicateName . liftIO $ do
currentTs <- getCurrentTime
DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newName, currentTs, userId)
DB.execute
db
"INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(newName, newName, userId, currentTs, currentTs)
updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId userContactId localDisplayName newName currentTs
pure user {localDisplayName = newName, profile, fullPreferences}
where
User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}} = user
Profile {displayName = newName, preferences} = p'
@@ -454,17 +455,18 @@ getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) =
getContactWithoutConnViaAddress :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
getContactWithoutConnViaAddress db user@User {userId} (cReqSchema1, cReqSchema2) = do
ctId_ <- maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT ct.contact_id
FROM contacts ct
JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
LEFT JOIN connections c ON c.contact_id = ct.contact_id
WHERE cp.user_id = ? AND cp.contact_link IN (?,?) AND c.connection_id IS NULL
|]
(userId, cReqSchema1, cReqSchema2)
ctId_ <-
maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT ct.contact_id
FROM contacts ct
JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
LEFT JOIN connections c ON c.contact_id = ct.contact_id
WHERE cp.user_id = ? AND cp.contact_link IN (?,?) AND c.connection_id IS NULL
|]
(userId, cReqSchema1, cReqSchema2)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) ctId_
updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink