Compare commits

...
Author SHA1 Message Date
shum e7f348c500 add plans 2026-02-17 15:06:18 +00:00
Evgeny @ SimpleX Chat 37b1d15c55 fix encoding for XFTPServerHandshake 2026-02-17 06:57:17 +00:00
Evgeny @ SimpleX Chat 0bc3210cbf xftp CLI to support link 2026-02-16 23:25:58 +00:00
Evgeny Poberezkin 6c0e5cbe89 delete test screenshot 2026-02-12 00:13:38 +00:00
Evgeny @ SimpleX Chat 1a1ca91a9e opfs fallback 2026-02-12 00:03:29 +00:00
Evgeny @ SimpleX Chat 3958e066da debugging 2026-02-11 23:18:33 +00:00
Evgeny @ SimpleX Chat e00e9a77c2 fix 2026-02-11 22:46:25 +00:00
Evgeny @ SimpleX Chat 59e740c6b1 improve error handling, handle browser reconnections/re-handshake 2026-02-11 21:01:40 +00:00
Evgeny Poberezkin 57c144d22d add plan 2026-02-11 07:52:01 +00:00
Evgeny @ SimpleX Chat 51c5615419 debug logging for page sessions 2026-02-11 07:49:33 +00:00
Evgeny @ SimpleX Chat 74eb22c5e3 remove debug logging in server/browser, run preview xftp server via cabal run to ensure the latest code is used 2026-02-11 07:45:22 +00:00
Evgeny @ SimpleX Chat 442a3bafa4 debug logging in web page and server 2026-02-11 06:42:55 +00:00
Evgeny @ SimpleX Chat 9a55137d08 web test cert fixtures 2026-02-10 23:49:27 +00:00
Evgeny @ SimpleX Chat cc7a7ee9aa fixed https in the test page 2026-02-10 23:21:31 +00:00
Evgeny @ SimpleX Chat 42b2fa013a local preview over https 2026-02-10 21:18:00 +00:00
Evgeny @ SimpleX Chat 9c0b6568f6 preview:local 2026-02-10 20:48:44 +00:00
Evgeny @ SimpleX Chat 37846194da fix tests 2026-02-10 20:24:29 +00:00
Evgeny @ SimpleX Chat 25c08ecc7f update TS client to pad hellos 2026-02-10 14:11:05 +00:00
Evgeny @ SimpleX Chat 6f11e2a648 concurrent and padded hellos in the server 2026-02-10 14:09:32 +00:00
Evgeny @ SimpleX Chat 9333777c0d page tests pass 2026-02-09 19:34:35 +00:00
Evgeny @ SimpleX Chat dfda816d60 allow sending xftp client hello after handshake - for web clients that dont know if established connection exists 2026-02-08 21:54:18 +00:00
Evgeny @ SimpleX Chat 78dc2cddec fixes and page test plan 2026-02-05 23:42:31 +00:00
Evgeny @ SimpleX Chat df3b7a5af9 fix test 3 2026-02-05 23:11:09 +00:00
Evgeny @ SimpleX Chat d38f2783ad fix test 2 2026-02-05 23:04:10 +00:00
Evgeny @ SimpleX Chat 289f02ad59 fix test 2026-02-05 22:53:40 +00:00
Evgeny @ SimpleX Chat 97773f0f30 webpage implementation (not tested) 2026-02-05 09:59:00 +00:00
Evgeny @ SimpleX Chat 3eee58ad31 improve plan 2026-02-04 21:34:46 +00:00
Evgeny @ SimpleX Chat e0bc43ce2d web page plan 2026-02-04 19:09:37 +00:00
Evgeny Poberezkin 3574df14e1 move rfcs 2026-02-04 16:17:56 +00:00
Evgeny @ SimpleX Chat 41d474f0d4 persistent client sessions 2026-02-04 16:05:17 +00:00
Evgeny @ SimpleX Chat af3a183cda browser environment 2026-02-04 12:05:30 +00:00
Evgeny Poberezkin 3eb6f40f54 client transport abstraction 2026-02-03 22:40:07 +00:00
Evgeny Poberezkin 3f15fa2a13 rfc: web transport 2026-02-03 13:55:52 +00:00
Evgeny Poberezkin 9a2279d4f0 support description "redirect" in agent.ts and cross-platform compatibility tests (Haskell <> TypeScript) 2026-02-03 13:53:52 +00:00
Evgeny Poberezkin 260380486a xftp-web client functions, fix transmission encoding 2026-02-02 22:05:04 +00:00
Evgeny Poberezkin 64089834f3 test for xftp web handshake 2026-02-02 17:41:25 +00:00
Evgeny Poberezkin 947edc2886 web handshake 2026-02-02 07:44:21 +00:00
Evgeny Poberezkin ad24813426 xftp server changes to support web slients: SNI-based certificate choice, CORS headers, OPTIONS request 2026-02-01 12:20:56 +00:00
Evgeny Poberezkin b6c4c8faee protocol, file descriptions, more cryptogrpahy, handshake encoding, etc. 2026-01-31 21:42:26 +00:00
Evgeny Poberezkin 4a4f719bfb xftp: implementation of XFTP client as web page (rfc, low level functions) 2026-01-31 12:41:18 +00:00
Evgeny Poberezkin 8fdc0703bc 6.5.0.8 2026-01-28 23:12:19 +00:00
Evgeny Poberezkin d7b90b8415 Merge branch 'stable' 2026-01-28 22:52:33 +00:00
Evgeny Poberezkin 9346b85c3f 6.4.8.0 2026-01-28 21:58:32 +00:00
Evgeny 3c5ec8d9a1 agent: improve error handling (#1707)
* agent: improve error handling

* simplify

* report critical error when subscriber crashes

* fix test
2026-01-28 21:54:41 +00:00
Evgeny d10e05b796 agent: split creating connection to two steps to prepare connection link in advance (#1704)
* agent: split creating connection to two steps to prepare connection link in advance

* linkEntityId, newOwnerAuth

* simplify
2026-01-27 10:54:13 +00:00
Evgeny 66cc06738e agent: fix tests for short links (#1703) 2026-01-26 00:11:50 +00:00
Evgeny Poberezkin 0f3b8a4a16 docs: update contributing 2026-01-24 18:05:01 +00:00
Evgeny a1596ed234 docs: contributing guide (#1702) 2026-01-24 13:33:17 +00:00
spaced4ndyandEvgeny Poberezkin 89b81d151f agent: getConnShortLinkAsync; implement joinConnectionAsync for contact connections; narrow setConnShortLinkAsync only to Contact connections (#1694)
* agent: getConnShortLinkAsync

* enable all tests

* comment

* comment

* join conn async for contact URI (wip)

* fix test

* remove enableNtfs param

* FixedLinkData

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2026-01-20 08:40:35 +00:00
Evgeny 3e5b654109 agent: support multiple link owners in link data (#1701)
* agent: support multiple link owners in link data

* fix
2026-01-19 22:08:11 +00:00
spaced4ndyandEvgeny Poberezkin ca26c69937 db: withSavepoint; agent: correctly handle errors in createWithRandomId for postgres (#1693)
* db: withSavepoint; agent: correctly handle errors in createWithRandomId

* comment

* refactor

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2026-01-15 14:59:45 +00:00
Evgeny Poberezkin 58212c421a 6.5.0.7 2026-01-13 20:55:38 +00:00
Evgenyandspaced4ndy 1000107259 agent: clean up old records in batches (#1692)
* agent: clean up old records in batches

* update

* update

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

* stabilize tests

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
2026-01-13 19:11:46 +00:00
Evgeny 6aadcf1f3f agent: lock rows for concurrent queries in PostgreSQL (#1688)
* agent: lock rows for concurrent queries in PostgreSQL

* fix race conditions in workers

* refactor
2026-01-08 11:09:58 +00:00
spaced4ndy 07604a146f agent: async command to set connection short link (setConnShortLinkAsync) (#1680) 2026-01-07 15:12:52 +00:00
Ritiek Malhotra 4c782d3191 docker: build multi-arch images for x86-64 and arm64 (#1540) 2026-01-07 10:49:21 +00:00
Evgeny c4b687ba64 agent: reset schema after changes (#1690) 2026-01-05 20:37:50 +00:00
Evgeny a7b43b1a3e agent: use strict tables (#1686)
* agent: use strict tables

* migrate existing tables to strict

* test: verify that all tables are strict

* fix column types for device_token and ntf_mode

* fix encodings and column types for ntf_sub_action and ntf_sub_smp_action

* update schema

* remove debug.trace

* log
2026-01-03 17:19:18 +00:00
Evgeny d6df769799 ntf server: additional tests (#1687) 2026-01-02 14:07:13 +00:00
Evgeny Poberezkin 5f73d1e629 6.5.0.6 2025-12-23 18:00:26 +00:00
Evgeny Poberezkin 70d1b99fb4 Merge branch 'stable' 2025-12-23 14:18:07 +00:00
Evgeny Poberezkin 2ea98db9d8 6.4.7.0 2025-12-23 12:42:46 +00:00
Evgeny bbe1c716e6 xrcp: treat any 127.x.x.x IP address as local (#1682) 2025-12-23 12:42:05 +00:00
Evgeny Poberezkin 77ac452190 6.5.0.5 2025-12-22 21:56:25 +00:00
Evgeny ea70575275 agent: use server cert hash when selecting server queues to subscribe (#1679) 2025-12-15 11:48:17 +00:00
Evgeny 49e9ce1649 agent: skip subscribing servers without queues (#1678) 2025-12-14 23:01:21 +00:00
Evgeny Poberezkin 2ca440dd2d 6.5.0.4 2025-12-10 21:09:33 +00:00
spaced4ndyandEvgeny Poberezkin 92a9579e69 agent: option to add SQLite aggregates to DB connection (#1673)
* agent: add build_relations_vector function to sqlite

* update aggregate

* use static aggregate

* remove relations

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2025-12-04 08:58:14 +00:00
Evgeny cf9b7e5b6a agent: option to add SQLite functions to DB connection (#1674)
* agent: option to add SQLite functions to DB connection

* add module
2025-12-03 16:10:35 +00:00
132 changed files with 17655 additions and 697 deletions
+8
View File
@@ -39,9 +39,17 @@ jobs:
type=semver,pattern=v{{major}}.{{minor}}
type=semver,pattern=v{{major}}
- name: Set up QEMU
uses: docker/setup-qemu-action@v3
- name: Set up Docker Buildx
uses: docker/setup-buildx-action@v3
- name: Build and push Docker image
uses: simplex-chat/docker-build-push-action@v6
with:
context: .
platforms: linux/amd64,linux/arm64
push: true
build-args: |
APP=${{ matrix.app }}
+1
View File
@@ -11,3 +11,4 @@ cabal.project.local~
.hpc/
*.tix
.coverage
@@ -0,0 +1,53 @@
# XFTPClientAgent Pattern
## TOC
1. Executive Summary
2. Changes: client.ts
3. Changes: agent.ts
4. Changes: test/browser.test.ts
5. Verification
## Executive Summary
Add `XFTPClientAgent` — a per-server connection pool matching the Haskell pattern. The agent caches `XFTPClient` instances by server URL. All orchestration functions (`uploadFile`, `downloadFile`, `deleteFile`) take `agent` as first parameter and use `getXFTPServerClient(agent, server)` instead of calling `connectXFTP` directly. Connections stay open on success; the caller creates and closes the agent.
`connectXFTP` and `closeXFTP` stay exported (used by `XFTPWebTests.hs` Haskell tests). The `browserClients` hack, per-function `connections: Map`, and `getOrConnect` are deleted.
## Changes: client.ts
**Add** after types section: `XFTPClientAgent` interface, `newXFTPAgent`, `getXFTPServerClient`, `closeXFTPServerClient`, `closeXFTPAgent`.
**Delete**: `browserClients` Map and all `isNode` browser-cache checks in `connectXFTP` and `closeXFTP`.
**Revert `closeXFTP`** to unconditional `c.transport.close()` (browser transport.close() is already a no-op).
`connectXFTP` stays exported (backward compat) but becomes a raw low-level function — no caching.
## Changes: agent.ts
**Imports**: replace `connectXFTP`/`closeXFTP` with `getXFTPServerClient`/`closeXFTPAgent` etc.
**Re-export** from agent.ts: `newXFTPAgent`, `closeXFTPAgent`, `XFTPClientAgent`.
**`uploadFile`**: add `agent: XFTPClientAgent` as first param. Replace `connectXFTP``getXFTPServerClient`. Remove `finally { closeXFTP }`. Pass `agent` to `uploadRedirectDescription`.
**`uploadRedirectDescription`**: change from `(client, server, innerFd)` to `(agent, server, innerFd)`. Get client via `getXFTPServerClient`.
**`downloadFile`**: add `agent` param. Delete local `connections: Map`. Replace `getOrConnect``getXFTPServerClient`. Remove finally cleanup. Pass `agent` to `downloadWithRedirect`.
**`downloadWithRedirect`**: add `agent` param. Same replacements. Remove try/catch cleanup. Recursive call passes `agent`.
**`deleteFile`**: add `agent` param. Same pattern.
**Delete**: `getOrConnect` function entirely.
## Changes: test/browser.test.ts
Create agent before operations, pass to upload/download, close in finally.
## Verification
1. `npx vitest --run` — browser round-trip test passes
2. No remaining `browserClients`, `getOrConnect`, or per-function `connections: Map` locals
3. `connectXFTP` and `closeXFTP` still exported (XFTPWebTests.hs compat)
4. All orchestration functions take `agent` as first param
+104
View File
@@ -0,0 +1,104 @@
# Coding and building
This file provides guidance on coding style and approaches and on building the code.
## Code Security
When designing code and planning implementations:
- Apply adversarial thinking, and consider what may happen if one of the communicating parties is malicious.
- Formulate an explicit threat model for each change - who can do which undesirable things and under which circumstances.
## Code Quality Standards
Haskell client and server code serves as system specification, not just implementation — we use type-driven design to reflect the business domain in types. Quality, conciseness, and clarity of Haskell code are critical.
## Code Style, Formatting and Approaches
The project uses **fourmolu** for Haskell code formatting. Configuration is in `fourmolu.yaml`.
**Key formatting rules:**
- 2-space indentation
- Trailing function arrows, commas, and import/export style
- Record brace without space: `{field = value}`
- Single newline between declarations
- Never use unicode symbols
- Inline `let` style with right-aligned `in`
**Format code before committing:**
```bash
# Format a single file
fourmolu -i src/Simplex/Messaging/Protocol.hs
```
Some files that use CPP language extension cannot be formatted as a whole, so individual code fragments need to be formatted.
**Follow existing code patterns:**
- Match the style of surrounding code
- Use qualified imports with short aliases (e.g., `import qualified Data.ByteString.Char8 as B`)
- Use record syntax for types with multiple fields
- Prefer explicit pattern matching over partial functions
**Comments policy:**
- Avoid redundant comments that restate what the code already says
- Only comment on non-obvious design decisions or tricky implementation details
- Function names and type signatures should be self-documenting
- Do not add comments like "wire format encoding" (Encoding class is always wire format) or "check if X" when the function name already says that
- Assume a competent Haskell reader
**Diff and refactoring:**
- Avoid unnecessary changes and code movements
- Never do refactoring unless it substantially reduces cost of solving the current problem, including the cost of refactoring
- Aim to minimize the code changes - do what is minimally required to solve users' problems
**Document and code structure:**
- **Never move existing code or sections around** - add new content at appropriate locations without reorganizing existing structure.
- When adding new sections to documents, continue the existing numbering scheme.
- Minimize diff size - prefer small, targeted changes over reorganization.
**Code analysis and review:**
- Trace data flows end-to-end: from origin, through storage/parameters, to consumption. Flag values that are discarded and reconstructed from partial data (e.g. extracted from a URI missing original fields) — this is usually a bug.
- Read implementations of called functions, not just signatures — if duplication involves a called function, check whether decomposing it resolves the duplication.
- Do not save time on analysis. Read every function in the data flow even when the interface seems clear — wrong assumptions about internals are the main source of missed bugs.
### Haskell Extensions
- `StrictData` enabled by default
- Use STM for safe concurrency
- Assume concurrency in PostgreSQL queries
- Comprehensive warning flags with strict pattern matching
## Build Commands
```bash
# Standard build
cabal build
# Fast build
cabal build --ghc-options -O0
# Build specific executables
cabal build exe:smp-server exe:xftp-server exe:ntf-server exe:xftp
# Build with PostgreSQL server support
cabal build -fserver_postgres
# Client-only library build (no server code)
cabal build -fclient_library
# Find binary location
cabal list-bin exe:smp-server
```
### Cabal Flags
- `swift`: Enable Swift JSON format
- `client_library`: Build without server code
- `client_postgres`: Use PostgreSQL instead of SQLite for agent persistence
- `server_postgres`: PostgreSQL support for server queue/notification store
## External Dependencies
Custom forks specified in `cabal.project`:
- `aeson`, `hs-socks` (SimpleX forks)
- `direct-sqlcipher`, `sqlcipher-simple` (encrypted SQLite)
- `warp`, `warp-tls` (HTTP server)
+105
View File
@@ -0,0 +1,105 @@
# SimpleXMQ repository
This file provides guidance on the project structure to help working with code in this repository.
## Project Overview
SimpleXMQ is a Haskell message broker implementing unidirectional (simplex) queues for privacy-preserving messaging.
Key components:
- **SimpleX Messaging Protocol**: SMP protocol definition and encodings ([code](../src/Simplex/Messaging/Protocol.hs), [transport code](../src/Simplex/Messaging/Transport.hs), [spec](../protocol/simplex-messaging.md)).
- **SMP Server**: Message broker with TLS, in-memory queues, optional persistence ([main code](../src/Simplex/Messaging/Server.hs), [all code files](../src/Simplex/Messaging/Server/), [executable](../apps/smp-server/)). For proxying SMP commands the server uses [lightweight SMP client](../src/Simplex/Messaging/Client/Agent.hs).
- **SMP Client**: Functional API with STM-based message delivery ([code](../src/Simplex/Messaging/Client.hs)).
- **SMP Agent**: High-level duplex connections via multiple simplex queues with E2E encryption ([code](../src/Simplex/Messaging/Agent.hs)). Implements Agent-to-agent protocol ([code](../src/Simplex/Messaging/Agent/Protocol.hs), [spec](../protocol/agent-protocol.md)) via intermediary agent client ([code](../src/Simplex/Messaging/Agent/Client.hs)).
- **XFTP**: SimpleX File Transfer Protocol, server and CLI client ([code](../src/Simplex/FileTransfer/), [spec](../protocol/xftp.md)).
- **XRCP**: SimpleX Remote Control Protocol ([code](`../src/Simplex/RemoteControl/`), [spec](../protocol/xrcp.md)).
- **Notifications**: Push notifications server requires PostgreSQL ([code](../src/Simplex/Messaging/Notifications), [executable](../apps/ntf-server/)). Client protocol is used for clients to communicate with the server ([code](../src/Simplex/Messaging/Notifications/Protocol.hs), [spec](../protocol/push-notifications.md)). For subscribing to SMP notifications the server uses [lightweight SMP client](../src/Simplex/Messaging/Client/Agent.hs).
## Architecture
For general overview see `../protocol/overview-tjr.md`.
SMP Protocol Layers:
```
TLS Transport → SMP Protocol → Agent Protocol → Application protocol
```
XFTP Protocol Layers:
```
TLS Transport (HTTP2 encoding) → XFTP Protocol → Out-of-band file descriptions
```
## Key Patterns
1. **Persistence**: All queue state managed via Software Transactional Memory or via PostgreSQL
- `Simplex.Messaging.Server.MsgStore.STM` - in-memory messages
- `Simplex.Messaging.Server.QueueStore.STM` - in-memory queue state
- `Simplex.Messaging.Server.MsgStore.Postgres` - message storage
- `Simplex.Messaging.Server.QueueStore.Postgres` - queue storage
2. **Append-Only Store Log**: Optional persistence via journal for in-memory storage
- `Simplex.Messaging.Server.StoreLog` - queue creation log
- Compacted on restart
3. **Agent Storage**:
- SQLite (default) or PostgreSQL
- Migrations in `src/Simplex/Messaging/Agent/Store/{SQLite,Postgres}/Migrations/`
4. **Protocol Versioning**: All layers support version negotiation
- `Simplex.Messaging.Version` - version range utilities
5. **Double Ratchet E2E**: Per-connection encryption
- `Simplex.Messaging.Crypto.Ratchet`
- SNTRUP761 post-quantum KEM (`src/Simplex/Messaging/Crypto/SNTRUP761/`)
## Source Layout
```
src/Simplex/
├── Messaging/
│ ├── Agent.hs # Main agent (~210KB)
│ ├── Server.hs # SMP server (~130KB)
│ ├── Client.hs # Client API (~65KB)
│ ├── Protocol.hs # Protocol types (~77KB)
│ ├── Crypto.hs # E2E encryption (~52KB)
│ ├── Transport.hs # Transport encoding over TLS
│ ├── Agent/Store/ # SQLite/Postgres persistence
│ ├── Server/ # Server internals (QueueStore, MsgStore, Control)
│ └── Notifications/ # Push notification system
├── FileTransfer/ # XFTP implementation for file transfers
└── RemoteControl/ # XRCP implementation for device discovery & control
```
## Protocol Documentation
- `protocol/overview-tjr.md`: SMP protocols stack overview
- `protocol/simplex-messaging.md`: SMP protocol spec (v19)
- `protocol/agent-protocol.md`: Agent protocol spec (v7)
- `protocol/xftp.md`: File transfer protocol
- `protocol/xrcp.md`: Remote control protocol
- `rfcs/`: Design RFCs for features
## Testing
```bash
# Run all tests
cabal test --test-show-details=streaming
# Run specific test group (uses HSpec)
cabal test --test-option=--match="/Core tests/Encryption tests/"
# Run single test
cabal test --test-option=--match="/SMP client agent/functional API/"
```
Tests require PostgreSQL running on `localhost:5432` when using `-fserver_postgres` or `-fclient_postgres`.
Test files are in `tests/` with structure:
- `Test.hs`: Main runner
- `AgentTests/`: Agent protocol and connection tests
- `CoreTests/`: Crypto, encoding, storage tests
- `ServerTests.hs`: SMP server tests
- `XFTPServerTests.hs`: File transfer tests
+23
View File
@@ -0,0 +1,23 @@
# Contributing to SimpleX repositories
## Focus on user problems
We do not make code changes to improve code - any change must address a specific user problem or request.
## Discuss the plans as early as possible
Please discuss the problem you want to solve and your detailed implementation plan with the project team prior to contributing, to avoid wasted time and additional changes. Acceptance of your contribution depends on your willingness and ability to iterate the proposed contribution to achieve the required quality level, coding style, test coverage, and alignment with user requirements as they are understood by the project team.
## Follow project structure, coding style and approaches
./PROJECT.md has information about the structure of this `simplexmq` repository.
./CODE.md has details about general requirements common for `simplexmq` and `simplex-chat` repositories.
This files can be used with LLM prompts, e.g. if you use Claude Code you can create CLAUDE.md file in project root importing content from these files:
```markdown
@README.md
@contributing/PROJECT.md
@contributing/CODE.md
```
-23
View File
@@ -1,23 +0,0 @@
common:
corrId - random BS, used as CbNonce
entityId - p2r tlsUniq
# setup
s->p: "proxy", uri, auth?
# unless connected
p->r: "p_handshake"
p<-r: "r_key", tls-signed dh pub
s<-r: "r_key", tls-signed dh pub # reply entityId contains tlsUniq
# working
s ; generate random dh priv, make shared secret
s->p: s2r("forward", random dh pub, SEND command blob)
p->r: p2r("forward", random dh pub, s2r("forward", ...)))
r->c@ "msg", ...
p<-r: p2r("r_res", s2r("ok" / "error", error))
s<-p@ s2r("ok" / "error", error)
# expired
p<-r@ p2r("error", "key expired")
s<-p@ "error", "key expired"
s ; reconnect
+304
View File
@@ -0,0 +1,304 @@
# SMP Server Page Generation — Overview
## Table of Contents
1. [Architecture](#architecture)
2. [Call Graph](#call-graph)
3. [Files by Layer](#files-by-layer)
4. [Data Flow: INI → Types → Template → HTML](#data-flow-ini--types--template--html)
5. [INI Configuration](#ini-configuration)
6. [ServerInformation Construction](#serverinformation-construction)
7. [Template Engine](#template-engine)
8. [Template Variables](#template-variables-indexhtml)
9. [Serving Modes and Routing](#serving-modes-and-routing)
10. [Link Pages](#link-pages)
11. [Static Assets](#static-assets)
---
## Architecture
The SMP server generates a static mini-site at startup and serves it via three possible mechanisms: standalone HTTP, standalone HTTPS, or ALPN-multiplexed on the SMP TLS port.
## Call Graph
```
Main.main
└─ smpServerCLI_(Static.generateSite, Static.serveStaticFiles, Static.attachStaticFiles, ...)
└─ runServer
├─ builds ServerInformation { ServerPublicConfig, Maybe ServerPublicInfo }
├─ runWebServer(path, httpsParams, serverInfo)
│ ├─ generateSite(si, onionHost, path) ← writes files to disk
│ │ ├─ serverInformation(si, onionHost) ← renders index.html
│ │ │ └─ render(E.indexHtml, substs)
│ │ │ └─ section_ / item_ ← template engine
│ │ ├─ copyDir "media" E.mediaContent
│ │ ├─ copyDir "well-known" E.wellKnown
│ │ └─ createLinkPage × 7 (contact, invitation, a, c, g, r, i)
│ │ └─ writes E.linkHtml
│ └─ serveStaticFiles(EmbeddedWebParams) ← starts HTTP/HTTPS Warp
│ └─ staticFiles(path) :: Application
│ └─ wai-app-static + .well-known rewrite
└─ [if sharedHTTP] attachStaticFiles(path, action)
└─ Warp's serveConnection on ALPN-routed HTTP connections
```
## Files by Layer
| Layer | File | Role |
|---|---|---|
| **Entry** | `apps/smp-server/Main.hs:21` | Wires `Static.*` into `smpServerCLI_` |
| **Orchestration** | `src/.../Server/Main.hs:466-603` | `runServer` — builds `ServerInformation`, calls `runWebServer`, decides `attachStaticFiles` vs standalone |
| **INI parsing** | `src/.../Server/Main.hs:748-779` | `serverPublicInfo` reads `[INFORMATION]` section into `ServerPublicInfo` |
| **INI generation** | `src/.../Server/Main/Init.hs:65-171` | `iniFileContent` generates `[WEB]` section; `informationIniContent` generates `[INFORMATION]` section |
| **Types** | `src/.../Server/Information.hs` | `ServerInformation`, `ServerPublicConfig`, `ServerPublicInfo`, `Entity`, `ServerContactAddress`, `PGPKey`, `HostingType`, etc. |
| **Generation** | `apps/smp-server/web/Static.hs:95-117` | `generateSite` — writes all files to disk |
| **Rendering** | `apps/smp-server/web/Static.hs:119-253` | `serverInformation` — builds substitution pairs; `render`/`section_`/`item_` — template engine |
| **Serving** | `apps/smp-server/web/Static.hs:39-93` | `serveStaticFiles` (standalone Warp), `attachStaticFiles` (shared TLS port), `staticFiles` (WAI app) |
| **Embedding** | `apps/smp-server/web/Static/Embedded.hs` | TH `embedFile`/`embedDir` for `index.html`, `link.html`, `media/`, `.well-known/` |
| **Transport routing** | `src/.../Server.hs:202-219` | `runServer` per-port — routes `sniUsed` TLS connections to `attachHTTP` |
| **Transport type** | `src/.../Server.hs:163` | `type AttachHTTP = Socket -> TLS.Context -> IO ()` |
| **Shared port detection** | `src/.../Server/CLI.hs:374-387` | `iniTransports` — sets `addHTTP=True` when a transport port matches `[WEB] https` |
## Data Flow: INI → Types → Template → HTML
```
smp-server.ini
├─ [INFORMATION] section
│ └─ serverPublicInfo (Main.hs:748)
│ └─ Maybe ServerPublicInfo
├─ [WEB] section
│ ├─ static_path → webStaticPath'
│ ├─ http → webHttpPort
│ └─ https + cert + key → webHttpsParams'
├─ [TRANSPORT] section
│ ├─ host → onionHost detection (find THOnionHost in parsed hosts)
│ └─ port → iniTransports (sets addHTTP when port == [WEB] https)
└─ Runtime config (ServerConfig fields)
└─ ServerPublicConfig { persistence, messageExpiration, statsEnabled, newQueuesAllowed, basicAuthEnabled }
└─ ServerInformation { config, information }
└─ serverInformation (Static.hs:119)
├─ substConfig: 5 always-present substitution pairs
├─ substInfo: conditional substitution pairs from ServerPublicInfo
└─ onionHost: optional meta tag
└─ render(E.indexHtml, substs)
└─ section_ / item_ engine
└─ ByteString → written to sitePath/index.html
```
## INI Configuration
### `[INFORMATION]` Section — parsed by `serverPublicInfo` (Main.hs:748-779)
| INI key | Type | Maps to |
|---|---|---|
| `source_code` | Required (gates entire section) | `ServerPublicInfo.sourceCode` |
| `usage_conditions` | Optional | `ServerConditions.conditions` |
| `condition_amendments` | Optional | `ServerConditions.amendments` |
| `server_country` | Optional, ISO-3166 2-letter | `ServerPublicInfo.serverCountry` |
| `operator` | Optional | `Entity.name` |
| `operator_country` | Optional, ISO-3166 | `Entity.country` |
| `website` | Optional | `ServerPublicInfo.website` |
| `admin_simplex` | Optional, SimpleX address | `ServerContactAddress.simplex` |
| `admin_email` | Optional | `ServerContactAddress.email` |
| `admin_pgp` + `admin_pgp_fingerprint` | Optional, both required | `PGPKey` |
| `complaints_simplex`, `complaints_email`, `complaints_pgp`, `complaints_pgp_fingerprint` | Same structure as admin | `ServerPublicInfo.complaintsContacts` |
| `hosting` | Optional | `Entity.name` |
| `hosting_country` | Optional, ISO-3166 | `Entity.country` |
| `hosting_type` | Optional | `HostingType` (virtual/dedicated/colocation/owned) |
If `source_code` is absent, `serverPublicInfo` returns `Nothing` and the entire information section is omitted.
### `[WEB]` Section — parsed in `runServer` (Main.hs:597-603)
| INI key | Parser | Variable |
|---|---|---|
| `static_path` | `lookupValue` | `webStaticPath'` — if absent, no site generated |
| `http` | `read . T.unpack` | `webHttpPort` — standalone HTTP Warp |
| `https` | `read . T.unpack` | `webHttpsParams'.port` — standalone HTTPS Warp OR shared port |
| `cert` | `T.unpack` | `webHttpsParams'.cert` |
| `key` | `T.unpack` | `webHttpsParams'.key` |
### `[TRANSPORT]` Section — affects serving mode
| INI key | Effect on page serving |
|---|---|
| `host` | Parsed for `.onion` hostnames → `onionHost``<x-onionHost>` meta tag |
| `port` | Comma-separated ports. If any matches `[WEB] https`, that port gets `addHTTP=True` |
## ServerInformation Construction
Built in `runServer` (Main.hs:454-465) from runtime `ServerConfig` fields:
```haskell
ServerPublicConfig
{ persistence -- derived from serverStoreCfg:
-- SSCMemory Nothing → SPMMemoryOnly
-- SSCMemory (Just {storeMsgsFile=Nothing}) → SPMQueues
-- otherwise → SPMMessages
, messageExpiration -- ttl <$> cfg.messageExpiration
, statsEnabled -- isJust logStats
, newQueuesAllowed -- cfg.allowNewQueues
, basicAuthEnabled -- isJust cfg.newQueueBasicAuth
}
ServerInformation { config, information }
-- information = cfg.information :: Maybe ServerPublicInfo (from INI [INFORMATION])
```
## Template Engine
Custom two-pass substitution in `Static.hs:219-253`:
1. **`render`**: Iterates over `[(label, Maybe content)]` pairs, calling `section_` for each.
2. **`section_`**: Finds `<x-label>...</x-label>` markers. If the substitution value is `Just non-empty`, keeps the section and processes inner `${label}` items via `item_`. If `Nothing` or empty, collapses the entire section. If no section markers found, delegates to `item_` on the whole source.
3. **`item_`**: Replaces all `${label}` occurrences with the value.
## Template Variables (index.html)
### Substitution Pairs — built by `serverInformation` (Static.hs:119-190)
**`substConfig`** (always present, derived from `ServerPublicConfig`):
| Label | Value |
|---|---|
| `persistence` | `"In-memory only"` / `"Queues"` / `"Queues and messages"` |
| `messageExpiration` | `timedTTLText ttl` or `"Never"` |
| `statsEnabled` | `"Yes"` / `"No"` |
| `newQueuesAllowed` | `"Yes"` / `"No"` |
| `basicAuthEnabled` | `"Yes"` / `"No"` |
**`substInfo`** (from `Maybe ServerPublicInfo`, with `emptyServerInfo ""` as fallback):
| Label | Source | Conditional |
|---|---|---|
| `sourceCode` | `spi.sourceCode` | Section present if non-empty |
| `noSourceCode` | `Just "none"` if sourceCode empty | Inverse of above |
| `version` | `simplexMQVersion` | Always |
| `commitSourceCode` | `spi.sourceCode` or `simplexmqSource` | Always |
| `shortCommit` | `take 7 simplexmqCommit` | Always |
| `commit` | `simplexmqCommit` | Always |
| `website` | `spi.website` | Section collapsed if Nothing |
| `usageConditions` | `conditions` | Section collapsed if Nothing |
| `usageAmendments` | `amendments` | Section collapsed if Nothing |
| `operator` | `Just ""` (section marker) | Section collapsed if no operator |
| `operatorEntity` | `entity.name` | Inside operator section |
| `operatorCountry` | `entity.country` | Inside operator section |
| `admin` | `Just ""` (section marker) | Section collapsed if no adminContacts |
| `adminSimplex` | `strEncode simplex` | Inside admin section |
| `adminEmail` | `email` | Inside admin section |
| `adminPGP` | `pkURI` | Inside admin section |
| `adminPGPFingerprint` | `pkFingerprint` | Inside admin section |
| `complaints` | Same structure as admin | Section collapsed if no complaintsContacts |
| `hosting` | `Just ""` (section marker) | Section collapsed if no hosting |
| `hostingEntity` | `entity.name` | Inside hosting section |
| `hostingCountry` | `entity.country` | Inside hosting section |
| `serverCountry` | `spi.serverCountry` | Section collapsed if Nothing |
| `hostingType` | `strEncode`, capitalized first letter | Section collapsed if Nothing |
**`onionHost`** (separate):
| Label | Source |
|---|---|
| `onionHost` | `strEncode <$> onionHost` — from `[TRANSPORT] host`, first `.onion` entry |
## Serving Modes and Routing
### Mode Decision (Main.hs:466-477)
```
webStaticPath' = [WEB] static_path from INI
sharedHTTP = any transport port matches [WEB] https port
case webStaticPath' of
Just path | sharedHTTP →
runWebServer path Nothing si -- generate site, NO standalone HTTPS (shared instead)
attachStaticFiles path $ \attachHTTP →
runSMPServer cfg (Just attachHTTP) -- SMP server with HTTP routing callback
Just path →
runWebServer path webHttpsParams' si -- generate site, maybe start standalone HTTP/HTTPS
runSMPServer cfg Nothing -- SMP server without HTTP routing
Nothing →
logWarn "No server static path set"
runSMPServer cfg Nothing
```
### `runWebServer` (Main.hs:587-596)
1. Extracts `onionHost` from `[TRANSPORT] host` (finds first `THOnionHost`)
2. Extracts `webHttpPort` from `[WEB] http`
3. Calls `generateSite si onionHost webStaticPath` — writes all files
4. If `webHttpPort` or `webHttpsParams` set → calls `serveStaticFiles` (starts standalone Warp)
### Shared Port — ALPN Routing (Server.hs:202-219)
`iniTransports` (CLI.hs:374-387) builds `[(ServiceName, ASrvTransport, AddHTTP)]`:
- For each comma-separated port in `[TRANSPORT] port`, creates a `(port, TLS, addHTTP)` entry
- `addHTTP = True` when `port == [WEB] https`
Per-port `runServer` (Server.hs:202):
- If `httpCreds` + `attachHTTP_` + `addHTTP` all present:
- Uses `combinedCreds = TLSServerCredential { credential = smpCreds, sniCredential = Just httpCreds }`
- `runTransportServerState_` with HTTPS TLS params
- On each connection: if `sniUsed` (client connected using the HTTP SNI credential) → calls `attachHTTP socket tlsContext`
- Otherwise → normal SMP client handling
- If not: standard SMP transport, no HTTP routing
### `attachStaticFiles` (Static.hs:52-73)
Initializes Warp internal state (`WI.withII`) once, then provides a callback that:
1. Gets peer address from socket
2. Attaches the TLS context as a Warp connection (`WT.attachConn`)
3. Registers a timeout handler
4. Calls `WI.serveConnection` — Warp processes HTTP requests using `staticFiles` WAI app
### `staticFiles` WAI Application (Static.hs:78-93)
- Uses `wai-app-static` (`S.staticApp`) rooted at the generated site directory
- Directory listing disabled (`ssListing = Nothing`)
- Custom MIME type: `apple-app-site-association``application/json`
- Path rewrite: `/.well-known/...``/well-known/...` (because `staticApp` doesn't allow hidden folders)
## Link Pages
`link.html` is used unchanged for `/contact/`, `/invitation/`, `/a/`, `/c/`, `/g/`, `/r/`, `/i/`. Each path gets a directory with `index.html` = `E.linkHtml`.
Client-side `contact.js`:
1. Reads `document.location` URL
2. Extracts path action (`contact`, `a`, etc.)
3. Rewrites protocol to `https://`
4. Constructs `simplex:` app URI with hostname injection into hash params
5. Sets `mobileConnURIanchor.href` to app URI
6. Renders QR code of the HTTPS URL via `qrcode.js`
## Static Assets
All under `apps/smp-server/static/`, embedded at compile time via `file-embed` TH:
| File | Embedded via | Purpose |
|---|---|---|
| `index.html` | `embedFile``E.indexHtml` | Server information page template |
| `link.html` | `embedFile``E.linkHtml` | Contact/invitation link page |
| `media/*` | `embedDir``E.mediaContent` | CSS, JS, fonts, icons (23 files) |
| `.well-known/*` | `embedDir``E.wellKnown` | `apple-app-site-association`, `assetlinks.json` |
Media files include: `style.css`, `tailwind.css`, `script.js`, `contact.js`, `qrcode.js`, `swiper-bundle.min.{css,js}`, `favicon.ico`, `logo-{light,dark}.png`, `logo-symbol-{light,dark}.svg`, `sun.svg`, `moon.svg`, `apple_store.svg`, `google_play.svg`, `f_droid.svg`, `testflight.png`, `apk_icon.png`, `contact_page_mobile.png`, `Gilroy{Bold,Light,Medium,Regular,RegularItalic}.woff2`.
### Cabal Dependencies (smp-server executable, simplexmq.cabal:398-429)
```
other-modules: Static, Static.Embedded
hs-source-dirs: apps/smp-server, apps/smp-server/web
build-depends: file-embed, wai, wai-app-static, warp ==3.3.30, warp-tls ==3.4.7,
network, directory, filepath, text, bytestring, unliftio, simple-logger
```
+491
View File
@@ -0,0 +1,491 @@
# XFTP Server Pages Implementation Plan
## Table of Contents
1. [Context](#context)
2. [Executive Summary](#executive-summary)
3. [High-Level Design](#high-level-design)
4. [Detailed Implementation Plan](#detailed-implementation-plan)
5. [Verification](#verification)
---
## 1. Context
The SMP server has a full web infrastructure: server info page, link pages, static site generation, and serving (standalone HTTP/HTTPS or shared TLS port). The XFTP server has none of this — only `httpCredentials` for CORS/browser access to the XFTP protocol.
**Goal:** Add XFTP server pages identical in structure to SMP, with XFTP-specific configuration display and a `/file` page embedding the xftp-web upload/download app.
---
## 2. Executive Summary
**Share SMP's `Static.hs` via `hs-source-dirs`** — XFTP's cabal section references `apps/smp-server/web` for `Static.hs`, while providing its own `Static/Embedded.hs` with XFTP-specific templates. Zero code duplication for serving/rendering logic.
**Key changes (Haskell):**
- Parameterize `Static.hs`: use `E.linkPages` + `E.extraDirs` instead of hardcoded link page list
- Create `apps/xftp-server/web/Static/Embedded.hs` (XFTP templates + xftp-web dist)
- Create `apps/xftp-server/static/index.html` (XFTP server info template)
- Add `xftpServerCLI_` callback pattern (mirrors `smpServerCLI_`)
- Add `[INFORMATION]` section, `[WEB] static_path/http/relay_servers` to XFTP INI parsing/generation
- Update `simplexmq.cabal`: XFTP exe gets `Static`, `Static.Embedded` modules + web deps
**Key changes (TypeScript):**
- `servers.ts`: add `loadServers()` — fetches `./servers.json` at runtime, falls back to baked-in defaults
- `main.ts`: call `await loadServers()` before `initApp()`
- `vite.config.ts`: add `server` mode (empty baked-in servers, CSP placeholder preserved, `base: './'`)
**Reused without duplication:**
- `ServerInformation`, `ServerPublicConfig`, `ServerPublicInfo` types (`src/Simplex/Messaging/Server/Information.hs`)
- `serverPublicInfo` INI parser (`src/Simplex/Messaging/Server/Main.hs`)
- `EmbeddedWebParams`, `WebHttpsParams` types (`src/Simplex/Messaging/Server/Main.hs`)
- All of `Static.hs`: `generateSite`, `serverInformation`, `serveStaticFiles`, `attachStaticFiles`, `staticFiles`, `render`, `section_`, `item_`, `timedTTLText`
- All media assets (CSS, JS, fonts, icons) via `$(embedDir "apps/smp-server/static/media/")`
---
## 3. High-Level Design
### Module Sharing Strategy
```
apps/smp-server/web/Static.hs ← SHARED (both exes use this)
apps/smp-server/web/Static/Embedded.hs ← SMP-specific embedded content
apps/xftp-server/web/Static/Embedded.hs ← XFTP-specific embedded content
XFTP cabal hs-source-dirs order:
1. apps/xftp-server/web → finds Static/Embedded.hs (XFTP version)
2. apps/smp-server/web → finds Static.hs (shared)
GHC searches source dirs in order, first match wins:
Static.hs → NOT in xftp-server/web → found in smp-server/web ✓
Static/Embedded → found in xftp-server/web first ✓
```
**Note:** `Static.hs` imports `Simplex.Messaging.Server (AttachHTTP)` — this SMP module IS exposed in the library, so the XFTP executable can import it. `AttachHTTP` is just a type alias `Socket -> TLS.Context -> IO ()`.
### ServerPublicConfig Mapping (XFTP → existing fields)
| XFTP concept | `ServerPublicConfig` field | Value |
|---|---|---|
| *(not applicable)* | `persistence` | `SPMMemoryOnly` |
| File expiration | `messageExpiration` | `ttl <$> fileExpiration` |
| Stats enabled | `statsEnabled` | `isJust logStats` |
| File upload allowed | `newQueuesAllowed` | `allowNewFiles` |
| Basic auth enabled | `basicAuthEnabled` | `isJust newFileBasicAuth` |
The XFTP `index.html` template uses the same `${...}` variable names but has different label text. The `persistence` row is omitted from the XFTP template entirely.
### `/file` Page Architecture
```
sitePath/
index.html ← XFTP server info page (from template)
media/ ← shared CSS, JS, fonts, icons
well-known/ ← AASA, assetlinks
file/ ← xftp-web dist (from extraDirs)
index.html ← CSP patched at site generation time
servers.json ← generated from [WEB] relay_servers
assets/
index-xxx.js ← xftp-web compiled JS bundle
index-xxx.css ← styles
crypto.worker-xxx.js ← encryption Web Worker
```
### Data Flow at Runtime
```
file-server.ini
├─ [INFORMATION] → serverPublicInfo → Maybe ServerPublicInfo
├─ [WEB] relay_servers → relayServers :: [Text]
├─ [WEB] static_path → sitePath
└─ XFTPServerConfig fields → ServerPublicConfig
ServerInformation {config, information}
generateSite si onionHost sitePath ← writes index.html + media + file/
writeRelayConfig sitePath relayServers ← writes file/servers.json, patches CSP
serveStaticFiles EmbeddedWebParams ← standalone HTTP/HTTPS warp
```
---
## 4. Detailed Implementation Plan
### Step 1: Parameterize `Static.hs`
**File:** `apps/smp-server/web/Static.hs`
1. Add import: `System.FilePath (takeDirectory)`
2. Replace hardcoded link pages with `E.linkPages`; add `E.extraDirs` copying:
```haskell
-- BEFORE:
createLinkPage "contact"
createLinkPage "invitation"
createLinkPage "a"
createLinkPage "c"
createLinkPage "g"
createLinkPage "r"
createLinkPage "i"
-- AFTER:
mapM_ createLinkPage E.linkPages
forM_ E.extraDirs $ \(dir, content) -> do
createDirectoryIfMissing True $ sitePath </> dir
forM_ content $ \(path, s) -> do
createDirectoryIfMissing True $ sitePath </> dir </> takeDirectory path
B.writeFile (sitePath </> dir </> path) s
```
No change to `serverInformation` — it already uses `E.indexHtml` which resolves per-app via the `Embedded` module.
### Step 2: Update SMP's `Static/Embedded.hs`
**File:** `apps/smp-server/web/Static/Embedded.hs`
Add two new exports to maintain the shared interface:
```haskell
linkPages :: [FilePath]
linkPages = ["contact", "invitation", "a", "c", "g", "r", "i"]
extraDirs :: [(FilePath, [(FilePath, ByteString)])]
extraDirs = []
```
### Step 3: Create XFTP's `Static/Embedded.hs`
**New file:** `apps/xftp-server/web/Static/Embedded.hs`
```haskell
module Static.Embedded where
import Data.FileEmbed (embedDir, embedFile)
import Data.ByteString (ByteString)
indexHtml :: ByteString
indexHtml = $(embedFile "apps/xftp-server/static/index.html")
linkHtml :: ByteString
linkHtml = "" -- unused: XFTP has no simple link pages
mediaContent :: [(FilePath, ByteString)]
mediaContent = $(embedDir "apps/smp-server/static/media/") -- reuse SMP media
wellKnown :: [(FilePath, ByteString)]
wellKnown = $(embedDir "apps/smp-server/static/.well-known/")
linkPages :: [FilePath]
linkPages = []
extraDirs :: [(FilePath, [(FilePath, ByteString)])]
extraDirs = [("file", $(embedDir "xftp-web/dist-web/"))]
```
**Build dependency:** `xftp-web/dist-web/` must exist at compile time. Build with `cd xftp-web && npm run build -- --mode server` first.
### Step 4: Create XFTP `index.html` Template
**New file:** `apps/xftp-server/static/index.html`
Copy SMP's `apps/smp-server/static/index.html` with these differences:
- Title: "SimpleX XFTP - Server Information"
- Nav link list: add `<li>` for "/file" ("File transfer")
- Configuration section:
- **Remove** "Persistence" row
- "File expiration:" → `${messageExpiration}`
- "Stats enabled:" → `${statsEnabled}`
- "File upload allowed:" → `${newQueuesAllowed}`
- "Basic auth enabled:" → `${basicAuthEnabled}`
- Public information section: identical (same template variables, same structure)
- Footer: identical
### Step 5: Add `xftpServerCLI_` with Callbacks
**File:** `src/Simplex/FileTransfer/Server/Main.hs`
**New imports:**
```haskell
import Simplex.Messaging.Server.Information
import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..), serverPublicInfo, simplexmqSource)
import Simplex.Messaging.Transport.Client (TransportHost (..))
```
**New function** (mirrors `smpServerCLI_`):
```haskell
xftpServerCLI_ ::
(ServerInformation -> Maybe TransportHost -> FilePath -> IO ()) ->
(EmbeddedWebParams -> IO ()) ->
FilePath -> FilePath -> IO ()
```
**Refactor existing:**
```haskell
xftpServerCLI :: FilePath -> FilePath -> IO ()
xftpServerCLI = xftpServerCLI_ (\_ _ _ -> pure ()) (\_ -> pure ())
```
**In `runServer`, add after `printXFTPConfig`:**
1. Build `ServerPublicConfig` (see mapping table in Section 3)
2. Build `ServerInformation {config, information = serverPublicInfo ini}`
3. Parse web config:
- `webStaticPath' = eitherToMaybe $ T.unpack <$> lookupValue "WEB" "static_path" ini`
- `webHttpPort = eitherToMaybe $ read . T.unpack <$> lookupValue "WEB" "http" ini`
- `webHttpsParams'` = `{port, cert, key}` from `[WEB]` (same pattern as SMP)
- `relayServers = eitherToMaybe $ T.splitOn "," <$> lookupValue "WEB" "relay_servers" ini`
4. Extract `onionHost` from `[TRANSPORT] host` (same as SMP)
5. Web server logic:
```haskell
case webStaticPath' of
Just path -> do
generateSite si onionHost path
-- Post-process: inject relay server config into /file page
forM_ relayServers $ \servers -> do
let fileDir = path </> "file"
hosts = map (encodeUtf8 . T.strip) $ filter (not . T.null) servers
-- Write servers.json for xftp-web runtime loading
B.writeFile (fileDir </> "servers.json") $ "[" <> B.intercalate "," (map (\h -> "\"" <> h <> "\"") hosts) <> "]"
-- Patch CSP connect-src in file/index.html (inline ByteString replacement)
let cspHosts = B.intercalate " " $ map (parseXFTPHost . T.strip) $ filter (not . T.null) servers
marker = "__CSP_CONNECT_SRC__"
fileIndex <- B.readFile (fileDir </> "index.html")
let (before, after) = B.breakSubstring marker fileIndex
patched = if B.null after then fileIndex
else before <> cspHosts <> B.drop (B.length marker) after
B.writeFile (fileDir </> "index.html") patched
when (isJust webHttpPort || isJust webHttpsParams') $
serveStaticFiles EmbeddedWebParams {webStaticPath = path, webHttpPort, webHttpsParams = webHttpsParams'}
runXFTPServer serverConfig
Nothing -> runXFTPServer serverConfig
```
Where `parseXFTPHost` extracts `https://host:port` from an `xftp://fingerprint@host:port` address.
**Note:** `B.replace` is not in `Data.ByteString.Char8`. Use a simple find-and-replace helper (similar pattern to `item_` in `Static.hs`), or use `Data.ByteString.Search` from `stringsearch` package, or inline a ByteString replacement.
### Step 6: Update XFTP INI Generation
**File:** `src/Simplex/FileTransfer/Server/Main.hs` (in `iniFileContent`)
Add to the generated INI string:
After existing `[WEB]` section:
```ini
[WEB]
# cert: /etc/opt/simplex-xftp/web.crt
# key: /etc/opt/simplex-xftp/web.key
# static_path: /var/opt/simplex-xftp/www
# http: 8080
# relay_servers: xftp://fingerprint@host1,xftp://fingerprint@host2
```
Add new `[INFORMATION]` section (same format as SMP):
```ini
[INFORMATION]
# source_code: https://github.com/simplex-chat/simplexmq
# usage_conditions:
# condition_amendments:
# server_country:
# operator:
# operator_country:
# website:
# admin_simplex:
# admin_email:
# admin_pgp:
# admin_pgp_fingerprint:
# complaints_simplex:
# complaints_email:
# complaints_pgp:
# complaints_pgp_fingerprint:
# hosting:
# hosting_country:
# hosting_type: virtual
```
### Step 7: Update XFTP Entry Point
**File:** `apps/xftp-server/Main.hs`
```haskell
import qualified Static
import Simplex.FileTransfer.Server.Main (xftpServerCLI_)
main = do
...
withGlobalLogging logCfg $ xftpServerCLI_ Static.generateSite Static.serveStaticFiles cfgPath logPath
```
### Step 8: Update `simplexmq.cabal`
**xftp-server executable:**
```cabal
executable xftp-server
main-is: Main.hs
other-modules:
Static
Static.Embedded
Paths_simplexmq
hs-source-dirs:
apps/xftp-server
apps/xftp-server/web
apps/smp-server/web
build-depends:
base
, bytestring
, directory
, file-embed
, filepath
, network
, simple-logger
, simplexmq
, text
, unliftio
, wai
, wai-app-static
, warp ==3.3.30
, warp-tls ==3.4.7
```
**extra-source-files:** Add:
```cabal
apps/xftp-server/static/index.html
```
### Step 9: Modify xftp-web — Runtime Server Loading
**File:** `xftp-web/web/servers.ts`
```typescript
import {parseXFTPServer, type XFTPServer} from '../src/protocol/address.js'
declare const __XFTP_SERVERS__: string[]
const defaultServers: string[] = __XFTP_SERVERS__
let runtimeServers: string[] | null = null
export async function loadServers(): Promise<void> {
try {
const resp = await fetch('./servers.json')
if (resp.ok) {
const data: string[] = await resp.json()
if (Array.isArray(data) && data.length > 0) {
runtimeServers = data
}
}
} catch { /* fall back to defaults */ }
}
export function getServers(): XFTPServer[] {
return (runtimeServers ?? defaultServers).map(parseXFTPServer)
}
export function pickRandomServer(servers: XFTPServer[]): XFTPServer {
return servers[Math.floor(Math.random() * servers.length)]
}
```
**File:** `xftp-web/web/main.ts` — add `loadServers` import and call:
```typescript
import {loadServers} from './servers.js'
async function main() {
await sodium.ready
await loadServers()
initApp()
window.addEventListener('hashchange', initApp)
}
```
**File:** `xftp-web/web/download.ts` — NO changes needed (uses server addresses from file description in URL hash, not `getServers()`).
### Step 10: Modify xftp-web — Vite `server` Build Mode
**File:** `xftp-web/vite.config.ts`
Add `server` mode handling:
```typescript
if (mode === 'server') {
define['__XFTP_SERVERS__'] = JSON.stringify([])
servers = []
} else if (mode === 'development') {
// ... existing dev logic
} else {
// ... existing production logic
}
```
CSP plugin: skip replacement in server mode:
```typescript
handler(html) {
if (isDev) return html.replace(/<meta\s[^>]*?Content-Security-Policy[\s\S]*?>/i, '')
if (mode === 'server') return html // leave __CSP_CONNECT_SRC__ placeholder
return html.replace('__CSP_CONNECT_SRC__', origins)
}
```
Add `base: './'` for server mode (relative asset paths, needed for `/file/` subpath):
```typescript
base: mode === 'server' ? './' : '/',
```
### `servers.json` Format
Generated at site-generation time by the Haskell server:
```json
["xftp://fingerprint1@host1:443", "xftp://fingerprint2@host2:443"]
```
Simple JSON array of XFTP server address strings.
### Fallback Behavior
| Scenario | Upload servers | Download servers |
|---|---|---|
| `relay_servers` configured | From `servers.json` | From file description (URL hash) |
| `relay_servers` not configured | Build-time defaults (empty in server mode) | From file description (URL hash) |
| No `static_path` configured | No `/file` page served | N/A |
---
## 5. Verification
### Build
```bash
# 1. Build xftp-web for server embedding
cd xftp-web && npm run build -- --mode server && cd ..
# 2. Build both servers (fast, no optimization)
cabal build smp-server --ghc-options=-O0
cabal build xftp-server --ghc-options=-O0
```
### Test
```bash
cabal test simplexmq-test --ghc-options=-O0
```
### Manual Smoke Test
1. `cabal run xftp-server -- init -p /tmp/xftp-files -q 10gb`
2. Edit `file-server.ini`: uncomment `static_path`, `http: 8080`, add `relay_servers`
3. `cabal run xftp-server -- start`
4. `curl http://localhost:8080/` → server info HTML
5. `curl http://localhost:8080/file/` → xftp-web HTML
6. `curl http://localhost:8080/file/servers.json` → relay servers JSON
### Files Modified (Summary)
| File | Type | Change |
|---|---|---|
| `apps/smp-server/web/Static.hs` | Modify | `E.linkPages`, `E.extraDirs`, `takeDirectory` import |
| `apps/smp-server/web/Static/Embedded.hs` | Modify | Add `linkPages`, `extraDirs` exports |
| `apps/xftp-server/Main.hs` | Modify | Import Static, use `xftpServerCLI_` |
| `apps/xftp-server/web/Static/Embedded.hs` | **NEW** | XFTP templates + xftp-web dist embedding |
| `apps/xftp-server/static/index.html` | **NEW** | XFTP server info HTML template |
| `src/Simplex/FileTransfer/Server/Main.hs` | Modify | `xftpServerCLI_`, web logic, INI parsing/generation |
| `simplexmq.cabal` | Modify | XFTP exe: modules, deps, source dirs, extra-source-files |
| `xftp-web/web/servers.ts` | Modify | Add `loadServers()` for runtime config |
| `xftp-web/web/main.ts` | Modify | Call `loadServers()` at startup |
| `xftp-web/vite.config.ts` | Modify | `server` mode, conditional `base` |
File diff suppressed because it is too large Load Diff
@@ -0,0 +1,154 @@
# XFTP Server: SNI, CORS, and Web Support
Implementation details for Phase 3 of `rfcs/2026-01-30-send-file-page.md` (sections 6.1-6.4).
## 1. Overview
The XFTP server is extended to support web browser clients by:
1. **SNI-based TLS certificate switching** — Present a CA-issued web certificate (e.g., Let's Encrypt) to browsers, while continuing to present the self-signed XFTP identity certificate to native clients.
2. **CORS headers** — Add CORS response headers on SNI connections so browsers allow cross-origin XFTP requests.
3. **Configuration**`[WEB]` INI section for HTTPS cert/key paths; opt-in (commented out by default).
Web handshake (challenge-response identity proof, §6.3 of parent RFC) is not yet implemented and will be added separately.
## 2. SNI Certificate Switching
### 2.1 Reusing the SMP Pattern
The SMP server already implements SNI-based certificate switching via `TLSServerCredential` and `runTransportServerState_` (see `rfcs/2024-09-15-shared-port.md`). The XFTP server applies the same pattern with one key difference: both native and web XFTP clients use HTTP/2 transport, whereas SMP switches between raw SMP protocol and HTTP entirely.
### 2.2 Approach
When `httpServerCreds` is configured, the XFTP server bypasses `runHTTP2Server` and uses `runTransportServerState_` directly to obtain the per-connection `sniUsed` flag. It then sets up HTTP/2 manually on each TLS connection using `withHTTP2` (same internals as `runHTTP2ServerWith_`). The `sniUsed` flag is captured in the closure and shared by all HTTP/2 requests on that connection.
When `httpServerCreds` is absent, the existing `runHTTP2Server` path is unchanged.
```
Native client (no SNI) ──TLS──> XFTP identity cert ──HTTP/2──> processRequest (no CORS)
Browser client (SNI) ──TLS──> Web CA cert ──HTTP/2──> processRequest (+ CORS)
```
### 2.3 Certificate Chain
The web certificate file (e.g., `web.crt`) must contain the full chain: leaf certificate followed by the signing CA certificate. `loadServerCredential` uses `T.credentialLoadX509Chain` which reads all PEM blocks from the file.
The client validates the chain by comparing `idCert` fingerprint (the CA cert, second in the 2-cert chain) against the known `keyHash`. This is the same validation as for XFTP identity certificates — the CA that signed the web cert must match the XFTP server's identity.
## 3. CORS Support
### 3.1 Design
CORS headers are only added when both conditions are true:
- `addCORSHeaders` is `True` in `TransportServerConfig` (set in XFTP `Main.hs`)
- `sniUsed` is `True` for the current TLS connection
This ensures native clients never see CORS headers.
### 3.2 Response Headers
All POST responses on SNI connections include:
```
Access-Control-Allow-Origin: *
Access-Control-Expose-Headers: *
```
### 3.3 OPTIONS Preflight
OPTIONS requests are intercepted at the HTTP/2 dispatch level, before `processRequest`. This is necessary because `processRequest` rejects bodies that don't match `xftpBlockSize`.
Preflight response:
```
HTTP/2 200
Access-Control-Allow-Origin: *
Access-Control-Allow-Methods: POST, OPTIONS
Access-Control-Allow-Headers: *
Access-Control-Max-Age: 86400
```
### 3.4 Security
`Access-Control-Allow-Origin: *` is safe because:
- All XFTP commands require Ed25519 authentication (per-chunk keys from file description).
- No cookies or browser credentials are involved.
- File content is end-to-end encrypted.
## 4. Configuration
### 4.1 INI Template
```ini
[WEB]
# cert: /etc/opt/simplex-xftp/web.crt
# key: /etc/opt/simplex-xftp/web.key
```
Commented out by default — web support is opt-in.
### 4.2 Behavior
- `[WEB]` section not configured: silently ignored, server operates normally for native clients only.
- `[WEB]` section configured with valid cert/key paths: SNI + CORS enabled.
- `[WEB]` section configured with missing cert files: warning + continue (non-fatal, unlike SMP where it is fatal).
## 5. Files Modified
### 5.1 `src/Simplex/Messaging/Transport/Server.hs`
Added `addCORSHeaders :: Bool` field to `TransportServerConfig`. Updated `mkTransportServerConfig` to accept the new parameter. All existing SMP call sites pass `False`.
### 5.2 `src/Simplex/Messaging/Transport/HTTP2/Server.hs`
- Extracted `expireInactiveClient` from `runHTTP2ServerWith_`'s `where` clause to a module-level function.
- Parameterized `runHTTP2ServerWith_`: setup type changed from `((TLS p -> IO ()) -> a)` to `(((Bool, TLS p) -> IO ()) -> a)`, callback from `HTTP2ServerFunc` to `Bool -> HTTP2ServerFunc`. The `Bool` is the per-connection `sniUsed` flag, threaded through `H.run` to the callback.
- Extended `runHTTP2Server` with `Maybe T.Credential` parameter for SNI web certificate. Its setup uses `runTransportServerState_` with `TLSServerCredential`, which naturally provides `(sniUsed, tls)` pairs matching the new `runHTTP2ServerWith_` setup type.
- Adapted `runHTTP2ServerWith` (client-side HTTP/2, no SNI): wraps its setup to inject `(False, tls)` and its callback with `const`.
- Updated `getHTTP2Server` (test helper) to pass `Nothing` for httpCreds.
### 5.3 `src/Simplex/FileTransfer/Server/Env.hs`
- Added `httpCredentials :: Maybe ServerCredentials` to `XFTPServerConfig`.
- Added `httpServerCreds :: Maybe T.Credential` to `XFTPEnv`.
- `newXFTPServerEnv` loads HTTP credentials when configured.
### 5.4 `src/Simplex/FileTransfer/Server/Main.hs`
- Added `[WEB]` section to INI template.
- Added `httpCredentials` parsing from INI `[WEB]` section (`cert` and `key` fields).
- Set `addCORSHeaders = isJust httpCredentials_` in transport config (conditional on web cert presence).
### 5.5 `src/Simplex/FileTransfer/Server.hs`
Core server changes:
- `runServer` calls `runHTTP2Server` with `httpCreds_` and a `\sniUsed -> handleRequest (sniUsed && addCORSHeaders transportConfig)` callback. TLS params are `defaultSupportedParamsHTTPS` when web creds present, `defaultSupportedParams` otherwise. SNI routing, HTTP/2 setup, and client expiration are handled inside `runHTTP2Server`.
- `XFTPTransportRequest` carries `addCORS :: Bool` field, threaded through to `sendXFTPResponse`.
- `sendXFTPResponse` conditionally includes CORS headers based on `addCORS`.
- OPTIONS requests on SNI connections return CORS preflight headers before reaching `processRequest`.
- Helper functions: `corsHeaders` (response headers), `corsPreflightHeaders` (preflight headers).
### 5.6 `tests/XFTPClient.hs`
- Added `httpCredentials = Nothing` to `testXFTPServerConfig`.
- Added `testXFTPServerConfigSNI` with web cert config and `addCORSHeaders = True`.
- Added `withXFTPServerSNI` helper.
### 5.7 `tests/XFTPServerTests.hs`
Added SNI and CORS tests as a subsection within `xftpServerTests` (6 tests):
1. **SNI cert selection** — Connect with SNI + `h2` ALPN, verify RSA web certificate is presented.
2. **Non-SNI cert selection** — Connect without SNI + `xftp/1` ALPN, verify Ed448 XFTP certificate is presented.
3. **CORS headers** — SNI POST request includes `Access-Control-Allow-Origin: *` and `Access-Control-Expose-Headers: *`.
4. **OPTIONS preflight** — SNI OPTIONS request returns all CORS preflight headers.
5. **No CORS without SNI** — Non-SNI POST request has no CORS headers.
6. **File chunk delivery** — Full XFTP file chunk upload/download through SNI-enabled server verifying no regression.
## 6. Remaining Work
- **Web handshake** (§6.3 of parent RFC): Challenge-response identity proof for SNI connections. The server detects web clients via the `sniUsed` flag and expects a 32-byte challenge in the first POST body (non-empty, unlike standard handshake). Response includes full cert chain + signature over `(challenge ++ sessionId)`.
- **Static page serving** (§6.5 of parent RFC): Optional serving of the web page HTML/JS bundle on GET requests.
@@ -0,0 +1,246 @@
# Web Handshake — Challenge-Response Identity Proof
RFC §6.3: Server proves XFTP identity to web clients independently of TLS CA infrastructure.
## 1. Protocol
**Standard handshake** (unchanged):
```
Client → empty POST → Server
Server → padded {vRange, sessionId, authPubKey, Nothing} → Client
Client → padded {version, keyHash, Nothing} → Server
Server → empty → Client
```
**Web handshake** (SNI connection, non-empty hello):
```
Client → padded {32 random bytes} → Server
Server → padded {vRange, sessionId, authPubKey, Just sigBytes} → Client
sigBytes = signatureBytes(sign(identityLeafKey, challenge <> sessionId))
Client validates:
1. chainIdCaCerts(authPubKey.certChain) → CCValid {leafCert, idCert}
2. SHA-256(idCert) == keyHash (server identity)
3. verify(leafCert.pubKey, sigBytes, challenge <> sessionId) (challenge-response)
4. verify(leafCert.pubKey, signedPubKey.signature, signedPubKey.objectDer) (DH key auth)
Client → padded {version, keyHash, Just challenge} → Server
Server verifies: echoed challenge == stored challenge from step 1
Server → empty → Client
```
**Detection**: `sniUsed` per-connection flag. Non-empty hello allowed only when `sniUsed`. Empty hello with SNI → standard handshake.
**Why both steps 3 and 4**: Native clients verify `signedPubKey` using the TLS peer certificate (`serverKey` from `getServerVerifyKey`), which is the XFTP identity cert in non-SNI connections — TLS provides this binding. Web clients cannot access TLS peer certificate data (browser API limitation; TLS presents the web CA cert but provides no API to extract it). So web clients must verify at the application layer using `authPubKey.certChain`, which always contains the XFTP identity chain regardless of which cert TLS used. Step 3 proves the server holds its identity key *right now* (freshness via random challenge). Step 4 proves the DH session key was signed by the identity key holder (prevents MITM key substitution). Together they give web clients some assurance native clients get from TLS, except channel binding for commands.
## 2. Type Changes — `src/Simplex/FileTransfer/Transport.hs`
### `XFTPServerHandshake` (line 114)
Add field: `webIdentityProof :: Maybe ByteString` — raw Ed448 signature bytes (114 bytes), or `Nothing` for standard handshake. No record needed — the cert chain is already in `authPubKey.certChain`.
### `Encoding XFTPServerHandshake` (line 136)
- `smpEncode`: append `smpEncode webIdentityProof`
- `smpP`: `Tail compat`, if non-empty `eitherToMaybe $ smpDecode compat`
Backward compat: old clients ignore via `Tail _compat`; new client + old server → empty compat → `Nothing`.
### `XFTPClientHandshake` (line 121)
Add field: `webChallenge :: Maybe ByteString`
### `Encoding XFTPClientHandshake` (line 128)
Same `Tail compat` pattern as server handshake.
### Export list
Both types use `(..)` export — new fields auto-exported.
## 3. Server Changes — `src/Simplex/FileTransfer/Server.hs`
### `XFTPTransportRequest` (line 88)
Add field: `sniUsed :: SNICredentialUsed` (`Bool` from `Transport.Server`). Add import.
### `Handshake` (line 117)
`HandshakeSent C.PrivateKeyX25519``HandshakeSent C.PrivateKeyX25519 (Maybe ByteString)` — stores 32-byte web challenge or `Nothing`.
### `runServer` handler (line 145161)
- Pass `sniUsed` into request construction (line 154)
- SNI-first routing: when `sniUsed`, always route to `xftpServerHandshakeV1` (web ALPN `h2` would otherwise fall to `_` catch-all)
### `xftpServerHandshakeV1` (line 162)
- Destructure `sniUsed` from request
- Match `HandshakeSent pk challenge_``processClientHandshake pk challenge_`
### `processHello` (line 171)
- Branch `(sniUsed, B.null bodyHead)`:
- `(_, True)` → standard: `challenge_ = Nothing`
- `(True, False)` → web: unpad, verify 32 bytes, `challenge_ = Just`
- `(False, False)``throwE HANDSHAKE`
- Store: `HandshakeSent pk challenge_`
- Compute: `webIdentityProof = C.signatureBytes . C.sign serverSignKey . (<> sessionId) <$> challenge_`
- Construct `XFTPServerHandshake` with `webIdentityProof`
### `processClientHandshake` (line 183)
- Accept `challenge_` parameter
- Decode `webChallenge` from `XFTPClientHandshake`
- Add: `unless (challenge_ == webChallenge) $ throwE HANDSHAKE`
(standard: both `Nothing` → passes)
## 4. Native Client — `src/Simplex/FileTransfer/Client.hs`
### `xftpClientHandshakeV1` (line 142)
Add `webChallenge = Nothing` in `sendClientHandshake` call.
No other changes — parser handles new fields via `Tail`, native client ignores `webIdentityProof`.
## 5. TypeScript Changes (DONE except Ed448)
Sections 5.1 and 5.2 are implemented. Section 5.3 needs Ed448 support.
## 10. Ed448 Support via `@noble/curves`
**Problem**: Production servers use Ed448 certificates (default). `identity.ts` only supports Ed25519 via libsodium. libsodium has no Ed448 support and never will.
**Solution**: Add `@noble/curves` dependency for Ed448 verification only. All other crypto stays with libsodium.
### 10.1 `xftp-web/package.json` — Add dependency
```json
"dependencies": {
"libsodium-wrappers-sumo": "^0.7.13",
"@noble/curves": "^1.9.7"
}
```
Use v1.x (supports both CJS and ESM). v2.x is ESM-only with `.js` extension requirement.
### 10.2 `xftp-web/src/crypto/keys.ts` — Ed448 DER constants and decode
Add Ed448 SPKI DER prefix (12 bytes, same prefix length as Ed25519):
```
30 43 30 05 06 03 2b 65 71 03 3a 00
```
| Property | Ed25519 | Ed448 |
|----------|---------|-------|
| OID | `2b 65 70` | `2b 65 71` |
| SPKI prefix | `30 2a ...` | `30 43 ...` |
| Raw key size | 32 bytes | 57 bytes |
| SPKI total | 44 bytes | 69 bytes |
| Signature size | 64 bytes | 114 bytes |
New functions:
- `decodePubKeyEd448(der: Uint8Array): Uint8Array` — 69 bytes → 57 bytes raw
- `encodePubKeyEd448(raw: Uint8Array): Uint8Array` — 57 bytes → 69 bytes DER
- `verifyEd448(publicKey: Uint8Array, sig: Uint8Array, msg: Uint8Array): boolean` — uses `ed448.verify(sig, msg, publicKey)` from `@noble/curves/ed448`
Note: `@noble/curves` parameter order is `(signature, message, publicKey)`, not `(publicKey, signature, message)`.
### 10.3 `xftp-web/src/crypto/identity.ts` — Algorithm-agnostic verification
Replace `extractCertEd25519Key` + hardcoded Ed25519 `verify` with algorithm detection:
1. `extractCertPublicKeyInfo(certDer)` → SPKI DER (already exists, works for any algorithm)
2. Detect algorithm from SPKI: byte at offset 8 is `0x70` (Ed25519) or `0x71` (Ed448)
3. Extract raw key with appropriate decoder
4. Verify signatures with appropriate function
```typescript
type CertKeyAlgorithm = 'ed25519' | 'ed448'
function detectKeyAlgorithm(spki: Uint8Array): CertKeyAlgorithm {
if (spki.length === 44 && spki[8] === 0x70) return 'ed25519'
if (spki.length === 69 && spki[8] === 0x71) return 'ed448'
throw new Error("unsupported certificate key algorithm")
}
```
`verifyIdentityProof` changes:
- Extract SPKI from leaf cert
- Detect algorithm → choose `decodePubKeyEd25519`/`decodePubKeyEd448` and `verify`/`verifyEd448`
- Both challenge signature and DH key signature use the same leaf key + algorithm
Remove `extractCertEd25519Key` (replaced by generic path). Keep `extractCertPublicKeyInfo` (already generic).
### 10.4 `xftp-web/src/protocol/handshake.ts` — Comment update
`SignedKey.signature` comment: "raw Ed25519 signature bytes (64 bytes)" → "raw signature bytes (Ed25519: 64, Ed448: 114)"
### 10.5 Tests — `tests/XFTPWebTests.hs`
**Integration test**: Switch from `withXFTPServerEd25519SNI` (Ed25519 fixtures) to `withXFTPServerSNI` (default Ed448 fixtures). Update fingerprint source from `tests/fixtures/ed25519/ca.crt` to `tests/fixtures/ca.crt`.
Optionally add a second integration test with Ed25519 to cover both paths, or rely on existing unit tests for Ed25519 coverage.
### 10.6 Implementation order
1. `npm install @noble/curves` in `xftp-web/`
2. `keys.ts` — Ed448 constants, decode, encode, verifyEd448
3. `identity.ts` — algorithm detection, generic verification
4. `handshake.ts` — comment fix
5. `XFTPWebTests.hs` — switch integration test to Ed448
6. Build TS + run all tests
## 6. Haskell Integration Test — `tests/XFTPServerTests.hs`
Add `testWebHandshake` to "XFTP SNI and CORS" describe block.
1. `withXFTPServerSNI` — server with web credentials
2. Connect with SNI + `h2` ALPN
3. Send padded 32-byte challenge
4. Decode `XFTPServerHandshake`, assert `webIdentityProof` is `Just`
5. `chainIdCaCerts` on `authPubKey.certChain``CCValid {leafCert, idCert}`
6. Verify `SHA-256(idCert) == keyHash`
7. Extract `leafCert` public key, verify challenge signature
8. Verify `signedPubKey` signature using `leafCert` key (DH key auth)
9. Send `XFTPClientHandshake` with `webChallenge = Just challenge`
10. Assert empty response
Imports: `XFTPServerHandshake (..)`, `XFTPClientHandshake (..)`, `ChainCertificates (..)`, `chainIdCaCerts`.
## 7. TS Tests — `tests/XFTPWebTests.hs`
### Unit tests
- **`decodeServerHandshake` with proof**: Haskell-encode with `Just sigBytes`, TS-decode, verify bytes match.
- **`encodeClientHandshake` with challenge**: TS-encode, compare with Haskell-encoded.
- **`chainIdCaCerts`**: 2/3/4-cert chains return correct positions.
- **`caFingerprint` (fixed)**: matches `sha256(idCert)` for 2 and 3-cert chains.
### Integration test
Node.js inline script against `withXFTPServerSNI`:
1. Connect with SNI via `http2.connect`
2. Send padded challenge, decode `XFTPServerHandshake` with TS
3. `verifyIdentityProof` — full chain validation + challenge sig + DH key sig
4. Send client handshake with echoed challenge
5. Assert empty response
## 8. Implementation Order
1. `Transport.hs``Maybe` fields + encoding instances
2. `Server.hs``sniUsed`, challenge in `Handshake`, `processHello`, `processClientHandshake`, SNI routing
3. `Client.hs``webChallenge = Nothing`
4. Build: `cabal build --ghc-options -O0`
5. Run existing SNI/CORS tests
6. `XFTPServerTests.hs``testWebHandshake`
7. `handshake.ts` — types, decoding, `chainIdCaCerts`, fix `caFingerprint`
8. `crypto/identity.ts` — Node.js verification functions
9. `XFTPWebTests.hs` — unit + integration tests
10. Build TS + run all tests
## 9. Verification
```bash
cd xftp-web && npm install && npm run build && cd ..
cabal test --ghc-options=-O0 --test-option='--match=/XFTP/XFTP server/XFTP SNI and CORS/' --test-show-details=streaming
cabal test --ghc-options=-O0 --test-option='--match=/XFTP Web Client/' --test-show-details=streaming
```
@@ -0,0 +1,208 @@
# Plan: Browser ↔ Haskell File Transfer Tests
## Table of Contents
1. Goal
2. Current State
3. Implementation
4. Success Criteria
5. Files
6. Order
## 1. Goal
Run browser upload/download tests in headless Chromium via Vitest, proving fetch-based transport works in real browser environment.
## 2. Current State
- `client.ts`: Transport abstraction done — http2 for Node, fetch for browser ✓
- `agent.ts`: Uses `node:crypto` (randomBytes) and `node:zlib` (deflateRawSync/inflateRawSync) — **won't run in browser**
- `XFTPWebTests.hs`: Cross-language tests exist (Haskell calls TS via Node.js) ✓
## 3. Implementation
### 3.1 Make agent.ts isomorphic
| Current (Node.js only) | Isomorphic replacement |
|------------------------|------------------------|
| `import crypto from "node:crypto"` | Remove import |
| `import zlib from "node:zlib"` | `import pako from "pako"` |
| `crypto.randomBytes(32)` | `crypto.getRandomValues(new Uint8Array(32))` |
| `zlib.deflateRawSync(buf)` | `pako.deflateRaw(buf)` |
| `zlib.inflateRawSync(buf)` | `pako.inflateRaw(buf)` |
Note: `crypto.getRandomValues` available in both browser and Node.js (globalThis.crypto).
### 3.2 Vitest browser mode setup
`package.json` additions:
```json
"devDependencies": {
"vitest": "^3.0.0",
"@vitest/browser": "^3.0.0",
"playwright": "^1.50.0",
"@types/pako": "^2.0.3"
},
"dependencies": {
"pako": "^2.1.0"
}
```
`vitest.config.ts`:
```typescript
import {defineConfig} from 'vitest/config'
import {readFileSync} from 'fs'
import {createHash} from 'crypto'
// Compute fingerprint from ca.crt (same as Haskell's loadFileFingerprint)
const caCert = readFileSync('../tests/fixtures/ca.crt')
const fingerprint = createHash('sha256').update(caCert).digest('base64url')
const serverAddr = `xftp://${fingerprint}@localhost:7000`
export default defineConfig({
define: {
'import.meta.env.XFTP_SERVER': JSON.stringify(serverAddr)
},
test: {
browser: {
enabled: true,
provider: 'playwright',
instances: [{browser: 'chromium'}],
headless: true,
providerOptions: {
launch: {ignoreHTTPSErrors: true}
}
},
globalSetup: './test/globalSetup.ts'
}
})
```
### 3.3 Server startup
`test/globalSetup.ts`:
```typescript
import {spawn, ChildProcess} from 'child_process'
import {resolve, join} from 'path'
import {mkdtempSync, writeFileSync, copyFileSync} from 'fs'
import {tmpdir} from 'os'
let server: ChildProcess | null = null
export async function setup() {
const fixtures = resolve(__dirname, '../../tests/fixtures')
// Create temp directories
const cfgDir = mkdtempSync(join(tmpdir(), 'xftp-cfg-'))
const logDir = mkdtempSync(join(tmpdir(), 'xftp-log-'))
const filesDir = mkdtempSync(join(tmpdir(), 'xftp-files-'))
// Copy certificates to cfgDir (xftp-server expects ca.crt, server.key, server.crt there)
copyFileSync(join(fixtures, 'ca.crt'), join(cfgDir, 'ca.crt'))
copyFileSync(join(fixtures, 'server.key'), join(cfgDir, 'server.key'))
copyFileSync(join(fixtures, 'server.crt'), join(cfgDir, 'server.crt'))
// Write INI config file
const iniContent = `[STORE_LOG]
enable: off
[TRANSPORT]
host: localhost
port: 7000
[FILES]
path: ${filesDir}
[WEB]
cert: ${join(fixtures, 'web.crt')}
key: ${join(fixtures, 'web.key')}
`
writeFileSync(join(cfgDir, 'file-server.ini'), iniContent)
// Spawn xftp-server with env vars
server = spawn('cabal', ['exec', 'xftp-server', '--', 'start'], {
env: {
...process.env,
XFTP_SERVER_CFG_PATH: cfgDir,
XFTP_SERVER_LOG_PATH: logDir
},
stdio: ['ignore', 'pipe', 'pipe']
})
// Wait for "Listening on port 7000..."
await waitForServerReady(server)
}
export async function teardown() {
server?.kill('SIGTERM')
await new Promise(r => setTimeout(r, 500))
}
function waitForServerReady(proc: ChildProcess): Promise<void> {
return new Promise((resolve, reject) => {
const timeout = setTimeout(() => reject(new Error('Server start timeout')), 15000)
proc.stdout?.on('data', (data: Buffer) => {
if (data.toString().includes('Listening on port')) {
clearTimeout(timeout)
resolve()
}
})
proc.stderr?.on('data', (data: Buffer) => {
console.error('[xftp-server]', data.toString())
})
proc.on('error', reject)
proc.on('exit', (code) => {
clearTimeout(timeout)
if (code !== 0) reject(new Error(`Server exited with code ${code}`))
})
})
}
```
Server env vars (from `apps/xftp-server/Main.hs` + `getEnvPath`):
- `XFTP_SERVER_CFG_PATH` — directory containing `file-server.ini` and certs (`ca.crt`, `server.key`, `server.crt`)
- `XFTP_SERVER_LOG_PATH` — directory for logs
### 3.4 Browser test
`test/browser.test.ts`:
```typescript
import {test, expect} from 'vitest'
import {encryptFileForUpload, uploadFile, downloadFile} from '../src/agent.js'
import {parseXFTPServer} from '../src/protocol/address.js'
const server = parseXFTPServer(import.meta.env.XFTP_SERVER)
test('browser upload + download round-trip', async () => {
const data = new Uint8Array(50000)
crypto.getRandomValues(data)
const encrypted = encryptFileForUpload(data, 'test.bin')
const {rcvDescription} = await uploadFile(server, encrypted)
const {content} = await downloadFile(rcvDescription)
expect(content).toEqual(data)
})
```
## 4. Success Criteria
1. `npm run build` — agent.ts compiles without node: imports
2. `cabal test --test-option='--match=/XFTP Web Client/'` — existing Node.js tests still pass
3. `npm run test:browser` — browser round-trip test passes in headless Chromium
## 5. Files to Create/Modify
**Modify:**
- `xftp-web/package.json` — add vitest, @vitest/browser, playwright, pako, @types/pako
- `xftp-web/src/agent.ts` — replace node:crypto, node:zlib with isomorphic alternatives
**Create:**
- `xftp-web/vitest.config.ts` — browser mode config
- `xftp-web/test/globalSetup.ts` — xftp-server lifecycle
- `xftp-web/test/browser.test.ts` — browser round-trip test
## 6. Order of Implementation
1. **Add pako dependency**`npm install pako @types/pako`
2. **Make agent.ts isomorphic** — replace node:crypto, node:zlib
3. **Verify Node.js tests pass**`cabal test --test-option='--match=/XFTP Web Client/'`
4. **Set up Vitest** — add devDeps, create vitest.config.ts
5. **Create globalSetup.ts** — write INI config, spawn xftp-server
6. **Write browser test** — upload + download round-trip
7. **Verify browser test passes**`npm run test:browser`
@@ -0,0 +1,920 @@
# Browser Transport & Web Worker Architecture
## TOC
1. Executive Summary
2. Transport: fetch() API
3. Architecture: Environment Abstraction
4. Web Worker Implementation
5. OPFS Implementation
6. Implementation Plan
7. Testing Strategy
## 1. Executive Summary
Adapt `client.ts` from `node:http2` to `fetch()` API for isomorphic Node.js/browser support. Add environment abstraction layer so the same upload/download pipeline works with or without Web Workers and with or without OPFS. In browsers, crypto runs in a Web Worker to keep UI responsive; in Node.js tests, crypto runs directly.
**Key architectural constraint:** Existing crypto functions (`encryptFile`, `decryptChunks`, etc.) remain unchanged. The abstraction layer wraps them, choosing execution context (direct vs Worker) and storage (memory vs OPFS) based on environment.
**Scope:**
- Replace `node:http2` with `fetch()` in `client.ts`
- Add `CryptoBackend` abstraction with three implementations
- Create Web Worker that calls existing crypto functions
- Add OPFS storage for large files in browser
**Out of scope:** Web page UI (Phase 5 in main RFC).
## 2. Transport: fetch() API
### 2.1 Current State
`client.ts` uses `node:http2`:
```typescript
import http2 from "node:http2"
const session = http2.connect(url)
const stream = session.request({':method': 'POST', ':path': '/'})
stream.write(commandBlock)
stream.end(chunkData)
```
### 2.2 Target State
Isomorphic `fetch()` (Node.js 18+ and browsers):
```typescript
const response = await fetch(url, {
method: 'POST',
body: concatStreams(commandBlock, chunkData),
duplex: 'half', // Required for streaming request body
})
const reader = response.body!.getReader()
```
### 2.3 Key Differences
| Aspect | node:http2 | fetch() |
|--------|-----------|---------|
| Session management | Explicit `session.connect()` / `session.close()` | Per-request (HTTP/2 connection reuse is automatic) |
| Streaming upload | `stream.write()` chunks | `ReadableStream` body + `duplex: 'half'` |
| Streaming download | `stream.on('data')` | `response.body.getReader()` |
| Connection pooling | Manual | Automatic per origin |
### 2.4 API Changes
```typescript
// Before (node:http2)
export interface XFTPClient {
session: http2.ClientHttp2Session
thParams: THParams
server: XFTPServer
}
// After (fetch)
export interface XFTPClient {
baseUrl: string // "https://host:port"
thParams: THParams
server: XFTPServer
}
```
`connectXFTP()` performs handshake via fetch, returns `XFTPClient` with `baseUrl`.
Subsequent commands use `fetch(client.baseUrl, ...)`.
### 2.5 Handshake via fetch()
**TLS session binding:** Multiple fetch() requests to the same origin reuse the HTTP/2 connection, which means they share the same TLS session. The server's `sessionId` (derived from TLS channel binding) remains consistent across the handshake round-trips and subsequent commands.
```typescript
async function connectXFTP(server: XFTPServer): Promise<XFTPClient> {
const baseUrl = `https://${server.host}:${server.port}`
// Round-trip 1: challenge → server handshake + identity proof
const challenge = crypto.getRandomValues(new Uint8Array(32))
const req1 = pad(encodeWebClientHello(challenge), xftpBlockSize)
const resp1 = await fetch(baseUrl, {method: 'POST', body: req1})
const reader = resp1.body!.getReader()
const serverBlock = await readExactly(reader, xftpBlockSize)
const serverHs = decodeServerHandshake(unPad(serverBlock))
const proofBody = await readRemaining(reader)
verifyIdentityProof(server.keyHash, challenge, serverHs.sessionId, proofBody)
// Round-trip 2: client handshake → server ack
const clientHs = encodeClientHandshake({xftpVersion: 3, keyHash: server.keyHash})
const req2 = pad(clientHs, xftpBlockSize)
await fetch(baseUrl, {method: 'POST', body: req2})
return {baseUrl, thParams: {sessionId: serverHs.sessionId, ...}, server}
}
```
### 2.6 Command Execution
```typescript
async function sendXFTPCommand(
client: XFTPClient,
key: Uint8Array,
entityId: Uint8Array,
cmd: Uint8Array,
chunkData?: Uint8Array
): Promise<{response: Uint8Array, body?: ReadableStream}> {
const block = xftpEncodeAuthTransmission(client.thParams, key, entityId, cmd)
const reqBody = chunkData
? concatBytes(block, chunkData)
: block
const resp = await fetch(client.baseUrl, {
method: 'POST',
body: reqBody,
duplex: 'half',
})
const reader = resp.body!.getReader()
const responseBlock = await readExactly(reader, xftpBlockSize)
const parsed = xftpDecodeTransmission(responseBlock)
// For FGET: remaining body is encrypted chunk
const hasMore = await peekReader(reader)
return {
response: parsed,
body: hasMore ? wrapAsStream(reader) : undefined
}
}
```
## 3. Architecture: Environment Abstraction
### 3.1 Core Principle
**Existing crypto functions remain unchanged.** The functions `encryptFile()`, `decryptChunks()`, `sha512()`, etc. in `crypto/file.ts` and `crypto/digest.ts` are pure computation — they take input bytes and produce output bytes. They have no knowledge of Workers, OPFS, or execution context.
The abstraction layer sits between `agent.ts` (upload/download orchestration) and these crypto functions:
```
┌─────────────────────────────────────────────────────────────────────┐
│ agent.ts (upload/download orchestration) │
│ - Unchanged logic: encrypt → chunk → upload → build description │
│ - Calls CryptoBackend interface, not crypto functions directly │
├─────────────────────────────────────────────────────────────────────┤
│ CryptoBackend interface (env.ts) │
│ - Abstract interface for encrypt/decrypt/readChunk/writeChunk │
│ - Factory function selects implementation based on environment │
├──────────────┬──────────────────────┬───────────────────────────────┤
│ DirectMemory │ WorkerMemory │ WorkerOPFS │
│ Backend │ Backend │ Backend │
│ (Node.js) │ (Browser, ≤50MB) │ (Browser, >50MB) │
├──────────────┼──────────────────────┼───────────────────────────────┤
│ Calls crypto │ Posts to Worker, │ Posts to Worker, │
│ functions │ Worker calls crypto │ Worker calls crypto, │
│ directly │ functions, returns │ streams through OPFS │
│ │ via postMessage │ │
├──────────────┴──────────────────────┴───────────────────────────────┤
│ crypto/file.ts, crypto/digest.ts (unchanged) │
│ - encryptFile(), decryptChunks(), sha512(), etc. │
│ - Pure functions, no environment dependencies │
└─────────────────────────────────────────────────────────────────────┘
```
### 3.2 CryptoBackend Interface
```typescript
// env.ts
export interface CryptoBackend {
// Encrypt file, store result (in memory or OPFS depending on backend)
encrypt(
data: Uint8Array,
fileName: string,
onProgress?: (done: number, total: number) => void
): Promise<EncryptResult>
// Decrypt from stored encrypted data
decrypt(
key: Uint8Array,
nonce: Uint8Array,
size: number,
onProgress?: (done: number, total: number) => void
): Promise<DecryptResult>
// Read chunk from stored encrypted data (for upload)
readChunk(offset: number, size: number): Promise<Uint8Array>
// Write chunk to storage (for download, before decrypt)
writeChunk(data: Uint8Array, offset: number): Promise<void>
// Clean up temporary storage
cleanup(): Promise<void>
}
export interface EncryptResult {
digest: Uint8Array // SHA-512 of encrypted data
key: Uint8Array // Generated encryption key
nonce: Uint8Array // Generated nonce
chunkSizes: number[] // Chunk sizes for upload
totalSize: number // Total encrypted size
}
export interface DecryptResult {
header: FileHeader // Extracted file header (fileName, etc.)
content: Uint8Array // Decrypted file content
}
```
### 3.3 Backend Implementations
**DirectMemoryBackend** (Node.js):
```typescript
class DirectMemoryBackend implements CryptoBackend {
private encryptedData: Uint8Array | null = null
async encrypt(data: Uint8Array, fileName: string, onProgress?): Promise<EncryptResult> {
const key = randomBytes(32)
const nonce = randomBytes(24)
// Call existing crypto function directly
this.encryptedData = encryptFile(data, fileName, key, nonce, onProgress)
const digest = sha512(this.encryptedData)
const chunkSizes = prepareChunkSizes(this.encryptedData.length)
return { digest, key, nonce, chunkSizes, totalSize: this.encryptedData.length }
}
async decrypt(key, nonce, size, onProgress): Promise<DecryptResult> {
// Call existing crypto function directly
return decryptChunks([this.encryptedData!], key, nonce, size, onProgress)
}
async readChunk(offset: number, size: number): Promise<Uint8Array> {
return this.encryptedData!.slice(offset, offset + size)
}
async writeChunk(data: Uint8Array, offset: number): Promise<void> {
if (!this.encryptedData) this.encryptedData = new Uint8Array(offset + data.length)
this.encryptedData.set(data, offset)
}
async cleanup(): Promise<void> {
this.encryptedData = null
}
}
```
**WorkerMemoryBackend** and **WorkerOPFSBackend** are similar but post messages to a Web Worker instead of calling crypto directly. The Worker then calls the same `encryptFile()`, `decryptChunks()` functions. See §4 for Worker implementation details.
### 3.4 Factory Function
```typescript
// env.ts
export function createCryptoBackend(fileSize: number): CryptoBackend {
const hasWorker = typeof Worker !== 'undefined'
const hasOPFS = typeof navigator?.storage?.getDirectory !== 'undefined'
const isLargeFile = fileSize > 50 * 1024 * 1024
if (hasWorker && hasOPFS && isLargeFile) {
return new WorkerOPFSBackend() // Browser + large file
} else if (hasWorker) {
return new WorkerMemoryBackend() // Browser + small file
} else {
return new DirectMemoryBackend() // Node.js
}
}
```
### 3.5 Usage in agent.ts
```typescript
// agent.ts - upload orchestration (simplified)
export async function uploadFile(
server: XFTPServer,
fileData: Uint8Array,
fileName: string,
onProgress?: ProgressCallback
): Promise<string> {
// Create backend based on environment
const backend = createCryptoBackend(fileData.length)
try {
// Encrypt (runs in Worker in browser, directly in Node)
const enc = await backend.encrypt(fileData, fileName, onProgress)
// Upload chunks (same code regardless of backend)
const client = await connectXFTP(server)
const sentChunks = []
let offset = 0
for (const size of enc.chunkSizes) {
const chunk = await backend.readChunk(offset, size)
const sent = await uploadChunk(client, chunk, enc.digest)
sentChunks.push(sent)
offset += size
}
// Build description and URI
const fd = buildFileDescription(enc, sentChunks)
return encodeFileDescriptionURI(fd)
} finally {
await backend.cleanup()
}
}
```
The key point: `uploadFile()` logic is identical regardless of whether crypto runs in a Worker or directly. The `CryptoBackend` abstraction hides that detail.
### 3.6 Why This Matters for Testing
- **Layer 1 tests** (per-function): Call `encryptFile()`, `decryptChunks()` directly via Node — unchanged
- **Layer 2 tests** (full flow): Call `uploadFile()`, `downloadFile()` in Node — uses `DirectMemoryBackend`, same code path as browser except for Worker
- **Layer 3 tests** (browser): Call `uploadFile()`, `downloadFile()` in Playwright — uses `WorkerMemoryBackend` or `WorkerOPFSBackend`
All three layers exercise the same crypto functions. The only difference is execution context.
## 4. Web Worker Implementation
### 4.1 Why Web Worker
File encryption (XSalsa20-Poly1305) is sequential and CPU-bound:
- 100 MB file ≈ 1-2 seconds of continuous computation
- Running on main thread blocks UI (no progress updates, frozen page)
- Chunking into async microtasks adds complexity and still causes jank
Web Worker runs crypto in parallel thread. Main thread stays responsive.
### 4.2 Architecture
```
┌─────────────────────────────────────────────────────────────┐
│ Main Thread │
│ ┌─────────────┐ ┌─────────────┐ ┌─────────────────────┐ │
│ │ UI (upload/ │ │ Progress │ │ Network (fetch) │ │
│ │ download) │ │ display │ │ │ │
│ └──────┬──────┘ └──────▲──────┘ └──────────▲──────────┘ │
│ │ │ │ │
│ │ postMessage │ progress │ encrypted │
│ ▼ │ events │ chunks │
├─────────────────────────────────────────────────────────────┤
│ Web Worker │
│ ┌─────────────────────────────────────────────────────────┐│
│ │ Crypto Pipeline ││
│ │ - encryptFile() with progress callbacks ││
│ │ - decryptChunks() with progress callbacks ││
│ │ - OPFS read/write for temp storage ││
│ └─────────────────────────────────────────────────────────┘│
└─────────────────────────────────────────────────────────────┘
```
### 4.3 Message Protocol
**Main → Worker:**
```typescript
type WorkerRequest =
// Encrypt file, store result in OPFS (large) or memory (small)
| {type: 'encrypt', file: File, fileName: string, useOPFS: boolean}
// Read encrypted chunk from OPFS for upload
| {type: 'readChunk', offset: number, size: number}
// Write downloaded chunk to OPFS for later decryption
| {type: 'writeChunk', data: ArrayBuffer, offset: number}
// Decrypt from OPFS or provided chunks
| {type: 'decrypt', key: Uint8Array, nonce: Uint8Array, size: number, chunks?: ArrayBuffer[]}
// Delete OPFS temp files
| {type: 'cleanup'}
| {type: 'cancel'}
```
**Worker → Main:**
```typescript
type WorkerResponse =
| {type: 'progress', phase: 'encrypt' | 'decrypt', done: number, total: number}
// For OPFS: encData is empty, data lives in OPFS temp file
| {type: 'encrypted', encData: ArrayBuffer | null, digest: Uint8Array, key: Uint8Array, nonce: Uint8Array, chunkSizes: number[]}
| {type: 'chunk', data: ArrayBuffer} // Response to readChunk
| {type: 'chunkWritten'} // Response to writeChunk
| {type: 'decrypted', header: FileHeader, content: ArrayBuffer}
| {type: 'cleaned'} // Response to cleanup
| {type: 'error', message: string}
```
### 4.4 Worker Implementation
```typescript
// crypto.worker.ts
import {encryptFile, encryptFileStreaming, decryptChunks, decryptFromOPFS} from './crypto/file.js'
import {sha512} from './crypto/digest.js'
import {prepareChunkSizes} from './protocol/chunks.js'
let opfsHandle: FileSystemSyncAccessHandle | null = null
self.onmessage = async (e: MessageEvent<WorkerRequest>) => {
const req = e.data
if (req.type === 'encrypt') {
const key = crypto.getRandomValues(new Uint8Array(32))
const nonce = crypto.getRandomValues(new Uint8Array(24))
if (req.useOPFS) {
// Large file: stream through OPFS to avoid memory pressure
const root = await navigator.storage.getDirectory()
const fileHandle = await root.getFileHandle('encrypted-temp', {create: true})
opfsHandle = await fileHandle.createSyncAccessHandle()
// Stream encrypt: read 64KB from File, encrypt, write to OPFS
const digest = await encryptFileStreaming(
req.file,
req.fileName,
key,
nonce,
opfsHandle,
(done, total) => self.postMessage({type: 'progress', phase: 'encrypt', done, total})
)
const encSize = opfsHandle.getSize()
const chunkSizes = prepareChunkSizes(encSize)
self.postMessage({
type: 'encrypted',
encData: null, // Data in OPFS, not memory
digest, key, nonce, chunkSizes
})
} else {
// Small file: in-memory is fine
const source = new Uint8Array(await req.file.arrayBuffer())
const encData = encryptFile(source, req.fileName, key, nonce, (done, total) => {
self.postMessage({type: 'progress', phase: 'encrypt', done, total})
})
const digest = sha512(encData)
const chunkSizes = prepareChunkSizes(encData.length)
self.postMessage({
type: 'encrypted',
encData: encData.buffer,
digest, key, nonce, chunkSizes
}, [encData.buffer])
}
}
if (req.type === 'readChunk') {
// Read chunk from OPFS for upload
const chunk = new Uint8Array(req.size)
opfsHandle!.read(chunk, {at: req.offset})
self.postMessage({type: 'chunk', data: chunk.buffer}, [chunk.buffer])
}
if (req.type === 'writeChunk') {
// Write downloaded chunk to OPFS
if (!opfsHandle) {
const root = await navigator.storage.getDirectory()
const fileHandle = await root.getFileHandle('download-temp', {create: true})
opfsHandle = await fileHandle.createSyncAccessHandle()
}
opfsHandle.write(new Uint8Array(req.data), {at: req.offset})
self.postMessage({type: 'chunkWritten'})
}
if (req.type === 'decrypt') {
let result
if (req.chunks) {
// Small file: chunks provided in memory
const chunks = req.chunks.map(b => new Uint8Array(b))
result = decryptChunks(chunks, req.key, req.nonce, req.size, (done, total) => {
self.postMessage({type: 'progress', phase: 'decrypt', done, total})
})
} else {
// Large file: read from OPFS
result = decryptFromOPFS(opfsHandle!, req.key, req.nonce, req.size, (done, total) => {
self.postMessage({type: 'progress', phase: 'decrypt', done, total})
})
}
self.postMessage({
type: 'decrypted',
header: result.header,
content: result.content.buffer
}, [result.content.buffer])
}
if (req.type === 'cleanup') {
if (opfsHandle) {
opfsHandle.close()
opfsHandle = null
}
const root = await navigator.storage.getDirectory()
try { await root.removeEntry('encrypted-temp') } catch {}
try { await root.removeEntry('download-temp') } catch {}
self.postMessage({type: 'cleaned'})
}
}
```
### 4.5 Main Thread Wrapper
```typescript
// crypto-worker.ts (main thread)
export class CryptoWorker {
private worker: Worker
private pending: Map<string, {resolve: Function, reject: Function}> = new Map()
private onProgress?: (done: number, total: number) => void
constructor() {
this.worker = new Worker(new URL('./crypto.worker.js', import.meta.url), {type: 'module'})
this.worker.onmessage = (e) => this.handleMessage(e.data)
}
async encrypt(file: File, onProgress?: (done: number, total: number) => void): Promise<EncryptedFileInfo> {
const useOPFS = file.size > 50 * 1024 * 1024 // 50 MB threshold
return new Promise((resolve, reject) => {
this.pending.set('encrypt', {resolve, reject})
this.onProgress = onProgress
this.worker.postMessage({type: 'encrypt', file, fileName: file.name, useOPFS})
})
}
async decrypt(
chunks: Uint8Array[],
key: Uint8Array,
nonce: Uint8Array,
size: number,
onProgress?: (done: number, total: number) => void
): Promise<DownloadResult> {
return new Promise((resolve, reject) => {
this.pending.set('decrypt', {resolve, reject})
this.onProgress = onProgress
this.worker.postMessage({
type: 'decrypt',
chunks: chunks.map(c => c.buffer),
key, nonce, size
}, chunks.map(c => c.buffer))
})
}
private handleMessage(msg: WorkerResponse) {
if (msg.type === 'progress') {
this.onProgress?.(msg.done, msg.total)
} else if (msg.type === 'encrypted') {
this.pending.get('encrypt')?.resolve({
encData: msg.encData ? new Uint8Array(msg.encData) : null, // null when using OPFS
digest: msg.digest,
key: msg.key,
nonce: msg.nonce,
chunkSizes: msg.chunkSizes
})
} else if (msg.type === 'decrypted') {
this.pending.get('decrypt')?.resolve({
header: msg.header,
content: new Uint8Array(msg.content)
})
} else if (msg.type === 'error') {
// Reject all pending
for (const p of this.pending.values()) p.reject(new Error(msg.message))
}
}
}
```
## 5. OPFS Implementation
### 5.1 Purpose
For files approaching 100 MB, holding encrypted data in memory while uploading creates memory pressure. OPFS provides temporary file storage:
- Write encrypted data to OPFS as it's generated
- Read chunks from OPFS for upload
- Delete after upload completes
### 5.2 When to Use
- Files > 50 MB: Use OPFS
- Files ≤ 50 MB: In-memory (simpler, no OPFS overhead)
Threshold is configurable.
### 5.3 OPFS API
```typescript
// In Web Worker (synchronous API for performance)
const root = await navigator.storage.getDirectory()
const fileHandle = await root.getFileHandle('encrypted-temp', {create: true})
const accessHandle = await fileHandle.createSyncAccessHandle()
// Write encrypted chunks as they're generated
accessHandle.write(encryptedChunk, {at: offset})
// Read chunk for upload
const chunk = new Uint8Array(chunkSize)
accessHandle.read(chunk, {at: chunkOffset})
// Cleanup
accessHandle.close()
await root.removeEntry('encrypted-temp')
```
### 5.4 Upload Flow with OPFS
```
1. Main: user drops file
2. Main → Worker: {type: 'encrypt', file}
3. Worker:
- Create OPFS temp file
- Encrypt 64KB at a time, write to OPFS
- Post progress every 64KB
- Compute digest
- Return {digest, key, nonce, chunkSizes} (data stays in OPFS)
4. Main: for each chunk:
- Main → Worker: {type: 'readChunk', offset, size}
- Worker: read from OPFS, return chunk
- Main: upload chunk via fetch()
5. Main → Worker: {type: 'cleanup'}
6. Worker: delete OPFS temp file
```
### 5.5 Download Flow with OPFS
```
1. Main: parse URL, get FileDescription
2. Main: for each chunk:
- Download via fetch()
- Main → Worker: {type: 'writeChunk', data, offset}
- Worker: write to OPFS temp file
3. Main → Worker: {type: 'decrypt', key, nonce, size}
4. Worker:
- Read from OPFS
- Decrypt, verify auth tag
- Return {header, content}
5. Main: trigger browser download
6. Main → Worker: {type: 'cleanup'}
```
## 6. Implementation Plan
### 6.1 Phase A: fetch() Transport
**Goal:** Replace `node:http2` with `fetch()` in `client.ts`. All existing Node.js tests pass.
1. Rewrite `connectXFTP()` to use fetch() for handshake
2. Rewrite `sendXFTPCommand()` to use fetch()
3. Update `createXFTPChunk`, `uploadXFTPChunk`, `downloadXFTPChunk`, etc.
4. Remove `node:http2` import
5. Run existing Haskell integration tests — must pass
**Files:** `client.ts`
### 6.2 Phase B: Environment Abstraction + Web Worker
**Goal:** Add `CryptoBackend` abstraction (§3) so the same code works in Node (direct) and browser (Worker).
1. Create `env.ts` with `CryptoBackend` interface and `createCryptoBackend()` factory (as specified in §3)
2. Implement `DirectMemoryBackend` for Node.js
3. Create `crypto.worker.ts` that imports and calls existing crypto functions
4. Implement `WorkerMemoryBackend` for browser
5. Update `agent.ts` to use `createCryptoBackend()` instead of direct crypto calls
6. Existing tests pass (now using `DirectMemoryBackend`)
**Files:** `env.ts`, `crypto.worker.ts`, `agent.ts`
### 6.3 Phase C: OPFS Backend
**Goal:** Large files (>50 MB) use OPFS for temp storage in browser.
1. Implement `WorkerOPFSBackend` — uses OPFS sync API in worker
2. Add OPFS helpers in worker: read/write to temp file
3. Factory function now returns `WorkerOPFSBackend` for large files
4. Same `agent.ts` code works — only backend implementation differs
**Files:** `env.ts`, `crypto.worker.ts`
### 6.4 Phase D: Browser Testing
**Goal:** Verify everything works in real browsers.
1. Create minimal test HTML page
2. Test upload flow in Chrome, Firefox, Safari
3. Test download flow
4. Test progress reporting
5. Test cancellation
6. Test error handling (network failure, invalid file)
## 7. Testing Strategy
### 7.1 Test Layers
The `CryptoBackend` abstraction (§3) enables testing at multiple levels without code duplication:
```
┌─────────────────────────────────────────────────────────────────┐
│ Layer 3: Browser Integration (Playwright) │
│ - Web Worker message passing │
│ - OPFS read/write │
│ - Progress UI updates │
│ - Real browser fetch() with CORS │
├─────────────────────────────────────────────────────────────────┤
│ Layer 2: Full Flow (Haskell-driven, Node.js) │
│ - fetch() transport against real xftp-server │
│ - Upload: encrypt → chunk → upload → build description │
│ - Download: parse → download → verify → decrypt │
│ - Cross-language: TS upload ↔ Haskell download (and vice versa) │
├─────────────────────────────────────────────────────────────────┤
│ Layer 1: Per-Function (Haskell-driven, Node.js) │
│ - 172 existing tests │
│ - Byte-identical output vs Haskell functions │
└─────────────────────────────────────────────────────────────────┘
```
### 7.2 Layer 1: Per-Function Tests (Existing)
Existing Haskell-driven tests in `XFTPWebTests.hs`. Each test calls a TypeScript function via Node and compares output with Haskell.
```bash
cabal test --ghc-options -O0 --test-option='--match=/XFTP Web Client/'
```
All 172 tests must pass. No changes needed for browser transport work.
### 7.3 Layer 2: Full Flow Tests (Node.js + fetch)
Haskell-driven integration tests using Node.js native fetch(). These test the complete upload/download flow without Worker/OPFS.
```haskell
-- XFTPWebTests.hs (extends existing test file)
it "fetch transport: upload and download round-trip" $ do
withXFTPServer testXFTPServerConfigSNI $ \server -> do
-- TypeScript uploads via fetch(), returns URI
uri <- jsOut $ callTS "src/agent" "uploadFileTest" serverAddrHex <> testFileHex
-- TypeScript downloads via fetch()
content <- jsOut $ callTS "src/agent" "downloadFileTest" uriHex
content `shouldBe` testFileContent
it "fetch transport: TS upload, Haskell download" $ do
withXFTPServer testXFTPServerConfigSNI $ \server -> do
uri <- jsOut $ callTS "src/agent" "uploadFileTest" serverAddrHex <> testFileHex
-- Haskell agent downloads using existing xftp CLI pattern
outPath <- withAgent 1 agentCfg initAgentServers testDB $ \a -> do
rfId <- xftpReceiveFile' a 1 uri Nothing
waitRfDone a
content <- B.readFile outPath
content `shouldBe` testFileContent
```
**What this tests:**
- fetch() handshake (challenge-response, TLS session binding)
- fetch() command execution (FNEW, FPUT, FGET, FACK)
- Streaming request/response bodies
- Full encrypt → upload → download → decrypt flow
**What this doesn't test:**
- Web Worker message passing
- OPFS storage
- Browser-specific fetch() behavior (CORS preflight, etc.)
### 7.4 Layer 3: Browser Integration Tests (Playwright)
Playwright tests run in real browsers, testing browser-specific functionality.
**Test infrastructure:**
```
xftp-web/
├── test/
│ ├── browser.test.ts # Playwright test file
│ └── test-server.ts # Spawns xftp-server for tests
└── test-page/
├── index.html # Minimal test UI
└── test-harness.ts # Exposes test functions to window
```
**Running browser tests:**
```bash
cd xftp-web
npm run test:browser # Spawns xftp-server, runs Playwright
```
**Test cases:**
```typescript
// test/browser.test.ts
import { test, expect } from '@playwright/test'
import { spawn } from 'child_process'
let serverProcess: ChildProcess
test.beforeAll(async () => {
// Spawn xftp-server with SNI cert for browser TLS
serverProcess = spawn('xftp-server', ['start', '-c', 'test-config.ini'])
await waitForServer()
})
test.afterAll(async () => {
serverProcess.kill()
})
test('small file upload/download (in-memory)', async ({ page }) => {
await page.goto('/test-page/')
const result = await page.evaluate(async () => {
const data = new Uint8Array(1024 * 1024) // 1 MB
crypto.getRandomValues(data)
const file = new File([data], 'small.bin')
const uri = await window.xftp.uploadFile(file)
const downloaded = await window.xftp.downloadFile(uri)
return {
uploadedSize: data.length,
downloadedSize: downloaded.length,
match: arraysEqual(data, downloaded),
usedOPFS: window.xftp.lastUploadUsedOPFS
}
})
expect(result.match).toBe(true)
expect(result.usedOPFS).toBe(false) // Small file, no OPFS
})
test('large file upload/download (OPFS)', async ({ page }) => {
await page.goto('/test-page/')
const result = await page.evaluate(async () => {
const data = new Uint8Array(60 * 1024 * 1024) // 60 MB
crypto.getRandomValues(data)
const file = new File([data], 'large.bin')
const uri = await window.xftp.uploadFile(file)
const downloaded = await window.xftp.downloadFile(uri)
return {
match: arraysEqual(data, downloaded),
usedOPFS: window.xftp.lastUploadUsedOPFS
}
})
expect(result.match).toBe(true)
expect(result.usedOPFS).toBe(true) // Large file, used OPFS
})
test('progress events fire during upload', async ({ page }) => {
await page.goto('/test-page/')
const progressEvents = await page.evaluate(async () => {
const events: number[] = []
const data = new Uint8Array(10 * 1024 * 1024) // 10 MB
const file = new File([data], 'progress.bin')
await window.xftp.uploadFile(file, (done, total) => {
events.push(done / total)
})
return events
})
expect(progressEvents.length).toBeGreaterThan(1)
expect(progressEvents[progressEvents.length - 1]).toBe(1) // 100% at end
})
test('Web Worker keeps UI responsive', async ({ page }) => {
await page.goto('/test-page/')
// Start upload and measure main thread responsiveness
const result = await page.evaluate(async () => {
const data = new Uint8Array(50 * 1024 * 1024) // 50 MB
const file = new File([data], 'responsive.bin')
let frameCount = 0
let uploadDone = false
// Count animation frames during upload
function countFrames() {
frameCount++
if (!uploadDone) requestAnimationFrame(countFrames)
}
requestAnimationFrame(countFrames)
const start = performance.now()
await window.xftp.uploadFile(file)
uploadDone = true
const elapsed = performance.now() - start
// If main thread was blocked, frameCount would be very low
const expectedFrames = (elapsed / 1000) * 30 // ~30 fps minimum
return { frameCount, expectedFrames, elapsed }
})
// Should maintain reasonable frame rate (Worker offloaded crypto)
expect(result.frameCount).toBeGreaterThan(result.expectedFrames * 0.5)
})
```
### 7.5 Cross-Browser Matrix
| Browser | fetch streaming | Web Worker | OPFS sync | Status |
|---------|----------------|------------|-----------|--------|
| Chrome 105+ | ✓ | ✓ | ✓ | Primary target |
| Firefox 111+ | ✓ | ✓ | ✓ | Supported |
| Safari 16.4+ | ✓ | ✓ | ✓ | Supported |
| Edge 105+ | ✓ | ✓ | ✓ | Supported (Chromium) |
Playwright tests run against Chrome by default. CI can run against all browsers.
### 7.6 Test Execution Summary
| Phase | Test Layer | Command | What's Verified |
|-------|-----------|---------|-----------------|
| A | Layer 1 + 2 | `cabal test --test-option='--match=/XFTP Web Client/'` | fetch() transport, full flow |
| B | Layer 3 | `npm run test:browser` | Worker message passing, progress |
| C | Layer 3 | `npm run test:browser` | OPFS storage for large files |
| D | Layer 3 | `npm run test:browser -- --project=firefox,webkit` | Cross-browser |
@@ -0,0 +1,772 @@
# Send File Web Page — Implementation Plan
## TOC
1. Executive Summary
2. Architecture
3. CryptoBackend & Web Worker
4. Server Configuration
5. Page Structure & UI
6. Upload Flow
7. Download Flow
8. Build & Dev Setup
9. agent.ts Changes
10. Testing
11. Files
12. Implementation Order
## 1. Executive Summary
Build a static web page for browser-based XFTP file transfer (Phase 5 of master RFC). The page supports upload (drag-drop → encrypt → upload → shareable link) and download (open link → download → decrypt → save). Crypto runs in a Web Worker; large files use OPFS temp storage.
Two build variants:
- **Local**: single test server at `localhost:7000` (development/testing)
- **Production**: 12 preset XFTP servers (6 SimpleX + 6 Flux)
Uses Vite for bundling (already a dependency via vitest). No CSS framework — plain CSS per RFC spec.
## 2. Architecture
```
xftp-web/
├── src/ # Library (existing, targeted changes)
│ ├── agent.ts # Modified: uploadFile readChunk, downloadFileRaw
│ ├── client.ts # Modified: downloadXFTPChunkRaw
│ ├── crypto/ # Unchanged
│ ├── download.ts # Unchanged
│ └── protocol/
│ └── description.ts # Fix: SHA-256 → SHA-512 comment on digest field
├── web/ # Web page (new)
│ ├── index.html # Entry point (CSP meta tag)
│ ├── main.ts # Router + sodium.ready init
│ ├── upload.ts # Upload UI + orchestration
│ ├── download.ts # Download UI + orchestration
│ ├── progress.ts # Circular progress canvas component
│ ├── servers.ts # Server list (build-time configured, imports servers.json)
│ ├── servers.json # Preset server addresses (shared with vite.config.ts)
│ ├── crypto-backend.ts # CryptoBackend interface + WorkerBackend
│ ├── crypto.worker.ts # Web Worker: encrypt/decrypt/OPFS
│ └── style.css # Minimal styling
├── vite.config.ts # Page build config (new)
├── tsconfig.web.json # IDE/CI type-check for web/ (new)
├── tsconfig.worker.json # IDE/CI type-check for worker (new)
├── playwright.config.ts # Page E2E test config (new)
├── vitest.config.ts # Test config (existing)
├── .gitignore # Existing (add dist-web/)
└── test/ # Tests (existing + new page test)
```
Data flow:
```
┌───────────────────────────────────────────┐
│ Main Thread │
│ │
│ Upload: upload.ts ──► agent.ts ──► fetch()│
│ Download: download.ts ──► agent.ts ──► fetch()
│ │ │
│ postMessage HTTP/2 │
│ ▼ ▼
│ ┌─────────────────┐ ┌──────────┐│
│ │ Web Worker │ │ XFTP ││
│ │ crypto.worker.ts │ │ Server ││
│ │ ┌─────────────┐ │ └──────────┘│
│ │ │ OPFS temp │ │ │
│ │ └─────────────┘ │ │
│ └─────────────────┘ │
└───────────────────────────────────────────┘
```
Both upload and download use `agent.ts` for orchestration (connection pooling, parallel chunk transfers, redirect handling). Upload uses a `readChunk` callback for Worker data access. Download uses an `onRawChunk` callback to route raw encrypted chunks to the Worker for decryption (see §7.2). ACK is the caller's responsibility — `downloadFileRaw` returns the resolved `FileDescription` without ACKing, so the caller can verify integrity before acknowledging.
## 3. CryptoBackend & Web Worker
### 3.1 Interface
```typescript
// crypto-backend.ts
export interface CryptoBackend {
// Upload: encrypt file, store encrypted data in OPFS
encrypt(data: Uint8Array, fileName: string,
onProgress?: (done: number, total: number) => void
): Promise<EncryptResult>
// Upload: read encrypted chunk from OPFS (called by agent.ts via readChunk callback)
readChunk(offset: number, size: number): Promise<Uint8Array>
// Download: transit-decrypt raw chunk and store in OPFS
decryptAndStoreChunk(
dhSecret: Uint8Array, nonce: Uint8Array,
body: Uint8Array, digest: Uint8Array, chunkNo: number
): Promise<void>
// Download: verify digest + file-level decrypt all stored chunks
// Only needs size/digest/key/nonce — not the full FileDescription (avoids sending private keys to Worker)
verifyAndDecrypt(params: {size: number, digest: Uint8Array, key: Uint8Array, nonce: Uint8Array}
): Promise<{header: FileHeader, content: Uint8Array}>
cleanup(): Promise<void>
}
// Structurally identical to EncryptedFileMetadata from agent.ts (§9.1).
// Kept separate to avoid crypto-backend.ts importing from agent.ts
// (which would pull in node:http2 via client.ts, breaking Worker bundling).
// TypeScript structural typing makes them assignment-compatible.
export interface EncryptResult {
digest: Uint8Array
key: Uint8Array
nonce: Uint8Array
chunkSizes: number[]
}
```
### 3.2 Factory
```typescript
export function createCryptoBackend(): CryptoBackend {
if (typeof Worker === 'undefined') {
throw new Error('Web Workers required — update your browser')
}
return new WorkerBackend()
}
```
The Worker always uses OPFS for temp storage (single code path — no memory/disk branching). OPFS I/O overhead is negligible relative to crypto and network time. Each Worker session creates a unique directory in OPFS root named `session-<Date.now()>-<crypto.randomUUID()>`, containing `upload.bin` and `download.bin` as needed. `cleanup()` deletes the entire session directory. On Worker startup (before processing messages), sweep OPFS root and delete any `session-*` directories whose embedded timestamp (parsed from the name) is older than 1 hour — this handles stale files from crashed tabs. The OPFS API does not expose directory timestamps, so the name-encoded timestamp is the only reliable mechanism. This prevents cross-tab collisions and unbounded OPFS growth.
### 3.3 Worker message protocol
Every request carries a numeric `id`. Responses carry the same `id`. WorkerBackend maintains a `Map<number, {resolve, reject}>` to match responses to pending promises.
Main → Worker (fields marked `†` are Transferable — arrive as `ArrayBuffer` in Worker, must be wrapped with `new Uint8Array(...)` before use):
- `{id: number, type: 'encrypt', data†: ArrayBuffer, fileName: string}` — encrypt file, store in OPFS
- `{id: number, type: 'readChunk', offset: number, size: number}` — read encrypted chunk from OPFS
- `{id: number, type: 'decryptAndStoreChunk', dhSecret: Uint8Array, nonce: Uint8Array, body†: ArrayBuffer, chunkDigest: Uint8Array, chunkNo: number}` — transit-decrypt + store in OPFS. `chunkDigest` is the per-chunk SHA-256 digest (verified by `decryptReceivedChunk`). Distinct from the file-level SHA-512 digest in `verifyAndDecrypt`.
- `{id: number, type: 'verifyAndDecrypt', size: number, digest: Uint8Array, key: Uint8Array, nonce: Uint8Array}` — verify digest + file-level decrypt all chunks. Only the four fields needed for verification/decryption are sent — not the full `FileDescription`, which contains private replica keys that the Worker doesn't need.
- `{id: number, type: 'cleanup'}` — delete OPFS temp files
Worker → Main (fields marked `†` are Transferable):
- `{id: number, type: 'progress', done: number, total: number}` — encryption/decryption progress (fire-and-forget, no promise)
- `{id: number, type: 'encrypted', digest: Uint8Array, key: Uint8Array, nonce: Uint8Array, chunkSizes: number[]}` — all fields structured-cloned (not transferred)
- `{id: number, type: 'chunk', data†: ArrayBuffer}` — readChunk response
- `{id: number, type: 'stored'}` — decryptAndStore acknowledgment
- `{id: number, type: 'decrypted', header: FileHeader, content†: ArrayBuffer}` — verifyAndDecrypt response
- `{id: number, type: 'cleaned'}`
- `{id: number, type: 'error', message: string}` — rejects the pending promise for this `id`
All messages carrying large `ArrayBuffer` payloads use `postMessage(msg, [transferables])` to transfer ownership instead of structured-clone copying. Only `ArrayBuffer` can be transferred — `Uint8Array`, `number[]`, and other types are always structured-cloned. This applies to: `encrypt` request (`data`), `readChunk` response (`data`), `decryptAndStoreChunk` request (`body`), and `verifyAndDecrypt` response (`content`). The `WorkerBackend` implementation must ensure the transferred `ArrayBuffer` covers the full `Uint8Array` — if `byteOffset !== 0` or `byteLength !== buffer.byteLength`, slice first: `data.buffer.slice(data.byteOffset, data.byteOffset + data.byteLength)`. This is required for `decryptAndStore` request bodies: `sendXFTPCommand` returns `body = fullResp.subarray(XFTP_BLOCK_SIZE)`, which has `byteOffset = XFTP_BLOCK_SIZE`. Other payloads are full-buffer views (§6 step 3 creates `new Uint8Array(await file.arrayBuffer())`; Worker responses allocate fresh buffers) but `WorkerBackend` should guard unconditionally.
### 3.4 Worker internals
**Imports:** The Worker imports directly from `libsodium-wrappers-sumo` (for `await sodium.ready`), `src/crypto/file.js` (`encryptFile`, `encodeFileHeader`, `decryptChunks`), `src/crypto/digest.js` (`sha512`), `src/protocol/chunks.js` (`prepareChunkSizes`, `fileSizeLen`, `authTagSize`), `src/protocol/encoding.js` (`concatBytes`), and `src/download.js` (`decryptReceivedChunk`). `download.js` directly imports `src/protocol/client.js` (for `decryptTransportChunk`). These transitively pull in `src/crypto/secretbox.js`, `src/crypto/keys.js`, and `src/crypto/padding.js`. None of these import `src/agent.ts` or `src/client.ts` — those pull in `node:http2` via dynamic import which would break Worker bundling. Vite tree-shakes the transitive deps automatically. Note: `download.js``protocol/client.js``crypto/keys.js` transitively pulls in `@noble/curves` (~50-80KB). This is unavoidable since `decryptTransportChunk` needs `dh` from `keys.js`. If Worker bundle size becomes a concern, `decryptReceivedChunk` could be refactored out of `download.js` into a separate module that doesn't import `protocol/client.js`.
**ArrayBuffer → Uint8Array conversion:** All Transferable fields arrive in the Worker as `ArrayBuffer`. The Worker's message handler must wrap them before passing to library functions: `new Uint8Array(msg.data)` for encrypt, `new Uint8Array(msg.body)` for decryptAndStore. Non-transferred fields (`dhSecret`, `nonce`, `digest`, `chunkSizes`) arrive as their original types (`Uint8Array` / `number[]`) via structured clone.
The Worker's encrypt handler calls the same functions as `encryptFileForUpload` in agent.ts (key/nonce generation → `encryptFile``sha512``prepareChunkSizes`). This is not reimplementation — it's calling the same library functions from a different entry point.
**Libsodium init:** Both the Worker and the main thread must `await sodium.ready` before calling any crypto functions that use libsodium. The Worker does this once on startup before processing messages. The main thread needs it before `connectXFTP` (which uses libsodium via `verifyIdentityProof`) and before `downloadXFTPChunkRaw` (which uses libsodium via `generateX25519KeyPair` + `dh`). In practice, `main.ts` calls `await sodium.ready` at page load, before any XFTP calls.
Encrypt (mirrors `encryptFileForUpload` in agent.ts):
1. Generate key (32B) + nonce (24B) via `crypto.getRandomValues`
2. `fileHdr = encodeFileHeader({fileName, fileExtra: null})`
3. `fileSize = BigInt(fileHdr.length + source.length)`
4. `payloadSize = Number(fileSize) + fileSizeLen + authTagSize`
5. `chunkSizes = prepareChunkSizes(payloadSize)`
6. `encSize = BigInt(chunkSizes.reduce((a, b) => a + b, 0))`
7. `encData = encryptFile(source, fileHdr, key, nonce, fileSize, encSize)`
8. `digest = sha512(encData)` — note: the `digest` field comment in `FileDescription` in `description.ts` says "SHA-256" but the actual hash is SHA-512 everywhere (`sha512` in agent.ts and download.ts). Fix the comment during implementation.
9. Open OPFS upload file via `createSyncAccessHandle`, write `encData`, flush, close handle. Null out `encData` reference.
10. Reopen the same OPFS file with `createSyncAccessHandle` as a persistent read handle (stored on the Worker module scope). This handle is used by all subsequent `readChunk` calls and closed on `cleanup`.
11. Post back `{digest, key, nonce, chunkSizes}` (no encData transfer — data stays in OPFS)
readChunk:
- Use the persistent read handle: `handle.read(buf, {at: offset})` → return slice as transferable ArrayBuffer. OPFS allows only one `FileSystemSyncAccessHandle` per file; the persistent handle avoids per-call open/close overhead.
decryptAndStoreChunk (removes transport encryption only — stored data is still file-level encrypted):
1. `decryptReceivedChunk(dhSecret, nonce, new Uint8Array(body), chunkDigest)` → transit-decrypted chunk data (still file-level encrypted — only the transport layer is removed). Argument order matches signature `(dhSecret, cbNonce, encData, expectedDigest)` from download.ts. `body` arrives as `ArrayBuffer` via Transferable and must be wrapped; `dhSecret`, `nonce`, `chunkDigest` arrive as `Uint8Array` via structured clone.
2. On first call, open the OPFS download temp file via `createSyncAccessHandle` and store as a persistent write handle. Record `{chunkNo, size: decrypted.length}` in an in-memory `chunkMeta: Map<number, {offset: number, size: number}>` — offset is the running sum of sizes for chunks stored so far (chunks may arrive out of order with `concurrency > 1`, so offset is assigned as `currentFileOffset`, then `currentFileOffset += size`)
3. Write decrypted chunk to the persistent handle at the recorded offset
verifyAndDecrypt (mirrors size/digest checks in agent.ts `downloadFile`):
1. Close the persistent download write handle (flush first), then reopen as a read handle. Read each chunk from OPFS into a `Uint8Array[]` array, ordered by `chunkNo`: for each entry in `chunkMeta` sorted by `chunkNo`, `handle.read(buf, {at: offset})` with the recorded offset and size
2. Concatenate for verification: `combined = concatBytes(...chunks)`
3. Verify total size: `combined.length === params.size`
4. Verify SHA-512 digest: `sha512(combined)` matches `params.digest`
5. Decrypt: `decryptChunks(BigInt(params.size), chunks, params.key, params.nonce)``params.size` is the encrypted file size (`fd.size` = `sum(chunkSizes)` = `decryptChunks`' first param `encSize`). Called directly instead of via `processDownloadedFile` (which expects a full `FileDescription`). Pass the original `chunks` array (not `combined`), as `decryptChunks` handles concatenation internally.
6. Delete OPFS download temp file
7. Return `{header, content}` via transferable ArrayBuffer
### 3.5 Browser requirements
The page requires a modern browser with Web Worker and OPFS support:
- Chrome 102+, Firefox 114+, Safari 15.2+ (Workers + OPFS + ES module Workers — Firefox added module Worker support in 114)
- If Worker or OPFS is unavailable, the page shows an error message rather than falling back silently.
No `DirectBackend` is needed — the page is browser-only, and tests run in vitest browser mode (real Chromium). The existing library tests (`test/browser.test.ts`) test the crypto/upload/download pipeline directly without Workers.
## 4. Server Configuration
### 4.1 Server lists
`web/servers.json` — single source of truth for preset server addresses (imported by both `servers.ts` and `vite.config.ts`):
```json
{
"simplex": [
"xftp://da1aH3nOT-9G8lV7bWamhxpDYdJ1xmW7j3JpGaDR5Ug=@xftp1.simplex.im",
"xftp://5vog2Imy1ExJB_7zDZrkV1KDWi96jYFyy9CL6fndBVw=@xftp2.simplex.im",
"xftp://PYa32DdYNFWi0uZZOprWQoQpIk5qyjRJ3EF7bVpbsn8=@xftp3.simplex.im",
"xftp://k_GgQl40UZVV0Y4BX9ZTyMVqX5ZewcLW0waQIl7AYDE=@xftp4.simplex.im",
"xftp://-bIo6o8wuVc4wpZkZD3tH-rCeYaeER_0lz1ffQcSJDs=@xftp5.simplex.im",
"xftp://6nSvtY9pJn6PXWTAIMNl95E1Kk1vD7FM2TeOA64CFLg=@xftp6.simplex.im"
],
"flux": [
"xftp://92Sctlc09vHl_nAqF2min88zKyjdYJ9mgxRCJns5K2U=@xftp1.simplexonflux.com",
"xftp://YBXy4f5zU1CEhnbbCzVWTNVNsaETcAGmYqGNxHntiE8=@xftp2.simplexonflux.com",
"xftp://ARQO74ZSvv2OrulRF3CdgwPz_AMy27r0phtLSq5b664=@xftp3.simplexonflux.com",
"xftp://ub2jmAa9U0uQCy90O-fSUNaYCj6sdhl49Jh3VpNXP58=@xftp4.simplexonflux.com",
"xftp://Rh19D5e4Eez37DEE9hAlXDB3gZa1BdFYJTPgJWPO9OI=@xftp5.simplexonflux.com",
"xftp://0AznwoyfX8Od9T_acp1QeeKtxUi676IBIiQjXVwbdyU=@xftp6.simplexonflux.com"
]
}
```
`web/servers.ts`:
```typescript
import {parseXFTPServer, type XFTPServer} from '../src/protocol/address.js'
import presets from './servers.json'
declare const __XFTP_SERVERS__: string[]
const serverAddresses: string[] = typeof __XFTP_SERVERS__ !== 'undefined'
? __XFTP_SERVERS__
: [...presets.simplex, ...presets.flux]
export function getServers(): XFTPServer[] {
return serverAddresses.map(parseXFTPServer)
}
export function pickRandomServer(servers: XFTPServer[]): XFTPServer {
return servers[Math.floor(Math.random() * servers.length)]
}
```
### 4.2 Build-time injection
`vite.config.ts` defines `__XFTP_SERVERS__`:
- `mode === 'local'`: `["xftp://<test-fingerprint>@localhost:7000"]`
- `mode === 'production'`: not defined → falls through to hardcoded list
### 4.3 Assumption
Production XFTP servers must have `[WEB]` section configured with a CA-signed certificate for browser TLS. Without this, browsers will reject the self-signed XFTP identity cert. The local test server uses `tests/fixtures/` certs which Chromium accepts via `ignoreHTTPSErrors`.
## 5. Page Structure & UI
### 5.1 Routing
`main.ts` checks `window.location.hash` once on page load:
- Hash present → download mode
- Hash absent → upload mode
No `hashchange` listener — the shareable link opens in a new tab. Simple page-load routing.
### 5.2 Upload UI states
1. **Landing**: Drag-drop zone centered, file picker button, size limit note
2. **Uploading**: Circular progress (canvas), percentage, cancel button
3. **Complete**: Shareable link (input + copy button), "Install SimpleX" CTA
4. **Error**: Error message + retry button. On server-unreachable, auto-retry with exponential backoff (1s, 2s, 4s, up to 3 attempts) before showing the error state.
### 5.3 Download UI states
1. **Ready**: Approximate file size displayed (encrypted size from `fd.size` or `fd.redirect.size` — see §7 step 2; file name is unavailable — it's inside the encrypted content), download button
2. **Downloading**: Circular progress, percentage
3. **Complete**: Browser save dialog triggered automatically
4. **Error**: Error message (expired, corrupted, unreachable)
### 5.4 Security summary (RFC §7.4)
Both upload-complete and download-ready states display a brief non-technical security summary:
- Files are encrypted in the browser before upload — the server never sees file contents.
- The link contains the decryption key in the hash fragment, which the browser never sends to any server.
- For maximum security, use the SimpleX app.
### 5.5 File expiry
Display on upload-complete state: "Files are typically available for 48 hours." This is an approximation — actual expiry depends on each XFTP server's `[STORE_LOG]` retention configuration. The 48-hour figure matches the current preset server defaults.
### 5.6 Styling
Plain CSS, no framework. White background, centered content, responsive. Circular progress via `<canvas>` (arc drawing, percentage text in center).
File size limit: 100MB. Displayed on upload page.
### 5.7 CSP
`index.html` includes a `<meta>` Content-Security-Policy tag with a build-time placeholder:
```html
<meta http-equiv="Content-Security-Policy"
content="default-src 'self'; worker-src 'self' blob:; style-src 'self' 'unsafe-inline'; connect-src __CSP_CONNECT_SRC__;">
```
Vite's `transformIndexHtml` hook (in `vite.config.ts`) replaces `__CSP_CONNECT_SRC__` at build time with origins derived from the server list:
- Local mode: `https://localhost:7000`
- Production: `https://xftp1.simplex.im:443 https://xftp2.simplex.im:443 ...` (all 12 servers)
## 6. Upload Flow
`web/upload.ts`:
1. User drops/picks file → `File` object
2. Validate `file.size <= 100 * 1024 * 1024` — show error if exceeded
3. Read file: `new Uint8Array(await file.arrayBuffer())` — note: after `backend.encrypt()` transfers the buffer to the Worker, `fileData` is detached (zero-length). Peak memory is ~2× file size (main thread holds original until transfer, Worker holds encrypted copy before OPFS write). Acceptable for the 100MB limit; do not raise the limit without considering memory implications.
4. Create `CryptoBackend` via factory
5. Create `XFTPClientAgent`
6. `backend.encrypt(fileData, file.name, onProgress)``EncryptResult`
- Encryption progress shown on canvas (Worker posts progress messages)
7. Pick one random server from configured list (V1: all chunks to same server)
8. Call `uploadFile(agent, server, metadata, {onProgress, readChunk: (off, sz) => backend.readChunk(off, sz)})`:
- `metadata` = `{digest, key, nonce, chunkSizes}` from EncryptResult
- Network progress shown on canvas
- Returns `{rcvDescription, sndDescription, uri}`
9. Construct full URL: `window.location.origin + window.location.pathname + '#' + uri`
10. Display link, copy button
11. Cleanup: `backend.cleanup()`, `closeXFTPAgent(agent)`
**Cancel:** User can abort via cancel button. Sets an `AbortController` signal that:
- Sends `{type: 'cleanup'}` to Worker
- Closes the XFTPClientAgent (drops HTTP/2 connections)
- Resets UI to landing state
## 7. Download Flow
`web/download.ts`:
1. Parse `window.location.hash.slice(1)``decodeDescriptionURI(fragment)``FileDescription`
2. Display file size (`fd.size` bytes, formatted human-readable). Note: `fd.size` is the encrypted size (slightly larger than plaintext due to padding + auth tag). The plaintext size is not available until decryption — display it as an approximate file size. If `fd.redirect !== null`, size comes from `fd.redirect.size` (which is the inner encrypted size).
3. User clicks "Download"
4. Create `CryptoBackend` and `XFTPClientAgent`
5. Call `downloadFileRaw(agent, fd, onRawChunk, {onProgress, concurrency: 3})`:
- `onRawChunk` forwards each raw chunk to the Worker: `backend.decryptAndStoreChunk(raw.dhSecret, raw.nonce, raw.body, raw.digest, raw.chunkNo)`
- `downloadFileRaw` handles redirect resolution internally (see §7.1), parallel downloads, and connection pooling
- Returns the resolved `FileDescription` (inner fd for redirect case, original fd otherwise)
6. `backend.verifyAndDecrypt({size: resolvedFd.size, digest: resolvedFd.digest, key: resolvedFd.key, nonce: resolvedFd.nonce})``{header, content}`
- Verifies size + SHA-512 digest + file-level decryption inside Worker. Only the four needed fields are sent — private replica keys stay on the main thread.
7. ACK: `ackFileChunks(agent, resolvedFd)` — best-effort, after verification succeeds
8. Sanitize `header.fileName` before use: strip path separators (`/`, `\`), replace null/control characters (U+0000-U+001F, U+007F), strip Unicode bidi override characters (U+202A-U+202E, U+2066-U+2069 — prevents `doc.pdf.exe` appearing as `doc.exe.pdf`), limit length to 255 chars. The filename is user-controlled (set by the uploader) and arrives via decrypted content. Then trigger browser save: `new Blob([content])``<a download="${sanitizedName}">` click
9. Cleanup: `backend.cleanup()`, `closeXFTPAgent(agent)`
### 7.1 Redirect handling
Handled inside `downloadFileRaw` in agent.ts — the web page doesn't see it. When `fd.redirect !== null`:
1. Download redirect chunks via `downloadXFTPChunkRaw` (parallel, same as regular chunks)
2. Transit-decrypt + verify + file-level decrypt on main thread (redirect data is always small — a few KB of YAML, so main thread decryption is fine)
3. Parse YAML → inner `FileDescription`, validate against `fd.redirect.{size, digest}`
4. ACK redirect chunks (best-effort)
5. Continue downloading inner description's chunks, calling `onRawChunk` for each
### 7.2 Architecture note: download refactoring
Both upload and download use `agent.ts` for orchestration. The key difference is where the crypto/network split happens:
- **Upload**: agent.ts reads encrypted chunks from the Worker via `readChunk` callback, sends them over the network.
- **Download**: agent.ts receives raw encrypted responses from the network via `downloadXFTPChunkRaw` (DH key exchange + network only, no decryption), passes them to the web page via `onRawChunk` callback, which routes them to the Worker for transit decryption.
This split keeps all expensive crypto off the main thread. Transit decryption uses a custom JS Salsa20 implementation (`xorKeystream` in secretbox.ts) that would block the UI for ~50-200ms on a 4MB chunk. File-level decryption (`decryptChunks`) is similarly expensive. Both happen in the Worker.
The cheap operations stay on the main thread: DH key exchange (`generateX25519KeyPair` + `dh` — ~1ms via libsodium WASM), XFTP command encoding/decoding, connection management.
## 8. Build & Dev Setup
### 8.1 vite.config.ts (new, separate from vitest.config.ts)
```typescript
import {defineConfig, type Plugin} from 'vite'
import {readFileSync} from 'fs'
import {createHash} from 'crypto'
import presets from './web/servers.json'
function parseHost(addr: string): string {
const m = addr.match(/@(.+)$/)
if (!m) throw new Error('bad server address: ' + addr)
const host = m[1].split(',')[0]
return host.includes(':') ? host : host + ':443'
}
function cspPlugin(servers: string[]): Plugin {
const origins = servers.map(s => 'https://' + parseHost(s)).join(' ')
return {
name: 'csp-connect-src',
transformIndexHtml: {
order: 'pre',
handler(html, ctx) {
if (ctx.server) {
// Dev mode: remove CSP meta tag entirely — Vite HMR needs inline scripts
return html.replace(/<meta\s[^>]*?Content-Security-Policy[\s\S]*?>/i, '')
}
return html.replace('__CSP_CONNECT_SRC__', origins)
}
}
}
}
export default defineConfig(({mode}) => {
const define: Record<string, string> = {}
let servers: string[]
if (mode === 'local') {
const pem = readFileSync('../tests/fixtures/ca.crt', 'utf-8')
const der = Buffer.from(pem.replace(/-----[^-]+-----/g, '').replace(/\s/g, ''), 'base64')
const fp = createHash('sha256').update(der).digest('base64')
.replace(/\+/g, '-').replace(/\//g, '_')
servers = [`xftp://${fp}@localhost:7000`]
define['__XFTP_SERVERS__'] = JSON.stringify(servers)
} else {
servers = [...presets.simplex, ...presets.flux]
}
return {
root: 'web',
build: {outDir: '../dist-web'},
define,
worker: {format: 'es'},
plugins: [cspPlugin(servers)],
}
})
```
### 8.2 package.json scripts
```json
"dev": "vite --mode local",
"build:local": "vite build --mode local",
"build:prod": "vite build --mode production",
"preview": "vite preview",
"check:web": "tsc -p tsconfig.web.json --noEmit && tsc -p tsconfig.worker.json --noEmit"
```
Note: `check:web` type-checks `src/` twice (once per config) — acceptable for this small library.
Add `vite` as an explicit devDependency (`^6.0.0` — matching the version vitest 3.x depends on transitively). Relying on transitive resolution is fragile across package managers.
### 8.3 TypeScript configuration
The existing `tsconfig.json` has `rootDir: "src"` and `include: ["src/**/*.ts"]` — this is for library compilation only (output to `dist/`). Vite handles `web/` TypeScript compilation independently via esbuild, so the main tsconfig is unchanged. `web/*.ts` files import from `../src/*.js` using relative paths.
Add two tsconfigs for `web/` type-checking — split by environment to avoid type pollution between DOM and WebWorker globals:
`tsconfig.web.json` — main-thread files (DOM globals: `document`, `window`, etc.):
```json
{
"extends": "./tsconfig.json",
"compilerOptions": {
"rootDir": ".",
"noEmit": true,
"types": [],
"moduleResolution": "bundler",
"lib": ["ES2022", "DOM"]
},
"include": ["web/**/*.ts", "src/**/*.ts"],
"exclude": ["web/crypto.worker.ts"]
}
```
`tsconfig.worker.json` — Worker file (`self`, `FileSystemSyncAccessHandle`, etc.):
```json
{
"extends": "./tsconfig.json",
"compilerOptions": {
"rootDir": ".",
"noEmit": true,
"types": [],
"moduleResolution": "bundler",
"lib": ["ES2022", "WebWorker"]
},
"include": ["web/crypto.worker.ts", "src/**/*.ts"]
}
```
Both configs set `"types": []` to prevent auto-inclusion of `@types/node` and `"moduleResolution": "bundler"` for Vite-compatible resolution (JSON imports, `.js` extension mapping). The base config's `"moduleResolution": "node"` would cause false type errors on `import ... from './servers.json'`. Both override `@types/node`, which would pollute DOM/WebWorker environments with Node.js globals (`process`, `Buffer`, etc.). This means `src/client.ts`'s dynamic `import("node:http2")` will produce a type error in these configs. This is acceptable — `src/client.ts` provides `createNodeTransport` which is never used in browser code (Vite tree-shakes it out), and full `src/` type-checking is handled by the base `tsconfig.json`. If the error is distracting, add `src/client.ts` to both configs' `exclude` arrays.
Both extend the library tsconfig (inheriting `strict`, `module`, etc.) and include `src/**/*.ts` so imports from `../src/*.js` resolve. `"noEmit": true` means they're only used for type-checking — Vite handles actual compilation. The inherited `"exclude": ["node_modules", "dist", "test"]` intentionally excludes `test/` — test files are type-checked by their own vitest/playwright configs, not by `check:web`.
### 8.4 Dev workflow
`npm run dev` → Vite dev server at `localhost:5173`, configured for local test server. Start `xftp-server` on port 7000 separately (or via the existing globalSetup).
Note: The CSP meta tag's `default-src 'self'` blocks Vite's injected HMR inline scripts in dev mode. The `cspPlugin` handles this by removing the entire CSP `<meta>` tag in serve mode (dev server), so HMR works without restrictions. Production builds always have the correct CSP.
## 9. Library Changes (agent.ts + client.ts)
Changes to support the web page: upload `readChunk` callback, download `onRawChunk` callback with parallel chunk downloads.
### 9.1 Type changes
Split the existing `EncryptedFileInfo` (which currently has `encData`, `digest`, `key`, `nonce`, `chunkSizes` as direct fields) into a metadata-only base and an extension:
```typescript
// Metadata-only variant (no encData — data lives in Worker/OPFS)
export interface EncryptedFileMetadata {
digest: Uint8Array
key: Uint8Array
nonce: Uint8Array
chunkSizes: number[]
}
// Full variant (existing, extends metadata with data)
export interface EncryptedFileInfo extends EncryptedFileMetadata {
encData: Uint8Array
}
```
### 9.2 uploadFile signature change
Replace positional optional params with an options bag. Add optional `readChunk`. When provided, `encrypted.encData` is not accessed.
```typescript
export interface UploadOptions {
onProgress?: (uploaded: number, total: number) => void
redirectThreshold?: number
readChunk?: (offset: number, size: number) => Promise<Uint8Array>
}
export async function uploadFile(
agent: XFTPClientAgent,
server: XFTPServer,
encrypted: EncryptedFileMetadata,
options?: UploadOptions
): Promise<UploadResult>
```
Inside `uploadFile`:
- Chunk read: if `options?.readChunk` is provided, use it. Otherwise, verify `'encData' in encrypted` at runtime (throws `"uploadFile: readChunk required when encData is absent"` if missing), then use `(off, sz) => Promise.resolve((encrypted as EncryptedFileInfo).encData.subarray(off, off + sz))`. This guards against calling `uploadFile` with `EncryptedFileMetadata` but no `readChunk`. For each chunk, call `readChunk(offset, size)` once and use the returned `Uint8Array` for both `getChunkDigest(chunkData)` and `uploadXFTPChunk(..., chunkData)` — do not call `readChunk` twice per chunk.
- Progress total: `const total = encrypted.chunkSizes.reduce((a, b) => a + b, 0)` — replaces `encrypted.encData.length` (line 129) since `EncryptedFileMetadata` has no `encData`. The values are identical: `encData.length === sum(chunkSizes)`.
- `buildDescription` parameter type: change from `EncryptedFileInfo` to `EncryptedFileMetadata` — it only accesses `chunkSizes`, `digest`, `key`, `nonce` (not `encData`).
`uploadRedirectDescription` (internal) is unchanged — redirect descriptions are always small and created in-memory by `encryptFileForUpload`.
### 9.3 Backward compatibility
The signature change from positional params `(agent, server, encrypted, onProgress?, redirectThreshold?)` to `(agent, server, encrypted, options?)` is a breaking change for callers that pass `onProgress` or `redirectThreshold`. In practice, the only callers are the browser test (which passes no options — no change needed) and the web page (new code). `EncryptedFileInfo` extends `EncryptedFileMetadata`, so existing callers that pass `EncryptedFileInfo` work without change.
### 9.4 client.ts: downloadXFTPChunkRaw
Split `downloadXFTPChunk` at the network/crypto boundary. The new function does DH key exchange and network I/O but skips transit decryption:
```typescript
export interface RawChunkResponse {
dhSecret: Uint8Array
nonce: Uint8Array
body: Uint8Array
}
export async function downloadXFTPChunkRaw(
c: XFTPClient, rpKey: Uint8Array, fId: Uint8Array
): Promise<RawChunkResponse> {
const {publicKey, privateKey} = generateX25519KeyPair()
const cmd = encodeFGET(encodePubKeyX25519(publicKey))
const {response, body} = await sendXFTPCommand(c, rpKey, fId, cmd)
if (response.type !== "FRFile") throw new Error("unexpected response: " + response.type)
const dhSecret = dh(response.rcvDhKey, privateKey)
return {dhSecret, nonce: response.nonce, body}
}
```
`RawChunkResponse` contains only what client.ts produces (DH secret, nonce, encrypted body). The chunk metadata (`chunkNo`, `digest`) is added by agent.ts when constructing `RawDownloadedChunk` (see §9.5).
The existing `downloadXFTPChunk` is refactored to call `downloadXFTPChunkRaw` + `decryptReceivedChunk`:
```typescript
export async function downloadXFTPChunk(
c: XFTPClient, rpKey: Uint8Array, fId: Uint8Array, digest?: Uint8Array
): Promise<Uint8Array> {
const {dhSecret, nonce, body} = await downloadXFTPChunkRaw(c, rpKey, fId)
return decryptReceivedChunk(dhSecret, nonce, body, digest ?? null)
}
```
### 9.5 agent.ts: downloadFileRaw, ackFileChunks, RawDownloadedChunk
New type combining client.ts's `RawChunkResponse` with chunk metadata from agent.ts:
```typescript
export interface RawDownloadedChunk {
chunkNo: number
dhSecret: Uint8Array
nonce: Uint8Array
body: Uint8Array
digest: Uint8Array
}
```
New function providing download orchestration with a raw chunk callback. Handles connection pooling, parallel downloads, redirect resolution, and progress. Does **not** ACK — the caller ACKs after verification.
```typescript
export interface DownloadRawOptions {
onProgress?: (downloaded: number, total: number) => void
concurrency?: number // max parallel chunk downloads, default 1
}
export async function downloadFileRaw(
agent: XFTPClientAgent,
fd: FileDescription,
onRawChunk: (chunk: RawDownloadedChunk) => Promise<void>,
options?: DownloadRawOptions
): Promise<FileDescription>
```
Returns the resolved `FileDescription` — for redirect files this is the inner fd, for non-redirect files this is the original fd. The caller uses this for verification and ACK.
Internal structure:
1. Validate `fd` via `validateFileDescription` (may double-validate if caller already validated via `decodeDescriptionURI` — harmless)
2. If `fd.redirect !== null`: resolve redirect on main thread (redirect data is small):
a. Download redirect chunks via `downloadXFTPChunk` (not raw — main thread decryption is fine for a few KB)
b. Verify size + digest, `processDownloadedFile` → YAML bytes
c. Parse inner `FileDescription`, validate against `fd.redirect.{size, digest}`
d. ACK redirect chunks (best-effort — redirect chunks are small and separate from the file chunks)
e. Replace `fd` with inner description
3. Pre-connect: call `getXFTPServerClient(agent, server)` for each unique server before launching concurrent workers. This ensures the client connection exists in the agent's map, avoiding a race condition where multiple concurrent workers all see the client as missing and each call `connectXFTP` independently (leaking all but the last connection). Known limitation: if a connection drops mid-download and multiple workers attempt reconnection simultaneously, the same TOCTOU race reappears. This is a pre-existing issue in `getXFTPServerClient`; a proper fix (per-key connection promise) is out of scope for this plan but should be tracked for follow-up.
4. Download file chunks in parallel (concurrency-limited via sliding window):
- Create a queue of chunk indices `[0, 1, ..., N-1]`. Launch `min(concurrency, N)` async workers, each pulling the next index from the queue until empty. Each worker loops: pull index → derive key → `getXFTPServerClient``downloadXFTPChunkRaw``await onRawChunk(...)` → update progress → next index. `await Promise.all(workers)` to wait for completion.
- For each chunk: derive key (`decodePrivKeyEd25519``ed25519KeyPairFromSeed`), get client (`getXFTPServerClient`), call `downloadXFTPChunkRaw`, `await onRawChunk(...)` with result + `chunkNo` + `chunk.digest`
- Each concurrency slot awaits its `onRawChunk` before starting the next download on that slot. With `concurrency > 1`, multiple `onRawChunk` calls may be in-flight concurrently (one per slot). The Worker handles this correctly — messages are queued and processed sequentially.
- Update progress after each chunk: `downloaded += chunk.chunkSize; onProgress?.(downloaded, resolvedFd.size)` — both values use encrypted sizes for consistency
5. Return the resolved `fd`
New helper for ACKing after verification:
```typescript
export async function ackFileChunks(
agent: XFTPClientAgent, fd: FileDescription
): Promise<void> {
for (const chunk of fd.chunks) {
const replica = chunk.replicas[0]
if (!replica) continue
try {
const client = await getXFTPServerClient(agent, parseXFTPServer(replica.server))
const seed = decodePrivKeyEd25519(replica.replicaKey)
const kp = ed25519KeyPairFromSeed(seed)
await ackXFTPChunk(client, kp.privateKey, replica.replicaId)
} catch (_) {}
}
}
```
The existing `downloadFile` is refactored to use `downloadFileRaw` internally:
```typescript
export async function downloadFile(
agent: XFTPClientAgent,
fd: FileDescription,
onProgress?: (downloaded: number, total: number) => void
): Promise<DownloadResult> {
const chunks: Uint8Array[] = []
const resolvedFd = await downloadFileRaw(agent, fd, async (raw) => {
chunks[raw.chunkNo - 1] = decryptReceivedChunk(
raw.dhSecret, raw.nonce, raw.body, raw.digest
)
}, {onProgress})
// verify + file-level decrypt using resolvedFd (inner fd for redirect case)
const combined = chunks.length === 1 ? chunks[0] : concatBytes(...chunks)
if (combined.length !== resolvedFd.size) throw new Error("downloadFile: file size mismatch")
const digest = sha512(combined)
if (!digestEqual(digest, resolvedFd.digest)) throw new Error("downloadFile: file digest mismatch")
// processDownloadedFile re-concatenates chunks internally — this mirrors the
// existing downloadFile pattern (verify on concatenated data, then pass chunks
// array to decryptChunks which concatenates again). Acceptable overhead for
// correctness: verification must happen on transit-decrypted data before
// file-level decryption transforms it.
const result = processDownloadedFile(resolvedFd, chunks)
await ackFileChunks(agent, resolvedFd)
return result
}
```
Existing callers retain serial behavior (`concurrency` defaults to 1). The web page opts into parallelism by passing `concurrency: 3`. The browser test (`test/browser.test.ts`) continues to work unchanged. The chunks array is initialized empty (`[]`) and populated by sparse index assignment (`chunks[raw.chunkNo - 1] = ...`), so it correctly handles both redirect and non-redirect cases regardless of the outer fd's chunk count. `digestEqual` is an existing module-private helper in agent.ts (line 327) that performs constant-time byte comparison.
### 9.6 Backward compatibility (download)
`downloadFile` signature is unchanged — existing callers are unaffected. The refactoring adds `downloadFileRaw`, `ackFileChunks`, and `RawDownloadedChunk` as new exports from agent.ts, and `downloadXFTPChunkRaw` + `RawChunkResponse` as new exports from client.ts.
## 10. Testing
### 10.1 Existing tests (unchanged)
- `npm run test:browser` — vitest browser round-trip (library-level)
- `cabal test --test-option='--match=/XFTP Web Client/'` — Haskell per-function tests
### 10.2 New: page E2E test
Add `test/page.spec.ts` using `@playwright/test` (not vitest browser mode — vitest tests run IN the browser and can't control page navigation; Playwright tests run in Node.js and control the browser). Add `@playwright/test` as a devDependency.
Add `playwright.config.ts` at the project root (`xftp-web/`):
- `webServer: { command: 'vite build --mode local && vite preview', url: 'http://localhost:4173', reuseExistingServer: !process.env.CI }` — the `url` property tells Playwright to wait until the preview server is ready before running tests
- `use.ignoreHTTPSErrors: true` (test server uses self-signed cert)
- `use.launchOptions: { args: ['--ignore-certificate-errors'] }` — required because Playwright's `ignoreHTTPSErrors` only affects page navigation, not `fetch()` calls from in-page JavaScript. Without this flag, the page's `createBrowserTransport` fetch to `https://localhost:7000` would fail TLS validation.
- `globalSetup`: `'./test/globalSetup.ts'` (starts xftp-server, shared with vitest)
```typescript
import {test, expect} from '@playwright/test'
test('page upload + download round-trip', async ({page}) => {
await page.goto(PAGE_URL)
// Set file input via page.setInputFiles()
// Wait for upload link to appear: page.waitForSelector('[data-testid="share-link"]')
// Extract hash from link text
// Navigate to PAGE_URL + '#' + hash
// Wait for download complete state
// Verify file was offered for save (check download event)
})
```
Add script: `"test:page": "playwright test test/page.spec.ts"`
This tests the real bundle including Worker loading, OPFS, and CSP. The existing `test/browser.test.ts` continues to test the library-level pipeline (vitest browser mode, no Workers).
### 10.3 Manual testing
`npm run dev` → open `localhost:5173` in browser → drag file → get link → open link in new tab → download. Requires xftp-server running on port 7000 (local mode).
## 11. Files
**Create:**
- `xftp-web/web/index.html` — page entry point (includes CSP meta tag)
- `xftp-web/web/main.ts` — router + libsodium init
- `xftp-web/web/upload.ts` — upload UI + orchestration
- `xftp-web/web/download.ts` — download UI + orchestration
- `xftp-web/web/progress.ts` — circular progress canvas component
- `xftp-web/web/servers.json` — preset server addresses (shared by servers.ts and vite.config.ts)
- `xftp-web/web/servers.ts` — server configuration (imports servers.json)
- `xftp-web/web/crypto-backend.ts` — CryptoBackend interface + WorkerBackend + factory
- `xftp-web/web/crypto.worker.ts` — Web Worker implementation
- `xftp-web/web/style.css` — styles
- `xftp-web/vite.config.ts` — page build config (CSP generation, server list)
- `xftp-web/tsconfig.web.json` — IDE/CI type-checking for `web/` main-thread files (DOM)
- `xftp-web/tsconfig.worker.json` — IDE/CI type-checking for `web/crypto.worker.ts` (WebWorker)
- `xftp-web/playwright.config.ts` — Playwright E2E test config (webServer, globalSetup)
- `xftp-web/test/page.spec.ts` — page E2E test (Playwright)
**Modify:**
- `xftp-web/src/agent.ts` — add `EncryptedFileMetadata` type, `uploadFile` options bag with `readChunk`, `downloadFileRaw` with `onRawChunk` callback + parallel downloads, `ackFileChunks`, `RawDownloadedChunk` type, refactor `downloadFile` on top of `downloadFileRaw`, add `import {decryptReceivedChunk} from "./download.js"` (needed by refactored `downloadFile`)
- `xftp-web/src/client.ts` — add `downloadXFTPChunkRaw`, `RawChunkResponse` type, refactor `downloadXFTPChunk` to use raw variant
- `xftp-web/package.json` — add dev/build/check:web/test:page scripts, add `vite` + `@playwright/test` devDeps
- `xftp-web/src/protocol/description.ts` — fix stale "SHA-256" comment on `FileDescription.digest` to "SHA-512"
- `xftp-web/.gitignore` — add `dist-web/`
## 12. Implementation Order
1. **Library refactoring**`client.ts`: add `downloadXFTPChunkRaw`; `agent.ts`: add `downloadFileRaw` + parallel downloads, `uploadFile` options bag with `readChunk`; refactor existing `downloadFile` on top of `downloadFileRaw`. Run existing tests to verify no regressions.
2. **Vite config + HTML shell**`vite.config.ts`, `index.html`, `main.ts`, verify dev server works
3. **Server config**`servers.ts` with both local and production server lists
4. **CryptoBackend + Worker** — interface, WorkerBackend, Worker implementation, OPFS logic
5. **Upload flow**`upload.ts` with drag-drop, encrypt via Worker, upload via agent, show link
6. **Download flow**`download.ts` with URL parsing, download via agent `downloadFileRaw`, Worker decrypt, browser save
7. **Progress component**`progress.ts` canvas drawing
8. **Styling**`style.css`
9. **Testing** — page E2E test, manual browser verification
10. **Build scripts**`build:local`, `build:prod` in package.json
@@ -0,0 +1,53 @@
# XFTPClientAgent Pattern
## TOC
1. Executive Summary
2. Changes: client.ts
3. Changes: agent.ts
4. Changes: test/browser.test.ts
5. Verification
## Executive Summary
Add `XFTPClientAgent` — a per-server connection pool matching the Haskell pattern. The agent caches `XFTPClient` instances by server URL. All orchestration functions (`uploadFile`, `downloadFile`, `deleteFile`) take `agent` as first parameter and use `getXFTPServerClient(agent, server)` instead of calling `connectXFTP` directly. Connections stay open on success; the caller creates and closes the agent.
`connectXFTP` and `closeXFTP` stay exported (used by `XFTPWebTests.hs` Haskell tests). The `browserClients` hack, per-function `connections: Map`, and `getOrConnect` are deleted.
## Changes: client.ts
**Add** after types section: `XFTPClientAgent` interface, `newXFTPAgent`, `getXFTPServerClient`, `closeXFTPServerClient`, `closeXFTPAgent`.
**Delete**: `browserClients` Map and all `isNode` browser-cache checks in `connectXFTP` and `closeXFTP`.
**Revert `closeXFTP`** to unconditional `c.transport.close()` (browser transport.close() is already a no-op).
`connectXFTP` stays exported (backward compat) but becomes a raw low-level function — no caching.
## Changes: agent.ts
**Imports**: replace `connectXFTP`/`closeXFTP` with `getXFTPServerClient`/`closeXFTPAgent` etc.
**Re-export** from agent.ts: `newXFTPAgent`, `closeXFTPAgent`, `XFTPClientAgent`.
**`uploadFile`**: add `agent: XFTPClientAgent` as first param. Replace `connectXFTP``getXFTPServerClient`. Remove `finally { closeXFTP }`. Pass `agent` to `uploadRedirectDescription`.
**`uploadRedirectDescription`**: change from `(client, server, innerFd)` to `(agent, server, innerFd)`. Get client via `getXFTPServerClient`.
**`downloadFile`**: add `agent` param. Delete local `connections: Map`. Replace `getOrConnect``getXFTPServerClient`. Remove finally cleanup. Pass `agent` to `downloadWithRedirect`.
**`downloadWithRedirect`**: add `agent` param. Same replacements. Remove try/catch cleanup. Recursive call passes `agent`.
**`deleteFile`**: add `agent` param. Same pattern.
**Delete**: `getOrConnect` function entirely.
## Changes: test/browser.test.ts
Create agent before operations, pass to upload/download, close in finally.
## Verification
1. `npx vitest --run` — browser round-trip test passes
2. No remaining `browserClients`, `getOrConnect`, or per-function `connections: Map` locals
3. `connectXFTP` and `closeXFTP` still exported (XFTPWebTests.hs compat)
4. All orchestration functions take `agent` as first param
@@ -0,0 +1,859 @@
# XFTP Web Page E2E Tests Plan
## Table of Contents
1. [Executive Summary](#1-executive-summary)
2. [Test Infrastructure](#2-test-infrastructure)
3. [Test Infrastructure - Page Objects](#3-test-infrastructure---page-objects)
4. [Upload Flow Tests](#4-upload-flow-tests)
5. [Download Flow Tests](#5-download-flow-tests)
6. [Edge Cases](#6-edge-cases)
7. [Implementation Order](#7-implementation-order)
8. [Test Utilities](#8-test-utilities)
---
## 1. Executive Summary
This document specifies comprehensive Playwright E2E tests for the XFTP web page. The existing test (`page.spec.ts`) performs a basic upload/download round-trip. This plan extends coverage to:
- **Upload flow**: File selection (picker + drag-drop), validation, progress, cancellation, link sharing, error handling
- **Download flow**: Invalid link handling, download button, progress, file save, error states
- **Edge cases**: Boundary file sizes, special characters, network failures, multi-chunk files with redirect, UI information display
**Key constraints**:
- Tests run against a local XFTP server (started via `globalSetup.ts`)
- Server port is dynamic (read from `/tmp/xftp-test-server.port`)
- Browser uses `--ignore-certificate-errors` for self-signed certs
- OPFS and Web Workers are required (Chromium supports both)
**Test file location**: `/code/simplexmq/xftp-web/test/page.spec.ts`
**Architecture**: Tests use the Page Object Model pattern to encapsulate UI interactions, making tests read as domain-specific scenarios rather than raw Playwright API calls.
---
## 2. Test Infrastructure
### 2.1 Current Setup
```
xftp-web/
├── playwright.config.ts # Playwright config (webServer, globalSetup)
├── test/
│ ├── globalSetup.ts # Starts xftp-server, writes port to PORT_FILE
│ ├── page.spec.ts # E2E tests (to be extended)
│ └── pages/ # Page Objects (new)
│ ├── UploadPage.ts
│ └── DownloadPage.ts
```
### 2.2 Prerequisites
- `globalSetup.ts` starts the XFTP server and writes port to `PORT_FILE`
- Tests must read the port dynamically: `readFileSync(PORT_FILE, 'utf-8').trim()`
- Vite builds and serves the page at `http://localhost:4173`
---
## 3. Test Infrastructure - Page Objects
Page Objects encapsulate page-specific selectors and actions, providing a clean API for tests. This follows the standard Page Object Model pattern used in simplex-chat and most professional test suites.
### 3.1 UploadPage
```typescript
// test/pages/UploadPage.ts
import {Page, Locator, expect} from '@playwright/test'
export class UploadPage {
readonly page: Page
readonly dropZone: Locator
readonly fileInput: Locator
readonly progressStage: Locator
readonly progressCanvas: Locator
readonly statusText: Locator
readonly cancelButton: Locator
readonly completeStage: Locator
readonly shareLink: Locator
readonly copyButton: Locator
readonly errorStage: Locator
readonly errorMessage: Locator
readonly retryButton: Locator
readonly expiryNote: Locator
readonly securityNote: Locator
constructor(page: Page) {
this.page = page
this.dropZone = page.locator('#drop-zone')
this.fileInput = page.locator('#file-input')
this.progressStage = page.locator('#upload-progress')
this.progressCanvas = page.locator('#progress-container canvas')
this.statusText = page.locator('#upload-status')
this.cancelButton = page.locator('#cancel-btn')
this.completeStage = page.locator('#upload-complete')
this.shareLink = page.locator('[data-testid="share-link"]')
this.copyButton = page.locator('#copy-btn')
this.errorStage = page.locator('#upload-error')
this.errorMessage = page.locator('#error-msg')
this.retryButton = page.locator('#retry-btn')
this.expiryNote = page.locator('.expiry')
this.securityNote = page.locator('.security-note')
}
async goto() {
await this.page.goto('http://localhost:4173')
}
async selectFile(name: string, content: Buffer, mimeType = 'application/octet-stream') {
await this.fileInput.setInputFiles({name, mimeType, buffer: content})
}
async selectTextFile(name: string, content: string) {
await this.selectFile(name, Buffer.from(content, 'utf-8'), 'text/plain')
}
async selectLargeFile(name: string, sizeBytes: number) {
// Create large file in browser to avoid memory issues in test process
await this.page.evaluate(({name, size}) => {
const input = document.getElementById('file-input') as HTMLInputElement
const buffer = new ArrayBuffer(size)
new Uint8Array(buffer).fill(0x55)
const file = new File([buffer], name, {type: 'application/octet-stream'})
const dt = new DataTransfer()
dt.items.add(file)
input.files = dt.files
input.dispatchEvent(new Event('change', {bubbles: true}))
}, {name, size: sizeBytes})
}
async dragDropFile(name: string, content: Buffer) {
// Drag-drop uses same file input handler internally
await this.selectFile(name, content)
}
async waitForEncrypting(timeout = 10_000) {
await expect(this.statusText).toContainText('Encrypting', {timeout})
}
async waitForUploading(timeout = 30_000) {
await expect(this.statusText).toContainText('Uploading', {timeout})
}
async waitForShareLink(timeout = 60_000): Promise<string> {
await expect(this.shareLink).toBeVisible({timeout})
return await this.shareLink.inputValue()
}
async clickCopy() {
await this.copyButton.click()
await expect(this.copyButton).toContainText('Copied!')
}
async clickCancel() {
await this.cancelButton.click()
}
async clickRetry() {
await this.retryButton.click()
}
async expectError(messagePattern: string | RegExp) {
await expect(this.errorStage).toBeVisible()
await expect(this.errorMessage).toContainText(messagePattern)
}
async expectDropZoneVisible() {
await expect(this.dropZone).toBeVisible()
}
async expectProgressVisible() {
await expect(this.progressStage).toBeVisible()
await expect(this.progressCanvas).toBeVisible()
}
async expectCompleteWithExpiry() {
await expect(this.completeStage).toBeVisible()
await expect(this.expiryNote).toContainText('48 hours')
}
async expectSecurityNote() {
await expect(this.securityNote).toBeVisible()
await expect(this.securityNote).toContainText('encrypted')
}
getHashFromLink(url: string): string {
return new URL(url).hash
}
}
```
### 3.2 DownloadPage
```typescript
// test/pages/DownloadPage.ts
import {Page, Locator, expect, Download} from '@playwright/test'
export class DownloadPage {
readonly page: Page
readonly readyStage: Locator
readonly downloadButton: Locator
readonly progressStage: Locator
readonly progressCanvas: Locator
readonly statusText: Locator
readonly errorStage: Locator
readonly errorMessage: Locator
readonly retryButton: Locator
readonly securityNote: Locator
constructor(page: Page) {
this.page = page
this.readyStage = page.locator('#dl-ready')
this.downloadButton = page.locator('#dl-btn')
this.progressStage = page.locator('#dl-progress')
this.progressCanvas = page.locator('#dl-progress-container canvas')
this.statusText = page.locator('#dl-status')
this.errorStage = page.locator('#dl-error')
this.errorMessage = page.locator('#dl-error-msg')
this.retryButton = page.locator('#dl-retry-btn')
this.securityNote = page.locator('.security-note')
}
async goto(hash: string) {
await this.page.goto(`http://localhost:4173${hash}`)
}
async gotoWithLink(fullUrl: string) {
const hash = new URL(fullUrl).hash
await this.goto(hash)
}
async expectFileReady() {
await expect(this.readyStage).toBeVisible()
await expect(this.downloadButton).toBeVisible()
}
async expectFileSizeDisplayed() {
await expect(this.readyStage).toContainText(/\d+(?:\.\d+)?\s*(?:KB|MB|B)/)
}
async clickDownload(): Promise<Download> {
const downloadPromise = this.page.waitForEvent('download')
await this.downloadButton.click()
return downloadPromise
}
async waitForDownloading(timeout = 30_000) {
await expect(this.statusText).toContainText('Downloading', {timeout})
}
async waitForDecrypting(timeout = 30_000) {
await expect(this.statusText).toContainText('Decrypting', {timeout})
}
async expectProgressVisible() {
await expect(this.progressStage).toBeVisible()
await expect(this.progressCanvas).toBeVisible()
}
async expectInitialError(messagePattern: string | RegExp) {
// For malformed links - error shown in card without #dl-error stage
await expect(this.page.locator('.card .error')).toBeVisible()
await expect(this.page.locator('.card .error')).toContainText(messagePattern)
}
async expectRuntimeError(messagePattern: string | RegExp) {
// For runtime download errors - uses #dl-error stage
await expect(this.errorStage).toBeVisible()
await expect(this.errorMessage).toContainText(messagePattern)
}
async expectSecurityNote() {
await expect(this.securityNote).toBeVisible()
await expect(this.securityNote).toContainText('encrypted')
}
}
```
### 3.3 Test Fixtures
```typescript
// test/fixtures.ts
import {test as base} from '@playwright/test'
import {UploadPage} from './pages/UploadPage'
import {DownloadPage} from './pages/DownloadPage'
import {readFileSync} from 'fs'
// Extend Playwright test with page objects
export const test = base.extend<{
uploadPage: UploadPage
downloadPage: DownloadPage
}>({
uploadPage: async ({page}, use) => {
const uploadPage = new UploadPage(page)
await uploadPage.goto()
await use(uploadPage)
},
downloadPage: async ({page}, use) => {
await use(new DownloadPage(page))
},
})
export {expect} from '@playwright/test'
// Test data helpers
export function createTestContent(size: number, fill = 0x41): Buffer {
return Buffer.alloc(size, fill)
}
export function createTextContent(text: string): Buffer {
return Buffer.from(text, 'utf-8')
}
export function uniqueFileName(base: string, ext = 'txt'): string {
return `${base}-${Date.now()}.${ext}`
}
```
---
## 4. Upload Flow Tests
### 4.1 File Selection - File Picker Button
**Test ID**: `upload-file-picker`
```typescript
test('upload via file picker button', async ({uploadPage}) => {
await uploadPage.expectDropZoneVisible()
await uploadPage.selectTextFile('picker-test.txt', 'test content ' + Date.now())
await uploadPage.waitForEncrypting()
await uploadPage.waitForUploading()
const link = await uploadPage.waitForShareLink()
expect(link).toMatch(/^http:\/\/localhost:\d+\/#/)
})
```
### 4.2 File Selection - Drag and Drop
**Test ID**: `upload-drag-drop`
```typescript
test('upload via drag and drop', async ({uploadPage}) => {
await uploadPage.dragDropFile('dragdrop-test.txt', createTextContent('drag drop test'))
await uploadPage.expectProgressVisible()
const link = await uploadPage.waitForShareLink()
expect(link).toContain('#')
})
```
### 4.3 File Size Validation - Too Large
**Test ID**: `upload-file-too-large`
```typescript
test('upload rejects file over 100MB', async ({uploadPage}) => {
await uploadPage.selectLargeFile('large.bin', 100 * 1024 * 1024 + 1)
await uploadPage.expectError('too large')
await uploadPage.expectError('100 MB')
})
```
### 4.4 File Size Validation - Empty File
**Test ID**: `upload-file-empty`
```typescript
test('upload rejects empty file', async ({uploadPage}) => {
await uploadPage.selectFile('empty.txt', Buffer.alloc(0))
await uploadPage.expectError('empty')
})
```
### 4.5 Progress Display
**Test ID**: `upload-progress-display`
```typescript
test('upload shows progress during encryption and upload', async ({uploadPage}) => {
await uploadPage.selectFile('progress-test.bin', createTestContent(500 * 1024))
await uploadPage.expectProgressVisible()
await uploadPage.waitForEncrypting()
await uploadPage.waitForUploading()
await uploadPage.waitForShareLink()
})
```
### 4.6 Cancel Button
**Test ID**: `upload-cancel`
```typescript
test('cancel button aborts upload and returns to landing', async ({uploadPage}) => {
await uploadPage.selectFile('cancel-test.bin', createTestContent(1024 * 1024))
await uploadPage.expectProgressVisible()
await uploadPage.clickCancel()
await uploadPage.expectDropZoneVisible()
await expect(uploadPage.shareLink).toBeHidden()
})
```
### 4.7 Share Link Display and Copy
**Test ID**: `upload-share-link-copy`
```typescript
test('share link copy button works', async ({uploadPage, context}) => {
await context.grantPermissions(['clipboard-read', 'clipboard-write'])
await uploadPage.selectTextFile('copy-test.txt', 'copy test content')
const link = await uploadPage.waitForShareLink()
await uploadPage.clickCopy()
// Verify clipboard (may fail in headless)
try {
const clipboardText = await uploadPage.page.evaluate(() => navigator.clipboard.readText())
expect(clipboardText).toBe(link)
} catch {
// Clipboard API may not be available
}
})
```
### 4.8 Error Handling and Retry
**Test ID**: `upload-error-retry`
```typescript
test('error state shows retry button', async ({uploadPage}) => {
await uploadPage.selectFile('error-test.txt', Buffer.alloc(0))
await uploadPage.expectError('empty')
await expect(uploadPage.retryButton).toBeVisible()
})
```
---
## 5. Download Flow Tests
### 5.1 Invalid Link Handling - Malformed Hash
**Test ID**: `download-invalid-hash-malformed`
```typescript
test('download shows error for malformed hash', async ({downloadPage}) => {
await downloadPage.goto('#not-valid-base64!!!')
await downloadPage.expectInitialError(/[Ii]nvalid|corrupted/)
await expect(downloadPage.downloadButton).not.toBeVisible()
})
```
### 5.2 Invalid Link Handling - Valid Base64 but Invalid Structure
**Test ID**: `download-invalid-hash-structure`
```typescript
test('download shows error for invalid structure', async ({downloadPage}) => {
await downloadPage.goto('#AAAA')
await downloadPage.expectInitialError(/[Ii]nvalid|corrupted/)
})
```
### 5.3 Download Button Click
**Test ID**: `download-button-click`
```typescript
test('download button initiates download', async ({uploadPage, downloadPage}) => {
// Upload first
await uploadPage.selectTextFile('dl-btn-test.txt', 'download test content')
const link = await uploadPage.waitForShareLink()
// Navigate to download
await downloadPage.gotoWithLink(link)
await downloadPage.expectFileReady()
// Click download
const download = await downloadPage.clickDownload()
expect(download.suggestedFilename()).toBe('dl-btn-test.txt')
})
```
### 5.4 Progress Display
**Test ID**: `download-progress-display`
```typescript
test('download shows progress', async ({uploadPage, downloadPage}) => {
await uploadPage.selectFile('dl-progress.bin', createTestContent(500 * 1024))
const link = await uploadPage.waitForShareLink()
await downloadPage.gotoWithLink(link)
const downloadPromise = downloadPage.clickDownload()
await downloadPage.expectProgressVisible()
await downloadPage.waitForDownloading()
await downloadPromise
})
```
### 5.5 File Save Verification
**Test ID**: `download-file-save`
```typescript
test('downloaded file content matches upload', async ({uploadPage, downloadPage}) => {
const content = 'verification content ' + Date.now()
const fileName = 'verify.txt'
await uploadPage.selectTextFile(fileName, content)
const link = await uploadPage.waitForShareLink()
await downloadPage.gotoWithLink(link)
const download = await downloadPage.clickDownload()
expect(download.suggestedFilename()).toBe(fileName)
const path = await download.path()
if (path) {
const downloadedContent = (await import('fs')).readFileSync(path, 'utf-8')
expect(downloadedContent).toBe(content)
}
})
```
---
## 6. Edge Cases
### 6.1 Very Small Files
**Test ID**: `edge-small-file`
```typescript
test('upload and download 1-byte file', async ({uploadPage, downloadPage}) => {
await uploadPage.selectFile('tiny.bin', Buffer.from([0x42]))
const link = await uploadPage.waitForShareLink()
await downloadPage.gotoWithLink(link)
const download = await downloadPage.clickDownload()
expect(download.suggestedFilename()).toBe('tiny.bin')
const path = await download.path()
if (path) {
const content = (await import('fs')).readFileSync(path)
expect(content.length).toBe(1)
expect(content[0]).toBe(0x42)
}
})
```
### 6.2 Files Near 100MB Limit
**Test ID**: `edge-near-limit`
```typescript
test.slow()
test('upload file at exactly 100MB', async ({uploadPage}) => {
await uploadPage.selectLargeFile('exactly-100mb.bin', 100 * 1024 * 1024)
// Should succeed (not show error)
await expect(uploadPage.errorStage).toBeHidden({timeout: 5000})
await uploadPage.expectProgressVisible()
// Wait for completion (may take a while)
await uploadPage.waitForShareLink(300_000)
})
```
### 6.3 Special Characters in Filename
**Test ID**: `edge-special-chars-filename`
```typescript
test('upload and download file with unicode filename', async ({uploadPage, downloadPage}) => {
const fileName = 'test-\u4e2d\u6587-\u0420\u0443\u0441\u0441\u043a\u0438\u0439.txt'
await uploadPage.selectTextFile(fileName, 'unicode filename test')
const link = await uploadPage.waitForShareLink()
await downloadPage.gotoWithLink(link)
const download = await downloadPage.clickDownload()
expect(download.suggestedFilename()).toBe(fileName)
})
test('upload and download file with spaces', async ({uploadPage, downloadPage}) => {
const fileName = 'my document (final) v2.txt'
await uploadPage.selectTextFile(fileName, 'spaces test')
const link = await uploadPage.waitForShareLink()
await downloadPage.gotoWithLink(link)
const download = await downloadPage.clickDownload()
expect(download.suggestedFilename()).toBe(fileName)
})
test('filename with path separators is sanitized', async ({uploadPage, downloadPage}) => {
await uploadPage.selectTextFile('../../../etc/passwd', 'path traversal test')
const link = await uploadPage.waitForShareLink()
await downloadPage.gotoWithLink(link)
const download = await downloadPage.clickDownload()
expect(download.suggestedFilename()).not.toContain('/')
expect(download.suggestedFilename()).not.toContain('\\')
})
```
### 6.4 Network Errors (Mocked)
**Test ID**: `edge-network-error`
```typescript
test('upload handles network error gracefully', async ({uploadPage}) => {
// Intercept and abort POST requests
await uploadPage.page.route('**/localhost:*', route => {
if (route.request().method() === 'POST') {
route.abort('failed')
} else {
route.continue()
}
})
await uploadPage.selectTextFile('network-error.txt', 'network error test')
await uploadPage.expectError(/.+/) // Any error message
})
```
### 6.5 Binary File Content Integrity
**Test ID**: `edge-binary-content`
```typescript
test('binary file with all byte values', async ({uploadPage, downloadPage}) => {
// Create buffer with all 256 byte values
const buffer = Buffer.alloc(256)
for (let i = 0; i < 256; i++) buffer[i] = i
await uploadPage.selectFile('all-bytes.bin', buffer)
const link = await uploadPage.waitForShareLink()
await downloadPage.gotoWithLink(link)
const download = await downloadPage.clickDownload()
const path = await download.path()
if (path) {
const content = (await import('fs')).readFileSync(path)
expect(content.length).toBe(256)
for (let i = 0; i < 256; i++) {
expect(content[i]).toBe(i)
}
}
})
```
### 6.6 Multiple Concurrent Downloads
**Test ID**: `edge-concurrent-downloads`
```typescript
test('concurrent downloads from same link', async ({browser}) => {
const context = await browser.newContext({ignoreHTTPSErrors: true})
const page1 = await context.newPage()
const upload = new UploadPage(page1)
await upload.goto()
await upload.selectTextFile('concurrent.txt', 'concurrent download test')
const link = await upload.waitForShareLink()
const hash = upload.getHashFromLink(link)
// Open two tabs and download concurrently
const page2 = await context.newPage()
const page3 = await context.newPage()
const dl2 = new DownloadPage(page2)
const dl3 = new DownloadPage(page3)
await dl2.goto(hash)
await dl3.goto(hash)
const [download2, download3] = await Promise.all([
dl2.clickDownload(),
dl3.clickDownload()
])
expect(download2.suggestedFilename()).toBe('concurrent.txt')
expect(download3.suggestedFilename()).toBe('concurrent.txt')
await context.close()
})
```
### 6.7 Redirect File Handling (Multi-chunk)
**Test ID**: `edge-redirect-file`
```typescript
test.slow()
test('upload and download multi-chunk file with redirect', async ({uploadPage, downloadPage}) => {
// Use ~5MB file to get multiple chunks
await uploadPage.selectLargeFile('multi-chunk.bin', 5 * 1024 * 1024)
const link = await uploadPage.waitForShareLink(120_000)
await downloadPage.gotoWithLink(link)
const download = await downloadPage.clickDownload()
expect(download.suggestedFilename()).toBe('multi-chunk.bin')
const path = await download.path()
if (path) {
const stat = (await import('fs')).statSync(path)
expect(stat.size).toBe(5 * 1024 * 1024)
}
})
```
### 6.8 UI Information Display
**Test ID**: `edge-ui-info`
```typescript
test('upload complete shows expiry and security note', async ({uploadPage}) => {
await uploadPage.selectTextFile('ui-test.txt', 'ui test')
await uploadPage.waitForShareLink()
await uploadPage.expectCompleteWithExpiry()
await uploadPage.expectSecurityNote()
})
test('download page shows file size and security note', async ({uploadPage, downloadPage}) => {
await uploadPage.selectFile('size-test.bin', createTestContent(1024))
const link = await uploadPage.waitForShareLink()
await downloadPage.gotoWithLink(link)
await downloadPage.expectFileSizeDisplayed()
await downloadPage.expectSecurityNote()
})
```
---
## 7. Implementation Order
### Phase 1: Core Infrastructure (Priority: High)
1. Create `test/pages/UploadPage.ts` with Page Object
2. Create `test/pages/DownloadPage.ts` with Page Object
3. Create `test/fixtures.ts` with extended test function
4. Refactor existing test to use Page Objects
### Phase 2: Core Happy Path (Priority: High)
5. `upload-file-picker` - Basic upload via file picker
6. `download-button-click` - Basic download
7. `download-file-save` - Content verification
### Phase 3: Validation (Priority: High)
8. `upload-file-too-large` - Size validation
9. `upload-file-empty` - Empty file validation
10. `download-invalid-hash-malformed` - Invalid link handling
11. `download-invalid-hash-structure` - Invalid structure handling
### Phase 4: Progress and Cancel (Priority: Medium)
12. `upload-progress-display` - Progress visibility
13. `upload-cancel` - Cancel functionality
14. `download-progress-display` - Download progress
### Phase 5: Link Sharing (Priority: Medium)
15. `upload-share-link-copy` - Copy button functionality
16. `upload-drag-drop` - Drag-drop upload
### Phase 6: Edge Cases (Priority: Low)
17. `edge-small-file` - 1-byte file
18. `edge-special-chars-filename` - Unicode/special characters
19. `edge-binary-content` - Binary content integrity
20. `edge-near-limit` - 100MB file (slow test)
21. `edge-network-error` - Network error handling
### Phase 7: Error Recovery and Advanced (Priority: Low)
22. `upload-error-retry` - Retry after error
23. `edge-concurrent-downloads` - Concurrent access
24. `edge-redirect-file` - Multi-chunk file with redirect (slow)
25. `edge-ui-info` - Expiry message, security notes
---
## 8. Test Utilities
### 8.1 Shared Test Setup
```typescript
// test/page.spec.ts
import {test, expect, createTestContent, createTextContent, uniqueFileName} from './fixtures'
test.describe('Upload Flow', () => {
test('upload via file picker', async ({uploadPage}) => {
// Tests use uploadPage fixture which navigates automatically
})
})
test.describe('Download Flow', () => {
test('download works', async ({uploadPage, downloadPage}) => {
// Both pages available via fixtures
})
})
test.describe('Edge Cases', () => {
// Edge case tests
})
```
### 8.2 File Structure
```
xftp-web/test/
├── fixtures.ts # Playwright fixtures with page objects
├── pages/
│ ├── UploadPage.ts # Upload page object
│ └── DownloadPage.ts # Download page object
├── page.spec.ts # All E2E tests
└── globalSetup.ts # Server startup (existing)
```
---
## Appendix: Test Matrix
| Test ID | Category | Priority | Estimated Time | Dependencies |
|---------|----------|----------|----------------|--------------|
| upload-file-picker | Upload | High | 30s | - |
| upload-drag-drop | Upload | Medium | 30s | - |
| upload-file-too-large | Upload | High | 5s | - |
| upload-file-empty | Upload | High | 5s | - |
| upload-progress-display | Upload | Medium | 45s | - |
| upload-cancel | Upload | Medium | 30s | - |
| upload-share-link-copy | Upload | Medium | 30s | - |
| upload-error-retry | Upload | Low | 30s | - |
| download-invalid-hash-malformed | Download | High | 5s | - |
| download-invalid-hash-structure | Download | High | 5s | - |
| download-button-click | Download | High | 45s | upload |
| download-progress-display | Download | Medium | 60s | upload |
| download-file-save | Download | High | 45s | upload |
| edge-small-file | Edge | Low | 30s | - |
| edge-near-limit | Edge | Low | 300s | - |
| edge-special-chars-filename | Edge | Low | 30s | - |
| edge-network-error | Edge | Low | 45s | - |
| edge-binary-content | Edge | Low | 30s | - |
| edge-concurrent-downloads | Edge | Low | 60s | upload |
| edge-redirect-file | Edge | Low | 120s | - |
| edge-ui-info | Edge | Low | 60s | upload |
**Total estimated time**: ~18 minutes (excluding 100MB and 5MB tests)
@@ -0,0 +1,221 @@
# XFTP Web Hello Header — Session Re-handshake for Browser Connection Reuse
## 1. Problem Statement
Browser HTTP/2 connection pooling reuses TLS connections across page navigations (same origin = same connection pool). The XFTP server maintains per-TLS-connection session state in `TMap SessionId Handshake` keyed by `tlsUniq tls`. When a browser navigates from the upload page to the download page (or reloads), the new page sends a fresh ClientHello on the reused HTTP/2 connection. The server is already in `HandshakeAccepted` state for that connection, so it routes the request to `processRequest`, which expects a 16384-byte command block but receives a 34-byte ClientHello → `ERR BLOCK`.
**Root cause**: The server cannot distinguish a ClientHello from a command on an already-handshaked connection because both arrive on the same HTTP/2 connection (same `tlsUniq`), and there is no content-level discriminator (ClientHello is unpadded, but the server never gets to parse it — the size check in `processRequest` rejects it first).
**Browser limitation**: `fetch()` provides zero control over HTTP/2 connection pooling. There is no browser API to force a new connection or detect connection reuse before a request is sent.
## 2. Solution Summary
Add an HTTP header `xftp-web-hello` to web ClientHello requests. When the server sees this header on an already-handshaked connection (`HandshakeAccepted` state), it re-runs `processHello` **reusing the existing session keys** (same X25519 key pair from the original handshake). The client then completes the normal handshake flow (sends ClientHandshake, receives ack) and proceeds with commands.
Key properties:
- Server reuses existing `serverPrivKey` — no new key material generated on re-handshake, so `thAuth` remains consistent with any in-flight commands on concurrent HTTP/2 streams.
- Header is only checked when `sniUsed` is true (web/browser connections). Native XFTP clients are unaffected.
- CORS preflight already allows all headers (`Access-Control-Allow-Headers: *`).
- Web clients always send this header on ClientHello — it's harmless on first connection (`Nothing` state) and enables re-handshake on reused connections (`HandshakeAccepted` state).
## 3. Detailed Technical Design
### 3.1 Server change: parameterize `processHello` (`src/Simplex/FileTransfer/Server.hs`)
The entire server change is parameterizing the existing `processHello` with `Maybe C.PrivateKeyX25519`. Zero new functions.
#### Current code (lines 165-191):
```haskell
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
Just (HandshakeSent pk) -> processClientHandshake pk
Just (HandshakeAccepted thParams) -> pure $ Just thParams
either sendError pure r
where
processHello = do
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
-- ...build and send ServerHandshake...
pure Nothing
```
#### After (diff is ~10 lines):
```haskell
xftpServerHandshakeV1 chain serverSignKey sessions
XFTPTransportRequest {thParams = thParams0@THandleParams {sessionId}, request, reqBody = HTTP2Body {bodyHead}, sendResponse, sniUsed, addCORS} = do
-- ^^^^^^^ bind request
s <- atomically $ TM.lookup sessionId sessions
r <- runExceptT $ case s of
Nothing -> processHello Nothing
Just (HandshakeSent pk) -> processClientHandshake pk
Just (HandshakeAccepted thParams)
| webHello -> processHello (serverPrivKey <$> thAuth thParams)
| otherwise -> pure $ Just thParams
either sendError pure r
where
webHello = sniUsed && any (\(t, _) -> tokenKey t == "xftp-web-hello") (fst $ H.requestHeaders request)
processHello pk_ = do
challenge_ <-
if
| B.null bodyHead -> pure Nothing
| sniUsed -> do
XFTPClientHello {webChallenge} <- liftHS $ smpDecode bodyHead
pure webChallenge
| otherwise -> throwE HANDSHAKE
(k, pk) <- maybe
(atomically . C.generateKeyPair =<< asks random)
(\pk -> pure (C.publicKey pk, pk))
pk_
atomically $ TM.insert sessionId (HandshakeSent pk) sessions
-- ...rest unchanged...
pure Nothing
```
#### What changes:
1. **Bind `request`** in the `XFTPTransportRequest` pattern (+1 field)
2. **Add `webHello`** binding in `where` clause (1 line) — checks header only when `sniUsed`
3. **Add `pk_` parameter** to `processHello` (change signature)
4. **Replace key generation** with `maybe` that generates fresh keys when `pk_ = Nothing`, or derives public from existing private when `pk_ = Just pk` (3 lines replace 1 line)
5. **Add guard** in `HandshakeAccepted` branch (2 lines replace 1 line)
6. **Call site** `Nothing -> processHello Nothing` (+1 word)
7. **One import** added: `Network.HPACK.Token (tokenKey)`
#### Imports to add:
```haskell
import Network.HPACK.Token (tokenKey)
```
`OverloadedStrings` (already enabled in Server.hs) provides the `IsString` instance for `CI ByteString`, so `tokenKey t == "xftp-web-hello"` works without importing `Data.CaseInsensitive`. Verified on Hackage: `requestHeaders :: Request -> HeaderTable`, `tokenKey :: Token -> CI ByteString`.
### 3.2 Re-handshake flow
When `webHello` is true in `HandshakeAccepted` state:
1. `processHello (serverPrivKey <$> thAuth thParams)` is called with `Just pk` (existing private key)
2. `(k, pk) <- pure (C.publicKey pk, pk)` — reuses same key pair, no generation
3. `TM.insert sessionId (HandshakeSent pk) sessions` — transitions state back to `HandshakeSent` with same `pk`
4. Server sends `ServerHandshake` response (same format as initial handshake)
5. Client sends `ClientHandshake` on next stream → enters `Just (HandshakeSent pk) -> processClientHandshake pk` → normal flow
6. `processClientHandshake` stores `HandshakeAccepted thParams` with same `serverPrivKey = pk`
### 3.3 Web client change (`xftp-web/src/client.ts`)
Add optional `headers?` parameter to `Transport.post()`, thread it through `fetch()` and `session.request()`, and pass `{"xftp-web-hello": "1"}` in the ClientHello call in `connectXFTP`.
### 3.4 What does NOT change
- **CORS**: Already has `Access-Control-Allow-Headers: *` (Server.hs:106).
- **Native Haskell client**: Uses `[]` headers. No header = existing behavior.
- **Protocol wire format**: ClientHello, ServerHandshake, ClientHandshake, commands — all unchanged.
- **`processRequest`**, **`processClientHandshake`**, **`sendError`**, **`encodeXftp`** — unchanged.
### 3.5 Haskell test (`tests/XFTPServerTests.hs`)
Add `testWebReHandshake` next to the existing `testWebHandshake` (line 504). It reuses the same SNI + HTTP/2 setup pattern, performs a full handshake, then sends a second ClientHello with the `xftp-web-hello` header on the same connection and verifies the server responds with a valid ServerHandshake (same `sessionId`), then completes the second handshake.
```haskell
-- Register in xftpServerTests (after line 86):
it "should re-handshake on same connection with xftp-web-hello header" testWebReHandshake
-- Test (after testWebHandshake):
testWebReHandshake :: Expectation
testWebReHandshake =
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
g <- C.newRandom
-- First handshake (same as testWebHandshake)
challenge1 <- atomically $ C.randomBytes 32 g
let helloReq1 = H2.requestBuilder "POST" "/" [] $ byteString (smpEncode (XFTPClientHello {webChallenge = Just challenge1}))
resp1 <- either (error . show) pure =<< HC.sendRequest h2 helloReq1 (Just 5000000)
shs1 <- either error pure $ smpDecode =<< C.unPad (bodyHead (HC.respBody resp1))
let XFTPServerHandshake {sessionId = sid1} = shs1
clientHsPadded <- either (error . show) pure $ C.pad (smpEncode (XFTPClientHandshake {xftpVersion = VersionXFTP 1, keyHash})) xftpBlockSize
resp1b <- either (error . show) pure =<< HC.sendRequest h2 (H2.requestBuilder "POST" "/" [] $ byteString clientHsPadded) (Just 5000000)
B.length (bodyHead (HC.respBody resp1b)) `shouldBe` 0
-- Second handshake on same connection with xftp-web-hello header
challenge2 <- atomically $ C.randomBytes 32 g
let helloReq2 = H2.requestBuilder "POST" "/" [("xftp-web-hello", "1")] $ byteString (smpEncode (XFTPClientHello {webChallenge = Just challenge2}))
resp2 <- either (error . show) pure =<< HC.sendRequest h2 helloReq2 (Just 5000000)
shs2 <- either error pure $ smpDecode =<< C.unPad (bodyHead (HC.respBody resp2))
let XFTPServerHandshake {sessionId = sid2} = shs2
sid2 `shouldBe` sid1 -- same TLS connection → same sessionId
-- Complete second handshake
resp2b <- either (error . show) pure =<< HC.sendRequest h2 (H2.requestBuilder "POST" "/" [] $ byteString clientHsPadded) (Just 5000000)
B.length (bodyHead (HC.respBody resp2b)) `shouldBe` 0
```
The only difference from `testWebHandshake`: the second `helloReq2` passes `[("xftp-web-hello", "1")]` instead of `[]`. The test verifies:
1. Server responds with `ServerHandshake` (not `ERR BLOCK`)
2. Same `sessionId` (same TLS connection)
3. Second `ClientHandshake` completes with empty ACK
## 4. Implementation Plan
### Step 1: Server — parameterize `processHello`
Apply the diff from Section 3.1 to `src/Simplex/FileTransfer/Server.hs`.
### Step 2: Test — add `testWebReHandshake`
Add the test from Section 3.5 to `tests/XFTPServerTests.hs`.
### Step 3: Client — add `xftp-web-hello` header
Add optional `headers?` to `Transport.post()`, pass `{"xftp-web-hello": "1"}` on ClientHello in `connectXFTP`.
### Step 4: Test
Run Haskell tests (`cabal test`) and E2E Playwright tests (`npx playwright test` in `xftp-web/`).
## 5. Race Condition Analysis
### Single-tab navigation (the common case)
1. Upload page completes, all fetch() requests finish
2. Browser navigates to download page (or reloads)
3. All upload-page fetches are aborted on page unload
4. Download page sends ClientHello with `xftp-web-hello` header
5. Server is in `HandshakeAccepted``processHello (Just pk)``HandshakeSent pk` (same key)
6. No concurrent streams → no race
**Safe.**
### Multi-tab (edge case)
Tab A (upload) and Tab B (download) share the same HTTP/2 connection.
1. Tab A has active command streams (e.g., FPUT upload in progress)
2. Tab B sends ClientHello with header
3. Server reads `HandshakeAccepted` atomically for both streams
4. Tab A's stream already has its `thParams` snapshot → proceeds with `processRequest` using old `thParams`
5. Tab B's stream triggers `processHello (Just pk)` → stores `HandshakeSent pk` (same pk!)
6. Tab A's in-progress FPUT continues with snapshot `thParams` → completes normally (same `serverPrivKey`)
7. Tab A's NEXT command reads `HandshakeSent` from TMap → enters `processClientHandshake` → fails (command body ≠ ClientHandshake format) → HANDSHAKE error
**Tab A's in-flight commands succeed. Tab A's subsequent commands fail with HANDSHAKE error.** This is the inherent multi-tab problem — unavoidable with per-connection session state and HTTP/2 connection sharing. The failure is clean (HANDSHAKE error, not silent corruption).
## 6. Security Considerations
- **No new key material**: Re-handshake reuses existing `serverPrivKey`. No opportunity for key confusion or downgrade.
- **Identity re-verification**: Server re-signs the web challenge with its long-term signing key. Client verifies identity again.
- **Header cannot escalate privileges**: The header only triggers re-handshake (which the server was already capable of doing on first connection). It does not bypass any authentication.
- **Timing**: Re-handshake takes the same code path as initial handshake, so timing side-channels are unchanged.
@@ -0,0 +1,948 @@
# XFTP Web Error Handling and Connection Resilience
## 1. Problem Statement
The XFTP web client is fundamentally fragile: any transient error (browser opening a new HTTP/2 connection, network hiccup, server restart) causes an unrecoverable failure with a cryptic error message. There is no retry logic, no fetch timeout, no error categorization, and the upload uses a single server instead of distributing chunks across preset servers. This makes the app frustrating — it works most of the time but fails unpredictably, which is worse than being completely broken.
### Confirmed root cause (from diagnostic logs)
When the browser opens a new HTTP/2 connection mid-operation, the new connection has a different TLS SessionId with no handshake state in the server's `TMap SessionId Handshake`. The server's `Nothing` branch in `xftpServerHandshakeV1` (Server.hs:169) unconditionally calls `processHello`, which tries to decode the command body as `XFTPClientHello`, fails, and sends a raw padded "HANDSHAKE" error string. The client cannot parse this as a proper transmission (first byte 'H' = 72 is read as batch count), producing `"expected batch count 1, got 72"`.
Server log confirming the SessionId change:
```
DEBUG dispatch: Accepted+command sessId="ZSo1GGETgIvjbB7CWHbvGPpbMjx_b2IlC1eTI6aKfqc="
...20 successful commands...
DEBUG dispatch: Nothing sessId="mJC7Sck9xxW5UsXoPGoUWduuHghSVgf6CnD6ZC6SBhU=" webHello=False
```
### Why re-handshake is required (cannot be made optional)
1. **SessionId is baked into signed command data.** `encodeAuthTransmission` signs `concat(encode(sessionId), tInner)` with Ed25519. Server's `tDecodeServer` (Protocol.hs:2242) verifies `sessId == sessionId`. New connection = different sessionId = signature mismatch.
2. **Server generates per-session DH keys.** `processHello` creates fresh X25519 keypair stored in `HandshakeSent`. For SMP browser clients (future), `verifyCmdAuth` (Protocol.hs:1322) requires the matching `serverPrivKey` from `thAuth`.
3. **This applies to both XFTP and future SMP browser clients** — the session management approach is the same.
### Why multiple preset servers cannot work
Upload (`agent.ts:105-157`) takes a single `server: XFTPServer` parameter and uploads ALL chunks to it. `web/upload.ts:133` calls `pickRandomServer(servers)` which selects ONE random server from all presets. The multi-server preset configuration is pointless — only one server is ever used per upload. The design intent (RFC section 11.6: "upload in parallel to 8 randomly selected servers") is not implemented. This must be fixed in Phase 2 (section 3.7).
## 2. Solution Summary
### Phase 1: Error handling and connection resilience
1. **Server: strict dispatch for allowed protocol combinations** — reject all invalid combinations
2. **Client: automatic retry with re-handshake** on SESSION/HANDSHAKE errors
3. **Client: fetch timeout** with configurable duration
4. **UI: error categorization and retry** — auto-retry temporary, human-readable permanent
5. **Client: connection state with Promise-based lock and per-server queues**`ServerConnection` with `client: Promise<XFTPClient>` + `queue: Promise<void>`
6. **Client: fix cache key** — include keyHash
### Phase 2: Multi-server upload (after Phase 1)
7. **Multi-server upload with server selection and failover** — distribute chunks across servers, retry FNEW on different server if one fails
## 3. Detailed Technical Design
### 3.1 Server: strict dispatch for allowed protocol combinations
**Principle:** Everything not explicitly done by existing Haskell/TS clients is prohibited. It is better to fail on impossible combinations than to be permissive — permissiveness complicates debugging and creates attack vectors via unexpected behaviors.
**Allowed behaviors by client type:**
| Client | SNI | webHello header | Hello body | When |
|--------|-----|----------------|------------|------|
| Haskell | No | No | Empty | New connection only |
| Web | Yes | Yes | Non-empty (XFTPClientHello) | New OR existing connection |
**Minimal surgical change.** The existing dispatch (Server.hs:169-189) already correctly handles `HandshakeSent` and `HandshakeAccepted` — their guards cover all valid and invalid combinations. The ONLY missing case is `Nothing` + web client sending a command on a stale session.
`processHello` (Server.hs:194-217) already internally routes: `B.null bodyHead` → Haskell hello, `sniUsed` → web hello decode, else → HANDSHAKE. For stale web sessions, it currently tries to decode a command body as `XFTPClientHello`, fails, and throws HANDSHAKE. The fix: detect this case BEFORE calling processHello and throw SESSION instead, so the client knows to re-handshake (not that its hello was malformed).
**Change: add one guard to `Nothing` branch, remove debug logging.**
```haskell
-- Before (1 line):
Nothing -> processHello Nothing
-- After (3 lines):
Nothing
| sniUsed && not webHello -> throwE SESSION -- web command on stale session
| otherwise -> processHello Nothing -- normal hello (web or Haskell)
```
`throwE SESSION` is caught by `either sendError pure r` (line 190). `sendError` pads `smpEncode SESSION` = `"SESSION"` (Transport.hs:298) to `xftpBlockSize`. The client's padded error detection (section 3.2) catches this as a retriable error and triggers re-handshake. SESSION is a valid `XFTPErrorType` constructor (Transport.hs:225) — no new helpers needed.
**All other branches remain unchanged.** `HandshakeSent` guards (`webHello` → processHello, `otherwise` → processClientHandshake with body size check inside) are correct. `HandshakeAccepted` guards (`webHello`, `webHandshake`, `otherwise` → command) are correct.
### 3.2 Client: automatic retry with re-handshake
**Location:** `sendXFTPCommand` in `client.ts`
**Design:** Retry loop inside `sendXFTPCommand`. Maximum 3 attempts. On retriable error, close old client, re-handshake, retry.
**Error classification:**
| Error | Type | Retriable? | Human-readable message |
|-------|------|-----------|----------------------|
| Padded "HANDSHAKE" | Temporary | Yes (auto) | "Connection interrupted, reconnecting..." |
| Padded "SESSION" | Temporary | Yes (auto) | "Session expired, reconnecting..." |
| `FRErr SESSION` | Temporary | Yes (auto) | "Session expired, reconnecting..." |
| `FRErr HANDSHAKE` | Temporary | Yes (auto) | "Connection interrupted, reconnecting..." |
| `fetch()` TypeError | Temporary | Yes (auto) | "Network error, retrying..." |
| AbortError (timeout) | Temporary | Yes (auto) | "Server timeout, retrying..." |
| `FRErr AUTH` | Permanent | No | "File is invalid, expired, or has been removed" |
| `FRErr NO_FILE` | Permanent | No | "File not found — it may have expired" |
| `FRErr SIZE` | Permanent | No | "File size exceeds server limit" |
| `FRErr QUOTA` | Permanent | No | "Server storage quota exceeded" |
| `FRErr BLOCKED` | Permanent | No | "File has been blocked by server" |
| `FRErr DIGEST` | Permanent | No | "File integrity check failed" |
| `FRErr INTERNAL` | Permanent | No | "Server internal error" |
| `CMD *` | Permanent | No | "Protocol error" |
**Retry behavior:**
- Auto-retry up to 3 times for temporary errors, transparent to user
- After 3 failures: show human-readable error with diagnosis, offer manual retry button
- Permanent errors: show human-readable error immediately, NO manual retry button (user can reload page)
**Implementation:**
```typescript
async function sendXFTPCommand(
agent: XFTPClientAgent,
server: XFTPServer,
privateKey: Uint8Array,
entityId: Uint8Array,
cmdBytes: Uint8Array,
chunkData?: Uint8Array,
maxRetries: number = 3
): Promise<{response: FileResponse, body: Uint8Array}> {
let clientP = getXFTPServerClient(agent, server)
let client = await clientP
for (let attempt = 1; attempt <= maxRetries; attempt++) {
try {
return await sendXFTPCommandOnce(client, privateKey, entityId, cmdBytes, chunkData)
} catch (e) {
if (!isRetriable(e)) {
// Permanent error (AUTH, NO_FILE, etc.) — connection is fine, don't touch it
throw categorizeError(e)
}
if (attempt === maxRetries) {
// Retriable error exhausted — connection is bad, remove stale promise
removeStaleConnection(agent, server, clientP)
throw categorizeError(e)
}
clientP = reconnectClient(agent, server)
client = await clientP
}
}
throw new Error("unreachable")
}
```
**`sendXFTPCommandOnce`** — renamed from current `sendXFTPCommand`. Two changes:
1. **Padded error detection** (before `decodeTransmission`):
```typescript
// After getting respBlock, before decodeTransmission:
const raw = blockUnpad(respBlock)
if (raw.length < 20) {
const text = new TextDecoder().decode(raw)
if (/^[A-Z_]+$/.test(text)) {
throw new XFTPRetriableError(text) // "HANDSHAKE" or "SESSION"
}
}
```
2. **FRErr classification** (replaces current unconditional throw):
```typescript
// After decodeResponse, instead of throw new Error("Server error: " + err.type):
if (response.type === "FRErr") {
const err = response.err
if (err.type === "SESSION" || err.type === "HANDSHAKE") {
throw new XFTPRetriableError(err.type)
}
throw new XFTPPermanentError(err.type, humanReadableMessage(err))
}
```
### 3.3 Client: fetch timeout
**Location:** `createBrowserTransport` and `createNodeTransport` in `client.ts`
**Design:** `AbortController` with configurable timeout on every `fetch()`.
```typescript
interface TransportConfig {
timeoutMs: number // default 30000, lower for tests
}
function createBrowserTransport(baseUrl: string, config: TransportConfig): Transport {
return {
async post(body: Uint8Array, headers?: Record<string, string>): Promise<Uint8Array> {
const controller = new AbortController()
const timer = setTimeout(() => controller.abort(), config.timeoutMs)
try {
const resp = await fetch(effectiveUrl, {
method: "POST", headers, body,
signal: controller.signal
})
if (!resp.ok) throw new Error(`Server request failed: ${resp.status}`)
return new Uint8Array(await resp.arrayBuffer())
} finally {
clearTimeout(timer)
}
},
close() {}
}
}
```
For Node.js transport, use `setTimeout` on the HTTP/2 request stream.
Default: 30s for production, 5s for tests. Threaded through `connectXFTP``createTransport`.
### 3.4 UI: error categorization and retry
**Behavior (Option D):**
- **Temporary errors:** Auto-retry loop (3 attempts). After 3 failures, show human-readable diagnosis with manual retry button. Diagnosis examples: "Server timeout — the server may be temporarily unavailable", "Connection interrupted — your network may be unstable".
- **Permanent errors:** Show human-readable error immediately, NO retry button. User can reload page if they want to retry. Examples: "File is invalid, expired, or has been removed" (AUTH), "File not found" (NO_FILE).
**Current UI retry buttons:**
- `upload.ts:73-75` — retry calls `startUpload(pendingFile)` from scratch
- `download.ts:60` — retry calls `startDownload()` from scratch
**Improvement:** Track uploaded/downloaded chunk indices. On manual retry, skip completed chunks:
```typescript
// Upload: track which chunks completed
const completedChunks: Set<number> = new Set()
for (let i = 0; i < specs.length; i++) {
if (completedChunks.has(i)) continue
// ... create + upload chunk
completedChunks.add(i)
}
// Download: already naturally resumable — each chunk is independent
```
### 3.5 Client: connection state with Promise-based lock and per-server queues
**Design:** Each server gets a `ServerConnection` record containing a `Promise<XFTPClient>` (the connection lock) and a `Promise<void>` (the sequential command queue). The `XFTPClientAgent` maps server keys to these records.
The promise IS the lock — every consumer awaits the same promise. When reconnect is needed, the promise is replaced atomically.
```typescript
interface ServerConnection {
client: Promise<XFTPClient> // resolves to connected client; replaced on reconnect
queue: Promise<void> // tail of sequential command chain
}
interface XFTPClientAgent {
connections: Map<string, ServerConnection>
}
function newXFTPAgent(): XFTPClientAgent {
return {connections: new Map()}
}
```
**Connection lifecycle — `getXFTPServerClient` and `reconnectClient`:**
```typescript
function getXFTPServerClient(agent: XFTPClientAgent, server: XFTPServer): Promise<XFTPClient> {
const key = formatXFTPServer(server)
let conn = agent.connections.get(key)
if (!conn) {
const p = connectXFTP(server)
conn = {client: p, queue: Promise.resolve()}
agent.connections.set(key, conn)
// On connection failure, remove from map so next call retries
p.catch(() => {
const cur = agent.connections.get(key)
if (cur && cur.client === p) agent.connections.delete(key)
})
}
return conn.client
}
function reconnectClient(agent: XFTPClientAgent, server: XFTPServer): Promise<XFTPClient> {
const key = formatXFTPServer(server)
const old = agent.connections.get(key)
// Close old client (fire-and-forget)
old?.client.then(c => c.transport.close(), () => {})
// Replace with new connection promise — all concurrent callers will await this
// Queue survives reconnect — pending operations stay ordered
const p = connectXFTP(server)
const conn: ServerConnection = {client: p, queue: old?.queue ?? Promise.resolve()}
agent.connections.set(key, conn)
p.catch(() => {
const cur = agent.connections.get(key)
if (cur && cur.client === p) agent.connections.delete(key)
})
return p
}
function closeXFTPServerClient(agent: XFTPClientAgent, server: XFTPServer): void {
const key = formatXFTPServer(server)
const conn = agent.connections.get(key)
if (conn) {
agent.connections.delete(key)
conn.client.then(c => c.transport.close(), () => {})
}
}
function closeXFTPAgent(agent: XFTPClientAgent): void {
for (const conn of agent.connections.values()) {
conn.client.then(c => c.transport.close(), () => {})
}
agent.connections.clear()
}
```
**Precise semantics:**
1. `getXFTPServerClient(agent, server)` — returns existing `conn.client` promise if present, otherwise creates a new `ServerConnection` with fresh connection and empty queue
2. When error detected, first caller calls `reconnectClient` which replaces `conn.client` with a new connection promise. The queue is preserved across reconnect.
3. All concurrent callers awaiting the OLD promise receive the error
4. They then call `getXFTPServerClient` which returns the NEW promise
5. If reconnection fails, auto-cleanup (`p.catch(() => delete)`) removes the entry so the next caller starts fresh
**Stale error cleanup rule:** When a caller exhausts retries for a retriable error, it removes the failed entry from the map (only if no concurrent caller has already replaced it via `reconnectClient`). This prevents the next caller from receiving a stale rejected promise. Permanent errors (AUTH, NO_FILE, etc.) do NOT remove the connection — the transport is fine, only the command failed.
```typescript
function removeStaleConnection(
agent: XFTPClientAgent, server: XFTPServer, failedP: Promise<XFTPClient>
): void {
const key = formatXFTPServer(server)
const conn = agent.connections.get(key)
// Only remove if current promise is the one that failed — not if already replaced by reconnect
if (conn && conn.client === failedP) {
agent.connections.delete(key)
failedP.then(c => c.transport.close(), () => {})
}
}
```
**Per-server sequential queue:** `queue` is a `Promise<void>` — the tail of the sequential operation chain. Each new operation `.then()`s onto it. It's `void` because callers hold their own typed promises; the queue only tracks completion order:
```typescript
async function enqueueCommand<T>(
agent: XFTPClientAgent,
server: XFTPServer,
fn: () => Promise<T> // no client param — fn uses command wrappers (agent+server)
): Promise<T> {
const key = formatXFTPServer(server)
// Ensure connection exists (with auto-cleanup on failure)
await getXFTPServerClient(agent, server)
const conn = agent.connections.get(key)! // guaranteed to exist after getXFTPServerClient
// Chain onto the queue — fn runs after previous operation completes
let resolve_: (v: T) => void, reject_: (e: any) => void
const result = new Promise<T>((res, rej) => { resolve_ = res; reject_ = rej })
conn.queue = conn.queue.then(
() => fn().then(resolve_!, reject_!),
() => fn().then(resolve_!, reject_!)
).then(() => {}, () => {}) // swallow errors in the chain
return result
}
```
Commands to the same server execute one at a time via the queue. Commands to different servers execute concurrently because each has its own queue. `enqueueCommand` provides sequencing; `sendXFTPCommand` (called inside `fn` via command wrappers) provides retry. They compose as: `enqueueCommand` sequences calls to wrappers that internally use `sendXFTPCommand`.
**Download change:** Group chunks by server, process each server's chunks sequentially, servers in parallel. Uses `for` loop for per-server sequencing (same pattern as Stage 2 upload). `enqueueCommand` is available for cases where different callers target the same server.
```typescript
const byServer = new Map<string, FileChunk[]>()
for (const chunk of resolvedFd.chunks) {
const srv = chunk.replicas[0]?.server ?? ""
if (!byServer.has(srv)) byServer.set(srv, [])
byServer.get(srv)!.push(chunk)
}
await Promise.all([...byServer.entries()].map(async ([srv, chunks]) => {
const server = parseXFTPServer(srv)
for (const chunk of chunks) {
const seed = decodePrivKeyEd25519(chunk.replicas[0].replicaKey)
const kp = ed25519KeyPairFromSeed(seed)
const raw = await downloadXFTPChunkRaw(agent, server, kp.privateKey, chunk.replicas[0].replicaId)
await onRawChunk({chunkNo: chunk.chunkNo, dhSecret: raw.dhSecret, nonce: raw.nonce, body: raw.body, digest: chunk.digest})
downloaded += chunk.chunkSize
onProgress?.(downloaded, resolvedFd.size)
}
}))
```
### 3.6 Fix cache key
**Bug:** `getXFTPServerClient` (client.ts:110) uses `"https://" + server.host + ":" + server.port` as cache key, ignoring `keyHash`. Two servers with same host:port but different keyHash share a cached connection, bypassing identity verification.
**Fix:** Use `formatXFTPServer(server)` as cache key (includes keyHash). Already available in `protocol/address.ts:52-54`.
```typescript
// Before:
const key = "https://" + server.host + ":" + server.port
// After:
const key = formatXFTPServer(server)
```
Note: With the redesign in 3.5, the cache key fix is inherent — the `connections` Map uses `formatXFTPServer(server)` everywhere.
### 3.7 Phase 2: Multi-server upload with server selection and failover
**Problem:** Current upload (`agent.ts:105-157`) takes a single `server: XFTPServer` and uploads ALL chunks to it. The 12 preset servers (6 SimpleX + 6 Flux) are pointless — only one is ever used.
**Design goal:** Distribute chunks across servers. Retry FNEW on a different server if one fails. Once working servers are found, prefer them (heuristic: server unlikely to fail mid-process, more likely to be broken initially due to maintenance/downtime).
**Reference implementation:** Haskell `Agent.hs:457-486` (`createChunk` / `createWithNextSrv`) + `Client.hs:2335-2385` (`getNextServer_` / `withNextSrv`).
#### Haskell algorithm summary
Two-stage architecture:
1. **Allocate stage (serial per file in Haskell):** For each chunk, call FNEW on a randomly-selected server. If FNEW fails, pick a different server and retry. Track tried hosts to avoid retrying the same server. After all chunks are assigned to servers, spawn one upload worker per server.
2. **Upload stage (parallel per server):** Each server worker uploads its assigned chunks sequentially (FPUT). On FPUT failure, retry on the same server with backoff (because the chunk replica already exists on that server). No server failover for FPUT.
Server selection constraints (hierarchical, `getNextServer_` Client.hs:2335-2350):
1. Prefer servers from unused operators (operator diversity)
2. Prefer servers with unused hosts (host diversity)
3. Random pick from the most-constrained candidate set
4. If all exhausted, reset tried set and start over
#### Web client adaptation
The web client doesn't have operators or a database. Simplified algorithm with two stages:
**Stage 1 — Allocate:** Create chunk records on servers (FNEW). Unlike Haskell which is serial here, web FNEW runs concurrently within a concurrency limit. FNEW is a small command — concurrent FNEW on the same connection is not a problem, and concurrent FNEW across servers improves upload startup time.
**Stage 2 — Upload:** Upload chunk data (FPUT). Parallel across servers, sequential per server (reuses per-server queues from 3.5). FPUT retries on the same server with backoff — no server rotation because the chunk replica already exists on that server. Stage 2 reads chunk data by offset (via `readChunk`), so `SentChunk` must be extended with `chunkOffset: number` (from ChunkSpec).
```typescript
interface UploadState {
untriedServers: XFTPServer[] // servers not yet attempted — initially all servers
workingServers: XFTPServer[] // servers that succeeded FNEW
}
const MAX_FNEW_ATTEMPTS = 5 // per chunk: try up to 5 different servers
async function uploadFile(
agent: XFTPClientAgent,
allServers: XFTPServer[],
encrypted: EncryptedFileMetadata,
options?: UploadOptions
): Promise<UploadResult> {
const state: UploadState = {untriedServers: [...allServers], workingServers: []}
const specs = prepareChunkSpecs(encrypted.chunkSizes)
const concurrency = options?.concurrency ?? 4
// Stage 1: Allocate — concurrent FNEW within concurrency limit
const sentChunks: SentChunk[] = new Array(specs.length)
const queue = specs.map((spec, i) => ({spec, chunkNo: i + 1, index: i}))
let idx = 0
async function allocateWorker() {
while (idx < queue.length) {
const item = queue[idx++]
const {server, chunk} = await createChunkWithFailover(
agent, allServers, state, concurrency, item.spec, item.chunkNo
)
sentChunks[item.index] = chunk
}
}
const allocateWorkers = Array.from(
{length: Math.min(concurrency, queue.length)},
() => allocateWorker()
)
await Promise.all(allocateWorkers)
// Stage 2: Upload — parallel across servers, sequential per server
// readChunk reads from the encrypted file by offset (same as Phase 1 uploadFile)
let uploaded = 0
const total = encrypted.chunkSizes.reduce((a, b) => a + b, 0)
const byServer = groupBy(sentChunks, c => formatXFTPServer(c.server))
await Promise.all([...byServer.entries()].map(async ([srvKey, chunks]) => {
for (const chunk of chunks) {
const chunkData = await readChunk(chunk.chunkOffset, chunk.chunkSize)
await uploadXFTPChunk(agent, chunk.server, chunk.senderKey, chunk.senderId, chunkData)
uploaded += chunk.chunkSize
options?.onProgress?.(uploaded, total)
}
}))
return buildDescriptions(encrypted, sentChunks)
}
```
**`createChunkWithFailover`** — server selection with per-chunk retry limit:
```typescript
async function createChunkWithFailover(
agent: XFTPClientAgent,
allServers: XFTPServer[],
state: UploadState,
concurrency: number,
spec: ChunkSpec,
chunkNo: number
): Promise<{server: XFTPServer, chunk: SentChunk}> {
const maxAttempts = Math.min(allServers.length, MAX_FNEW_ATTEMPTS)
for (let attempt = 0; attempt < maxAttempts; attempt++) {
const server = pickServer(allServers, state, concurrency)
try {
const chunk = await createAndPrepareChunk(agent, server, spec, chunkNo)
// Success — add to working set (if not already there)
if (!state.workingServers.some(s => formatXFTPServer(s) === formatXFTPServer(server))) {
state.workingServers.push(server)
}
return {server, chunk}
} catch (e) {
// Remove from working if it was there
state.workingServers = state.workingServers.filter(
s => formatXFTPServer(s) !== formatXFTPServer(server)
)
if (attempt === maxAttempts - 1) throw e
}
}
throw new Error("unreachable")
}
```
**`pickServer`** — two-list selection:
```typescript
function pickServer(
allServers: XFTPServer[],
state: UploadState,
concurrency: number
): XFTPServer {
// Once enough working servers found, only use those
if (state.workingServers.length >= concurrency) {
return randomPick(state.workingServers)
}
// Still exploring — pick from untried
if (state.untriedServers.length > 0) {
const idx = Math.floor(Math.random() * state.untriedServers.length)
return state.untriedServers.splice(idx, 1)[0] // remove from untried
}
// All tried — reset untried to non-working servers and retry
state.untriedServers = allServers.filter(
s => !state.workingServers.some(w => formatXFTPServer(w) === formatXFTPServer(s))
)
if (state.untriedServers.length > 0) {
const idx = Math.floor(Math.random() * state.untriedServers.length)
return state.untriedServers.splice(idx, 1)[0]
}
// Every server is working — pick any working
return randomPick(state.workingServers)
}
```
**Algorithm:** Two lists — `untriedServers` (initially all) and `workingServers` (initially empty). When `workingServers.length < concurrency`, pick from `untriedServers` (removing on pick). On FNEW success, add to `workingServers`. On FNEW failure, server is already removed from `untriedServers`; remove from `workingServers` if present. When `untriedServers` is empty, reset it to all non-working servers. Once `workingServers.length >= concurrency`, pick randomly only from `workingServers`.
**Termination condition:** Each chunk tries at most `min(serverCount, 5)` different servers. If all attempts fail, the chunk fails and the upload fails with the last error. Rationale: if 5 out of 12 servers are down, something systemic is wrong and continuing is unlikely to help. Timeouts count as failures — the timed-out server is removed from working and a different server is picked next.
**Key differences from Haskell:**
- No operator concept — just host diversity via random selection
- No database — state tracked in-memory during upload
- FNEW runs concurrently (Haskell is serial) — improves startup time
- FNEW is cheap and retried with server rotation; FPUT retries on same server
**Download changes (also Phase 2):** Default concurrency should be 4 (matching Haskell). Download already groups by server in 3.5. If `replicas[0]` download fails, try `replicas[1]`, `replicas[2]`, etc. (fallback across replicas).
## 4. Implementation Plan
### Phase 1: Error handling and connection resilience
Steps are ordered by dependency and should be implemented one by one.
#### Step 1: Fix cache key (3.6)
- Change cache key to `formatXFTPServer(server)` in `getXFTPServerClient` and `closeXFTPServerClient`
- Add import for `formatXFTPServer`
- Run existing tests to verify no regression
#### Step 2: Typed error detection for padded server errors (3.2 client-side)
- Add `XFTPRetriableError` class
- In `sendXFTPCommand`, detect padded error strings before `decodeTransmission`
- Classify `FRErr` responses as retriable or permanent with human-readable messages
- Run existing tests
#### Step 3: Fetch timeout (3.3)
- Add `TransportConfig` with `timeoutMs`
- Thread config through `createTransport``connectXFTP` → command wrappers
- Add `AbortController` to browser `fetch()` and `setTimeout` to Node.js HTTP/2
- Add vitest test: timeout triggers after configured duration
- Run existing tests
#### Step 4: Connection state with Promise-based lock and per-server queues (3.5)
- Introduce `ServerConnection` record: `{client: Promise<XFTPClient>, queue: Promise<void>}`
- Replace `XFTPClientAgent.clients: Map<string, XFTPClient>` with `connections: Map<string, ServerConnection>`
- Implement `reconnectClient` — replaces `conn.client` with new promise, preserves queue
- Implement `enqueueCommand` — chains operation onto server's queue
- Implement `removeStaleConnection` — removes entry only if current promise is the failed one
- Auto-cleanup: `p.catch(() => delete)` removes failed connections so next caller starts fresh
- Adapt `closeXFTPServerClient` and `closeXFTPAgent`
- Add vitest tests:
- Concurrent calls to same server produce single connection
- Failed promise is cleaned up, next caller gets fresh connection
#### Step 5: Automatic retry in sendXFTPCommand (3.2)
- Add retry loop with reconnect
- Change `sendXFTPCommand` signature: takes `agent + server` instead of `client`; export it (needed by tests and by agent.ts callers)
- Rename current `sendXFTPCommand``sendXFTPCommandOnce` (private); add padded error detection + FRErr classification (throw `XFTPRetriableError` for SESSION/HANDSHAKE, `XFTPPermanentError` for AUTH/NO_FILE/etc.)
- All command wrappers (`createXFTPChunk`, `uploadXFTPChunk`, etc.) pass agent + server
- Update agent.ts call sites: remove `getXFTPServerClient` calls before command wrappers (in `uploadFile`, `uploadRedirectDescription`, `downloadFileRaw`, `resolveRedirect`, `deleteFile`)
- Max 3 retries for retriable errors, immediate throw for permanent
- On retriable error: call `reconnectClient` and retry. On retriable error exhausted: call `removeStaleConnection` to clean up. On permanent error: throw immediately without touching connection
- Add vitest tests:
- Server started with delay → first attempt fails, retry succeeds
- 3 retries exhausted → error propagates with human-readable message
- Non-retriable error (AUTH) → no retry, immediate failure
#### Step 6: Server-side stale session handling (3.1)
- Add one guard to `Nothing` branch: `sniUsed && not webHello -> throwE SESSION`
- Remove debug `hPutStrLn stderr` lines (all 6 occurrences in dispatch)
- All other branches unchanged
- Run Haskell tests + Playwright tests
#### Step 7: Download with per-server grouping
- Modify `downloadFileRaw` to group chunks by server, sequential within each server (`for` loop), parallel across servers (`Promise.all`)
- Add vitest test: concurrent downloads from different servers run in parallel
#### Step 8: UI error improvements (3.4)
- Temporary errors: auto-retry loop (3 attempts), then show human-readable diagnosis + manual retry button
- Permanent errors: show human-readable error, NO retry button
- Manual retry resumes from last successful chunk (not full restart)
#### Step 9: Remove debug logging
- Remove all `console.log('[DEBUG ...]')` and `hPutStrLn stderr "DEBUG ..."` lines
- Keep `console.error('[XFTP] ...')` error logging
### Phase 2: Multi-server upload
Implement after Phase 1 is complete and tested.
#### Step 10: Multi-server upload with failover (3.7)
- Extend `SentChunk` with `chunkOffset: number` (from ChunkSpec) and `server: XFTPServer` (assigned during allocate) — Stage 2 reads data by offset and groups chunks by server
- Change `uploadFile` signature: takes `allServers: XFTPServer[]` instead of single `server`
- Implement `UploadState` with `untriedServers` and `workingServers`
- Implement `createChunkWithFailover` and `pickServer`: two-list selection (untried → working once enough found), max `min(serverCount, 5)` attempts per chunk
- Allocate stage: concurrent FNEW within concurrency limit (default 4)
- Upload stage: parallel across servers, sequential per server (reuse queue from Step 7)
- Update `web/upload.ts`: pass `getServers()` instead of `pickRandomServer(getServers())`
- Update description building: each chunk references its actual server
- Add vitest tests:
- File split across N servers (verify different servers in description)
- One server down → chunks redistributed to others
- All servers down → error after exhausting 5 attempts per chunk
#### Step 11: Download concurrency and replica fallback
- Change default download concurrency from 1 to 4
- If `replicas[0]` download fails, try `replicas[1]`, `replicas[2]`, etc.
- Uses per-server queues from Step 7
## 5. Testing Plan
### Principle
Prefer low-level vitest tests over Playwright E2E. Each new function gets one focused test. Pure functions tested without mocks; connection management tested with mock `connectXFTP`; server behavior tested with real server. Total: 13 tests across 4 files.
Tests A-C run in browser context (`@vitest/browser` with Chromium headless), configured in `vitest.config.ts`. Test D (integration) requires a separate Node.js vitest config since it uses `node:http2`. Existing `globalSetup.ts` provides a real XFTP server for integration tests.
### Test file A: `test/errors.test.ts` — pure, no server
Tests error classification and padded error detection (Steps 2, 5).
**T1. `isRetriable` classifies errors correctly**
```typescript
// Retriable:
expect(isRetriable(new XFTPRetriableError("SESSION"))).toBe(true)
expect(isRetriable(new XFTPRetriableError("HANDSHAKE"))).toBe(true)
expect(isRetriable(new TypeError("fetch failed"))).toBe(true) // network error
expect(isRetriable(Object.assign(new Error(), {name: "AbortError"}))).toBe(true) // timeout
// Not retriable:
expect(isRetriable(new XFTPPermanentError("AUTH", "..."))).toBe(false)
expect(isRetriable(new XFTPPermanentError("NO_FILE", "..."))).toBe(false)
expect(isRetriable(new XFTPPermanentError("INTERNAL", "..."))).toBe(false)
```
**T2. `categorizeError` produces human-readable messages**
```typescript
// categorizeError receives thrown errors (from sendXFTPCommandOnce or transport)
const e = categorizeError(new XFTPPermanentError("AUTH", "File is invalid, expired, or has been removed"))
expect(e.message).toContain("expired")
// Verify every permanent error type maps to a non-empty human-readable message
for (const errType of ["AUTH", "NO_FILE", "SIZE", "QUOTA", "BLOCKED", "DIGEST", "INTERNAL"]) {
expect(humanReadableMessage({type: errType}).length).toBeGreaterThan(0)
}
// Retriable errors also get human-readable messages after exhaustion
const re = categorizeError(new XFTPRetriableError("SESSION"))
expect(re.message).toContain("expired") // "Session expired, reconnecting..."
```
**T3. Padded error detection extracts error string from padded block**
```typescript
import {blockPad, blockUnpad} from '../src/protocol/transmission.js'
// Simulate server sending padded "SESSION"
const padded = blockPad(new TextEncoder().encode("SESSION"))
const raw = blockUnpad(padded)
expect(raw.length).toBeLessThan(20)
expect(new TextDecoder().decode(raw)).toBe("SESSION")
// Normal transmission block (batch count + large-encoded data) is NOT a short string
const sessionId = new Uint8Array(32) // dummy
const normalBlock = encodeTransmission(sessionId, new Uint8Array(0), new Uint8Array(0), encodePING())
const normalRaw = blockUnpad(normalBlock)
expect(normalRaw.length).toBeGreaterThan(20) // not mistaken for padded error
```
### Test file B: `test/connection.test.ts` — mock connectXFTP, no server
Tests connection management functions (Steps 4, 5). Uses `vi.mock` to replace `connectXFTP` with a controllable promise factory.
**T4. `getXFTPServerClient` coalesces concurrent calls**
```typescript
// Mock connectXFTP to return a deferred promise
const {promise, resolve} = promiseWithResolvers<XFTPClient>()
vi.mocked(connectXFTP).mockReturnValueOnce(promise)
const agent = newXFTPAgent()
const p1 = getXFTPServerClient(agent, server)
const p2 = getXFTPServerClient(agent, server)
expect(p1).toBe(p2) // same promise, single connection
resolve(mockClient)
expect(await p1).toBe(mockClient)
```
**T5. `getXFTPServerClient` auto-cleans failed connections**
```typescript
vi.mocked(connectXFTP).mockReturnValueOnce(Promise.reject(new Error("down")))
const agent = newXFTPAgent()
const p1 = getXFTPServerClient(agent, server)
await expect(p1).rejects.toThrow("down")
// After microtask, entry is removed
await new Promise(r => setTimeout(r, 0))
expect(agent.connections.has(formatXFTPServer(server))).toBe(false)
// Next call creates fresh connection
vi.mocked(connectXFTP).mockReturnValueOnce(Promise.resolve(mockClient))
const p2 = getXFTPServerClient(agent, server)
expect(p2).not.toBe(p1)
```
**T6. `removeStaleConnection` respects promise identity**
```typescript
const agent = newXFTPAgent()
const p1 = Promise.resolve(mockClient)
agent.connections.set(key, {client: p1, queue: Promise.resolve()})
// Replace with reconnect
const p2 = Promise.resolve(mockClient2)
agent.connections.set(key, {client: p2, queue: Promise.resolve()})
// removeStaleConnection with old promise does NOT remove new entry
removeStaleConnection(agent, server, p1)
expect(agent.connections.has(key)).toBe(true)
expect(agent.connections.get(key)!.client).toBe(p2)
// removeStaleConnection with current promise removes it
removeStaleConnection(agent, server, p2)
expect(agent.connections.has(key)).toBe(false)
```
**T7. `reconnectClient` replaces promise but preserves queue**
```typescript
const agent = newXFTPAgent()
const origQueue = Promise.resolve()
agent.connections.set(key, {client: Promise.resolve(mockClient), queue: origQueue})
vi.mocked(connectXFTP).mockReturnValueOnce(Promise.resolve(mockClient2))
reconnectClient(agent, server)
const conn = agent.connections.get(key)!
expect(await conn.client).toBe(mockClient2) // new client
expect(conn.queue).toBe(origQueue) // queue preserved
```
**T8. Retry loop: retriable error triggers reconnect, permanent error does not**
Mock approach: `vi.mock('../src/client.js')` to mock `connectXFTP` (exported). `reconnectClient` is not exported — its behavior is controlled indirectly via `connectXFTP` mock (it calls `connectXFTP` internally). Verify retry count via `connectXFTP` call count. Note: vitest module mocking may need adjustment depending on ESM transform behavior — if intra-module calls bypass the mock, extract `connectXFTP` to a separate module or use dependency injection for testing.
```typescript
// Script: first connectXFTP returns client whose post throws retriable,
// second connectXFTP (from reconnect) returns client whose post succeeds
vi.mocked(connectXFTP)
.mockResolvedValueOnce({
...mockClient,
transport: { post: async () => { throw new XFTPRetriableError("SESSION") }, close: () => {} }
})
.mockResolvedValueOnce({
...mockClient,
transport: { post: async () => okResponseBlock, close: () => {} }
})
const agent = newXFTPAgent()
const result = await sendXFTPCommand(agent, server, dummyKey, dummyId, encodePING())
expect(result.response.type).toBe("FROk")
expect(vi.mocked(connectXFTP)).toHaveBeenCalledTimes(2) // initial + 1 reconnect
// Reset — all 3 retries exhausted: connectXFTP called 3 times (initial + 2 reconnects)
vi.mocked(connectXFTP).mockClear()
vi.mocked(connectXFTP).mockResolvedValue({
...mockClient,
transport: { post: async () => { throw new XFTPRetriableError("SESSION") }, close: () => {} }
})
const agent2 = newXFTPAgent()
await expect(sendXFTPCommand(agent2, server, dummyKey, dummyId, encodePING()))
.rejects.toThrow(/reconnecting|expired/)
expect(vi.mocked(connectXFTP)).toHaveBeenCalledTimes(3) // initial + 2 reconnects
// Reset — permanent error: connectXFTP called once (initial only, no reconnect)
vi.mocked(connectXFTP).mockClear()
vi.mocked(connectXFTP).mockResolvedValue({
...mockClient,
transport: { post: async () => authErrorBlock, close: () => {} }
})
const agent3 = newXFTPAgent()
await expect(sendXFTPCommand(agent3, server, dummyKey, dummyId, encodePING()))
.rejects.toThrow(/expired/)
expect(vi.mocked(connectXFTP)).toHaveBeenCalledTimes(1) // initial only, no reconnect
```
### Test file C: `test/server-selection.test.ts` — pure, no server
Tests `pickServer` state machine (Step 10). Determinism: seed `Math.random` or test invariants not specific picks.
**T9. `pickServer` picks from untried when working < concurrency**
```typescript
const servers = [s1, s2, s3, s4, s5]
const state: UploadState = {untriedServers: [...servers], workingServers: []}
const picked = pickServer(servers, state, 4)
// picked is from untried, and was removed from untried
expect(state.untriedServers.length).toBe(4)
expect(state.untriedServers).not.toContainEqual(picked)
```
**T10. `pickServer` picks only from working when working >= concurrency**
```typescript
const state: UploadState = {
untriedServers: [s5], // still has untried
workingServers: [s1, s2, s3, s4]
}
const picked = pickServer(servers, state, 4)
// Must pick from working, NOT from untried
expect([s1, s2, s3, s4]).toContainEqual(picked)
expect(state.untriedServers.length).toBe(1) // untried unchanged
```
**T11. `pickServer` resets untried when exhausted**
```typescript
const state: UploadState = {
untriedServers: [], // all tried
workingServers: [s1, s2] // only 2 working, concurrency=4
}
const picked = pickServer(servers, state, 4)
// Should have reset untried to non-working servers and picked from them
expect([s3, s4, s5]).toContainEqual(picked)
expect(state.untriedServers.length).toBe(2) // 3 non-working minus 1 picked
```
### Test file D: `test/integration.test.ts` — real server, Node.js mode
Requires separate vitest config with `browser: {enabled: false}` since these tests use `node:http2` directly. Alternatively, add `test/vitest.node.config.ts` that includes only `test/integration.test.ts` and runs in Node.js.
**T12. Stale session returns padded SESSION error (requires Step 6)**
```typescript
import http2 from 'node:http2'
// Connect and handshake normally via the client
const client = await connectXFTP(server)
// Create a raw HTTP/2 session (new TLS SessionId, no handshake state on server)
const session = http2.connect(client.baseUrl, {rejectUnauthorized: false})
// Build a dummy command block using the old client's sessionId.
// Content doesn't matter — server detects stale session before parsing command.
const dummyKey = new Uint8Array(64) // Ed25519 private key (dummy)
const dummyId = new Uint8Array(24) // entity ID (dummy)
const cmdBlock = encodeAuthTransmission(client.sessionId, new Uint8Array(0), dummyId, encodePING(), dummyKey)
const resp = await new Promise<Uint8Array>((resolve, reject) => {
const req = session.request({":method": "POST", ":path": "/"})
const chunks: Buffer[] = []
req.on("data", (c: Buffer) => chunks.push(c))
req.on("end", () => resolve(new Uint8Array(Buffer.concat(chunks))))
req.on("error", reject)
req.end(Buffer.from(cmdBlock))
})
// Server should return padded "SESSION" (not crash, not "HANDSHAKE")
const raw = blockUnpad(resp.subarray(0, XFTP_BLOCK_SIZE))
expect(new TextDecoder().decode(raw)).toBe("SESSION")
session.close()
closeXFTP(client)
```
**T13. Fetch timeout fires within configured duration**
```typescript
// connectXFTP with 1ms timeout — handshake requires multiple round trips,
// so even on localhost it will exceed 1ms and trigger abort
await expect(
connectXFTP(server, {timeoutMs: 1})
).rejects.toThrow(/abort|timeout/i)
```
### What existing tests already cover (no new tests needed)
| Behavior | Covered by |
|----------|-----------|
| Cache key fix (Step 1) | Existing round-trip test — uses `formatXFTPServer` after refactor |
| Basic upload/download | 24 Playwright tests + 1 vitest browser test |
| File size limits, unicode filenames | Playwright edge case tests |
| Server startup/teardown | `globalSetup.ts` / `globalTeardown.ts` |
| Handshake + identity verification | `connectXFTP` in existing round-trip test |
### Test ordering
Tests must be added alongside their implementation step:
- **Step 2**: Add T1, T2, T3 (test/errors.test.ts)
- **Step 3**: Add T13 (test/integration.test.ts) — requires Node.js vitest config
- **Step 4**: Add T4, T5, T6, T7 (test/connection.test.ts)
- **Step 5**: Add T8 (test/connection.test.ts)
- **Step 6**: Add T12 (test/integration.test.ts) — requires server change + Node.js vitest config
- **Step 10**: Add T9, T10, T11 (test/server-selection.test.ts)
## 6. Context for Implementation Sessions
### Files to re-read on session start
**TypeScript (xftp-web/src/):**
- `client.ts``XFTPClient`, `XFTPClientAgent`, `getXFTPServerClient`, `closeXFTPServerClient`, `connectXFTP`, `sendXFTPCommand`, `createBrowserTransport`, `createNodeTransport`, all command wrappers
- `agent.ts``uploadFile`, `downloadFileRaw`, `downloadFile`, `resolveRedirect`, `encryptFileForUpload`
- `protocol/transmission.ts``encodeAuthTransmission`, `decodeTransmission`, `blockPad`, `blockUnpad`
- `protocol/commands.ts``XFTPErrorType`, `FileResponse`, `decodeResponse`, `decodeXFTPError`
- `protocol/handshake.ts``decodeServerHandshake` (padded error detection heuristic)
- `protocol/address.ts``XFTPServer`, `parseXFTPServer`, `formatXFTPServer`
- `web/upload.ts` — UI error handling, retry button
- `web/download.ts` — UI error handling, retry button
- `web/servers.ts``getServers`, `pickRandomServer`
**TypeScript (xftp-web/test/):**
- `browser.test.ts` — vitest Node.js test template (uses real Haskell server)
- `globalSetup.ts` — server startup, config generation, port file
- `page.spec.ts` — Playwright page tests
**Haskell (reference for multi-server):**
- `src/Simplex/FileTransfer/Agent.hs``createChunk` (lines 457-486, allocate stage), `runXFTPSndPrepareWorker` (lines 391-430, serial allocate in Haskell), `runXFTPSndWorker` (lines 494-548, per-server upload worker)
- `src/Simplex/Messaging/Agent/Client.hs``getNextServer_` (lines 2335-2350), `withNextSrv` (lines 2366-2385), `pickServer` (lines 2309-2314)
**Haskell (server):**
- `src/Simplex/FileTransfer/Server.hs``xftpServerHandshakeV1` (lines 165-244), `processRequest` (lines 403-435)
- `src/Simplex/Messaging/Protocol.hs``tDecodeServer` (lines 2239-2265) — sessionId verification at line 2242
### Key design constraints
1. `tDecodeServer` (Protocol.hs:2242) verifies `sessId == sessionId` — commands signed with old sessionId WILL fail on new connection
2. Server generates per-session DH key in `processHello` (Server.hs:207) — cannot be shared across sessions
3. `fetch()` provides zero control over HTTP/2 connection reuse — browser decides
4. `xftp-web-hello` header is only checked in dispatch (Server.hs:192), NOT inside `processHello`
5. Handshake-phase errors are raw padded strings; command-phase errors are proper ERR transmissions
6. Ed25519 signature verification (`TASignature` path, Protocol.hs:1314) does NOT use `thAuth` — but SMP will
7. Reconnect must re-handshake to get new sessionId AND new server DH key
8. The new `throwE SESSION` guard (Step 6) sends a raw padded "SESSION" string — no sessionId framing. Client detects this via padded error heuristic (section 3.2), not via sessionId mismatch
9. FNEW is cheap (creates chunk record on server) — retry with different server on failure
10. FPUT retries on same server (chunk replica already exists there) — close connection + backoff
## 7. Plan Maintenance
This plan must be updated as implementation proceeds:
- Mark completed steps with date
- Record any deviations from the plan with rationale
- Add new issues discovered during implementation
- Update file references if code moves
@@ -0,0 +1,327 @@
# CLI-Web Link Compatibility
## Problem
CLI and web clients are isolated: CLI outputs `.xftp` description files, web outputs
`https://host/#<encoded>` links. A file uploaded via one cannot be downloaded via the other.
## Solution Summary
Make CLI produce and consume web-compatible links so that:
- CLI `send` always outputs a web link (in addition to `.xftp` files)
- CLI `recv` accepts a web link URL as input (alternative to `.xftp` file path)
- Browser can download files uploaded by CLI and vice versa
The web page host is derived from the XFTP server address - the server that hosts the file
also hosts the download page. Making XFTP servers actually serve the web page is a separate
concern (not covered here), but the link format anticipates it.
The YAML file description format is already identical between CLI and web.
The only gap is the URI encoding layer: DEFLATE-raw compression + base64url + URL structure.
## Current State
### Web link format
```
https://<xftp-server-host>/#<base64url(deflateRaw(YAML))>
```
Encoding chain (agent.ts:64-68):
1. `encodeFileDescription(fd)` -> YAML string
2. `TextEncoder.encode(yaml)` -> bytes
3. `pako.deflateRaw(bytes)` -> compressed
4. `base64urlEncode(compressed)` -> URI fragment (no `#`)
For multi-chunk files exceeding ~400 chars in URI, a redirect description is uploaded:
the real file description is encrypted, uploaded as a separate XFTP file, and a smaller
"redirect" description (pointing to it) is put in the URI.
### CLI file format
```
xftp send FILE -> writes rcv1.xftp (raw YAML), snd.xftp.private
xftp recv FILE.xftp -> reads raw YAML from file
```
No URI support. No compression. No redirect descriptions.
### Existing Haskell `FileDescriptionURI`
`Description.hs:243-266` defines a `simplex:/file#/?desc=<URL-encoded raw YAML>` format.
This is the SimpleX Chat app format - NOT the web page format. It uses URL-encoded raw YAML
(no DEFLATE compression), and has a different URL structure.
## Detailed Tech Design
### 1. File Header (Filename) Compatibility
The filename is carried **inside the encrypted file data**, not in the file description YAML.
Both CLI and web use the same `FileHeader` structure and binary encoding - full interop.
#### FileHeader type
Haskell (`Types.hs:36-46`):
```haskell
data FileHeader = FileHeader { fileName :: Text, fileExtra :: Maybe Text }
instance Encoding FileHeader where
smpEncode FileHeader {fileName, fileExtra} = smpEncode (fileName, fileExtra)
```
TypeScript (`crypto/file.ts:11-24`):
```typescript
interface FileHeader { fileName: string; fileExtra: string | null }
function encodeFileHeader(hdr: FileHeader): Uint8Array {
return concatBytes(encodeString(hdr.fileName), encodeMaybe(encodeString, hdr.fileExtra))
}
```
Both produce identical binary: `[1-byte UTF-8 length][fileName bytes]['0']` (for null fileExtra).
Max filename: 255 UTF-8 bytes (1-byte length prefix).
#### Encrypted file structure
Both CLI and web produce the same encrypted stream:
```
XSalsa20-Poly1305 encrypted:
[8-byte Int64 fileSize] [FileHeader] [file content] ['#' padding]
+ [16-byte auth tag]
Where fileSize = len(FileHeader) + len(file content)
```
The 8-byte length prefix and padding are handled identically:
- Haskell: `Crypto.hs:43-56` (`encryptFile`) / `Crypto.hs:81-87` (`decryptFirstChunk`)
- TypeScript: `crypto/file.ts:51-70` (`encryptFile`) / `crypto/file.ts:81-94` (`decryptChunks`)
On decryption, `unPadLazy`/`splitLen` strips the 8-byte length prefix, then `parseFileHeader`
extracts the filename from the remaining decrypted bytes (up to 1024 bytes examined, both sides).
#### CLI upload: sets real filename (ok)
`Client/Main.hs:246-247,273`:
```haskell
let (_, fileNameStr) = splitFileName filePath
fileName = T.pack fileNameStr
...
fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing}
```
Extracts the actual filename from the path and embeds it in the encrypted header.
#### CLI download: uses filename from header (ok)
`Crypto.hs:62-66` (single chunk) / `Crypto.hs:72-74` (multi-chunk):
```haskell
(FileHeader {fileName}, rest) <- parseFileHeader decryptedContent
destFile <- withExceptT FTCEFileIOError $ getDestFile fileName
```
`Client/Main.hs:435-441` (`getFilePath`):
- If output dir specified: saves to `<dir>/<fileName>`
- If no dir: saves to `~/Downloads/<fileName>`
The filename from the decrypted header determines the output file name.
#### Web upload: sets real filename (ok)
`upload.ts:121` -> `agent.ts:86`:
```typescript
const fileHdr = encodeFileHeader({fileName, fileExtra: null})
```
Where `fileName` comes from `file.name` (browser File API).
#### Web download: uses filename from header (ok)
`download.ts:97,102`:
```typescript
const fileName = sanitizeFileName(header.fileName)
a.download = encodeURIComponent(fileName)
```
The web client additionally sanitizes the filename (strips path separators, control chars,
bidi overrides, limits to 255 chars).
#### Web redirect description: empty filename (correct)
`agent.ts:193`: `encryptFileForUpload(yamlBytes, "")` - redirect descriptions use empty filename
because they are internal artifacts, not user files. This is handled correctly on both sides:
the redirect content is decrypted and parsed as YAML, not saved as a file.
#### Cross-client interop: fully compatible (ok)
| Scenario | Filename flow | Status |
|----------|--------------|--------|
| CLI upload -> CLI download | `splitFileName` -> header -> `getDestFile` | Works |
| Web upload -> Web download | `File.name` -> header -> `sanitizeFileName` | Works |
| CLI upload -> Web download | `splitFileName` -> header -> `sanitizeFileName` | **Compatible** |
| Web upload -> CLI download | `File.name` -> header -> `getDestFile` | **Compatible** |
The binary encoding is identical (smpEncode). No changes needed for filename interop.
The CLI should consider adding filename sanitization similar to the web client for safety.
### 2. Web Link Host Derivation
The web page URL domain comes from the XFTP server address, not from a CLI flag:
- **Non-redirected description**: use the server host of the first chunk's first replica.
E.g., `xftp://abc=@xftp1.simplex.im` -> `https://xftp1.simplex.im/#<encoded>`
- **Redirected description**: use the server host of the redirect chunk (the outer description's
chunk that stores the encrypted inner description).
The server address format is `xftp://<keyhash>@<host>[,<host2>,...][:<port>]`.
The web link uses `https://<host>` (port 443 implied).
This means the CLI does not need a `--web-url` flag - the server address fully determines
the link. The XFTP server serving the web page is a separate deployment concern.
### 3. Web URI Encoding/Decoding in Haskell
Add two functions (new module or in `Description.hs`):
```haskell
-- Encode file description as web URI fragment (no leading #)
encodeWebURI :: FileDescription 'FRecipient -> ByteString
-- 1. Y.encode . encodeFileDescription -> YAML bytes
-- 2. deflateRaw (raw DEFLATE, no zlib/gzip header) via zlib package
-- 3. base64url encode (with padding, matching Data.ByteString.Base64.URL)
-- Decode web URI fragment (no leading #) to file description
decodeWebURI :: ByteString -> Either String (ValidFileDescription 'FRecipient)
-- 1. base64url decode
-- 2. inflateRaw (raw DEFLATE decompress)
-- 3. Y.decodeEither' -> YAMLFileDescription -> FileDescription
-- 4. validateFileDescription
-- Build full web link from file description
-- Extracts server host from first chunk replica (or redirect chunk)
fileWebLink :: FileDescription 'FRecipient -> (String, ByteString)
-- Returns (webHost, uriFragment)
-- Caller assembles: "https://" <> webHost <> "/#" <> uriFragment
```
**Dependency**: Add `zlib` to `simplexmq.cabal` (for raw DEFLATE).
The codebase already has `zstd` for message compression - `zlib` is standard and small.
The `zlib` Haskell package provides `Codec.Compression.Zlib.Raw` for raw DEFLATE
(no header/trailer), matching `pako.deflateRaw()` / `pako.inflateRaw()`.
### 4. Redirect Description Support
The CLI currently does NOT create redirect descriptions. For single-server single-recipient
uploads, most file descriptions fit in a reasonable URI even for multi-chunk files. But for
large files (many chunks x long server hostnames), the URI can exceed practical limits.
**Approach**: Match the web client threshold.
- After encoding the URI, if `length > 400` and chunks > 1, upload a redirect description.
- The redirect upload uses the same XFTP upload flow: encrypt YAML -> upload as file -> create
outer description pointing to it.
- This matches `agent.ts:152-155` exactly.
- The redirect chunk's server becomes the web link host.
For CLI download from a redirect URI, the existing `cliReceiveFile` needs extension:
- After decoding the file description, check `redirect` field.
- If present: download and decrypt the redirect chunks first to get the inner description,
then download the actual file using the inner description.
- The web client already does this (`resolveRedirect` in agent.ts:320-346).
### 5. CLI Command Changes
#### `xftp send` - always output web link
```
xftp send FILE [DIR] [-n COUNT] [-s SERVERS]
```
- Upload file as usual
- Generate web link: `https://<server-host>/#<encodeWebURI(rcvDescription)>`
- If URI exceeds threshold, upload redirect description first
- Print web link to stdout (in addition to `.xftp` file paths)
- Only generates link for the first recipient (web links are single-recipient)
**Output change**:
```
Sender file description: ./file.xftp/snd.xftp.private
Pass file descriptions to the recipient(s):
./file.xftp/rcv1.xftp
Web link:
https://xftp1.simplex.im/#eJy0VduO2zYQ...
```
#### `xftp recv` - accept URL as input
```
xftp recv <FILE.xftp | URL> [DIR]
```
- If input starts with `http://` or `https://`, extract hash fragment after `#`
- Decode: base64url -> inflateRaw -> YAML -> FileDescription
- Resolve redirect if present
- Download and decrypt as usual
The URL must be quoted on the command line (`"https://...#..."`) because `#` is a shell
comment character when unquoted.
Implementation: modify `receiveP` parser to accept URL, add `decodeWebURI` path in
`cliReceiveFile` alongside existing `getFileDescription'`.
### 6. YAML Format Compatibility
Already identical. The web `description.ts` explicitly matches Haskell `Data.Yaml` output:
- Same field names (alphabetical key order)
- Same base64url encoding for binary fields (with `=` padding)
- Same server replica colon-delimited format: `chunkNo:replicaId:replicaKey[:digest][:chunkSize]`
- Same size encoding (`kb`/`mb`/`gb` suffixes)
- Same redirect structure
**Verification**: The Playwright test suite already tests upload->download round-trips.
Adding a cross-client test (CLI upload -> web download, or web upload -> CLI download) would
validate interop end-to-end.
### 7. Server Compatibility
No server changes needed. Both clients use the same XFTP protocol (FGET, FPUT, FNEW, FACK, FDEL).
The web client adds `xftp-web-hello: 1` header for the hello handshake, but the actual file
operations are identical wire-format.
The only consideration: CLI uses native HTTP/2 (via `http2` Haskell package), web uses
browser `fetch()` API over HTTP/2. Both produce identical XFTP protocol frames.
**Note**: Making XFTP servers actually serve the web download page at `https://<host>/` is a
separate deployment/infrastructure task. This plan only establishes the link format convention
so that links are ready to work once servers serve the page.
## Implementation Plan
### Phase 1: Web URI codec in Haskell
1. Add `zlib` dependency to `simplexmq.cabal`
2. Add `encodeWebURI` / `decodeWebURI` / `fileWebLink` to `Simplex.FileTransfer.Description`
(or a new `Simplex.FileTransfer.Description.WebURI` module)
3. `fileWebLink` extracts host from first chunk's first replica server address
4. Add unit tests: encode a known FileDescription, verify output matches web client encoding
5. Add round-trip test: encode -> decode -> compare
### Phase 2: CLI `recv` accepts URL
1. Modify `ReceiveOptions` to accept `Either FilePath WebURL` for `fileDescription`
2. In `cliReceiveFile`: if URL, extract fragment after `#`, call `decodeWebURI`
3. Add redirect resolution: if `redirect /= Nothing`, download redirect chunks,
decrypt, parse inner description, then proceed with download
4. Test: upload via web page -> copy link -> `xftp recv <link>`
### Phase 3: CLI `send` outputs web link
1. After upload, call `fileWebLink` to get (host, fragment)
2. If fragment exceeds threshold, upload redirect description first, rebuild link
3. Print `https://<host>/#<fragment>` to stdout
4. Test: `xftp send FILE` -> open link in browser -> download
### Phase 4: Cross-client integration test
1. Add test: CLI send -> extract link from stdout -> Playwright browser download -> verify
2. Add test: Playwright browser upload -> extract link -> CLI recv -> verify
3. These can be shell-script or Haskell test-suite tests that spawn both clients
+7 -1
View File
@@ -1,7 +1,7 @@
cabal-version: 1.12
name: simplexmq
version: 6.5.0.3
version: 6.5.0.8
synopsis: SimpleXMQ message broker
description: This package includes <./docs/Simplex-Messaging-Server.html server>,
<./docs/Simplex-Messaging-Client.html client> and
@@ -167,6 +167,7 @@ library
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251009_queue_to_subscribe
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251010_client_notices
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251230_strict_tables
else
exposed-modules:
Simplex.Messaging.Agent.Store.SQLite
@@ -216,6 +217,8 @@ library
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251009_queue_to_subscribe
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251010_client_notices
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251230_strict_tables
Simplex.Messaging.Agent.Store.SQLite.Util
if flag(client_postgres) || flag(server_postgres)
exposed-modules:
Simplex.Messaging.Agent.Store.Postgres
@@ -344,6 +347,7 @@ library
, process ==1.6.*
, temporary ==1.3.*
, websockets ==0.12.*
, zlib >=0.6 && <0.8
if flag(client_postgres) || flag(server_postgres)
build-depends:
postgresql-libpq >=0.10.0.0
@@ -494,6 +498,7 @@ test-suite simplexmq-test
XFTPCLI
XFTPClient
XFTPServerTests
XFTPWebTests
Static
Static.Embedded
Paths_simplexmq
@@ -523,6 +528,7 @@ test-suite simplexmq-test
, async
, base64-bytestring
, bytestring
, case-insensitive ==1.2.*
, containers
, crypton
, crypton-x509
+5 -2
View File
@@ -47,7 +47,7 @@ import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Set as S
import Data.Text (Text)
import Data.Text (Text, pack)
import Data.Time.Clock (getCurrentTime)
import Data.Time.Format (defaultTimeLocale, formatTime)
import Simplex.FileTransfer.Chunks (toKB)
@@ -223,6 +223,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
agentXFTPDownloadChunk c userId digest replica chunkSpec
liftIO $ waitUntilForeground c
(entityId, complete, progress) <- withStore c $ \db -> runExceptT $ do
liftIO $ lockRcvFileForUpdate db rcvFileId
liftIO $ updateRcvFileChunkReceived db (rcvChunkReplicaId replica) rcvChunkId relChunkPath
RcvFile {size = FileSize currentSize, chunks, redirect} <- ExceptT $ getRcvFile db rcvFileId
let rcvd = receivedSize chunks
@@ -413,6 +414,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
withStore' c $ \db -> updateSndFileStatus db sndFileId SFSEncrypting
(digest, chunkSpecsDigests) <- encryptFileForUpload sndFile fsEncPath
withStore c $ \db -> do
lockSndFileForUpdate db sndFileId
updateSndFileEncrypted db sndFileId digest chunkSpecsDigests
getSndFile db sndFileId
else pure sndFile
@@ -431,7 +433,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
encryptFileForUpload :: SndFile -> FilePath -> AM (FileDigest, [(XFTPChunkSpec, FileDigest)])
encryptFileForUpload SndFile {key, nonce, srcFile, redirect} fsEncPath = do
let CryptoFile {filePath} = srcFile
fileName = takeFileName filePath
fileName = pack $ takeFileName filePath
fileSize <- liftIO $ fromInteger <$> CF.getFileContentsSize srcFile
when (fileSize > maxFileSizeHard) $ throwE $ FILE FT.SIZE
let fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing}
@@ -530,6 +532,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
agentXFTPUploadChunk c userId chunkDigest replica' chunkSpec'
liftIO $ waitUntilForeground c
sf@SndFile {sndFileEntityId, prefixPath, chunks} <- withStore c $ \db -> do
lockSndFileForUpdate db sndFileId
updateSndChunkReplicaStatus db sndChunkReplicaId SFRSUploaded
getSndFile db sndFileId
let uploaded = uploadedSize chunks
+9 -8
View File
@@ -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
+55 -13
View File
@@ -16,6 +16,9 @@ module Simplex.FileTransfer.Client.Main
xftpClientCLI,
cliSendFile,
cliSendFileOpts,
encodeWebURI,
decodeWebURI,
fileWebLink,
singleChunkSize,
prepareChunkSizes,
prepareChunkSpecs,
@@ -23,6 +26,7 @@ module Simplex.FileTransfer.Client.Main
)
where
import qualified Codec.Compression.Zlib.Raw as Z
import Control.Logger.Simple
import Control.Monad
import Control.Monad.Except
@@ -30,17 +34,19 @@ import Control.Monad.Trans.Except
import Crypto.Random (ChaChaDRG)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (first)
import qualified Data.ByteString.Base64.URL as U
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char (toLower)
import Data.Either (partitionEithers)
import Data.Int (Int64)
import Data.List (foldl', sortOn)
import Data.List (foldl', isPrefixOf, sortOn)
import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word32)
import GHC.Records (HasField (getField))
@@ -62,7 +68,7 @@ import qualified Simplex.Messaging.Crypto.Lazy as LC
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String (StrEncoding (..))
import Simplex.Messaging.Parsers (parseAll)
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), SenderId, SndPrivateAuthKey, XFTPServer, XFTPServerWithAuth)
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), SenderId, SndPrivateAuthKey, XFTPServer, XFTPServerWithAuth)
import Simplex.Messaging.Server.CLI (getCliCommand')
import Simplex.Messaging.Util (groupAllOn, ifM, tshow, whenM)
import System.Exit (exitFailure)
@@ -242,7 +248,8 @@ cliSendFile opts = cliSendFileOpts opts True $ printProgress "Uploaded"
cliSendFileOpts :: SendOptions -> Bool -> (Int64 -> Int64 -> IO ()) -> ExceptT CLIError IO ()
cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, retryCount, tempPath, verbose} printInfo notifyProgress = do
let (_, fileName) = splitFileName filePath
let (_, fileNameStr) = splitFileName filePath
fileName = T.pack fileNameStr
liftIO $ when printInfo $ printNoNewLine "Encrypting file..."
g <- liftIO C.newRandom
(encPath, fdRcv, fdSnd, chunkSpecs, encSize) <- encryptFileForUpload g fileName
@@ -254,14 +261,18 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
liftIO $ do
let fdRcvs = createRcvFileDescriptions fdRcv sentChunks
fdSnd' = createSndFileDescription fdSnd sentChunks
(fdRcvPaths, fdSndPath) <- writeFileDescriptions fileName fdRcvs fdSnd'
(fdRcvPaths, fdSndPath) <- writeFileDescriptions fileNameStr fdRcvs fdSnd'
when printInfo $ do
printNoNewLine "File uploaded!"
putStrLn $ "\nSender file description: " <> fdSndPath
putStrLn "Pass file descriptions to the recipient(s):"
forM_ fdRcvPaths putStrLn
when printInfo $ case fdRcvs of
rcvFd : _ -> forM_ (fileWebLink rcvFd) $ \(host, fragment) ->
putStrLn $ "\nWeb link:\nhttps://" <> B.unpack host <> "/#" <> B.unpack fragment
_ -> pure ()
where
encryptFileForUpload :: TVar ChaChaDRG -> String -> ExceptT CLIError IO (FilePath, FileDescription 'FRecipient, FileDescription 'FSender, [XFTPChunkSpec], Int64)
encryptFileForUpload :: TVar ChaChaDRG -> Text -> ExceptT CLIError IO (FilePath, FileDescription 'FRecipient, FileDescription 'FSender, [XFTPChunkSpec], Int64)
encryptFileForUpload g fileName = do
fileSize <- fromInteger <$> getFileSize filePath
when (fileSize > maxFileSize) $ throwE $ CLIError $ "Files bigger than " <> maxFileSizeStr <> " are not supported"
@@ -387,8 +398,17 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
cliReceiveFile :: ReceiveOptions -> ExceptT CLIError IO ()
cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath, verbose, yes} =
getFileDescription' fileDescription >>= receive
getInputFileDescription >>= receive
where
getInputFileDescription
| "http://" `isPrefixOf` fileDescription || "https://" `isPrefixOf` fileDescription = do
let fragment = B.pack $ drop 1 $ dropWhile (/= '#') fileDescription
when (B.null fragment) $ throwE $ CLIError "Invalid URL: no fragment"
vfd@(ValidFileDescription FileDescription {redirect = r}) <- either (throwE . CLIError . ("Invalid web link: " <>)) pure $ decodeWebURI fragment
case r of
Just _ -> throwE $ CLIError "Redirect descriptions are not yet supported via CLI. Download in browser instead."
Nothing -> pure vfd
| otherwise = getFileDescription' fileDescription
receive :: ValidFileDescription 'FRecipient -> ExceptT CLIError IO ()
receive (ValidFileDescription FileDescription {size, digest, key, nonce, chunks}) = do
encPath <- getEncPath tempPath "xftp"
@@ -430,13 +450,14 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
when verbose $ putStrLn ""
pure (chunkNo, chunkPath)
downloadFileChunk _ _ _ _ _ _ = throwE $ CLIError "chunk has no replicas"
getFilePath :: String -> ExceptT String IO FilePath
getFilePath name =
case filePath of
Just path ->
ifM (doesDirectoryExist path) (uniqueCombine path name) $
ifM (doesFileExist path) (throwE "File already exists") (pure path)
_ -> (`uniqueCombine` name) . (</> "Downloads") =<< getHomeDirectory
getFilePath :: Text -> ExceptT String IO FilePath
getFilePath name = case filePath of
Just path ->
ifM (doesDirectoryExist path) (uniqueCombine path name') $
ifM (doesFileExist path) (throwE "File already exists") (pure path)
_ -> (`uniqueCombine` name') . (</> "Downloads") =<< getHomeDirectory
where
name' = T.unpack name
acknowledgeFileChunk :: XFTPClientAgent -> FileChunk -> ExceptT CLIError IO ()
acknowledgeFileChunk a FileChunk {replicas = replica : _} = do
let FileChunkReplica {server, replicaId, replicaKey} = replica
@@ -552,3 +573,24 @@ cliRandomFile RandomFileOptions {filePath, fileSize = FileSize size} = do
B.hPut h bytes
when (sz > mb') $ saveRandomFile h (sz - mb')
mb' = mb 1
-- | Encode file description as web-compatible URI fragment.
-- Result is base64url(deflateRaw(YAML)), no leading '#'.
encodeWebURI :: FileDescription 'FRecipient -> B.ByteString
encodeWebURI fd = U.encode $ LB.toStrict $ Z.compress $ LB.fromStrict $ strEncode fd
-- | Decode web URI fragment to validated file description.
-- Input is base64url-encoded DEFLATE-compressed YAML, no leading '#'.
decodeWebURI :: B.ByteString -> Either String (ValidFileDescription 'FRecipient)
decodeWebURI fragment = do
compressed <- U.decode fragment
let yaml = LB.toStrict $ Z.decompress $ LB.fromStrict compressed
strDecode yaml >>= validateFileDescription
-- | Extract web link host and URI fragment from a file description.
-- Returns (hostname, uriFragment) for https://hostname/#uriFragment.
fileWebLink :: FileDescription 'FRecipient -> Maybe (B.ByteString, B.ByteString)
fileWebLink fd@FileDescription {chunks} = case chunks of
(FileChunk {replicas = FileChunkReplica {server = ProtocolServer {host}} : _} : _) ->
Just (strEncode (L.head host), encodeWebURI fd)
_ -> Nothing
+2 -1
View File
@@ -16,6 +16,7 @@ import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Int (Int64)
import Data.Text (Text)
import Simplex.FileTransfer.Types (FileHeader (..), authTagSize)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), FTCryptoError (..))
@@ -54,7 +55,7 @@ encryptFile srcFile fileHdr key nonce fileSize' encSize encFile = do
liftIO $ B.hPut w ch'
encryptChunks_ get w (sb', len - chSize)
decryptChunks :: Int64 -> [FilePath] -> C.SbKey -> C.CbNonce -> (String -> ExceptT String IO CryptoFile) -> ExceptT FTCryptoError IO CryptoFile
decryptChunks :: Int64 -> [FilePath] -> C.SbKey -> C.CbNonce -> (Text -> ExceptT String IO CryptoFile) -> ExceptT FTCryptoError IO CryptoFile
decryptChunks _ [] _ _ _ = throwE $ FTCEInvalidHeader "empty"
decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse chPaths of
[] -> do
+75 -31
View File
@@ -40,6 +40,7 @@ import GHC.IO.Handle (hSetNewlineMode)
import GHC.IORef (atomicSwapIORef)
import GHC.Stats (getRTSStats)
import qualified Network.HTTP.Types as N
import Network.HPACK.Token (tokenKey)
import qualified Network.HTTP2.Server as H
import Network.Socket
import Simplex.FileTransfer.Protocol
@@ -63,12 +64,12 @@ import Simplex.Messaging.Server.Stats
import Simplex.Messaging.SystemTime
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport (CertChainPubKey (..), SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams)
import Simplex.Messaging.Transport (CertChainPubKey (..), SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams, defaultSupportedParamsHTTPS)
import Simplex.Messaging.Transport.Buffer (trimCR)
import Simplex.Messaging.Transport.HTTP2
import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
import Simplex.Messaging.Transport.HTTP2.Server
import Simplex.Messaging.Transport.Server (runLocalTCPServer)
import Simplex.Messaging.Transport.HTTP2.Server (runHTTP2Server)
import Simplex.Messaging.Transport.Server (SNICredentialUsed, TransportServerConfig (..), runLocalTCPServer)
import Simplex.Messaging.Util
import Simplex.Messaging.Version
import System.Environment (lookupEnv)
@@ -89,9 +90,24 @@ data XFTPTransportRequest = XFTPTransportRequest
{ thParams :: THandleParamsXFTP 'TServer,
reqBody :: HTTP2Body,
request :: H.Request,
sendResponse :: H.Response -> IO ()
sendResponse :: H.Response -> IO (),
sniUsed :: SNICredentialUsed,
addCORS :: Bool
}
corsHeaders :: Bool -> [N.Header]
corsHeaders addCORS
| addCORS = [("Access-Control-Allow-Origin", "*"), ("Access-Control-Expose-Headers", "*")]
| otherwise = []
corsPreflightHeaders :: [N.Header]
corsPreflightHeaders =
[ ("Access-Control-Allow-Origin", "*"),
("Access-Control-Allow-Methods", "POST, OPTIONS"),
("Access-Control-Allow-Headers", "*"),
("Access-Control-Max-Age", "86400")
]
runXFTPServer :: XFTPServerConfig -> IO ()
runXFTPServer cfg = do
started <- newEmptyTMVarIO
@@ -120,45 +136,73 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
runServer :: M ()
runServer = do
srvCreds@(chain, pk) <- asks tlsServerCreds
httpCreds_ <- asks httpServerCreds
signKey <- liftIO $ case C.x509ToPrivate' pk of
Right pk' -> pure pk'
Left e -> putStrLn ("Server has no valid key: " <> show e) >> exitFailure
env <- ask
sessions <- liftIO TM.emptyIO
let cleanup sessionId = atomically $ TM.delete sessionId sessions
liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize defaultSupportedParams srvCreds transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
reqBody <- getHTTP2Body r xftpBlockSize
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}
flip runReaderT env $ case sessionALPN of
Nothing -> processRequest req0
Just alpn | alpn == xftpALPNv1 || alpn == httpALPN11 ->
xftpServerHandshakeV1 chain signKey sessions req0 >>= \case
Nothing -> pure () -- handshake response sent
Just thParams -> processRequest req0 {thParams} -- proceed with new version (XXX: may as well switch the request handler here)
_ -> liftIO . sendResponse $ H.responseNoBody N.ok200 [] -- shouldn't happen: means server picked handshake protocol it doesn't know about
srvParams = if isJust httpCreds_ then defaultSupportedParamsHTTPS else defaultSupportedParams
liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize srvParams srvCreds httpCreds_ transportConfig inactiveClientExpiration cleanup $ \sniUsed sessionId sessionALPN r sendResponse -> do
let addCORS' = sniUsed && addCORSHeaders transportConfig
if addCORS' && H.requestMethod r == Just "OPTIONS"
then sendResponse $ H.responseNoBody N.ok200 corsPreflightHeaders
else do
reqBody <- getHTTP2Body r xftpBlockSize
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, sniUsed, addCORS = addCORS'}
flip runReaderT env $ case sessionALPN of
Nothing -> processRequest req0
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} = do
xftpServerHandshakeV1 chain serverSignKey sessions XFTPTransportRequest {thParams = thParams0@THandleParams {sessionId}, request, reqBody = HTTP2Body {bodyHead}, sendResponse, sniUsed, addCORS} = do
s <- atomically $ TM.lookup sessionId sessions
r <- runExceptT $ case s of
Nothing -> processHello
Just (HandshakeSent pk) -> processClientHandshake pk
Just (HandshakeAccepted thParams) -> pure $ Just thParams
Nothing
| sniUsed && not webHello -> throwE SESSION
| otherwise -> processHello Nothing
Just (HandshakeSent pk)
| webHello -> processHello (Just pk)
| otherwise -> processClientHandshake pk
Just (HandshakeAccepted thParams)
| webHello -> processHello (serverPrivKey <$> thAuth thParams)
| webHandshake, Just auth <- thAuth thParams -> processClientHandshake (serverPrivKey auth)
| otherwise -> pure $ Just thParams
either sendError pure r
where
processHello = do
unless (B.null bodyHead) $ throwE HANDSHAKE
(k, pk) <- atomically . C.generateKeyPair =<< asks random
atomically $ TM.insert sessionId (HandshakeSent pk) sessions
webHello = sniUsed && any (\(t, _) -> tokenKey t == "xftp-web-hello") (fst $ H.requestHeaders request)
webHandshake = sniUsed && any (\(t, _) -> tokenKey t == "xftp-handshake") (fst $ H.requestHeaders request)
processHello pk_ = do
challenge_ <-
if
| B.null bodyHead -> pure Nothing
| sniUsed -> do
body <- liftHS $ C.unPad bodyHead
XFTPClientHello {webChallenge} <- liftHS $ first show (smpDecode body)
pure webChallenge
| otherwise -> throwE HANDSHAKE
rng <- asks random
k <- atomically $ TM.lookup sessionId sessions >>= \case
Just (HandshakeSent pk') -> pure $ C.publicKey pk'
_ -> do
kp <- maybe (C.generateKeyPair rng) (\p -> pure (C.publicKey p, p)) pk_
fst kp <$ TM.insert sessionId (HandshakeSent $ snd kp) 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
#endif
liftIO . sendResponse $ H.responseBuilder N.ok200 [] shs
liftIO . sendResponse $ H.responseBuilder N.ok200 (corsHeaders addCORS) shs
pure Nothing
processClientHandshake pk = do
unless (B.length bodyHead == xftpBlockSize) $ throwE HANDSHAKE
@@ -174,13 +218,13 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
#ifdef slow_servers
lift randomDelay
#endif
liftIO . sendResponse $ H.responseNoBody N.ok200 []
liftIO . sendResponse $ H.responseNoBody N.ok200 (corsHeaders addCORS)
pure Nothing
Nothing -> throwE HANDSHAKE
sendError :: XFTPErrorType -> M (Maybe (THandleParams XFTPVersion 'TServer))
sendError err = do
runExceptT (encodeXftp err) >>= \case
Right bs -> liftIO . sendResponse $ H.responseBuilder N.ok200 [] bs
Right bs -> liftIO . sendResponse $ H.responseBuilder N.ok200 (corsHeaders addCORS) bs
Left _ -> logError $ "Error encoding handshake error: " <> tshow err
pure Nothing
encodeXftp :: Encoding a => a -> ExceptT XFTPErrorType (ReaderT XFTPEnv IO) Builder
@@ -346,7 +390,7 @@ data ServerFile = ServerFile
}
processRequest :: XFTPTransportRequest -> M ()
processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHead}, sendResponse}
processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHead}, sendResponse, addCORS}
| B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", NoEntity, FRErr BLOCK) Nothing
| otherwise =
case xftpDecodeTServer thParams bodyHead of
@@ -365,7 +409,7 @@ processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHea
#ifdef slow_servers
randomDelay
#endif
liftIO $ sendResponse $ H.responseStreaming N.ok200 [] $ streamBody t_
liftIO $ sendResponse $ H.responseStreaming N.ok200 (corsHeaders addCORS) $ streamBody t_
where
streamBody t_ send done = do
case t_ of
+5 -2
View File
@@ -57,6 +57,7 @@ data XFTPServerConfig = XFTPServerConfig
-- | time after which inactive clients can be disconnected and check interval, seconds
inactiveClientExpiration :: Maybe ExpirationConfig,
xftpCredentials :: ServerCredentials,
httpCredentials :: Maybe ServerCredentials,
-- | XFTP client-server protocol version range
xftpServerVRange :: VersionRangeXFTP,
-- stats config - see SMP server config
@@ -84,6 +85,7 @@ data XFTPEnv = XFTPEnv
random :: TVar ChaChaDRG,
serverIdentity :: C.KeyHash,
tlsServerCreds :: T.Credential,
httpServerCreds :: Maybe T.Credential,
serverStats :: FileServerStats
}
@@ -98,7 +100,7 @@ defaultFileExpiration =
}
newXFTPServerEnv :: XFTPServerConfig -> IO XFTPEnv
newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, xftpCredentials} = do
newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, xftpCredentials, httpCredentials} = do
random <- C.newRandom
store <- newFileStore
storeLog <- mapM (`readWriteFileStore` store) storeLogFile
@@ -108,9 +110,10 @@ newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, xftpCrede
logNote $ "Total / available storage: " <> tshow quota <> " / " <> tshow (quota - used)
when (quota < used) $ logWarn "WARNING: storage quota is less than used storage, no files can be uploaded!"
tlsServerCreds <- loadServerCredential xftpCredentials
httpServerCreds <- mapM loadServerCredential httpCredentials
Fingerprint fp <- loadFingerprint xftpCredentials
serverStats <- newFileServerStats =<< getCurrentTime
pure XFTPEnv {config, store, storeLog, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats}
pure XFTPEnv {config, store, storeLog, random, tlsServerCreds, httpServerCreds, serverIdentity = C.KeyHash fp, serverStats}
countUsedStorage :: M.Map k FileRec -> Int64
countUsedStorage = M.foldl' (\acc FileRec {fileInfo = FileInfo {size}} -> acc + fromIntegral size) 0
+30 -9
View File
@@ -12,7 +12,7 @@ import Data.Either (fromRight)
import Data.Functor (($>))
import Data.Ini (lookupValue, readIniFile)
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Network.Socket (HostName)
@@ -21,7 +21,7 @@ import Simplex.FileTransfer.Chunks
import Simplex.FileTransfer.Description (FileSize (..))
import Simplex.FileTransfer.Server (runXFTPServer)
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration)
import Simplex.FileTransfer.Transport (supportedFileServerVRange, alpnSupportedXFTPhandshakes)
import Simplex.FileTransfer.Transport (alpnSupportedXFTPhandshakes, supportedFileServerVRange)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
@@ -29,7 +29,7 @@ import Simplex.Messaging.Server.CLI
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Transport.HTTP2 (httpALPN)
import Simplex.Messaging.Transport.Server (ServerCredentials (..), mkTransportServerConfig)
import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), mkTransportServerConfig)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.FilePath (combine)
@@ -124,6 +124,10 @@ xftpServerCLI cfgPath logPath = do
\disconnect: off\n"
<> ("# ttl: " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
<> ("# check_interval: " <> tshow (checkInterval defaultInactiveClientExpiration) <> "\n")
<> "\n\
\[WEB]\n\
\# cert: /etc/opt/simplex-xftp/web.crt\n\
\# key: /etc/opt/simplex-xftp/web.key\n"
runServer ini = do
hSetBuffering stdout LineBuffering
hSetBuffering stderr LineBuffering
@@ -155,6 +159,17 @@ xftpServerCLI cfgPath logPath = do
else "NOT allowed."
putStrLn $ "Listening on port " <> xftpPort <> "..."
httpCredentials_ =
eitherToMaybe $ do
cert <- T.unpack <$> lookupValue "WEB" "cert" ini
key <- T.unpack <$> lookupValue "WEB" "key" ini
pure
ServerCredentials
{ caCertificateFile = Nothing,
certificateFile = cert,
privateKeyFile = key
}
serverConfig =
XFTPServerConfig
{ xftpPort = T.unpack $ strictIni "TRANSPORT" "port" ini,
@@ -186,6 +201,7 @@ xftpServerCLI cfgPath logPath = do
privateKeyFile = c serverKeyFile,
certificateFile = c serverCrtFile
},
httpCredentials = httpCredentials_,
xftpServerVRange = supportedFileServerVRange,
logStatsInterval = logStats $> 86400, -- seconds
logStatsStartTime = 0, -- seconds from 00:00 UTC
@@ -194,10 +210,12 @@ xftpServerCLI cfgPath logPath = do
prometheusInterval = eitherToMaybe $ read . T.unpack <$> lookupValue "STORE_LOG" "prometheus_interval" ini,
prometheusMetricsFile = combine logPath "xftp-server-metrics.txt",
transportConfig =
mkTransportServerConfig
(fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini)
(Just $ alpnSupportedXFTPhandshakes <> httpALPN)
False,
let cfg =
mkTransportServerConfig
(fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini)
(Just $ alpnSupportedXFTPhandshakes <> httpALPN)
False
in cfg {addCORSHeaders = isJust httpCredentials_},
responseDelay = 0
}
@@ -229,11 +247,14 @@ cliCommandP cfgPath logPath iniFile =
initP :: Parser InitOptions
initP = do
enableStoreLog <-
flag' False
flag'
False
( long "disable-store-log"
<> help "Disable store log for persistence (enabled by default)"
)
<|> flag True True
<|> flag
True
True
( long "store-log"
<> short 'l'
<> help "Enable store log for persistence (DEPRECATED, enabled by default)"
+24 -7
View File
@@ -19,6 +19,7 @@ module Simplex.FileTransfer.Transport
-- xftpClientHandshake,
XFTPServerHandshake (..),
-- xftpServerHandshake,
XFTPClientHello (..),
THandleXFTP,
THandleParamsXFTP,
VersionXFTP,
@@ -35,6 +36,7 @@ module Simplex.FileTransfer.Transport
)
where
import Control.Applicative (optional)
import qualified Control.Exception as E
import Control.Logger.Simple
import Control.Monad
@@ -60,7 +62,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 +113,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 +134,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 +151,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 <- optional $ 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
+3 -2
View File
@@ -10,6 +10,7 @@ import qualified Data.Aeson.TH as J
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString)
import Data.Int (Int64)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word32)
@@ -33,8 +34,8 @@ authTagSize = fromIntegral C.authTagSize
-- fileExtra is added to allow header extension in future versions
data FileHeader = FileHeader
{ fileName :: String,
fileExtra :: Maybe String
{ fileName :: Text,
fileExtra :: Maybe Text
}
deriving (Eq, Show)
+223 -70
View File
@@ -49,6 +49,8 @@ module Simplex.Messaging.Agent
deleteUser,
connRequestPQSupport,
createConnectionAsync,
setConnShortLinkAsync,
getConnShortLinkAsync,
joinConnectionAsync,
allowConnectionAsync,
acceptContactAsync,
@@ -57,6 +59,8 @@ module Simplex.Messaging.Agent
deleteConnectionAsync,
deleteConnectionsAsync,
createConnection,
prepareConnectionLink,
createConnectionForLink,
setConnShortLink,
deleteConnShortLink,
getConnShortLink,
@@ -197,8 +201,8 @@ import Simplex.Messaging.Client (NetworkRequestMode (..), SMPClientError, Server
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs)
import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
import qualified Simplex.Messaging.Crypto.ShortLink as SL
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import qualified Simplex.Messaging.Crypto.ShortLink as SL
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP)
@@ -345,9 +349,20 @@ createConnectionAsync :: ConnectionModeI c => AgentClient -> UserId -> ACorrId -
createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAsync c userId aCorrId enableNtfs
{-# INLINE createConnectionAsync #-}
-- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id
joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
joinConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId enableNtfs
-- | Create or update user's contact connection short link (LSET command) asynchronously, no synchronous response
setConnShortLinkAsync :: AgentClient -> ACorrId -> ConnId -> UserConnLinkData 'CMContact -> Maybe CRClientData -> AE ()
setConnShortLinkAsync c = withAgentEnv c .:: setConnShortLinkAsync' c
{-# INLINE setConnShortLinkAsync #-}
-- | Get and verify data from short link (LGET/LKEY command) asynchronously, synchronous response is new connection id
getConnShortLinkAsync :: AgentClient -> UserId -> ACorrId -> ConnShortLink 'CMContact -> AE ConnId
getConnShortLinkAsync c = withAgentEnv c .:. getConnShortLinkAsync' c
{-# INLINE getConnShortLinkAsync #-}
-- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id.
-- If connId is provided (for contact URIs), it updates the existing connection record created by getConnShortLinkAsync.
joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
joinConnectionAsync c userId aCorrId connId_ enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId connId_ enableNtfs
{-# INLINE joinConnectionAsync #-}
-- | Allow connection to continue after CONF notification (LET command), no synchronous response
@@ -385,6 +400,19 @@ createConnection :: ConnectionModeI c => AgentClient -> NetworkRequestMode -> Us
createConnection c nm userId enableNtfs checkNotices = withAgentEnv c .::. newConn c nm userId enableNtfs checkNotices
{-# INLINE createConnection #-}
-- | Prepare connection link for contact mode (no network call).
-- Returns root key pair (for signing OwnerAuth), the created link, and internal params.
-- The link address is fully determined at this point.
prepareConnectionLink :: AgentClient -> UserId -> Maybe ByteString -> Bool -> Maybe CRClientData -> AE (C.KeyPairEd25519, CreatedConnLink 'CMContact, PreparedLinkParams)
prepareConnectionLink c userId linkEntityId checkNotices = withAgentEnv c . prepareConnectionLink' c userId linkEntityId checkNotices
{-# INLINE prepareConnectionLink #-}
-- | Create connection for prepared link (single network call).
-- Validates that server response matches the prepared link.
createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> SubscriptionMode -> AE ConnId
createConnectionForLink c nm userId enableNtfs = withAgentEnv c .::. createConnectionForLink' c nm userId enableNtfs
{-# INLINE createConnectionForLink #-}
-- | Create or update user's contact connection short link
setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c)
setConnShortLink c = withAgentEnv c .::. setConnShortLink' c
@@ -395,7 +423,7 @@ deleteConnShortLink c = withAgentEnv c .:. deleteConnShortLink' c
{-# INLINE deleteConnShortLink #-}
-- | Get and verify data from short link. For 1-time invitations it preserves the key to allow retries
getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c)
getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c)
getConnShortLink c = withAgentEnv c .:. getConnShortLink' c
{-# INLINE getConnShortLink #-}
@@ -778,8 +806,9 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do
-- TODO [short links] TBC, but probably we will need async join for contact addresses as the contact will be created after user confirming the connection,
-- and join should retry, the same as 1-time invitation joins.
joinConnAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
joinConnAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
joinConnAsync c userId corrId connId_ enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
when (isJust connId_) $ throwE $ CMD PROHIBITED "joinConnAsync: connId not allowed for invitation URI"
withInvLock c (strEncode cReqUri) "joinConnAsync" $ do
lift (compatibleInvitationUri cReqUri) >>= \case
Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
@@ -790,8 +819,22 @@ joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup
enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
pure connId
Nothing -> throwE $ AGENT A_VERSION
joinConnAsync _c _userId _corrId _enableNtfs (CRContactUri _) _subMode _cInfo _pqEncryption =
throwE $ CMD PROHIBITED "joinConnAsync"
joinConnAsync c userId corrId connId_ enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode = do
lift (compatibleContactUri cReqUri) >>= \case
Just (_, Compatible connAgentVersion) -> do
let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing
connId <- case connId_ of
Just cId -> do
-- update connection record created by getConnShortLinkAsync
withStore' c $ \db -> updateNewConnJoin db cId connAgentVersion pqSupport enableNtfs
pure cId
Nothing -> do
g <- asks random
let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
withStore c $ \db -> createNewConn db g cData SCMInvitation
enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
pure connId
Nothing -> throwE $ AGENT A_VERSION
allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
allowConnectionAsync' c corrId connId confId ownConnInfo =
@@ -810,7 +853,7 @@ acceptContactAsync' :: AgentClient -> UserId -> ACorrId -> Bool -> InvitationId
acceptContactAsync' c userId corrId enableNtfs invId ownConnInfo pqSupport subMode = do
Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId
withStore' c $ \db -> acceptInvitation db invId ownConnInfo
joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do
joinConnAsync c userId corrId Nothing enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do
withStore' c (`unacceptInvitation` invId)
throwE err
@@ -870,8 +913,69 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey
srv <- getSMPServer c userId
when (checkNotices && connMode cMode == CMContact) $ checkClientNotices c srv
connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys)
(connId,) <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv
`catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
(connId,)
<$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv
`catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
-- | Prepare connection link for contact mode (no network, no database).
-- Generates all cryptographic material and returns the link that will be created.
prepareConnectionLink' :: AgentClient -> UserId -> Maybe ByteString -> Bool -> Maybe CRClientData -> AM (C.KeyPairEd25519, CreatedConnLink 'CMContact, PreparedLinkParams)
prepareConnectionLink' c userId linkEntityId checkNotices clientData = do
g <- asks random
plpSrvWithAuth@(ProtoServerWithAuth srv _) <- getSMPServer c userId
when checkNotices $ checkClientNotices c plpSrvWithAuth
AgentConfig {smpClientVRange, smpAgentVRange} <- asks config
plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
sigKeys@(_, plpRootPrivKey) <- atomically $ C.generateKeyPair g
plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g
let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId
qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just QMContact)
connReq = CRContactUri $ ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData
(plpLinkKey, plpSignedFixedData) = SL.encodeSignFixedData sigKeys smpAgentVRange connReq linkEntityId
ccLink = CCLink connReq $ Just $ CSLContact SLSServer CCTContact srv plpLinkKey
params = PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth}
pure (sigKeys, ccLink, params)
-- | Create connection for prepared link (single network call).
createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> SubscriptionMode -> AM ConnId
createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} userLinkData pqInitKeys subMode = do
g <- asks random
AgentConfig {smpAgentVRange} <- asks config
case pqInitKeys of
CR.IKUsePQ -> throwE $ CMD PROHIBITED "createConnectionForLink"
_ -> pure ()
connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption pqInitKeys)
let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq
md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData
linkData = (plpSignedFixedData, md)
qd <- encryptContactLinkData g plpRootPrivKey plpLinkKey sndId linkData
(_, qUri) <-
createRcvQueue c nm userId connId plpSrvWithAuth enableNtfs subMode (Just plpNonce) qd plpQueueE2EKeys
`catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
let SMPQueueUri _ SMPQueueAddress {senderId = actualSndId} = qUri
unless (actualSndId == sndId) $ throwE $ INTERNAL "createConnectionForLink: sender ID mismatch"
pure connId
-- | Encrypt signed link data for contact mode.
encryptContactLinkData :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> LinkKey -> SMP.SenderId -> (ByteString, ByteString) -> AM ClntQueueReqData
encryptContactLinkData g privSigKey linkKey sndId linkData = do
let (linkId, k) = SL.contactShortLinkKdf linkKey
srvData <- liftError id $ SL.encryptLinkData g k linkData
pure $ CQRContact $ Just CQRData {linkKey, privSigKey, srvReq = (linkId, (sndId, srvData))}
-- | Shared helper: create receive queue and set up subscriptions.
createRcvQueue :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> Bool -> SubscriptionMode -> Maybe C.CbNonce -> ClntQueueReqData -> C.KeyPairX25519 -> AM (RcvQueue, SMPQueueUri)
createRcvQueue c nm userId connId srvWithAuth@(ProtoServerWithAuth srv _) enableNtfs subMode nonce_ qd e2eKeys = do
AgentConfig {smpClientVRange = vr} <- asks config
ntfServer_ <- if enableNtfs then newQueueNtfServer else pure Nothing
(rq, qUri, tSess, sessId) <-
newRcvQueue_ c nm userId connId srvWithAuth vr qd (isJust ntfServer_) subMode nonce_ e2eKeys
`catchAllErrors` \e -> liftIO (print e) >> throwE e
atomically $ incSMPServerStat c userId srv connCreated
rq' <- withStore c $ \db -> updateNewConnRcv db connId rq subMode
lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
mapM_ (newQueueNtfSubscription c rq') ntfServer_
pure (rq', qUri)
checkClientNotices :: AgentClient -> SMPServerWithAuth -> AM ()
checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAuth srv@(ProtocolServer {host}) _) = do
@@ -886,6 +990,42 @@ checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAu
when (maybe True (ts <) expires_) $
throwError NOTICE {server = safeDecodeUtf8 $ strEncode $ L.head host, preset = isNothing srvKey, expiresAt = roundedToUTCTime <$> expires_}
setConnShortLinkAsync' :: AgentClient -> ACorrId -> ConnId -> UserConnLinkData 'CMContact -> Maybe CRClientData -> AM ()
setConnShortLinkAsync' c corrId connId userLinkData clientData =
withConnLock c connId "setConnShortLinkAsync" $ do
SomeConn _ conn <- withStore c (`getConn` connId)
srv <- case (conn, userLinkData) of
(ContactConnection _ RcvQueue {server, shortLink}, UserContactLinkData d) -> do
liftEitherWith (CMD PROHIBITED . ("setConnShortLinkAsync: " <>)) $ validateOwners shortLink d
pure server
_ -> throwE $ CMD PROHIBITED "setConnShortLinkAsync: invalid connection or mode"
enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET userLinkData clientData
getConnShortLinkAsync' :: AgentClient -> UserId -> ACorrId -> ConnShortLink 'CMContact -> AM ConnId
getConnShortLinkAsync' c userId corrId shortLink@(CSLContact _ _ srv _) = do
g <- asks random
connId <- withStore c $ \db -> do
-- server is created so the command is processed in server queue,
-- not blocking other "no server" commands
void $ createServer db srv
prepareNewConn db g
enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LGET shortLink
pure connId
where
prepareNewConn db g = do
let cData =
ConnData
{ userId,
connId = "",
connAgentVersion = currentSMPAgentVersion,
enableNtfs = False,
lastExternalSndId = 0,
deleted = False,
ratchetSyncState = RSOk,
pqSupport = PQSupportOff
}
createNewConn db g cData SCMInvitation
setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM (ConnShortLink c)
setConnShortLink' c nm connId cMode userLinkData clientData =
withConnLock c connId "setConnShortLink" $ do
@@ -898,7 +1038,8 @@ setConnShortLink' c nm connId cMode userLinkData clientData =
pure sl
where
prepareContactLinkData :: RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData)
prepareContactLinkData rq@RcvQueue {shortLink} ud = do
prepareContactLinkData rq@RcvQueue {shortLink} ud@(UserContactLinkData d') = do
liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink d'
g <- asks random
AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
let cslContact = CSLContact SLSServer CCTContact (qServer rq)
@@ -912,10 +1053,10 @@ setConnShortLink' c nm connId cMode userLinkData clientData =
sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact}
connReq = CRContactUri $ ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq ud
(linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing ud
(linkId, k) = SL.contactShortLinkKdf linkKey
srvData <- liftError id $ SL.encryptLinkData g k linkData
let slCreds = ShortLinkCreds linkId linkKey privSigKey (fst srvData)
let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing (fst srvData)
withStore' c $ \db -> updateShortLinkCreds db rq slCreds
pure (rq, linkId, cslContact linkKey, srvData)
prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
@@ -939,7 +1080,7 @@ deleteConnShortLink' c nm connId cMode =
_ -> throwE $ CMD PROHIBITED "deleteConnShortLink: not contact address"
-- TODO [short links] remove 1-time invitation data and link ID from the server after the message is sent.
getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (ConnectionRequestUri c, ConnLinkData c)
getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (FixedLinkData c, ConnLinkData c)
getConnShortLink' c nm userId = \case
CSLInvitation _ srv linkId linkKey -> do
g <- asks random
@@ -960,18 +1101,19 @@ getConnShortLink' c nm userId = \case
ld <- getQueueLink c nm userId srv linkId
decryptData srv linkKey k ld
where
decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (ConnectionRequestUri c, ConnLinkData c)
decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (FixedLinkData c, ConnLinkData c)
decryptData srv linkKey k (sndId, d) = do
r@(cReq, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d
let (srv', sndId') = qAddress (connReqQueue cReq)
unless (srv `sameSrvHost` srv' && sndId == sndId') $
throwE $ AGENT $ A_LINK "different address"
pure $ if srv' == srv then r else (updateConnReqServer srv cReq, clData)
r@(fd, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d
let (srv', sndId') = qAddress (connReqQueue $ linkConnReq fd)
unless (srv `sameSrvHost` srv' && sndId == sndId') $ throwE $ AGENT $ A_LINK "different address"
pure $ if srv' == srv then r else (updateConnReqServer srv fd, clData)
sameSrvHost ProtocolServer {host = h :| _} ProtocolServer {host = hs} = h `elem` hs
updateConnReqServer :: SMPServer -> ConnectionRequestUri c -> ConnectionRequestUri c
updateConnReqServer srv = \case
CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams
CRContactUri crData -> CRContactUri $ updateQueues crData
updateConnReqServer :: SMPServer -> FixedLinkData c -> FixedLinkData c
updateConnReqServer srv fd =
let connReq' = case linkConnReq fd of
CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams
CRContactUri crData -> CRContactUri $ updateQueues crData
in fd {linkConnReq = connReq'}
where
updateQueues crData@(ConnReqUriData {crSmpQueues = SMPQueueUri vr addr :| qs}) =
crData {crSmpQueues = SMPQueueUri vr addr {smpServer = srv} :| qs}
@@ -998,25 +1140,15 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
case userLinkData_ of
Just d -> do
(nonce, qUri, cReq, qd) <- prepareLinkData d $ fst e2eKeys
(rq, qUri') <- createRcvQueue (Just nonce) qd e2eKeys
(rq, qUri') <- createRcvQueue c nm userId connId srvWithAuth enableNtfs subMode (Just nonce) qd e2eKeys
ccLink <- connReqWithShortLink qUri cReq qUri' (shortLink rq)
pure (ccLink, clientServiceId rq)
Nothing -> do
let qd = case cMode of SCMContact -> CQRContact Nothing; SCMInvitation -> CQRMessaging Nothing
(rq, qUri) <- createRcvQueue Nothing qd e2eKeys
(rq, qUri) <- createRcvQueue c nm userId connId srvWithAuth enableNtfs subMode Nothing qd e2eKeys
cReq <- createConnReq qUri
pure (CCLink cReq Nothing, clientServiceId rq)
where
createRcvQueue :: Maybe C.CbNonce -> ClntQueueReqData -> C.KeyPairX25519 -> AM (RcvQueue, SMPQueueUri)
createRcvQueue nonce_ qd e2eKeys = do
AgentConfig {smpClientVRange = vr} <- asks config
ntfServer_ <- if enableNtfs then newQueueNtfServer else pure Nothing
(rq, qUri, tSess, sessId) <- newRcvQueue_ c nm userId connId srvWithAuth vr qd (isJust ntfServer_) subMode nonce_ e2eKeys `catchAllErrors` \e -> liftIO (print e) >> throwE e
atomically $ incSMPServerStat c userId srv connCreated
rq' <- withStore c $ \db -> updateNewConnRcv db connId rq subMode
lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
mapM_ (newQueueNtfSubscription c rq') ntfServer_
pure (rq', qUri)
createConnReq :: SMPQueueUri -> AM (ConnectionRequestUri c)
createConnReq qUri = do
AgentConfig {smpAgentVRange, e2eEncryptVRange} <- asks config
@@ -1040,12 +1172,9 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
qm = case cMode of SCMContact -> QMContact; SCMInvitation -> QMMessaging
qUri = SMPQueueUri vr $ SMPQueueAddress srv sndId e2eDhKey (Just qm)
connReq <- createConnReq qUri
let (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq userLinkData
let (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing userLinkData
qd <- case cMode of
SCMContact -> do
let (linkId, k) = SL.contactShortLinkKdf linkKey
srvData <- liftError id $ SL.encryptLinkData g k linkData
pure $ CQRContact $ Just CQRData {linkKey, privSigKey, srvReq = (linkId, (sndId, srvData))}
SCMContact -> encryptContactLinkData g privSigKey linkKey sndId linkData
SCMInvitation -> do
let k = SL.invShortLinkKdf linkKey
srvData <- liftError id $ SL.encryptLinkData g k linkData
@@ -1054,7 +1183,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (CreatedConnLink c)
connReqWithShortLink qUri cReq qUri' shortLink = case shortLink of
Just ShortLinkCreds {shortLinkId, shortLinkKey}
| qUri == qUri' -> pure $ case cReq of
| qUri == qUri' -> pure $ case cReq of
CRContactUri _ -> CCLink cReq $ Just $ CSLContact SLSServer CCTContact srv shortLinkKey
CRInvitationUri crData (CR.E2ERatchetParamsUri vr k1 k2 _) ->
let cReq' = case pqInitKeys of
@@ -1129,7 +1258,8 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
case sq_ of
Just sq@SndQueue {e2ePubKey = Just _k} -> do
e2eSndParams <- withStore c $ \db ->
e2eSndParams <- withStore c $ \db -> do
lockConnForUpdate db connId
getSndRatchet db connId v >>= \case
Right r -> pure $ Right $ snd r
Left e -> do
@@ -1143,6 +1273,7 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
sndKey_ = snd <$> invLink_
(q, _) <- lift $ newSndQueue userId "" qInfo sndKey_
withStore c $ \db -> runExceptT $ do
liftIO $ lockConnForUpdate db connId
e2eSndParams <- createRatchet_ db g maxSupported pqSupport e2eRcvParams
sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_
pure (cData, sq', e2eSndParams, lnkId_)
@@ -1221,7 +1352,8 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup su
AgentConfig {smpClientVRange = vr, smpAgentVRange, e2eEncryptVRange = e2eVR} <- asks config
let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMMessaging}
crData = ConnReqUriData SSSimplex smpAgentVRange [qUri] Nothing
e2eRcvParams <- withStore' c $ \db ->
e2eRcvParams <- withStore' c $ \db -> do
lockConnForUpdate db connId
getRatchetX3dhKeys db connId >>= \case
Right keys -> pure $ CR.mkRcvE2ERatchetParams (maxVersion e2eVR) keys
Left e -> do
@@ -1312,7 +1444,7 @@ databaseDiff passed known =
let passedSet = S.fromList passed
knownSet = S.fromList known
missingIds = S.toList $ passedSet `S.difference` knownSet
extraIds = S.toList $ knownSet `S.difference` passedSet
extraIds = S.toList $ knownSet `S.difference` passedSet
in DatabaseDiff {missingIds, extraIds}
-- | Subscribe to receive connection messages (SUB command) in Reader monad
@@ -1350,7 +1482,8 @@ subscribeConnections_ c conns = do
notifyResultError rs
pure rs
where
partitionResultsConns :: (ConnId, Either StoreError SomeConnSub) ->
partitionResultsConns ::
(ConnId, Either StoreError SomeConnSub) ->
(Map ConnId (Either AgentErrorType (Maybe ClientServiceId)), [(ConnId, SomeConnSub)]) ->
(Map ConnId (Either AgentErrorType (Maybe ClientServiceId)), [(ConnId, SomeConnSub)])
partitionResultsConns (connId, conn_) (rs, cs) = case conn_ of
@@ -1443,10 +1576,10 @@ subscribeAllConnections' c onlyNeeded activeUserId_ = handleErr $ do
tryAllErrors' $ do
qs <- withStore' c $ \db -> do
qs <- getUserServerRcvQueueSubs db userId srv onlyNeeded
atomically $ modifyTVar' currPending (+ length qs) -- update before leaving transaction
unless (null qs) $ atomically $ modifyTVar' currPending (+ length qs) -- update before leaving transaction
pure qs
let n = length qs
lift $ subscribe qs `E.finally` atomically (modifyTVar' currPending $ subtract n)
unless (null qs) $ lift $ subscribe qs `E.finally` atomically (modifyTVar' currPending $ subtract n)
pure n
where
subscribe qs = do
@@ -1657,11 +1790,26 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do
(CCLink cReq _, service) <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv
notify $ INV (ACR cMode cReq) service
LSET userLinkData clientData ->
withServer' . tryCommand $ do
link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData
notify $ LINK link userLinkData
LGET shortLink ->
withServer' . tryCommand $ do
(fixedData, linkData) <- getConnShortLink' c NRMBackground userId shortLink
notify $ LDATA fixedData linkData
JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do
triedHosts <- newTVarIO S.empty
tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
(sqSecured, service) <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
notify $ JOINED sqSecured service
-- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously.
-- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously.
JOIN enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc subMode connInfo -> noServer $ do
triedHosts <- newTVarIO S.empty
tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
(sqSecured, service) <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo pqEnc subMode srv
notify $ JOINED sqSecured service
LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK
SWCH ->
@@ -1671,7 +1819,6 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
switchDuplexConnection c NRMBackground conn replaced >>= notify . SWITCH QDRcv SPStarted
_ -> throwE $ CMD PROHIBITED "SWCH: not duplex"
DEL -> withServer' . tryCommand $ deleteConnection' c NRMBackground connId >> notify OK
_ -> notify $ ERR $ INTERNAL $ "unsupported async command " <> show (aCommandTag cmd)
AInternalCommand cmd -> case cmd of
ICAckDel rId srvMsgId msgId -> withServer $ \srv -> tryWithLock "ICAckDel" $ ack srv rId srvMsgId >> withStore' c (\db -> deleteMsg db connId msgId)
ICAck rId srvMsgId -> withServer $ \srv -> tryWithLock "ICAck" $ ack srv rId srvMsgId
@@ -1835,7 +1982,7 @@ enqueueMessageB c reqs = do
storeSentMsg db cfg aMessageIds = \case
Left e -> pure (aMessageIds, Left e)
Right req@(csqs_, pqEnc_, msgFlags, mbr) -> case mbr of
VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of
VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of
Just _ -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg duplicate saved message body")
Nothing -> do
(mbId_, r) <- case csqs_ of
@@ -1877,7 +2024,6 @@ enqueueMessageB c reqs = do
handleInternal :: E.SomeException -> IO (Either AgentErrorType b)
handleInternal = pure . Left . INTERNAL . show
encodeAgentMsgStr :: AMessage -> InternalSndId -> PrevSndMsgHash -> ByteString
encodeAgentMsgStr aMessage internalSndId prevMsgHash = do
let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
@@ -1937,7 +2083,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} sq@SndQueue {userId, connId, server,
withRetryLock2 ri' qLock $ \riState loop -> do
liftIO $ waitWhileSuspended c
liftIO $ waitForUserNetwork c
resp <- tryError $ case msgType of
resp <- tryAllErrors $ case msgType of
AM_CONN_INFO -> sendConfirmation c NRMBackground sq msgBody
AM_CONN_INFO_REPLY -> sendConfirmation c NRMBackground sq msgBody
_ -> case pendingMsgPrepData_ of
@@ -2077,10 +2223,12 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} sq@SndQueue {userId, connId, server,
notifyDelMsgs :: InternalId -> AgentErrorType -> UTCTime -> AM ()
notifyDelMsgs msgId err expireTs = do
notifyDel msgId $ MERR (unId msgId) err
msgIds_ <- withStore' c $ \db -> getExpiredSndMessages db connId sq expireTs
msgIds_ <- withStore' c $ \db -> do
msgIds_ <- getExpiredSndMessages db connId sq expireTs
forM_ msgIds_ $ \msgId' -> deleteSndMsgDelivery db connId sq msgId' False `catchAll_` pure ()
pure msgIds_
forM_ (L.nonEmpty msgIds_) $ \msgIds -> do
notify $ MERRS (L.map unId msgIds) err
withStore' c $ \db -> forM_ msgIds $ \msgId' -> deleteSndMsgDelivery db connId sq msgId' False `catchAll_` pure ()
atomically $ incSMPServerStat' c userId server sentExpiredErrs (length msgIds_ + 1)
delMsg :: InternalId -> AM ()
delMsg = delMsgKeep False
@@ -2296,7 +2444,8 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do
forM_ cIds_ $ \cIds -> notify ("", "", AEvt SAEConn $ DEL_CONNS cIds)
pure res
where
partitionResultsConns :: (ConnId, Either StoreError SomeConn) ->
partitionResultsConns ::
(ConnId, Either StoreError SomeConn) ->
(Map ConnId (Either AgentErrorType ()), [RcvQueue], [ConnId]) ->
(Map ConnId (Either AgentErrorType ()), [RcvQueue], [ConnId])
partitionResultsConns (connId, conn_) (rs, rqs, cIds) = case conn_ of
@@ -2304,7 +2453,7 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do
Right (SomeConn _ conn) -> case connRcvQueues conn of
[] -> (M.insert connId (Right ()) rs, rqs, cIds)
rqs' -> (rs, rqs' ++ rqs, connId : cIds)
unsubNtfConnIds :: NonEmpty ConnId -> AM' ()
unsubNtfConnIds :: NonEmpty ConnId -> AM' ()
unsubNtfConnIds connIds' = do
ns <- asks ntfSupervisor
atomically $ writeTBQueue (ntfSubQ ns) (NSCDeleteSub, connIds')
@@ -2721,22 +2870,24 @@ getNextSMPServer c userId = getNextServer c userId storageSrvs
{-# INLINE getNextSMPServer #-}
subscriber :: AgentClient -> AM' ()
subscriber c@AgentClient {msgQ} = forever $ do
subscriber c@AgentClient {msgQ, subQ} = run $ forever $ do
t <- atomically $ readTBQueue msgQ
agentOperationBracket c AORcvNetwork waitUntilActive $
processSMPTransmissions c t
where
run a = a `catchOwn` \e -> notify $ CRITICAL True $ "Agent subscriber stopped: " <> show e
notify err = atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR err)
cleanupManager :: AgentClient -> AM' ()
cleanupManager c@AgentClient {subQ} = do
delay <- asks (initialCleanupDelay . config)
liftIO $ threadDelay' delay
int <- asks (cleanupInterval . config)
ttl <- asks $ storedMsgDataTTL . config
AgentConfig {initialCleanupDelay, cleanupInterval = int, storedMsgDataTTL = ttl, cleanupBatchSize = limit} <-
asks config
liftIO $ threadDelay' initialCleanupDelay
forever $ waitActive $ do
run ERR deleteConns
run ERR $ withStore' c (`deleteRcvMsgHashesExpired` ttl)
run ERR $ withStore' c (`deleteSndMsgsExpired` ttl)
run ERR $ withStore' c (`deleteRatchetKeyHashesExpired` ttl)
run ERR $ withStore' c $ \db -> deleteRcvMsgHashesExpired db ttl limit
run ERR $ withStore' c $ \db -> deleteSndMsgsExpired db ttl limit
run ERR $ withStore' c $ \db -> deleteRatchetKeyHashesExpired db ttl limit
run ERR $ withStore' c (`deleteExpiredNtfTokensToDelete` ttl)
run RFERR deleteRcvFilesExpired
run RFERR deleteRcvFilesDeleted
@@ -3005,7 +3156,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
throwE e
agentClientMsg :: TVar ChaChaDRG -> ByteString -> AM (Maybe (InternalId, MsgMeta, AMessage, CR.RatchetX448))
agentClientMsg g encryptedMsgHash = withStore c $ \db -> runExceptT $ do
rc <- ExceptT $ getRatchet db connId -- ratchet state pre-decryption - required for processing EREADY
liftIO $ lockConnForUpdate db connId
rc <- ExceptT $ getRatchetForUpdate db connId -- ratchet state pre-decryption - required for processing EREADY
(agentMsgBody, pqEncryption) <- agentRatchetDecrypt' g db connId rc encAgentMessage
liftEither (parse smpP (SEAgentError $ AGENT A_MESSAGE) agentMsgBody) >>= \case
agentMsg@(AgentMessage APrivHeader {sndMsgId, prevMsgHash} aMessage) -> do
@@ -3045,7 +3197,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
ackDel :: InternalId -> AM ACKd
ackDel aId = enqueueCmd (ICAckDel rId srvMsgId aId) $> ACKd
handleNotifyAck :: AM ACKd -> AM ACKd
handleNotifyAck m = m `catchAllErrors` \e -> notify (ERR e) >> ack
handleNotifyAck m = m `catchAllOwnErrors` \e -> notify (ERR e) >> ack
SMP.END ->
atomically (ifM (activeClientSession c tSess sessId) (removeSubscription c tSess connId rq $> True) (pure False))
>>= notifyEnd
@@ -3240,6 +3392,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
Just sqs' -> do
(sq_@SndQueue {sndPrivateKey}, dhPublicKey) <- lift $ newSndQueue userId connId qInfo Nothing
sq2 <- withStore c $ \db -> do
lockConnForUpdate db connId
liftIO $ mapM_ (deleteConnSndQueue db connId) delSqs
addConnSndQueue db connId (sq_ :: NewSndQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret' srvMsgId <> " " <> logSecret (senderId queueAddress)
@@ -3544,7 +3697,7 @@ agentRatchetEncrypt db cData msg getPaddedLen pqEnc_ currentE2EVersion = do
agentRatchetEncryptHeader :: DB.Connection -> ConnData -> (VersionSMPA -> PQSupport -> Int) -> Maybe PQEncryption -> CR.VersionE2E -> ExceptT StoreError IO (CR.MsgEncryptKeyX448, Int, PQEncryption)
agentRatchetEncryptHeader db ConnData {connId, connAgentVersion = v, pqSupport} getPaddedLen pqEnc_ currentE2EVersion = do
rc <- ExceptT $ getRatchet db connId
rc <- ExceptT $ getRatchetForUpdate db connId
let paddedLen = getPaddedLen v pqSupport
(mek, rc') <- withExceptT (SEAgentError . cryptoError) $ CR.rcEncryptHeader rc pqEnc_ currentE2EVersion
liftIO $ updateRatchet db connId rc' CR.SMDNoChange
@@ -3553,7 +3706,7 @@ agentRatchetEncryptHeader db ConnData {connId, connAgentVersion = v, pqSupport}
-- encoded EncAgentMessage -> encoded AgentMessage
agentRatchetDecrypt :: TVar ChaChaDRG -> DB.Connection -> ConnId -> ByteString -> ExceptT StoreError IO (ByteString, PQEncryption)
agentRatchetDecrypt g db connId encAgentMsg = do
rc <- ExceptT $ getRatchet db connId
rc <- ExceptT $ getRatchetForUpdate db connId
agentRatchetDecrypt' g db connId rc encAgentMsg
agentRatchetDecrypt' :: TVar ChaChaDRG -> DB.Connection -> ConnId -> CR.RatchetX448 -> ByteString -> ExceptT StoreError IO (ByteString, PQEncryption)
+36 -33
View File
@@ -240,6 +240,7 @@ import Simplex.Messaging.Agent.Stats
import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Agent.Store.AgentStore (getClientNotices, updateClientNotices)
import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
import Simplex.Messaging.Agent.Store.DB (SQLError)
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Agent.Store.Entity
import Simplex.Messaging.Agent.TSessionSubs (TSessionSubs)
@@ -1447,12 +1448,12 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl
(CQRMessaging ld, Just QMMessaging) ->
withLinkData ld $ \lnkId CQRData {linkKey, privSigKey, srvReq = (sndId', d)} ->
if sndId == sndId'
then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey (fst d)
then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey Nothing (fst d)
else newErr "different sender ID"
(CQRContact ld, Just QMContact) ->
withLinkData ld $ \lnkId CQRData {linkKey, privSigKey, srvReq = (lnkId', (sndId', d))} ->
if sndId == sndId' && lnkId == lnkId'
then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey (fst d)
then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey Nothing (fst d)
else newErr "different sender or link IDs"
(_, Nothing) -> case linkId of
Nothing | v < sndAuthKeySMPVersion -> pure Nothing
@@ -2113,39 +2114,46 @@ withWork :: AgentClient -> TMVar () -> (DB.Connection -> IO (Either StoreError (
withWork c doWork = withWork_ c doWork . withStore' c
{-# INLINE withWork #-}
-- setting doWork flag to "no work" before getWork rather than after prevents race condition when flag is set to "has work" by another thread after getWork call.
withWork_ :: (AnyStoreError e', MonadIO m) => AgentClient -> TMVar () -> ExceptT e m (Either e' (Maybe a)) -> (a -> ExceptT e m ()) -> ExceptT e m ()
withWork_ c doWork getWork action =
getWork >>= \case
Right (Just r) -> action r
Right Nothing -> noWork
-- worker is stopped here (noWork) because the next iteration is likely to produce the same result
noWork >> getWork >>= \case
Right (Just r) -> hasWork >> action r
Right Nothing -> pure ()
Left e
| isWorkItemError e -> noWork >> notifyErr (CRITICAL False) e
| otherwise -> notifyErr INTERNAL e
| isWorkItemError e -> notifyErr (CRITICAL False) e -- worker remains stopped here because the next iteration is likely to produce the same result
| otherwise -> hasWork >> notifyErr INTERNAL e
where
hasWork = atomically $ hasWorkToDo' doWork
noWork = liftIO $ noWorkToDo doWork
notifyErr err e = atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
notifyErr err e = do
logError $ "withWork_ error: " <> tshow e
atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
withWorkItems :: (AnyStoreError e', MonadIO m) => AgentClient -> TMVar () -> ExceptT e m (Either e' [Either e' a]) -> (NonEmpty a -> ExceptT e m ()) -> ExceptT e m ()
withWorkItems c doWork getWork action = do
getWork >>= \case
Right [] -> noWork
noWork >> getWork >>= \case
Right [] -> pure ()
Right rs -> do
let (errs, items) = partitionEithers rs
case L.nonEmpty items of
Just items' -> action items'
Just items' -> hasWork >> action items'
Nothing -> do
let criticalErr = find isWorkItemError errs
forM_ criticalErr $ \err -> do
notifyErr (CRITICAL False) err
when (all isWorkItemError errs) noWork
case find isWorkItemError errs of
Nothing -> hasWork
Just err -> do
notifyErr (CRITICAL False) err
unless (all isWorkItemError errs) hasWork
forM_ (L.nonEmpty errs) $ notifySub c . ERRS . L.map (\e -> ("", INTERNAL $ show e))
Left e
| isWorkItemError e -> noWork >> notifyErr (CRITICAL False) e
| otherwise -> notifyErr INTERNAL e
| isWorkItemError e -> notifyErr (CRITICAL False) e
| otherwise -> hasWork >> notifyErr INTERNAL e
where
hasWork = atomically $ hasWorkToDo' doWork
noWork = liftIO $ noWorkToDo doWork
notifyErr err e = atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
notifyErr err e = do
logError $ "withWorkItems error: " <> tshow e
atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
noWorkToDo :: TMVar () -> IO ()
noWorkToDo = void . atomically . tryTakeTMVar
@@ -2243,24 +2251,19 @@ withStore :: AgentClient -> (DB.Connection -> IO (Either StoreError a)) -> AM a
withStore c action = do
st <- asks store
withExceptT storeError . ExceptT . liftIO . agentOperationBracket c AODatabase (\_ -> pure ()) $
withTransaction st action `E.catches` handleDBErrors
withTransaction st action `E.catch` handleDBErrors
where
handleDBErrors :: E.SomeException -> IO (Either StoreError a)
handleDBErrors e = pure $ Left $ case E.fromException e of
Just (e' :: SQLError) ->
#if defined(dbPostgres)
-- TODO [postgres] postgres specific error handling
handleDBErrors :: [E.Handler IO (Either StoreError a)]
handleDBErrors =
[ E.Handler $ \(E.SomeException e) -> pure . Left $ SEInternal $ bshow e
]
SEInternal $ bshow e'
#else
handleDBErrors :: [E.Handler IO (Either StoreError a)]
handleDBErrors =
[ E.Handler $ \(e :: SQL.SQLError) ->
let se = SQL.sqlError e
busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
in pure . Left . (if busy then SEDatabaseBusy else SEInternal) $ bshow se,
E.Handler $ \(E.SomeException e) -> pure . Left $ SEInternal $ bshow e
]
let se = SQL.sqlError e'
busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
in (if busy then SEDatabaseBusy else SEInternal) $ bshow e'
#endif
Nothing -> SEInternal $ bshow e
unsafeWithStore :: AgentClient -> (DB.Connection -> IO a) -> AM' a
unsafeWithStore c action = do
+3 -1
View File
@@ -153,6 +153,7 @@ data AgentConfig = AgentConfig
persistErrorInterval :: NominalDiffTime,
initialCleanupDelay :: Int64,
cleanupInterval :: Int64,
cleanupBatchSize :: Int,
initialLogStatsDelay :: Int64,
logStatsInterval :: Int64,
cleanupStepInterval :: Int,
@@ -224,7 +225,8 @@ defaultAgentConfig =
quotaExceededTimeout = 7 * nominalDay,
persistErrorInterval = 3, -- seconds
initialCleanupDelay = 30 * 1000000, -- 30 seconds
cleanupInterval = 30 * 60 * 1000000, -- 30 minutes
cleanupInterval = 5 * 60 * 1000000, -- 5 minutes
cleanupBatchSize = 10000,
initialLogStatsDelay = 10 * 1000000, -- 10 seconds
logStatsInterval = 10 * 1000000, -- 10 seconds
cleanupStepInterval = 200000, -- 200ms
+13 -14
View File
@@ -36,6 +36,7 @@ import qualified Data.List.NonEmpty as L
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes)
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Time (UTCTime, addUTCTime, getCurrentTime)
import Data.Time.Clock (diffUTCTime)
import Simplex.Messaging.Agent.Client
@@ -46,13 +47,13 @@ import Simplex.Messaging.Agent.Stats
import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Agent.Store.AgentStore
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Client (NetworkRequestMode (..))
import Simplex.Messaging.Client (NetworkRequestMode (..), nonBlockingWriteTBQueue)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Notifications.Protocol
import Simplex.Messaging.Notifications.Types
import Simplex.Messaging.Protocol (NtfServer, sameSrvAddr)
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Util (catchAllErrors, diffToMicroseconds, threadDelay', tryAllErrors, tshow, whenM)
import Simplex.Messaging.Util (catchAllErrors, catchAllErrors', diffToMicroseconds, threadDelay', tryAllErrors, tshow, whenM)
import System.Random (randomR)
import UnliftIO
import UnliftIO.Concurrent (forkIO)
@@ -66,19 +67,15 @@ runNtfSupervisor c = do
Right _ -> pure ()
forever $ do
cmd <- atomically . readTBQueue $ ntfSubQ ns
handleErr . agentOperationBracket c AONtfNetwork waitUntilActive $
runExceptT (processNtfCmd c cmd) >>= \case
Left e -> notifyErr e
Right _ -> return ()
handleErr $ agentOperationBracket c AONtfNetwork waitUntilActive $
processNtfCmd c cmd `catchAllErrors'` notifyErr
where
startTknDelete :: AM ()
startTknDelete = do
pendingDelServers <- withStore' c getPendingDelTknServers
lift . forM_ pendingDelServers $ getNtfTknDelWorker True c
handleErr :: AM' () -> AM' ()
handleErr = E.handle $ \(e :: E.SomeException) -> do
logError $ "runNtfSupervisor error " <> tshow e
notifyErr e
handleErr = E.handle $ \(e :: E.SomeException) -> notifyErr e
notifyErr e = notifyInternalError' c $ "runNtfSupervisor error " <> show e
partitionErrs :: (a -> ConnId) -> [a] -> [Either AgentErrorType b] -> ([(ConnId, AgentErrorType)], [b])
@@ -505,16 +502,18 @@ workerInternalError c connId internalErrStr = do
-- TODO change error
notifyInternalError :: MonadIO m => AgentClient -> ConnId -> String -> m ()
notifyInternalError AgentClient {subQ} connId internalErrStr = atomically $ writeTBQueue subQ ("", connId, AEvt SAEConn $ ERR $ INTERNAL internalErrStr)
{-# INLINE notifyInternalError #-}
notifyInternalError AgentClient {subQ} connId internalErrStr = do
logError $ T.pack internalErrStr
liftIO $ nonBlockingWriteTBQueue subQ ("", connId, AEvt SAEConn $ ERR $ INTERNAL internalErrStr)
notifyInternalError' :: MonadIO m => AgentClient -> String -> m ()
notifyInternalError' AgentClient {subQ} internalErrStr = atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL internalErrStr)
notifyInternalError' c = notifyInternalError c ""
{-# INLINE notifyInternalError' #-}
notifyErrs :: MonadIO m => AgentClient -> [(ConnId, AgentErrorType)] -> m ()
notifyErrs c = mapM_ (notifySub c . ERRS) . L.nonEmpty
{-# INLINE notifyErrs #-}
notifyErrs c errs_ = forM_ (L.nonEmpty errs_) $ \errs -> do
logError $ "notifyErrs: " <> tshow errs
notifySub c $ ERRS errs
getNtfToken :: AM' (Maybe NtfToken)
getNtfToken = do
+154 -33
View File
@@ -20,8 +20,8 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
-- |
-- Module : Simplex.Messaging.Agent.Protocol
@@ -107,11 +107,14 @@ module Simplex.Messaging.Agent.Protocol
ConnectionModeI (..),
ConnectionRequestUri (..),
AConnectionRequestUri (..),
ShortLinkCreds (..),
ConnReqUriData (..),
CRClientData,
ServiceScheme,
FixedLinkData (..),
AConnLinkData (..),
ConnLinkData (..),
AUserConnLinkData (..),
UserConnLinkData (..),
UserContactData (..),
UserLinkData (..),
@@ -126,9 +129,12 @@ module Simplex.Messaging.Agent.Protocol
ContactConnType (..),
ShortLinkScheme (..),
LinkKey (..),
PreparedLinkParams (..),
StoredClientService (..),
ClientService,
ClientServiceId,
validateOwners,
validateLinkOwners,
sameConnReqContact,
sameShortLinkContact,
simplexChat,
@@ -177,7 +183,7 @@ module Simplex.Messaging.Agent.Protocol
where
import Control.Applicative (optional, (<|>))
import Control.Exception (BlockedIndefinitelyOnSTM (..), fromException)
import Control.Exception (BlockedIndefinitelyOnMVar (..), BlockedIndefinitelyOnSTM (..), fromException)
import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.:), (.:?))
import qualified Data.Aeson as J'
import qualified Data.Aeson.Encoding as JE
@@ -197,7 +203,7 @@ import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, isJust)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
@@ -251,10 +257,10 @@ import Simplex.Messaging.Protocol
legacyStrEncodeServer,
noAuthSrv,
sameSrvAddr,
senderCanSecure,
shortLinksSMPClientVersion,
sndAuthKeySMPClientVersion,
srvHostnamesSMPClientVersion,
shortLinksSMPClientVersion,
senderCanSecure,
pattern ProtoServerWithAuth,
pattern SMPServer,
)
@@ -382,6 +388,8 @@ type SndQueueSecured = Bool
-- | Parameterized type for SMP agent events
data AEvent (e :: AEntity) where
INV :: AConnectionRequestUri -> Maybe ClientServiceId -> AEvent AEConn
LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn
LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> AEvent AEConn
CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender
INFO :: PQSupport -> ConnInfo -> AEvent AEConn
@@ -435,6 +443,8 @@ deriving instance Show AEvtTag
data ACommand
= NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV
| LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK
| LGET (ConnShortLink 'CMContact) -- response LDATA
| JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo
| LET ConfirmationId ConnInfo -- ConnInfo is from client
| ACK AgentMsgId (Maybe MsgReceiptInfo)
@@ -444,6 +454,8 @@ data ACommand
data ACommandTag
= NEW_
| LSET_
| LGET_
| JOIN_
| LET_
| ACK_
@@ -453,6 +465,8 @@ data ACommandTag
data AEventTag (e :: AEntity) where
INV_ :: AEventTag AEConn
LINK_ :: AEventTag AEConn
LDATA_ :: AEventTag AEConn
CONF_ :: AEventTag AEConn
REQ_ :: AEventTag AEConn
INFO_ :: AEventTag AEConn
@@ -499,6 +513,8 @@ deriving instance Show (AEventTag e)
aCommandTag :: ACommand -> ACommandTag
aCommandTag = \case
NEW {} -> NEW_
LSET {} -> LSET_
LGET _ -> LGET_
JOIN {} -> JOIN_
LET {} -> LET_
ACK {} -> ACK_
@@ -508,6 +524,8 @@ aCommandTag = \case
aEventTag :: AEvent e -> AEventTag e
aEventTag = \case
INV {} -> INV_
LINK {} -> LINK_
LDATA {} -> LDATA_
CONF {} -> CONF_
REQ {} -> REQ_
INFO {} -> INFO_
@@ -698,9 +716,9 @@ instance ToJSON NotificationsMode where
instance FromJSON NotificationsMode where
parseJSON = strParseJSON "NotificationsMode"
instance ToField NotificationsMode where toField = toField . strEncode
instance ToField NotificationsMode where toField = toField . decodeLatin1 . strEncode
instance FromField NotificationsMode where fromField = blobFieldDecoder $ parseAll strP
instance FromField NotificationsMode where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
data NotificationInfo = NotificationInfo
{ ntfConnId :: ConnId,
@@ -1432,6 +1450,15 @@ instance Eq AConnectionRequestUri where
deriving instance Show AConnectionRequestUri
data ShortLinkCreds = ShortLinkCreds
{ shortLinkId :: SMP.LinkId,
shortLinkKey :: LinkKey,
linkPrivSigKey :: C.PrivateKeyEd25519,
linkRootSigKey :: Maybe C.PublicKeyEd25519, -- in case the current user is not the original owner, and the root key is different from linkPrivSigKey
linkEncFixedData :: SMP.EncFixedDataBytes
}
deriving (Show)
data ShortLinkScheme = SLSSimplex | SLSServer deriving (Eq, Show)
data ConnShortLink (m :: ConnectionMode) where
@@ -1453,6 +1480,23 @@ newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
instance ToField LinkKey where toField (LinkKey s) = toField $ Binary s
-- | Parameters for creating a connection with a prepared link.
data PreparedLinkParams = PreparedLinkParams
{ -- | Correlation ID / determines sender ID
plpNonce :: C.CbNonce,
-- | Queue E2EE DH key pair
plpQueueE2EKeys :: C.KeyPairX25519,
-- | For encrypting link data
plpLinkKey :: LinkKey,
-- | Root signing key (for signing link data)
plpRootPrivKey :: C.PrivateKeyEd25519,
-- | smpEncode of FixedLinkData (includes linkEntityId)
plpSignedFixedData :: ByteString,
-- | Server with basic auth (not stored in link)
plpSrvWithAuth :: SMPServerWithAuth
}
deriving (Show)
instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode
instance (Typeable c, ConnectionModeI c) => FromField (ConnectionLink c) where fromField = blobFieldDecoder strDecode
@@ -1687,13 +1731,19 @@ type CRClientData = Text
data FixedLinkData c = FixedLinkData
{ agentVRange :: VersionRangeSMPA,
rootKey :: C.PublicKeyEd25519,
connReq :: ConnectionRequestUri c
linkConnReq :: ConnectionRequestUri c,
linkEntityId :: Maybe ByteString
}
deriving (Eq, Show)
data ConnLinkData c where
InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
ContactLinkData :: VersionRangeSMPA -> UserContactData -> ConnLinkData 'CMContact
deriving instance Eq (ConnLinkData c)
deriving instance Show (ConnLinkData c)
data UserContactData = UserContactData
{ -- direct connection via connReq in fixed data is allowed.
direct :: Bool,
@@ -1703,8 +1753,10 @@ data UserContactData = UserContactData
relays :: [ConnShortLink 'CMContact],
userData :: UserLinkData
}
deriving (Eq, Show)
newtype UserLinkData = UserLinkData ByteString
deriving (Eq, Show)
data AConnLinkData = forall m. ConnectionModeI m => ACLD (SConnectionMode m) (ConnLinkData m)
@@ -1712,6 +1764,12 @@ data UserConnLinkData c where
UserInvLinkData :: UserLinkData -> UserConnLinkData 'CMInvitation
UserContactLinkData :: UserContactData -> UserConnLinkData 'CMContact
deriving instance Eq (UserConnLinkData m)
deriving instance Show (UserConnLinkData m)
data AUserConnLinkData = forall m. ConnectionModeI m => AULD (SConnectionMode m) (UserConnLinkData m)
linkUserData :: ConnLinkData c -> UserLinkData
linkUserData = \case
InvitationLinkData _ d -> d
@@ -1727,37 +1785,60 @@ type OwnerId = ByteString
data OwnerAuth = OwnerAuth
{ ownerId :: OwnerId, -- unique in the list, application specific - e.g., MemberId
ownerKey :: C.PublicKeyEd25519,
-- sender ID signed with ownerKey,
-- confirms that the owner accepts being the owner.
-- sender ID is used here as it is immutable for the queue, link data can be removed.
ownerSig :: C.Signature 'C.Ed25519,
-- null for root key authorization
authOwnerId :: OwnerId,
-- owner authorization, sig(ownerId || ownerKey, key(authOwnerId)),
-- where authOwnerId is either null for a root key or some other owner authorized by root key, etc.
-- Owner validation should detect and reject loops.
-- owner authorization by root or any previous owner, sig(ownerId || ownerKey, prevOwnerKey),
authOwnerSig :: C.Signature 'C.Ed25519
}
deriving (Eq, Show)
instance Encoding OwnerAuth where
smpEncode OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig} =
smpEncode (ownerId, ownerKey, C.signatureBytes ownerSig, authOwnerId, C.signatureBytes authOwnerSig)
smpEncode OwnerAuth {ownerId, ownerKey, authOwnerSig} =
-- It is additionally encoded as ByteString to have known length and allow OwnerAuth extension
smpEncode $ smpEncode (ownerId, ownerKey, C.signatureBytes authOwnerSig)
smpP = do
(ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig) <- smpP
pure OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig}
-- parseOnly ignores any unused extension
(ownerId, ownerKey, authOwnerSig) <- A.parseOnly smpP <$?> smpP
pure OwnerAuth {ownerId, ownerKey, authOwnerSig}
validateOwners :: Maybe ShortLinkCreds -> UserContactData -> Either String ()
validateOwners shortLink_ UserContactData {owners} = case shortLink_ of
Nothing
| null owners -> Right ()
| otherwise -> Left "no link credentials with additional owners"
Just ShortLinkCreds {linkPrivSigKey, linkRootSigKey}
| hasOwner -> validateLinkOwners (fromMaybe k linkRootSigKey) owners
| otherwise -> Left "no current owner in link data"
where
hasOwner = isNothing linkRootSigKey || any ((k ==) . ownerKey) owners
k = C.publicKey linkPrivSigKey
validateLinkOwners :: C.PublicKeyEd25519 -> [OwnerAuth] -> Either String ()
validateLinkOwners rootKey = go []
where
go _ [] = Right ()
go prev (o : os) = validOwner o >> go (o : prev) os
where
validOwner OwnerAuth {ownerId = oId, ownerKey = k, authOwnerSig = sig}
| k == rootKey = Left $ "owner key for ID " <> idStr <> " matches root key"
| any duplicate prev = Left $ "duplicate owner key or ID " <> idStr
| signedBy rootKey || any (signedBy . ownerKey) prev = Right ()
| otherwise = Left $ "invalid authorization of owner ID " <> idStr
where
duplicate OwnerAuth {ownerId, ownerKey} = oId == ownerId || k == ownerKey
idStr = B.unpack $ B64.encodeUnpadded oId
signedBy k' = C.verify' k' sig (oId <> C.encodePubKey k)
instance ConnectionModeI c => Encoding (FixedLinkData c) where
smpEncode FixedLinkData {agentVRange, rootKey, connReq} =
smpEncode (agentVRange, rootKey, connReq)
smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} =
smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId
smpP = do
(agentVRange, rootKey, connReq) <- smpP
pure FixedLinkData {agentVRange, rootKey, connReq}
(agentVRange, rootKey, linkConnReq) <- smpP
linkEntityId <- optional smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId}
instance ConnectionModeI c => Encoding (ConnLinkData c) where
smpEncode = \case
InvitationLinkData vr userData -> smpEncode (CMInvitation, vr, userData)
ContactLinkData vr UserContactData {direct, owners, relays, userData} ->
B.concat [smpEncode (CMContact, vr, direct), smpEncodeList owners, smpEncodeList relays, smpEncode userData]
ContactLinkData vr cd -> smpEncode (CMContact, vr, cd)
smpP = (\(ACLD _ d) -> checkConnMode d) <$?> smpP
{-# INLINE smpP #-}
@@ -1770,13 +1851,43 @@ instance Encoding AConnLinkData where
(vr, userData) <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
pure $ ACLD SCMInvitation $ InvitationLinkData vr userData
CMContact -> do
(vr, direct) <- smpP
owners <- smpListP
relays <- smpListP
userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
let cd = UserContactData {direct, owners, relays, userData}
(vr, cd) <- smpP
pure $ ACLD SCMContact $ ContactLinkData vr cd
instance ConnectionModeI c => Encoding (UserConnLinkData c) where
smpEncode = \case
UserInvLinkData userData -> smpEncode (CMInvitation, userData)
UserContactLinkData cd -> smpEncode (CMContact, cd)
smpP = (\(AULD _ d) -> checkConnMode d) <$?> smpP
{-# INLINE smpP #-}
instance Encoding AUserConnLinkData where
smpEncode (AULD _ d) = smpEncode d
{-# INLINE smpEncode #-}
smpP =
smpP >>= \case
CMInvitation -> do
userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
pure $ AULD SCMInvitation $ UserInvLinkData userData
CMContact ->
AULD SCMContact . UserContactLinkData <$> smpP
instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where
strEncode = smpEncode
{-# INLINE strEncode #-}
strP = smpP
{-# INLINE strP #-}
instance Encoding UserContactData where
smpEncode UserContactData {direct, owners, relays, userData} =
B.concat [smpEncode direct, smpEncodeList owners, smpEncodeList relays, smpEncode userData]
smpP = do
direct <- smpP
owners <- smpListP
relays <- smpListP
userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
pure UserContactData {direct, owners, relays, userData}
instance Encoding UserLinkData where
smpEncode (UserLinkData s) = if B.length s <= 254 then smpEncode s else smpEncode ('\255', Large s)
{-# INLINE smpEncode #-}
@@ -1894,7 +2005,9 @@ data AgentErrorType
instance AnyError AgentErrorType where
fromSomeException e = case fromException e of
Just BlockedIndefinitelyOnSTM -> CRITICAL True "Thread blocked indefinitely in STM transaction"
_ -> INTERNAL $ show e
_ -> case fromException e of
Just BlockedIndefinitelyOnMVar -> CRITICAL True "Thread blocked indefinitely on MVar"
_ -> INTERNAL $ show e
{-# INLINE fromSomeException #-}
-- | SMP agent protocol command or response error.
@@ -1976,6 +2089,8 @@ instance StrEncoding ACommandTag where
strP =
A.takeTill (== ' ') >>= \case
"NEW" -> pure NEW_
"LSET" -> pure LSET_
"LGET" -> pure LGET_
"JOIN" -> pure JOIN_
"LET" -> pure LET_
"ACK" -> pure ACK_
@@ -1984,6 +2099,8 @@ instance StrEncoding ACommandTag where
_ -> fail "bad ACommandTag"
strEncode = \case
NEW_ -> "NEW"
LSET_ -> "LSET"
LGET_ -> "LGET"
JOIN_ -> "JOIN"
LET_ -> "LET"
ACK_ -> "ACK"
@@ -1995,6 +2112,8 @@ commandP binaryP =
strP
>>= \case
NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe))
LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP))
LGET_ -> s (LGET <$> strP)
JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP)
LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP)
ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP))
@@ -2012,6 +2131,8 @@ commandP binaryP =
serializeCommand :: ACommand -> ByteString
serializeCommand = \case
NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode)
LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_
LGET sl -> s (LGET_, sl)
JOIN ntfs cReq pqSup subMode cInfo -> s (JOIN_, ntfs, cReq, pqSup, subMode, Str $ serializeBinary cInfo)
LET confId cInfo -> B.unwords [s LET_, confId, serializeBinary cInfo]
ACK mId rcptInfo_ -> s (ACK_, mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_
+5 -10
View File
@@ -16,7 +16,7 @@
module Simplex.Messaging.Agent.Store where
import Control.Exception (Exception)
import Control.Exception (Exception (..))
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString)
import Data.Int (Int64)
@@ -31,6 +31,7 @@ import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.RetryInterval (RI2State)
import Simplex.Messaging.Agent.Store.Entity
import Simplex.Messaging.Agent.Store.Common
import Simplex.Messaging.Agent.Store.DB (SQLError)
import Simplex.Messaging.Agent.Store.Interface (createDBStore)
import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations)
import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..))
@@ -126,14 +127,6 @@ rcvQueueSub :: RcvQueue -> RcvQueueSub
rcvQueueSub RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId = DBEntityId dbQueueId, primary, dbReplaceQueueId} =
RcvQueueSub {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId, primary, dbReplaceQueueId}
data ShortLinkCreds = ShortLinkCreds
{ shortLinkId :: SMP.LinkId,
shortLinkKey :: LinkKey,
linkPrivSigKey :: C.PrivateKeyEd25519,
linkEncFixedData :: SMP.EncFixedDataBytes
}
deriving (Show)
clientServiceId :: RcvQueue -> Maybe ClientServiceId
clientServiceId = fmap dbServiceId . clientService
{-# INLINE clientServiceId #-}
@@ -752,7 +745,9 @@ data StoreError
deriving (Eq, Show, Exception)
instance AnyError StoreError where
fromSomeException = SEInternal . bshow
fromSomeException e = SEInternal $ case fromException e of
Just (e' :: SQLError) -> bshow e'
Nothing -> bshow e
class (Show e, AnyError e) => AnyStoreError e where
isWorkItemError :: e -> Bool
+250 -120
View File
@@ -36,6 +36,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
checkUser,
-- * Queues and connections
createServer,
createNewConn,
updateNewConnRcv,
updateNewConnSnd,
@@ -52,10 +53,12 @@ module Simplex.Messaging.Agent.Store.AgentStore
getConnSubs,
getDeletedConns,
getConnsData,
lockConnForUpdate,
setConnDeleted,
setConnUserId,
setConnAgentVersion,
setConnPQSupport,
updateNewConnJoin,
getDeletedConnIds,
getDeletedWaitingDeliveryConnIds,
setConnRatchetSync,
@@ -140,6 +143,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
createRatchet,
deleteRatchet,
getRatchet,
getRatchetForUpdate,
getSkippedMsgKeys,
updateRatchet,
-- Async commands
@@ -187,6 +191,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
-- Rcv files
createRcvFile,
createRcvFileRedirect,
lockRcvFileForUpdate,
getRcvFile,
getRcvFileByEntityId,
getRcvFileRedirects,
@@ -207,6 +212,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
getRcvFilesExpired,
-- Snd files
createSndFile,
lockSndFileForUpdate,
getSndFile,
getSndFileByEntityId,
getNextSndFileToPrepare,
@@ -285,7 +291,7 @@ import Simplex.Messaging.Agent.Stats
import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Agent.Store.Common
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_)
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), FromField (..), ToField (..), SQLError, blobFieldDecoder, fromTextField_)
import Simplex.Messaging.Agent.Store.Entity
import Simplex.Messaging.Client (SMPTransportSession)
import qualified Simplex.Messaging.Crypto as C
@@ -308,11 +314,11 @@ import qualified UnliftIO.Exception as E
import UnliftIO.STM
#if defined(dbPostgres)
import Data.List (sortOn)
import Database.PostgreSQL.Simple (In (..), Only (..), Query, SqlError, (:.) (..))
import Database.PostgreSQL.Simple (In (..), Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.Errors (constraintViolation)
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (FromRow (..), Only (..), Query (..), SQLError, ToRow (..), field, (:.) (..))
import Database.SQLite.Simple (FromRow (..), Only (..), Query (..), ToRow (..), field, (:.) (..))
import qualified Database.SQLite.Simple as SQL
import Database.SQLite.Simple.QQ (sql)
#endif
@@ -320,13 +326,12 @@ import Database.SQLite.Simple.QQ (sql)
checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
checkConstraint err action = action `E.catch` (pure . Left . handleSQLError err)
handleSQLError :: StoreError -> SQLError -> StoreError
#if defined(dbPostgres)
handleSQLError :: StoreError -> SqlError -> StoreError
handleSQLError err e = case constraintViolation e of
Just _ -> err
Nothing -> SEInternal $ bshow e
#else
handleSQLError :: StoreError -> SQLError -> StoreError
handleSQLError err e
| SQL.sqlError e == SQL.ErrorConstraint = err
| otherwise = SEInternal $ bshow e
@@ -391,22 +396,23 @@ deleteUsersWithoutConns db = do
pure userIds
createConn_ ::
DB.Connection ->
TVar ChaChaDRG ->
ConnData ->
(ConnId -> IO a) ->
IO (Either StoreError (ConnId, a))
createConn_ gVar cData create = checkConstraint SEConnDuplicate $ case cData of
ConnData {connId = ""} -> createWithRandomId' gVar create
createConn_ db gVar cData create = checkConstraint SEConnDuplicate $ case cData of
ConnData {connId = ""} -> createWithRandomId' db gVar create
ConnData {connId} -> Right . (connId,) <$> create connId
createNewConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> SConnectionMode c -> IO (Either StoreError ConnId)
createNewConn db gVar cData cMode = do
fst <$$> createConn_ gVar cData (\connId -> createConnRecord db connId cData cMode)
fst <$$> createConn_ db gVar cData (\connId -> createConnRecord db connId cData cMode)
-- TODO [certs rcv] store clientServiceId from NewRcvQueue
updateNewConnRcv :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO (Either StoreError RcvQueue)
updateNewConnRcv db connId rq subMode =
getConn db connId $>>= \case
getConnForUpdate db connId $>>= \case
(SomeConn _ NewConnection {}) -> updateConn
(SomeConn _ RcvConnection {}) -> updateConn -- to allow retries
(SomeConn c _) -> pure . Left . SEBadConnType "updateNewConnRcv" $ connType c
@@ -416,7 +422,7 @@ updateNewConnRcv db connId rq subMode =
updateNewConnSnd :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue)
updateNewConnSnd db connId sq =
getConn db connId $>>= \case
getConnForUpdate db connId $>>= \case
(SomeConn _ NewConnection {}) -> updateConn
(SomeConn c _) -> pure . Left . SEBadConnType "updateNewConnSnd" $ connType c
where
@@ -427,8 +433,8 @@ createSndConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> NewSndQueue -> I
createSndConn db gVar cData q@SndQueue {server} =
-- check confirmed snd queue doesn't already exist, to prevent it being deleted by REPLACE in insertSndQueue_
ifM (liftIO $ checkConfirmedSndQueueExists_ db q) (pure $ Left SESndQueueExists) $
createConn_ gVar cData $ \connId -> do
serverKeyHash_ <- createServer_ db server
createConn_ db gVar cData $ \connId -> do
serverKeyHash_ <- createServer db server
createConnRecord db connId cData SCMInvitation
insertSndQueue_ db connId q serverKeyHash_
@@ -450,7 +456,11 @@ checkConfirmedSndQueueExists_ db SndQueue {server, sndId} =
maybeFirstRow' False fromOnlyBI $
DB.query
db
"SELECT 1 FROM snd_queues WHERE host = ? AND port = ? AND snd_id = ? AND status != ? LIMIT 1"
( "SELECT 1 FROM snd_queues WHERE host = ? AND port = ? AND snd_id = ? AND status != ? LIMIT 1"
#if defined(dpPostgres)
<> " FOR UPDATE"
#endif
)
(host server, port server, sndId, New)
getRcvConn :: DB.Connection -> SMPServer -> SMP.RecipientId -> IO (Either StoreError (RcvQueue, SomeConn))
@@ -489,14 +499,14 @@ deleteConn db waitDeliveryTimeout_ connId = case waitDeliveryTimeout_ of
upgradeRcvConnToDuplex :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue)
upgradeRcvConnToDuplex db connId sq =
getConn db connId $>>= \case
getConnForUpdate db connId $>>= \case
(SomeConn _ RcvConnection {}) -> Right <$> addConnSndQueue_ db connId sq
(SomeConn c _) -> pure . Left . SEBadConnType "upgradeRcvConnToDuplex" $ connType c
-- TODO [certs rcv] store clientServiceId from NewRcvQueue
upgradeSndConnToDuplex :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO (Either StoreError RcvQueue)
upgradeSndConnToDuplex db connId rq subMode =
getConn db connId >>= \case
getConnForUpdate db connId >>= \case
Right (SomeConn _ SndConnection {}) -> Right <$> addConnRcvQueue_ db connId rq subMode
Right (SomeConn c _) -> pure . Left . SEBadConnType "upgradeSndConnToDuplex" $ connType c
_ -> pure $ Left SEConnNotFound
@@ -504,26 +514,26 @@ upgradeSndConnToDuplex db connId rq subMode =
-- TODO [certs rcv] store clientServiceId from NewRcvQueue
addConnRcvQueue :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO (Either StoreError RcvQueue)
addConnRcvQueue db connId rq subMode =
getConn db connId >>= \case
getConnForUpdate db connId >>= \case
Right (SomeConn _ DuplexConnection {}) -> Right <$> addConnRcvQueue_ db connId rq subMode
Right (SomeConn c _) -> pure . Left . SEBadConnType "addConnRcvQueue" $ connType c
_ -> pure $ Left SEConnNotFound
addConnRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue
addConnRcvQueue_ db connId rq@RcvQueue {server} subMode = do
serverKeyHash_ <- createServer_ db server
serverKeyHash_ <- createServer db server
insertRcvQueue_ db connId rq subMode serverKeyHash_
addConnSndQueue :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue)
addConnSndQueue db connId sq =
getConn db connId >>= \case
getConnForUpdate db connId >>= \case
Right (SomeConn _ DuplexConnection {}) -> Right <$> addConnSndQueue_ db connId sq
Right (SomeConn c _) -> pure . Left . SEBadConnType "addConnSndQueue" $ connType c
_ -> pure $ Left SEConnNotFound
addConnSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> IO SndQueue
addConnSndQueue_ db connId sq@SndQueue {server} = do
serverKeyHash_ <- createServer_ db server
serverKeyHash_ <- createServer db server
insertSndQueue_ db connId sq serverKeyHash_
setRcvQueueStatus :: DB.Connection -> RcvQueue -> QueueStatus -> IO ()
@@ -670,7 +680,7 @@ smpConfirmation (senderKey, e2ePubKey, connInfo, smpReplyQueues_, smpClientVersi
createConfirmation :: DB.Connection -> TVar ChaChaDRG -> NewConfirmation -> IO (Either StoreError ConfirmationId)
createConfirmation db gVar NewConfirmation {connId, senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues, smpClientVersion}, ratchetState} =
createWithRandomId gVar $ \confirmationId ->
createWithRandomId db gVar $ \confirmationId ->
DB.execute
db
[sql|
@@ -742,7 +752,7 @@ removeConfirmations db connId =
createInvitation :: DB.Connection -> TVar ChaChaDRG -> NewInvitation -> IO (Either StoreError InvitationId)
createInvitation db gVar NewInvitation {contactConnId, connReq, recipientConnInfo} =
createWithRandomId gVar $ \invitationId ->
createWithRandomId db gVar $ \invitationId ->
DB.execute
db
[sql|
@@ -821,7 +831,7 @@ deleteInvShortLink db srv lnkId =
createInvShortLink :: DB.Connection -> InvShortLink -> IO ()
createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey, sndId} = do
serverKeyHash_ <- createServer_ db server
serverKeyHash_ <- createServer db server
DB.execute
db
[sql|
@@ -1049,7 +1059,14 @@ setMsgUserAck :: DB.Connection -> ConnId -> InternalId -> IO (Either StoreError
setMsgUserAck db connId agentMsgId = runExceptT $ do
(dbRcvId, srvMsgId) <-
ExceptT . firstRow id (SEMsgNotFound "setMsgUserAck") $
DB.query db "SELECT rcv_queue_id, broker_id FROM rcv_messages WHERE conn_id = ? AND internal_id = ?" (connId, agentMsgId)
DB.query
db
( "SELECT rcv_queue_id, broker_id FROM rcv_messages WHERE conn_id = ? AND internal_id = ?"
#if defined(dbPostgres)
<> " FOR UPDATE"
#endif
)
(connId, agentMsgId)
rq <- ExceptT $ getRcvQueueById db connId dbRcvId
liftIO $ DB.execute db "UPDATE rcv_messages SET user_ack = ? WHERE conn_id = ? AND internal_id = ?" (BI True, connId, agentMsgId)
pure (rq, srvMsgId)
@@ -1121,6 +1138,9 @@ deleteMsgContent db connId msgId = do
deleteDeliveredSndMsg :: DB.Connection -> ConnId -> InternalId -> IO ()
deleteDeliveredSndMsg db connId msgId = do
#if defined(dbPostgres)
_ :: [Only Int] <- DB.query db "SELECT 1 FROM messages WHERE conn_id = ? AND internal_id = ? FOR UPDATE" (connId, msgId)
#endif
cnt <- countPendingSndDeliveries_ db connId msgId
when (cnt == 0) $ deleteMsg db connId msgId
@@ -1139,11 +1159,15 @@ deleteSndMsgDelivery db connId SndQueue {dbQueueId} msgId keepForReceipt = do
maybeFirstRow id $
DB.query
db
[sql|
SELECT rcpt_status, snd_message_body_id FROM snd_messages
WHERE NOT EXISTS (SELECT 1 FROM snd_message_deliveries WHERE conn_id = ? AND internal_id = ? AND failed = 0)
AND conn_id = ? AND internal_id = ?
|]
( [sql|
SELECT rcpt_status, snd_message_body_id FROM snd_messages
WHERE NOT EXISTS (SELECT 1 FROM snd_message_deliveries WHERE conn_id = ? AND internal_id = ? AND failed = 0)
AND conn_id = ? AND internal_id = ?
|]
#if defined(dbPostgres)
<> " FOR UPDATE"
#endif
)
(connId, msgId, connId, msgId)
deleteMsgAndBody :: (Maybe MsgReceiptStatus, Maybe Int64) -> IO ()
deleteMsgAndBody (rcptStatus_, sndMsgBodyId_) = do
@@ -1152,9 +1176,11 @@ deleteSndMsgDelivery db connId SndQueue {dbQueueId} msgId keepForReceipt = do
Just MROk -> deleteMsg
_ -> if keepForReceipt then deleteMsgContent else deleteMsg
del db connId msgId
forM_ sndMsgBodyId_ $ \bodyId ->
-- Delete message body if it is not used by any snd message.
-- The current snd message is already deleted by deleteMsg or cleared by deleteMsgContent.
forM_ sndMsgBodyId_ $ \bodyId -> do
#if defined(dbPostgres)
-- lock for concurrent deletion of different records in snd_messages pointing to the same record in snd_message_bodies
_ :: [Only Int] <- DB.query db "SELECT 1 FROM snd_message_bodies WHERE snd_message_body_id = ? FOR UPDATE" (Only bodyId)
#endif
DB.execute
db
[sql|
@@ -1169,18 +1195,39 @@ countPendingSndDeliveries_ db connId msgId = do
(Only cnt : _) <- DB.query db "SELECT count(*) FROM snd_message_deliveries WHERE conn_id = ? AND internal_id = ? AND failed = 0" (connId, msgId)
pure cnt
deleteRcvMsgHashesExpired :: DB.Connection -> NominalDiffTime -> IO ()
deleteRcvMsgHashesExpired db ttl = do
cutoffTs <- addUTCTime (-ttl) <$> getCurrentTime
DB.execute db "DELETE FROM encrypted_rcv_message_hashes WHERE created_at < ?" (Only cutoffTs)
deleteSndMsgsExpired :: DB.Connection -> NominalDiffTime -> IO ()
deleteSndMsgsExpired db ttl = do
deleteRcvMsgHashesExpired :: DB.Connection -> NominalDiffTime -> Int -> IO ()
deleteRcvMsgHashesExpired db ttl limit = do
cutoffTs <- addUTCTime (-ttl) <$> getCurrentTime
DB.execute
db
"DELETE FROM messages WHERE internal_ts < ? AND internal_snd_id IS NOT NULL"
(Only cutoffTs)
[sql|
DELETE FROM encrypted_rcv_message_hashes
WHERE encrypted_rcv_message_hash_id IN (
SELECT encrypted_rcv_message_hash_id
FROM encrypted_rcv_message_hashes
WHERE created_at < ?
ORDER BY created_at ASC
LIMIT ?
)
|]
(cutoffTs, limit)
deleteSndMsgsExpired :: DB.Connection -> NominalDiffTime -> Int -> IO ()
deleteSndMsgsExpired db ttl limit = do
cutoffTs <- addUTCTime (-ttl) <$> getCurrentTime
DB.execute
db
[sql|
DELETE FROM messages
WHERE (conn_id, internal_id) IN (
SELECT conn_id, internal_id
FROM messages
WHERE internal_ts < ? AND internal_snd_id IS NOT NULL
ORDER BY internal_ts ASC
LIMIT ?
)
|]
(cutoffTs, limit)
createRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO ()
createRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem =
@@ -1261,9 +1308,25 @@ deleteRatchet :: DB.Connection -> ConnId -> IO ()
deleteRatchet db connId =
DB.execute db "DELETE FROM ratchets WHERE conn_id = ?" (Only connId)
getRatchetForUpdate :: DB.Connection -> ConnId -> IO (Either StoreError RatchetX448)
getRatchetForUpdate =
#if defined(dbPostgres)
getRatchet_ (ratchetQuery <> " FOR UPDATE")
#else
getRatchet_ ratchetQuery
#endif
{-# INLINE getRatchetForUpdate #-}
getRatchet :: DB.Connection -> ConnId -> IO (Either StoreError RatchetX448)
getRatchet db connId =
firstRow' ratchet SERatchetNotFound $ DB.query db "SELECT ratchet_state FROM ratchets WHERE conn_id = ?" (Only connId)
getRatchet = getRatchet_ ratchetQuery
{-# INLINE getRatchet #-}
ratchetQuery :: Query
ratchetQuery = "SELECT ratchet_state FROM ratchets WHERE conn_id = ?"
getRatchet_ :: Query -> DB.Connection -> ConnId -> IO (Either StoreError RatchetX448)
getRatchet_ q db connId =
firstRow' ratchet SERatchetNotFound $ DB.query db q (Only connId)
where
ratchet = maybe (Left SERatchetNotFound) Right . fromOnly
@@ -1428,7 +1491,7 @@ createNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer
INSERT INTO ntf_tokens
(provider, device_token, ntf_host, ntf_port, tkn_id, tkn_pub_key, tkn_priv_key, tkn_pub_dh_key, tkn_priv_dh_key, tkn_dh_secret, tkn_status, tkn_action, ntf_mode) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
|]
((provider, token, host, port, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode))
((provider, Binary token, host, port, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode))
getSavedNtfToken :: DB.Connection -> IO (Maybe NtfToken)
getSavedNtfToken db = do
@@ -1443,7 +1506,7 @@ getSavedNtfToken db = do
JOIN ntf_servers s USING (ntf_host, ntf_port)
|]
where
ntfToken ((host, port, keyHash) :. (provider, dt, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode_)) =
ntfToken ((host, port, keyHash) :. (provider, Binary dt, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode_)) =
let ntfServer = NtfServer host port keyHash
ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
ntfMode = fromMaybe NMPeriodic ntfMode_
@@ -1459,7 +1522,7 @@ updateNtfTokenRegistration db NtfToken {deviceToken = DeviceToken provider token
SET tkn_id = ?, tkn_dh_secret = ?, tkn_status = ?, tkn_action = ?, updated_at = ?
WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
|]
(tknId, ntfDhSecret, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)
(tknId, ntfDhSecret, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, Binary token, host, port)
updateDeviceToken :: DB.Connection -> NtfToken -> DeviceToken -> IO ()
updateDeviceToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} (DeviceToken toProvider toToken) = do
@@ -1471,7 +1534,7 @@ updateDeviceToken db NtfToken {deviceToken = DeviceToken provider token, ntfServ
SET provider = ?, device_token = ?, tkn_status = ?, tkn_action = ?, updated_at = ?
WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
|]
(toProvider, toToken, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)
(toProvider, Binary toToken, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, Binary token, host, port)
updateNtfMode :: DB.Connection -> NtfToken -> NotificationsMode -> IO ()
updateNtfMode db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} ntfMode = do
@@ -1483,7 +1546,7 @@ updateNtfMode db NtfToken {deviceToken = DeviceToken provider token, ntfServer =
SET ntf_mode = ?, updated_at = ?
WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
|]
(ntfMode, updatedAt, provider, token, host, port)
(ntfMode, updatedAt, provider, Binary token, host, port)
updateNtfToken :: DB.Connection -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> IO ()
updateNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknStatus tknAction = do
@@ -1495,7 +1558,7 @@ updateNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer
SET tkn_status = ?, tkn_action = ?, updated_at = ?
WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
|]
(tknStatus, tknAction, updatedAt, provider, token, host, port)
(tknStatus, tknAction, updatedAt, provider, Binary token, host, port)
removeNtfToken :: DB.Connection -> NtfToken -> IO ()
removeNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} =
@@ -1505,7 +1568,7 @@ removeNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer
DELETE FROM ntf_tokens
WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
|]
(provider, token, host, port)
(provider, Binary token, host, port)
addNtfTokenToDelete :: DB.Connection -> NtfServer -> C.APrivateAuthKey -> NtfTokenId -> IO ()
addNtfTokenToDelete db ProtocolServer {host, port, keyHash} ntfPrivKey tknId =
@@ -1819,7 +1882,7 @@ getActiveNtfToken db =
|]
(Only NTActive)
where
ntfToken ((host, port, keyHash) :. (provider, dt, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode_)) =
ntfToken ((host, port, keyHash) :. (provider, Binary dt, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode_)) =
let ntfServer = NtfServer host port keyHash
ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
ntfMode = fromMaybe NMPeriodic ntfMode_
@@ -1963,14 +2026,16 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
-- * Server helper
-- | Creates a new server, if it doesn't exist, and returns the passed key hash if it is different from stored.
createServer_ :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash)
createServer_ db newSrv@ProtocolServer {host, port, keyHash} =
getServerKeyHash_ db newSrv >>= \case
Right keyHash_ -> pure keyHash_
Left _ -> insertNewServer_ $> Nothing
createServer :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash)
createServer db newSrv@ProtocolServer {host, port, keyHash} = do
r <- insertNewServer_
if null r
then getServerKeyHash_ db newSrv >>= either E.throwIO pure
else pure Nothing
where
insertNewServer_ :: IO [Only Int]
insertNewServer_ =
DB.execute db "INSERT INTO servers (host, port, key_hash) VALUES (?,?,?)" (host, port, keyHash)
DB.query db "INSERT INTO servers (host, port, key_hash) VALUES (?,?,?) ON CONFLICT (host, port) DO NOTHING RETURNING 1" (host, port, keyHash)
-- | Returns the passed server key hash if it is different from the stored one, or the error if the server does not exist.
getServerKeyHash_ :: DB.Connection -> SMPServer -> IO (Either StoreError (Maybe C.KeyHash))
@@ -2147,12 +2212,12 @@ getSubscriptionServers db onlyNeeded =
toUserServer (userId, host, port, keyHash) = (userId, SMPServer host port keyHash)
getUserServerRcvQueueSubs :: DB.Connection -> UserId -> SMPServer -> Bool -> IO [RcvQueueSub]
getUserServerRcvQueueSubs db userId srv onlyNeeded =
getUserServerRcvQueueSubs db userId (SMPServer h p kh) onlyNeeded =
map toRcvQueueSub
<$> DB.query
db
(rcvQueueSubQuery <> toSubscribe <> " c.deleted = 0 AND q.deleted = 0 AND c.user_id = ? AND q.host = ? AND q.port = ?")
(userId, host srv, port srv)
(rcvQueueSubQuery <> toSubscribe <> " c.deleted = 0 AND q.deleted = 0 AND c.user_id = ? AND q.host = ? AND q.port = ? AND COALESCE(q.server_key_hash, s.key_hash) = ?")
(userId, h, p, kh)
where
toSubscribe
| onlyNeeded = " WHERE q.to_subscribe = 1 AND "
@@ -2167,23 +2232,27 @@ getConnIds :: DB.Connection -> IO [ConnId]
getConnIds db = map fromOnly <$> DB.query_ db "SELECT conn_id FROM connections WHERE deleted = 0"
getConn :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getConn = getAnyConn False
getConn = getAnyConn False False
{-# INLINE getConn #-}
getConnForUpdate :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getConnForUpdate = getAnyConn False True
{-# INLINE getConnForUpdate #-}
getDeletedConn :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getDeletedConn = getAnyConn True
getDeletedConn = getAnyConn True False
{-# INLINE getDeletedConn #-}
getAnyConn :: Bool -> DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getAnyConn :: Bool -> Bool -> DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getAnyConn = getAnyConn_ getRcvQueuesByConnId_ getSndQueuesByConnId_
{-# INLINE getAnyConn #-}
getAnyConn_ ::
(DB.Connection -> ConnId -> IO (Maybe (NonEmpty rq))) ->
(DB.Connection -> ConnId -> IO (Maybe (NonEmpty sq))) ->
(Bool -> DB.Connection -> ConnId -> IO (Either StoreError (SomeConn' rq sq)))
getAnyConn_ getRQs getSQs deleted' db connId =
getConnData deleted' db connId >>= \case
(Bool -> Bool -> DB.Connection -> ConnId -> IO (Either StoreError (SomeConn' rq sq)))
getAnyConn_ getRQs getSQs deleted' forUpdate db connId =
getConnData deleted' forUpdate db connId >>= \case
Just (cData, cMode) -> do
rQ <- getRQs db connId
sQ <- getSQs db connId
@@ -2282,28 +2351,39 @@ getAnyConns_ ::
(DB.Connection -> ConnId -> IO (Maybe (NonEmpty rq))) ->
(DB.Connection -> ConnId -> IO (Maybe (NonEmpty sq))) ->
(Bool -> DB.Connection -> [ConnId] -> IO [Either StoreError (SomeConn' rq sq)])
getAnyConns_ getRQs getSQs deleted' db connIds = forM connIds $ E.handle handleDBError . getAnyConn_ getRQs getSQs deleted' db
getAnyConns_ getRQs getSQs deleted' db connIds = forM connIds $ E.handle handleDBError . getAnyConn_ getRQs getSQs deleted' False db
getConnsData :: DB.Connection -> [ConnId] -> IO [Either StoreError (Maybe (ConnData, ConnectionMode))]
getConnsData db connIds = forM connIds $ E.handle handleDBError . fmap Right . getConnData False db
getConnsData db connIds = forM connIds $ E.handle handleDBError . fmap Right . getConnData False False db
handleDBError :: E.SomeException -> IO (Either StoreError a)
handleDBError = pure . Left . SEInternal . bshow
#endif
getConnData :: Bool -> DB.Connection -> ConnId -> IO (Maybe (ConnData, ConnectionMode))
getConnData deleted' db connId' =
getConnData :: Bool -> Bool -> DB.Connection -> ConnId -> IO (Maybe (ConnData, ConnectionMode))
getConnData deleted' forUpdate db connId' =
maybeFirstRow rowToConnData $
DB.query
db
[sql|
SELECT user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs,
last_external_snd_msg_id, deleted, ratchet_sync_state, pq_support
FROM connections
WHERE conn_id = ? AND deleted = ?
|]
( [sql|
SELECT user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs,
last_external_snd_msg_id, deleted, ratchet_sync_state, pq_support
FROM connections
WHERE conn_id = ? AND deleted = ?
|]
#if defined(dbPostgres)
<> (if forUpdate then " FOR UPDATE" else "")
#endif
)
(connId', BI deleted')
lockConnForUpdate :: DB.Connection -> ConnId -> IO ()
lockConnForUpdate db connId = do
#if defined(dbPostgres)
_ :: [Only Int] <- DB.query db "SELECT 1 FROM connections WHERE conn_id = ? FOR UPDATE" (Only connId)
#endif
pure ()
rowToConnData :: (UserId, ConnId, ConnectionMode, VersionSMPA, Maybe BoolInt, PrevExternalSndId, BoolInt, RatchetSyncState, PQSupport) -> (ConnData, ConnectionMode)
rowToConnData (userId, connId, cMode, connAgentVersion, enableNtfs_, lastExternalSndId, BI deleted, ratchetSyncState, pqSupport) =
(ConnData {userId, connId, connAgentVersion, enableNtfs = maybe True unBI enableNtfs_, lastExternalSndId, deleted, ratchetSyncState, pqSupport}, cMode)
@@ -2328,6 +2408,10 @@ setConnPQSupport :: DB.Connection -> ConnId -> PQSupport -> IO ()
setConnPQSupport db connId pqSupport =
DB.execute db "UPDATE connections SET pq_support = ? WHERE conn_id = ?" (pqSupport, connId)
updateNewConnJoin :: DB.Connection -> ConnId -> VersionSMPA -> PQSupport -> Bool -> IO ()
updateNewConnJoin db connId aVersion pqSupport enableNtfs =
DB.execute db "UPDATE connections SET smp_agent_version = ?, pq_support = ?, enable_ntfs = ? WHERE conn_id = ?" (aVersion, pqSupport, BI enableNtfs, connId)
getDeletedConnIds :: DB.Connection -> IO [ConnId]
getDeletedConnIds db = map fromOnly <$> DB.query db "SELECT conn_id FROM connections WHERE deleted = ?" (Only (BI True))
@@ -2348,13 +2432,29 @@ checkRatchetKeyHashExists db connId hash =
maybeFirstRow' False fromOnlyBI $
DB.query
db
"SELECT 1 FROM processed_ratchet_key_hashes WHERE conn_id = ? AND hash = ? LIMIT 1"
( "SELECT 1 FROM processed_ratchet_key_hashes WHERE conn_id = ? AND hash = ? LIMIT 1"
#if defined(dbPostgres)
<> " FOR UPDATE"
#endif
)
(connId, Binary hash)
deleteRatchetKeyHashesExpired :: DB.Connection -> NominalDiffTime -> IO ()
deleteRatchetKeyHashesExpired db ttl = do
deleteRatchetKeyHashesExpired :: DB.Connection -> NominalDiffTime -> Int -> IO ()
deleteRatchetKeyHashesExpired db ttl limit = do
cutoffTs <- addUTCTime (-ttl) <$> getCurrentTime
DB.execute db "DELETE FROM processed_ratchet_key_hashes WHERE created_at < ?" (Only cutoffTs)
DB.execute
db
[sql|
DELETE FROM processed_ratchet_key_hashes
WHERE processed_ratchet_key_hash_id IN (
SELECT processed_ratchet_key_hash_id
FROM processed_ratchet_key_hashes
WHERE created_at < ?
ORDER BY created_at ASC
LIMIT ?
)
|]
(cutoffTs, limit)
-- | returns all connection queues, the first queue is the primary one
getRcvQueuesByConnId_ :: DB.Connection -> ConnId -> IO (Maybe (NonEmpty RcvQueue))
@@ -2397,7 +2497,7 @@ toRcvQueue
(Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
_ -> Nothing
shortLink = case (shortLinkId_, shortLinkKey_, linkPrivSigKey_, linkEncFixedData_) of
(Just shortLinkId, Just shortLinkKey, Just linkPrivSigKey, Just linkEncFixedData) -> Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData}
(Just shortLinkId, Just shortLinkKey, Just linkPrivSigKey, Just linkEncFixedData) -> Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkRootSigKey = Nothing, linkEncFixedData} -- TODO linkRootSigKey should be stored in a separate field
_ -> Nothing
enableNtfs = maybe True unBI enableNtfs_
-- TODO [certs rcv] read client service
@@ -2472,11 +2572,15 @@ retrieveLastIdsAndHashRcv_ dbConn connId = do
[(lastInternalId, lastInternalRcvId, lastExternalSndId, lastRcvHash)] <-
DB.query
dbConn
[sql|
SELECT last_internal_msg_id, last_internal_rcv_msg_id, last_external_snd_msg_id, last_rcv_msg_hash
FROM connections
WHERE conn_id = ?
|]
( [sql|
SELECT last_internal_msg_id, last_internal_rcv_msg_id, last_external_snd_msg_id, last_rcv_msg_hash
FROM connections
WHERE conn_id = ?
|]
#if defined(dbPostgres)
<> " FOR UPDATE"
#endif
)
(Only connId)
return (lastInternalId, lastInternalRcvId, lastExternalSndId, lastRcvHash)
@@ -2543,11 +2647,15 @@ retrieveLastIdsAndHashSnd_ dbConn connId = do
firstRow id SEConnNotFound $
DB.query
dbConn
[sql|
SELECT last_internal_msg_id, last_internal_snd_msg_id, last_snd_msg_hash
FROM connections
WHERE conn_id = ?
|]
( [sql|
SELECT last_internal_msg_id, last_internal_snd_msg_id, last_snd_msg_hash
FROM connections
WHERE conn_id = ?
|]
#if defined(dbPostgres)
<> " FOR UPDATE"
#endif
)
(Only connId)
updateLastIdsSnd_ :: DB.Connection -> ConnId -> InternalId -> InternalSndId -> IO ()
@@ -2606,17 +2714,17 @@ updateSndMsgHash db connId internalSndId internalHash =
(Binary internalHash, connId, internalSndId)
-- create record with a random ID
createWithRandomId :: TVar ChaChaDRG -> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
createWithRandomId gVar create = fst <$$> createWithRandomId' gVar create
createWithRandomId :: DB.Connection -> TVar ChaChaDRG -> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
createWithRandomId db gVar create = fst <$$> createWithRandomId' db gVar create
createWithRandomId' :: forall a. TVar ChaChaDRG -> (ByteString -> IO a) -> IO (Either StoreError (ByteString, a))
createWithRandomId' gVar create = tryCreate 3
createWithRandomId' :: forall a. DB.Connection -> TVar ChaChaDRG -> (ByteString -> IO a) -> IO (Either StoreError (ByteString, a))
createWithRandomId' db gVar create = tryCreate 3
where
tryCreate :: Int -> IO (Either StoreError (ByteString, a))
tryCreate 0 = pure $ Left SEUniqueID
tryCreate n = do
id' <- randomId gVar 12
E.try (create id') >>= \case
withSavepoint db "create_random_id" (create id') >>= \case
Right r -> pure $ Right (id', r)
Left e -> handleErr n e
#if defined(dbPostgres)
@@ -2637,19 +2745,19 @@ ntfSubAndSMPAction (NSANtf action) = (Just action, Nothing)
ntfSubAndSMPAction (NSASMP action) = (Nothing, Just action)
createXFTPServer_ :: DB.Connection -> XFTPServer -> IO Int64
createXFTPServer_ db newSrv@ProtocolServer {host, port, keyHash} =
getXFTPServerId_ db newSrv >>= \case
Right srvId -> pure srvId
Left _ -> insertNewServer_
where
insertNewServer_ = do
DB.execute db "INSERT INTO xftp_servers (xftp_host, xftp_port, xftp_key_hash) VALUES (?,?,?)" (host, port, keyHash)
insertedRowId db
getXFTPServerId_ :: DB.Connection -> XFTPServer -> IO (Either StoreError Int64)
getXFTPServerId_ db ProtocolServer {host, port, keyHash} = do
firstRow fromOnly SEXFTPServerNotFound $
DB.query db "SELECT xftp_server_id FROM xftp_servers WHERE xftp_host = ? AND xftp_port = ? AND xftp_key_hash = ?" (host, port, keyHash)
createXFTPServer_ db ProtocolServer {host, port, keyHash} = do
Only serverId : _ <-
DB.query
db
[sql|
INSERT INTO xftp_servers (xftp_host, xftp_port, xftp_key_hash)
VALUES (?, ?, ?)
ON CONFLICT (xftp_host, xftp_port, xftp_key_hash)
DO UPDATE SET xftp_host = EXCLUDED.xftp_host
RETURNING xftp_server_id
|]
(host, port, keyHash)
pure serverId
createRcvFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath file approvedRelays = runExceptT $ do
@@ -2690,7 +2798,7 @@ insertRcvFile db gVar userId FileDescription {size, digest, key, nonce, chunkSiz
Just RedirectFileInfo {digest = d, size = s} -> (Just d, Just s)
Nothing -> (Nothing, Nothing)
rcvFileEntityId <- ExceptT $
createWithRandomId gVar $ \rcvFileEntityId ->
createWithRandomId db gVar $ \rcvFileEntityId ->
DB.execute
db
"INSERT INTO rcv_files (rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status, redirect_id, redirect_entity_id, redirect_digest, redirect_size, approved_relays) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
@@ -2729,6 +2837,13 @@ getRcvFileRedirects db rcvFileId = do
redirects <- fromOnly <$$> DB.query db "SELECT rcv_file_id FROM rcv_files WHERE redirect_id = ?" (Only rcvFileId)
fmap catMaybes . forM redirects $ getRcvFile db >=> either (const $ pure Nothing) (pure . Just)
lockRcvFileForUpdate :: DB.Connection -> DBRcvFileId -> IO ()
lockRcvFileForUpdate db rcvFileId = do
#if defined(dbPostgres)
_ :: [Only Int] <- DB.query db "SELECT 1 FROM rcv_files WHERE rcv_file_id = ? FOR UPDATE" (Only rcvFileId)
#endif
pure ()
getRcvFile :: DB.Connection -> DBRcvFileId -> IO (Either StoreError RcvFile)
getRcvFile db rcvFileId = runExceptT $ do
f@RcvFile {rcvFileEntityId, userId, tmpPath} <- ExceptT getFile
@@ -2740,11 +2855,15 @@ getRcvFile db rcvFileId = runExceptT $ do
firstRow toFile SEFileNotFound $
DB.query
db
[sql|
SELECT rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status, deleted, redirect_id, redirect_entity_id, redirect_size, redirect_digest
FROM rcv_files
WHERE rcv_file_id = ?
|]
( [sql|
SELECT rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status, deleted, redirect_id, redirect_entity_id, redirect_size, redirect_digest
FROM rcv_files
WHERE rcv_file_id = ?
|]
#if defined(dbPostgres)
<> " FOR UPDATE"
#endif
)
(Only rcvFileId)
where
toFile :: (RcvFileId, UserId, FileSize Int64, FileDigest, C.SbKey, C.CbNonce, FileSize Word32, FilePath, Maybe FilePath) :. (FilePath, Maybe C.SbKey, Maybe C.CbNonce, RcvFileStatus, BoolInt, Maybe DBRcvFileId, Maybe RcvFileId, Maybe (FileSize Int64), Maybe FileDigest) -> RcvFile
@@ -2984,7 +3103,7 @@ getRcvFilesExpired db ttl = do
createSndFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> CryptoFile -> Int -> FilePath -> C.SbKey -> C.CbNonce -> Maybe RedirectFileInfo -> IO (Either StoreError SndFileId)
createSndFile db gVar userId (CryptoFile path cfArgs) numRecipients prefixPath key nonce redirect_ =
createWithRandomId gVar $ \sndFileEntityId ->
createWithRandomId db gVar $ \sndFileEntityId ->
DB.execute
db
"INSERT INTO snd_files (snd_file_entity_id, user_id, path, src_file_key, src_file_nonce, num_recipients, prefix_path, key, nonce, status, redirect_size, redirect_digest) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)"
@@ -3005,6 +3124,13 @@ getSndFileIdByEntityId_ db sndFileEntityId =
firstRow fromOnly SEFileNotFound $
DB.query db "SELECT snd_file_id FROM snd_files WHERE snd_file_entity_id = ?" (Only (Binary sndFileEntityId))
lockSndFileForUpdate :: DB.Connection -> DBSndFileId -> IO ()
lockSndFileForUpdate db sndFileId = do
#if defined(dbPostgres)
_ :: [Only Int] <- DB.query db "SELECT 1 FROM snd_files WHERE snd_file_id = ? FOR UPDATE" (Only sndFileId)
#endif
pure ()
getSndFile :: DB.Connection -> DBSndFileId -> IO (Either StoreError SndFile)
getSndFile db sndFileId = runExceptT $ do
f@SndFile {sndFileEntityId, userId, numRecipients, prefixPath} <- ExceptT getFile
@@ -3016,11 +3142,15 @@ getSndFile db sndFileId = runExceptT $ do
firstRow toFile SEFileNotFound $
DB.query
db
[sql|
SELECT snd_file_entity_id, user_id, path, src_file_key, src_file_nonce, num_recipients, digest, prefix_path, key, nonce, status, deleted, redirect_size, redirect_digest
FROM snd_files
WHERE snd_file_id = ?
|]
( [sql|
SELECT snd_file_entity_id, user_id, path, src_file_key, src_file_nonce, num_recipients, digest, prefix_path, key, nonce, status, deleted, redirect_size, redirect_digest
FROM snd_files
WHERE snd_file_id = ?
|]
#if defined(dbPostgres)
<> " FOR UPDATE"
#endif
)
(Only sndFileId)
where
toFile :: (SndFileId, UserId, FilePath, Maybe C.SbKey, Maybe C.CbNonce, Int, Maybe FileDigest, Maybe FilePath, C.SbKey, C.CbNonce) :. (SndFileStatus, BoolInt, Maybe (FileSize Int64), Maybe FileDigest) -> SndFile
@@ -15,13 +15,17 @@ module Simplex.Messaging.Agent.Store.Postgres.Common
withTransaction,
withTransaction',
withTransactionPriority,
withSavepoint,
)
where
import Control.Monad (void)
import Control.Concurrent.MVar
import Control.Concurrent.STM
import qualified Control.Exception as E
import Data.Bitraversable (bimapM)
import Data.ByteString (ByteString)
import Data.Functor (($>))
import qualified Database.PostgreSQL.Simple as PSQL
import Numeric.Natural (Natural)
import Simplex.Messaging.Agent.Store.Postgres.Options
@@ -91,3 +95,14 @@ withTransactionPriority :: DBStore -> Bool -> (PSQL.Connection -> IO a) -> IO a
withTransactionPriority st priority action = withConnectionPriority st priority transaction
where
transaction conn = PSQL.withTransaction conn $ action conn
-- Execute an action within a savepoint.
-- On success, releases the savepoint. On error, rolls back to the savepoint
-- to restore the transaction to a usable state before returning the error.
withSavepoint :: PSQL.Connection -> PSQL.Query -> IO a -> IO (Either PSQL.SqlError a)
withSavepoint db name action = do
void $ PSQL.execute_ db $ "SAVEPOINT " <> name
E.try action
>>= bimapM
(PSQL.execute_ db ("ROLLBACK TO SAVEPOINT " <> name) $>)
(PSQL.execute_ db ("RELEASE SAVEPOINT " <> name) $>)
@@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Simplex.Messaging.Agent.Store.Postgres.DB
@@ -6,33 +7,39 @@ module Simplex.Messaging.Agent.Store.Postgres.DB
PSQL.Connection,
FromField (..),
ToField (..),
SQLError,
PSQL.connect,
PSQL.close,
execute,
execute_,
executeMany,
PSQL.query,
PSQL.query_,
query,
query_,
blobFieldDecoder,
fromTextField_,
)
where
import qualified Control.Exception as E
import Control.Monad (void)
import qualified Data.ByteString as B
import Data.ByteString.Char8 (ByteString)
import Data.Int (Int64)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import Data.Typeable (Typeable)
import Data.Word (Word16, Word32)
import Database.PostgreSQL.Simple (ResultError (..))
import Database.PostgreSQL.Simple (Connection, ResultError (..), SqlError (..), FromRow, ToRow)
import qualified Database.PostgreSQL.Simple as PSQL
import Database.PostgreSQL.Simple.FromField (Field (..), FieldParser, FromField (..), returnError)
import Database.PostgreSQL.Simple.ToField (ToField (..))
import Database.PostgreSQL.Simple.TypeInfo.Static (textOid, varcharOid)
import Database.PostgreSQL.Simple.Types (Query (..))
newtype BoolInt = BI {unBI :: Bool}
type SQLError = SqlError
instance FromField BoolInt where
fromField field dat = BI . (/= (0 :: Int)) <$> fromField field dat
{-# INLINE fromField #-}
@@ -41,18 +48,30 @@ instance ToField BoolInt where
toField (BI b) = toField ((if b then 1 else 0) :: Int)
{-# INLINE toField #-}
execute :: PSQL.ToRow q => PSQL.Connection -> PSQL.Query -> q -> IO ()
execute db q qs = void $ PSQL.execute db q qs
execute :: ToRow q => PSQL.Connection -> Query -> q -> IO ()
execute db q qs = void $ PSQL.execute db q qs `E.catch` addSql q
{-# INLINE execute #-}
execute_ :: PSQL.Connection -> PSQL.Query -> IO ()
execute_ db q = void $ PSQL.execute_ db q
execute_ :: PSQL.Connection -> Query -> IO ()
execute_ db q = void $ PSQL.execute_ db q `E.catch` addSql q
{-# INLINE execute_ #-}
executeMany :: PSQL.ToRow q => PSQL.Connection -> PSQL.Query -> [q] -> IO ()
executeMany db q qs = void $ PSQL.executeMany db q qs
executeMany :: ToRow q => PSQL.Connection -> Query -> [q] -> IO ()
executeMany db q qs = void $ PSQL.executeMany db q qs `E.catch` addSql q
{-# INLINE executeMany #-}
query :: (ToRow q, FromRow r) => PSQL.Connection -> Query -> q -> IO [r]
query db q qs = PSQL.query db q qs `E.catch` addSql q
{-# INLINE query #-}
query_ :: FromRow r => Connection -> Query -> IO [r]
query_ db q = PSQL.query_ db q `E.catch` addSql q
{-# INLINE query_ #-}
addSql :: Query -> SqlError -> IO r
addSql q e@SqlError {sqlErrorHint = hint} =
E.throwIO e {sqlErrorHint = if B.null hint then fromQuery q else hint <> ", " <> fromQuery q}
-- orphan instances
-- used in FileSize
@@ -10,6 +10,7 @@ import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251009_queue_to_subscribe
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251010_client_notices
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251230_strict_tables
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
@@ -19,7 +20,8 @@ schemaMigrations =
("20250322_short_links", m20250322_short_links, Just down_m20250322_short_links),
("20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete),
("20251009_queue_to_subscribe", m20251009_queue_to_subscribe, Just down_m20251009_queue_to_subscribe),
("20251010_client_notices", m20251010_client_notices, Just down_m20251010_client_notices)
("20251010_client_notices", m20251010_client_notices, Just down_m20251010_client_notices),
("20251230_strict_tables", m20251230_strict_tables, Just down_m20251230_strict_tables)
]
-- | The list of migrations in ascending order by date
@@ -0,0 +1,66 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251230_strict_tables where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20251230_strict_tables :: Text
m20251230_strict_tables =
isValidText
<> [r|
DELETE FROM ntf_tokens
WHERE NOT simplex_is_valid_text(ntf_mode);
ALTER TABLE ntf_tokens
ALTER COLUMN device_token TYPE BYTEA USING device_token::BYTEA,
ALTER COLUMN ntf_mode TYPE TEXT USING ntf_mode::TEXT;
UPDATE ntf_subscriptions
SET ntf_sub_action = NULL
WHERE NOT simplex_is_valid_text(ntf_sub_action);
UPDATE ntf_subscriptions
SET ntf_sub_smp_action = NULL
WHERE NOT simplex_is_valid_text(ntf_sub_smp_action);
ALTER TABLE ntf_subscriptions
ALTER COLUMN ntf_sub_action TYPE TEXT USING ntf_sub_action::TEXT,
ALTER COLUMN ntf_sub_smp_action TYPE TEXT USING ntf_sub_smp_action::TEXT;
DROP FUNCTION simplex_is_valid_text(BYTEA);
|]
down_m20251230_strict_tables :: Text
down_m20251230_strict_tables =
isValidText
<> [r|
DELETE FROM ntf_tokens
WHERE NOT simplex_is_valid_text(device_token);
ALTER TABLE ntf_tokens
ALTER COLUMN device_token TYPE TEXT USING device_token::TEXT,
ALTER COLUMN ntf_mode TYPE BYTEA USING ntf_mode::BYTEA;
ALTER TABLE ntf_subscriptions
ALTER COLUMN ntf_sub_action TYPE BYTEA USING ntf_sub_action::BYTEA,
ALTER COLUMN ntf_sub_smp_action TYPE BYTEA USING ntf_sub_smp_action::BYTEA;
DROP FUNCTION simplex_is_valid_text(BYTEA);
|]
isValidText :: Text
isValidText =
[r|
CREATE FUNCTION simplex_is_valid_text(b BYTEA)
RETURNS BOOLEAN
LANGUAGE plpgsql AS $$
BEGIN
PERFORM b::TEXT;
RETURN TRUE;
EXCEPTION
WHEN OTHERS THEN RETURN FALSE;
END;
$$;
|]
+23 -16
View File
@@ -42,6 +42,9 @@ module Simplex.Messaging.Agent.Store.SQLite
)
where
import Control.Concurrent.MVar
import Control.Concurrent.STM
import Control.Exception (bracketOnError, onException, throwIO)
import Control.Monad
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
@@ -58,21 +61,19 @@ import Simplex.Messaging.Agent.Store.Migrations (DBMigrate (..), sharedMigrateSc
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
import Simplex.Messaging.Agent.Store.SQLite.Common
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.SQLite.Util
import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationError (..))
import Simplex.Messaging.Util (ifM, safeDecodeUtf8)
import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
import System.FilePath (takeDirectory, takeFileName, (</>))
import UnliftIO.Exception (bracketOnError, onException)
import UnliftIO.MVar
import UnliftIO.STM
-- * SQLite Store implementation
createDBStore :: DBOpts -> [Migration] -> MigrationConfig -> IO (Either MigrationError DBStore)
createDBStore opts@DBOpts {dbFilePath, dbKey, keepKey, track} migrations migrationConfig = do
createDBStore opts@DBOpts {dbFilePath} migrations migrationConfig = do
let dbDir = takeDirectory dbFilePath
createDirectoryIfMissing True dbDir
st <- connectSQLiteStore dbFilePath dbKey keepKey track
st <- connectSQLiteStore opts
r <- migrateDBSchema st opts Nothing migrations migrationConfig `onException` closeDBStore st
case r of
Right () -> pure $ Right st
@@ -91,27 +92,26 @@ migrateDBSchema st DBOpts {dbFilePath, vacuum} migrationsTable migrations Migrat
dbm = DBMigrate {initialize, getCurrent, run, backup}
in sharedMigrateSchema dbm (dbNew st) migrations confirm
connectSQLiteStore :: FilePath -> ScrubbedBytes -> Bool -> DB.TrackQueries -> IO DBStore
connectSQLiteStore dbFilePath key keepKey track = do
connectSQLiteStore :: DBOpts -> IO DBStore
connectSQLiteStore DBOpts {dbFilePath, dbFunctions, dbKey = key, keepKey, track} = do
dbNew <- not <$> doesFileExist dbFilePath
dbConn <- dbBusyLoop (connectDB dbFilePath key track)
dbConn <- dbBusyLoop $ connectDB dbFilePath dbFunctions key track
dbConnection <- newMVar dbConn
dbKey <- newTVarIO $! storeKey key keepKey
dbClosed <- newTVarIO False
dbSem <- newTVarIO 0
pure DBStore {dbFilePath, dbKey, dbSem, dbConnection, dbNew, dbClosed}
pure DBStore {dbFilePath, dbFunctions, dbKey, dbSem, dbConnection, dbNew, dbClosed}
connectDB :: FilePath -> ScrubbedBytes -> DB.TrackQueries -> IO DB.Connection
connectDB path key track = do
connectDB :: FilePath -> [SQLiteFuncDef] -> ScrubbedBytes -> DB.TrackQueries -> IO DB.Connection
connectDB path functions key track = do
db <- DB.open path track
prepare db `onException` DB.close db
-- _printPragmas db path
pure db
where
prepare db = do
let exec = SQLite3.exec $ SQL.connectionHandle $ DB.conn db
unless (BA.null key) . exec $ "PRAGMA key = " <> keyString key <> ";"
exec . fromQuery $
unless (BA.null key) . SQLite3.exec db' $ "PRAGMA key = " <> keyString key <> ";"
SQLite3.exec db' . fromQuery $
[sql|
PRAGMA busy_timeout = 100;
PRAGMA foreign_keys = ON;
@@ -119,6 +119,13 @@ connectDB path key track = do
PRAGMA secure_delete = ON;
PRAGMA auto_vacuum = FULL;
|]
mapM_ addFunction functions
where
db' = SQL.connectionHandle $ DB.conn db
addFunction SQLiteFuncDef {funcName, argCount, funcPtrs} =
either (throwIO . userError . show) pure =<< case funcPtrs of
SQLiteFuncPtr isDet funcPtr -> createStaticFunction db' funcName argCount isDet funcPtr
SQLiteAggrPtrs stepPtr finalPtr -> createStaticAggregate db' funcName argCount stepPtr finalPtr
closeDBStore :: DBStore -> IO ()
closeDBStore st@DBStore {dbClosed} =
@@ -132,12 +139,12 @@ openSQLiteStore st@DBStore {dbClosed} key keepKey =
ifM (readTVarIO dbClosed) (openSQLiteStore_ st key keepKey) (putStrLn "openSQLiteStore: already opened")
openSQLiteStore_ :: DBStore -> ScrubbedBytes -> Bool -> IO ()
openSQLiteStore_ DBStore {dbConnection, dbFilePath, dbKey, dbClosed} key keepKey =
openSQLiteStore_ DBStore {dbConnection, dbFilePath, dbFunctions, dbKey, dbClosed} key keepKey =
bracketOnError
(takeMVar dbConnection)
(tryPutMVar dbConnection)
$ \DB.Connection {slow, track} -> do
DB.Connection {conn} <- connectDB dbFilePath key track
DB.Connection {conn} <- connectDB dbFilePath dbFunctions key track
atomically $ do
writeTVar dbClosed False
writeTVar dbKey $! storeKey key keepKey
@@ -6,11 +6,14 @@
module Simplex.Messaging.Agent.Store.SQLite.Common
( DBStore (..),
DBOpts (..),
SQLiteFuncDef (..),
SQLiteFuncPtrs (..),
withConnection,
withConnection',
withTransaction,
withTransaction',
withTransactionPriority,
withSavepoint,
dbBusyLoop,
storeKey,
)
@@ -20,9 +23,13 @@ import Control.Concurrent (threadDelay)
import Control.Concurrent.STM (retry)
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
import Data.ByteString (ByteString)
import Database.SQLite.Simple (SQLError)
import qualified Database.SQLite.Simple as SQL
import Database.SQLite3.Bindings
import Foreign.Ptr
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.SQLite.Util
import Simplex.Messaging.Util (ifM, unlessM)
import qualified UnliftIO.Exception as E
import UnliftIO.MVar
@@ -33,6 +40,7 @@ storeKey key keepKey = if keepKey || BA.null key then Just key else Nothing
data DBStore = DBStore
{ dbFilePath :: FilePath,
dbFunctions :: [SQLiteFuncDef],
dbKey :: TVar (Maybe ScrubbedBytes),
dbSem :: TVar Int,
dbConnection :: MVar DB.Connection,
@@ -42,12 +50,25 @@ data DBStore = DBStore
data DBOpts = DBOpts
{ dbFilePath :: FilePath,
dbFunctions :: [SQLiteFuncDef],
dbKey :: ScrubbedBytes,
keepKey :: Bool,
vacuum :: Bool,
track :: DB.TrackQueries
}
-- e.g. `SQLiteFuncDef "func_name" 2 (SQLiteFuncPtr True func)`
-- or `SQLiteFuncDef "aggr_name" 3 (SQLiteAggrPtrs step final)`
data SQLiteFuncDef = SQLiteFuncDef
{ funcName :: ByteString,
argCount :: CArgCount,
funcPtrs :: SQLiteFuncPtrs
}
data SQLiteFuncPtrs
= SQLiteFuncPtr {deterministic :: Bool, funcPtr :: FunPtr SQLiteFunc}
| SQLiteAggrPtrs {stepPtr :: FunPtr SQLiteFunc, finalPtr :: FunPtr SQLiteFuncFinal}
withConnectionPriority :: DBStore -> Bool -> (DB.Connection -> IO a) -> IO a
withConnectionPriority DBStore {dbSem, dbConnection} priority action
| priority = E.bracket_ signal release $ withMVar dbConnection action
@@ -77,6 +98,12 @@ withTransactionPriority st priority action = withConnectionPriority st priority
where
transaction db@DB.Connection {conn} = SQL.withImmediateTransaction conn $ action db
-- No-op for SQLite, just tries the action.
-- This provides a consistent interface with the PostgreSQL version.
withSavepoint :: DB.Connection -> SQL.Query -> IO a -> IO (Either SQLError a)
withSavepoint _ _ = E.try
{-# INLINE withSavepoint #-}
dbBusyLoop :: forall a. IO a -> IO a
dbBusyLoop action = loop 500 3000000
where
@@ -14,6 +14,7 @@ module Simplex.Messaging.Agent.Store.SQLite.DB
TrackQueries (..),
FromField (..),
ToField (..),
SQLError,
open,
close,
execute,
@@ -38,7 +39,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (diffUTCTime, getCurrentTime)
import Data.Typeable (Typeable)
import Database.SQLite.Simple (FromRow, ResultError (..), Query, SQLData (..), ToRow)
import Database.SQLite.Simple (FromRow, ResultError (..), Query, SQLData (..), SQLError, ToRow)
import qualified Database.SQLite.Simple as SQL
import Database.SQLite.Simple.FromField (FieldParser, FromField (..), returnError)
import Database.SQLite.Simple.Internal (Field (..))
@@ -46,6 +46,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251009_queue_to_subscribe
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251010_client_notices
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251230_strict_tables
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -91,7 +92,8 @@ schemaMigrations =
("m20250322_short_links", m20250322_short_links, Just down_m20250322_short_links),
("m20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete),
("m20251009_queue_to_subscribe", m20251009_queue_to_subscribe, Just down_m20251009_queue_to_subscribe),
("m20251010_client_notices", m20251010_client_notices, Just down_m20251010_client_notices)
("m20251010_client_notices", m20251010_client_notices, Just down_m20251010_client_notices),
("m20251230_strict_tables", m20251230_strict_tables, Just down_m20251230_strict_tables)
]
-- | The list of migrations in ascending order by date
@@ -19,7 +19,7 @@ CREATE TABLE ntf_servers (
CREATE TABLE ntf_tokens (
provider TEXT NOT NULL, -- apns
device_token TEXT NOT NULL, -- ! this field is mislabeled and is actually saved as binary
device_token TEXT NOT NULL,
ntf_host TEXT NOT NULL,
ntf_port TEXT NOT NULL,
tkn_id BLOB, -- token ID assigned by notifications server
@@ -17,7 +17,7 @@ UPDATE sqlite_master
SET sql = replace(sql, 'sender_key BLOB NOT NULL,', 'sender_key BLOB,')
WHERE name = 'conn_confirmations' AND type = 'table';
PRAGMA writable_schema=0;
PRAGMA writable_schema=RESET;
|]
down_m20240624_snd_secure :: Query
@@ -32,5 +32,5 @@ UPDATE sqlite_master
SET sql = replace(sql, 'sender_key BLOB,', 'sender_key BLOB NOT NULL,')
WHERE name = 'conn_confirmations' AND type = 'table';
PRAGMA writable_schema=0;
PRAGMA writable_schema=RESET;
|]
@@ -18,7 +18,7 @@ SET sql = replace(
)
WHERE name = 'conn_invitations' AND type = 'table';
PRAGMA writable_schema=0;
PRAGMA writable_schema=RESET;
|]
down_m20250702_conn_invitations_remove_cascade_delete :: Query
@@ -34,5 +34,5 @@ SET sql = replace(
)
WHERE name = 'conn_invitations' AND type = 'table';
PRAGMA writable_schema=0;
PRAGMA writable_schema=RESET;
|]
@@ -0,0 +1,58 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251230_strict_tables where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20251230_strict_tables :: Query
m20251230_strict_tables =
[sql|
UPDATE ntf_tokens SET ntf_mode = CAST(ntf_mode as TEXT);
UPDATE ntf_subscriptions
SET ntf_sub_action = CAST(ntf_sub_action as TEXT),
ntf_sub_smp_action = CAST(ntf_sub_smp_action as TEXT);
PRAGMA writable_schema=1;
UPDATE sqlite_master
SET sql = CASE
WHEN LOWER(SUBSTR(sql, -15)) = ') without rowid' THEN sql || ', STRICT'
WHEN SUBSTR(sql, -1) = ')' THEN sql || ' STRICT'
ELSE sql
END
WHERE type = 'table' AND name != 'sqlite_sequence';
UPDATE sqlite_master
SET sql = replace(sql, 'device_token TEXT NOT NULL', 'device_token BLOB NOT NULL')
WHERE type = 'table' AND name = 'ntf_tokens';
PRAGMA writable_schema=RESET;
|]
down_m20251230_strict_tables :: Query
down_m20251230_strict_tables =
[sql|
PRAGMA writable_schema=1;
UPDATE sqlite_master
SET sql = CASE
WHEN LOWER(SUBSTR(sql, -8)) = ', strict' THEN SUBSTR(sql, 1, LENGTH(sql) - 8)
WHEN LOWER(SUBSTR(sql, -7)) = ' strict' THEN SUBSTR(sql, 1, LENGTH(sql) - 7)
ELSE sql
END
WHERE type = 'table' AND name != 'sqlite_sequence';
UPDATE sqlite_master
SET sql = replace(sql, 'device_token BLOB NOT NULL', 'device_token TEXT NOT NULL')
WHERE type = 'table' AND name = 'ntf_tokens';
PRAGMA writable_schema=RESET;
UPDATE ntf_tokens SET ntf_mode = CAST(ntf_mode as BLOB);
UPDATE ntf_subscriptions
SET ntf_sub_action = CAST(ntf_sub_action as BLOB),
ntf_sub_smp_action = CAST(ntf_sub_smp_action as BLOB);
|]
@@ -2,13 +2,13 @@ CREATE TABLE migrations(
name TEXT NOT NULL PRIMARY KEY,
ts TEXT NOT NULL,
down TEXT
);
) STRICT;
CREATE TABLE servers(
host TEXT NOT NULL,
port TEXT NOT NULL,
key_hash BLOB NOT NULL,
PRIMARY KEY(host, port)
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE connections(
conn_id BLOB NOT NULL PRIMARY KEY,
conn_mode TEXT NOT NULL,
@@ -28,7 +28,7 @@ CREATE TABLE connections(
ratchet_sync_state TEXT NOT NULL DEFAULT 'ok',
deleted_at_wait_delivery TEXT,
pq_support INTEGER NOT NULL DEFAULT 0
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE rcv_queues(
host TEXT NOT NULL,
port TEXT NOT NULL,
@@ -67,7 +67,7 @@ CREATE TABLE rcv_queues(
FOREIGN KEY(host, port) REFERENCES servers
ON DELETE RESTRICT ON UPDATE CASCADE,
UNIQUE(host, port, snd_id)
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE snd_queues(
host TEXT NOT NULL,
port TEXT NOT NULL,
@@ -89,7 +89,7 @@ CREATE TABLE snd_queues(
PRIMARY KEY(host, port, snd_id),
FOREIGN KEY(host, port) REFERENCES servers
ON DELETE RESTRICT ON UPDATE CASCADE
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE messages(
conn_id BLOB NOT NULL REFERENCES connections(conn_id)
ON DELETE CASCADE,
@@ -106,7 +106,7 @@ CREATE TABLE messages(
ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED,
FOREIGN KEY(conn_id, internal_snd_id) REFERENCES snd_messages
ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE rcv_messages(
conn_id BLOB NOT NULL,
internal_rcv_id INTEGER NOT NULL,
@@ -122,7 +122,7 @@ CREATE TABLE rcv_messages(
PRIMARY KEY(conn_id, internal_rcv_id),
FOREIGN KEY(conn_id, internal_id) REFERENCES messages
ON DELETE CASCADE
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE snd_messages(
conn_id BLOB NOT NULL,
internal_snd_id INTEGER NOT NULL,
@@ -139,7 +139,7 @@ CREATE TABLE snd_messages(
PRIMARY KEY(conn_id, internal_snd_id),
FOREIGN KEY(conn_id, internal_id) REFERENCES messages
ON DELETE CASCADE
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE conn_confirmations(
confirmation_id BLOB NOT NULL PRIMARY KEY,
conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
@@ -153,7 +153,7 @@ CREATE TABLE conn_confirmations(
,
smp_reply_queues BLOB NULL,
smp_client_version INTEGER
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE conn_invitations(
invitation_id BLOB NOT NULL PRIMARY KEY,
contact_conn_id BLOB REFERENCES connections ON DELETE SET NULL,
@@ -162,7 +162,7 @@ CREATE TABLE conn_invitations(
accepted INTEGER NOT NULL DEFAULT 0,
own_conn_info BLOB,
created_at TEXT NOT NULL DEFAULT(datetime('now'))
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE ratchets(
conn_id BLOB NOT NULL PRIMARY KEY REFERENCES connections
ON DELETE CASCADE,
@@ -177,7 +177,7 @@ CREATE TABLE ratchets(
x3dh_pub_key_2 BLOB,
pq_priv_kem BLOB,
pq_pub_kem BLOB
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE skipped_messages(
skipped_message_id INTEGER PRIMARY KEY,
conn_id BLOB NOT NULL REFERENCES ratchets
@@ -185,7 +185,7 @@ CREATE TABLE skipped_messages(
header_key BLOB NOT NULL,
msg_n INTEGER NOT NULL,
msg_key BLOB NOT NULL
);
) STRICT;
CREATE TABLE ntf_servers(
ntf_host TEXT NOT NULL,
ntf_port TEXT NOT NULL,
@@ -193,10 +193,10 @@ CREATE TABLE ntf_servers(
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now')),
PRIMARY KEY(ntf_host, ntf_port)
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE ntf_tokens(
provider TEXT NOT NULL, -- apns
device_token TEXT NOT NULL, -- ! this field is mislabeled and is actually saved as binary
device_token BLOB NOT NULL,
ntf_host TEXT NOT NULL,
ntf_port TEXT NOT NULL,
tkn_id BLOB, -- token ID assigned by notifications server
@@ -213,7 +213,7 @@ tkn_dh_secret BLOB, -- DH secret for e2e encryption of notifications
PRIMARY KEY(provider, device_token, ntf_host, ntf_port),
FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers
ON DELETE RESTRICT ON UPDATE CASCADE
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE ntf_subscriptions(
conn_id BLOB NOT NULL,
smp_host TEXT NULL,
@@ -237,7 +237,7 @@ CREATE TABLE ntf_subscriptions(
ON DELETE SET NULL ON UPDATE CASCADE,
FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers
ON DELETE RESTRICT ON UPDATE CASCADE
) WITHOUT ROWID;
) WITHOUT ROWID, STRICT;
CREATE TABLE commands(
command_id INTEGER PRIMARY KEY,
conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
@@ -252,7 +252,7 @@ CREATE TABLE commands(
failed INTEGER DEFAULT 0,
FOREIGN KEY(host, port) REFERENCES servers
ON DELETE RESTRICT ON UPDATE CASCADE
);
) STRICT;
CREATE TABLE snd_message_deliveries(
snd_message_delivery_id INTEGER PRIMARY KEY AUTOINCREMENT,
conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
@@ -260,13 +260,13 @@ CREATE TABLE snd_message_deliveries(
internal_id INTEGER NOT NULL,
failed INTEGER DEFAULT 0,
FOREIGN KEY(conn_id, internal_id) REFERENCES messages ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
);
) STRICT;
CREATE TABLE sqlite_sequence(name,seq);
CREATE TABLE users(
user_id INTEGER PRIMARY KEY AUTOINCREMENT
,
deleted INTEGER DEFAULT 0 CHECK(deleted NOT NULL)
);
) STRICT;
CREATE TABLE xftp_servers(
xftp_server_id INTEGER PRIMARY KEY,
xftp_host TEXT NOT NULL,
@@ -275,7 +275,7 @@ CREATE TABLE xftp_servers(
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now')),
UNIQUE(xftp_host, xftp_port, xftp_key_hash)
);
) STRICT;
CREATE TABLE rcv_files(
rcv_file_id INTEGER PRIMARY KEY,
rcv_file_entity_id BLOB NOT NULL,
@@ -302,7 +302,7 @@ CREATE TABLE rcv_files(
redirect_digest BLOB,
approved_relays INTEGER NOT NULL DEFAULT 0,
UNIQUE(rcv_file_entity_id)
);
) STRICT;
CREATE TABLE rcv_file_chunks(
rcv_file_chunk_id INTEGER PRIMARY KEY,
rcv_file_id INTEGER NOT NULL REFERENCES rcv_files ON DELETE CASCADE,
@@ -312,7 +312,7 @@ CREATE TABLE rcv_file_chunks(
tmp_path TEXT,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
) STRICT;
CREATE TABLE rcv_file_chunk_replicas(
rcv_file_chunk_replica_id INTEGER PRIMARY KEY,
rcv_file_chunk_id INTEGER NOT NULL REFERENCES rcv_file_chunks ON DELETE CASCADE,
@@ -325,7 +325,7 @@ CREATE TABLE rcv_file_chunk_replicas(
retries INTEGER NOT NULL DEFAULT 0,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
) STRICT;
CREATE TABLE snd_files(
snd_file_id INTEGER PRIMARY KEY,
snd_file_entity_id BLOB NOT NULL,
@@ -347,7 +347,7 @@ CREATE TABLE snd_files(
failed INTEGER DEFAULT 0,
redirect_size INTEGER,
redirect_digest BLOB
);
) STRICT;
CREATE TABLE snd_file_chunks(
snd_file_chunk_id INTEGER PRIMARY KEY,
snd_file_id INTEGER NOT NULL REFERENCES snd_files ON DELETE CASCADE,
@@ -357,7 +357,7 @@ CREATE TABLE snd_file_chunks(
digest BLOB NOT NULL,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
) STRICT;
CREATE TABLE snd_file_chunk_replicas(
snd_file_chunk_replica_id INTEGER PRIMARY KEY,
snd_file_chunk_id INTEGER NOT NULL REFERENCES snd_file_chunks ON DELETE CASCADE,
@@ -370,7 +370,7 @@ CREATE TABLE snd_file_chunk_replicas(
retries INTEGER NOT NULL DEFAULT 0,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
) STRICT;
CREATE TABLE snd_file_chunk_replica_recipients(
snd_file_chunk_replica_recipient_id INTEGER PRIMARY KEY,
snd_file_chunk_replica_id INTEGER NOT NULL REFERENCES snd_file_chunk_replicas ON DELETE CASCADE,
@@ -378,7 +378,7 @@ CREATE TABLE snd_file_chunk_replica_recipients(
rcv_replica_key BLOB NOT NULL,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
) STRICT;
CREATE TABLE deleted_snd_chunk_replicas(
deleted_snd_chunk_replica_id INTEGER PRIMARY KEY,
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
@@ -392,28 +392,28 @@ CREATE TABLE deleted_snd_chunk_replicas(
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
,
failed INTEGER DEFAULT 0
);
) STRICT;
CREATE TABLE encrypted_rcv_message_hashes(
encrypted_rcv_message_hash_id INTEGER PRIMARY KEY,
conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
hash BLOB NOT NULL,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
) STRICT;
CREATE TABLE processed_ratchet_key_hashes(
processed_ratchet_key_hash_id INTEGER PRIMARY KEY,
conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
hash BLOB NOT NULL,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
) STRICT;
CREATE TABLE servers_stats(
servers_stats_id INTEGER PRIMARY KEY,
servers_stats TEXT,
started_at TEXT NOT NULL DEFAULT(datetime('now')),
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
) STRICT;
CREATE TABLE ntf_tokens_to_delete(
ntf_token_to_delete_id INTEGER PRIMARY KEY,
ntf_host TEXT NOT NULL,
@@ -423,11 +423,11 @@ CREATE TABLE ntf_tokens_to_delete(
tkn_priv_key BLOB NOT NULL, -- client's private key to sign token commands,
del_failed INTEGER DEFAULT 0,
created_at TEXT NOT NULL DEFAULT(datetime('now'))
);
) STRICT;
CREATE TABLE snd_message_bodies(
snd_message_body_id INTEGER PRIMARY KEY,
agent_msg BLOB NOT NULL DEFAULT x''
);
) STRICT;
CREATE TABLE inv_short_links(
inv_short_link_id INTEGER PRIMARY KEY AUTOINCREMENT,
host TEXT NOT NULL,
@@ -438,7 +438,7 @@ CREATE TABLE inv_short_links(
snd_private_key BLOB NOT NULL,
snd_id BLOB,
FOREIGN KEY(host, port) REFERENCES servers ON DELETE RESTRICT ON UPDATE CASCADE
);
) STRICT;
CREATE TABLE client_notices(
client_notice_id INTEGER PRIMARY KEY AUTOINCREMENT,
protocol TEXT NOT NULL,
@@ -449,7 +449,7 @@ CREATE TABLE client_notices(
notice_ttl INTEGER,
created_at INTEGER NOT NULL,
updated_at INTEGER NOT NULL
);
) STRICT;
CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id);
CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id);
CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id);
@@ -0,0 +1,89 @@
module Simplex.Messaging.Agent.Store.SQLite.Util where
import Control.Exception (SomeException, catch, mask_)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.IORef
import Database.SQLite3.Direct (Database (..), FuncArgs (..), FuncContext (..))
import Database.SQLite3.Bindings
import Foreign.C.String
import Foreign.Ptr
import Foreign.StablePtr
import Foreign.Storable
data CFuncPtrs = CFuncPtrs (FunPtr CFunc) (FunPtr CFunc) (FunPtr CFuncFinal)
type SQLiteFunc = Ptr CContext -> CArgCount -> Ptr (Ptr CValue) -> IO ()
type SQLiteFuncFinal = Ptr CContext -> IO ()
mkSQLiteFunc :: (FuncContext -> FuncArgs -> IO ()) -> SQLiteFunc
mkSQLiteFunc f cxt nArgs cvals = catchAsResultError cxt $ f (FuncContext cxt) (FuncArgs nArgs cvals)
{-# INLINE mkSQLiteFunc #-}
-- Based on createFunction from Database.SQLite3.Direct, but uses static function pointer to avoid dynamic wrapper that triggers DCL.
createStaticFunction :: Database -> ByteString -> CArgCount -> Bool -> FunPtr SQLiteFunc -> IO (Either Error ())
createStaticFunction (Database db) name nArgs isDet funPtr = mask_ $ do
u <- newStablePtr $ CFuncPtrs funPtr nullFunPtr nullFunPtr
let flags = if isDet then c_SQLITE_DETERMINISTIC else 0
B.useAsCString name $ \namePtr ->
toResult () <$> c_sqlite3_create_function_v2 db namePtr nArgs flags (castStablePtrToPtr u) funPtr nullFunPtr nullFunPtr nullFunPtr
mkSQLiteAggStep :: a -> (FuncContext -> FuncArgs -> a -> IO a) -> SQLiteFunc
mkSQLiteAggStep initSt xStep cxt nArgs cvals = catchAsResultError cxt $ do
-- we store the aggregate state in the buffer returned by
-- c_sqlite3_aggregate_context as a StablePtr pointing to an IORef that
-- contains the actual aggregate state
aggCtx <- getAggregateContext cxt
aggStPtr <- peek aggCtx
aggStRef <-
if castStablePtrToPtr aggStPtr /= nullPtr
then deRefStablePtr aggStPtr
else do
aggStRef <- newIORef initSt
aggStPtr' <- newStablePtr aggStRef
poke aggCtx aggStPtr'
return aggStRef
aggSt <- readIORef aggStRef
aggSt' <- xStep (FuncContext cxt) (FuncArgs nArgs cvals) aggSt
writeIORef aggStRef aggSt'
mkSQLiteAggFinal :: a -> (FuncContext -> a -> IO ()) -> SQLiteFuncFinal
mkSQLiteAggFinal initSt xFinal cxt = do
aggCtx <- getAggregateContext cxt
aggStPtr <- peek aggCtx
if castStablePtrToPtr aggStPtr == nullPtr
then catchAsResultError cxt $ xFinal (FuncContext cxt) initSt
else do
catchAsResultError cxt $ do
aggStRef <- deRefStablePtr aggStPtr
aggSt <- readIORef aggStRef
xFinal (FuncContext cxt) aggSt
freeStablePtr aggStPtr
getAggregateContext :: Ptr CContext -> IO (Ptr a)
getAggregateContext cxt = c_sqlite3_aggregate_context cxt stPtrSize
where
stPtrSize = fromIntegral $ sizeOf (undefined :: StablePtr ())
-- Based on createAggregate from Database.SQLite3.Direct, but uses static function pointers to avoid dynamic wrappers that trigger DCL.
createStaticAggregate :: Database -> ByteString -> CArgCount -> FunPtr SQLiteFunc -> FunPtr SQLiteFuncFinal -> IO (Either Error ())
createStaticAggregate (Database db) name nArgs stepPtr finalPtr = mask_ $ do
u <- newStablePtr $ CFuncPtrs nullFunPtr stepPtr finalPtr
B.useAsCString name $ \namePtr ->
toResult () <$> c_sqlite3_create_function_v2 db namePtr nArgs 0 (castStablePtrToPtr u) nullFunPtr stepPtr finalPtr nullFunPtr
-- Convert a 'CError' to a 'Either Error', in the common case where
-- SQLITE_OK signals success and anything else signals an error.
--
-- Note that SQLITE_OK == 0.
toResult :: a -> CError -> Either Error a
toResult a (CError 0) = Right a
toResult _ code = Left $ decodeError code
-- call c_sqlite3_result_error in the event of an error
catchAsResultError :: Ptr CContext -> IO () -> IO ()
catchAsResultError ctx action = catch action $ \exn -> do
let msg = show (exn :: SomeException)
withCAStringLen msg $ \(ptr, len) ->
c_sqlite3_result_error ctx ptr (fromIntegral len)
+8 -6
View File
@@ -36,10 +36,12 @@ compress1 bs
| B.length bs <= maxLengthPassthrough = Passthrough bs
| otherwise = Compressed . Large $ Z1.compress compressionLevel bs
decompress1 :: Compressed -> Either String ByteString
decompress1 = \case
decompress1 :: Int -> Compressed -> Either String ByteString
decompress1 limit = \case
Passthrough bs -> Right bs
Compressed (Large bs) -> case Z1.decompress bs of
Z1.Error e -> Left e
Z1.Skip -> Right mempty
Z1.Decompress bs' -> Right bs'
Compressed (Large bs) -> case Z1.decompressedSize bs of
Just sz | sz <= limit -> case Z1.decompress bs of
Z1.Error e -> Left e
Z1.Skip -> Right mempty
Z1.Decompress bs' -> Right bs'
_ -> Left $ "compressed size not specified or exceeds " <> show limit
+32 -10
View File
@@ -13,7 +13,9 @@ module Simplex.Messaging.Crypto.ShortLink
( contactShortLinkKdf,
invShortLinkKdf,
encodeSignLinkData,
encodeSignFixedData,
encodeSignUserData,
newOwnerAuth,
encryptLinkData,
encryptUserData,
decryptLinkData,
@@ -21,6 +23,7 @@ module Simplex.Messaging.Crypto.ShortLink
where
import Control.Concurrent.STM
import Control.Monad (unless)
import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
@@ -32,7 +35,7 @@ import Simplex.Messaging.Agent.Client (cryptoError)
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Protocol (EntityId (..), LinkId, EncDataBytes (..), QueueLinkData)
import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), LinkId, QueueLinkData)
import Simplex.Messaging.Util (liftEitherWith)
fixedDataPaddedLength :: Int
@@ -49,11 +52,16 @@ contactShortLinkKdf (LinkKey k) =
invShortLinkKdf :: LinkKey -> C.SbKey
invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32
encodeSignLinkData :: ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> UserConnLinkData c -> (LinkKey, (ByteString, ByteString))
encodeSignLinkData (rootKey, pk) agentVRange connReq userData =
let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq}
md = smpEncode $ connLinkData agentVRange userData
in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md))
encodeSignLinkData :: forall c. ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> Maybe ByteString -> UserConnLinkData c -> (LinkKey, (ByteString, ByteString))
encodeSignLinkData keys@(_, pk) agentVRange linkConnReq linkEntityId userData =
let (linkKey, fd) = encodeSignFixedData keys agentVRange linkConnReq linkEntityId
md = encodeSignUserData (sConnectionMode @c) pk agentVRange userData
in (linkKey, (fd, md))
encodeSignFixedData :: ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> Maybe ByteString -> (LinkKey, ByteString)
encodeSignFixedData (rootKey, pk) agentVRange linkConnReq linkEntityId =
let fd = smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId}
in (LinkKey (C.sha3_256 fd), encodeSign pk fd)
encodeSignUserData :: ConnectionModeI c => SConnectionMode c -> C.PrivateKeyEd25519 -> VersionRangeSMPA -> UserConnLinkData c -> ByteString
encodeSignUserData _ pk agentVRange userLinkData =
@@ -67,6 +75,14 @@ connLinkData vr = \case
encodeSign :: C.PrivateKeyEd25519 -> ByteString -> ByteString
encodeSign pk s = smpEncode (C.sign' pk s) <> s
-- | Generate a new owner key pair and create OwnerAuth signed by the authorizing key.
-- ownerId is application-specific (e.g., MemberId in chat).
newOwnerAuth :: TVar ChaChaDRG -> OwnerId -> C.PrivateKeyEd25519 -> IO (C.PrivateKeyEd25519, OwnerAuth)
newOwnerAuth g ownerId signingKey = do
(ownerKey, ownerPrivKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
let authOwnerSig = C.sign' signingKey $ ownerId <> C.encodePubKey ownerKey
pure (ownerPrivKey, OwnerAuth {ownerId, ownerKey, authOwnerSig})
encryptLinkData :: TVar ChaChaDRG -> C.SbKey -> (ByteString, ByteString) -> ExceptT AgentErrorType IO QueueLinkData
encryptLinkData g k = bimapM (encrypt fixedDataPaddedLength) (encrypt userDataPaddedLength)
where
@@ -81,17 +97,22 @@ encryptData g k len s = do
ct <- liftEitherWith cryptoError $ C.sbEncrypt k nonce s len
pure $ EncDataBytes $ smpEncode nonce <> ct
decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnLinkData c)
decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (FixedLinkData c, ConnLinkData c)
decryptLinkData linkKey k (encFD, encMD) = do
(sig1, fd) <- decrypt encFD
(sig2, md) <- decrypt encMD
FixedLinkData {rootKey, connReq} <- decode fd
fd'@FixedLinkData {rootKey} <- decode fd
md' <- decode @(ConnLinkData c) md
let signedBy k' = C.verify' k' sig2 md
if
| LinkKey (C.sha3_256 fd) /= linkKey -> linkErr "link data hash"
| not (C.verify' rootKey sig1 fd) -> linkErr "link data signature"
| not (C.verify' rootKey sig2 md) -> linkErr "user data signature"
| otherwise -> Right (connReq, md')
| otherwise -> case md' of
InvitationLinkData {} -> unless (signedBy rootKey) $ linkErr "user data signature"
ContactLinkData _ UserContactData {owners} -> do
first (AGENT . A_LINK) $ validateLinkOwners rootKey owners
unless (signedBy rootKey || any (signedBy . ownerKey) owners) $ linkErr "user data signature"
Right (fd', md')
where
decrypt (EncDataBytes d) = do
(nonce, Tail ct) <- decode d
@@ -100,4 +121,5 @@ decryptLinkData linkKey k (encFD, encMD) = do
decode :: Encoding a => ByteString -> Either AgentErrorType a
decode = msgErr . smpDecode
msgErr = first (const $ AGENT A_MESSAGE)
linkErr :: String -> Either AgentErrorType ()
linkErr = Left . AGENT . A_LINK
+8
View File
@@ -24,6 +24,8 @@ import Data.Bits (shiftL, shiftR, (.|.))
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Internal (c2w, w2c)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
import Data.Int (Int64)
import qualified Data.List.NonEmpty as L
import Data.Time.Clock.System (SystemTime (..))
@@ -156,6 +158,12 @@ smpEncodeList xs = B.cons (lenEncode $ length xs) . B.concat $ map smpEncode xs
smpListP :: Encoding a => Parser [a]
smpListP = (`A.count` smpP) =<< lenP
instance Encoding Text where
smpEncode = smpEncode . encodeUtf8
{-# INLINE smpEncode #-}
smpP = either (fail . show) pure . decodeUtf8' =<< smpP
{-# INLINE smpP #-}
instance Encoding String where
smpEncode = smpEncode . B.pack
{-# INLINE smpEncode #-}
+21 -21
View File
@@ -13,8 +13,10 @@ import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..), UserId)
import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Notifications.Protocol
import Simplex.Messaging.Protocol (NotifierId, NtfServer, SMPServer)
import Simplex.Messaging.Util (eitherToMaybe)
data NtfTknAction
= NTARegister
@@ -101,42 +103,40 @@ data NtfSubNTFAction
| NSARotate -- deprecated
deriving (Show)
instance Encoding NtfSubNTFAction where
smpEncode = \case
instance TextEncoding NtfSubNTFAction where
textEncode = \case
NSACreate -> "N"
NSACheck -> "C"
NSADelete -> "D"
NSARotate -> "R"
smpP =
A.anyChar >>= \case
'N' -> pure NSACreate
'C' -> pure NSACheck
'D' -> pure NSADelete
'R' -> pure NSARotate
_ -> fail "bad NtfSubNTFAction"
textDecode = \case
"N" -> Just NSACreate
"C" -> Just NSACheck
"D" -> Just NSADelete
"R" -> Just NSARotate
_ -> Nothing
instance FromField NtfSubNTFAction where fromField = blobFieldDecoder smpDecode
instance FromField NtfSubNTFAction where fromField = fromTextField_ textDecode
instance ToField NtfSubNTFAction where toField = toField . Binary . smpEncode
instance ToField NtfSubNTFAction where toField = toField . textEncode
data NtfSubSMPAction
= NSASmpKey
| NSASmpDelete
deriving (Show)
instance Encoding NtfSubSMPAction where
smpEncode = \case
instance TextEncoding NtfSubSMPAction where
textEncode = \case
NSASmpKey -> "K"
NSASmpDelete -> "D"
smpP =
A.anyChar >>= \case
'K' -> pure NSASmpKey
'D' -> pure NSASmpDelete
_ -> fail "bad NtfSubSMPAction"
textDecode = \case
"K" -> Just NSASmpKey
"D" -> Just NSASmpDelete
_ -> Nothing
instance FromField NtfSubSMPAction where fromField = blobFieldDecoder smpDecode
instance FromField NtfSubSMPAction where fromField = fromTextField_ textDecode
instance ToField NtfSubSMPAction where toField = toField . Binary . smpEncode
instance ToField NtfSubSMPAction where toField = toField . textEncode
data NtfAgentSubStatus
= -- | subscription started
@@ -171,7 +171,7 @@ instance Encoding NtfAgentSubStatus where
"DELETED" -> pure NASDeleted
_ -> fail "bad NtfAgentSubStatus"
instance FromField NtfAgentSubStatus where fromField = fromTextField_ $ either (const Nothing) Just . smpDecode . encodeUtf8
instance FromField NtfAgentSubStatus where fromField = fromTextField_ $ eitherToMaybe . smpDecode . encodeUtf8
instance ToField NtfAgentSubStatus where toField = toField . decodeLatin1 . smpEncode
+20 -11
View File
@@ -16,7 +16,7 @@ import Numeric.Natural (Natural)
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Transport (ALPN, SessionId, TLS, closeConnection, tlsALPN, tlsUniq)
import Simplex.Messaging.Transport.HTTP2
import Simplex.Messaging.Transport.Server (ServerCredentials, TransportServerConfig (..), loadServerCredential, runTransportServer)
import Simplex.Messaging.Transport.Server (SNICredentialUsed, ServerCredentials, TLSServerCredential (..), TransportServerConfig (..), loadServerCredential, newSocketState, runTransportServerState_)
import Simplex.Messaging.Util (threadDelay')
import UnliftIO (finally)
import UnliftIO.Concurrent (forkIO, killThread)
@@ -54,7 +54,7 @@ getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, se
started <- newEmptyTMVarIO
reqQ <- newTBQueueIO qSize
action <- async $
runHTTP2Server started http2Port bufferSize serverSupported srvCreds transportConfig Nothing (const $ pure ()) $ \sessionId sessionALPN r sendResponse -> do
runHTTP2Server started http2Port bufferSize serverSupported srvCreds Nothing transportConfig Nothing (const $ pure ()) $ \_sniUsed sessionId sessionALPN r sendResponse -> do
reqBody <- getHTTP2Body r bodyHeadSize
atomically $ writeTBQueue reqQ HTTP2Request {sessionId, sessionALPN, request = r, reqBody, sendResponse}
void . atomically $ takeTMVar started
@@ -63,24 +63,33 @@ getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, se
closeHTTP2Server :: HTTP2Server -> IO ()
closeHTTP2Server = uninterruptibleCancel . action
runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.Supported -> T.Credential -> TransportServerConfig -> Maybe ExpirationConfig -> (SessionId -> IO ()) -> HTTP2ServerFunc -> IO ()
runHTTP2Server started port bufferSize srvSupported srvCreds transportConfig expCfg_ clientFinished = runHTTP2ServerWith_ expCfg_ clientFinished bufferSize setup
runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.Supported -> T.Credential -> Maybe T.Credential -> TransportServerConfig -> Maybe ExpirationConfig -> (SessionId -> IO ()) -> (SNICredentialUsed -> HTTP2ServerFunc) -> IO ()
runHTTP2Server started port bufferSize srvSupported srvCreds httpCreds_ transportConfig expCfg_ clientFinished = runHTTP2ServerWith_ expCfg_ clientFinished bufferSize setup
where
setup = runTransportServer started port srvSupported srvCreds transportConfig
setup handler = do
ss <- newSocketState
let combinedCreds = TLSServerCredential {credential = srvCreds, sniCredential = httpCreds_}
runTransportServerState_ ss started port srvSupported combinedCreds transportConfig $ \_ -> handler
-- HTTP2 server can be run on both client and server TLS connections.
runHTTP2ServerWith :: BufferSize -> ((TLS p -> IO ()) -> a) -> HTTP2ServerFunc -> a
runHTTP2ServerWith = runHTTP2ServerWith_ Nothing (\_sessId -> pure ())
runHTTP2ServerWith bufferSize tlsSetup http2Server =
runHTTP2ServerWith_
Nothing
(\_sessId -> pure ())
bufferSize
(\handler -> tlsSetup $ \tls -> handler (False, tls))
(const http2Server)
runHTTP2ServerWith_ :: Maybe ExpirationConfig -> (SessionId -> IO ()) -> BufferSize -> ((TLS p -> IO ()) -> a) -> HTTP2ServerFunc -> a
runHTTP2ServerWith_ expCfg_ clientFinished bufferSize setup http2Server = setup $ \tls -> do
runHTTP2ServerWith_ :: Maybe ExpirationConfig -> (SessionId -> IO ()) -> BufferSize -> (((SNICredentialUsed, TLS p) -> IO ()) -> a) -> (SNICredentialUsed -> HTTP2ServerFunc) -> a
runHTTP2ServerWith_ expCfg_ clientFinished bufferSize setup http2Server = setup $ \(sniUsed, tls) -> do
activeAt <- newTVarIO =<< getSystemTime
tid_ <- mapM (forkIO . expireInactiveClient tls activeAt) expCfg_
withHTTP2 bufferSize (run tls activeAt) (clientFinished $ tlsUniq tls) tls `finally` mapM_ killThread tid_
withHTTP2 bufferSize (run sniUsed tls activeAt) (clientFinished $ tlsUniq tls) tls `finally` mapM_ killThread tid_
where
run tls activeAt cfg = H.run cfg $ \req _aux sendResp -> do
run sniUsed tls activeAt cfg = H.run cfg $ \req _aux sendResp -> do
getSystemTime >>= atomically . writeTVar activeAt
http2Server (tlsUniq tls) (tlsALPN tls) req (`sendResp` [])
http2Server sniUsed (tlsUniq tls) (tlsALPN tls) req (`sendResp` [])
expireInactiveClient tls activeAt expCfg = loop
where
loop = do
+7 -3
View File
@@ -11,6 +11,7 @@ module Simplex.Messaging.Transport.Server
( TransportServerConfig (..),
ServerCredentials (..),
TLSServerCredential (..),
SNICredentialUsed,
AddHTTP,
mkTransportServerConfig,
runTransportServerState,
@@ -62,6 +63,7 @@ data TransportServerConfig = TransportServerConfig
{ logTLSErrors :: Bool,
serverALPN :: Maybe [ALPN],
askClientCert :: Bool,
addCORSHeaders :: Bool,
tlsSetupTimeout :: Int,
transportTimeout :: Int
}
@@ -91,6 +93,7 @@ mkTransportServerConfig logTLSErrors serverALPN askClientCert =
{ logTLSErrors,
serverALPN,
askClientCert,
addCORSHeaders = False,
tlsSetupTimeout = 60000000,
transportTimeout = 40000000
}
@@ -274,9 +277,10 @@ paramsAskClientCert clientCert params =
{ T.serverWantClientCert = True,
T.serverHooks =
(T.serverHooks params)
{ T.onClientCertificate = \cc -> validateClientCertificate cc >>= \case
Just reason -> T.CertificateUsageReject reason <$ atomically (tryPutTMVar clientCert Nothing)
Nothing -> T.CertificateUsageAccept <$ atomically (tryPutTMVar clientCert $ Just cc)
{ T.onClientCertificate = \cc ->
validateClientCertificate cc >>= \case
Just reason -> T.CertificateUsageReject reason <$ atomically (tryPutTMVar clientCert Nothing)
Nothing -> T.CertificateUsageAccept <$ atomically (tryPutTMVar clientCert $ Just cc)
}
}
+69 -18
View File
@@ -4,6 +4,7 @@
module Simplex.Messaging.Util where
import Control.Exception (AllocationLimitExceeded (..), AsyncException (..))
import qualified Control.Exception as E
import Control.Monad
import Control.Monad.Except
@@ -21,9 +22,9 @@ import Data.Int (Int64)
import Data.List (groupBy, sortOn)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
import Data.Maybe (listToMaybe)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
@@ -93,7 +94,7 @@ anyM :: Monad m => [m Bool] -> m Bool
anyM = foldM (\r a -> if r then pure r else (r ||) <$!> a) False
{-# INLINE anyM #-}
infixl 1 $>>, $>>=
infixl 1 $>>, $>>=
($>>=) :: (Monad m, Monad f, Traversable f) => m (f a) -> (a -> m (f b)) -> m (f b)
f $>>= g = f >>= fmap join . mapM g
@@ -115,15 +116,19 @@ forME :: (Monad m, Traversable t) => t (Either e a) -> (a -> m (Either e b)) ->
forME = flip mapME
{-# INLINE forME #-}
-- | Monadic version of mapAccumL
-- Copied from ghc-9.6.3 package: https://hackage.haskell.org/package/ghc-9.12.1/docs/GHC-Utils-Monad.html#v:mapAccumLM
-- for backward compatibility with 8.10.7.
mapAccumLM :: (Monad m, Traversable t)
=> (acc -> x -> m (acc, y)) -- ^ combining function
-> acc -- ^ initial state
-> t x -- ^ inputs
-> m (acc, t y) -- ^ final state, outputs
mapAccumLM ::
(Monad m, Traversable t) =>
-- | combining function
(acc -> x -> m (acc, y)) ->
-- | initial state
acc ->
-- | inputs
t x ->
-- | final state, outputs
m (acc, t y)
{-# INLINE [1] mapAccumLM #-}
-- INLINE pragma. mapAccumLM is called in inner loops. Like 'map',
-- we inline it so that we can take advantage of knowing 'f'.
@@ -132,26 +137,31 @@ mapAccumLM :: (Monad m, Traversable t)
mapAccumLM f s = fmap swap . flip runStateT s . traverse f'
where
f' = StateT . (fmap . fmap) swap . flip f
{-# RULES "mapAccumLM/List" mapAccumLM = mapAccumLM_List #-}
{-# RULES "mapAccumLM/NonEmpty" mapAccumLM = mapAccumLM_NonEmpty #-}
mapAccumLM_List
:: Monad m
=> (acc -> x -> m (acc, y))
-> acc -> [x] -> m (acc, [y])
mapAccumLM_List ::
Monad m =>
(acc -> x -> m (acc, y)) ->
acc ->
[x] ->
m (acc, [y])
{-# INLINE mapAccumLM_List #-}
mapAccumLM_List f = go
where
go s (x : xs) = do
(s1, x') <- f s x
(s1, x') <- f s x
(s2, xs') <- go s1 xs
return (s2, x' : xs')
return (s2, x' : xs')
go s [] = return (s, [])
mapAccumLM_NonEmpty
:: Monad m
=> (acc -> x -> m (acc, y))
-> acc -> NonEmpty x -> m (acc, NonEmpty y)
mapAccumLM_NonEmpty ::
Monad m =>
(acc -> x -> m (acc, y)) ->
acc ->
NonEmpty x ->
m (acc, NonEmpty y)
{-# INLINE mapAccumLM_NonEmpty #-}
mapAccumLM_NonEmpty f s (x :| xs) =
[(s2, x' :| xs') | (s1, x') <- f s x, (s2, xs') <- mapAccumLM_List f s1 xs]
@@ -197,6 +207,47 @@ allFinally :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> ExceptT e m b ->
allFinally action final = tryAllErrors action >>= \r -> final >> except r
{-# INLINE allFinally #-}
isOwnException :: E.SomeException -> Bool
isOwnException e = case E.fromException e of
Just StackOverflow -> True
Just HeapOverflow -> True
_ -> case E.fromException e of
Just AllocationLimitExceeded -> True
_ -> False
{-# INLINE isOwnException #-}
isAsyncCancellation :: E.SomeException -> Bool
isAsyncCancellation e = case E.fromException e of
Just (_ :: SomeAsyncException) -> not $ isOwnException e
Nothing -> False
{-# INLINE isAsyncCancellation #-}
catchOwn' :: IO a -> (E.SomeException -> IO a) -> IO a
catchOwn' action handleInternal = action `E.catch` \e -> if isAsyncCancellation e then E.throwIO e else handleInternal e
{-# INLINE catchOwn' #-}
catchOwn :: MonadUnliftIO m => m a -> (E.SomeException -> m a) -> m a
catchOwn action handleInternal =
withRunInIO $ \run ->
run action `E.catch` \e -> if isAsyncCancellation e then E.throwIO e else run (handleInternal e)
{-# INLINE catchOwn #-}
tryAllOwnErrors :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> ExceptT e m (Either e a)
tryAllOwnErrors action = ExceptT $ Right <$> runExceptT action `catchOwn` (pure . Left . fromSomeException)
{-# INLINE tryAllOwnErrors #-}
tryAllOwnErrors' :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> m (Either e a)
tryAllOwnErrors' action = runExceptT action `catchOwn` (pure . Left . fromSomeException)
{-# INLINE tryAllOwnErrors' #-}
catchAllOwnErrors :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
catchAllOwnErrors action handler = tryAllOwnErrors action >>= either handler pure
{-# INLINE catchAllOwnErrors #-}
catchAllOwnErrors' :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> (e -> m a) -> m a
catchAllOwnErrors' action handler = tryAllOwnErrors' action >>= either handler pure
{-# INLINE catchAllOwnErrors' #-}
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe = either (const Nothing) Just
{-# INLINE eitherToMaybe #-}
+5 -5
View File
@@ -14,7 +14,7 @@ import Control.Logger.Simple
import Control.Monad
import Data.ByteString (ByteString)
import Data.Default (def)
import Data.List (delete, find)
import Data.List (delete, find, partition)
import Data.Maybe (mapMaybe)
import Data.String (IsString)
import qualified Data.Text as T
@@ -53,11 +53,11 @@ getLocalAddress preferred_ =
ok -> Just RCCtrlAddress {address = THIPv4 ok, interface = T.pack name}
mkLastLocalHost :: [RCCtrlAddress] -> [RCCtrlAddress]
mkLastLocalHost addrs = case find localHost addrs of
Nothing -> addrs
Just lh -> delete lh addrs <> [lh]
mkLastLocalHost addrs = other <> local
where
localHost RCCtrlAddress {address = a} = a == THIPv4 (127, 0, 0, 1)
(local, other) = partition localHost addrs
localHost RCCtrlAddress {address = THIPv4 (127, _, _, _)} = True
localHost _ = False
preferAddress :: RCCtrlAddress -> [RCCtrlAddress] -> [RCCtrlAddress]
preferAddress RCCtrlAddress {address, interface} addrs =
+1 -17
View File
@@ -5,7 +5,7 @@
module AgentTests.EqInstances where
import Data.Type.Equality
import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), OwnerAuth (..), UserContactData (..), UserLinkData (..))
import Simplex.Messaging.Agent.Protocol (ShortLinkCreds (..))
import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Client (ProxiedRelay (..))
@@ -28,22 +28,6 @@ deriving instance Eq ClientNtfCreds
deriving instance Eq ShortLinkCreds
deriving instance Show (ConnLinkData c)
deriving instance Eq (ConnLinkData c)
deriving instance Show UserContactData
deriving instance Eq UserContactData
deriving instance Show UserLinkData
deriving instance Eq UserLinkData
deriving instance Show OwnerAuth
deriving instance Eq OwnerAuth
deriving instance Show ProxiedRelay
deriving instance Eq ProxiedRelay
+192 -57
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
@@ -219,6 +220,9 @@ pattern SENT msgId = A.SENT msgId Nothing
pattern Rcvd :: AgentMsgId -> AEvent 'AEConn
pattern Rcvd agentMsgId <- RCVD MsgMeta {integrity = MsgOk} [MsgReceipt {agentMsgId, msgRcptStatus = MROk}]
pattern Rcvd' :: AgentMsgId -> AgentMsgId -> AEvent 'AEConn
pattern Rcvd' aMsgId rcvdMsgId <- RCVD MsgMeta {integrity = MsgOk, recipient = (aMsgId, _)} [MsgReceipt {agentMsgId = rcvdMsgId, msgRcptStatus = MROk}]
pattern INV :: AConnectionRequestUri -> AEvent 'AEConn
pattern INV cReq = A.INV cReq Nothing
@@ -309,7 +313,7 @@ deleteConnection c = A.deleteConnection c NRMInteractive
deleteConnections :: AgentClient -> [ConnId] -> AE (M.Map ConnId (Either AgentErrorType ()))
deleteConnections c = A.deleteConnections c NRMInteractive
getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c)
getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c)
getConnShortLink c = A.getConnShortLink c NRMInteractive
setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c)
@@ -331,8 +335,8 @@ functionalAPITests ps = do
describe "Duplex connection - delivery stress test" $ do
describe "one way (50)" $ testMatrix2Stress ps $ runAgentClientStressTestOneWay 50
xdescribe "one way (1000)" $ testMatrix2Stress ps $ runAgentClientStressTestOneWay 1000
describe "two way concurrently (50)" $ testMatrix2Stress ps $ runAgentClientStressTestConc 25
xdescribe "two way concurrently (1000)" $ testMatrix2Stress ps $ runAgentClientStressTestConc 500
describe "two way concurrently (50)" $ testMatrix2Stress ps $ runAgentClientStressTestConc 50
xdescribe "two way concurrently (1000)" $ testMatrix2Stress ps $ runAgentClientStressTestConc 1000
describe "Establishing duplex connection, different PQ settings" $ do
testPQMatrix2 ps $ runAgentClientTestPQ False True
describe "Establishing duplex connection v2, different Ratchet versions" $
@@ -379,6 +383,7 @@ functionalAPITests ps = do
it "should connect via contact short link after restart" $ testContactShortLinkRestart ps
it "should connect via added contact short link after restart" $ testAddContactShortLinkRestart ps
it "should create and get short links with the old contact queues" $ testOldContactQueueShortLink ps
it "should connect via prepared connection link" $ testPrepareCreateConnectionLink ps
describe "Message delivery" $ do
describe "update connection agent version on received messages" $ do
it "should increase if compatible, shouldn'ps decrease" $
@@ -452,6 +457,10 @@ functionalAPITests ps = do
describe "Async agent commands" $ do
describe "connect using async agent commands" $
testBasicMatrix2 ps testAsyncCommands
it "should add short link data using async agent command" $
testSetConnShortLinkAsync ps
it "should get short link data and join connection using async agent commands" $
testGetConnShortLinkAsync ps
it "should restore and complete async commands on restart" $
testAsyncCommandsRestore ps
describe "accept connection using async command" $
@@ -469,7 +478,7 @@ functionalAPITests ps = do
testWaitDelivery ps
it "should delete connection if message can'ps be delivered due to AUTH error" $
testWaitDeliveryAUTHErr ps
it "should delete connection by timeout even if message wasn'ps delivered" $
it "should delete connection by timeout even if message wasn't delivered" $
testWaitDeliveryTimeout ps
it "should delete connection by timeout, message in progress can be delivered" $
testWaitDeliveryTimeout2 ps
@@ -782,36 +791,64 @@ runAgentClientStressTestOneWay n pqSupport sqSecured viaProxy alice bob baseId =
runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
runAgentClientStressTestConc n pqSupport sqSecured viaProxy alice bob baseId = runRight_ $ do
let pqEnc = PQEncryption $ supportPQ pqSupport
(aliceId, bobId) <- makeConnection_ pqSupport sqSecured alice bob
let proxySrv = if viaProxy then Just testSMPServer else Nothing
message i = "message " <> bshow i
loop a bId mIdVar i = do
when (i <= n) $ do
mId <- msgId <$> A.sendMessage a bId pqEnc SMP.noMsgFlags (message i)
liftIO $ mId >= i `shouldBe` True
let getEvent = do
get a >>= \case
("", c, A.SENT _ srv) -> liftIO $ c == bId && srv == proxySrv `shouldBe` True
("", c, QCONT) -> do
liftIO $ c == bId `shouldBe` True
getEvent
("", c, Msg' mId pq msg) -> do
-- tests that mId increases
liftIO $ (mId >) <$> atomically (swapTVar mIdVar mId) `shouldReturn` True
liftIO $ c == bId && pq == pqEnc && ("message " `B.isPrefixOf` msg) `shouldBe` True
ackMessage a bId mId Nothing
r -> liftIO $ expectationFailure $ "wrong message: " <> show r
getEvent
amId <- newTVarIO 0
bmId <- newTVarIO 0
concurrently_
(forM_ ([1 .. n * 2] :: [Int64]) $ loop alice bobId amId)
(forM_ ([1 .. n * 2] :: [Int64]) $ loop bob aliceId bmId)
let n2 = n `div` 2
mapConcurrently_ id
( [ send alice bobId [1 .. n2],
send alice bobId [n2 + 1 .. n],
send bob aliceId [1 .. n2],
send bob aliceId [n2 + 1 .. n],
receive alice bobId amId (n, n, n, 2 * n),
receive bob aliceId bmId (n, n, n, 2 * n)
] :: [ExceptT AgentErrorType IO ()]
)
liftIO $ noMessagesIngoreQCONT alice "nothing else should be delivered to alice"
liftIO $ noMessagesIngoreQCONT bob "nothing else should be delivered to bob"
where
msgId = subtract baseId . fst
pqEnc = PQEncryption $ supportPQ pqSupport
proxySrv = if viaProxy then Just testSMPServer else Nothing
message i = "message " <> bshow i
send :: AgentClient -> ConnId -> [Int64] -> ExceptT AgentErrorType IO ()
send a bId = mapM_ $ \i -> void $ A.sendMessage a bId pqEnc SMP.noMsgFlags (message i)
receive :: AgentClient -> ConnId -> TVar AgentMsgId -> (Int64, Int64, Int64, Int64) -> ExceptT AgentErrorType IO ()
receive a bId mIdVar acc' = loop acc' >> liftIO drain
where
drain =
timeout 100000 (get a)
>>= mapM_ (\case ("", _, QCONT) -> drain; r -> expectationFailure $ "unexpected: " <> show r)
loop (0, 0, 0, 0) = pure ()
loop acc@(!s, !m, !r, !o) =
timeout 3000000 (get a) >>= \case
Nothing -> error $ "timeout " <> show acc
Just evt -> case evt of
("", c, A.SENT mId srv) -> do
liftIO $ c == bId && srv == proxySrv `shouldBe` True
unless (s > 0) $ error "unexpected SENT"
loop (s - 1, m, r, o)
("", c, QCONT) -> do
liftIO $ c == bId `shouldBe` True
loop (s, m, r, o)
("", c, Msg' mId pq msg) -> do
-- tests that mId increases
liftIO $ (mId >) <$> atomically (swapTVar mIdVar mId) `shouldReturn` True
liftIO $ c == bId && pq == pqEnc && ("message " `B.isPrefixOf` msg) `shouldBe` True
ackMessageAsync a "123" bId mId (Just "")
unless (m > 0) $ error "unexpected MSG"
loop (s, m - 1, r, o)
("", c, Rcvd' mId rcvdMsgId) -> do
liftIO $ (mId >) <$> atomically (swapTVar mIdVar mId) `shouldReturn` True
liftIO $ c == bId `shouldBe` True
ackMessageAsync a "123" bId mId Nothing
unless (r > 0) $ error "unexpected RCVD"
loop (s, m, r - 1, o)
("123", c, OK) -> do
liftIO $ c == bId `shouldBe` True
unless (o > 0) $ error "unexpected OK"
loop (s, m, r, o - 1)
_ -> liftIO $ expectationFailure $ "unexpected: " <> show r
testEnablePQEncryption :: HasCallStack => IO ()
testEnablePQEncryption =
@@ -999,10 +1036,10 @@ noMessages_ :: Bool -> HasCallStack => AgentClient -> String -> Expectation
noMessages_ ingoreQCONT c err = tryGet `shouldReturn` ()
where
tryGet =
10000 `timeout` get c >>= \case
50000 `timeout` get c >>= \case
Just (_, _, QCONT) | ingoreQCONT -> noMessages_ ingoreQCONT c err
Just msg -> error $ err <> ": " <> show msg
_ -> return ()
Nothing -> return ()
testRejectContactRequest :: HasCallStack => IO ()
testRejectContactRequest =
@@ -1335,12 +1372,12 @@ testInvitationShortLink viaProxy a b =
let userData = UserLinkData "some user data"
newLinkData = UserInvLinkData userData
(bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe
(connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
-- same user can get invitation link again
(connReq2, connData2) <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq2}, connData2) <- runRight $ getConnShortLink b 1 shortLink
connReq2 `shouldBe` connReq
linkUserData connData2 `shouldBe` userData
-- another user cannot get the same invitation link
@@ -1378,12 +1415,12 @@ testInvitationShortLinkAsync viaProxy a b = do
let userData = UserLinkData "some user data"
newLinkData = UserInvLinkData userData
(bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe
(connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
runRight $ do
aId <- A.joinConnectionAsync b 1 "123" True connReq "bob's connInfo" PQSupportOn SMSubscribe
aId <- A.joinConnectionAsync b 1 "123" Nothing True connReq "bob's connInfo" PQSupportOn SMSubscribe
get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False
("", _, CONF confId _ "bob's connInfo") <- get a
allowConnection a bId confId "alice's connInfo"
@@ -1406,16 +1443,16 @@ testContactShortLink viaProxy a b =
newLinkData = UserContactLinkData userCtData
(contactId, (CCLink connReq0 (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMSubscribe
Right connReq <- pure $ smpDecode (smpEncode connReq0)
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
userCtData' `shouldBe` userCtData
-- same user can get contact link again
(connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
connReq2 `shouldBe` connReq
userCtData2 `shouldBe` userCtData
-- another user can get the same contact link
(connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
(FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
connReq3 `shouldBe` connReq
userCtData3 `shouldBe` userCtData
runRight $ do
@@ -1437,7 +1474,7 @@ testContactShortLink viaProxy a b =
userLinkData' = UserContactLinkData updatedCtData
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
shortLink' `shouldBe` shortLink
(connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
(FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
connReq4 `shouldBe` connReq
updatedCtData' `shouldBe` updatedCtData
-- one more time
@@ -1457,16 +1494,16 @@ testAddContactShortLink viaProxy a b =
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
newLinkData = UserContactLinkData userCtData
shortLink <- runRight $ setConnShortLink a contactId SCMContact newLinkData Nothing
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
userCtData' `shouldBe` userCtData
-- same user can get contact link again
(connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
connReq2 `shouldBe` connReq
userCtData2 `shouldBe` userCtData
-- another user can get the same contact link
(connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
(FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
connReq3 `shouldBe` connReq
userCtData3 `shouldBe` userCtData
runRight $ do
@@ -1488,7 +1525,7 @@ testAddContactShortLink viaProxy a b =
userLinkData' = UserContactLinkData updatedCtData
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
shortLink' `shouldBe` shortLink
(connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
(FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
connReq4 `shouldBe` connReq
updatedCtData' `shouldBe` updatedCtData
@@ -1500,7 +1537,7 @@ testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do
runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMOnlyCreate
withSmpServer ps $ do
runRight_ $ subscribeConnection a bId
(connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
@@ -1517,16 +1554,16 @@ testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
updatedLinkData = UserContactLinkData updatedCtData
withSmpServer ps $ do
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
(fd', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkConnReq fd' `shouldBe` connReq
userCtData' `shouldBe` userCtData
-- update user data
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedLinkData Nothing
shortLink' `shouldBe` shortLink
withSmpServer ps $ do
(connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
connReq4 `shouldBe` connReq
(fd4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
linkConnReq fd4 `shouldBe` connReq
updatedCtData' `shouldBe` updatedCtData
testAddContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
@@ -1542,16 +1579,16 @@ testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
updatedLinkData = UserContactLinkData updatedCtData
withSmpServer ps $ do
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
(fd', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkConnReq fd' `shouldBe` connReq
userCtData' `shouldBe` userCtData
-- update user data
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedLinkData Nothing
shortLink' `shouldBe` shortLink
withSmpServer ps $ do
(connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
connReq4 `shouldBe` connReq
(fd4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
linkConnReq fd4 `shouldBe` connReq
updatedCtData' `shouldBe` updatedCtData
testOldContactQueueShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
@@ -1589,7 +1626,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userLinkData = UserContactLinkData userCtData
shortLink <- runRight $ setConnShortLink a contactId SCMContact userLinkData Nothing
(connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
userCtData' `shouldBe` userCtData
@@ -1600,7 +1637,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
shortLink' `shouldBe` shortLink
-- check updated
(connReq'', ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq''}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
connReq'' `shouldBe` connReq
updatedCtData' `shouldBe` updatedCtData
@@ -1610,6 +1647,36 @@ replaceSubstringInFile filePath oldText newText = do
let newContent = T.replace oldText newText content
T.writeFile filePath newContent
testPrepareCreateConnectionLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
let userData = UserLinkData "test user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userLinkData = UserContactLinkData userCtData
g <- C.newRandom
linkEntId <- atomically $ C.randomBytes 32 g
runRight $ do
((_rootPubKey, _rootPrivKey), ccLink@(CCLink connReq (Just shortLink)), preparedParams) <-
A.prepareConnectionLink a 1 (Just linkEntId) True Nothing
liftIO $ strDecode (strEncode shortLink) `shouldBe` Right shortLink
_ <- A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams userLinkData CR.IKPQOn SMSubscribe
(FixedLinkData {linkConnReq = connReq', linkEntityId}, ContactLinkData _ userCtData') <- getConnShortLink b 1 shortLink
liftIO $ Just linkEntId `shouldBe` linkEntityId
Right connReqDecoded <- pure $ smpDecode (smpEncode connReq)
liftIO $ connReq' `shouldBe` connReqDecoded
liftIO $ userCtData' `shouldBe` userCtData
(bId, sndSecure) <- joinConnection b 1 True connReq' "bob's connInfo" SMSubscribe
liftIO $ sndSecure `shouldBe` False
("", _, REQ invId _ "bob's connInfo") <- get a
aId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
(sndSecure', Nothing) <- acceptContact a 1 aId True invId "alice's connInfo" PQSupportOn SMSubscribe
liftIO $ sndSecure' `shouldBe` True
("", _, CONF confId _ "alice's connInfo") <- get b
allowConnection b bId confId "bob's connInfo"
get a ##> ("", aId, INFO "bob's connInfo")
get a ##> ("", aId, CON)
get b ##> ("", bId, CON)
exchangeGreetings a aId b bId
testIncreaseConnAgentVersion :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testIncreaseConnAgentVersion ps = do
alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
@@ -2583,7 +2650,7 @@ testAsyncCommands sqSecured alice bob baseId =
bobId <- createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe
("1", bobId', INV (ACR _ qInfo)) <- get alice
liftIO $ bobId' `shouldBe` bobId
aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
aliceId <- joinConnectionAsync bob 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
("2", aliceId', JOINED sqSecured') <- get bob
liftIO $ do
aliceId' `shouldBe` aliceId
@@ -2628,6 +2695,66 @@ testAsyncCommands sqSecured alice bob baseId =
where
msgId = subtract baseId
testSetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO ()
testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
let userData = UserLinkData "test user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
newLinkData = UserContactLinkData userCtData
(cId, (CCLink qInfo (Just shortLink), _)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe
-- verify initial link data
(_, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink
liftIO $ userCtData' `shouldBe` userCtData
-- update link data async
let updatedData = UserLinkData "updated user data"
updatedCtData = UserContactData {direct = False, owners = [], relays = [], userData = updatedData}
setConnShortLinkAsync alice "1" cId (UserContactLinkData updatedCtData) Nothing
("1", cId', LINK shortLink' (UserContactLinkData updatedCtData')) <- get alice
liftIO $ cId' `shouldBe` cId
liftIO $ shortLink' `shouldBe` shortLink
liftIO $ updatedCtData' `shouldBe` updatedCtData
-- verify updated link data
(_, ContactLinkData _ updatedCtData'') <- getConnShortLink bob 1 shortLink'
liftIO $ updatedCtData'' `shouldBe` updatedCtData
-- complete connection via contact address
(aliceId, _) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
("", _, REQ invId _ "bob's connInfo") <- get alice
bobId <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
(_, Nothing) <- acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
("", _, CONF confId _ "alice's connInfo") <- get bob
allowConnection bob aliceId confId "bob's connInfo"
get alice ##> ("", bobId, INFO "bob's connInfo")
get alice ##> ("", bobId, CON)
get bob ##> ("", aliceId, CON)
testGetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO ()
testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
let userData = UserLinkData "test user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
newLinkData = UserContactLinkData userCtData
(_, (CCLink qInfo (Just shortLink), _)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe
-- get link data async - creates new connection for bob
newId <- getConnShortLinkAsync bob 1 "1" shortLink
("1", newId', LDATA FixedLinkData {linkConnReq = qInfo'} (ContactLinkData _ userCtData')) <- get bob
liftIO $ newId' `shouldBe` newId
liftIO $ qInfo' `shouldBe` qInfo
liftIO $ userCtData' `shouldBe` userCtData
-- join connection async using connId from getConnShortLinkAsync
aliceId <- joinConnectionAsync bob 1 "2" (Just newId) True qInfo' "bob's connInfo" PQSupportOn SMSubscribe
liftIO $ aliceId `shouldBe` newId
("2", aliceId', JOINED False) <- get bob
liftIO $ aliceId' `shouldBe` aliceId
-- complete connection
("", _, REQ invId _ "bob's connInfo") <- get alice
bobId <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
(_, Nothing) <- acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
("", _, CONF confId _ "alice's connInfo") <- get bob
allowConnection bob aliceId confId "bob's connInfo"
get alice ##> ("", bobId, INFO "bob's connInfo")
get alice ##> ("", bobId, CON)
get bob ##> ("", aliceId, CON)
testAsyncCommandsRestore :: (ASrvTransport, AStoreType) -> IO ()
testAsyncCommandsRestore ps = do
alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
@@ -2921,7 +3048,7 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do
bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe
("1", bId', INV (ACR _ qInfo)) <- get a
liftIO $ bId' `shouldBe` bId
aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
liftIO $ threadDelay 500000
ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
pure (aId, bId)
@@ -2966,7 +3093,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe
("1", bId', INV (ACR _ qInfo)) <- get a
liftIO $ bId' `shouldBe` bId
aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
liftIO $ threadDelay 500000
ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
pure (aId, bId)
@@ -3679,13 +3806,21 @@ getSMPAgentClient' clientId cfg' initServers dbPath = do
#if defined(dbPostgres)
createStore :: String -> IO (Either MigrationError DBStore)
createStore schema = createAgentStore (DBOpts testDBConnstr (B.pack schema) 1 True) (MigrationConfig MCError Nothing)
createStore schema = createAgentStore dbOpts $ MigrationConfig MCError Nothing
where
dbOpts =
DBOpts
{ connstr = testDBConnstr,
schema = B.pack schema,
poolSize = 10,
createSchema = True
}
insertUser :: DBStore -> IO ()
insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users DEFAULT VALUES")
#else
createStore :: String -> IO (Either MigrationError DBStore)
createStore dbPath = createAgentStore (DBOpts dbPath "" False True DB.TQOff) (MigrationConfig MCError Nothing)
createStore dbPath = createAgentStore (DBOpts dbPath [] "" False True DB.TQOff) (MigrationConfig MCError Nothing)
insertUser :: DBStore -> IO ()
insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) VALUES (1)")
+1
View File
@@ -230,6 +230,7 @@ createStore randSuffix migrations confirmMigrations = do
let dbOpts =
DBOpts {
dbFilePath = testDB randSuffix,
dbFunctions = [],
dbKey = "",
keepKey = False,
vacuum = True,
+21 -18
View File
@@ -72,7 +72,7 @@ withStore2 = before connect2 . after (removeStore . fst)
connect2 :: IO (DBStore, DBStore)
connect2 = do
s1@DBStore {dbFilePath} <- createStore'
s2 <- connectSQLiteStore dbFilePath "" False DB.TQOff
s2 <- connectSQLiteStore $ DBOpts dbFilePath [] "" False False DB.TQOff
pure (s1, s2)
createStore' :: IO DBStore
@@ -83,7 +83,7 @@ createEncryptedStore key keepKey = do
-- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous
-- IO operations on multiple similarly named files; error seems to be environment specific
r <- randomIO :: IO Word32
Right st <- createDBStore (DBOpts (testDB <> show r) key keepKey True DB.TQOff) appMigrations (MigrationConfig MCError Nothing)
Right st <- createDBStore (DBOpts (testDB <> show r) [] key keepKey True DB.TQOff) appMigrations (MigrationConfig MCError Nothing)
withTransaction' st (`SQL.execute_` "INSERT INTO users (user_id) VALUES (1);")
pure st
@@ -778,14 +778,15 @@ testGetNextSndFileToPrepare st = do
withTransaction st $ \db -> do
Right Nothing <- getNextSndFileToPrepare db 86400
Right _ <- createSndFile db g 1 (CryptoFile "filepath" Nothing) 1 "filepath" testFileSbKey testFileCbNonce Nothing
DB.execute_ db "UPDATE snd_files SET status = 'new', num_recipients = 'bad' WHERE snd_file_id = 1"
-- Can't test it with strict tables
-- Right _ <- createSndFile db g 1 (CryptoFile "filepath" Nothing) 1 "filepath" testFileSbKey testFileCbNonce Nothing
-- DB.execute_ db "UPDATE snd_files SET status = 'new', num_recipients = 'bad' WHERE snd_file_id = 1"
Right fId2 <- createSndFile db g 1 (CryptoFile "filepath" Nothing) 1 "filepath" testFileSbKey testFileCbNonce Nothing
DB.execute_ db "UPDATE snd_files SET status = 'new' WHERE snd_file_id = 2"
Left e <- getNextSndFileToPrepare db 86400
show e `shouldContain` "ConversionFailed"
DB.query_ db "SELECT snd_file_id FROM snd_files WHERE failed = 1" `shouldReturn` [Only (1 :: Int)]
-- Left e <- getNextSndFileToPrepare db 86400
-- show e `shouldContain` "ConversionFailed"
-- DB.query_ db "SELECT snd_file_id FROM snd_files WHERE failed = 1" `shouldReturn` [Only (1 :: Int)]
Right (Just SndFile {sndFileEntityId}) <- getNextSndFileToPrepare db 86400
sndFileEntityId `shouldBe` fId2
@@ -808,16 +809,17 @@ testGetNextSndChunkToUpload st = do
-- create file 1
Right _ <- createSndFile db g 1 (CryptoFile "filepath" Nothing) 1 "filepath" testFileSbKey testFileCbNonce Nothing
updateSndFileEncrypted db 1 (FileDigest "abc") [(XFTPChunkSpec "filepath" 1 1, FileDigest "ghi")]
createSndFileReplica_ db 1 newSndChunkReplica1
DB.execute_ db "UPDATE snd_files SET num_recipients = 'bad' WHERE snd_file_id = 1"
-- Can't test it with strict tables
-- createSndFileReplica_ db 1 newSndChunkReplica1
-- DB.execute_ db "UPDATE snd_files SET num_recipients = 'bad' WHERE snd_file_id = 1"
-- create file 2
Right fId2 <- createSndFile db g 1 (CryptoFile "filepath" Nothing) 1 "filepath" testFileSbKey testFileCbNonce Nothing
updateSndFileEncrypted db 2 (FileDigest "abc") [(XFTPChunkSpec "filepath" 1 1, FileDigest "ghi")]
createSndFileReplica_ db 2 newSndChunkReplica1
Left e <- getNextSndChunkToUpload db xftpServer1 86400
show e `shouldContain` "ConversionFailed"
DB.query_ db "SELECT snd_file_id FROM snd_files WHERE failed = 1" `shouldReturn` [Only (1 :: Int)]
-- Left e <- getNextSndChunkToUpload db xftpServer1 86400
-- show e `shouldContain` "ConversionFailed"
-- DB.query_ db "SELECT snd_file_id FROM snd_files WHERE failed = 1" `shouldReturn` [Only (1 :: Int)]
Right (Just SndFileChunk {sndFileEntityId}) <- getNextSndChunkToUpload db xftpServer1 86400
sndFileEntityId `shouldBe` fId2
@@ -827,16 +829,17 @@ testGetNextDeletedSndChunkReplica st = do
withTransaction st $ \db -> do
Right Nothing <- getNextDeletedSndChunkReplica db xftpServer1 86400
createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId $ EntityId "abc") testFileReplicaKey) (FileDigest "ghi")
DB.execute_ db "UPDATE deleted_snd_chunk_replicas SET delay = 'bad' WHERE deleted_snd_chunk_replica_id = 1"
-- Can't test it with strict tables
-- createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId $ EntityId "abc") testFileReplicaKey) (FileDigest "ghi")
-- DB.execute_ db "UPDATE deleted_snd_chunk_replicas SET delay = 'bad' WHERE deleted_snd_chunk_replica_id = 1"
createDeletedSndChunkReplica db 1 (FileChunkReplica xftpServer1 (ChunkReplicaId $ EntityId "abc") testFileReplicaKey) (FileDigest "ghi")
Left e <- getNextDeletedSndChunkReplica db xftpServer1 86400
show e `shouldContain` "ConversionFailed"
DB.query_ db "SELECT deleted_snd_chunk_replica_id FROM deleted_snd_chunk_replicas WHERE failed = 1" `shouldReturn` [Only (1 :: Int)]
-- Left e <- getNextDeletedSndChunkReplica db xftpServer1 86400
-- show e `shouldContain` "ConversionFailed"
-- DB.query_ db "SELECT deleted_snd_chunk_replica_id FROM deleted_snd_chunk_replicas WHERE failed = 1" `shouldReturn` [Only (1 :: Int)]
Right (Just DeletedSndChunkReplica {deletedSndChunkReplicaId}) <- getNextDeletedSndChunkReplica db xftpServer1 86400
deletedSndChunkReplicaId `shouldBe` 2
deletedSndChunkReplicaId `shouldBe` 1
testMarkNtfSubActionNtfFailed :: DBStore -> Expectation
testMarkNtfSubActionNtfFailed st = do
+14 -6
View File
@@ -7,6 +7,7 @@ import Control.DeepSeq
import Control.Monad (unless, void)
import Data.List (dropWhileEnd)
import Data.Maybe (fromJust, isJust)
import Data.Text (Text)
import Database.SQLite.Simple (Only (..))
import qualified Database.SQLite.Simple as SQL
import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations)
@@ -44,6 +45,7 @@ schemaDumpTest = do
it "verify and overwrite schema dump" testVerifySchemaDump
it "verify .lint fkey-indexes" testVerifyLintFKeyIndexes
it "verify schema down migrations" testSchemaMigrations
it "verify strict tables" testVerifyStrict
it "should NOT create user record for new database" testUsersMigrationNew
it "should create user record for old database" testUsersMigrationOld
@@ -51,7 +53,7 @@ testVerifySchemaDump :: IO ()
testVerifySchemaDump = do
savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
savedSchema `deepseq` pure ()
void $ createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing)
void $ createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing)
getSchema testDB appSchema `shouldReturn` savedSchema
removeFile testDB
@@ -59,14 +61,14 @@ testVerifyLintFKeyIndexes :: IO ()
testVerifyLintFKeyIndexes = do
savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "")
savedLint `deepseq` pure ()
void $ createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing)
void $ createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing)
getLintFKeyIndexes testDB "tests/tmp/agent_lint.sql" `shouldReturn` savedLint
removeFile testDB
testSchemaMigrations :: IO ()
testSchemaMigrations = do
let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) appMigrations
Right st <- createDBStore (DBOpts testDB "" False True TQOff) noDownMigrations (MigrationConfig MCError Nothing)
Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) noDownMigrations (MigrationConfig MCError Nothing)
mapM_ (testDownMigration st) $ drop (length noDownMigrations) appMigrations
closeDBStore st
removeFile testDB
@@ -87,9 +89,15 @@ testSchemaMigrations = do
schema''' <- getSchema testDB testSchema
schema''' `shouldBe` schema'
testVerifyStrict :: IO ()
testVerifyStrict = do
Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing)
withTransaction' st (`SQL.query_` "SELECT name FROM sqlite_master WHERE type = 'table' AND name != 'sqlite_sequence' AND sql NOT LIKE '% STRICT'")
`shouldReturn` ([] :: [Only Text])
testUsersMigrationNew :: IO ()
testUsersMigrationNew = do
Right st <- createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCError Nothing)
Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCError Nothing)
withTransaction' st (`SQL.query_` "SELECT user_id FROM users;")
`shouldReturn` ([] :: [Only Int])
closeDBStore st
@@ -97,11 +105,11 @@ testUsersMigrationNew = do
testUsersMigrationOld :: IO ()
testUsersMigrationOld = do
let beforeUsers = takeWhile (("m20230110_users" /=) . name) appMigrations
Right st <- createDBStore (DBOpts testDB "" False True TQOff) beforeUsers (MigrationConfig MCError Nothing)
Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) beforeUsers (MigrationConfig MCError Nothing)
withTransaction' st (`SQL.query_` "SELECT name FROM sqlite_master WHERE type = 'table' AND name = 'users';")
`shouldReturn` ([] :: [Only String])
closeDBStore st
Right st' <- createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCYesUp Nothing)
Right st' <- createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCYesUp Nothing)
withTransaction' st' (`SQL.query_` "SELECT user_id FROM users;")
`shouldReturn` ([Only (1 :: Int)])
closeDBStore st'
+129 -11
View File
@@ -11,10 +11,14 @@ import AgentTests.ConnectionRequestTests (contactConnRequest, invConnRequest)
import AgentTests.EqInstances ()
import Control.Concurrent.STM
import Control.Monad.Except
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), ConnLinkData (..), ConnectionMode (..), ConnShortLink (..), LinkKey (..), UserConnLinkData (..), SConnectionMode (..), SMPAgentError (..), UserContactData (..), UserLinkData (..), linkUserData, supportedSMPAgentVRange)
import Crypto.Random (ChaChaDRG)
import qualified Data.ByteString.Base64.URL as B64
import qualified Data.ByteString.Char8 as B
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.ShortLink as SL
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (EncFixedDataBytes)
import Test.Hspec hiding (fit, it)
import Util
@@ -28,6 +32,10 @@ shortLinkTests = do
it "should encrypt updated user data" testUpdateContactShortLink
it "should fail to decrypt contact data with bad hash" testContactShortLinkBadDataHash
it "should fail to decrypt contact data with bad signature" testContactShortLinkBadSignature
describe "contact link with additional owners" $ do
it "should encrypt and decrypt data with additional owner" testContactShortLinkOwner
it "should encrypt and decrypt data with many additional owners" testContactShortLinkManyOwners
it "should fail to decrypt contact data with invalid or unauthorized owners" testContactShortLinkInvalidOwners
testInvShortLink :: IO ()
testInvShortLink = do
@@ -36,11 +44,11 @@ testInvShortLink = do
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
userLinkData = UserInvLinkData userData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange invConnRequest userLinkData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange invConnRequest Nothing userLinkData
k = SL.invShortLinkKdf linkKey
Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
-- decrypt
Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k srvData
Right (FixedLinkData {linkConnReq = connReq}, connData') <- pure $ SL.decryptLinkData linkKey k srvData
connReq `shouldBe` invConnRequest
linkUserData connData' `shouldBe` userData
@@ -51,7 +59,7 @@ testInvShortLinkBadDataHash = do
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
userLinkData = UserInvLinkData userData
(_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange invConnRequest userLinkData
(_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange invConnRequest Nothing userLinkData
-- different key
linkKey <- LinkKey <$> atomically (C.randomBytes 32 g)
let k = SL.invShortLinkKdf linkKey
@@ -74,11 +82,11 @@ testContactShortLink = do
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userLinkData = UserContactLinkData userCtData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userLinkData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
-- decrypt
Right (connReq, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData
Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData
connReq `shouldBe` contactConnRequest
userCtData' `shouldBe` userCtData
@@ -90,7 +98,7 @@ testUpdateContactShortLink = do
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userLinkData = UserContactLinkData userCtData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userLinkData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
-- encrypt updated user data
@@ -100,7 +108,7 @@ testUpdateContactShortLink = do
signed = SL.encodeSignUserData SCMContact (snd sigKeys) supportedSMPAgentVRange userLinkData'
Right ud' <- runExceptT $ SL.encryptUserData g k signed
-- decrypt
Right (connReq, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud')
Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud')
connReq `shouldBe` contactConnRequest
userCtData'' `shouldBe` userCtData'
@@ -111,7 +119,7 @@ testContactShortLinkBadDataHash = do
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
(_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userLinkData
(_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData
-- different key
linkKey <- LinkKey <$> atomically (C.randomBytes 32 g)
let (_linkId, k) = SL.contactShortLinkKdf linkKey
@@ -127,7 +135,7 @@ testContactShortLinkBadSignature = do
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userLinkData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
-- encrypt updated user data
@@ -140,3 +148,113 @@ testContactShortLinkBadSignature = do
-- decryption fails
SL.decryptLinkData @'CMContact linkKey k (fd, ud')
`shouldBe` Left (AGENT (A_LINK "user data signature"))
testContactShortLinkOwner :: IO ()
testContactShortLinkOwner = do
-- encrypt
g <- C.newRandom
(pk, lnk) <- encryptLink g
-- encrypt updated user data
(ownerPK, owner) <- authNewOwner g pk
let ud = UserContactData {direct = True, owners = [owner], relays = [], userData = UserLinkData "updated user data"}
testEncDec g pk lnk ud
testEncDec g ownerPK lnk ud
(_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
testEncDecFail g wrongKey lnk ud $ A_LINK "user data signature"
encryptLink :: TVar ChaChaDRG -> IO (C.PrivateKeyEd25519, (EncFixedDataBytes, LinkKey, C.SbKey))
encryptLink g = do
sigKeys@(_, pk) <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
pure (pk, (fd, linkKey, k))
authNewOwner :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> IO (C.PrivateKeyEd25519, OwnerAuth)
authNewOwner g pk = do
(ownerKey, ownerPK) <- atomically $ C.generateKeyPair @'C.Ed25519 g
ownerId <- atomically $ C.randomBytes 16 g
let authOwnerSig = C.sign' pk $ ownerId <> C.encodePubKey ownerKey
pure (ownerPK, OwnerAuth {ownerId, ownerKey, authOwnerSig})
testEncDec :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> (EncFixedDataBytes, LinkKey, C.SbKey) -> UserContactData -> IO ()
testEncDec g pk (fd, linkKey, k) ctData = do
let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange $ UserContactLinkData ctData
Right ud <- runExceptT $ SL.encryptUserData g k signed
Right (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud)
connReq' `shouldBe` contactConnRequest
ctData' `shouldBe` ctData
testContactShortLinkManyOwners :: IO ()
testContactShortLinkManyOwners = do
-- encrypt
g <- C.newRandom
(pk, lnk) <- encryptLink g
-- encrypt updated user data
(ownerPK1, owner1) <- authNewOwner g pk
(ownerPK2, owner2) <- authNewOwner g pk
(ownerPK3, owner3) <- authNewOwner g ownerPK1
(ownerPK4, owner4) <- authNewOwner g ownerPK1
(ownerPK5, owner5) <- authNewOwner g ownerPK3
let owners = [owner1, owner2, owner3, owner4, owner5]
ud = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data"}
testEncDec g pk lnk ud
testEncDec g ownerPK1 lnk ud
testEncDec g ownerPK2 lnk ud
testEncDec g ownerPK3 lnk ud
testEncDec g ownerPK4 lnk ud
testEncDec g ownerPK5 lnk ud
(_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
testEncDecFail g wrongKey lnk ud $ A_LINK "user data signature"
testContactShortLinkInvalidOwners :: IO ()
testContactShortLinkInvalidOwners = do
-- encrypt
g <- C.newRandom
(pk, lnk) <- encryptLink g
-- encrypt updated user data
(ownerPK, owner) <- authNewOwner g pk
let mkCtData owners = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data"}
-- decryption fails: owner uses root key
let ud = mkCtData [owner {ownerKey = C.publicKey pk}]
err = A_LINK $ "owner key for ID " <> ownerIdStr owner <> " matches root key"
testEncDecFail g pk lnk ud err
testEncDecFail g ownerPK lnk ud err
-- decryption fails: duplicate owner ID or key
(ownerPK1, owner1) <- authNewOwner g pk
let ud1 = mkCtData [owner, owner1 {ownerId = ownerId owner}]
ud1' = mkCtData [owner, owner1 {ownerKey = ownerKey owner}]
err1 o = A_LINK $ "duplicate owner key or ID " <> ownerIdStr o
testEncDecFail g pk lnk ud1 $ err1 owner
testEncDecFail g pk lnk ud1' $ err1 owner1
-- decryption fails: wrong order
(ownerPK2, owner2) <- authNewOwner g ownerPK
let ud2 = mkCtData [owner, owner1, owner2]
ud2' = mkCtData [owner, owner2, owner1]
testEncDec g pk lnk ud2
testEncDec g pk lnk ud2'
testEncDec g ownerPK lnk ud2
testEncDec g ownerPK1 lnk ud2
testEncDec g ownerPK2 lnk ud2
let ud2'' = mkCtData [owner2, owner, owner1]
err2 = A_LINK $ "invalid authorization of owner ID " <> ownerIdStr owner2
testEncDecFail g pk lnk ud2'' err2
-- decryption fails: authorized with wrong key
(_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
(_, owner3) <- authNewOwner g wrongKey
let ud3 = mkCtData [owner3]
ud3' = mkCtData [owner, owner1, owner2, owner3]
err3 = A_LINK $ "invalid authorization of owner ID " <> ownerIdStr owner3
testEncDecFail g pk lnk ud3 err3
testEncDecFail g pk lnk ud3' err3
testEncDecFail :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> (EncFixedDataBytes, LinkKey, C.SbKey) -> UserContactData -> SMPAgentError -> IO ()
testEncDecFail g pk (fd, linkKey, k) ctData err = do
let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange $ UserContactLinkData ctData
Right ud <- runExceptT $ SL.encryptUserData g k signed
SL.decryptLinkData @'CMContact linkKey k (fd, ud) `shouldBe` Left (AGENT err)
ownerIdStr :: OwnerAuth -> String
ownerIdStr OwnerAuth {ownerId} = B.unpack $ B64.encodeUnpadded ownerId
+33 -1
View File
@@ -3,7 +3,7 @@
module CoreTests.UtilTests where
import AgentTests.FunctionalAPITests ()
import Control.Exception (Exception, SomeException, throwIO)
import Control.Exception (AllocationLimitExceeded (..), AsyncException (..), Exception, SomeException, throwIO)
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.IORef
@@ -71,11 +71,43 @@ utilTests = do
runExceptT (throwTestException `allFinally` final) `shouldReturn` Left (TestException "user error (error)")
it "and should not throw if there are no exceptions" $ withFinal $ \final ->
runExceptT (noErrors `allFinally` final) `shouldReturn` Right "no errors"
describe "tryAllOwnErrors" $ do
it "should return ExceptT error as Left" $
runExceptT (tryAllOwnErrors throwTestError) `shouldReturn` Right (Left (TestError "error"))
it "should return SomeException as Left" $
runExceptT (tryAllOwnErrors throwTestException) `shouldReturn` Right (Left (TestException "user error (error)"))
it "should catch StackOverflow" $
runExceptT (tryAllOwnErrors $ throwAsync StackOverflow) `shouldReturn` Right (Left (TestException "stack overflow"))
it "should catch HeapOverflow" $
runExceptT (tryAllOwnErrors $ throwAsync HeapOverflow) `shouldReturn` Right (Left (TestException "heap overflow"))
it "should catch AllocationLimitExceeded" $
runExceptT (tryAllOwnErrors $ throwAsync AllocationLimitExceeded) `shouldReturn` Right (Left (TestException "allocation limit exceeded"))
it "should rethrow ThreadKilled" $
runExceptT (tryAllOwnErrors $ throwAsync ThreadKilled) `shouldThrow` (\e -> e == ThreadKilled)
it "should return no errors as Right" $
runExceptT (tryAllOwnErrors noErrors) `shouldReturn` Right (Right "no errors")
describe "catchAllOwnErrors" $ do
it "should catch ExceptT error" $
runExceptT (throwTestError `catchAllOwnErrors` handleCatch) `shouldReturn` Right "caught TestError \"error\""
it "should catch SomeException" $
runExceptT (throwTestException `catchAllOwnErrors` handleCatch) `shouldReturn` Right "caught TestException \"user error (error)\""
it "should catch StackOverflow" $
runExceptT (throwAsync StackOverflow `catchAllOwnErrors` handleCatch) `shouldReturn` Right "caught TestException \"stack overflow\""
it "should catch HeapOverflow" $
runExceptT (throwAsync HeapOverflow `catchAllOwnErrors` handleCatch) `shouldReturn` Right "caught TestException \"heap overflow\""
it "should catch AllocationLimitExceeded" $
runExceptT (throwAsync AllocationLimitExceeded `catchAllOwnErrors` handleCatch) `shouldReturn` Right "caught TestException \"allocation limit exceeded\""
it "should rethrow ThreadKilled" $
runExceptT (throwAsync ThreadKilled `catchAllOwnErrors` handleCatch) `shouldThrow` (\e -> e == ThreadKilled)
it "should not throw if there are no errors" $
runExceptT (noErrors `catchAllOwnErrors` throwError) `shouldReturn` Right "no errors"
where
throwTestError :: ExceptT TestError IO String
throwTestError = throwError $ TestError "error"
throwTestException :: ExceptT TestError IO String
throwTestException = liftIO $ throwIO $ userError "error"
throwAsync :: Exception e => e -> ExceptT TestError IO String
throwAsync = liftIO . throwIO
noErrors :: ExceptT TestError IO String
noErrors = pure "no errors"
handleCatch :: TestError -> ExceptT TestError IO String
+1 -1
View File
@@ -87,7 +87,7 @@ ntfTestStoreDBOpts =
DBOpts
{ connstr = ntfTestServerDBConnstr,
schema = "ntf_server",
poolSize = 3,
poolSize = 10,
createSchema = True
}
+64 -18
View File
@@ -53,7 +53,7 @@ ntfServerTests :: (ASrvTransport, AStoreType) -> Spec
ntfServerTests ps@(t, _) = do
describe "Notifications server protocol syntax" $ ntfSyntaxTests t
describe "Notification subscriptions (NKEY)" $ testNotificationSubscription ps createNtfQueueNKEY
-- describe "Notification subscriptions (NEW with ntf creds)" $ testNotificationSubscription ps createNtfQueueNEW
describe "Notification subscriptions (NEW with ntf creds)" $ testNotificationSubscription ps createNtfQueueNEW
describe "Retried notification subscription" $ testRetriedNtfSubscription ps
ntfSyntaxTests :: ASrvTransport -> Spec
@@ -109,8 +109,9 @@ testNotificationSubscription (ATransport t, msType) createQueue =
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
let tkn = DeviceToken PPApnsTest "abcd"
withAPNSMockServer $ \apns ->
smpTest2 t msType $ \rh sh ->
ntfTest t $ \nh -> do
ntfTest t $ \nh -> do
v <- newEmptyTMVarIO
smpTest2 t msType $ \rh sh -> do
((sId, rId, rKey, rcvDhSecret), nId, rcvNtfDhSecret) <- createQueue rh sPub nPub
-- register and verify token
RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
@@ -181,6 +182,52 @@ testNotificationSubscription (ATransport t, msType) createQueue =
PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer3, notifierId = notifierId3}} = L.last pnMsgs2
smpServer3 `shouldBe` srv
notifierId3 `shouldBe` nId
Resp "" _ (MSG RcvMessage {msgId = mId2, msgBody = EncRcvMsgBody body2}) <- tGet1 rh
Right ClientRcvMsgBody {msgBody = "hello 2"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId2) body2)
Resp "10" _ OK <- signSendRecv rh rKey ("10", rId, ACK mId2)
q2 <- createQueue rh sPub nPub
atomically $ putTMVar v (sId, rId, rKey, nId, dhSecret, rcvDhSecret, tId, tkn', srv, q2)
(sId, rId, rKey, nId, dhSecret, rcvDhSecret, tId, tkn', srv, q2) <- atomically $ readTMVar v
let ((sId', rId', rKey', rcvDhSecret'), nId', _rcvNtfDhSecret') = q2
RespNtf "11" _ (NRSubId _subId) <- signSendRecvNtf nh tknKey ("11", NoEntity, SNEW $ NewNtfSub tId (SMPQueueNtf srv nId') nKey)
threadDelay 250000
smpTest2 t msType $ \rh sh -> do
Resp "12" _ (SOK Nothing) <- signSendRecv rh rKey ("12", rId, SUB)
Resp "12.1" _ (SOK Nothing) <- signSendRecv rh rKey' ("12.1", rId', SUB)
-- deliver to queue with ntf sub created while SMP was online
Resp "14" _ OK <- signSendRecv sh sKey ("14", sId, _SEND' "hello 3")
APNSMockRequest {notification = notification4} <- getMockNotification apns tkn'
let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData4} = notification4
Right nonce4 = C.cbNonce <$> ntfData4 .-> "nonce"
Right message4 = ntfData4 .-> "message"
Right ntfDataDecrypted4 = C.cbDecrypt dhSecret nonce4 message4
Right pnMsgs4 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted4
PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer4, notifierId = notifierId4}} = L.last pnMsgs4
smpServer4 `shouldBe` srv
notifierId4 `shouldBe` nId
Resp "" _ (MSG RcvMessage {msgId = mId3, msgBody = EncRcvMsgBody body3}) <- tGet1 rh
Right ClientRcvMsgBody {msgBody = "hello 3"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId3) body3)
Resp "15" _ OK <- signSendRecv rh rKey ("15", rId, ACK mId3)
-- deliver to queue with ntf sub created while SMP was offline
Resp "16" _ OK <- signSendRecv sh sKey ("16", sId', _SEND' "hello 4")
APNSMockRequest {notification = notification5} <- getMockNotification apns tkn'
let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData5} = notification5
Right nonce5 = C.cbNonce <$> ntfData5 .-> "nonce"
Right message5 = ntfData5 .-> "message"
Right ntfDataDecrypted5 = C.cbDecrypt dhSecret nonce5 message5
Right pnMsgs5 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted5
PNMessageData {smpQueue = SMPQueueNtf {smpServer = smpServer5, notifierId = notifierId5}} = L.last pnMsgs5
smpServer5 `shouldBe` srv
notifierId5 `shouldBe` nId'
Resp "" _ (MSG RcvMessage {msgId = mId4, msgBody = EncRcvMsgBody body4}) <- tGet1 rh
Right ClientRcvMsgBody {msgBody = "hello 4"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret' (C.cbNonce mId4) body4)
Resp "17" _ OK <- signSendRecv rh rKey' ("17", rId', ACK mId4)
pure ()
testRetriedNtfSubscription :: (ASrvTransport, AStoreType) -> Spec
testRetriedNtfSubscription (ATransport t, msType) =
@@ -250,18 +297,17 @@ registerToken nh apns token = do
let code = decryptCode ntfData
pure (tknKey, dhSecret, tId, code)
-- TODO [notifications]
-- createNtfQueueNEW :: CreateQueueFunc
-- createNtfQueueNEW h sPub nPub = do
-- g <- C.newRandom
-- (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
-- (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-- (rcvNtfPubDhKey, rcvNtfPrivDhKey) <- atomically $ C.generateKeyPair g
-- let cmd = NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just (QRMessaging Nothing)) (Just (NewNtfCreds nPub rcvNtfPubDhKey)))
-- Resp "abcd" NoEntity (IDS (QIK rId sId srvDh _sndSecure _linkId (Just (ServerNtfCreds nId rcvNtfSrvPubDhKey)))) <-
-- signSendRecv h rKey ("abcd", NoEntity, cmd)
-- let dhShared = C.dh' srvDh dhPriv
-- Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, KEY sPub)
-- (rId', rId) #== "same queue ID"
-- let rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
-- pure ((sId, rId, rKey, dhShared), nId, rcvNtfDhSecret)
createNtfQueueNEW :: CreateQueueFunc
createNtfQueueNEW h sPub nPub = do
g <- C.newRandom
(rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
(rcvNtfPubDhKey, rcvNtfPrivDhKey) <- atomically $ C.generateKeyPair g
let cmd = NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just (QRMessaging Nothing)) (Just (NewNtfCreds nPub rcvNtfPubDhKey)))
Resp "abcd" NoEntity (IDS (QIK rId sId srvDh _sndSecure _linkId _serviceId (Just (ServerNtfCreds nId rcvNtfSrvPubDhKey)))) <-
signSendRecv h rKey ("abcd", NoEntity, cmd)
let dhShared = C.dh' srvDh dhPriv
Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, KEY sPub)
(rId', rId) #== "same queue ID"
let rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
pure ((sId, rId, rKey, dhShared), nId, rcvNtfDhSecret)
+1 -1
View File
@@ -9,7 +9,7 @@ import AgentTests.FunctionalAPITests (runRight)
import Control.Logger.Simple
import Crypto.Random (ChaChaDRG)
import qualified Data.Aeson as J
import Data.ByteString.Lazy.Char8 as LB
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.List.NonEmpty (NonEmpty (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String (StrEncoding (..))
+2 -2
View File
@@ -93,7 +93,7 @@ testStoreDBOpts =
DBOpts
{ connstr = testServerDBConnstr,
schema = "smp_server",
poolSize = 3,
poolSize = 10,
createSchema = True
}
@@ -214,7 +214,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
ServerConfig
{ transports = [],
smpHandshakeTimeout = 60000000,
tbqSize = 1,
tbqSize = 4,
msgQueueQuota = 4,
maxJournalMsgCount = 5,
maxJournalStateLines = 2,
+4 -2
View File
@@ -35,6 +35,7 @@ import Util
import XFTPAgent
import XFTPCLI
import XFTPServerTests (xftpServerTests)
import XFTPWebTests (xftpWebTests)
#if defined(dbPostgres)
import Fixtures
@@ -125,8 +126,8 @@ main = do
ntfTestStoreDBOpts
"src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql"
around_ (postgressBracket ntfTestServerDBConnectInfo) $ do
describe "Notifications server (SMP server: jornal store)" $
ntfServerTests (transport @TLS, ASType SQSMemory SMSJournal)
describe "Notifications server (SMP server: memory store)" $
ntfServerTests (transport @TLS, ASType SQSMemory SMSMemory)
around_ (postgressBracket testServerDBConnectInfo) $ do
-- xdescribe "Notifications server (SMP server: postgres+jornal store)" $
-- ntfServerTests (transport @TLS, ASType SQSPostgres SMSJournal)
@@ -149,6 +150,7 @@ main = do
describe "XFTP file description" fileDescriptionTests
describe "XFTP CLI" xftpCLITests
describe "XFTP agent" xftpAgentTests
describe "XFTP Web Client" xftpWebTests
describe "XRCP" remoteControlTests
describe "Server CLIs" cliTests
+9 -3
View File
@@ -48,12 +48,14 @@ testXFTPCLISendReceive = withXFTPServer $ do
fdSnd = filePath <> ".xftp" </> "snd.xftp.private"
progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr, "--tmp=tests/tmp"]
progress `shouldSatisfy` uploadProgress
sendResult
let (sendInfo, sendRest) = splitAt 4 sendResult
sendInfo
`shouldBe` [ "Sender file description: " <> fdSnd,
"Pass file descriptions to the recipient(s):",
fdRcv1,
fdRcv2
]
sendRest `shouldSatisfy` any ("https://" `isPrefixOf`)
testInfoFile fdRcv1 "Recipient"
testReceiveFile fdRcv1 "testfile" file
testInfoFile fdRcv2 "Recipient"
@@ -82,12 +84,14 @@ testXFTPCLISendReceive2servers = withXFTPServer . withXFTPServer2 $ do
fdSnd = filePath <> ".xftp" </> "snd.xftp.private"
progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr <> ";" <> testXFTPServerStr2, "--tmp=tests/tmp"]
progress `shouldSatisfy` uploadProgress
sendResult
let (sendInfo, sendRest) = splitAt 4 sendResult
sendInfo
`shouldBe` [ "Sender file description: " <> fdSnd,
"Pass file descriptions to the recipient(s):",
fdRcv1,
fdRcv2
]
sendRest `shouldSatisfy` any ("https://" `isPrefixOf`)
testReceiveFile fdRcv1 "testfile" file
testReceiveFile fdRcv2 "testfile_1" file
where
@@ -118,12 +122,14 @@ testXFTPCLIDelete = withXFTPServer . withXFTPServer2 $ do
fdSnd = filePath <> ".xftp" </> "snd.xftp.private"
progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr <> ";" <> testXFTPServerStr2, "--tmp=tests/tmp"]
progress `shouldSatisfy` uploadProgress
sendResult
let (sendInfo, sendRest) = splitAt 4 sendResult
sendInfo
`shouldBe` [ "Sender file description: " <> fdSnd,
"Pass file descriptions to the recipient(s):",
fdRcv1,
fdRcv2
]
sendRest `shouldSatisfy` any ("https://" `isPrefixOf`)
xftpCLI ["del", fdRcv1]
`shouldThrow` anyException
progress1 : recvResult <- xftpCLI ["recv", fdRcv1, recipientFiles, "--tmp=tests/tmp", "-y"]
+44 -1
View File
@@ -15,8 +15,9 @@ import Simplex.FileTransfer.Client
import Simplex.FileTransfer.Description
import Simplex.FileTransfer.Server (runXFTPServerBlocking)
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration, defaultInactiveClientExpiration)
import Simplex.FileTransfer.Transport (supportedFileServerVRange, alpnSupportedXFTPhandshakes)
import Simplex.FileTransfer.Transport (alpnSupportedXFTPhandshakes, supportedFileServerVRange)
import Simplex.Messaging.Protocol (XFTPServer)
import Simplex.Messaging.Transport.HTTP2 (httpALPN)
import Simplex.Messaging.Transport.Server
import Test.Hspec hiding (fit, it)
@@ -125,6 +126,7 @@ testXFTPServerConfig =
privateKeyFile = "tests/fixtures/server.key",
certificateFile = "tests/fixtures/server.crt"
},
httpCredentials = Nothing,
xftpServerVRange = supportedFileServerVRange,
logStatsInterval = Nothing,
logStatsStartTime = 0,
@@ -148,3 +150,44 @@ testXFTPClientWith cfg client = do
getXFTPClient (1, testXFTPServer, Nothing) cfg [] ts (\_ -> pure ()) >>= \case
Right c -> client c
Left e -> error $ show e
testXFTPServerConfigSNI :: XFTPServerConfig
testXFTPServerConfigSNI =
testXFTPServerConfig
{ httpCredentials =
Just
ServerCredentials
{ caCertificateFile = Nothing,
privateKeyFile = "tests/fixtures/web.key",
certificateFile = "tests/fixtures/web.crt"
},
transportConfig =
(mkTransportServerConfig True (Just $ alpnSupportedXFTPhandshakes <> httpALPN) False)
{ addCORSHeaders = True
}
}
withXFTPServerSNI :: HasCallStack => (HasCallStack => ThreadId -> IO a) -> IO a
withXFTPServerSNI = withXFTPServerCfg testXFTPServerConfigSNI
testXFTPServerConfigEd25519SNI :: XFTPServerConfig
testXFTPServerConfigEd25519SNI =
testXFTPServerConfig
{ xftpCredentials =
ServerCredentials
{ caCertificateFile = Just "tests/fixtures/ed25519/ca.crt",
privateKeyFile = "tests/fixtures/ed25519/server.key",
certificateFile = "tests/fixtures/ed25519/server.crt"
},
httpCredentials =
Just
ServerCredentials
{ caCertificateFile = Nothing,
privateKeyFile = "tests/fixtures/web.key",
certificateFile = "tests/fixtures/web.crt"
},
transportConfig =
(mkTransportServerConfig True (Just $ alpnSupportedXFTPhandshakes <> httpALPN) False)
{ addCORSHeaders = True
}
}
+210 -7
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
@@ -13,23 +14,37 @@ import Control.Exception (SomeException)
import Control.Monad
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
import Data.List (isInfixOf)
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 (..), 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 (CertChainPubKey (..), TLS (..), TransportPeer (..), defaultSupportedParams, defaultSupportedParamsHTTPS)
import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost (..), defaultTransportClientConfig, runTLSTransportClient)
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)
@@ -39,10 +54,8 @@ import XFTPClient
xftpServerTests :: Spec
xftpServerTests =
before_ (createDirectoryIfMissing False xftpServerFiles)
. after_ (removeDirectoryRecursive xftpServerFiles)
. describe "XFTP file chunk delivery"
$ do
before_ (createDirectoryIfMissing False xftpServerFiles) . after_ (removeDirectoryRecursive xftpServerFiles) $ do
describe "XFTP file chunk delivery" $ do
it "should create, upload and receive file chunk (1 client)" testFileChunkDelivery
it "should create, upload and receive file chunk (2 clients)" testFileChunkDelivery2
it "should create, add recipients, upload and receive file chunk" testFileChunkDeliveryAddRecipients
@@ -63,6 +76,16 @@ xftpServerTests =
it "allowed with correct basic auth" $ testFileBasicAuth True (Just "pwd") (Just "pwd") True
it "allowed with auth on server without auth" $ testFileBasicAuth True Nothing (Just "any") True
it "should not change content for uploaded and committed files" testFileSkipCommitted
describe "XFTP SNI and CORS" $ do
it "should select web certificate when SNI is used" testSNICertSelection
it "should select XFTP certificate when SNI is not used" testNoSNICertSelection
it "should add CORS headers when SNI is used" testCORSHeaders
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
it "should re-handshake on same connection with xftp-web-hello header" testWebReHandshake
it "should return padded SESSION error for stale web session" testStaleWebSession
chSize :: Integral a => a
chSize = kb 128
@@ -395,3 +418,183 @@ testFileSkipCommitted =
uploadXFTPChunk c spKey sId chunkSpec -- upload again to get FROk without getting stuck
downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk" chSize digest
liftIO $ B.readFile "tests/tmp/received_chunk" `shouldReturn` bytes -- new chunk content got ignored
-- SNI and CORS tests
lookupResponseHeader :: B.ByteString -> H2.Response -> Maybe B.ByteString
lookupResponseHeader name resp =
snd <$> find (\(t, _) -> tokenKey t == CI.mk name) (fst $ H2.responseHeaders resp)
getCerts :: TLS 'TClient -> [X.Certificate]
getCerts tls =
let X.CertificateChain cc = tlsPeerCert tls
in map (X.signedObject . X.getSigned) cc
testSNICertSelection :: Expectation
testSNICertSelection =
withXFTPServerSNI $ \_ -> do
Fingerprint fpHTTP <- loadFileFingerprint "tests/fixtures/web_ca.crt"
let caHTTP = C.KeyHash fpHTTP
cfg = defaultTransportClientConfig {clientALPN = Just ["h2"], useSNI = True}
runTLSTransportClient defaultSupportedParamsHTTPS Nothing cfg Nothing "localhost" xftpTestPort (Just caHTTP) $ \(tls :: TLS 'TClient) -> do
tlsALPN tls `shouldBe` Just "h2"
case getCerts tls of
X.Certificate {X.certPubKey = X.PubKeyRSA rsa} : _ -> RSA.public_size rsa `shouldSatisfy` (> 0)
leaf : _ -> expectationFailure $ "Expected RSA cert, got: " <> show (X.certPubKey leaf)
[] -> expectationFailure "Empty certificate chain"
testNoSNICertSelection :: Expectation
testNoSNICertSelection =
withXFTPServerSNI $ \_ -> do
Fingerprint fpXFTP <- loadFileFingerprint "tests/fixtures/ca.crt"
let caXFTP = C.KeyHash fpXFTP
cfg = defaultTransportClientConfig {clientALPN = Just ["xftp/1"], useSNI = False}
runTLSTransportClient defaultSupportedParams Nothing cfg Nothing "localhost" xftpTestPort (Just caXFTP) $ \(tls :: TLS 'TClient) -> do
tlsALPN tls `shouldBe` Just "xftp/1"
case getCerts tls of
X.Certificate {X.certPubKey = X.PubKeyEd448 _} : _ -> pure ()
leaf : _ -> expectationFailure $ "Expected Ed448 cert, got: " <> show (X.certPubKey leaf)
[] -> expectationFailure "Empty certificate chain"
testCORSHeaders :: Expectation
testCORSHeaders =
withXFTPServerSNI $ \_ -> do
Fingerprint fpHTTP <- loadFileFingerprint "tests/fixtures/web_ca.crt"
let caHTTP = C.KeyHash fpHTTP
cfg = defaultTransportClientConfig {clientALPN = Just ["h2"], useSNI = True}
runTLSTransportClient defaultSupportedParamsHTTPS Nothing cfg Nothing "localhost" xftpTestPort (Just caHTTP) $ \(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
let req = H2.requestNoBody "POST" "/" []
HC.HTTP2Response {HC.response} <- either (error . show) pure =<< HC.sendRequest h2 req (Just 5000000)
lookupResponseHeader "access-control-allow-origin" response `shouldBe` Just "*"
lookupResponseHeader "access-control-expose-headers" response `shouldBe` Just "*"
testCORSPreflight :: Expectation
testCORSPreflight =
withXFTPServerSNI $ \_ -> do
Fingerprint fpHTTP <- loadFileFingerprint "tests/fixtures/web_ca.crt"
let caHTTP = C.KeyHash fpHTTP
cfg = defaultTransportClientConfig {clientALPN = Just ["h2"], useSNI = True}
runTLSTransportClient defaultSupportedParamsHTTPS Nothing cfg Nothing "localhost" xftpTestPort (Just caHTTP) $ \(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
let req = H2.requestNoBody "OPTIONS" "/" []
HC.HTTP2Response {HC.response} <- either (error . show) pure =<< HC.sendRequest h2 req (Just 5000000)
lookupResponseHeader "access-control-allow-origin" response `shouldBe` Just "*"
lookupResponseHeader "access-control-allow-methods" response `shouldBe` Just "POST, OPTIONS"
lookupResponseHeader "access-control-allow-headers" response `shouldBe` Just "*"
lookupResponseHeader "access-control-max-age" response `shouldBe` Just "86400"
testNoCORSWithoutSNI :: Expectation
testNoCORSWithoutSNI =
withXFTPServerSNI $ \_ -> do
Fingerprint fpXFTP <- loadFileFingerprint "tests/fixtures/ca.crt"
let caXFTP = C.KeyHash fpXFTP
cfg = defaultTransportClientConfig {clientALPN = Just ["xftp/1"], useSNI = False}
runTLSTransportClient defaultSupportedParams Nothing cfg Nothing "localhost" xftpTestPort (Just caXFTP) $ \(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
let req = H2.requestNoBody "POST" "/" []
HC.HTTP2Response {HC.response} <- either (error . show) pure =<< HC.sendRequest h2 req (Just 5000000)
lookupResponseHeader "access-control-allow-origin" response `shouldBe` Nothing
testFileChunkDeliverySNI :: Expectation
testFileChunkDeliverySNI =
withXFTPServerSNI $ \_ -> testXFTPClient $ \c -> runRight_ $ runTestFileChunkDelivery c c
testWebHandshake :: Expectation
testWebHandshake =
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}
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
-- Send web challenge as XFTPClientHello
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)
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
testWebReHandshake :: Expectation
testWebReHandshake =
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}
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
-- First handshake
challenge1 <- atomically $ C.randomBytes 32 g
helloBody1 <- either (error . show) pure $ C.pad (smpEncode (XFTPClientHello {webChallenge = Just challenge1})) xftpBlockSize
let helloReq1 = H2.requestBuilder "POST" "/" [("xftp-web-hello", "1")] $ byteString helloBody1
resp1 <- either (error . show) pure =<< HC.sendRequest h2 helloReq1 (Just 5000000)
serverHs1 <- either (error . show) pure $ C.unPad (bodyHead (HC.respBody resp1))
XFTPServerHandshake {sessionId = sid1} <- either error pure $ smpDecode serverHs1
clientHsPadded <- either (error . show) pure $ C.pad (smpEncode (XFTPClientHandshake {xftpVersion = VersionXFTP 1, keyHash})) xftpBlockSize
resp1b <- either (error . show) pure =<< HC.sendRequest h2 (H2.requestBuilder "POST" "/" [] $ byteString clientHsPadded) (Just 5000000)
B.length (bodyHead (HC.respBody resp1b)) `shouldBe` 0
-- Re-handshake on same connection with xftp-web-hello header
challenge2 <- atomically $ C.randomBytes 32 g
helloBody2 <- either (error . show) pure $ C.pad (smpEncode (XFTPClientHello {webChallenge = Just challenge2})) xftpBlockSize
let helloReq2 = H2.requestBuilder "POST" "/" [("xftp-web-hello", "1")] $ byteString helloBody2
resp2 <- either (error . show) pure =<< HC.sendRequest h2 helloReq2 (Just 5000000)
serverHs2 <- either (error . show) pure $ C.unPad (bodyHead (HC.respBody resp2))
XFTPServerHandshake {sessionId = sid2} <- either error pure $ smpDecode serverHs2
sid2 `shouldBe` sid1
-- Complete re-handshake
resp2b <- either (error . show) pure =<< HC.sendRequest h2 (H2.requestBuilder "POST" "/" [] $ byteString clientHsPadded) (Just 5000000)
B.length (bodyHead (HC.respBody resp2b)) `shouldBe` 0
testStaleWebSession :: Expectation
testStaleWebSession =
withXFTPServerSNI $ \_ -> do
Fingerprint fpWeb <- loadFileFingerprint "tests/fixtures/web_ca.crt"
let webCaHash = C.KeyHash fpWeb
cfg = defaultTransportClientConfig {clientALPN = Just ["h2"], useSNI = True}
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
-- Send a command on web connection without doing hello (no xftp-web-hello header)
dummyBody <- either (error . show) pure $ C.pad "PING" xftpBlockSize
let req = H2.requestBuilder "POST" "/" [] $ byteString dummyBody
resp <- either (error . show) pure =<< HC.sendRequest h2 req (Just 5000000)
let respBody = bodyHead (HC.respBody resp)
-- Server should return padded SESSION error
B.length respBody `shouldBe` xftpBlockSize
decoded <- either (error . show) pure $ C.unPad respBody
decoded `shouldBe` smpEncode SESSION
File diff suppressed because it is too large Load Diff
+1
View File
@@ -0,0 +1 @@
6395D75F2A7A37CA274B8BE766187EA9ECC64665
+10
View File
@@ -0,0 +1,10 @@
-----BEGIN CERTIFICATE-----
MIIBazCCAR2gAwIBAgIUSTqS4QptGQWYoukUUuYqC6iV5TMwBQYDK2VwMCoxFjAU
BgNVBAMMDVNNUCBzZXJ2ZXIgQ0ExEDAOBgNVBAoMB1NpbXBsZVgwIBcNMjYwMjAy
MDkxMTM1WhgPMjEyNjAxMDkwOTExMzVaMCoxFjAUBgNVBAMMDVNNUCBzZXJ2ZXIg
Q0ExEDAOBgNVBAoMB1NpbXBsZVgwKjAFBgMrZXADIQAv7I91vFk1tu6bj7J8HfkA
c7vjTnae9LFz+fXXtjkJVqNTMFEwHQYDVR0OBBYEFJSRDsRRvAyWhRMrXfW0Apsw
FbIHMB8GA1UdIwQYMBaAFJSRDsRRvAyWhRMrXfW0ApswFbIHMA8GA1UdEwEB/wQF
MAMBAf8wBQYDK2VwA0EAa9btje9yq4avTR8AOOkLHvGG0F6CskcGUFCkEbdCU+7I
9Qx1E8TlK6SwtLAKGi+qoK89dsdKL7rY2KbSP3SMAg==
-----END CERTIFICATE-----
+3
View File
@@ -0,0 +1,3 @@
-----BEGIN PRIVATE KEY-----
MC4CAQAwBQYDK2VwBCIEINrfCroxhwopILZmG394xna73ethj6Z6IJSdBY2KjmW2
-----END PRIVATE KEY-----
+10
View File
@@ -0,0 +1,10 @@
-----BEGIN CERTIFICATE-----
MIIBcTCCASOgAwIBAgIUGMY4bIefHdfLBMptm/MOtg3ekGEwBQYDK2VwMCoxFjAU
BgNVBAMMDVNNUCBzZXJ2ZXIgQ0ExEDAOBgNVBAoMB1NpbXBsZVgwIBcNMjYwMjAy
MDkxMTM1WhgPMjEyNjAxMDkwOTExMzVaMBQxEjAQBgNVBAMMCWxvY2FsaG9zdDAq
MAUGAytlcAMhANYHFcaIJ540sL66lt5GmPrd0HX3mogATKrnWHPWQaGmo28wbTAJ
BgNVHRMEAjAAMAsGA1UdDwQEAwIDyDATBgNVHSUEDDAKBggrBgEFBQcDATAdBgNV
HQ4EFgQUQlsiIdymULnrH8KY+N+dd5RQADMwHwYDVR0jBBgwFoAUlJEOxFG8DJaF
Eytd9bQCmzAVsgcwBQYDK2VwA0EAFXpm1Ucdoa4W1ZPE/28FRkoHeHiEfyHX0NFx
qz7fiV6ys6KnnlC+xLDX0HVLcppImdnm4qmKddCagRfE7h0zAw==
-----END CERTIFICATE-----
+3
View File
@@ -0,0 +1,3 @@
-----BEGIN PRIVATE KEY-----
MC4CAQAwBQYDK2VwBCIEIJjrvSfyWU9Xdiery1u85BK0Syw5jmxIJdzo0idiIasu
-----END PRIVATE KEY-----
+57 -30
View File
@@ -1,34 +1,61 @@
-----BEGIN CERTIFICATE-----
MIIDnTCCAx2gAwIBAgIUFhZZsKj9uBgGnUrr+Cf3XFf7t6IwBQYDK2VxMCoxFjAU
BgNVBAMMDVNNUCBzZXJ2ZXIgQ0ExEDAOBgNVBAoMB1NpbXBsZVgwIBcNMjQwOTI2
MTIyNTEyWhgPNDc2MjA4MjMxMjI1MTJaMBQxEjAQBgNVBAMMCWxvY2FsaG9zdDCC
AiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBALB59b8oyxP5YtXI1kemBzJU
Pt0xLN/Tmzdul283DhbNCJV+eUn4fNz+PjiRS/F2vZLb3WXInPi3bc57hw2Yu94o
7MXH5DTWkaubNq0bV0Koi17zZBSCOOq+MbPN7bUT1sOwOHadLh3IWTfkz9EufowD
ivpymNKWbeAHMXlXsBJnHfHuM05MWlP87PTHd3D7YQmmgbISgEGG4GchWBqnnCxx
gOOa09f/n+gWJFbN3hkbVZKMEpT5gu9WWsgv9BDhJzcBSw13MMz0sByxYKzhwQBJ
ikFz+16AttZ0ccoDaWwajZzK8+yfFv9T3b8kWmioHi2dw2vBgSove78liUqYCsOU
Bt5MNk3P037KgSJPdp6azsF3bMKmPssEhT9vHMPgSkiBfmBlJ7dTTRd9dh/cLKIO
AMzu4O+pEodIOJDXTARBE6VX1qoEZQuft5+ljVy4i9ySpmHnkxLocF40rKV1G0c5
LnVNTtr5GokC9sfIXZPZw0EEpk3eAseNWccwuyRfHQfL6yjcDig2IdLvLVcm9JyA
2P5QpP15EoA3Ow9uX8HmBbSFe1F35rqcNwY0lhDXEboSA/X4xDLnu4aVhNPiUnRq
NXqVlgz5ybRAUHd8fDBwK8fT5VhvuEnCja7+8hVc33gK56vu+28ZMkN2Y4z0GNQd
iamPUZJlUcCJzNI2cz27AgMBAAGjbzBtMAkGA1UdEwQCMAAwCwYDVR0PBAQDAgPI
MBMGA1UdJQQMMAoGCCsGAQUFBwMBMB0GA1UdDgQWBBSWiPT6Nl13/CTjaHCkHp17
GWoyvzAfBgNVHSMEGDAWgBQcUJvR7mm26yxMQfCsWgbnwMmJVDAFBgMrZXEDcwDC
DTbvSA61ydoRA8mTHFW1EYL+xfQjo0aH56N1Aqn47DzLGQZjP/fxoW929+Jwoiz0
UgUtUAeFjgA9wfvDv7mMm/K4wqyiZzFuWVZdQV6AUwBJK0hN5qlXpvJzMKLrj3Ap
dRELAgLJvC2e/xVc3dXSFwA=
MIIFQTCCAymgAwIBAgIUZ7vJLAGbbk9wG8fLSTClM6NneS4wDQYJKoZIhvcNAQEL
BQAwFjEUMBIGA1UEAwwLWEZUUCBXZWIgQ0EwIBcNMjYwMjEwMjMzMTQxWhgPNDc2
NDAxMDcyMzMxNDFaMBQxEjAQBgNVBAMMCWxvY2FsaG9zdDCCAiIwDQYJKoZIhvcN
AQEBBQADggIPADCCAgoCggIBALB59b8oyxP5YtXI1kemBzJUPt0xLN/Tmzdul283
DhbNCJV+eUn4fNz+PjiRS/F2vZLb3WXInPi3bc57hw2Yu94o7MXH5DTWkaubNq0b
V0Koi17zZBSCOOq+MbPN7bUT1sOwOHadLh3IWTfkz9EufowDivpymNKWbeAHMXlX
sBJnHfHuM05MWlP87PTHd3D7YQmmgbISgEGG4GchWBqnnCxxgOOa09f/n+gWJFbN
3hkbVZKMEpT5gu9WWsgv9BDhJzcBSw13MMz0sByxYKzhwQBJikFz+16AttZ0ccoD
aWwajZzK8+yfFv9T3b8kWmioHi2dw2vBgSove78liUqYCsOUBt5MNk3P037KgSJP
dp6azsF3bMKmPssEhT9vHMPgSkiBfmBlJ7dTTRd9dh/cLKIOAMzu4O+pEodIOJDX
TARBE6VX1qoEZQuft5+ljVy4i9ySpmHnkxLocF40rKV1G0c5LnVNTtr5GokC9sfI
XZPZw0EEpk3eAseNWccwuyRfHQfL6yjcDig2IdLvLVcm9JyA2P5QpP15EoA3Ow9u
X8HmBbSFe1F35rqcNwY0lhDXEboSA/X4xDLnu4aVhNPiUnRqNXqVlgz5ybRAUHd8
fDBwK8fT5VhvuEnCja7+8hVc33gK56vu+28ZMkN2Y4z0GNQdiamPUZJlUcCJzNI2
cz27AgMBAAGjgYYwgYMwFAYDVR0RBA0wC4IJbG9jYWxob3N0MAkGA1UdEwQCMAAw
CwYDVR0PBAQDAgPIMBMGA1UdJQQMMAoGCCsGAQUFBwMBMB0GA1UdDgQWBBSWiPT6
Nl13/CTjaHCkHp17GWoyvzAfBgNVHSMEGDAWgBTrt7AAg953MNz2yI3mMIOGdhp4
xTANBgkqhkiG9w0BAQsFAAOCAgEAdBNI0bmuthjyzKxR99GLm/hYPCi5GobQcv35
sWzU/ivzkrKrjh7lZewc6Y5TyINgYYtLTnX82pJJdHDJQ8tQ2whW3eyiVF988HSO
4Upw0TyyCAPN2PoCPQ338tfSwcNC63cK7z6/8aRFm9zMY+Lu14s2pDU1ry8bY8CZ
pYDWT1qNgzBCt0geX93rU48RWO0/hdTWZksVfErDjhogtyV1DiEq6+fteRSjCNHV
qQmgKoRNdphnduR/JMDWcHpmPdCqq4ffIGOsa3qRdjMqNTCc5Jgp1M92bXgbg+kh
6K9PEcC+YKhTlJRkLxw98fxkZ16iFgKmPFfj9X4yye38lJJimK6c8/lXQcUQxKO7
cqoIPVQ65xSxIxIprGDtF6CHZKGMkcNOycQjqEGq46qSXoNHNO47bheDlyCpmDIq
B966RIpcOIZxsSn3mFLYK8vxdNMu4MuUmyoSQlgKGVchiSjErpQxyL+Ra1SSiZdZ
uKxYQOXnCqg8VZKGmwRSCOSnwXT1bS8bc0wVe7MQpBnwWDjH7/GpfWXjvGmKfRIN
loJ7I4akQ25xMa5CGzzsy5COJrXbq8vEDgJMZq02dgfVibK7minLSeOT7+xB1+pW
+sULqQgT+zOfVtdzQ7MrowNlEkUA2Sl9loQ9yhPHy5y4e6Z0Wv9yBps07dMdf8Oq
mkhfGdY=
-----END CERTIFICATE-----
-----BEGIN CERTIFICATE-----
MIIBtjCCATagAwIBAgIUe2PryrWo0xXX9vcA3WfbCzcdmgAwBQYDK2VxMCoxFjAU
BgNVBAMMDVNNUCBzZXJ2ZXIgQ0ExEDAOBgNVBAoMB1NpbXBsZVgwIBcNMjIwMTEx
MTExNjM5WhgPNDc1OTEyMDgxMTE2MzlaMCoxFjAUBgNVBAMMDVNNUCBzZXJ2ZXIg
Q0ExEDAOBgNVBAoMB1NpbXBsZVgwQzAFBgMrZXEDOgCAcvFwVicR+RLZpiEWPFNR
XYTbf+mFcX1NHIyPQDugFwOCgqJAW1fsjYgFhtQJSMH/lc1N7clfm4CjUzBRMB0G
A1UdDgQWBBQcUJvR7mm26yxMQfCsWgbnwMmJVDAfBgNVHSMEGDAWgBQcUJvR7mm2
6yxMQfCsWgbnwMmJVDAPBgNVHRMBAf8EBTADAQH/MAUGAytlcQNzAAAP/hMPNxyW
fyJi+iJViodU+C/aklnvHtjh5P3AbiVCSUfY6+PEdvkC8Ov0pBAYpYi5ukSNNVXl
ABVRlipB+vOcLQStNyaZ7kXzQ2IO/0btmIidh+G6SP8I4aytYIYYcV5pEUZpG1L1
57g8P29SDv81AA==
MIIFDzCCAvegAwIBAgIUI0uZLHpqLKV7FHEJonLx8bsild8wDQYJKoZIhvcNAQEL
BQAwFjEUMBIGA1UEAwwLWEZUUCBXZWIgQ0EwIBcNMjYwMjEwMjMzMTM2WhgPNDc2
NDAxMDcyMzMxMzZaMBYxFDASBgNVBAMMC1hGVFAgV2ViIENBMIICIjANBgkqhkiG
9w0BAQEFAAOCAg8AMIICCgKCAgEAycPQtKmG0tzXtJz46Jh7IWwRpg1YmvR+n8KM
sfCKKFmMYECHIQcHbKd/2aerElHmm3t13NCBn3biB1Rh1+tB8g9pNOadxSnl7Www
QTI4uIsTeRVLOcwXkGg3BbQd7DKGQPEHPsS1gE47CGB+W48kndhzm5jrXeq/z/gJ
mdiimrGWP+RP6touApyyjzDoEV6dmI5fcnf1Y0YCGQT7hEnA/OZH8YHZf+CbUnxZ
B4BUuaUko+oji5OG2+UjI4X0CYmdvlAuUZ1uDe8kwQaJIgpnJidVBcCZP93VUr0I
Upm8wJXoQdIAvfbT32LTMPcno0uyv9FmCEJY8fdteS1ByLZYNgM09IisEEIzVf8A
Mx35vxm1Q7eCr8aoiOlgaA3EmTExhLuAYa1XbGSPwahOOtdLfdkr2Vxp2OdxY1AE
Ze9b2iVvSdlwxpKRkaEI0rleEnBJkvmNP4dG2JBIv7PPu4OVfHHVCFmhFUxAjrcf
FDyskq+58Wx8vvcTNeAGsv/fFGmt5C/muhOOZnm2ig6TRaE72QHZqfBA2PDKWC3p
C+Oltm+9jkl1Ofo1IMFKf8fR3plltGez4vL4gc9o5aGoAB1f99Ig3D2Q40lOYucf
GjsXQue+3pqzj8Dz90s3T1Rr340JtFpsw5+THUeIz/qM+mZiOvWOOM77k8iiKjOD
VHRkBK0CAwEAAaNTMFEwHQYDVR0OBBYEFOu3sACD3ncw3PbIjeYwg4Z2GnjFMB8G
A1UdIwQYMBaAFOu3sACD3ncw3PbIjeYwg4Z2GnjFMA8GA1UdEwEB/wQFMAMBAf8w
DQYJKoZIhvcNAQELBQADggIBAGa2kZszMmzN55No/DFcnYchaszJ2Pn5duU/cjNf
ZTme6e4CbB60Ot4gANnQa5geOiVGWw3WMNpqwInlMAKepuElhniZV3jDuKfsdGyy
yicXzZe6QTDQc8uMqMU7eAZo/nbx+hObyh094a5KOXODiTnbAT7+udqlIcPGJkWa
Sll5hZtlo3mIK59WsTjA1RxRAmjF/BxubBl1iSnxuO2fXLiO+EWTBMFMsVWZYFRC
KK1HY4E0zVC+9qrjIPcc9nLYw1UV8EVFXcOSxvvMEsQ9mzGqhg6A65nD6TVOUSbf
t+IWQXEvP6cDxTrsmdV4kTSeGPte2ANascE9BMOXgmWS/6mpa2NWKhbGvGZK/yTP
3mHIEMxxve8KLeiFv2bQaHojIco6i85Y3a9EPGNfuzCsxXuK0lmT5A3mih3FgnUF
KpVM4ci4O2qWjdrby6ydPjdU/KAywfNPg/htxoHen8wXm4fAVwy1JD7dM9OxgyyP
8c+zThvQ8ueHrrzv68LPpMMwH5wskdSWt9+1bZyAZJN5MD05eqEJ6KoXj+oTnLTC
4ERV1yxtECM8zqhT2fM7+UOKVjBRQWmZj4zlowRhogENHQKEXxghrHy0aKbz2daW
usrIscN+SG9zHw3iq6Gf+hVKuLfTDPuBQDL+kIPep8mM0NI/Tayefzt7fyRn4R4W
QBe2
-----END CERTIFICATE-----
+30
View File
@@ -0,0 +1,30 @@
-----BEGIN CERTIFICATE-----
MIIFDzCCAvegAwIBAgIUI0uZLHpqLKV7FHEJonLx8bsild8wDQYJKoZIhvcNAQEL
BQAwFjEUMBIGA1UEAwwLWEZUUCBXZWIgQ0EwIBcNMjYwMjEwMjMzMTM2WhgPNDc2
NDAxMDcyMzMxMzZaMBYxFDASBgNVBAMMC1hGVFAgV2ViIENBMIICIjANBgkqhkiG
9w0BAQEFAAOCAg8AMIICCgKCAgEAycPQtKmG0tzXtJz46Jh7IWwRpg1YmvR+n8KM
sfCKKFmMYECHIQcHbKd/2aerElHmm3t13NCBn3biB1Rh1+tB8g9pNOadxSnl7Www
QTI4uIsTeRVLOcwXkGg3BbQd7DKGQPEHPsS1gE47CGB+W48kndhzm5jrXeq/z/gJ
mdiimrGWP+RP6touApyyjzDoEV6dmI5fcnf1Y0YCGQT7hEnA/OZH8YHZf+CbUnxZ
B4BUuaUko+oji5OG2+UjI4X0CYmdvlAuUZ1uDe8kwQaJIgpnJidVBcCZP93VUr0I
Upm8wJXoQdIAvfbT32LTMPcno0uyv9FmCEJY8fdteS1ByLZYNgM09IisEEIzVf8A
Mx35vxm1Q7eCr8aoiOlgaA3EmTExhLuAYa1XbGSPwahOOtdLfdkr2Vxp2OdxY1AE
Ze9b2iVvSdlwxpKRkaEI0rleEnBJkvmNP4dG2JBIv7PPu4OVfHHVCFmhFUxAjrcf
FDyskq+58Wx8vvcTNeAGsv/fFGmt5C/muhOOZnm2ig6TRaE72QHZqfBA2PDKWC3p
C+Oltm+9jkl1Ofo1IMFKf8fR3plltGez4vL4gc9o5aGoAB1f99Ig3D2Q40lOYucf
GjsXQue+3pqzj8Dz90s3T1Rr340JtFpsw5+THUeIz/qM+mZiOvWOOM77k8iiKjOD
VHRkBK0CAwEAAaNTMFEwHQYDVR0OBBYEFOu3sACD3ncw3PbIjeYwg4Z2GnjFMB8G
A1UdIwQYMBaAFOu3sACD3ncw3PbIjeYwg4Z2GnjFMA8GA1UdEwEB/wQFMAMBAf8w
DQYJKoZIhvcNAQELBQADggIBAGa2kZszMmzN55No/DFcnYchaszJ2Pn5duU/cjNf
ZTme6e4CbB60Ot4gANnQa5geOiVGWw3WMNpqwInlMAKepuElhniZV3jDuKfsdGyy
yicXzZe6QTDQc8uMqMU7eAZo/nbx+hObyh094a5KOXODiTnbAT7+udqlIcPGJkWa
Sll5hZtlo3mIK59WsTjA1RxRAmjF/BxubBl1iSnxuO2fXLiO+EWTBMFMsVWZYFRC
KK1HY4E0zVC+9qrjIPcc9nLYw1UV8EVFXcOSxvvMEsQ9mzGqhg6A65nD6TVOUSbf
t+IWQXEvP6cDxTrsmdV4kTSeGPte2ANascE9BMOXgmWS/6mpa2NWKhbGvGZK/yTP
3mHIEMxxve8KLeiFv2bQaHojIco6i85Y3a9EPGNfuzCsxXuK0lmT5A3mih3FgnUF
KpVM4ci4O2qWjdrby6ydPjdU/KAywfNPg/htxoHen8wXm4fAVwy1JD7dM9OxgyyP
8c+zThvQ8ueHrrzv68LPpMMwH5wskdSWt9+1bZyAZJN5MD05eqEJ6KoXj+oTnLTC
4ERV1yxtECM8zqhT2fM7+UOKVjBRQWmZj4zlowRhogENHQKEXxghrHy0aKbz2daW
usrIscN+SG9zHw3iq6Gf+hVKuLfTDPuBQDL+kIPep8mM0NI/Tayefzt7fyRn4R4W
QBe2
-----END CERTIFICATE-----
+52
View File
@@ -0,0 +1,52 @@
-----BEGIN PRIVATE KEY-----
MIIJRAIBADANBgkqhkiG9w0BAQEFAASCCS4wggkqAgEAAoICAQDJw9C0qYbS3Ne0
nPjomHshbBGmDVia9H6fwoyx8IooWYxgQIchBwdsp3/Zp6sSUeabe3Xc0IGfduIH
VGHX60HyD2k05p3FKeXtbDBBMji4ixN5FUs5zBeQaDcFtB3sMoZA8Qc+xLWATjsI
YH5bjySd2HObmOtd6r/P+AmZ2KKasZY/5E/q2i4CnLKPMOgRXp2Yjl9yd/VjRgIZ
BPuEScD85kfxgdl/4JtSfFkHgFS5pSSj6iOLk4bb5SMjhfQJiZ2+UC5RnW4N7yTB
BokiCmcmJ1UFwJk/3dVSvQhSmbzAlehB0gC99tPfYtMw9yejS7K/0WYIQljx9215
LUHItlg2AzT0iKwQQjNV/wAzHfm/GbVDt4KvxqiI6WBoDcSZMTGEu4BhrVdsZI/B
qE4610t92SvZXGnY53FjUARl71vaJW9J2XDGkpGRoQjSuV4ScEmS+Y0/h0bYkEi/
s8+7g5V8cdUIWaEVTECOtx8UPKySr7nxbHy+9xM14Aay/98Uaa3kL+a6E45mebaK
DpNFoTvZAdmp8EDY8MpYLekL46W2b72OSXU5+jUgwUp/x9HemWW0Z7Pi8viBz2jl
oagAHV/30iDcPZDjSU5i5x8aOxdC577emrOPwPP3SzdPVGvfjQm0WmzDn5MdR4jP
+oz6ZmI69Y44zvuTyKIqM4NUdGQErQIDAQABAoICABULRvPo8KaCoT711mJQMRuJ
zYdvweubj69zF8ChcY+G04TghheUR5p2F/goLEgjYbWa2W64EqUCvc186B2grIam
Q9dgLFl5psEuNRQ/vDnHS7cn2OpE1rpZnE+Me0h89pLEcPiDhNjGkBKuGc/L7MpH
3rr+ZqIrj2kOGlZBCaiv2Bd+5TT+H6lnFZqow7O4FiDozJzAVUhO734TjnY8SRQ3
oo5WeEyFrT2buZ92K6AXUOyFycJPl1PNIO6eFJeAEoNckpAxpt5uMHuvhlMWGa8Z
kB0i+vj11r+j9r/CyDSgDhL7Z9dobK3SfWuQg8Jc7V5jZUx8OxG1uGXYqhFYr3d3
N2CMz5f6T6VoM/f9WNtcaKNfeRHfysxLU1P7g57l5jo1ktts5lNOsrg2Pt8isAGF
Yb13x1RRAKYlBzkuqUOx99g/wZvAHRzug2GBdmKpVTcFbqUQjhglxNm8mkYsb2ed
RGs0jkq9IlJI7UxRaZbWCgBCwz/C2JBRpCbcom6WHqWSwjALGVI9inqZa9/Q01O4
ZxXwBKpjVgkItqccjFOMppbx1HcUM5qUsRsdC3kGihWhAjO58j25yD4mO5JAlU6/
u/EOOJ+F6/Dw6lDIfrkvkrt/GXruL7TY2BoIYhjOyXO/KEba7qyEShCtXMi44aj0
m0Ldt1HKm3vbGQpffXsjAoIBAQDy8sGdw4YQQXXpBlASAsij8J+LoUlWOV+bxORo
zES4VbF8OP3wLMgLj69nfnwdq1v3zggPHCdMmu4GqnD12HzalXDjT9T6ujxFawJK
ApyPe3c7iBDUSX3tCfkEekKy6GPeDmFOrxeIuBA/lADYMGIY7qQisen2O5Qt0Vb0
/kRyqrIDsWcVH4Cjx4zFFeOQ14vAzP69K/BeZVVJkeimY9EMVu2NJIrJmtBCw0yI
7CaJa8Vu36y/u83ZC2jXxN1MhEJJCeBc2ydvyEjhuzvq2/dQbFHow6z/4AkAn9yS
B1IIMz3X911FYxRnrTlDknWfB2r3ZVwHtXvIKjAtXT+OM1oPAoIBAQDUmqsOG4Ak
lrXKPCs90YWqLnzOQPamyec3HP3Ma98Kw+O7ulQTFvjf+YB+OplFdtpaI04gk0Gm
Vi5diu+HoABil//jduUOqUj5tNifv60XnrzVpVzek8oPphYCTq7P+vmBN66qQ6Sw
JlYo6SBJZHR3FCvfIUTxQBPqZ9NL061lKt5g38YIxl8z2pK0JxrEfaxo7IXIFCm3
/7DmtiikvQOrMLZ6r0pTnPaBf5+f8ySKU4x4kFJu3Hb9idBc1r13WMjqRPaqeS8p
TAT6icyktA0N/aAoTbNj99wRvfjHvlXx9jh3jy9Ka2Dn2cE+YtY1/bIAvFQxiRzt
8EW6sBKrbyGDAoIBAQCYsHN5WNpYOxwFAV+vgiphxqgvVIXH+DUbrEo1hzQlek4b
GaKXoT107rA55mfRKdKaUtYD0Rjt721rqRFnodEOe9/ALXtYvVWF93Qv2aZWEy3j
r2eMVEgdgygLZV+oG6Awfm8vyaGL3srvenBxby8oJkvoNlMp21YM2cXCIlAYlSle
Ys+7mdn6lT7m2xP0A1QlL3FmqUffu+Y3X8mNUaygCb4w9+d2P6NmYmImp+ysb5xd
S5zBwCHmqGITQfonzfPu/ZMSKPaHLaSIomlM+URdOkbceKaxBjgCOXaiHJG076eN
pTzskBHR+y/DRThBY6MZq42Els4eBk3TJQj9sU6HAoIBAQCShsa9wlZe4UAJUc67
nFvzHncF7+AOs7iXU3PYH8BpOvkJuTGYtoxwURUt6lUYewGifhKqgNMOQPdToR3U
64FYckn6C0dzA1k4QFvMPd6eGNkspfuLq2/nuSASFwiEbwTm+el3j4dBoCphp8qI
yqM6LrzN27AYVYFkXIpUCF/JCfKZ8aAbDB0xL8NMRmc8ZSEeb2UEsGDQX3kciQ8Z
+us8YSZjB8zCM7vxJHRvWLQmYc6+iTlHDsszknf4hEewqZBPZZhbhYnrfGkyAyb3
nOAidFqdbG/mxjz2PWfowlWZnYjtXdHKCJeRM5Lr3FKmg2La/vFH8qftlVt5f0Be
xwjhAoIBAQDSznM/ZO+yVMOME/L3Rphaep+vxzO2WHnlIeTFCep/fYS4PeeXvGQu
Sg3JzMk6hh93OeZ0TYj0QCoi4/1RhQ2pbtIX0+FU/FtdfXJKWz9NXTT81DZtJK+n
krVlutTEGSeDROkymcFmn56vGC6D9N/kv0tUoQ2tr4/5WLqE868Kl2Q3/AoLbIiF
lH83oNTnXicaJAfrDlAlMieRmhIYbjYBdqjdiSkxG7N3t8TyTR6VRzCM7jy2/ZN1
pFbX1ol+Dbf9zm6f3erTn1TnPju6gBZheQoCn2w7O00NapCgd2w6pVJT0I/srMS0
7C4nNFR/SOa1Zpf0FsRY3pYK6usQu/9T
-----END PRIVATE KEY-----
+1
View File
@@ -0,0 +1 @@
67BBC92C019B6E4F701BC7CB4930A533A367792E
+4
View File
@@ -0,0 +1,4 @@
node_modules/
dist/
dist-web/
package-lock.json
+47
View File
@@ -0,0 +1,47 @@
# xftp-web
Browser-compatible XFTP file transfer client in TypeScript.
## Prerequisites
- Haskell toolchain with `cabal` (to build `xftp-server`)
- Node.js 20+
- Chromium system dependencies (see below)
## Setup
```bash
# Build the XFTP server binary (from repo root)
cabal build xftp-server
# Install JS dependencies
cd xftp-web
npm install
# Install Chromium for Playwright (browser tests)
npx playwright install chromium
```
If Chromium fails to launch due to missing system libraries, install them with:
```bash
# Requires root
npx playwright install-deps chromium
```
## Running tests
```bash
# Browser round-trip test (vitest + Playwright headless Chromium)
npm run test
```
The browser test automatically starts an `xftp-server` instance on port 7000 via `globalSetup`, using certs from `tests/fixtures/`.
## Build
```bash
npm run build
```
Output goes to `dist/`.
+37
View File
@@ -0,0 +1,37 @@
{
"name": "xftp-web",
"version": "0.1.0",
"private": true,
"type": "module",
"main": "dist/index.js",
"types": "dist/index.d.ts",
"scripts": {
"postinstall": "ln -sf ../../../libsodium-sumo/dist/modules-sumo-esm/libsodium-sumo.mjs node_modules/libsodium-wrappers-sumo/dist/modules-sumo-esm/libsodium-sumo.mjs && npx playwright install chromium",
"build": "tsc",
"test": "vitest",
"dev": "npx tsx test/runSetup.ts && vite --mode development",
"build:local": "npx tsx test/runSetup.ts && vite build --mode development",
"build:prod": "vite build --mode production",
"preview": "vite preview",
"preview:local": "npm run build:local && vite preview",
"preview:prod": "vite build --mode production && vite preview",
"check:web": "tsc -p tsconfig.web.json --noEmit && tsc -p tsconfig.worker.json --noEmit",
"test:page": "playwright test test/page.spec.ts"
},
"devDependencies": {
"@types/libsodium-wrappers-sumo": "^0.7.8",
"@types/node": "^20.0.0",
"@types/pako": "^2.0.3",
"@vitest/browser": "^3.0.0",
"@playwright/test": "^1.50.0",
"playwright": "^1.50.0",
"typescript": "^5.4.0",
"vite": "^6.0.0",
"vitest": "^3.0.0"
},
"dependencies": {
"@noble/curves": "^1.9.7",
"libsodium-wrappers-sumo": "^0.7.13",
"pako": "^2.1.0"
}
}
+27
View File
@@ -0,0 +1,27 @@
import {defineConfig} from '@playwright/test'
export default defineConfig({
testDir: './test',
testMatch: '**/*.spec.ts',
timeout: 60_000,
use: {
ignoreHTTPSErrors: true,
launchOptions: {
// --ignore-certificate-errors makes fetch() accept self-signed certs
args: [
'--ignore-certificate-errors',
'--ignore-certificate-errors-spki-list',
'--allow-insecure-localhost',
]
}
},
// Note: globalSetup runs AFTER webServer plugins in playwright 1.58+, so we
// run setup from the webServer command instead
globalTeardown: './test/globalTeardown.ts',
webServer: {
// Run setup script first (starts XFTP server + proxy), then build, then preview
command: 'npx tsx test/runSetup.ts && npx vite build --mode development && npx vite preview --mode development',
url: 'http://localhost:4173',
reuseExistingServer: false
},
})
+372
View File
@@ -0,0 +1,372 @@
// XFTP upload/download orchestration + URI encoding -- Simplex.FileTransfer.Client.Main
//
// Combines all building blocks: encryption, chunking, XFTP client commands,
// file descriptions, and DEFLATE-compressed URI encoding.
import pako from "pako"
import {encryptFile, encodeFileHeader} from "./crypto/file.js"
import {generateEd25519KeyPair, encodePubKeyEd25519, encodePrivKeyEd25519, decodePrivKeyEd25519, ed25519KeyPairFromSeed} from "./crypto/keys.js"
import {sha512Streaming} from "./crypto/digest.js"
import {prepareChunkSizes, prepareChunkSpecs, getChunkDigest, fileSizeLen, authTagSize} from "./protocol/chunks.js"
import {
encodeFileDescription, decodeFileDescription, validateFileDescription,
base64urlEncode, base64urlDecode,
type FileDescription
} from "./protocol/description.js"
import type {FileInfo} from "./protocol/commands.js"
import {
createXFTPChunk, uploadXFTPChunk, downloadXFTPChunk, downloadXFTPChunkRaw,
deleteXFTPChunk, type XFTPClientAgent
} from "./client.js"
export {newXFTPAgent, closeXFTPAgent, type XFTPClientAgent, type TransportConfig} from "./client.js"
import {processDownloadedFile, decryptReceivedChunk} from "./download.js"
import type {XFTPServer} from "./protocol/address.js"
import {formatXFTPServer, parseXFTPServer} from "./protocol/address.js"
import type {FileHeader} from "./crypto/file.js"
// -- Types
interface SentChunk {
chunkNo: number
senderId: Uint8Array
senderKey: Uint8Array // 64B libsodium Ed25519 private key
recipientId: Uint8Array
recipientKey: Uint8Array // 64B libsodium Ed25519 private key
chunkSize: number
digest: Uint8Array // SHA-256
server: XFTPServer
}
export interface EncryptedFileMetadata {
digest: Uint8Array // SHA-512 of encData
key: Uint8Array // 32B SbKey
nonce: Uint8Array // 24B CbNonce
chunkSizes: number[]
}
export interface EncryptedFileInfo extends EncryptedFileMetadata {
encData: Uint8Array
}
export interface UploadResult {
rcvDescription: FileDescription
sndDescription: FileDescription
uri: string // base64url-encoded compressed YAML (no leading #)
}
export interface DownloadResult {
header: FileHeader
content: Uint8Array
}
// -- URI encoding/decoding (RFC section 4.1: DEFLATE + base64url)
export function encodeDescriptionURI(fd: FileDescription): string {
const yaml = encodeFileDescription(fd)
const compressed = pako.deflateRaw(new TextEncoder().encode(yaml))
return base64urlEncode(compressed)
}
export function decodeDescriptionURI(fragment: string): FileDescription {
const compressed = base64urlDecode(fragment)
const yaml = new TextDecoder().decode(pako.inflateRaw(compressed))
const fd = decodeFileDescription(yaml)
const err = validateFileDescription(fd)
if (err) throw new Error("decodeDescriptionURI: " + err)
return fd
}
// -- Upload
export function encryptFileForUpload(source: Uint8Array, fileName: string): EncryptedFileInfo {
const key = new Uint8Array(32)
const nonce = new Uint8Array(24)
crypto.getRandomValues(key)
crypto.getRandomValues(nonce)
const fileHdr = encodeFileHeader({fileName, fileExtra: null})
const fileSize = BigInt(fileHdr.length + source.length)
const payloadSize = Number(fileSize) + fileSizeLen + authTagSize
const chunkSizes = prepareChunkSizes(payloadSize)
const encSize = BigInt(chunkSizes.reduce((a, b) => a + b, 0))
const encData = encryptFile(source, fileHdr, key, nonce, fileSize, encSize)
const digest = sha512Streaming([encData])
console.log(`[AGENT-DBG] encrypt: encData.len=${encData.length} digest=${_dbgHex(digest, 64)} chunkSizes=[${chunkSizes.join(',')}]`)
return {encData, digest, key, nonce, chunkSizes}
}
const DEFAULT_REDIRECT_THRESHOLD = 400
export interface UploadOptions {
onProgress?: (uploaded: number, total: number) => void
redirectThreshold?: number
readChunk?: (offset: number, size: number) => Promise<Uint8Array>
}
export async function uploadFile(
agent: XFTPClientAgent,
server: XFTPServer,
encrypted: EncryptedFileMetadata,
options?: UploadOptions
): Promise<UploadResult> {
const {onProgress, redirectThreshold, readChunk: readChunkOpt} = options ?? {}
const readChunk: (offset: number, size: number) => Promise<Uint8Array> = readChunkOpt
? readChunkOpt
: ('encData' in encrypted
? (off, sz) => Promise.resolve((encrypted as EncryptedFileInfo).encData.subarray(off, off + sz))
: () => { throw new Error("uploadFile: readChunk required when encData is absent") })
const total = encrypted.chunkSizes.reduce((a, b) => a + b, 0)
const specs = prepareChunkSpecs(encrypted.chunkSizes)
const sentChunks: SentChunk[] = []
let uploaded = 0
for (let i = 0; i < specs.length; i++) {
const spec = specs[i]
const chunkNo = i + 1
const sndKp = generateEd25519KeyPair()
const rcvKp = generateEd25519KeyPair()
const chunkData = await readChunk(spec.chunkOffset, spec.chunkSize)
const chunkDigest = getChunkDigest(chunkData)
console.log(`[AGENT-DBG] upload chunk=${chunkNo} offset=${spec.chunkOffset} size=${spec.chunkSize} digest=${_dbgHex(chunkDigest, 32)} data[0..8]=${_dbgHex(chunkData)} data[-8..]=${_dbgHex(chunkData.slice(-8))}`)
const fileInfo: FileInfo = {
sndKey: encodePubKeyEd25519(sndKp.publicKey),
size: spec.chunkSize,
digest: chunkDigest
}
const rcvKeysForChunk = [encodePubKeyEd25519(rcvKp.publicKey)]
const {senderId, recipientIds} = await createXFTPChunk(
agent, server, sndKp.privateKey, fileInfo, rcvKeysForChunk
)
await uploadXFTPChunk(agent, server, sndKp.privateKey, senderId, chunkData)
sentChunks.push({
chunkNo, senderId, senderKey: sndKp.privateKey,
recipientId: recipientIds[0], recipientKey: rcvKp.privateKey,
chunkSize: spec.chunkSize, digest: chunkDigest, server
})
uploaded += spec.chunkSize
onProgress?.(uploaded, total)
}
const rcvDescription = buildDescription("recipient", encrypted, sentChunks)
const sndDescription = buildDescription("sender", encrypted, sentChunks)
let uri = encodeDescriptionURI(rcvDescription)
let finalRcvDescription = rcvDescription
const threshold = redirectThreshold ?? DEFAULT_REDIRECT_THRESHOLD
if (uri.length > threshold && sentChunks.length > 1) {
finalRcvDescription = await uploadRedirectDescription(agent, server, rcvDescription)
uri = encodeDescriptionURI(finalRcvDescription)
}
return {rcvDescription: finalRcvDescription, sndDescription, uri}
}
function buildDescription(
party: "recipient" | "sender",
enc: EncryptedFileMetadata,
chunks: SentChunk[]
): FileDescription {
const defChunkSize = enc.chunkSizes[0]
return {
party,
size: enc.chunkSizes.reduce((a, b) => a + b, 0),
digest: enc.digest,
key: enc.key,
nonce: enc.nonce,
chunkSize: defChunkSize,
chunks: chunks.map(c => ({
chunkNo: c.chunkNo,
chunkSize: c.chunkSize,
digest: c.digest,
replicas: [{
server: formatXFTPServer(c.server),
replicaId: party === "recipient" ? c.recipientId : c.senderId,
replicaKey: encodePrivKeyEd25519(party === "recipient" ? c.recipientKey : c.senderKey)
}]
})),
redirect: null
}
}
async function uploadRedirectDescription(
agent: XFTPClientAgent,
server: XFTPServer,
innerFd: FileDescription
): Promise<FileDescription> {
const yaml = encodeFileDescription(innerFd)
const yamlBytes = new TextEncoder().encode(yaml)
const enc = encryptFileForUpload(yamlBytes, "")
const specs = prepareChunkSpecs(enc.chunkSizes)
const sentChunks: SentChunk[] = []
for (let i = 0; i < specs.length; i++) {
const spec = specs[i]
const chunkNo = i + 1
const sndKp = generateEd25519KeyPair()
const rcvKp = generateEd25519KeyPair()
const chunkData = enc.encData.subarray(spec.chunkOffset, spec.chunkOffset + spec.chunkSize)
const chunkDigest = getChunkDigest(chunkData)
const fileInfo: FileInfo = {
sndKey: encodePubKeyEd25519(sndKp.publicKey),
size: spec.chunkSize,
digest: chunkDigest
}
const rcvKeysForChunk = [encodePubKeyEd25519(rcvKp.publicKey)]
const {senderId, recipientIds} = await createXFTPChunk(
agent, server, sndKp.privateKey, fileInfo, rcvKeysForChunk
)
await uploadXFTPChunk(agent, server, sndKp.privateKey, senderId, chunkData)
sentChunks.push({
chunkNo, senderId, senderKey: sndKp.privateKey,
recipientId: recipientIds[0], recipientKey: rcvKp.privateKey,
chunkSize: spec.chunkSize, digest: chunkDigest, server
})
}
return {
party: "recipient",
size: enc.chunkSizes.reduce((a, b) => a + b, 0),
digest: enc.digest,
key: enc.key,
nonce: enc.nonce,
chunkSize: enc.chunkSizes[0],
chunks: sentChunks.map(c => ({
chunkNo: c.chunkNo,
chunkSize: c.chunkSize,
digest: c.digest,
replicas: [{
server: formatXFTPServer(c.server),
replicaId: c.recipientId,
replicaKey: encodePrivKeyEd25519(c.recipientKey)
}]
})),
redirect: {size: innerFd.size, digest: innerFd.digest}
}
}
// -- Download
export interface RawDownloadedChunk {
chunkNo: number
dhSecret: Uint8Array
nonce: Uint8Array
body: Uint8Array
digest: Uint8Array
}
export interface DownloadRawOptions {
onProgress?: (downloaded: number, total: number) => void
concurrency?: number
}
export async function downloadFileRaw(
agent: XFTPClientAgent,
fd: FileDescription,
onRawChunk: (chunk: RawDownloadedChunk) => Promise<void>,
options?: DownloadRawOptions
): Promise<FileDescription> {
const err = validateFileDescription(fd)
if (err) throw new Error("downloadFileRaw: " + err)
const {onProgress, concurrency = 1} = options ?? {}
// Resolve redirect on main thread (redirect data is small)
if (fd.redirect !== null) {
console.log(`[AGENT-DBG] resolving redirect: outer size=${fd.size} chunks=${fd.chunks.length}`)
fd = await resolveRedirect(agent, fd)
console.log(`[AGENT-DBG] resolved: size=${fd.size} chunks=${fd.chunks.length} digest=${Array.from(fd.digest.slice(0, 16)).map(x => x.toString(16).padStart(2, '0')).join('')}`)
}
const resolvedFd = fd
// Group chunks by server, sequential within each server, parallel across servers
let downloaded = 0
const byServer = new Map<string, typeof resolvedFd.chunks>()
for (const chunk of resolvedFd.chunks) {
const srv = chunk.replicas[0]?.server ?? ""
if (!byServer.has(srv)) byServer.set(srv, [])
byServer.get(srv)!.push(chunk)
}
await Promise.all([...byServer.entries()].map(async ([srv, chunks]) => {
const server = parseXFTPServer(srv)
for (const chunk of chunks) {
const replica = chunk.replicas[0]
if (!replica) throw new Error("downloadFileRaw: chunk has no replicas")
const seed = decodePrivKeyEd25519(replica.replicaKey)
const kp = ed25519KeyPairFromSeed(seed)
const raw = await downloadXFTPChunkRaw(agent, server, kp.privateKey, replica.replicaId)
console.log(`[AGENT-DBG] chunk=${chunk.chunkNo} body.len=${raw.body.length} expectedChunkSize=${chunk.chunkSize} digest=${_dbgHex(chunk.digest, 32)} body.byteOffset=${raw.body.byteOffset} body.buffer.byteLength=${raw.body.buffer.byteLength}`)
await onRawChunk({
chunkNo: chunk.chunkNo,
dhSecret: raw.dhSecret,
nonce: raw.nonce,
body: raw.body,
digest: chunk.digest
})
downloaded += chunk.chunkSize
onProgress?.(downloaded, resolvedFd.size)
}
}))
return resolvedFd
}
export async function downloadFile(
agent: XFTPClientAgent,
fd: FileDescription,
onProgress?: (downloaded: number, total: number) => void
): Promise<DownloadResult> {
const chunks: Uint8Array[] = []
const resolvedFd = await downloadFileRaw(agent, fd, async (raw) => {
chunks[raw.chunkNo - 1] = decryptReceivedChunk(
raw.dhSecret, raw.nonce, raw.body, raw.digest
)
}, {onProgress})
const totalSize = chunks.reduce((s, c) => s + c.length, 0)
if (totalSize !== resolvedFd.size) throw new Error("downloadFile: file size mismatch")
const digest = sha512Streaming(chunks)
if (!digestEqual(digest, resolvedFd.digest)) throw new Error("downloadFile: file digest mismatch")
return processDownloadedFile(resolvedFd, chunks)
}
async function resolveRedirect(
agent: XFTPClientAgent,
fd: FileDescription
): Promise<FileDescription> {
const plaintextChunks: Uint8Array[] = new Array(fd.chunks.length)
for (const chunk of fd.chunks) {
const replica = chunk.replicas[0]
if (!replica) throw new Error("resolveRedirect: chunk has no replicas")
const server = parseXFTPServer(replica.server)
const seed = decodePrivKeyEd25519(replica.replicaKey)
const kp = ed25519KeyPairFromSeed(seed)
const data = await downloadXFTPChunk(agent, server, kp.privateKey, replica.replicaId, chunk.digest)
plaintextChunks[chunk.chunkNo - 1] = data
}
const totalSize = plaintextChunks.reduce((s, c) => s + c.length, 0)
if (totalSize !== fd.size) throw new Error("resolveRedirect: redirect file size mismatch")
const digest = sha512Streaming(plaintextChunks)
if (!digestEqual(digest, fd.digest)) throw new Error("resolveRedirect: redirect file digest mismatch")
const {content: yamlBytes} = processDownloadedFile(fd, plaintextChunks)
const yamlStr = new TextDecoder().decode(yamlBytes)
const innerFd = decodeFileDescription(yamlStr)
const innerErr = validateFileDescription(innerFd)
if (innerErr) throw new Error("resolveRedirect: inner description invalid: " + innerErr)
if (innerFd.size !== fd.redirect!.size) throw new Error("resolveRedirect: redirect size mismatch")
if (!digestEqual(innerFd.digest, fd.redirect!.digest)) throw new Error("resolveRedirect: redirect digest mismatch")
return innerFd
}
// -- Delete
export async function deleteFile(agent: XFTPClientAgent, sndDescription: FileDescription): Promise<void> {
for (const chunk of sndDescription.chunks) {
const replica = chunk.replicas[0]
if (!replica) throw new Error("deleteFile: chunk has no replicas")
const server = parseXFTPServer(replica.server)
const seed = decodePrivKeyEd25519(replica.replicaKey)
const kp = ed25519KeyPairFromSeed(seed)
await deleteXFTPChunk(agent, server, kp.privateKey, replica.replicaId)
}
}
// -- Internal
function _dbgHex(b: Uint8Array, n = 8): string {
return Array.from(b.slice(0, n)).map(x => x.toString(16).padStart(2, '0')).join('')
}
function digestEqual(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
}
+448
View File
@@ -0,0 +1,448 @@
// XFTP HTTP/2 client -- Simplex.FileTransfer.Client
//
// Connects to XFTP server via HTTP/2, performs web handshake,
// sends authenticated commands, receives responses.
//
// Uses node:http2 in Node.js (tests), fetch() in browsers.
import {
encodeAuthTransmission, encodeTransmission, decodeTransmission,
XFTP_BLOCK_SIZE, initialXFTPVersion, currentXFTPVersion
} from "./protocol/transmission.js"
import {
encodeClientHello, encodeClientHandshake, decodeServerHandshake,
compatibleVRange
} from "./protocol/handshake.js"
import {verifyIdentityProof} from "./crypto/identity.js"
import {generateX25519KeyPair, encodePubKeyX25519, dh} from "./crypto/keys.js"
import {
encodeFNEW, encodeFADD, encodeFPUT, encodeFGET, encodeFDEL, encodePING,
decodeResponse, type FileResponse, type FileInfo, type XFTPErrorType
} from "./protocol/commands.js"
import {decryptReceivedChunk} from "./download.js"
import type {XFTPServer} from "./protocol/address.js"
import {formatXFTPServer} from "./protocol/address.js"
import {concatBytes} from "./protocol/encoding.js"
import {blockUnpad} from "./protocol/transmission.js"
// -- Error types
export class XFTPRetriableError extends Error {
constructor(public readonly errorType: string) {
super(humanReadableMessage(errorType))
this.name = "XFTPRetriableError"
}
}
export class XFTPPermanentError extends Error {
constructor(public readonly errorType: string, message: string) {
super(message)
this.name = "XFTPPermanentError"
}
}
export function isRetriable(e: unknown): boolean {
if (e instanceof XFTPRetriableError) return true
if (e instanceof XFTPPermanentError) return false
if (e instanceof TypeError) return true // fetch network error
if (e instanceof Error && e.name === "AbortError") return true // timeout
return false
}
export function categorizeError(e: unknown): Error {
if (e instanceof XFTPRetriableError || e instanceof XFTPPermanentError) return e
if (e instanceof TypeError) return new XFTPRetriableError("NETWORK")
if (e instanceof Error && e.name === "AbortError") return new XFTPRetriableError("TIMEOUT")
return e instanceof Error ? e : new Error(String(e))
}
export function humanReadableMessage(errorType: string | XFTPErrorType): string {
const t = typeof errorType === "string" ? errorType : errorType.type
switch (t) {
case "SESSION": return "Session expired, reconnecting..."
case "HANDSHAKE": return "Connection interrupted, reconnecting..."
case "NETWORK": return "Network error, retrying..."
case "TIMEOUT": return "Server timeout, retrying..."
case "AUTH": return "File is invalid, expired, or has been removed"
case "NO_FILE": return "File not found — it may have expired"
case "SIZE": return "File size exceeds server limit"
case "QUOTA": return "Server storage quota exceeded"
case "BLOCKED": return "File has been blocked by server"
case "DIGEST": return "File integrity check failed"
case "INTERNAL": return "Server internal error"
case "CMD": return "Protocol error"
default: return "Server error: " + t
}
}
// -- Types
export interface XFTPClient {
baseUrl: string
sessionId: Uint8Array
xftpVersion: number
transport: Transport
}
export interface TransportConfig {
timeoutMs: number // default 30000 (30s), lower for tests
}
const DEFAULT_TRANSPORT_CONFIG: TransportConfig = {timeoutMs: 30000}
interface Transport {
post(body: Uint8Array, headers?: Record<string, string>): Promise<Uint8Array>
close(): void
}
// -- Transport implementations
const isNode = typeof globalThis.process !== "undefined" && globalThis.process.versions?.node
// In development mode, use HTTP proxy to avoid self-signed cert issues in browser
// __XFTP_PROXY_PORT__ is injected by vite build (null in production)
declare const __XFTP_PROXY_PORT__: string | null
async function createTransport(baseUrl: string, config: TransportConfig): Promise<Transport> {
if (isNode) {
return createNodeTransport(baseUrl, config)
} else {
return createBrowserTransport(baseUrl, config)
}
}
async function createNodeTransport(baseUrl: string, config: TransportConfig): Promise<Transport> {
const http2 = await import("node:http2")
const session = http2.connect(baseUrl, {rejectUnauthorized: false})
return {
async post(body: Uint8Array, headers?: Record<string, string>): Promise<Uint8Array> {
return new Promise((resolve, reject) => {
const req = session.request({":method": "POST", ":path": "/", ...headers})
req.setTimeout(config.timeoutMs, () => {
req.close()
reject(Object.assign(new Error("Request timeout"), {name: "AbortError"}))
})
const chunks: Buffer[] = []
req.on("data", (chunk: Buffer) => chunks.push(chunk))
req.on("end", () => resolve(new Uint8Array(Buffer.concat(chunks))))
req.on("error", reject)
req.end(Buffer.from(body))
})
},
close() {
session.close()
}
}
}
function createBrowserTransport(baseUrl: string, config: TransportConfig): Transport {
// In dev mode, route through /xftp-proxy to avoid self-signed cert rejection
// __XFTP_PROXY_PORT__ is 'proxy' in dev mode (uses relative path), null in production
const effectiveUrl = typeof __XFTP_PROXY_PORT__ !== 'undefined' && __XFTP_PROXY_PORT__
? '/xftp-proxy'
: baseUrl
return {
async post(body: Uint8Array, headers?: Record<string, string>): Promise<Uint8Array> {
const controller = new AbortController()
const timer = setTimeout(() => controller.abort(), config.timeoutMs)
try {
const resp = await fetch(effectiveUrl, {
method: "POST",
headers,
body,
signal: controller.signal
})
if (!resp.ok) {
console.error('[XFTP] fetch %s failed: %d %s', effectiveUrl, resp.status, resp.statusText)
throw new Error(`Server request failed: ${resp.status} ${resp.statusText}`)
}
return new Uint8Array(await resp.arrayBuffer())
} finally {
clearTimeout(timer)
}
},
close() {}
}
}
// -- Client agent (connection pool with Promise-based lock)
interface ServerConnection {
client: Promise<XFTPClient> // resolves to connected client; replaced on reconnect
queue: Promise<void> // tail of sequential command chain
}
export interface XFTPClientAgent {
connections: Map<string, ServerConnection>
/** @internal Injectable for testing — defaults to connectXFTP */
_connectFn: (server: XFTPServer) => Promise<XFTPClient>
}
export function newXFTPAgent(): XFTPClientAgent {
return {connections: new Map(), _connectFn: connectXFTP}
}
export function getXFTPServerClient(agent: XFTPClientAgent, server: XFTPServer): Promise<XFTPClient> {
const key = formatXFTPServer(server)
let conn = agent.connections.get(key)
if (!conn) {
const p = agent._connectFn(server)
conn = {client: p, queue: Promise.resolve()}
agent.connections.set(key, conn)
p.catch(() => {
const cur = agent.connections.get(key)
if (cur && cur.client === p) agent.connections.delete(key)
})
}
return conn.client
}
export function reconnectClient(agent: XFTPClientAgent, server: XFTPServer): Promise<XFTPClient> {
const key = formatXFTPServer(server)
const old = agent.connections.get(key)
old?.client.then(c => c.transport.close(), () => {})
const p = agent._connectFn(server)
const conn: ServerConnection = {client: p, queue: old?.queue ?? Promise.resolve()}
agent.connections.set(key, conn)
p.catch(() => {
const cur = agent.connections.get(key)
if (cur && cur.client === p) agent.connections.delete(key)
})
return p
}
export function removeStaleConnection(
agent: XFTPClientAgent, server: XFTPServer, failedP: Promise<XFTPClient>
): void {
const key = formatXFTPServer(server)
const conn = agent.connections.get(key)
if (conn && conn.client === failedP) {
agent.connections.delete(key)
failedP.then(c => c.transport.close(), () => {})
}
}
export function closeXFTPServerClient(agent: XFTPClientAgent, server: XFTPServer): void {
const key = formatXFTPServer(server)
const conn = agent.connections.get(key)
if (conn) {
agent.connections.delete(key)
conn.client.then(c => c.transport.close(), () => {})
}
}
export function closeXFTPAgent(agent: XFTPClientAgent): void {
for (const conn of agent.connections.values()) {
conn.client.then(c => c.transport.close(), () => {})
}
agent.connections.clear()
}
// -- Connect + handshake
export async function connectXFTP(server: XFTPServer, config?: Partial<TransportConfig>): Promise<XFTPClient> {
const cfg: TransportConfig = {...DEFAULT_TRANSPORT_CONFIG, ...config}
const baseUrl = "https://" + server.host + ":" + server.port
const transport = await createTransport(baseUrl, cfg)
try {
// Step 1: send client hello with web challenge
const challenge = new Uint8Array(32)
crypto.getRandomValues(challenge)
const clientHelloBytes = encodeClientHello({webChallenge: challenge})
const shsBody = await transport.post(clientHelloBytes, {"xftp-web-hello": "1"})
// Step 2: decode + verify server handshake
const hs = decodeServerHandshake(shsBody)
if (!hs.webIdentityProof) {
console.error('[XFTP] Server did not provide web identity proof')
throw new Error("Server did not provide web identity proof")
}
const idOk = verifyIdentityProof({
certChainDer: hs.certChainDer,
signedKeyDer: hs.signedKeyDer,
sigBytes: hs.webIdentityProof,
challenge,
sessionId: hs.sessionId,
keyHash: server.keyHash
})
if (!idOk) {
console.error('[XFTP] Server identity verification failed')
throw new Error("Server identity verification failed")
}
// Step 3: version negotiation
const vr = compatibleVRange(hs.xftpVersionRange, {minVersion: initialXFTPVersion, maxVersion: currentXFTPVersion})
if (!vr) {
console.error('[XFTP] Incompatible server version: %o', hs.xftpVersionRange)
throw new Error("Incompatible server version")
}
const xftpVersion = vr.maxVersion
// Step 4: send client handshake
const ack = await transport.post(encodeClientHandshake({xftpVersion, keyHash: server.keyHash}), {"xftp-handshake": "1"})
if (ack.length !== 0) {
console.error('[XFTP] Non-empty handshake ack (%d bytes)', ack.length)
throw new Error("Server handshake failed")
}
return {baseUrl, sessionId: hs.sessionId, xftpVersion, transport}
} catch (e) {
console.error('[XFTP] Connection to %s failed:', baseUrl, e)
transport.close()
throw e
}
}
// -- Send command (single attempt, no retry)
async function sendXFTPCommandOnce(
client: XFTPClient,
privateKey: Uint8Array,
entityId: Uint8Array,
cmdBytes: Uint8Array,
chunkData?: Uint8Array
): Promise<{response: FileResponse, body: Uint8Array}> {
const corrId = new Uint8Array(0)
const block = encodeAuthTransmission(client.sessionId, corrId, entityId, cmdBytes, privateKey)
const reqBody = chunkData ? concatBytes(block, chunkData) : block
const fullResp = await client.transport.post(reqBody)
console.log(`[XFTP-DBG] sendOnce: fullResp.length=${fullResp.length} entityId=${_hex(entityId)} cmdTag=${cmdBytes[0]}`)
if (fullResp.length < XFTP_BLOCK_SIZE) {
console.error('[XFTP] Response too short: %d bytes (expected >= %d)', fullResp.length, XFTP_BLOCK_SIZE)
throw new Error("Server response too short")
}
const respBlock = fullResp.subarray(0, XFTP_BLOCK_SIZE)
const body = fullResp.subarray(XFTP_BLOCK_SIZE)
console.log(`[XFTP-DBG] sendOnce: body.length=${body.length} body.byteOffset=${body.byteOffset} body.buffer.byteLength=${body.buffer.byteLength}`)
// Detect padded error strings (HANDSHAKE, SESSION) before decodeTransmission
const raw = blockUnpad(respBlock)
if (raw.length < 20) {
const text = new TextDecoder().decode(raw)
if (/^[A-Z_]+$/.test(text)) {
throw new XFTPRetriableError(text)
}
}
const {command} = decodeTransmission(client.sessionId, respBlock)
const response = decodeResponse(command)
if (response.type === "FRErr") {
const err = response.err
if (err.type === "SESSION" || err.type === "HANDSHAKE") {
throw new XFTPRetriableError(err.type)
}
throw new XFTPPermanentError(err.type, humanReadableMessage(err))
}
return {response, body}
}
function _hex(b: Uint8Array, n = 8): string {
return Array.from(b.slice(0, n)).map(x => x.toString(16).padStart(2, '0')).join('')
}
// -- Send command (with retry + reconnect)
export async function sendXFTPCommand(
agent: XFTPClientAgent,
server: XFTPServer,
privateKey: Uint8Array,
entityId: Uint8Array,
cmdBytes: Uint8Array,
chunkData?: Uint8Array,
maxRetries: number = 3
): Promise<{response: FileResponse, body: Uint8Array}> {
let clientP = getXFTPServerClient(agent, server)
let client = await clientP
for (let attempt = 1; attempt <= maxRetries; attempt++) {
try {
if (attempt > 1) console.log(`[XFTP-DBG] sendCmd: retry attempt=${attempt}/${maxRetries}`)
return await sendXFTPCommandOnce(client, privateKey, entityId, cmdBytes, chunkData)
} catch (e) {
console.log(`[XFTP-DBG] sendCmd: attempt=${attempt} failed: ${e instanceof Error ? e.message : String(e)} retriable=${isRetriable(e)}`)
if (!isRetriable(e)) {
throw categorizeError(e)
}
if (attempt === maxRetries) {
removeStaleConnection(agent, server, clientP)
throw categorizeError(e)
}
clientP = reconnectClient(agent, server)
client = await clientP
}
}
throw new Error("unreachable")
}
// -- Command wrappers
export async function createXFTPChunk(
agent: XFTPClientAgent, server: XFTPServer, spKey: Uint8Array, file: FileInfo,
rcvKeys: Uint8Array[], auth: Uint8Array | null = null
): Promise<{senderId: Uint8Array, recipientIds: Uint8Array[]}> {
const {response} = await sendXFTPCommand(agent, server, spKey, new Uint8Array(0), encodeFNEW(file, rcvKeys, auth))
if (response.type !== "FRSndIds") throw new Error("unexpected response: " + response.type)
return {senderId: response.senderId, recipientIds: response.recipientIds}
}
export async function addXFTPRecipients(
agent: XFTPClientAgent, server: XFTPServer, spKey: Uint8Array, fId: Uint8Array, rcvKeys: Uint8Array[]
): Promise<Uint8Array[]> {
const {response} = await sendXFTPCommand(agent, server, spKey, fId, encodeFADD(rcvKeys))
if (response.type !== "FRRcvIds") throw new Error("unexpected response: " + response.type)
return response.recipientIds
}
export async function uploadXFTPChunk(
agent: XFTPClientAgent, server: XFTPServer, spKey: Uint8Array, fId: Uint8Array, chunkData: Uint8Array
): Promise<void> {
const {response} = await sendXFTPCommand(agent, server, spKey, fId, encodeFPUT(), chunkData)
if (response.type !== "FROk") throw new Error("unexpected response: " + response.type)
}
export interface RawChunkResponse {
dhSecret: Uint8Array
nonce: Uint8Array
body: Uint8Array
}
export async function downloadXFTPChunkRaw(
agent: XFTPClientAgent, server: XFTPServer, rpKey: Uint8Array, fId: Uint8Array
): Promise<RawChunkResponse> {
const {publicKey, privateKey} = generateX25519KeyPair()
const cmd = encodeFGET(encodePubKeyX25519(publicKey))
const {response, body} = await sendXFTPCommand(agent, server, rpKey, fId, cmd)
if (response.type !== "FRFile") throw new Error("unexpected response: " + response.type)
const dhSecret = dh(response.rcvDhKey, privateKey)
console.log(`[XFTP-DBG] dlChunkRaw: body.length=${body.length} nonce=${_hex(response.nonce, 24)} dhSecret=${_hex(dhSecret)} body[0..8]=${_hex(body)} body[-8..]=${_hex(body.slice(-8))}`)
return {dhSecret, nonce: response.nonce, body}
}
export async function downloadXFTPChunk(
agent: XFTPClientAgent, server: XFTPServer, rpKey: Uint8Array, fId: Uint8Array, digest?: Uint8Array
): Promise<Uint8Array> {
const {dhSecret, nonce, body} = await downloadXFTPChunkRaw(agent, server, rpKey, fId)
return decryptReceivedChunk(dhSecret, nonce, body, digest ?? null)
}
export async function deleteXFTPChunk(
agent: XFTPClientAgent, server: XFTPServer, spKey: Uint8Array, sId: Uint8Array
): Promise<void> {
const {response} = await sendXFTPCommand(agent, server, spKey, sId, encodeFDEL())
if (response.type !== "FROk") throw new Error("unexpected response: " + response.type)
}
export async function pingXFTP(agent: XFTPClientAgent, server: XFTPServer): Promise<void> {
const client = await getXFTPServerClient(agent, server)
const corrId = new Uint8Array(0)
const block = encodeTransmission(client.sessionId, corrId, new Uint8Array(0), encodePING())
const fullResp = await client.transport.post(block)
if (fullResp.length < XFTP_BLOCK_SIZE) throw new Error("pingXFTP: response too short")
const {command} = decodeTransmission(client.sessionId, fullResp.subarray(0, XFTP_BLOCK_SIZE))
const response = decodeResponse(command)
if (response.type !== "FRPong") throw new Error("unexpected response: " + response.type)
}
// -- Close
export function closeXFTP(c: XFTPClient): void {
c.transport.close()
}
+26
View File
@@ -0,0 +1,26 @@
// Cryptographic hash functions matching Simplex.Messaging.Crypto (sha256Hash, sha512Hash).
import sodium from "libsodium-wrappers-sumo"
// SHA-256 digest (32 bytes) -- Crypto.hs:1006
export function sha256(data: Uint8Array): Uint8Array {
return sodium.crypto_hash_sha256(data)
}
// SHA-512 digest (64 bytes) -- Crypto.hs:1011
export function sha512(data: Uint8Array): Uint8Array {
return sodium.crypto_hash_sha512(data)
}
// Streaming SHA-512 over multiple chunks -- avoids copying large data into WASM memory at once.
// Internally segments chunks larger than 4MB to limit peak WASM memory usage.
export function sha512Streaming(chunks: Iterable<Uint8Array>): Uint8Array {
const SEG = 4 * 1024 * 1024
const state = sodium.crypto_hash_sha512_init()
for (const chunk of chunks) {
for (let off = 0; off < chunk.length; off += SEG) {
sodium.crypto_hash_sha512_update(state, chunk.subarray(off, Math.min(off + SEG, chunk.length)))
}
}
return sodium.crypto_hash_sha512_final(state)
}
+94
View File
@@ -0,0 +1,94 @@
// File-level encryption/decryption matching Simplex.FileTransfer.Crypto.
// Operates on in-memory Uint8Array (no file I/O needed for browser).
import {Decoder, concatBytes, encodeInt64, encodeString, decodeString, encodeMaybe, decodeMaybe} from "../protocol/encoding.js"
import {sbInit, sbEncryptChunk, sbDecryptTailTag, sbAuth} from "./secretbox.js"
const AUTH_TAG_SIZE = 16n
// -- FileHeader
export interface FileHeader {
fileName: string
fileExtra: string | null
}
// Encoding matches Haskell: smpEncode (fileName, fileExtra)
// = smpEncode fileName <> smpEncode fileExtra
// = encodeString(fileName) + encodeMaybe(encodeString, fileExtra)
export function encodeFileHeader(hdr: FileHeader): Uint8Array {
return concatBytes(
encodeString(hdr.fileName),
encodeMaybe(encodeString, hdr.fileExtra)
)
}
// Parse FileHeader from decrypted content (first 1024 bytes examined).
// Returns the parsed header and remaining bytes (file content).
export function parseFileHeader(data: Uint8Array): {header: FileHeader, rest: Uint8Array} {
const hdrLen = Math.min(1024, data.length)
const d = new Decoder(data.subarray(0, hdrLen))
const fileName = decodeString(d)
const fileExtra = decodeMaybe(decodeString, d)
const consumed = d.offset()
return {
header: {fileName, fileExtra},
rest: data.subarray(consumed)
}
}
// -- Encryption (FileTransfer.Crypto:encryptFile)
// Encrypt file content with streaming XSalsa20-Poly1305.
// Output format: encrypted(Int64 fileSize | fileHdr | source | '#' padding) | 16-byte auth tag
//
// source -- raw file content
// fileHdr -- pre-encoded FileHeader bytes (from encodeFileHeader)
// key -- 32-byte symmetric key
// nonce -- 24-byte nonce
// fileSize -- BigInt(fileHdr.length + source.length)
// encSize -- total output size (including 16-byte auth tag)
export function encryptFile(
source: Uint8Array,
fileHdr: Uint8Array,
key: Uint8Array,
nonce: Uint8Array,
fileSize: bigint,
encSize: bigint
): Uint8Array {
const state = sbInit(key, nonce)
const lenStr = encodeInt64(fileSize)
const padLen = Number(encSize - AUTH_TAG_SIZE - fileSize - 8n)
if (padLen < 0) throw new Error("encryptFile: encSize too small")
const hdr = sbEncryptChunk(state, concatBytes(lenStr, fileHdr))
const encSource = sbEncryptChunk(state, source)
const padding = new Uint8Array(padLen)
padding.fill(0x23) // '#'
const encPad = sbEncryptChunk(state, padding)
const tag = sbAuth(state)
return concatBytes(hdr, encSource, encPad, tag)
}
// -- Decryption (FileTransfer.Crypto:decryptChunks)
// Decrypt one or more XFTP chunks into a FileHeader and file content.
// Chunks are concatenated, then decrypted as a single stream.
//
// encSize -- total encrypted size (including 16-byte auth tag)
// chunks -- downloaded XFTP chunk data (concatenated = full encrypted file)
// key -- 32-byte symmetric key
// nonce -- 24-byte nonce
export function decryptChunks(
encSize: bigint,
chunks: Uint8Array[],
key: Uint8Array,
nonce: Uint8Array
): {header: FileHeader, content: Uint8Array} {
if (chunks.length === 0) throw new Error("decryptChunks: empty chunks")
const paddedLen = encSize - AUTH_TAG_SIZE
const data = chunks.length === 1 ? chunks[0] : concatBytes(...chunks)
const {valid, content} = sbDecryptTailTag(key, nonce, paddedLen, data)
if (!valid) throw new Error("decryptChunks: invalid auth tag")
const {header, rest} = parseFileHeader(content)
return {header, content: rest}
}
+112
View File
@@ -0,0 +1,112 @@
// 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 via libsodium, Ed448 via @noble/curves.
import {Decoder, concatBytes} from "../protocol/encoding.js"
import {sha256} from "./digest.js"
import {verify, decodePubKeyEd25519, verifyEd448, decodePubKeyEd448} 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
}
// Detect certificate key algorithm from SPKI DER prefix.
// Ed25519 OID 1.3.101.112: byte 8 = 0x70, SPKI = 44 bytes
// Ed448 OID 1.3.101.113: byte 8 = 0x71, SPKI = 69 bytes
type CertKeyAlgorithm = 'ed25519' | 'ed448'
function detectKeyAlgorithm(spki: Uint8Array): CertKeyAlgorithm {
if (spki.length === 44 && spki[8] === 0x70) return 'ed25519'
if (spki.length === 69 && spki[8] === 0x71) return 'ed448'
throw new Error("unsupported certificate key algorithm")
}
// Extract raw public key from SPKI DER, auto-detecting Ed25519 or Ed448.
function extractCertRawKey(spki: Uint8Array): {key: Uint8Array, alg: CertKeyAlgorithm} {
const alg = detectKeyAlgorithm(spki)
const key = alg === 'ed25519' ? decodePubKeyEd25519(spki) : decodePubKeyEd448(spki)
return {key, alg}
}
// Verify signature using the appropriate algorithm.
function verifySig(alg: CertKeyAlgorithm, key: Uint8Array, sig: Uint8Array, msg: Uint8Array): boolean {
return alg === 'ed25519' ? verify(key, sig, msg) : verifyEd448(key, sig, msg)
}
// -- 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 spki = extractCertPublicKeyInfo(cc.leafCert)
const {key, alg} = extractCertRawKey(spki)
if (!verifySig(alg, key, v.sigBytes, concatBytes(v.challenge, v.sessionId))) return false
const sk = extractSignedKey(v.signedKeyDer)
return verifySig(alg, key, 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
}
+172
View File
@@ -0,0 +1,172 @@
// Key generation, signing, DH -- Simplex.Messaging.Crypto (Ed25519/X25519/Ed448 functions).
import sodium from "libsodium-wrappers-sumo"
import {ed448} from "@noble/curves/ed448"
import {sha256} from "./digest.js"
import {concatBytes} from "../protocol/encoding.js"
// -- Ed25519 key generation (Crypto.hs:726 generateAuthKeyPair)
export interface Ed25519KeyPair {
publicKey: Uint8Array // 32 bytes raw
privateKey: Uint8Array // 64 bytes (libsodium: seed || pubkey)
}
export function generateEd25519KeyPair(): Ed25519KeyPair {
const kp = sodium.crypto_sign_keypair()
return {publicKey: kp.publicKey, privateKey: kp.privateKey}
}
// Generate from known 32-byte seed (deterministic, for testing/interop).
export function ed25519KeyPairFromSeed(seed: Uint8Array): Ed25519KeyPair {
const kp = sodium.crypto_sign_seed_keypair(seed)
return {publicKey: kp.publicKey, privateKey: kp.privateKey}
}
// -- X25519 key generation (Crypto.hs via generateKeyPair)
export interface X25519KeyPair {
publicKey: Uint8Array // 32 bytes
privateKey: Uint8Array // 32 bytes
}
export function generateX25519KeyPair(): X25519KeyPair {
const kp = sodium.crypto_box_keypair()
return {publicKey: kp.publicKey, privateKey: kp.privateKey}
}
// Derive X25519 keypair from raw 32-byte private key.
export function x25519KeyPairFromPrivate(privateKey: Uint8Array): X25519KeyPair {
const publicKey = sodium.crypto_scalarmult_base(privateKey)
return {publicKey, privateKey}
}
// -- Ed25519 signing (Crypto.hs:1175 sign')
export function sign(privateKey: Uint8Array, msg: Uint8Array): Uint8Array {
return sodium.crypto_sign_detached(msg, privateKey)
}
// -- Ed25519 verification (Crypto.hs:1270 verify')
export function verify(publicKey: Uint8Array, sig: Uint8Array, msg: Uint8Array): boolean {
try {
return sodium.crypto_sign_verify_detached(sig, msg, publicKey)
} catch {
return false
}
}
// -- X25519 Diffie-Hellman (Crypto.hs:1280 dh')
export function dh(publicKey: Uint8Array, privateKey: Uint8Array): Uint8Array {
return sodium.crypto_scalarmult(privateKey, publicKey)
}
// -- DER encoding for Ed25519 public keys (RFC 8410, SubjectPublicKeyInfo)
// SEQUENCE { SEQUENCE { OID 1.3.101.112 } BIT STRING { 0x00 <32 bytes> } }
const ED25519_PUBKEY_DER_PREFIX = new Uint8Array([
0x30, 0x2a, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x70, 0x03, 0x21, 0x00,
])
const X25519_PUBKEY_DER_PREFIX = new Uint8Array([
0x30, 0x2a, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x6e, 0x03, 0x21, 0x00,
])
export function encodePubKeyEd25519(rawPubKey: Uint8Array): Uint8Array {
return concatBytes(ED25519_PUBKEY_DER_PREFIX, rawPubKey)
}
export function decodePubKeyEd25519(der: Uint8Array): Uint8Array {
if (der.length !== 44) throw new Error("decodePubKeyEd25519: invalid length")
for (let i = 0; i < ED25519_PUBKEY_DER_PREFIX.length; i++) {
if (der[i] !== ED25519_PUBKEY_DER_PREFIX[i]) throw new Error("decodePubKeyEd25519: invalid DER prefix")
}
return der.subarray(12)
}
export function encodePubKeyX25519(rawPubKey: Uint8Array): Uint8Array {
return concatBytes(X25519_PUBKEY_DER_PREFIX, rawPubKey)
}
export function decodePubKeyX25519(der: Uint8Array): Uint8Array {
if (der.length !== 44) throw new Error("decodePubKeyX25519: invalid length")
for (let i = 0; i < X25519_PUBKEY_DER_PREFIX.length; i++) {
if (der[i] !== X25519_PUBKEY_DER_PREFIX[i]) throw new Error("decodePubKeyX25519: invalid DER prefix")
}
return der.subarray(12)
}
// -- DER encoding for Ed448 public keys (RFC 8410, SubjectPublicKeyInfo)
// SEQUENCE { SEQUENCE { OID 1.3.101.113 } BIT STRING { 0x00 <57 bytes> } }
const ED448_PUBKEY_DER_PREFIX = new Uint8Array([
0x30, 0x43, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x71, 0x03, 0x3a, 0x00,
])
export function encodePubKeyEd448(rawPubKey: Uint8Array): Uint8Array {
return concatBytes(ED448_PUBKEY_DER_PREFIX, rawPubKey)
}
export function decodePubKeyEd448(der: Uint8Array): Uint8Array {
if (der.length !== 69) throw new Error("decodePubKeyEd448: invalid length")
for (let i = 0; i < ED448_PUBKEY_DER_PREFIX.length; i++) {
if (der[i] !== ED448_PUBKEY_DER_PREFIX[i]) throw new Error("decodePubKeyEd448: invalid DER prefix")
}
return der.subarray(12)
}
// -- Ed448 verification via @noble/curves (Crypto.hs:1270 verify')
export function verifyEd448(publicKey: Uint8Array, sig: Uint8Array, msg: Uint8Array): boolean {
try {
return ed448.verify(sig, msg, publicKey)
} catch {
return false
}
}
// -- DER encoding for private keys (PKCS8 OneAsymmetricKey, RFC 8410)
// SEQUENCE { INTEGER 0, SEQUENCE { OID }, OCTET STRING { OCTET STRING { <32 bytes> } } }
const ED25519_PRIVKEY_DER_PREFIX = new Uint8Array([
0x30, 0x2e, 0x02, 0x01, 0x00, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x70, 0x04, 0x22, 0x04, 0x20,
])
const X25519_PRIVKEY_DER_PREFIX = new Uint8Array([
0x30, 0x2e, 0x02, 0x01, 0x00, 0x30, 0x05, 0x06, 0x03, 0x2b, 0x65, 0x6e, 0x04, 0x22, 0x04, 0x20,
])
export function encodePrivKeyEd25519(privateKey: Uint8Array): Uint8Array {
// privateKey is 64 bytes (libsodium: seed || pubkey), seed is first 32 bytes
const seed = privateKey.subarray(0, 32)
return concatBytes(ED25519_PRIVKEY_DER_PREFIX, seed)
}
export function decodePrivKeyEd25519(der: Uint8Array): Uint8Array {
if (der.length !== 48) throw new Error("decodePrivKeyEd25519: invalid length")
for (let i = 0; i < ED25519_PRIVKEY_DER_PREFIX.length; i++) {
if (der[i] !== ED25519_PRIVKEY_DER_PREFIX[i]) throw new Error("decodePrivKeyEd25519: invalid DER prefix")
}
// Returns 32-byte seed; call ed25519KeyPairFromSeed to get full keypair.
return der.subarray(16)
}
export function encodePrivKeyX25519(privateKey: Uint8Array): Uint8Array {
return concatBytes(X25519_PRIVKEY_DER_PREFIX, privateKey)
}
export function decodePrivKeyX25519(der: Uint8Array): Uint8Array {
if (der.length !== 48) throw new Error("decodePrivKeyX25519: invalid length")
for (let i = 0; i < X25519_PRIVKEY_DER_PREFIX.length; i++) {
if (der[i] !== X25519_PRIVKEY_DER_PREFIX[i]) throw new Error("decodePrivKeyX25519: invalid DER prefix")
}
return der.subarray(16)
}
// -- KeyHash: SHA-256 of DER-encoded public key (Crypto.hs:981)
export function keyHash(derPubKey: Uint8Array): Uint8Array {
return sha256(derPubKey)
}
+61
View File
@@ -0,0 +1,61 @@
// Block padding matching Simplex.Messaging.Crypto (strict) and Simplex.Messaging.Crypto.Lazy.
// Strict: 2-byte BE length prefix + message + '#' fill.
// Lazy: 8-byte Int64 length prefix + message + '#' fill.
import {encodeWord16, decodeWord16, encodeInt64, decodeInt64, Decoder} from "../protocol/encoding.js"
const HASH = 0x23 // '#'
// -- Strict pad/unPad (protocol messages) -- Crypto.hs:1077
export function pad(msg: Uint8Array, paddedLen: number): Uint8Array {
const len = msg.length
if (len > 65535) throw new Error("pad: message too large for Word16 length")
const fillLen = paddedLen - len - 2
if (fillLen < 0) throw new Error("pad: message exceeds padded size")
const result = new Uint8Array(paddedLen)
const lenBytes = encodeWord16(len)
result.set(lenBytes, 0)
result.set(msg, 2)
result.fill(HASH, 2 + len)
return result
}
export function unPad(padded: Uint8Array): Uint8Array {
if (padded.length < 2) throw new Error("unPad: input too short")
const d = new Decoder(padded)
const len = decodeWord16(d)
if (padded.length - 2 < len) throw new Error("unPad: invalid length")
return padded.subarray(2, 2 + len)
}
// -- Lazy pad/unPad (file encryption) -- Crypto/Lazy.hs:70
export function padLazy(msg: Uint8Array, msgLen: bigint, padLen: bigint): Uint8Array {
const fillLen = padLen - msgLen - 8n
if (fillLen < 0n) throw new Error("padLazy: message exceeds padded size")
const totalLen = Number(padLen)
const result = new Uint8Array(totalLen)
const lenBytes = encodeInt64(msgLen)
result.set(lenBytes, 0)
result.set(msg.subarray(0, Number(msgLen)), 8)
result.fill(HASH, 8 + Number(msgLen))
return result
}
export function unPadLazy(padded: Uint8Array): Uint8Array {
return splitLen(padded).content
}
// splitLen: extract 8-byte Int64 length and content -- Crypto/Lazy.hs:96
// Does not fail if content is shorter than declared length (for chunked decryption).
export function splitLen(data: Uint8Array): {len: bigint; content: Uint8Array} {
if (data.length < 8) throw new Error("splitLen: input too short")
const d = new Decoder(data)
const len = decodeInt64(d)
if (len < 0n) throw new Error("splitLen: negative length")
const numLen = Number(len)
const available = data.length - 8
const takeLen = Math.min(numLen, available)
return {len, content: data.subarray(8, 8 + takeLen)}
}
+219
View File
@@ -0,0 +1,219 @@
// Streaming XSalsa20-Poly1305 -- Simplex.Messaging.Crypto / Crypto.Lazy
//
// Libsodium-wrappers-sumo does not expose crypto_stream_xsalsa20_xor_ic,
// so the Salsa20/20 stream cipher core is implemented here.
// HSalsa20 uses libsodium's crypto_core_hsalsa20.
// Poly1305 uses libsodium's streaming crypto_onetimeauth_* API.
import sodium, {StateAddress} from "libsodium-wrappers-sumo"
import {concatBytes} from "../protocol/encoding.js"
import {pad, unPad, padLazy, unPadLazy} from "./padding.js"
// crypto_core_hsalsa20 exists at runtime but is missing from @types/libsodium-wrappers-sumo
const _sodium = sodium as unknown as {
crypto_core_hsalsa20(input: Uint8Array, key: Uint8Array, constant?: Uint8Array): Uint8Array
} & typeof sodium
// -- Salsa20/20 stream cipher core
function readU32LE(buf: Uint8Array, off: number): number {
return ((buf[off] | (buf[off + 1] << 8) | (buf[off + 2] << 16) | (buf[off + 3] << 24)) >>> 0)
}
function writeU32LE(buf: Uint8Array, off: number, val: number): void {
buf[off] = val & 0xff
buf[off + 1] = (val >>> 8) & 0xff
buf[off + 2] = (val >>> 16) & 0xff
buf[off + 3] = (val >>> 24) & 0xff
}
function rotl32(v: number, n: number): number {
return ((v << n) | (v >>> (32 - n))) >>> 0
}
const SIGMA_0 = 0x61707865
const SIGMA_1 = 0x3320646e
const SIGMA_2 = 0x79622d32
const SIGMA_3 = 0x6b206574
function salsa20Block(key: Uint8Array, nonce8: Uint8Array, counter: number): Uint8Array {
const k0 = readU32LE(key, 0), k1 = readU32LE(key, 4)
const k2 = readU32LE(key, 8), k3 = readU32LE(key, 12)
const k4 = readU32LE(key, 16), k5 = readU32LE(key, 20)
const k6 = readU32LE(key, 24), k7 = readU32LE(key, 28)
const n0 = readU32LE(nonce8, 0), n1 = readU32LE(nonce8, 4)
const s0 = SIGMA_0, s1 = k0, s2 = k1, s3 = k2
const s4 = k3, s5 = SIGMA_1, s6 = n0, s7 = n1
const s8 = counter >>> 0, s9 = 0, s10 = SIGMA_2, s11 = k4
const s12 = k5, s13 = k6, s14 = k7, s15 = SIGMA_3
let x0 = s0, x1 = s1, x2 = s2, x3 = s3
let x4 = s4, x5 = s5, x6 = s6, x7 = s7
let x8 = s8, x9 = s9, x10 = s10, x11 = s11
let x12 = s12, x13 = s13, x14 = s14, x15 = s15
for (let i = 0; i < 10; i++) {
// Column round
x4 ^= rotl32((x0 + x12) >>> 0, 7); x8 ^= rotl32((x4 + x0) >>> 0, 9)
x12 ^= rotl32((x8 + x4) >>> 0, 13); x0 ^= rotl32((x12 + x8) >>> 0, 18)
x9 ^= rotl32((x5 + x1) >>> 0, 7); x13 ^= rotl32((x9 + x5) >>> 0, 9)
x1 ^= rotl32((x13 + x9) >>> 0, 13); x5 ^= rotl32((x1 + x13) >>> 0, 18)
x14 ^= rotl32((x10 + x6) >>> 0, 7); x2 ^= rotl32((x14 + x10) >>> 0, 9)
x6 ^= rotl32((x2 + x14) >>> 0, 13); x10 ^= rotl32((x6 + x2) >>> 0, 18)
x3 ^= rotl32((x15 + x11) >>> 0, 7); x7 ^= rotl32((x3 + x15) >>> 0, 9)
x11 ^= rotl32((x7 + x3) >>> 0, 13); x15 ^= rotl32((x11 + x7) >>> 0, 18)
// Row round
x1 ^= rotl32((x0 + x3) >>> 0, 7); x2 ^= rotl32((x1 + x0) >>> 0, 9)
x3 ^= rotl32((x2 + x1) >>> 0, 13); x0 ^= rotl32((x3 + x2) >>> 0, 18)
x6 ^= rotl32((x5 + x4) >>> 0, 7); x7 ^= rotl32((x6 + x5) >>> 0, 9)
x4 ^= rotl32((x7 + x6) >>> 0, 13); x5 ^= rotl32((x4 + x7) >>> 0, 18)
x11 ^= rotl32((x10 + x9) >>> 0, 7); x8 ^= rotl32((x11 + x10) >>> 0, 9)
x9 ^= rotl32((x8 + x11) >>> 0, 13); x10 ^= rotl32((x9 + x8) >>> 0, 18)
x12 ^= rotl32((x15 + x14) >>> 0, 7); x13 ^= rotl32((x12 + x15) >>> 0, 9)
x14 ^= rotl32((x13 + x12) >>> 0, 13); x15 ^= rotl32((x14 + x13) >>> 0, 18)
}
const out = new Uint8Array(64)
writeU32LE(out, 0, (x0 + s0) >>> 0); writeU32LE(out, 4, (x1 + s1) >>> 0)
writeU32LE(out, 8, (x2 + s2) >>> 0); writeU32LE(out, 12, (x3 + s3) >>> 0)
writeU32LE(out, 16, (x4 + s4) >>> 0); writeU32LE(out, 20, (x5 + s5) >>> 0)
writeU32LE(out, 24, (x6 + s6) >>> 0); writeU32LE(out, 28, (x7 + s7) >>> 0)
writeU32LE(out, 32, (x8 + s8) >>> 0); writeU32LE(out, 36, (x9 + s9) >>> 0)
writeU32LE(out, 40, (x10 + s10) >>> 0); writeU32LE(out, 44, (x11 + s11) >>> 0)
writeU32LE(out, 48, (x12 + s12) >>> 0); writeU32LE(out, 52, (x13 + s13) >>> 0)
writeU32LE(out, 56, (x14 + s14) >>> 0); writeU32LE(out, 60, (x15 + s15) >>> 0)
return out
}
// -- Streaming state
export interface SbState {
_subkey: Uint8Array
_nonce8: Uint8Array
_counter: number
_ksBuf: Uint8Array
_ksOff: number
_authState: StateAddress
}
export function sbInit(key: Uint8Array, nonce: Uint8Array): SbState {
// Double HSalsa20 cascade matching Haskell cryptonite XSalsa20 (Crypto.hs:xSalsa20):
// subkey1 = HSalsa20(key, zeros16)
// subkey2 = HSalsa20(subkey1, nonce[0:16])
// keystream = Salsa20(subkey2, nonce[16:24])
const zeros16 = new Uint8Array(16)
const subkey1 = _sodium.crypto_core_hsalsa20(zeros16, key)
const subkey = _sodium.crypto_core_hsalsa20(nonce.subarray(0, 16), subkey1)
const nonce8 = new Uint8Array(nonce.subarray(16, 24))
const block0 = salsa20Block(subkey, nonce8, 0)
const poly1305Key = block0.subarray(0, 32)
const ksBuf = new Uint8Array(block0.subarray(32))
const authState = sodium.crypto_onetimeauth_init(poly1305Key)
return {_subkey: subkey, _nonce8: nonce8, _counter: 1, _ksBuf: ksBuf, _ksOff: 0, _authState: authState}
}
export function cbInit(dhSecret: Uint8Array, nonce: Uint8Array): SbState {
return sbInit(dhSecret, nonce)
}
export function sbEncryptChunk(state: SbState, chunk: Uint8Array): Uint8Array {
const cipher = xorKeystream(state, chunk)
sodium.crypto_onetimeauth_update(state._authState, cipher)
return cipher
}
export function sbDecryptChunk(state: SbState, chunk: Uint8Array): Uint8Array {
sodium.crypto_onetimeauth_update(state._authState, chunk)
return xorKeystream(state, chunk)
}
export function sbAuth(state: SbState): Uint8Array {
return sodium.crypto_onetimeauth_final(state._authState)
}
// -- High-level: tail tag (tag appended)
export function sbEncryptTailTag(
key: Uint8Array, nonce: Uint8Array,
data: Uint8Array, len: bigint, padLen: bigint
): Uint8Array {
const padded = padLazy(data, len, padLen)
const state = sbInit(key, nonce)
const cipher = sbEncryptChunk(state, padded)
const tag = sbAuth(state)
return concatBytes(cipher, tag)
}
export function sbDecryptTailTag(
key: Uint8Array, nonce: Uint8Array,
paddedLen: bigint, data: Uint8Array
): {valid: boolean; content: Uint8Array} {
const pLen = Number(paddedLen)
const cipher = data.subarray(0, pLen)
const providedTag = data.subarray(pLen)
const state = sbInit(key, nonce)
const plaintext = sbDecryptChunk(state, cipher)
const computedTag = sbAuth(state)
const valid = providedTag.length === 16 && constantTimeEqual(providedTag, computedTag)
const content = unPadLazy(plaintext)
return {valid, content}
}
// -- Tag-prepended secretbox (Haskell Crypto.hs:cryptoBox)
export function cryptoBox(key: Uint8Array, nonce: Uint8Array, msg: Uint8Array): Uint8Array {
const state = sbInit(key, nonce)
const cipher = sbEncryptChunk(state, msg)
const tag = sbAuth(state)
return concatBytes(tag, cipher)
}
export function cbEncrypt(
dhSecret: Uint8Array, nonce: Uint8Array,
msg: Uint8Array, padLen: number
): Uint8Array {
return cryptoBox(dhSecret, nonce, pad(msg, padLen))
}
export function cbDecrypt(
dhSecret: Uint8Array, nonce: Uint8Array,
packet: Uint8Array
): Uint8Array {
const tag = packet.subarray(0, 16)
const cipher = packet.subarray(16)
const state = sbInit(dhSecret, nonce)
const plaintext = sbDecryptChunk(state, cipher)
const computedTag = sbAuth(state)
if (!constantTimeEqual(tag, computedTag)) throw new Error("secretbox: authentication failed")
return unPad(plaintext)
}
// -- Internal
function xorKeystream(state: SbState, data: Uint8Array): Uint8Array {
const result = new Uint8Array(data.length)
let off = 0
while (off < data.length) {
if (state._ksOff >= state._ksBuf.length) {
state._ksBuf = salsa20Block(state._subkey, state._nonce8, state._counter++)
state._ksOff = 0
}
const available = state._ksBuf.length - state._ksOff
const needed = data.length - off
const n = Math.min(available, needed)
for (let i = 0; i < n; i++) {
result[off + i] = data[off + i] ^ state._ksBuf[state._ksOff + i]
}
state._ksOff += n
off += n
}
return result
}
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
}
+76
View File
@@ -0,0 +1,76 @@
// XFTP download pipeline -- integration of protocol + crypto layers.
//
// Ties together: DH key exchange (keys), transport decryption (client),
// file-level decryption (file), chunk sizing (chunks), digest verification.
//
// Usage:
// 1. Parse FileDescription from YAML (description.ts)
// 2. For each chunk replica:
// a. generateX25519KeyPair() -> ephemeral DH keypair
// b. encodeFGET(dhPub) -> FGET command
// c. encodeAuthTransmission(...) -> padded block (send to server)
// d. decodeTransmission(responseBlock) -> raw response
// e. decodeResponse(raw) -> FRFile { rcvDhKey, nonce }
// f. processFileResponse(rcvPrivKey, rcvDhKey, nonce) -> dhSecret
// g. decryptReceivedChunk(dhSecret, nonce, encData, digest) -> plaintext
// 3. processDownloadedFile(fd, plaintextChunks) -> { header, content }
import {dh} from "./crypto/keys.js"
import {sha256} from "./crypto/digest.js"
import {decryptChunks, type FileHeader} from "./crypto/file.js"
import {decryptTransportChunk} from "./protocol/client.js"
import type {FileDescription} from "./protocol/description.js"
// -- Process FRFile response
// Derive transport decryption secret from FRFile response parameters.
// Uses DH(serverDhKey, recipientPrivKey) to produce shared secret.
export function processFileResponse(
recipientPrivKey: Uint8Array, // Ephemeral X25519 private key (32 bytes)
serverDhKey: Uint8Array, // rcvDhKey from FRFile response (32 bytes)
): Uint8Array {
return dh(serverDhKey, recipientPrivKey)
}
// -- Decrypt a single received chunk
// Decrypt transport-encrypted chunk data and verify SHA-256 digest.
// Returns decrypted content or throws on auth tag / digest failure.
export function decryptReceivedChunk(
dhSecret: Uint8Array,
cbNonce: Uint8Array,
encData: Uint8Array,
expectedDigest: Uint8Array | null
): Uint8Array {
const providedTag = encData.slice(encData.length - 16)
const {valid, content} = decryptTransportChunk(dhSecret, cbNonce, encData)
if (!valid) throw new Error("transport auth tag verification failed")
if (expectedDigest !== null) {
const actual = sha256(content)
if (!digestEqual(actual, expectedDigest)) {
throw new Error("chunk digest mismatch")
}
}
return content
}
// -- Full download pipeline
// Process downloaded file: concatenate transport-decrypted chunks,
// then file-level decrypt using key/nonce from file description.
// Returns parsed FileHeader and file content.
export function processDownloadedFile(
fd: FileDescription,
plaintextChunks: Uint8Array[]
): {header: FileHeader, content: Uint8Array} {
return decryptChunks(BigInt(fd.size), plaintextChunks, fd.key, fd.nonce)
}
// -- Internal
function digestEqual(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
}
+54
View File
@@ -0,0 +1,54 @@
// XFTP server address parsing/formatting -- Simplex.Messaging.Protocol (ProtocolServer)
//
// Parses/formats server address strings of the form:
// xftp://<keyhash>@<host>[,<host2>,...][:<port>]
//
// KeyHash is base64url-encoded SHA-256 fingerprint of the identity certificate.
import {base64urlEncode} from "./description.js"
export interface XFTPServer {
keyHash: Uint8Array // 32-byte SHA-256 fingerprint (decoded from base64url)
host: string // primary hostname
port: string // port number (default "443")
}
// Decode base64url (RFC 4648 section 5) to Uint8Array.
function base64urlDecode(s: string): Uint8Array {
// Convert base64url to standard base64
let b64 = s.replace(/-/g, '+').replace(/_/g, '/')
// Add padding if needed
while (b64.length % 4 !== 0) b64 += '='
const bin = atob(b64)
const bytes = new Uint8Array(bin.length)
for (let i = 0; i < bin.length; i++) bytes[i] = bin.charCodeAt(i)
return bytes
}
// Parse an XFTP server address string.
// Format: xftp://<base64url-keyhash>@<host>[,<host2>,...][:<port>]
export function parseXFTPServer(address: string): XFTPServer {
const m = address.match(/^xftp:\/\/([A-Za-z0-9_-]+={0,2})@(.+)$/)
if (!m) throw new Error("parseXFTPServer: invalid address format")
const keyHash = base64urlDecode(m[1])
if (keyHash.length !== 32) throw new Error("parseXFTPServer: keyHash must be 32 bytes")
const hostPart = m[2]
// Take the first host (before any comma), then split port from that
const firstHost = hostPart.split(',')[0]
const colonIdx = firstHost.lastIndexOf(':')
let host: string
let port: string
if (colonIdx > 0) {
host = firstHost.substring(0, colonIdx)
port = firstHost.substring(colonIdx + 1)
} else {
host = firstHost
port = "443"
}
return {keyHash, host, port}
}
// Format an XFTPServer back to its URI string representation.
export function formatXFTPServer(srv: XFTPServer): string {
return "xftp://" + base64urlEncode(srv.keyHash) + "@" + srv.host + ":" + srv.port
}
+86
View File
@@ -0,0 +1,86 @@
// XFTP chunk sizing -- Simplex.FileTransfer.Chunks + Client
//
// Computes chunk sizes for file uploads, chunk specifications with offsets,
// and per-chunk SHA-256 digests.
import {kb, mb} from "./description.js"
import {sha256} from "../crypto/digest.js"
// -- Chunk size constants (Simplex.FileTransfer.Chunks)
export const chunkSize0 = kb(64) // 65536
export const chunkSize1 = kb(256) // 262144
export const chunkSize2 = mb(1) // 1048576
export const chunkSize3 = mb(4) // 4194304
export const serverChunkSizes = [chunkSize0, chunkSize1, chunkSize2, chunkSize3]
// -- Size constants
export const fileSizeLen = 8 // 64-bit file size prefix (padLazy)
export const authTagSize = 16 // Poly1305 authentication tag
// -- Chunk sizing (Simplex.FileTransfer.Client.prepareChunkSizes)
function size34(sz: number): number {
return Math.floor((sz * 3) / 4)
}
export function prepareChunkSizes(payloadSize: number): number[] {
let smallSize: number, bigSize: number
if (payloadSize > size34(chunkSize3)) {
smallSize = chunkSize2; bigSize = chunkSize3
} else if (payloadSize > size34(chunkSize2)) {
smallSize = chunkSize1; bigSize = chunkSize2
} else {
smallSize = chunkSize0; bigSize = chunkSize1
}
function prepareSizes(size: number): number[] {
if (size === 0) return []
if (size >= bigSize) {
const n1 = Math.floor(size / bigSize)
const remSz = size % bigSize
return new Array<number>(n1).fill(bigSize).concat(prepareSizes(remSz))
}
if (size > size34(bigSize)) return [bigSize]
const n2 = Math.floor(size / smallSize)
const remSz2 = size % smallSize
return new Array<number>(remSz2 === 0 ? n2 : n2 + 1).fill(smallSize)
}
return prepareSizes(payloadSize)
}
// Find the smallest server chunk size that fits the payload.
// Returns null if payload exceeds the largest chunk size.
// Matches Haskell singleChunkSize.
export function singleChunkSize(payloadSize: number): number | null {
for (const sz of serverChunkSizes) {
if (payloadSize <= sz) return sz
}
return null
}
// -- Chunk specs
export interface ChunkSpec {
chunkOffset: number
chunkSize: number
}
// Generate chunk specifications with byte offsets.
// Matches Haskell prepareChunkSpecs (without filePath).
export function prepareChunkSpecs(chunkSizes: number[]): ChunkSpec[] {
const specs: ChunkSpec[] = []
let offset = 0
for (const size of chunkSizes) {
specs.push({chunkOffset: offset, chunkSize: size})
offset += size
}
return specs
}
// -- Chunk digest
export function getChunkDigest(chunk: Uint8Array): Uint8Array {
return sha256(chunk)
}
+95
View File
@@ -0,0 +1,95 @@
// XFTP client protocol operations -- Simplex.FileTransfer.Client + Crypto
//
// CbAuthenticator-based command authentication and transport-level
// chunk encryption/decryption for XFTP downloads.
import {concatBytes} from "./encoding.js"
import {dh} from "../crypto/keys.js"
import {sha512} from "../crypto/digest.js"
import {
cbInit, sbEncryptChunk, sbDecryptChunk, sbAuth, cryptoBox
} from "../crypto/secretbox.js"
// -- Constants
export const cbAuthenticatorSize = 80 // SHA512 (64) + authTag (16)
// -- CbAuthenticator (Crypto.hs:cbAuthenticate)
// Create crypto_box authenticator for a message.
// Encrypts sha512(msg) with NaCl crypto_box using DH(peerPubKey, ownPrivKey).
// Returns 80 bytes (16-byte tag prepended + 64-byte encrypted hash).
export function cbAuthenticate(
peerPubKey: Uint8Array,
ownPrivKey: Uint8Array,
nonce: Uint8Array,
msg: Uint8Array
): Uint8Array {
const dhSecret = dh(peerPubKey, ownPrivKey)
const hash = sha512(msg)
return cryptoBox(dhSecret, nonce, hash)
}
// Verify crypto_box authenticator for a message.
// Decrypts authenticator with DH(peerPubKey, ownPrivKey), checks against sha512(msg).
export function cbVerify(
peerPubKey: Uint8Array,
ownPrivKey: Uint8Array,
nonce: Uint8Array,
authenticator: Uint8Array,
msg: Uint8Array
): boolean {
if (authenticator.length !== cbAuthenticatorSize) return false
const dhSecret = dh(peerPubKey, ownPrivKey)
const tag = authenticator.subarray(0, 16)
const cipher = authenticator.subarray(16)
const state = cbInit(dhSecret, nonce)
const plaintext = sbDecryptChunk(state, cipher)
const computedTag = sbAuth(state)
if (!constantTimeEqual(tag, computedTag)) return false
const expectedHash = sha512(msg)
return constantTimeEqual(plaintext, expectedHash)
}
// -- Transport-level chunk encryption/decryption
// Encrypt a chunk for transport (tag-appended format).
// Matches sendEncFile in FileTransfer.Transport:
// ciphertext streamed via sbEncryptChunk, then 16-byte auth tag appended.
export function encryptTransportChunk(
dhSecret: Uint8Array,
cbNonce: Uint8Array,
plainData: Uint8Array
): Uint8Array {
const state = cbInit(dhSecret, cbNonce)
const cipher = sbEncryptChunk(state, plainData)
const tag = sbAuth(state)
return concatBytes(cipher, tag)
}
// Decrypt a transport-encrypted chunk (tag-appended format).
// Matches receiveEncFile / receiveSbFile in FileTransfer.Transport:
// ciphertext decrypted via sbDecryptChunk, then 16-byte auth tag verified.
export function decryptTransportChunk(
dhSecret: Uint8Array,
cbNonce: Uint8Array,
encData: Uint8Array
): {valid: boolean, content: Uint8Array, computedTag: Uint8Array} {
if (encData.length < 16) return {valid: false, content: new Uint8Array(0), computedTag: new Uint8Array(0)}
const cipher = encData.subarray(0, encData.length - 16)
const providedTag = encData.subarray(encData.length - 16)
const state = cbInit(dhSecret, cbNonce)
const plaintext = sbDecryptChunk(state, cipher)
const computedTag = sbAuth(state)
const valid = constantTimeEqual(providedTag, computedTag)
return {valid, content: plaintext, computedTag}
}
// -- Internal
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
}

Some files were not shown because too many files have changed in this diff Show More