web handshake

src/Simplex/FileTransfer/Client.hs

@@ -40,11 +40,11 @@ import Simplex.Messaging.Client
     NetworkRequestMode (..),
     ProtocolClientError (..),
     TransportSession,
-    netTimeoutInt,
     chooseTransportHost,
-    defaultNetworkConfig,
-    transportClientConfig,
     clientSocksCredentials,
+    defaultNetworkConfig,
+    netTimeoutInt,
+    transportClientConfig,
     unexpectedResponse,
     useWebPort,
   )
@@ -54,13 +54,13 @@ import Simplex.Messaging.Encoding (smpDecode, smpEncode)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
   ( BasicAuth,
+    NetworkError (..),
     Protocol (..),
     ProtocolServer (..),
     RecipientId,
     SenderId,
-    pattern NoEntity,
-    NetworkError (..),
     toNetworkError,
+    pattern NoEntity,
   )
 import Simplex.Messaging.Transport (ALPN, CertChainPubKey (..), HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
 import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost)
@@ -126,8 +126,9 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
       thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
   logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
   thParams@THandleParams {thVersion} <- case sessionALPN of
-    Just alpn | alpn == xftpALPNv1 || alpn == httpALPN11 ->
-      xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
+    Just alpn
+      | alpn == xftpALPNv1 || alpn == httpALPN11 ->
+          xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
     _ -> pure thParams0
   logDebug $ "Client negotiated protocol: " <> tshow thVersion
   let c = XFTPClient {http2Client, thParams, transportSession, config}
@@ -212,7 +213,7 @@ sendXFTPTransmission XFTPClient {config, thParams, http2Client} t chunkSpec_ = d
   HTTP2Response {respBody = body@HTTP2Body {bodyHead}} <- withExceptT xftpClientError . ExceptT $ sendRequest http2Client req (Just reqTimeout)
   when (B.length bodyHead /= xftpBlockSize) $ throwE $ PCEResponseError BLOCK
   -- TODO validate that the file ID is the same as in the request?
-  (_, _fId, respOrErr) <-liftEither $ first PCEResponseError $ xftpDecodeTClient thParams bodyHead
+  (_, _fId, respOrErr) <- liftEither $ first PCEResponseError $ xftpDecodeTClient thParams bodyHead
   case respOrErr of
     Right r -> case protocolError r of
       Just e -> throwE $ PCEProtocolError e

src/Simplex/FileTransfer/Server.hs

@@ -68,7 +68,7 @@ import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
 import Simplex.Messaging.Transport.HTTP2.Server (runHTTP2Server)
-import Simplex.Messaging.Transport.Server (TransportServerConfig (..), runLocalTCPServer)
+import Simplex.Messaging.Transport.Server (SNICredentialUsed, TransportServerConfig (..), runLocalTCPServer)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Environment (lookupEnv)
@@ -90,6 +90,7 @@ data XFTPTransportRequest = XFTPTransportRequest
     reqBody :: HTTP2Body,
     request :: H.Request,
     sendResponse :: H.Response -> IO (),
+    sniUsed :: SNICredentialUsed,
     addCORS :: Bool
   }
 
@@ -151,16 +152,17 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
             let v = VersionXFTP 1
                 thServerVRange = versionToRange v
                 thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
-                req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse, addCORS = addCORS'}
+                req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse, sniUsed, addCORS = addCORS'}
             flip runReaderT env $ case sessionALPN of
               Nothing -> processRequest req0
-              Just alpn | alpn == xftpALPNv1 || alpn == httpALPN11 ->
-                xftpServerHandshakeV1 chain signKey sessions req0 >>= \case
-                  Nothing -> pure ()
-                  Just thParams -> processRequest req0 {thParams}
-              _ -> liftIO . sendResponse $ H.responseNoBody N.ok200 (corsHeaders addCORS')
+              Just alpn
+                | alpn == xftpALPNv1 || alpn == httpALPN11 || (sniUsed && alpn == "h2") ->
+                    xftpServerHandshakeV1 chain signKey sessions req0 >>= \case
+                      Nothing -> pure ()
+                      Just thParams -> processRequest req0 {thParams}
+                | otherwise -> liftIO . sendResponse $ H.responseNoBody N.ok200 (corsHeaders addCORS')
     xftpServerHandshakeV1 :: X.CertificateChain -> C.APrivateSignKey -> TMap SessionId Handshake -> XFTPTransportRequest -> M (Maybe (THandleParams XFTPVersion 'TServer))
-    xftpServerHandshakeV1 chain serverSignKey sessions XFTPTransportRequest {thParams = thParams0@THandleParams {sessionId}, reqBody = HTTP2Body {bodyHead}, sendResponse, addCORS} = do
+    xftpServerHandshakeV1 chain serverSignKey sessions XFTPTransportRequest {thParams = thParams0@THandleParams {sessionId}, reqBody = HTTP2Body {bodyHead}, sendResponse, sniUsed, addCORS} = do
       s <- atomically $ TM.lookup sessionId sessions
       r <- runExceptT $ case s of
         Nothing -> processHello
@@ -169,11 +171,18 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
       either sendError pure r
       where
         processHello = do
-          unless (B.null bodyHead) $ throwE HANDSHAKE
+          challenge_ <-
+            if
+              | B.null bodyHead -> pure Nothing
+              | sniUsed -> do
+                  XFTPClientHello {webChallenge} <- liftHS $ smpDecode bodyHead
+                  pure webChallenge
+              | otherwise -> throwE HANDSHAKE
           (k, pk) <- atomically . C.generateKeyPair =<< asks random
           atomically $ TM.insert sessionId (HandshakeSent pk) sessions
           let authPubKey = CertChainPubKey chain (C.signX509 serverSignKey $ C.publicToX509 k)
-          let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey}
+              webIdentityProof = C.sign serverSignKey . (<> sessionId) <$> challenge_
+          let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey, webIdentityProof}
           shs <- encodeXftp hs
 #ifdef slow_servers
           lift randomDelay

src/Simplex/FileTransfer/Transport.hs

@@ -19,6 +19,7 @@ module Simplex.FileTransfer.Transport
     -- xftpClientHandshake,
     XFTPServerHandshake (..),
     -- xftpServerHandshake,
+    XFTPClientHello (..),
     THandleXFTP,
     THandleParamsXFTP,
     VersionXFTP,
@@ -60,7 +61,7 @@ import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol (BlockingInfo, CommandError)
 import Simplex.Messaging.Transport (ALPN, CertChainPubKey, ServiceCredentials, SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
 import Simplex.Messaging.Transport.HTTP2.File
-import Simplex.Messaging.Util (bshow, tshow)
+import Simplex.Messaging.Util (bshow, tshow, (<$?>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
 import System.IO (Handle, IOMode (..), withFile)
@@ -111,11 +112,18 @@ alpnSupportedXFTPhandshakes = [xftpALPNv1]
 xftpALPNv1 :: ALPN
 xftpALPNv1 = "xftp/1"
 
+data XFTPClientHello = XFTPClientHello
+  { -- | a random string sent by the client to the server to prove that server has identity certificate
+    webChallenge :: Maybe ByteString
+  }
+
 data XFTPServerHandshake = XFTPServerHandshake
   { xftpVersionRange :: VersionRangeXFTP,
     sessionId :: SessionId,
     -- | pub key to agree shared secrets for command authorization and entity ID encryption.
-    authPubKey :: CertChainPubKey
+    authPubKey :: CertChainPubKey,
+    -- | signed identity challenge from  XFTPClientHello
+    webIdentityProof :: Maybe C.ASignature
   }
 
 data XFTPClientHandshake = XFTPClientHandshake
@@ -125,6 +133,14 @@ data XFTPClientHandshake = XFTPClientHandshake
     keyHash :: C.KeyHash
   }
 
+instance Encoding XFTPClientHello where
+  smpEncode XFTPClientHello {webChallenge} = smpEncode webChallenge
+  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
   smpEncode XFTPClientHandshake {xftpVersion, keyHash} =
     smpEncode (xftpVersion, keyHash)
@@ -134,13 +150,13 @@ instance Encoding XFTPClientHandshake where
     pure XFTPClientHandshake {xftpVersion, keyHash}
 
 instance Encoding XFTPServerHandshake where
-  smpEncode XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey} =
-    smpEncode (xftpVersionRange, sessionId, authPubKey)
+  smpEncode XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey, webIdentityProof} =
+    smpEncode (xftpVersionRange, sessionId, authPubKey, C.signatureBytes webIdentityProof)
   smpP = do
-    (xftpVersionRange, sessionId) <- smpP
-    authPubKey <- smpP
+    (xftpVersionRange, sessionId, authPubKey) <- smpP
+    webIdentityProof <- C.decodeSignature <$?> smpP
     Tail _compat <- smpP
-    pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey}
+    pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey, webIdentityProof}
 
 sendEncFile :: Handle -> (Builder -> IO ()) -> LC.SbState -> Word32 -> IO ()
 sendEncFile h send = go

tests/XFTPServerTests.hs

@@ -16,6 +16,7 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import qualified Crypto.PubKey.RSA as RSA
 import qualified Data.ByteString.Base64.URL as B64
+import Data.ByteString.Builder (byteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -23,25 +24,27 @@ import qualified Data.CaseInsensitive as CI
 import Data.List (find, isInfixOf)
 import Data.Time.Clock (getCurrentTime)
 import qualified Data.X509 as X
-import Data.X509.Validation (Fingerprint (..))
+import Data.X509.Validation (Fingerprint (..), getFingerprint)
 import Network.HPACK.Token (tokenKey)
 import qualified Network.HTTP2.Client as H2
 import ServerTests (logSize)
 import Simplex.FileTransfer.Client
 import Simplex.FileTransfer.Description (kb)
-import Simplex.FileTransfer.Protocol (FileInfo (..), XFTPFileId)
+import Simplex.FileTransfer.Protocol (FileInfo (..), XFTPFileId, xftpBlockSize)
 import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
-import Simplex.FileTransfer.Transport (XFTPErrorType (..), XFTPRcvChunkSpec (..))
+import Simplex.FileTransfer.Transport (XFTPClientHandshake (..), XFTPClientHello (..), XFTPErrorType (..), XFTPRcvChunkSpec (..), XFTPServerHandshake (..), pattern VersionXFTP)
 import Simplex.Messaging.Client (ProtocolClientError (..))
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
+import Simplex.Messaging.Encoding (smpDecode, smpEncode)
 import Simplex.Messaging.Protocol (BasicAuth, EntityId (..), pattern NoEntity)
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..))
-import Simplex.Messaging.Transport (TLS (..), TransportPeer (..), defaultSupportedParams, defaultSupportedParamsHTTPS)
+import Simplex.Messaging.Transport (CertChainPubKey (..), TLS (..), TransportPeer (..), defaultSupportedParams, defaultSupportedParamsHTTPS)
 import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost (..), defaultTransportClientConfig, runTLSTransportClient)
-import Simplex.Messaging.Transport.HTTP2 ()
+import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HC
 import Simplex.Messaging.Transport.Server (loadFileFingerprint)
+import Simplex.Messaging.Transport.Shared (ChainCertificates (..), chainIdCaCerts)
 import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive, removeFile)
 import System.FilePath ((</>))
 import Test.Hspec hiding (fit, it)
@@ -80,6 +83,7 @@ xftpServerTests =
       it "should respond to OPTIONS preflight with CORS headers" testCORSPreflight
       it "should not add CORS headers without SNI" testNoCORSWithoutSNI
       it "should upload and receive file chunk through SNI-enabled server" testFileChunkDeliverySNI
+      it "should complete web handshake with challenge-response" testWebHandshake
 
 chSize :: Integral a => a
 chSize = kb 128
@@ -496,3 +500,43 @@ testNoCORSWithoutSNI =
 testFileChunkDeliverySNI :: Expectation
 testFileChunkDeliverySNI =
   withXFTPServerSNI $ \_ -> testXFTPClient $ \c -> runRight_ $ runTestFileChunkDelivery c c
+
+testWebHandshake :: Expectation
+testWebHandshake =
+  withXFTPServerSNI $ \_ -> do
+    Fingerprint fp <- loadFileFingerprint "tests/fixtures/ca.crt"
+    let keyHash = C.KeyHash fp
+        cfg = defaultTransportClientConfig {clientALPN = Just ["h2"], useSNI = True}
+    runTLSTransportClient defaultSupportedParamsHTTPS Nothing cfg Nothing "localhost" xftpTestPort (Just keyHash) $ \(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
+      -- Send web challenge as XFTPClientHello
+      g <- C.newRandom
+      challenge <- atomically $ C.randomBytes 32 g
+      let helloBody = smpEncode (XFTPClientHello {webChallenge = Just challenge})
+          helloReq = H2.requestBuilder "POST" "/" [] $ byteString helloBody
+      resp1 <- either (error . show) pure =<< HC.sendRequest h2 helloReq (Just 5000000)
+      let serverHsBody = bodyHead (HC.respBody resp1)
+      -- Decode server handshake
+      serverHsDecoded <- either (error . show) pure $ C.unPad serverHsBody
+      XFTPServerHandshake {sessionId, authPubKey = CertChainPubKey {certChain, signedPubKey}, webIdentityProof} <-
+        either error pure $ smpDecode serverHsDecoded
+      sig <- maybe (error "expected webIdentityProof") pure webIdentityProof
+      -- Verify cert chain identity
+      (leafCert, idCert) <- case chainIdCaCerts certChain of
+        CCValid {leafCert, idCert} -> pure (leafCert, idCert)
+        _ -> error "expected CCValid chain"
+      let Fingerprint idCertFP = getFingerprint idCert X.HashSHA256
+      C.KeyHash idCertFP `shouldBe` keyHash
+      -- Verify challenge signature (identity proof)
+      leafPubKey <- either error pure $ C.x509ToPublic' $ X.certPubKey $ X.signedObject $ X.getSigned leafCert
+      C.verify leafPubKey sig (challenge <> sessionId) `shouldBe` True
+      -- Verify signedPubKey (DH key auth)
+      void $ either error pure $ C.verifyX509 leafPubKey signedPubKey
+      -- Send client handshake with echoed challenge
+      let clientHs = XFTPClientHandshake {xftpVersion = VersionXFTP 1, keyHash}
+      clientHsPadded <- either (error . show) pure $ C.pad (smpEncode clientHs) xftpBlockSize
+      let clientHsReq = H2.requestBuilder "POST" "/" [] $ byteString clientHsPadded
+      resp2 <- either (error . show) pure =<< HC.sendRequest h2 clientHsReq (Just 5000000)
+      let ackBody = bodyHead (HC.respBody resp2)
+      B.length ackBody `shouldBe` 0

tests/XFTPWebTests.hs

@@ -23,6 +23,7 @@ import qualified Data.List.NonEmpty as NE
 import Data.Word (Word16, Word32)
 import Simplex.FileTransfer.Client (prepareChunkSizes)
 import Simplex.FileTransfer.Description (FileSize (..))
+import Simplex.FileTransfer.Transport (XFTPClientHello (..))
 import Simplex.FileTransfer.Types (FileHeader (..))
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
@@ -102,6 +103,13 @@ impHs =
     <> "import * as K from './dist/crypto/keys.js';"
     <> "import * as Hs from './dist/protocol/handshake.js';"
     <> "await sodium.ready;"
+impId :: String
+impId =
+  "import sodium from 'libsodium-wrappers-sumo';"
+    <> "import * as E from './dist/protocol/encoding.js';"
+    <> "import * as K from './dist/crypto/keys.js';"
+    <> "import * as Id from './dist/crypto/identity.js';"
+    <> "await sodium.ready;"
 impDesc :: String
 impDesc = "import * as Desc from './dist/protocol/description.js';"
 impChk :: String
@@ -145,6 +153,7 @@ xftpWebTests = do
       tsCommandTests
       tsTransmissionTests
       tsHandshakeTests
+      tsIdentityTests
       tsDescriptionTests
       tsChunkTests
       tsClientTests
@@ -1471,6 +1480,24 @@ tsHandshakeTests = describe "protocol/handshake" $ do
             <> jsOut ("Hs.encodeClientHandshake({xftpVersion:3,keyHash:" <> jsUint8 kh <> "})")
       tsResult `shouldBe` expected
 
+  describe "client hello" $ do
+    it "encodeClientHello (Nothing)" $ do
+      let expected = smpEncode (XFTPClientHello {webChallenge = Nothing})
+      tsResult <-
+        callNode $
+          impHs
+            <> jsOut "Hs.encodeClientHello({webChallenge: null})"
+      tsResult `shouldBe` expected
+
+    it "encodeClientHello (Just challenge)" $ do
+      let challenge = B.pack [1 .. 32]
+          expected = smpEncode (XFTPClientHello {webChallenge = Just challenge})
+      tsResult <-
+        callNode $
+          impHs
+            <> jsOut ("Hs.encodeClientHello({webChallenge:" <> jsUint8 challenge <> "})")
+      tsResult `shouldBe` expected
+
   describe "server handshake" $ do
     it "decodeServerHandshake" $ do
       let sessId = B.pack [1 .. 32]
@@ -1507,6 +1534,45 @@ tsHandshakeTests = describe "protocol/handshake" $ do
                        <> signedKeyBytes
                    )
 
+    it "decodeServerHandshake with webIdentityProof" $ do
+      let sessId = B.pack [1 .. 32]
+          cert1 = B.pack [101 .. 200]
+          cert2 = B.pack [201 .. 232]
+          signedKeyBytes = B.pack [1 .. 120]
+          sigBytes = B.pack [1 .. 64]
+          body =
+            smpEncode (1 :: Word16) <> smpEncode (3 :: Word16)
+              <> smpEncode sessId
+              <> smpEncode (NE.fromList [Large cert1, Large cert2])
+              <> smpEncode (Large signedKeyBytes)
+              <> smpEncode sigBytes
+          serverBlock = either (error . show) id $ C.pad body 16384
+      tsResult <-
+        callNode $
+          impHs
+            <> "const hs = Hs.decodeServerHandshake(" <> jsUint8 serverBlock <> ");"
+            <> jsOut "hs.webIdentityProof || new Uint8Array(0)"
+      tsResult `shouldBe` sigBytes
+
+    it "decodeServerHandshake without webIdentityProof" $ do
+      let sessId = B.pack [1 .. 32]
+          cert1 = B.pack [101 .. 200]
+          cert2 = B.pack [201 .. 232]
+          signedKeyBytes = B.pack [1 .. 120]
+          body =
+            smpEncode (1 :: Word16) <> smpEncode (3 :: Word16)
+              <> smpEncode sessId
+              <> smpEncode (NE.fromList [Large cert1, Large cert2])
+              <> smpEncode (Large signedKeyBytes)
+              <> smpEncode ("" :: B.ByteString)
+          serverBlock = either (error . show) id $ C.pad body 16384
+      tsResult <-
+        callNode $
+          impHs
+            <> "const hs = Hs.decodeServerHandshake(" <> jsUint8 serverBlock <> ");"
+            <> jsOut "new Uint8Array([hs.webIdentityProof === null ? 1 : 0])"
+      tsResult `shouldBe` B.pack [1]
+
   describe "certificate utilities" $ do
     it "caFingerprint" $ do
       let cert1 = B.pack [101 .. 200]
@@ -1519,6 +1585,56 @@ tsHandshakeTests = describe "protocol/handshake" $ do
             <> jsOut "Hs.caFingerprint(chain)"
       tsResult `shouldBe` expected
 
+    it "caFingerprint 3 certs" $ do
+      let cert1 = B.pack [1 .. 10]
+          cert2 = B.pack [11 .. 20]
+          cert3 = B.pack [21 .. 30]
+          expected = C.sha256Hash cert2
+      tsResult <-
+        callNode $
+          impHs
+            <> "const chain = [" <> jsUint8 cert1 <> "," <> jsUint8 cert2 <> "," <> jsUint8 cert3 <> "];"
+            <> jsOut "Hs.caFingerprint(chain)"
+      tsResult `shouldBe` expected
+
+    it "chainIdCaCerts 2 certs" $ do
+      let cert1 = B.pack [1 .. 10]
+          cert2 = B.pack [11 .. 20]
+      tsResult <-
+        callNode $
+          impHs
+            <> "const cc = Hs.chainIdCaCerts([" <> jsUint8 cert1 <> "," <> jsUint8 cert2 <> "]);"
+            <> "if (cc.type !== 'valid') throw new Error('expected valid');"
+            <> jsOut "E.concatBytes(cc.leafCert, cc.idCert, cc.caCert)"
+      tsResult `shouldBe` (cert1 <> cert2 <> cert2)
+
+    it "chainIdCaCerts 3 certs" $ do
+      let cert1 = B.pack [1 .. 10]
+          cert2 = B.pack [11 .. 20]
+          cert3 = B.pack [21 .. 30]
+      tsResult <-
+        callNode $
+          impHs
+            <> "const cc = Hs.chainIdCaCerts([" <> jsUint8 cert1 <> "," <> jsUint8 cert2 <> "," <> jsUint8 cert3 <> "]);"
+            <> "if (cc.type !== 'valid') throw new Error('expected valid');"
+            <> jsOut "E.concatBytes(cc.leafCert, cc.idCert, cc.caCert)"
+      tsResult `shouldBe` (cert1 <> cert2 <> cert3)
+
+    it "chainIdCaCerts 4 certs" $ do
+      let cert1 = B.pack [1 .. 10]
+          cert2 = B.pack [11 .. 20]
+          cert3 = B.pack [21 .. 30]
+          cert4 = B.pack [31 .. 40]
+      tsResult <-
+        callNode $
+          impHs
+            <> "const cc = Hs.chainIdCaCerts(["
+            <> jsUint8 cert1 <> "," <> jsUint8 cert2 <> "," <> jsUint8 cert3 <> "," <> jsUint8 cert4
+            <> "]);"
+            <> "if (cc.type !== 'valid') throw new Error('expected valid');"
+            <> jsOut "E.concatBytes(cc.leafCert, cc.idCert, cc.caCert)"
+      tsResult `shouldBe` (cert1 <> cert2 <> cert4)
+
   describe "SignedExact parsing" $ do
     it "extractSignedKey" $ do
       -- Generate signing key (Ed25519)
@@ -1577,6 +1693,213 @@ tsHandshakeTests = describe "protocol/handshake" $ do
             <> jsOut "new Uint8Array([ok ? 1 : 0])"
       tsResult `shouldBe` B.pack [1]
 
+-- ── crypto/identity ──────────────────────────────────────────────
+
+-- Construct a minimal X.509 certificate DER with an Ed25519 public key.
+-- Structurally valid for DER navigation but not a real certificate.
+mkFakeCertDer :: B.ByteString -> B.ByteString
+mkFakeCertDer pubKey32 =
+  let spki = B.pack [0x30, 0x2a, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x70, 0x03, 0x21, 0x00] <> pubKey32
+      tbsContents =
+        B.concat
+          [ B.pack [0xa0, 0x03, 0x02, 0x01, 0x02],
+            B.pack [0x02, 0x01, 0x01],
+            B.pack [0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x70],
+            B.pack [0x30, 0x00],
+            B.pack [0x30, 0x00],
+            B.pack [0x30, 0x00],
+            spki
+          ]
+      tbs = B.pack [0x30, fromIntegral $ B.length tbsContents] <> tbsContents
+      certContents =
+        B.concat
+          [ tbs,
+            B.pack [0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x70],
+            B.pack [0x03, 0x41, 0x00] <> B.replicate 64 0
+          ]
+      certLen = B.length certContents
+   in B.pack [0x30, 0x81, fromIntegral certLen] <> certContents
+
+tsIdentityTests :: Spec
+tsIdentityTests = describe "crypto/identity" $ do
+  describe "extractCertPublicKeyInfo" $ do
+    it "extracts SPKI from X.509 DER" $ do
+      let pubKey = B.pack [1 .. 32]
+          certDer = mkFakeCertDer pubKey
+          expectedSpki = B.pack [0x30, 0x2a, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x70, 0x03, 0x21, 0x00] <> pubKey
+      tsResult <-
+        callNode $
+          impId
+            <> jsOut ("Id.extractCertPublicKeyInfo(" <> jsUint8 certDer <> ")")
+      tsResult `shouldBe` expectedSpki
+
+    it "extractCertEd25519Key returns raw 32-byte key" $ do
+      let pubKey = B.pack [1 .. 32]
+          certDer = mkFakeCertDer pubKey
+      tsResult <-
+        callNode $
+          impId
+            <> jsOut ("Id.extractCertEd25519Key(" <> jsUint8 certDer <> ")")
+      tsResult `shouldBe` pubKey
+
+  describe "verifyIdentityProof" $ do
+    it "valid proof returns true" $ do
+      let signSeed = B.pack [1 .. 32]
+          signSk = throwCryptoError $ Ed25519.secretKey signSeed
+          signPk = Ed25519.toPublic signSk
+          signPkRaw = BA.convert signPk :: B.ByteString
+          leafCertDer = mkFakeCertDer signPkRaw
+          idCertDer = B.pack [1 .. 50]
+          keyHash = C.sha256Hash idCertDer
+          -- DH key SignedExact
+          dhSeed = B.pack [41 .. 72]
+          dhSk = throwCryptoError $ X25519.secretKey dhSeed
+          dhPk = X25519.toPublic dhSk
+          dhPkRaw = BA.convert dhPk :: B.ByteString
+          x25519Prefix = B.pack [0x30, 0x2a, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x6e, 0x03, 0x21, 0x00]
+          spkiDer = x25519Prefix <> dhPkRaw
+          dhSig = Ed25519.sign signSk signPk spkiDer
+          dhSigRaw = BA.convert dhSig :: B.ByteString
+          algId = B.pack [0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x70]
+          bitString = B.pack [0x03, 0x41, 0x00] <> dhSigRaw
+          signedKeyDer = B.pack [0x30, 0x76] <> spkiDer <> algId <> bitString
+          -- Challenge signature
+          challenge = B.pack [101 .. 132]
+          sessionId = B.pack [201 .. 232]
+          challengeSig = Ed25519.sign signSk signPk (challenge <> sessionId)
+          challengeSigRaw = BA.convert challengeSig :: B.ByteString
+      tsResult <-
+        callNode $
+          impId
+            <> "const ok = Id.verifyIdentityProof({"
+            <> "certChainDer: [" <> jsUint8 leafCertDer <> "," <> jsUint8 idCertDer <> "],"
+            <> "signedKeyDer: " <> jsUint8 signedKeyDer <> ","
+            <> "sigBytes: " <> jsUint8 challengeSigRaw <> ","
+            <> "challenge: " <> jsUint8 challenge <> ","
+            <> "sessionId: " <> jsUint8 sessionId <> ","
+            <> "keyHash: " <> jsUint8 keyHash
+            <> "});"
+            <> jsOut "new Uint8Array([ok ? 1 : 0])"
+      tsResult `shouldBe` B.pack [1]
+
+    it "wrong keyHash returns false" $ do
+      let signSeed = B.pack [1 .. 32]
+          signSk = throwCryptoError $ Ed25519.secretKey signSeed
+          signPk = Ed25519.toPublic signSk
+          signPkRaw = BA.convert signPk :: B.ByteString
+          leafCertDer = mkFakeCertDer signPkRaw
+          idCertDer = B.pack [1 .. 50]
+          wrongKeyHash = B.replicate 32 0xff
+          -- DH key SignedExact
+          dhSeed = B.pack [41 .. 72]
+          dhSk = throwCryptoError $ X25519.secretKey dhSeed
+          dhPk = X25519.toPublic dhSk
+          dhPkRaw = BA.convert dhPk :: B.ByteString
+          x25519Prefix = B.pack [0x30, 0x2a, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x6e, 0x03, 0x21, 0x00]
+          spkiDer = x25519Prefix <> dhPkRaw
+          dhSig = Ed25519.sign signSk signPk spkiDer
+          dhSigRaw = BA.convert dhSig :: B.ByteString
+          algId = B.pack [0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x70]
+          bitString = B.pack [0x03, 0x41, 0x00] <> dhSigRaw
+          signedKeyDer = B.pack [0x30, 0x76] <> spkiDer <> algId <> bitString
+          challenge = B.pack [101 .. 132]
+          sessionId = B.pack [201 .. 232]
+          challengeSig = Ed25519.sign signSk signPk (challenge <> sessionId)
+          challengeSigRaw = BA.convert challengeSig :: B.ByteString
+      tsResult <-
+        callNode $
+          impId
+            <> "const ok = Id.verifyIdentityProof({"
+            <> "certChainDer: [" <> jsUint8 leafCertDer <> "," <> jsUint8 idCertDer <> "],"
+            <> "signedKeyDer: " <> jsUint8 signedKeyDer <> ","
+            <> "sigBytes: " <> jsUint8 challengeSigRaw <> ","
+            <> "challenge: " <> jsUint8 challenge <> ","
+            <> "sessionId: " <> jsUint8 sessionId <> ","
+            <> "keyHash: " <> jsUint8 wrongKeyHash
+            <> "});"
+            <> jsOut "new Uint8Array([ok ? 1 : 0])"
+      tsResult `shouldBe` B.pack [0]
+
+    it "wrong challenge sig returns false" $ do
+      let signSeed = B.pack [1 .. 32]
+          signSk = throwCryptoError $ Ed25519.secretKey signSeed
+          signPk = Ed25519.toPublic signSk
+          signPkRaw = BA.convert signPk :: B.ByteString
+          leafCertDer = mkFakeCertDer signPkRaw
+          idCertDer = B.pack [1 .. 50]
+          keyHash = C.sha256Hash idCertDer
+          -- DH key SignedExact
+          dhSeed = B.pack [41 .. 72]
+          dhSk = throwCryptoError $ X25519.secretKey dhSeed
+          dhPk = X25519.toPublic dhSk
+          dhPkRaw = BA.convert dhPk :: B.ByteString
+          x25519Prefix = B.pack [0x30, 0x2a, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x6e, 0x03, 0x21, 0x00]
+          spkiDer = x25519Prefix <> dhPkRaw
+          dhSig = Ed25519.sign signSk signPk spkiDer
+          dhSigRaw = BA.convert dhSig :: B.ByteString
+          algId = B.pack [0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x70]
+          bitString = B.pack [0x03, 0x41, 0x00] <> dhSigRaw
+          signedKeyDer = B.pack [0x30, 0x76] <> spkiDer <> algId <> bitString
+          challenge = B.pack [101 .. 132]
+          sessionId = B.pack [201 .. 232]
+          wrongChallenge = B.pack [1 .. 32]
+          wrongSig = Ed25519.sign signSk signPk (wrongChallenge <> sessionId)
+          wrongSigRaw = BA.convert wrongSig :: B.ByteString
+      tsResult <-
+        callNode $
+          impId
+            <> "const ok = Id.verifyIdentityProof({"
+            <> "certChainDer: [" <> jsUint8 leafCertDer <> "," <> jsUint8 idCertDer <> "],"
+            <> "signedKeyDer: " <> jsUint8 signedKeyDer <> ","
+            <> "sigBytes: " <> jsUint8 wrongSigRaw <> ","
+            <> "challenge: " <> jsUint8 challenge <> ","
+            <> "sessionId: " <> jsUint8 sessionId <> ","
+            <> "keyHash: " <> jsUint8 keyHash
+            <> "});"
+            <> jsOut "new Uint8Array([ok ? 1 : 0])"
+      tsResult `shouldBe` B.pack [0]
+
+    it "wrong DH key sig returns false" $ do
+      let signSeed = B.pack [1 .. 32]
+          signSk = throwCryptoError $ Ed25519.secretKey signSeed
+          signPk = Ed25519.toPublic signSk
+          signPkRaw = BA.convert signPk :: B.ByteString
+          leafCertDer = mkFakeCertDer signPkRaw
+          idCertDer = B.pack [1 .. 50]
+          keyHash = C.sha256Hash idCertDer
+          -- DH key signed by a DIFFERENT key
+          otherSeed = B.pack [51 .. 82]
+          otherSk = throwCryptoError $ Ed25519.secretKey otherSeed
+          otherPk = Ed25519.toPublic otherSk
+          dhSeed = B.pack [41 .. 72]
+          dhSk = throwCryptoError $ X25519.secretKey dhSeed
+          dhPk = X25519.toPublic dhSk
+          dhPkRaw = BA.convert dhPk :: B.ByteString
+          x25519Prefix = B.pack [0x30, 0x2a, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x6e, 0x03, 0x21, 0x00]
+          spkiDer = x25519Prefix <> dhPkRaw
+          dhSig = Ed25519.sign otherSk otherPk spkiDer
+          dhSigRaw = BA.convert dhSig :: B.ByteString
+          algId = B.pack [0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x70]
+          bitString = B.pack [0x03, 0x41, 0x00] <> dhSigRaw
+          signedKeyDer = B.pack [0x30, 0x76] <> spkiDer <> algId <> bitString
+          challenge = B.pack [101 .. 132]
+          sessionId = B.pack [201 .. 232]
+          challengeSig = Ed25519.sign signSk signPk (challenge <> sessionId)
+          challengeSigRaw = BA.convert challengeSig :: B.ByteString
+      tsResult <-
+        callNode $
+          impId
+            <> "const ok = Id.verifyIdentityProof({"
+            <> "certChainDer: [" <> jsUint8 leafCertDer <> "," <> jsUint8 idCertDer <> "],"
+            <> "signedKeyDer: " <> jsUint8 signedKeyDer <> ","
+            <> "sigBytes: " <> jsUint8 challengeSigRaw <> ","
+            <> "challenge: " <> jsUint8 challenge <> ","
+            <> "sessionId: " <> jsUint8 sessionId <> ","
+            <> "keyHash: " <> jsUint8 keyHash
+            <> "});"
+            <> jsOut "new Uint8Array([ok ? 1 : 0])"
+      tsResult `shouldBe` B.pack [0]
+
 -- ── protocol/description ──────────────────────────────────────────
 
 tsDescriptionTests :: Spec

xftp-web/src/crypto/identity.ts

@@ -0,0 +1,93 @@
+// Web handshake identity proof verification.
+//
+// Verifies server identity in the XFTP web handshake using the certificate
+// chain from the protocol handshake (independent of TLS certificates).
+// Ed25519 verification via libsodium. Ed448 deferred.
+
+import {Decoder, concatBytes} from "../protocol/encoding.js"
+import {sha256} from "./digest.js"
+import {verify, decodePubKeyEd25519} from "./keys.js"
+import {chainIdCaCerts, extractSignedKey} from "../protocol/handshake.js"
+
+// ── ASN.1 DER helpers (minimal, for X.509 parsing) ─────────────────
+
+function derLen(d: Decoder): number {
+  const first = d.anyByte()
+  if (first < 0x80) return first
+  const n = first & 0x7f
+  if (n === 0 || n > 4) throw new Error("DER: unsupported length encoding")
+  let len = 0
+  for (let i = 0; i < n; i++) len = (len << 8) | d.anyByte()
+  return len
+}
+
+function derSkip(d: Decoder): void {
+  d.anyByte()
+  d.take(derLen(d))
+}
+
+function derReadElement(d: Decoder): Uint8Array {
+  const start = d.offset()
+  d.anyByte()
+  d.take(derLen(d))
+  return d.buf.subarray(start, d.offset())
+}
+
+// ── X.509 certificate public key extraction ─────────────────────────
+
+// Extract SubjectPublicKeyInfo DER from a full X.509 certificate DER.
+// Navigates: Certificate → TBSCertificate → skip version, serialNumber,
+//   signatureAlg, issuer, validity, subject → SubjectPublicKeyInfo.
+export function extractCertPublicKeyInfo(certDer: Uint8Array): Uint8Array {
+  const d = new Decoder(certDer)
+  if (d.anyByte() !== 0x30) throw new Error("X.509: expected Certificate SEQUENCE")
+  derLen(d)
+  if (d.anyByte() !== 0x30) throw new Error("X.509: expected TBSCertificate SEQUENCE")
+  derLen(d)
+  if (d.buf[d.offset()] === 0xa0) derSkip(d) // version [0] EXPLICIT (optional)
+  derSkip(d) // serialNumber
+  derSkip(d) // signature AlgorithmIdentifier
+  derSkip(d) // issuer
+  derSkip(d) // validity
+  derSkip(d) // subject
+  return derReadElement(d) // SubjectPublicKeyInfo
+}
+
+// Extract raw Ed25519 public key (32 bytes) from X.509 certificate DER.
+export function extractCertEd25519Key(certDer: Uint8Array): Uint8Array {
+  return decodePubKeyEd25519(extractCertPublicKeyInfo(certDer))
+}
+
+// ── Identity proof verification ─────────────────────────────────────
+
+export interface IdentityVerification {
+  certChainDer: Uint8Array[]
+  signedKeyDer: Uint8Array
+  sigBytes: Uint8Array
+  challenge: Uint8Array
+  sessionId: Uint8Array
+  keyHash: Uint8Array
+}
+
+// Verify server identity proof from XFTP web handshake.
+//   1. Certificate chain has valid structure (2-4 certs)
+//   2. SHA-256(idCert) matches expected keyHash
+//   3. Challenge signature valid: verify(leafKey, sigBytes, challenge || sessionId)
+//   4. DH key signature valid: verify(leafKey, signedKey.signature, signedKey.objectDer)
+export function verifyIdentityProof(v: IdentityVerification): boolean {
+  const cc = chainIdCaCerts(v.certChainDer)
+  if (cc.type !== 'valid') return false
+  const fp = sha256(cc.idCert)
+  if (!constantTimeEqual(fp, v.keyHash)) return false
+  const leafKey = extractCertEd25519Key(cc.leafCert)
+  if (!verify(leafKey, v.sigBytes, concatBytes(v.challenge, v.sessionId))) return false
+  const sk = extractSignedKey(v.signedKeyDer)
+  return verify(leafKey, sk.signature, sk.objectDer)
+}
+
+function constantTimeEqual(a: Uint8Array, b: Uint8Array): boolean {
+  if (a.length !== b.length) return false
+  let diff = 0
+  for (let i = 0; i < a.length; i++) diff |= a[i] ^ b[i]
+  return diff === 0
+}

xftp-web/src/protocol/handshake.ts

@@ -6,6 +6,7 @@ import {
   Decoder, concatBytes,
   encodeWord16, decodeWord16,
   encodeBytes, decodeBytes,
+  encodeMaybe,
   decodeLarge, decodeNonEmpty
 } from "./encoding.js"
 import {sha256} from "../crypto/digest.js"
@@ -41,6 +42,18 @@ export function compatibleVRange(a: VersionRange, b: VersionRange): VersionRange
   return {minVersion: min, maxVersion: max}
 }
 
+// ── Client hello ─────────────────────────────────────────────────
+
+export interface XFTPClientHello {
+  webChallenge: Uint8Array | null  // 32 random bytes for web handshake, or null for standard
+}
+
+// Encode client hello (NOT padded — sent as raw POST body).
+// Wire format: smpEncode (Maybe ByteString)
+export function encodeClientHello(hello: XFTPClientHello): Uint8Array {
+  return encodeMaybe(encodeBytes, hello.webChallenge)
+}
+
 // ── Client handshake ───────────────────────────────────────────────
 
 export interface XFTPClientHandshake {
@@ -62,11 +75,13 @@ export interface XFTPServerHandshake {
   sessionId: Uint8Array
   certChainDer: Uint8Array[]    // raw DER certificate blobs (NonEmpty)
   signedKeyDer: Uint8Array      // raw DER SignedExact blob
+  webIdentityProof: Uint8Array | null  // signature bytes, or null if absent/empty
 }
 
 // Decode padded server handshake block.
-// Wire format: unpad(block) → (versionRange, sessionId, certChainPubKey)
+// Wire format: unpad(block) → (versionRange, sessionId, certChainPubKey, sigBytes)
 //   where certChainPubKey = (NonEmpty Large certChain, Large signedKey)
+//         sigBytes = ByteString (1-byte len prefix, empty for Nothing)
 // Trailing bytes (Tail) are ignored for forward compatibility.
 export function decodeServerHandshake(block: Uint8Array): XFTPServerHandshake {
   const raw = blockUnpad(block)
@@ -76,17 +91,44 @@ export function decodeServerHandshake(block: Uint8Array): XFTPServerHandshake {
   // CertChainPubKey: smpEncode (encodeCertChain certChain, SignedObject signedPubKey)
   const certChainDer = decodeNonEmpty(decodeLarge, d)
   const signedKeyDer = decodeLarge(d)
+  // webIdentityProof: 1-byte length-prefixed ByteString (empty = Nothing)
+  let webIdentityProof: Uint8Array | null = null
+  if (d.remaining() > 0) {
+    const sigBytes = decodeBytes(d)
+    webIdentityProof = sigBytes.length === 0 ? null : sigBytes
+  }
   // Remaining bytes are Tail (ignored for forward compatibility)
-  return {xftpVersionRange, sessionId, certChainDer, signedKeyDer}
+  return {xftpVersionRange, sessionId, certChainDer, signedKeyDer, webIdentityProof}
 }
 
 // ── Certificate utilities ──────────────────────────────────────────
 
-// SHA-256 fingerprint of the CA certificate (last cert in chain).
-// Matches Haskell: XV.getFingerprint ca X.HashSHA256
+// Certificate chain decomposition matching Haskell chainIdCaCerts (Transport.Shared).
+export type ChainCertificates =
+  | {type: 'empty'}
+  | {type: 'self'; cert: Uint8Array}
+  | {type: 'valid'; leafCert: Uint8Array; idCert: Uint8Array; caCert: Uint8Array}
+  | {type: 'long'}
+
+export function chainIdCaCerts(certChainDer: Uint8Array[]): ChainCertificates {
+  switch (certChainDer.length) {
+    case 0: return {type: 'empty'}
+    case 1: return {type: 'self', cert: certChainDer[0]}
+    case 2: return {type: 'valid', leafCert: certChainDer[0], idCert: certChainDer[1], caCert: certChainDer[1]}
+    case 3: return {type: 'valid', leafCert: certChainDer[0], idCert: certChainDer[1], caCert: certChainDer[2]}
+    case 4: return {type: 'valid', leafCert: certChainDer[0], idCert: certChainDer[1], caCert: certChainDer[3]}
+    default: return {type: 'long'}
+  }
+}
+
+// SHA-256 fingerprint of the identity certificate.
+// For 2-cert chains: idCert = last cert (same as CA).
+// For 3+ cert chains: idCert = second cert (distinct from CA).
+// Matches Haskell: getFingerprint idCert HashSHA256
 export function caFingerprint(certChainDer: Uint8Array[]): Uint8Array {
-  if (certChainDer.length < 2) throw new Error("caFingerprint: need at least 2 certs (leaf + CA)")
-  return sha256(certChainDer[certChainDer.length - 1])
+  const cc = chainIdCaCerts(certChainDer)
+  if (cc.type !== 'valid') throw new Error("caFingerprint: need valid chain (2-4 certs)")
+  return sha256(cc.idCert)
 }
 
 // ── SignedExact DER parsing ────────────────────────────────────────