lovely-projects/simplex-chat
lovely-projects/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-03-14 09:45:42 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

core: fix validation of operator servers for non current users (#5205)

Browse source 
* core: fix validation of operator servers for non current users

* style

* refactor

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
This commit is contained in:
spaced4ndy 2024-11-19 00:22:35 +04:00 • committed by GitHub
parent 619985730e
commit fcae5e9925
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
3 changed files with 13 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
src/Simplex/Chat.hs
View file

@ -1611,7 +1611,7 @@ processChatCommand' vr = \case
srvs' <- mapM aUserServer srvs
processChatCommand $ APISetUserServers userId $ L.map (updatedServers p srvs') userServers
where
aUserServer :: AProtoServerWithAuth -> CM (AUserServer p)
aUserServer :: AProtoServerWithAuth -> CM (AUserServer p)
aUserServer (AProtoServerWithAuth p' srv) = case testEquality p p' of
Just Refl -> pure $ AUS SDBNew $ newUserServer srv
Nothing -> throwChatError $ CECommandError $ "incorrect server protocol: " <> B.unpack (strEncode srv)
@ -2949,8 +2949,17 @@ processChatCommand' vr = \case
validateAllUsersServers :: UserServersClass u => Int64 -> [u] -> CM [UserServersError]
validateAllUsersServers currUserId userServers = withFastStore $ \db -> do
users' <- filter (\User {userId} -> userId /= currUserId) <$> liftIO (getUsers db)
others <- mapM (\user -> liftIO . fmap (user,) . groupByOperator =<< getUserServers db user) users'
others <- mapM (getUserOperatorServers db) users'
pure $ validateUserServers userServers others
where
getUserOperatorServers :: DB.Connection -> User -> ExceptT StoreError IO (User, [UserOperatorServers])
getUserOperatorServers db user = do
uss <- liftIO . groupByOperator =<< getUserServers db user
pure (user, map updatedUserServers uss)
updatedUserServers uss = uss {operator = updatedOp <$> operator' uss} :: UserOperatorServers
updatedOp op = fromMaybe op $ find matchingOp $ mapMaybe operator' userServers
where
matchingOp op' = operatorId op' == operatorId op
forwardFile :: ChatName -> FileTransferId -> (ChatName -> CryptoFile -> ChatCommand) -> CM ChatResponse
forwardFile chatName fileId sendCommand = withUser $ \user -> do
withStore (\db -> getFileTransfer db user fileId) >>= \case

2
src/Simplex/Chat/Operators.hs
View file

@ -89,6 +89,8 @@ data DBEntityId' (s :: DBStored) where
deriving instance Show (DBEntityId' s)
deriving instance Eq (DBEntityId' s)
type DBEntityId = DBEntityId' 'DBStored
type DBNewEntity = DBEntityId' 'DBNew

2
tests/RandomServers.hs
View file

@ -29,8 +29,6 @@ randomServersTests = describe "choosig random servers" $ do
deriving instance Eq ServerRoles
deriving instance Eq (DBEntityId' s)
deriving instance Eq (UserServer' s p)
testRandomSMPServers :: IO ()