smp server: remove dependency of message size on the version (#1627)

This commit is contained in:
Evgeny
2025-09-08 11:28:42 +01:00
committed by GitHub
parent 42a2c1fc57
commit 8fea15245a
5 changed files with 16 additions and 23 deletions
+4 -9
View File
@@ -292,18 +292,13 @@ currentSMPClientVersion = VersionSMPC 4
supportedSMPClientVRange :: VersionRangeSMPC
supportedSMPClientVRange = mkVersionRange initialSMPClientVersion currentSMPClientVersion
-- TODO v6.0 remove dependency on version
maxMessageLength :: VersionSMP -> Int
maxMessageLength v
| v >= encryptedBlockSMPVersion = 16048 -- max 16048
| v >= sendingProxySMPVersion = 16064 -- max 16067
| otherwise = 16088 -- 16048 - always use this size to determine allowed ranges
maxMessageLength :: Int
maxMessageLength = 16048
paddedProxiedTLength :: Int
paddedProxiedTLength = 16226 -- 16225 .. 16227
-- TODO v7.0 change to 16048
type MaxMessageLen = 16088
type MaxMessageLen = 16048
-- 16 extra bytes: 8 for timestamp and 8 for flags (7 flags and the space, only 1 flag is currently used)
type MaxRcvMessageLen = MaxMessageLen + 16 -- 16104, the padded size is 16106
@@ -1477,7 +1472,7 @@ data ErrorType
STORE {storeErr :: Text}
| -- | ACK command is sent without message to be acknowledged
NO_MSG
| -- | sent message is too large (> maxMessageLength = 16088 bytes)
| -- | sent message is too large (> maxMessageLength = 16048 bytes)
LARGE_MSG
| -- | relay public key is expired
EXPIRED
+6 -7
View File
@@ -1349,11 +1349,10 @@ client
ms
clnt@Client {clientId, ntfSubscriptions, ntfServiceSubscribed, serviceSubsCount = _todo', ntfServiceSubsCount, rcvQ, sndQ, clientTHParams = thParams'@THandleParams {sessionId}, procThreads} = do
labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
let THandleParams {thVersion} = thParams'
clntServiceId = (\THClientService {serviceId} -> serviceId) <$> (peerClientService =<< thAuth thParams')
let clntServiceId = (\THClientService {serviceId} -> serviceId) <$> (peerClientService =<< thAuth thParams')
process t acc@(rs, msgs) =
(maybe acc (\(!r, !msg_) -> (r : rs, maybe msgs (: msgs) msg_)))
<$> processCommand clntServiceId thVersion t
<$> processCommand clntServiceId t
forever $
atomically (readTBQueue rcvQ)
>>= foldrM process ([], [])
@@ -1439,8 +1438,8 @@ client
mkIncProxyStats ps psOwn own sel = do
incStat $ sel ps
when own $ incStat $ sel psOwn
processCommand :: Maybe ServiceId -> VersionSMP -> VerifiedTransmission s -> M s (Maybe ResponseAndMessage)
processCommand clntServiceId clntVersion (q_, (corrId, entId, cmd)) = case cmd of
processCommand :: Maybe ServiceId -> VerifiedTransmission s -> M s (Maybe ResponseAndMessage)
processCommand clntServiceId (q_, (corrId, entId, cmd)) = case cmd of
Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
Cmd SSender command -> case command of
SKEY k -> withQueue $ \q qr -> checkMode QMMessaging qr $ secureQueue_ q k
@@ -1829,7 +1828,7 @@ client
sendMessage :: MsgFlags -> MsgBody -> StoreQueue s -> QueueRec -> M s (Transmission BrokerMsg)
sendMessage msgFlags msgBody q qr
| B.length msgBody > maxMessageLength clntVersion = do
| B.length msgBody > maxMessageLength = do
stats <- asks serverStats
incStat $ msgSentLarge stats
pure $ err LARGE_MSG
@@ -1982,7 +1981,7 @@ client
-- rejectOrVerify filters allowed commands, no need to repeat it here.
-- INTERNAL is used because processCommand never returns Nothing for sender commands (could be extracted for better types).
-- `fst` removes empty message that is only returned for `SUB` command
Right t''@(_, (corrId', entId', _)) -> maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing fwdVersion t'')
Right t''@(_, (corrId', entId', _)) -> maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing t'')
-- encode response
r' <- case batchTransmissions clntTHParams [Right (Nothing, encodeTransmission clntTHParams r)] of
[] -> throwE INTERNAL -- at least 1 item is guaranteed from NonEmpty/Right