mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +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
|
||||
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
Loading…
Add table
Reference in a new issue