mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 20:29:53 +00:00
core: fix validation of operator servers for non current users (#5205)
* 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:
parent
619985730e
commit
fcae5e9925
3 changed files with 13 additions and 4 deletions
|
@ -1611,7 +1611,7 @@ processChatCommand' vr = \case
|
||||||
srvs' <- mapM aUserServer srvs
|
srvs' <- mapM aUserServer srvs
|
||||||
processChatCommand $ APISetUserServers userId $ L.map (updatedServers p srvs') userServers
|
processChatCommand $ APISetUserServers userId $ L.map (updatedServers p srvs') userServers
|
||||||
where
|
where
|
||||||
aUserServer :: AProtoServerWithAuth -> CM (AUserServer p)
|
aUserServer :: AProtoServerWithAuth -> CM (AUserServer p)
|
||||||
aUserServer (AProtoServerWithAuth p' srv) = case testEquality p p' of
|
aUserServer (AProtoServerWithAuth p' srv) = case testEquality p p' of
|
||||||
Just Refl -> pure $ AUS SDBNew $ newUserServer srv
|
Just Refl -> pure $ AUS SDBNew $ newUserServer srv
|
||||||
Nothing -> throwChatError $ CECommandError $ "incorrect server protocol: " <> B.unpack (strEncode 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 :: UserServersClass u => Int64 -> [u] -> CM [UserServersError]
|
||||||
validateAllUsersServers currUserId userServers = withFastStore $ \db -> do
|
validateAllUsersServers currUserId userServers = withFastStore $ \db -> do
|
||||||
users' <- filter (\User {userId} -> userId /= currUserId) <$> liftIO (getUsers db)
|
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
|
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 -> FileTransferId -> (ChatName -> CryptoFile -> ChatCommand) -> CM ChatResponse
|
||||||
forwardFile chatName fileId sendCommand = withUser $ \user -> do
|
forwardFile chatName fileId sendCommand = withUser $ \user -> do
|
||||||
withStore (\db -> getFileTransfer db user fileId) >>= \case
|
withStore (\db -> getFileTransfer db user fileId) >>= \case
|
||||||
|
|
|
@ -89,6 +89,8 @@ data DBEntityId' (s :: DBStored) where
|
||||||
|
|
||||||
deriving instance Show (DBEntityId' s)
|
deriving instance Show (DBEntityId' s)
|
||||||
|
|
||||||
|
deriving instance Eq (DBEntityId' s)
|
||||||
|
|
||||||
type DBEntityId = DBEntityId' 'DBStored
|
type DBEntityId = DBEntityId' 'DBStored
|
||||||
|
|
||||||
type DBNewEntity = DBEntityId' 'DBNew
|
type DBNewEntity = DBEntityId' 'DBNew
|
||||||
|
|
|
@ -29,8 +29,6 @@ randomServersTests = describe "choosig random servers" $ do
|
||||||
|
|
||||||
deriving instance Eq ServerRoles
|
deriving instance Eq ServerRoles
|
||||||
|
|
||||||
deriving instance Eq (DBEntityId' s)
|
|
||||||
|
|
||||||
deriving instance Eq (UserServer' s p)
|
deriving instance Eq (UserServer' s p)
|
||||||
|
|
||||||
testRandomSMPServers :: IO ()
|
testRandomSMPServers :: IO ()
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue