refactor: replace smpDecode with decodeHandshake for improved handshake processing

src/Simplex/FileTransfer/Client.hs

@@ -73,7 +73,7 @@ import Simplex.Messaging.Client
   )
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
-import Simplex.Messaging.Encoding (smpDecode, smpEncode)
+import Simplex.Messaging.Encoding (smpEncode)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
   ( BasicAuth,
@@ -167,7 +167,7 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
       let helloReq = H.requestNoBody "POST" "/" []
       HTTP2Response {respBody = HTTP2Body {bodyHead = shsBody}} <-
         liftError' xftpClientError $ sendRequest c helloReq Nothing
-      liftTransportErr (TEHandshake PARSE) . smpDecode =<< liftTransportErr TEBadBlock (C.unPad shsBody)
+      liftTransportErr (TEHandshake PARSE) . decodeHandshake =<< liftTransportErr TEBadBlock (C.unPad shsBody)
     processServerHandshake :: XFTPServerHandshake -> ExceptT XFTPClientError IO (VersionRangeXFTP, C.PublicKeyX25519)
     processServerHandshake XFTPServerHandshake {xftpVersionRange, sessionId = serverSessId, authPubKey = serverAuth} = do
       unless (sessionId == serverSessId) $ throwE $ PCETransportError TEBadSession

src/Simplex/FileTransfer/Server.hs

@@ -191,7 +191,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
               | B.null bodyHead -> pure Nothing
               | sniUsed -> do
                   body <- liftHS $ C.unPad bodyHead
-                  XFTPClientHello {webChallenge} <- liftHS $ first show (smpDecode body)
+                  XFTPClientHello {webChallenge} <- liftHS $ first show (decodeHandshake body)
                   pure webChallenge
               | otherwise -> throwE HANDSHAKE
           rng <- asks random
@@ -212,7 +212,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
         processClientHandshake pk = do
           unless (B.length bodyHead == xftpBlockSize) $ throwE HANDSHAKE
           body <- liftHS $ C.unPad bodyHead
-          XFTPClientHandshake {xftpVersion = v, keyHash} <- liftHS $ smpDecode body
+          XFTPClientHandshake {xftpVersion = v, keyHash} <- liftHS $ decodeHandshake body
           kh <- asks serverIdentity
           unless (keyHash == kh) $ throwE HANDSHAKE
           case compatibleVRange' xftpServerVRange v of

src/Simplex/FileTransfer/Transport.hs

@@ -20,6 +20,7 @@ module Simplex.FileTransfer.Transport
     XFTPServerHandshake (..),
     -- xftpServerHandshake,
     XFTPClientHello (..),
+    decodeHandshake,
     THandleXFTP,
     THandleParamsXFTP,
     VersionXFTP,
@@ -139,7 +140,6 @@ instance Encoding XFTPClientHello where
   smpP = do
     webChallenge <- smpP
     forM_ webChallenge $ \challenge -> unless (B.length challenge == 32) $ fail "bad XFTPClientHello webChallenge"
-    Tail _compat <- smpP
     pure XFTPClientHello {webChallenge}
 
 instance Encoding XFTPClientHandshake where
@@ -147,7 +147,6 @@ instance Encoding XFTPClientHandshake where
     smpEncode (xftpVersion, keyHash)
   smpP = do
     (xftpVersion, keyHash) <- smpP
-    Tail _compat <- smpP
     pure XFTPClientHandshake {xftpVersion, keyHash}
 
 instance Encoding XFTPServerHandshake where
@@ -156,9 +155,12 @@ instance Encoding XFTPServerHandshake where
   smpP = do
     (xftpVersionRange, sessionId, authPubKey) <- smpP
     webIdentityProof <- optional $ C.decodeSignature <$?> smpP
-    Tail _compat <- smpP
     pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey, webIdentityProof}
 
+-- Decodes handshake block ignoring any trailing bytes, to allow adding fields in future versions (as SMP handshake does).
+decodeHandshake :: Encoding a => ByteString -> Either String a
+decodeHandshake = A.parseOnly smpP
+
 sendEncFile :: Handle -> (Builder -> IO ()) -> LC.SbState -> Word32 -> IO ()
 sendEncFile h send = go
   where

tests/XFTPServerTests.hs

@@ -32,7 +32,7 @@ import Simplex.FileTransfer.Client
 import Simplex.FileTransfer.Description (kb)
 import Simplex.FileTransfer.Protocol (FileInfo (..), XFTPFileId, xftpBlockSize)
 import Simplex.FileTransfer.Server.Env (AFStoreType, XFTPServerConfig (..))
-import Simplex.FileTransfer.Transport (XFTPClientHandshake (..), XFTPClientHello (..), XFTPErrorType (..), XFTPRcvChunkSpec (..), XFTPServerHandshake (..), pattern VersionXFTP)
+import Simplex.FileTransfer.Transport (XFTPClientHandshake (..), XFTPClientHello (..), XFTPErrorType (..), XFTPRcvChunkSpec (..), XFTPServerHandshake (..), decodeHandshake, pattern VersionXFTP)
 import Simplex.Messaging.Client (ProtocolClientError (..))
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
@@ -85,6 +85,7 @@ xftpServerTests =
       it "should upload and receive file chunk through SNI-enabled server" testFileChunkDeliverySNI
       it "should complete web handshake with challenge-response" testWebHandshake
       it "should re-handshake on same connection with xftp-web-hello header" testWebReHandshake
+      it "should ignore trailing handshake bytes (forward compatibility)" testHandshakeIgnoresTrailingBytes
       it "should return padded SESSION error for stale web session" testStaleWebSession
 
 chSize :: Integral a => a
@@ -579,6 +580,36 @@ testWebReHandshake =
       resp2b <- either (error . show) pure =<< HC.sendRequest h2 (H2.requestBuilder "POST" "/" [] $ byteString clientHsPadded) (Just 5000000)
       B.length (bodyHead (HC.respBody resp2b)) `shouldBe` 0
 
+-- Simulates a future protocol version appending extra fields to handshake messages:
+-- both client and server must ignore the trailing bytes (as SMP handshake does).
+testHandshakeIgnoresTrailingBytes :: Expectation
+testHandshakeIgnoresTrailingBytes =
+  withXFTPServerSNI $ \_ -> do
+    Fingerprint fpWeb <- loadFileFingerprint "tests/fixtures/web_ca.crt"
+    Fingerprint fpXFTP <- loadFileFingerprint "tests/fixtures/ca.crt"
+    let webCaHash = C.KeyHash fpWeb
+        keyHash = C.KeyHash fpXFTP
+        cfg = defaultTransportClientConfig {clientALPN = Just ["h2"], useSNI = True}
+        extra = "\1\2\3\4\5" :: ByteString
+    runTLSTransportClient defaultSupportedParamsHTTPS Nothing cfg Nothing "localhost" xftpTestPort (Just webCaHash) $ \(tls :: TLS 'TClient) -> do
+      let h2cfg = HC.defaultHTTP2ClientConfig {HC.bodyHeadSize = 65536}
+      h2 <- either (error . show) pure =<< HC.attachHTTP2Client h2cfg (THDomainName "localhost") xftpTestPort mempty 65536 tls
+      g <- C.newRandom
+      challenge <- atomically $ C.randomBytes 32 g
+      helloBody <- either (error . show) pure $ C.pad (smpEncode (XFTPClientHello {webChallenge = Just challenge})) xftpBlockSize
+      let helloReq = H2.requestBuilder "POST" "/" [("xftp-web-hello", "1")] $ byteString helloBody
+      resp1 <- either (error . show) pure =<< HC.sendRequest h2 helloReq (Just 5000000)
+      serverHsDecoded <- either (error . show) pure $ C.unPad (bodyHead (HC.respBody resp1))
+      -- client decodes the real server handshake and the same handshake with extra trailing bytes to the same result
+      XFTPServerHandshake {sessionId} <- either error pure $ decodeHandshake serverHsDecoded
+      XFTPServerHandshake {sessionId = sessionId'} <- either error pure $ decodeHandshake (serverHsDecoded <> extra)
+      sessionId' `shouldBe` sessionId
+      -- server accepts a client handshake with extra trailing bytes
+      let clientHs = XFTPClientHandshake {xftpVersion = VersionXFTP 1, keyHash}
+      clientHsPadded <- either (error . show) pure $ C.pad (smpEncode clientHs <> extra) xftpBlockSize
+      resp2 <- either (error . show) pure =<< HC.sendRequest h2 (H2.requestBuilder "POST" "/" [] $ byteString clientHsPadded) (Just 5000000)
+      B.length (bodyHead (HC.respBody resp2)) `shouldBe` 0
+
 testStaleWebSession :: Expectation
 testStaleWebSession =
   withXFTPServerSNI $ \_ -> do