Files
simplexmq/tests/SMPWebTests.hs
T
2026-04-20 11:12:39 +00:00

395 lines
20 KiB
Haskell

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}
-- | Per-function tests for the smp-web TypeScript SMP client library.
-- Each test calls the Haskell function and the corresponding TypeScript function
-- via node, then asserts byte-identical output.
--
-- Prerequisites: cd smp-web && npm install && npm run build
-- Run: cabal test --test-option=--match="/SMP Web Client/"
module SMPWebTests (smpWebTests) where
import Control.Monad.Except (ExceptT, runExceptT)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.List.NonEmpty (NonEmpty (..))
import Data.Word (Word16)
import qualified Simplex.Messaging.Agent as A
import qualified Simplex.Messaging.Agent.Protocol as AP
import Simplex.Messaging.Agent.Protocol (CreatedConnLink (..), UserLinkData (..), UserContactData (..), UserConnLinkData (..))
import Simplex.Messaging.Client (pattern NRMInteractive)
import Simplex.Messaging.Version (mkVersionRange)
import Simplex.Messaging.Version.Internal (Version (..))
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Crypto.ShortLink (contactShortLinkKdf, invShortLinkKdf)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String (strEncode)
import Simplex.Messaging.Protocol (EntityId (..), SMPServer, SubscriptionMode (..), pattern SMPServer)
import Simplex.Messaging.Server.Env.STM (AStoreType (..))
import Simplex.Messaging.Server.MsgStore.Types (SMSType (..), SQSType (..))
import Simplex.Messaging.Server.Web (attachStaticAndWS)
import Simplex.Messaging.Transport (TLS)
import Simplex.Messaging.Transport.Client (TransportHost (..))
import SMPAgentClient (agentCfg, initAgentServers, testDB)
import SMPClient (cfgWebOn, testKeyHash, testPort, withSmpServerConfig)
import AgentTests.FunctionalAPITests (withAgent)
import Test.Hspec hiding (it)
import Util
import XFTPWebTests (callNode_, jsOut, jsUint8)
smpWebDir :: FilePath
smpWebDir = "smp-web"
callNode :: String -> IO B.ByteString
callNode = callNode_ smpWebDir
impEnc :: String
impEnc = "import { Decoder, decodeLarge } from '@simplex-chat/xftp-web/dist/protocol/encoding.js';"
impProto_ :: String
impProto_ = "import { encodeTransmission, encodeBatch, decodeTransmission, encodeLGET, decodeLNK, decodeResponse } from './dist/protocol.js';"
impProto :: String
impProto = impEnc <> impProto_
impTransport :: String
impTransport = "import { decodeSMPServerHandshake, encodeSMPClientHandshake } from './dist/transport.js';"
<> "import { Decoder, encodeWord16 } from '@simplex-chat/xftp-web/dist/protocol/encoding.js';"
impWS :: String
impWS = "import { connectSMP, sendBlock, receiveBlock } from './dist/transport/websockets.js';"
<> "import { blockPad, blockUnpad } from '@simplex-chat/xftp-web/dist/protocol/transmission.js';"
impAgentProto_ :: String
impAgentProto_ = "import { connShortLinkStrP, decodeConnLinkData, decodeProtocolServer, decodeConnShortLink, decodeOwnerAuth, decodeUserLinkData, parseProfile } from './dist/agent/protocol.js';"
impAgentProto :: String
impAgentProto = impEnc <> impAgentProto_
impCryptoShortLink :: String
impCryptoShortLink = "import { contactShortLinkKdf, invShortLinkKdf, decryptLinkData } from './dist/crypto/shortLink.js';"
-- Init sodium from xftp-web's copy (same instance secretbox.ts uses)
impSodium :: String
impSodium = "import sodium from '@simplex-chat/xftp-web/node_modules/libsodium-wrappers-sumo/dist/modules-sumo/libsodium-wrappers.js'; await sodium.ready;"
jsStr :: B.ByteString -> String
jsStr bs = "'" <> BC.unpack bs <> "'"
runRight :: (Show e, HasCallStack) => ExceptT e IO a -> IO a
runRight action = runExceptT action >>= either (error . ("Unexpected error: " <>) . show) pure
smpWebTests :: SpecWith ()
smpWebTests = describe "SMP Web Client" $ do
describe "protocol" $ do
describe "transmission" $ do
it "encodeTransmission matches Haskell" $ do
let corrId = "1"
entityId = B.pack [1..24]
command = "LGET"
hsEncoded = smpEncode (corrId :: B.ByteString, entityId :: B.ByteString) <> command
tsEncoded <- callNode $ impProto
<> jsOut ("encodeTransmission("
<> jsUint8 corrId <> ","
<> jsUint8 entityId <> ","
<> "new Uint8Array([0x4C,0x47,0x45,0x54])"
<> ")")
tsEncoded `shouldBe` (B.singleton 0 <> hsEncoded)
it "decodeTransmission parses Haskell-encoded" $ do
let corrId = "abc"
entityId = B.pack [10..33]
command = "TEST"
encoded = smpEncode (B.empty :: B.ByteString)
<> smpEncode corrId
<> smpEncode entityId
<> command
tsResult <- callNode $ impProto
<> "const t = decodeTransmission(new Decoder(" <> jsUint8 encoded <> "));"
<> jsOut ("new Uint8Array([...t.corrId, ...t.entityId, ...t.command])")
tsResult `shouldBe` (corrId <> entityId <> command)
describe "LGET" $ do
it "encodeLGET produces correct bytes" $ do
tsResult <- callNode $ impProto <> jsOut "encodeLGET()"
tsResult `shouldBe` "LGET"
describe "LNK" $ do
it "decodeLNK parses correctly" $ do
let senderId = B.pack [1..24]
fixedData = B.pack [100..110]
userData = B.pack [200..220]
encoded = smpEncode senderId <> smpEncode (Large fixedData) <> smpEncode (Large userData)
tsResult <- callNode $ impProto
<> "const r = decodeLNK(new Decoder(" <> jsUint8 encoded <> "));"
<> jsOut ("new Uint8Array([...r.senderId, ...r.encFixedData, ...r.encUserData])")
tsResult `shouldBe` (senderId <> fixedData <> userData)
describe "decodeResponse" $ do
it "decodes LNK response" $ do
let senderId = B.pack [1..24]
fixedData = B.pack [100..110]
userData = B.pack [200..220]
commandBytes = "LNK " <> smpEncode senderId <> smpEncode (Large fixedData) <> smpEncode (Large userData)
tsResult <- callNode $ impProto
<> "const r = decodeResponse(new Decoder(" <> jsUint8 commandBytes <> "));"
<> "if (r.type !== 'LNK') throw new Error('expected LNK, got ' + r.type);"
<> jsOut ("new Uint8Array([...r.response.senderId])")
tsResult `shouldBe` senderId
it "decodes OK response" $ do
tsResult <- callNode $ impProto
<> "const r = decodeResponse(new Decoder(new Uint8Array([0x4F, 0x4B])));"
<> jsOut ("new Uint8Array([r.type === 'OK' ? 1 : 0])")
tsResult `shouldBe` B.singleton 1
describe "transport" $ do
describe "SMPServerHandshake" $ do
it "TypeScript parses Haskell-encoded server handshake (no authPubKey)" $ do
-- Manually construct: smpEncode (versionRange, sessionId) <> "" (no authPubKey)
let vRange = (6 :: Word16, 18 :: Word16)
sessId = B.pack [1..32]
encoded = smpEncode vRange <> smpEncode sessId
tsResult <- callNode $ impTransport
<> "const hs = decodeSMPServerHandshake(new Decoder(" <> jsUint8 encoded <> "));"
<> jsOut ("new Uint8Array(["
<> "hs.smpVersionRange.min, hs.smpVersionRange.max,"
<> "hs.authPubKey === null ? 1 : 0,"
<> "hs.sessionId.length"
<> "])")
tsResult `shouldBe` B.pack [6, 18, 1, 32]
describe "SMPClientHandshake" $ do
it "TypeScript-encoded client handshake matches Haskell (no authPubKey)" $ do
-- Haskell encoding: smpEncode (v18, keyHash) <> "" (no authPubKey) <> smpEncode False <> smpEncode (Nothing :: Maybe ())
let v = 18 :: Word16
keyHash = B.pack [1..32]
hsEncoded = smpEncode (v, keyHash)
<> "" -- authPubKey Nothing = empty
<> smpEncode False -- proxyServer
<> smpEncode (Nothing :: Maybe B.ByteString) -- clientService
tsEncoded <- callNode $ impTransport
<> jsOut ("encodeSMPClientHandshake({"
<> "smpVersion: 18,"
<> "keyHash: " <> jsUint8 keyHash <> ","
<> "authPubKey: null,"
<> "proxyServer: false,"
<> "clientService: null"
<> "})")
tsEncoded `shouldBe` hsEncoded
describe "crypto/shortLink" $ do
describe "contactShortLinkKdf" $ do
it "TypeScript produces same linkId and sbKey as Haskell" $ do
let linkKey = AP.LinkKey $ B.pack [1..32]
(EntityId hsLinkId, C.SbKey hsKey) = contactShortLinkKdf linkKey
tsResult <- callNode $ impCryptoShortLink
<> "const r = contactShortLinkKdf(" <> jsUint8 (B.pack [1..32]) <> ");"
<> jsOut ("new Uint8Array([...r.linkId, ...r.sbKey])")
tsResult `shouldBe` (hsLinkId <> hsKey)
describe "invShortLinkKdf" $ do
it "TypeScript produces same sbKey as Haskell" $ do
let linkKey = AP.LinkKey $ B.pack [50..81]
C.SbKey hsKey = invShortLinkKdf linkKey
tsResult <- callNode $ impCryptoShortLink
<> jsOut ("invShortLinkKdf(" <> jsUint8 (B.pack [50..81]) <> ")")
tsResult `shouldBe` hsKey
describe "decryptLinkData" $ do
it "TypeScript decrypts Haskell-encrypted data" $ do
let sbKey = C.unsafeSbKey $ B.pack [1..32]
nonce = C.cbNonce $ B.pack [1..24]
-- Simulate encodeSign: smpEncode signature <> plaintext
fakeSig = B.pack [1..64] -- 64-byte "signature"
fixedPlain = "fixed-data-here"
userPlain = "user-data-here"
signedFixed = smpEncode fakeSig <> fixedPlain
signedUser = smpEncode fakeSig <> userPlain
case (,) <$> C.sbEncrypt sbKey nonce signedFixed 2008
<*> C.sbEncrypt sbKey nonce signedUser 13784 of
Left e -> expectationFailure $ "encrypt failed: " <> show e
Right (ctFixed, ctUser) -> do
let encFixed = C.unCbNonce nonce <> ctFixed
encUser = C.unCbNonce nonce <> ctUser
tsResult <- callNode $ impSodium <> impCryptoShortLink
<> "const r = decryptLinkData("
<> jsUint8 (C.unSbKey sbKey) <> ","
<> jsUint8 encFixed <> ","
<> jsUint8 encUser <> ");"
<> jsOut ("new Uint8Array([...r.fixedData, 0, ...r.userData])")
tsResult `shouldBe` (fixedPlain <> B.singleton 0 <> userPlain)
describe "agent/protocol" $ do
describe "ProtocolServer binary" $ do
it "decodes Haskell-encoded server" $ do
let srv = SMPServer ("smp.example.com" :| ["smp2.example.com"]) "5223" (C.KeyHash $ B.pack [1..32])
encoded = smpEncode srv
tsResult <- callNode $ impAgentProto
<> "const s = decodeProtocolServer(new Decoder(" <> jsUint8 encoded <> "));"
<> "const enc = new TextEncoder();"
<> jsOut ("new Uint8Array([s.hosts.length, ...s.keyHash, ...enc.encode(new TextDecoder().decode(s.port))])")
tsResult `shouldBe` B.pack ([2] ++ [1..32]) <> "5223"
describe "ConnShortLink binary" $ do
it "decodes Haskell-encoded contact link" $ do
let srv = SMPServer ("relay.example.com" :| []) "" (C.KeyHash $ B.pack [1..32])
linkKey = AP.LinkKey $ B.pack [50..81]
link = AP.CSLContact AP.SLSServer AP.CCTGroup srv linkKey
encoded = smpEncode link
tsResult <- callNode $ impAgentProto
<> "const l = decodeConnShortLink(new Decoder(" <> jsUint8 encoded <> "));"
<> jsOut ("new Uint8Array([l.mode === 'contact' ? 1 : 0, l.connType === 'group' ? 1 : 0, ...l.linkKey])")
tsResult `shouldBe` B.pack ([1, 1] ++ [50..81])
describe "ConnLinkData" $ do
it "decodes Haskell-encoded ContactLinkData with profile" $ do
let profileJson = "{\"displayName\":\"alice\",\"fullName\":\"Alice A\"}"
userData = AP.UserLinkData profileJson
ucd = AP.UserContactData {AP.direct = True, AP.owners = [], AP.relays = [], AP.userData = userData}
cld = AP.ContactLinkData (mkVersionRange (Version 1) (Version 3)) ucd :: AP.ConnLinkData 'AP.CMContact
encoded = smpEncode cld
tsResult <- callNode $ impAgentProto
<> "const r = decodeConnLinkData(new Decoder(" <> jsUint8 encoded <> "));"
<> "const p = parseProfile(r.userContactData.userData);"
<> "const enc = new TextEncoder();"
<> jsOut ("new Uint8Array(["
<> "r.agentVRange.min >> 8, r.agentVRange.min & 0xff,"
<> "r.agentVRange.max >> 8, r.agentVRange.max & 0xff,"
<> "r.userContactData.direct ? 1 : 0,"
<> "r.userContactData.owners.length,"
<> "r.userContactData.relays.length,"
<> "...enc.encode(p.displayName)"
<> "])")
tsResult `shouldBe` B.pack [0, 1, 0, 3, 1, 0, 0] <> "alice"
describe "ConnShortLink URI" $ do
it "parses simplex: contact link" $ do
let srv = SMPServer ("smp1.example.com" :| []) "" (C.KeyHash $ B.pack [1..32])
linkKey = AP.LinkKey $ B.pack [100..131]
link = AP.CSLContact AP.SLSSimplex AP.CCTContact srv linkKey
uri = strEncode link
tsResult <- callNode $ impAgentProto
<> "const r = connShortLinkStrP(" <> jsStr uri <> ");"
<> jsOut ("new Uint8Array([...r.linkKey, ...r.server.keyHash])")
tsResult `shouldBe` (B.pack [100..131] <> B.pack [1..32])
it "parses https: contact link with port" $ do
let srv = SMPServer ("smp2.example.com" :| []) "5223" (C.KeyHash $ B.pack [50..81])
linkKey = AP.LinkKey $ B.pack [200..231]
link = AP.CSLContact AP.SLSServer AP.CCTContact srv linkKey
uri = strEncode link
tsResult <- callNode $ impAgentProto
<> "const r = connShortLinkStrP(" <> jsStr uri <> ");"
<> "const enc = new TextEncoder();"
<> jsOut ("new Uint8Array([...r.linkKey, ...r.server.keyHash, ...enc.encode(r.server.port), 0, ...enc.encode(r.server.hosts.join(','))])")
let expected = B.pack [200..231] <> B.pack [50..81] <> "5223" <> B.singleton 0 <> "smp2.example.com"
tsResult `shouldBe` expected
it "parses simplex: contact link with multiple hosts" $ do
let srv = SMPServer ("host1.example.com" :| ["host2.example.com"]) "" (C.KeyHash $ B.pack [1..32])
linkKey = AP.LinkKey $ B.pack [10..41]
link = AP.CSLContact AP.SLSSimplex AP.CCTContact srv linkKey
uri = strEncode link
tsResult <- callNode $ impAgentProto
<> "const r = connShortLinkStrP(" <> jsStr uri <> ");"
<> "const enc = new TextEncoder();"
<> jsOut ("new Uint8Array([...r.linkKey, ...enc.encode(r.server.hosts.join(','))])")
tsResult `shouldBe` (B.pack [10..41] <> "host1.example.com,host2.example.com")
it "parses group link type" $ do
let srv = SMPServer ("smp.example.com" :| []) "" (C.KeyHash $ B.pack [1..32])
linkKey = AP.LinkKey $ B.pack [10..41]
link = AP.CSLContact AP.SLSSimplex AP.CCTGroup srv linkKey
uri = strEncode link
tsResult <- callNode $ impAgentProto
<> "const r = connShortLinkStrP(" <> jsStr uri <> ");"
<> "const enc = new TextEncoder();"
<> jsOut ("enc.encode(r.connType)")
tsResult `shouldBe` "group"
it "round-trips: Haskell encode -> TypeScript parse -> fields match" $ do
let srv = SMPServer ("server1.simplex.im" :| ["server2.simplex.im"]) "443" (C.KeyHash $ B.pack [1..32])
linkKey = AP.LinkKey $ B.pack [200..231]
link = AP.CSLContact AP.SLSServer AP.CCTContact srv linkKey
uri = strEncode link
-- TypeScript returns: mode, scheme, connType, host count, port, linkKey
tsResult <- callNode $ impAgentProto
<> "const r = connShortLinkStrP(" <> jsStr uri <> ");"
<> "const enc = new TextEncoder();"
<> jsOut ("new Uint8Array(["
<> "r.mode === 'contact' ? 1 : 0,"
<> "r.scheme === 'https' ? 1 : 0,"
<> "r.connType === 'contact' ? 1 : 0,"
<> "r.server.hosts.length,"
<> "...r.linkKey"
<> "])")
tsResult `shouldBe` B.pack ([1, 1, 1, 2] ++ [200..231])
describe "WebSocket handshake" $ do
it "TypeScript connects, verifies server identity, and completes SMP handshake" $ do
let msType = ASType SQSMemory SMSJournal
attachStaticAndWS "tests/fixtures" $ \attachHTTP ->
withSmpServerConfig (cfgWebOn msType testPort) (Just attachHTTP) $ \_ -> do
let C.KeyHash kh = testKeyHash
tsResult <- callNode $ impSodium <> impWS <> impProto
<> "try {"
<> "const conn = await connectSMP('wss://localhost:" <> testPort <> "', " <> jsUint8 kh <> ", {rejectUnauthorized: false, ALPNProtocols: ['http/1.1']});"
<> "const ping = encodeTransmission(new Uint8Array([0x31]), new Uint8Array(0), new Uint8Array([0x50,0x49,0x4E,0x47]));"
<> "sendBlock(conn.ws, blockPad(encodeBatch(ping), 16384));"
<> "const {decodeLarge} = await import('@simplex-chat/xftp-web/dist/protocol/encoding.js');"
<> "const resp = await receiveBlock(conn.ws);"
<> "const d = new Decoder(blockUnpad(resp));"
<> "d.anyByte();" -- batch count
<> "const inner = decodeLarge(d);"
<> "const t = decodeTransmission(new Decoder(inner));"
<> jsOut ("t.command")
<> "conn.ws.close(); setTimeout(() => process.exit(0), 100);"
<> "} catch(e) { process.stderr.write('ERROR: ' + e.message + '\\n'); process.exit(1); }"
tsResult `shouldBe` "PONG"
describe "end-to-end" $ do
it "TypeScript fetches short link data via WebSocket" $ do
let msType = ASType SQSMemory SMSJournal
attachStaticAndWS "tests/fixtures" $ \attachHTTP ->
withSmpServerConfig (cfgWebOn msType testPort) (Just attachHTTP) $ \_serverThread ->
withAgent 1 agentCfg initAgentServers testDB $ \a -> do
let testData = "hello from short link"
userData = UserLinkData testData
userCtData = UserContactData {direct = True, owners = [], relays = [], userData = userData}
newLinkData = UserContactLinkData userCtData
(_connId, (CCLink _connReq (Just shortLink), Nothing)) <-
runRight $ A.createConnection a NRMInteractive 1 True True AP.SCMContact (Just newLinkData) Nothing CR.IKPQOn SMSubscribe
let linkUri = strEncode shortLink
tsResult <- callNode $ impSodium <> impWS <> impAgentProto <> impProto_ <> impCryptoShortLink
<> "try {"
-- 1. Parse short link URI
<> "const link = connShortLinkStrP(" <> jsStr linkUri <> ");"
-- 2. Derive keys
<> "const {linkId, sbKey} = contactShortLinkKdf(link.linkKey);"
-- 3. Connect via WSS
<> "const conn = await connectSMP('wss://localhost:" <> testPort <> "', " <> jsUint8 (C.unKeyHash testKeyHash) <> ", {rejectUnauthorized: false, ALPNProtocols: ['http/1.1']});"
-- 4. Send LGET
<> "const lget = encodeTransmission(new Uint8Array([0x31]), linkId, encodeLGET());"
<> "sendBlock(conn.ws, blockPad(encodeBatch(lget), 16384));"
-- 5. Receive LNK response
<> "const resp = await receiveBlock(conn.ws);"
<> "const rd = new Decoder(blockUnpad(resp));"
<> "rd.anyByte();" -- batch count
<> "const inner = decodeLarge(rd);"
<> "const t = decodeTransmission(new Decoder(inner));"
<> "const r = decodeResponse(new Decoder(t.command));"
<> "if (r.type !== 'LNK') throw new Error('expected LNK, got ' + r.type);"
-- 6. Decrypt
<> "const dec = decryptLinkData(sbKey, r.response.encFixedData, r.response.encUserData);"
-- 7. Parse ConnLinkData to get UserLinkData
<> "const cld = decodeConnLinkData(new Decoder(dec.userData));"
<> jsOut ("cld.userContactData.userData")
<> "conn.ws.close(); setTimeout(() => process.exit(0), 100);"
<> "} catch(e) { process.stderr.write('ERROR: ' + e.message + '\\n'); process.exit(1); }"
tsResult `shouldBe` testData