@@ -1156,9 +1156,10 @@ client
11561156 ms
11571157 clnt@ Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} = do
11581158 labelMyThread . B. unpack $ " client $" <> encode sessionId <> " commands"
1159+ let THandleParams {thVersion} = thParams'
11591160 forever $
11601161 atomically (readTBQueue rcvQ)
1161- >>= mapM processCommand
1162+ >>= mapM ( processCommand thVersion)
11621163 >>= mapM_ reply . L. nonEmpty . catMaybes . L. toList
11631164 where
11641165 reply :: MonadIO m => NonEmpty (Transmission BrokerMsg ) -> m ()
@@ -1243,8 +1244,8 @@ client
12431244 mkIncProxyStats ps psOwn own sel = do
12441245 incStat $ sel ps
12451246 when own $ incStat $ sel psOwn
1246- processCommand :: (Maybe (StoreQueue s , QueueRec ), Transmission Cmd ) -> M (Maybe (Transmission BrokerMsg ))
1247- processCommand (q_, (corrId, entId, cmd)) = case cmd of
1247+ processCommand :: VersionSMP -> (Maybe (StoreQueue s , QueueRec ), Transmission Cmd ) -> M (Maybe (Transmission BrokerMsg ))
1248+ processCommand clntVersion (q_, (corrId, entId, cmd)) = case cmd of
12481249 Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
12491250 Cmd SSender command -> Just <$> case command of
12501251 SKEY sKey ->
@@ -1506,7 +1507,7 @@ client
15061507
15071508 sendMessage :: MsgFlags -> MsgBody -> StoreQueue s -> QueueRec -> M (Transmission BrokerMsg )
15081509 sendMessage msgFlags msgBody q qr
1509- | B. length msgBody > maxMessageLength thVersion = do
1510+ | B. length msgBody > maxMessageLength clntVersion = do
15101511 stats <- asks serverStats
15111512 incStat $ msgSentLarge stats
15121513 pure $ err LARGE_MSG
@@ -1545,7 +1546,6 @@ client
15451546 liftIO $ updatePeriodStats (activeQueues stats) (recipientId qr)
15461547 pure ok
15471548 where
1548- THandleParams {thVersion} = thParams'
15491549 mkMessage :: MsgId -> C. MaxLenBS MaxMessageLen -> IO Message
15501550 mkMessage msgId body = do
15511551 msgTs <- getSystemTime
@@ -1654,7 +1654,7 @@ client
16541654 Left r -> pure r
16551655 -- rejectOrVerify filters allowed commands, no need to repeat it here.
16561656 -- INTERNAL is used because processCommand never returns Nothing for sender commands (could be extracted for better types).
1657- Right t''@ (_, (corrId', entId', _)) -> fromMaybe (corrId', entId', ERR INTERNAL ) <$> lift (processCommand t'')
1657+ Right t''@ (_, (corrId', entId', _)) -> fromMaybe (corrId', entId', ERR INTERNAL ) <$> lift (processCommand fwdVersion t'')
16581658 -- encode response
16591659 r' <- case batchTransmissions (batch clntTHParams) (blockSize clntTHParams) [Right (Nothing , encodeTransmission clntTHParams r)] of
16601660 [] -> throwE INTERNAL -- at least 1 item is guaranteed from NonEmpty/Right
0 commit comments