Merge pull request #880 from simplex-chat/xrcp

xrcp: SimpleX Remote Control protocol
2026-10-12 02:22:45 +00:00 · 2023-11-18 15:32:58 +00:00
parent 7aae6f3cbe 40ba94ce72
commit 0841067132
39 changed files with 3029 additions and 33 deletions
@@ -0,0 +1,3 @@
+# Streamlined NTRU Prime: sntrup761
+
+The implementation of sntrup761 is the _exact_ copy from this [Internet draft](https://www.ietf.org/archive/id/draft-josefsson-ntruprime-streamlined-00.html).
@@ -0,0 +1,9 @@
+#include <openssl/sha.h>
+#include "sha512.h"
+
+void crypto_hash_sha512 (unsigned char *out,
+                         const unsigned char *in,
+                         unsigned long long inlen)
+{
+  SHA512(in, inlen, out);
+}
@@ -0,0 +1,3 @@
+void crypto_hash_sha512 (unsigned char *out,
+                         const unsigned char *in,
+                         unsigned long long inlen);
@@ -0,0 +1,33 @@
+/*
+ * Derived from public domain source, written by (in alphabetical order):
+ * - Daniel J. Bernstein
+ * - Chitchanok Chuengsatiansup
+ * - Tanja Lange
+ * - Christine van Vredendaal
+ */
+
+#ifndef SNTRUP761_H
+#define SNTRUP761_H
+
+#include <string.h>
+#include <stdint.h>
+
+#define SNTRUP761_SECRETKEY_SIZE 1763
+#define SNTRUP761_PUBLICKEY_SIZE 1158
+#define SNTRUP761_CIPHERTEXT_SIZE 1039
+#define SNTRUP761_SIZE 32
+
+typedef void sntrup761_random_func (void *ctx, size_t length, uint8_t *dst);
+
+void
+sntrup761_keypair (uint8_t *pk, uint8_t *sk,
+                   void *random_ctx, sntrup761_random_func *random);
+
+void
+sntrup761_enc (uint8_t *c, uint8_t *k, const uint8_t *pk,
+               void *random_ctx, sntrup761_random_func *random);
+
+void
+sntrup761_dec (uint8_t *k, const uint8_t *c, const uint8_t *sk);
+
+#endif /* SNTRUP761_H */
@@ -20,6 +20,8 @@ category: Chat, Network, Web, System, Cryptography
 extra-source-files:
  - README.md
  - CHANGELOG.md
+  - cbits/sha512.h
+  - cbits/sntrup761.h

 dependencies:
  - aeson == 2.2.*
@@ -50,7 +52,9 @@ dependencies:
  - memory == 0.18.*
  - mtl == 2.3.*
  - network >= 3.1.2.7 && < 3.2
+  - network-info >= 0.2 && < 0.3
  - network-transport == 0.5.6
+  - network-udp >= 0.0 && < 0.1
  - optparse-applicative >= 0.15 && < 0.17
  - process == 1.6.*
  - random >= 1.1 && < 1.3
@@ -87,6 +91,11 @@ when:

 library:
  source-dirs: src
+  c-sources:
+    - cbits/sha512.c
+    - cbits/sntrup761.c
+  include-dirs: cbits
+  extra-libraries: crypto

 executables:
  smp-server:
@@ -0,0 +1,361 @@
+# SimpleX Remote Control protocol
+
+Using profiles in SimpleX Chat mobile app from desktop app with minimal risk to the security/threat model of SimpleX protocols.
+
+## Problem
+
+Synchronizing profiles that use double ratchet for e2e encryption is effectively impossible in a way that tolerates partitioning between devices without reducing security of double ratchet.
+
+We are not considering replacing (or weakening) double ratchet to allow profile synchronization, as some other messengers did (e.g., Session). We are also not considering Signal model, when profile is known to the server and adding devices results in changing security code and no visibility of conversation history, as it would be substantially different from the current model, and also effectively weakens the security, as in practives most users don't revalidate security codes when they change.
+
+## Solution
+
+The proposed solution is a new remote access/control protocol, when the application on host device (usually mobile) acts as a server, and application on another device (usually desktop) acts as a controller usually running in the same local network.
+
+Existing service discovery and remote control protocols known to us are vulnerable to spoofing, spamming and MITM attacks. This design aims to solve these problems.
+
+## Requirements
+
+- Strong, cryptographically verified identity of the controller device, with the initial connection requiring out-of-band communication of public keys (QR code or link).
+- Identity verification of the host device during session handshake.
+- Protection against malicious "controllers" trying to make host connect to them instead of valid controller on the same network.
+- Protection against replay attacks, both during discovery and during control session.
+- Additional encryption layer inside TLS, with post-quantum algorithm in key agreement.
+- Protect host device from unauthorized access in case of controller compromise.
+- Post-compromised security - that is, even if long term secrets were copied from the controller, and host device was made to connect to malicious controller device, prevent malicious controller from accessing the host device data.
+- Allow general high-level interactions common for many applications:
+  - RPC pattern for commands executed by the host application.
+  - Events sent by host to update controller UI.
+  - Uploading and downloading files between host and controller, either to be processed by the host or to be presented in the controller UI.
+
+This design will allow application-level protocol that is quite close to how SimpleX Chat UI interacts with SimpleX Chat core - there is a similar RPC + events protocol and support for files. The application-level protocol is out of scope of this specification.
+
+## Protocol phases
+
+Protocol consists of four phases:
+- controller session invitation
+- establishing session TLS connection
+- session verification and protocol negotiation
+- session operation
+
+### Session invitation
+
+The invitation to the first session between host and controller pair MUST be shared out-of-band, to establish a long term identity keys/certificates of the controller to host device.
+
+The subsequent sessions can be announced via an application-defined site-local multicast group, e.g. `224.0.0.251` (also used in mDNS/bonjour) and an application-defined port (SimpleX Chat uses 5227).
+
+The session invitation contains this data:
+- supported version range for remote control protocol
+- application-specific information, e.g. device name, application name and supported version range, settings, etc.
+- session start time in seconds since epoch
+- if multicast is used, counter of announce packets sent by controller
+- network address (ipv4 address and port) of the controller
+- CA TLS certificate fingerprint of the controller - this is part of long term identity of the controller established during the first session, and repeated in the subsequent session announcements.
+- Session Ed25519 public key used to verify the announcement and commands - this mitigates the compromise of the long term signature key, as the controller will have to sign each command with this key first.
+- Long-term Ed25519 public key used to verify the announcement and commands - this is part of the long term controller identity.
+- Session X25519 DH key and sntrup761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. These DH public key and KEM encapsulation key are always sent unencrypted. NaCL Cryptobox is used for encryption.
+
+Host device decrypts (except the first session) and validates the invitation:
+- Session signature is valid.
+- Timestamp is within some window from the current time.
+- Long-term key signature is valid.
+- Long-term CA and signature key are the same as in the first session.
+- Some version in the offered range is supported.
+
+OOB session invitation is a URI with this syntax:
+
+```abnf
+sessionAddressUri = "xrcp://" encodedCAFingerprint "@" host ":" port "#/?" qsParams
+encodedCAFingerprint = base64url
+qsParams = param *("&" param)
+param = versionRangeParam / appInfoParam / sessionTsParam /
+        sessPubKeyParam / idPubKeyParam / kemEncKeyParam / dhPubKeyParam /
+        sessSignatureParam / idSignatureParam
+versionRangeParam = "v=" (versionParam / (versionParam "-" versionParam))
+versionParam = 1*DIGIT
+appInfoParam = "app=" escapedJSON ; optional
+sessionTsParam = "ts=" 1*DIGIT
+sessPubKeyParam = "skey=" base64url ; required
+idPubKeyParam = "idkey=" base64url ; required
+dhPubKeyParam = "dh=" base64url ; required
+sessSignatureParam = "ssig=" base64url ; required, signs the URI with this and idSignatureParam param removed
+idSignatureParam = "idsig=" base64url ; required, signs the URI with this param removed
+base64url = <base64url encoded binary> ; RFC4648, section 5
+```
+
+Multicast session announcement is a binary encoded packet with this syntax:
+
+```abnf
+sessionAddressPacket = dhPubKey nonce encrypted(unpaddedSize sessionAddress packetPad)
+dhPubKey = length x509encoded ; same as announced
+nonce = length *OCTET
+sessionAddress = largeLength sessionAddressUri ; as above
+length = 1*1 OCTET ; for binary data up to 255 bytes
+largeLength = 2*2 OCTET ; for binary data up to 65535 bytes
+packetPad = <pad packet size to 1450 bytes> ; possibly, we may need to move KEM agreement one step later,
+; with encapsulation key in HELLO block and KEM ciphertext in reply to HELLO.
+```
+
+### Establishing session TLS connection
+
+Host connects to controller via TCP session and validates CA credentials during TLS handshake. Controller acts as a TCP server in this connection, to avoid host device listening on a port, which might create an attack vector. During TLS handshake the controller's TCP server MUST present a self-signed two-certificate chain where the fingerprint of the first certificate MUST be the same as in the announcement.
+
+Host device presents its own client certificate chain with CA representing a long-term identity of the host device.
+
+### Session verification and protocol negotiation
+
+Once TLS session is established, both the host and controller device present a "session security code" to the user who must match them (e.g., visually or via QR code scan) and confirm on the host device. The session security code must be a digest of tlsunique channel binding. As it is computed as a digest of the TLS handshake for both the controller and the host, it will validate that the same TLS certificates are used on both sides, and that the same TLS session is established, mitigating the possibility of MITM attack in the connection.
+
+Once the session is confirmed by the user, the host device sends "hello" block to the controller. ALPN TLS extension is not used to obtain tlsunique prior to sending any packets.
+
+Block size should be 16384 bytes.
+
+Host HELLO must contain:
+- new session DH key - used to compute new shared secret with the controller keys from the announcement.
+- encrypted part of hello block (JSON object), containing:
+  - chosen protocol version.
+  - host CA TLS certificate fingerprint - part of host long term identity - must match the one presented in TLS handshake and the previous sessions, otherwise the connection is terminated.
+  - KEM encapsulation key - used to compute new shared secret for the session.
+  - additional application specific parameters, e.g host device name, application version, host settings or JSON encoding format.
+
+Hello block syntax:
+
+```abnf
+hostHello = unpaddedSize %s"HELLO " dhPubKey nonce encrypted(unpaddedSize hostHelloJSON helloPad) pad
+unpaddedSize = largeLength
+dhPubKey = length x509encoded
+pad = <pad block size to 16384 bytes>
+helloPad = <pad hello size to 12888 bytes>
+largeLength = 2*2 OCTET
+```
+
+Controller decrypts (including the first session) and validates the received hello block:
+- Chosen versions are supported (must be within offered ranges).
+- CA fingerprint matches the one presented in TLS handshake and the previous sessions - in subsequent sessions TLS connection should be rejected if the fingerprint is different.
+
+JTD schema for the encrypted part of host HELLO block `hostHelloJSON`: 
+
+```json
+{
+  "definitions": {
+    "version": {
+      "type": "string",
+      "metadata": {
+        "format": "[0-9]+"
+      }
+    },
+    "base64url": {
+      "type": "string",
+      "metadata": {
+        "format": "base64url"
+      }
+    }
+  },
+  "properties": {
+    "v": {"ref": "version"},
+    "ca": {"ref": "base64url"},
+    "kem": {"ref": "base64url"}
+  },
+  "optionalProperties": {
+    "app": {"properties": {}, "additionalProperties": true}
+  },
+  "additionalProperties": true
+}
+```
+
+Controller should reply with with `hello` or `error` response:
+
+```abnf
+ctrlHello = unpaddedSize %s"HELLO " kemCyphertext nonce encrypted(unpaddedSize ctrlHelloJSON helloPad) pad
+; ctrlHelloJSON is encrypted with the hybrid secret,
+; including both previously agreed DH secret and KEM secret from kemCyphertext
+unpaddedSize = largeLength
+kemCyphertext = largeLength *OCTET
+pad = <pad block size to 16384 bytes>
+helloPad = <pad hello size to 12888 bytes>
+largeLength = 2*2 OCTET
+
+ctrlError = unpaddedSize %s"ERROR " nonce encrypted(unpaddedSize ctrlErrorJSON helloPad) pad
+; ctrlErrorJSON is encrypted using previously agreed DH secret.
+```
+
+JTD schema for the encrypted part of controller HELLO block `ctrlHelloJSON`:
+
+```json
+{
+  "properties": {},
+  "additionalProperties": true
+}
+```
+
+JTD schema for the encrypted part of controller ERROR block `ctrlErrorJSON`:
+
+```json
+{
+  "properties": {
+    "message": {"type": "string"}
+  },
+  "additionalProperties": true
+}
+```
+
+Once controller replies HELLO to the valid host HELLO block, it should stop accepting new TCP connections.
+
+
+### Сontroller/host session operation
+
+The protocol for communication during the session is out of scope of this protocol.
+
+SimpleX Chat will use HTTP2 encoding, where host device acts as a server and controller acts as a client (these roles are reversed compared with TLS connection).
+
+Payloads in the protocol must be encrypted using NaCL cryptobox using the hybrid shared secret agreed during session establishment.
+
+Commands of the controller must be signed after the encryption using the controller's session and long term Ed25519 keys.
+
+tlsunique channel binding from TLS session MUST be included in commands (included in the signed body).
+
+The syntax for encrypted command and response body encoding:
+
+```
+commandBody = encBody sessSignature idSignature (attachment / noAttachment)
+responseBody = encBody attachment; should match counter in the command
+encBody = nonce encLength32 encrypted(tlsunique counter body)
+attachment = %x01 nonce encLength32 encrypted(attachment)
+noAttachment = %x00
+tlsunique = length 1*OCTET
+counter = 8*8 OCTET ; int64
+encLength32 = 4*4 OCTET ; uint32, includes authTag
+```
+
+If the command or response includes attachment, it's hash must be included in command/response and validated.
+
+## Key agreement for announcement packet and for session
+
+Initial announcement is shared out-of-band (URI with xrcp scheme), and it is not encrypted.
+
+This announcement contains only DH keys, as KEM key is too large to include in QR code, which are used to agree encryption key for host HELLO block. The host HELLO block will containt DH key in plaintext part and KEM encapsulation (public) key in encrypted part, that will be used to determine the shared secret (using SHA256 over concatenated DH shared secret and KEM encapsulated secret) both for controller HELLO response (that contains KEM cyphertext in plaintext part) and subsequent session commands and responses.
+
+During the next session the announcement is sent via encrypted multicast block. The shared key for this announcement and for host HELLO block is determined using the KEM shared secred from the previous session and DH shared secret computed using the host DH key from the previous session and the new controller DH key from the announcement.
+
+For the session, the shared secred is computed again using the KEM shared secret encapsulated by the controller using the new KEM key from the HOST hello block and DH shared secret computed using the host DH key from HELLO block and the new controller DH key from the announcement.
+
+To describe it in pseudocode:
+
+```
+// session 1
+hostHelloSecret(1) = dhSecret(1)
+sessionSecret(1) = sha256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
+dhSecret(1) = dh(hostHelloDhKey(1), controllerInvitationDhKey(1))
+kemCiphertext(1) = enc(kemSecret(1), kemEncKey(1))
+// kemEncKey is included in host HELLO, kemCiphertext - in controller HELLO
+kemSecret(1) = dec(kemCiphertext(1), kemDecKey(1))
+
+// multicast announcement for session n
+announcementSecret(n) = sha256(dhSecret(n'))
+dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerDhKey(n))
+
+// session n
+hostHelloSecret(n) = dhSecret(n)
+sessionSecret(n) = sha256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
+dhSecret(n) = dh(hostHelloDhKey(n), controllerDhKey(n))
+// controllerDhKey(n) is either from invitation or from multicast announcement
+kemCiphertext(n) = enc(kemSecret(n), kemEncKey(n))
+kemSecret(n) = dec(kemCiphertext(n), kemDecKey(n))
+```
+
+If controller fails to store the new host DH key after receiving HELLO block, the encryption will become out of sync and the host won't be able to decrypt the next announcement. To mitigate it, the host should keep the last session DH key and also previous session DH key to try to decrypt the next announcement computing shared secret using both keys (first the new one, and in case it fails - the previous).
+
+To decrypt multicast announcement, the host should try to decrypt it using the keys of all known (paired) remote controllers.
+
+## Other options
+
+The proposed design has these pros/cons:
+
+Pros:
+- mobile host that has sensitive data doesn't act as TLS server.
+- multicast is optional - all sessions can happen via QR code only.
+
+Cons:
+- reversing of client/server roles between TLS and HTTP2.
+- in the first session mobile host TLS client credentials are verified after TLS connection is accepted.
+- cannot be used with host that runs in VM.
+
+The alternative design will use mobile host device as TLS server. The session negotiation process:
+
+- desktop shares its initial credentials via QR code, only for the first session
+- mobile sends encrypted multicast with session address, TLS CA fingerprint, DH key in clear text
+- desktop connects to mobile
+- session tlsunique presented to users on both devices - either user would have to confirm session on both devices or the mobile would have to send an additional "ready" block.
+
+Pros:
+- no reversing server role between TLS and HTTP2
+- TLS credentials are exchanged before TLS, so invalid credentials can be rejected during the handshake of the first session.
+- if some other way to pass data from host to controller is added, then it can be used with host running in VM.
+
+Cons:
+- multicast is mandatory, as there is no efficient way to communicate from mobile to desktop.
+- still needs hello or confirmation on both devices
+- mobile is now acting as TLS server creating additional attack vector
+
+In both proposed and alternative design mobile host has chat data, acts as HTTP2 server, commands are signed with desktop key presented out-of–band, and both commands and responses are encrypted inside TLS session.
+
+Other considered options:
+- SSH - more work integrating it.
+- use SMP connection to negotiate TLS session - it seems wrong to require Internet connection to negotiate a local network connection between desktop and mobile.
+- other multicast service discovery protocols - quite insecure.
+
+## Threat model
+
+#### A passive network adversary able to monitor the site-local traffic:
+
+*can:*
+- observe session times, duration and volume of the transmitted data between host and controller.
+
+*cannot:*
+- observe the content of the transmitted data.
+- substitute the transmitted commands or responses.
+- replay transmitted commands or events from the hosts.
+
+#### An active network adversary able to intercept and substitute the site-local traffic:
+
+*can:*
+- prevent host and controller devices from establishing the session
+
+*cannot:*
+- same as passive adversary, provided that user visually verified session code out-of-band.
+
+#### An active adversary with the access to the network:
+
+*can:*
+- spam controller device.
+
+*cannot:*
+- compromise host or controller devices.
+
+#### An active adversary with the access to the network who also observed OOB announcement:
+
+*can:*
+- connect to controller instead of the host.
+- present incorrect data to the controller.
+
+*cannot:*
+- connect to the host or make host connect to itself.
+
+#### Compromised controller device:
+
+*can:*
+- observe the content of the transmitted data.
+- access any data of the controlled host application, within the capabilities of the provided API.
+
+*cannot:*
+- access other data on the host device.
+- compromise host device.
+
+#### Compromised host device:
+
+*can:*
+- present incorrect data to the controller.
+- incorrectly interpret controller commands.
+
+*cannot:*
+- access controller data, even related to this host device.
@@ -1,6 +1,6 @@
 cabal-version: 1.12

-- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack

@@ -26,6 +26,8 @@ build-type:     Simple
 extra-source-files:
    README.md
    CHANGELOG.md
+    cbits/sha512.h
+    cbits/sntrup761.h

 flag swift
  description: Enable swift JSON format
@@ -99,6 +101,11 @@ library
      Simplex.Messaging.Crypto.File
      Simplex.Messaging.Crypto.Lazy
      Simplex.Messaging.Crypto.Ratchet
+      Simplex.Messaging.Crypto.SNTRUP761
+      Simplex.Messaging.Crypto.SNTRUP761.Bindings
+      Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
+      Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
+      Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
      Simplex.Messaging.Encoding
      Simplex.Messaging.Encoding.String
      Simplex.Messaging.Notifications.Client
@@ -141,11 +148,23 @@ library
      Simplex.Messaging.Transport.WebSockets
      Simplex.Messaging.Util
      Simplex.Messaging.Version
+      Simplex.RemoteControl.Client
+      Simplex.RemoteControl.Discovery
+      Simplex.RemoteControl.Discovery.Multicast
+      Simplex.RemoteControl.Invitation
+      Simplex.RemoteControl.Types
  other-modules:
      Paths_simplexmq
  hs-source-dirs:
      src
  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
+  include-dirs:
+      cbits
+  c-sources:
+      cbits/sha512.c
+      cbits/sntrup761.c
+  extra-libraries:
+      crypto
  build-depends:
      aeson ==2.2.*
    , ansi-terminal >=0.10 && <0.12
@@ -175,7 +194,9 @@ library
    , memory ==0.18.*
    , mtl ==2.3.*
    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
    , network-transport ==0.5.6
+    , network-udp ==0.0.*
    , optparse-applicative >=0.15 && <0.17
    , process ==1.6.*
    , random >=1.1 && <1.3
@@ -238,7 +259,9 @@ executable ntf-server
    , memory ==0.18.*
    , mtl ==2.3.*
    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
    , network-transport ==0.5.6
+    , network-udp ==0.0.*
    , optparse-applicative >=0.15 && <0.17
    , process ==1.6.*
    , random >=1.1 && <1.3
@@ -302,7 +325,9 @@ executable smp-agent
    , memory ==0.18.*
    , mtl ==2.3.*
    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
    , network-transport ==0.5.6
+    , network-udp ==0.0.*
    , optparse-applicative >=0.15 && <0.17
    , process ==1.6.*
    , random >=1.1 && <1.3
@@ -366,7 +391,9 @@ executable smp-server
    , memory ==0.18.*
    , mtl ==2.3.*
    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
    , network-transport ==0.5.6
+    , network-udp ==0.0.*
    , optparse-applicative >=0.15 && <0.17
    , process ==1.6.*
    , random >=1.1 && <1.3
@@ -430,7 +457,9 @@ executable xftp
    , memory ==0.18.*
    , mtl ==2.3.*
    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
    , network-transport ==0.5.6
+    , network-udp ==0.0.*
    , optparse-applicative >=0.15 && <0.17
    , process ==1.6.*
    , random >=1.1 && <1.3
@@ -494,7 +523,9 @@ executable xftp-server
    , memory ==0.18.*
    , mtl ==2.3.*
    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
    , network-transport ==0.5.6
+    , network-udp ==0.0.*
    , optparse-applicative >=0.15 && <0.17
    , process ==1.6.*
    , random >=1.1 && <1.3
@@ -546,6 +577,7 @@ test-suite simplexmq-test
      FileDescriptionTests
      NtfClient
      NtfServerTests
+      RemoteControl
      ServerTests
      SMPAgentClient
      SMPClient
@@ -593,7 +625,9 @@ test-suite simplexmq-test
    , memory ==0.18.*
    , mtl ==2.3.*
    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
    , network-transport ==0.5.6
+    , network-udp ==0.0.*
    , optparse-applicative >=0.15 && <0.17
    , process ==1.6.*
    , random >=1.1 && <1.3
@@ -51,7 +51,6 @@ import Simplex.Messaging.Protocol
    tEncode,
    tEncodeBatch,
    tParse,
-    _smpP,
  )
 import Simplex.Messaging.Transport (SessionId, TransportError (..))
 import Simplex.Messaging.Util (bshow, (<$?>))
@@ -6,9 +6,11 @@
 module Simplex.FileTransfer.Transport
  ( supportedFileServerVRange,
    XFTPRcvChunkSpec (..),
+    ReceiveFileError (..),
    receiveFile,
    sendEncFile,
    receiveEncFile,
+    receiveSbFile,
  )
 where

@@ -16,6 +18,7 @@ import qualified Control.Exception as E
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
+import Data.Bifunctor (first)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)
@@ -59,25 +62,34 @@ receiveFile getBody = receiveFile_ receive
 receiveEncFile :: (Int -> IO ByteString) -> LC.SbState -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO ()
 receiveEncFile getBody = receiveFile_ . receive
  where
-    receive sbState h sz = do
+    receive sbState h sz = first err <$> receiveSbFile getBody h sbState sz
+    err RFESize = SIZE
+    err RFECrypto = CRYPTO
+
+data ReceiveFileError = RFESize | RFECrypto
+
+receiveSbFile :: (Int -> IO ByteString) -> Handle -> LC.SbState -> Word32 -> IO (Either ReceiveFileError ())
+receiveSbFile getBody h = receive
+  where
+    receive sbState sz = do
      ch <- getBody fileBlockSize
      let chSize = fromIntegral $ B.length ch
      if
-        | chSize > sz + authSz -> pure $ Left SIZE
+        | chSize > sz + authSz -> pure $ Left RFESize
        | chSize > 0 -> do
            let (ch', rest) = B.splitAt (fromIntegral sz) ch
                (decCh, sbState') = LC.sbDecryptChunk sbState ch'
                sz' = sz - fromIntegral (B.length ch')
            B.hPut h decCh
            if sz' > 0
-              then receive sbState' h sz'
+              then receive sbState' sz'
              else do
                let tag' = B.take C.authTagSize rest
                    tagSz = B.length tag'
                    tag = LC.sbAuth sbState'
                tag'' <- if tagSz == C.authTagSize then pure tag' else (tag' <>) <$> getBody (C.authTagSize - tagSz)
-                pure $ if BA.constEq tag'' tag then Right () else Left CRYPTO
-        | otherwise -> pure $ Left SIZE
+                pure $ if BA.constEq tag'' tag then Right () else Left RFECrypto
+        | otherwise -> pure $ Left RFESize
    authSz = fromIntegral C.authTagSize

 receiveFile_ :: (Handle -> Word32 -> IO (Either XFTPErrorType ())) -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO ()
@@ -93,6 +93,10 @@ module Simplex.Messaging.Agent
    xftpSendFile,
    xftpDeleteSndFileInternal,
    xftpDeleteSndFileRemote,
+    rcNewHostPairing,
+    rcConnectHost,
+    rcConnectCtrl,
+    rcDiscoverCtrl,
    foregroundAgent,
    suspendAgent,
    execAgentStoreSQL,
@@ -111,6 +115,7 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
+import qualified Data.Aeson as J
 import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -156,6 +161,9 @@ import qualified Simplex.Messaging.Protocol as SMP
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
+import Simplex.RemoteControl.Client
+import Simplex.RemoteControl.Invitation
+import Simplex.RemoteControl.Types
 import UnliftIO.Async (async, race_)
 import UnliftIO.Concurrent (forkFinally, forkIO, threadDelay)
 import UnliftIO.STM
@@ -379,6 +387,37 @@ xftpDeleteSndFileInternal c = withAgentEnv c . deleteSndFileInternal c
 xftpDeleteSndFileRemote :: AgentErrorMonad m => AgentClient -> UserId -> SndFileId -> ValidFileDescription 'FSender -> m ()
 xftpDeleteSndFileRemote c = withAgentEnv c .:. deleteSndFileRemote c

+-- | Create new remote host pairing
+rcNewHostPairing :: MonadIO m => m RCHostPairing
+rcNewHostPairing = liftIO newRCHostPairing
+
+-- | start TLS server for remote host with optional multicast
+rcConnectHost :: AgentErrorMonad m => AgentClient -> RCHostPairing -> J.Value -> Bool -> m RCHostConnection
+rcConnectHost c = withAgentEnv c .:. rcConnectHost'
+
+rcConnectHost' :: AgentMonad m => RCHostPairing -> J.Value -> Bool -> m RCHostConnection
+rcConnectHost' pairing ctrlAppInfo multicast = do
+  drg <- asks random
+  liftError RCP $ connectRCHost drg pairing ctrlAppInfo multicast
+
+-- | connect to remote controller via URI
+rcConnectCtrl :: AgentErrorMonad m => AgentClient -> RCVerifiedInvitation -> Maybe RCCtrlPairing -> J.Value -> m RCCtrlConnection
+rcConnectCtrl c = withAgentEnv c .:. rcConnectCtrl'
+
+rcConnectCtrl' :: AgentMonad m => RCVerifiedInvitation -> Maybe RCCtrlPairing -> J.Value -> m RCCtrlConnection
+rcConnectCtrl' verifiedInv pairing_ hostAppInfo = do
+  drg <- asks random
+  liftError RCP $ connectRCCtrl drg verifiedInv pairing_ hostAppInfo
+
+-- | connect to known remote controller via multicast
+rcDiscoverCtrl :: AgentErrorMonad m => AgentClient -> NonEmpty RCCtrlPairing -> m (RCCtrlPairing, RCVerifiedInvitation)
+rcDiscoverCtrl c = withAgentEnv c . rcDiscoverCtrl'
+
+rcDiscoverCtrl' :: AgentMonad m => NonEmpty RCCtrlPairing -> m (RCCtrlPairing, RCVerifiedInvitation)
+rcDiscoverCtrl' pairings = do
+  subs <- asks multicastSubscribers
+  liftError RCP $ discoverRCCtrl subs pairings
+
 -- | Activate operations
 foregroundAgent :: MonadUnliftIO m => AgentClient -> m ()
 foregroundAgent c = withAgentEnv c $ foregroundAgent' c
@@ -74,6 +74,7 @@ module Simplex.Messaging.Agent.Client
    removeSubscription,
    hasActiveSubscription,
    agentClientStore,
+    agentDRG,
    getAgentSubscriptions,
    SubscriptionsInfo (..),
    SubInfo (..),
@@ -117,7 +118,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
-import Crypto.Random (getRandomBytes)
+import Crypto.Random (ChaChaDRG, getRandomBytes)
 import qualified Data.Aeson.TH as J
 import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Base64
@@ -380,6 +381,9 @@ newAgentClient InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv = do
 agentClientStore :: AgentClient -> SQLiteStore
 agentClientStore AgentClient {agentEnv = Env {store}} = store

+agentDRG :: AgentClient -> TVar ChaChaDRG
+agentDRG AgentClient {agentEnv = Env {random}} = random
+
 class (Encoding err, Show err) => ProtocolServerClient err msg | msg -> err where
  type Client msg = c | c -> msg
  getProtocolServerClient :: AgentMonad m => AgentClient -> TransportSession msg -> m (Client msg)
@@ -182,7 +182,8 @@ data Env = Env
    clientCounter :: TVar Int,
    randomServer :: TVar StdGen,
    ntfSupervisor :: NtfSupervisor,
-    xftpAgent :: XFTPAgent
+    xftpAgent :: XFTPAgent,
+    multicastSubscribers :: TMVar Int
  }

 newSMPAgentEnv :: AgentConfig -> SQLiteStore -> IO Env
@@ -192,7 +193,8 @@ newSMPAgentEnv config@AgentConfig {initialClientId} store = do
  randomServer <- newTVarIO =<< liftIO newStdGen
  ntfSupervisor <- atomically . newNtfSubSupervisor $ tbqSize config
  xftpAgent <- atomically newXFTPAgent
-  pure Env {config, store, random, clientCounter, randomServer, ntfSupervisor, xftpAgent}
+  multicastSubscribers <- newTMVarIO 0
+  pure Env {config, store, random, clientCounter, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers}

 createAgentStore :: FilePath -> String -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
 createAgentStore dbFilePath dbKey = createSQLiteStore dbFilePath dbKey Migrations.app
@@ -211,6 +211,7 @@ import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTra
 import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts_ (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
+import Simplex.RemoteControl.Types
 import Text.Read
 import UnliftIO.Exception (Exception)

@@ -1419,6 +1420,8 @@ data AgentErrorType
    NTF {ntfErr :: ErrorType}
  | -- | XFTP protocol errors forwarded to agent clients
    XFTP {xftpErr :: XFTPErrorType}
+  | -- | XRCP protocol errors forwarded to agent clients
+    RCP {rcpErr :: RCErrorType}
  | -- | SMP server errors
    BROKER {brokerAddress :: String, brokerErr :: BrokerErrorType}
  | -- | errors of other agents
@@ -1528,6 +1531,7 @@ instance StrEncoding AgentErrorType where
      <|> "SMP " *> (SMP <$> strP)
      <|> "NTF " *> (NTF <$> strP)
      <|> "XFTP " *> (XFTP <$> strP)
+      <|> "RCP " *> (RCP <$> strP)
      <|> "BROKER " *> (BROKER <$> textP <* " RESPONSE " <*> (RESPONSE <$> textP))
      <|> "BROKER " *> (BROKER <$> textP <* " TRANSPORT " <*> (TRANSPORT <$> transportErrorP))
      <|> "BROKER " *> (BROKER <$> textP <* A.space <*> parseRead1)
@@ -1544,6 +1548,7 @@ instance StrEncoding AgentErrorType where
    SMP e -> "SMP " <> strEncode e
    NTF e -> "NTF " <> strEncode e
    XFTP e -> "XFTP " <> strEncode e
+    RCP e -> "RCP " <> strEncode e
    BROKER srv (RESPONSE e) -> "BROKER " <> text srv <> " RESPONSE " <> text e
    BROKER srv (TRANSPORT e) -> "BROKER " <> text srv <> " TRANSPORT " <> serializeTransportError e
    BROKER srv e -> "BROKER " <> text srv <> " " <> bshow e
@@ -237,7 +237,7 @@ defaultNetworkConfig =

 transportClientConfig :: NetworkConfig -> TransportClientConfig
 transportClientConfig NetworkConfig {socksProxy, tcpKeepAlive, logTLSErrors} =
-  TransportClientConfig {socksProxy, tcpKeepAlive, logTLSErrors}
+  TransportClientConfig {socksProxy, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing}

 -- | protocol client configuration.
 data ProtocolClientConfig = ProtocolClientConfig
@@ -3,6 +3,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -84,6 +85,7 @@ module Simplex.Messaging.Crypto
    SignatureAlgorithm,
    AlgorithmI (..),
    sign,
+    sign',
    verify,
    verify',
    validSignatureSize,
@@ -115,6 +117,8 @@ module Simplex.Messaging.Crypto
    cbEncrypt,
    cbEncryptMaxLenBS,
    cbDecrypt,
+    sbDecrypt_,
+    sbEncrypt_,
    cbNonce,
    randomCbNonce,
    pseudoRandomCbNonce,
@@ -676,6 +680,10 @@ class CryptoSignature s where
  signatureBytes :: s -> ByteString
  decodeSignature :: ByteString -> Either String s

+instance CryptoSignature (Signature s) => StrEncoding (Signature s) where
+  strEncode = serializeSignature
+  strDecode = decodeSignature
+
 instance CryptoSignature ASignature where
  signatureBytes (ASignature _ sig) = signatureBytes sig
  decodeSignature s
@@ -14,13 +14,16 @@ module Simplex.Messaging.Crypto.Lazy
    sbEncrypt,
    sbDecrypt,
    sbEncryptTailTag,
+    kcbEncryptTailTag,
    sbDecryptTailTag,
+    kcbDecryptTailTag,
    fastReplicate,
    secretBox,
    secretBoxTailTag,
    SbState,
    cbInit,
    sbInit,
+    kcbInit,
    sbEncryptChunk,
    sbDecryptChunk,
    sbEncryptChunkLazy,
@@ -48,6 +51,7 @@ import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
 import Foreign (sizeOf)
 import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), DhSecret (..), DhSecretX25519, SbKey, pattern CbNonce, pattern SbKey)
+import Simplex.Messaging.Crypto.SNTRUP761 (KEMHybridSecret (..))
 import Simplex.Messaging.Encoding

 type LazyByteString = LB.ByteString
@@ -127,13 +131,33 @@ secretBox sbProcess secret nonce msg = run <$> sbInit_ secret nonce

 -- | NaCl @secret_box@ lazy encrypt with a symmetric 256-bit key and 192-bit nonce with appended auth tag (more efficient with large files).
 sbEncryptTailTag :: SbKey -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
-sbEncryptTailTag (SbKey key) (CbNonce nonce) msg len paddedLen =
+sbEncryptTailTag (SbKey key) = sbEncryptTailTag_ key
+{-# INLINE sbEncryptTailTag #-}
+
+-- | NaCl @crypto_box@ lazy encrypt with with a shared hybrid KEM+DH 256-bit secret and 192-bit nonce with appended auth tag (more efficient with large strings/files).
+kcbEncryptTailTag :: KEMHybridSecret -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
+kcbEncryptTailTag (KEMHybridSecret key) = sbEncryptTailTag_ key
+{-# INLINE kcbEncryptTailTag #-}
+
+sbEncryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
+sbEncryptTailTag_ key (CbNonce nonce) msg len paddedLen =
  LB.fromChunks <$> (secretBoxTailTag sbEncryptChunk key nonce =<< pad msg len paddedLen)

 -- | NaCl @secret_box@ decrypt with a symmetric 256-bit key and 192-bit nonce with appended auth tag (more efficient with large files).
 -- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
 sbDecryptTailTag :: SbKey -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
-sbDecryptTailTag (SbKey key) (CbNonce nonce) paddedLen packet =
+sbDecryptTailTag (SbKey key) = sbDecryptTailTag_ key
+{-# INLINE sbDecryptTailTag #-}
+
+-- | NaCl @crypto_box@ lazy decrypt with a shared hybrid KEM+DH 256-bit secret and 192-bit nonce with appended auth tag (more efficient with large strings/files).
+-- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
+kcbDecryptTailTag :: KEMHybridSecret -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
+kcbDecryptTailTag (KEMHybridSecret key) = sbDecryptTailTag_ key
+{-# INLINE kcbDecryptTailTag #-}
+
+-- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
+sbDecryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
+sbDecryptTailTag_ key (CbNonce nonce) paddedLen packet =
  case secretBox sbDecryptChunk key nonce c of
    Right (tag :| cs) ->
      let valid = LB.length tag' == 16 && BA.constEq (LB.toStrict tag') tag
@@ -165,6 +189,10 @@ sbInit :: SbKey -> CbNonce -> Either CryptoError SbState
 sbInit (SbKey secret) (CbNonce nonce) = sbInit_ secret nonce
 {-# INLINE sbInit #-}

+kcbInit :: KEMHybridSecret -> CbNonce -> Either CryptoError SbState
+kcbInit (KEMHybridSecret k) (CbNonce nonce) = sbInit_ k nonce
+{-# INLINE kcbInit #-}
+
 sbInit_ :: ByteArrayAccess key => key -> ByteString -> Either CryptoError SbState
 sbInit_ secret nonce = (state2,) <$> cryptoPassed (Poly1305.initialize rs)
  where
@@ -0,0 +1,31 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Simplex.Messaging.Crypto.SNTRUP761 where
+
+import Crypto.Hash (Digest, SHA256, hash)
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
+import Data.ByteString (ByteString)
+import Simplex.Messaging.Crypto
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings
+
+-- Hybrid shared secret for crypto_box is defined as SHA256(DHSecret || KEMSharedKey),
+-- similar to https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/
+
+newtype KEMHybridSecret = KEMHybridSecret ScrubbedBytes
+
+-- | NaCl @crypto_box@ decrypt with a shared hybrid DH + KEM secret and 192-bit nonce.
+kcbDecrypt :: KEMHybridSecret -> CbNonce -> ByteString -> Either CryptoError ByteString
+kcbDecrypt (KEMHybridSecret k) = sbDecrypt_ k
+
+-- | NaCl @crypto_box@ encrypt with a shared hybrid DH + KEM secret and 192-bit nonce.
+kcbEncrypt :: KEMHybridSecret -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
+kcbEncrypt (KEMHybridSecret k) = sbEncrypt_ k
+
+kemHybridSecret :: PublicKeyX25519 -> PrivateKeyX25519 -> KEMSharedKey -> KEMHybridSecret
+kemHybridSecret k pk (KEMSharedKey kem) =
+  let DhSecretX25519 dh = C.dh' k pk
+   in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA256)
@@ -0,0 +1,82 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Simplex.Messaging.Crypto.SNTRUP761.Bindings where
+
+import Control.Concurrent.STM
+import Crypto.Random (ChaChaDRG)
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Bifunctor (bimap)
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
+import Data.ByteString (ByteString)
+import Database.SQLite.Simple.FromField
+import Database.SQLite.Simple.ToField
+import Foreign (nullPtr)
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (withDRG)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
+
+newtype KEMPublicKey = KEMPublicKey ByteString
+  deriving (Show)
+
+newtype KEMSecretKey = KEMSecretKey ScrubbedBytes
+  deriving (Show)
+
+newtype KEMCiphertext = KEMCiphertext ByteString
+  deriving (Show)
+
+newtype KEMSharedKey = KEMSharedKey ScrubbedBytes
+  deriving (Show)
+
+type KEMKeyPair = (KEMPublicKey, KEMSecretKey)
+
+sntrup761Keypair :: TVar ChaChaDRG -> IO KEMKeyPair
+sntrup761Keypair drg =
+  bimap KEMPublicKey KEMSecretKey
+    <$> BA.allocRet
+      c_SNTRUP761_SECRETKEY_SIZE
+      ( \skPtr ->
+          BA.alloc c_SNTRUP761_PUBLICKEY_SIZE $ \pkPtr ->
+            withDRG drg $ c_sntrup761_keypair pkPtr skPtr nullPtr
+      )
+
+sntrup761Enc :: TVar ChaChaDRG -> KEMPublicKey -> IO (KEMCiphertext, KEMSharedKey)
+sntrup761Enc drg (KEMPublicKey pk) =
+  BA.withByteArray pk $ \pkPtr ->
+    bimap KEMCiphertext KEMSharedKey
+      <$> BA.allocRet
+        c_SNTRUP761_SIZE
+        ( \kPtr ->
+            BA.alloc c_SNTRUP761_CIPHERTEXT_SIZE $ \cPtr ->
+              withDRG drg $ c_sntrup761_enc cPtr kPtr pkPtr nullPtr
+        )
+
+sntrup761Dec :: KEMCiphertext -> KEMSecretKey -> IO KEMSharedKey
+sntrup761Dec (KEMCiphertext c) (KEMSecretKey sk) =
+  BA.withByteArray sk $ \skPtr ->
+    BA.withByteArray c $ \cPtr ->
+      KEMSharedKey
+        <$> BA.alloc c_SNTRUP761_SIZE (\kPtr -> c_sntrup761_dec kPtr cPtr skPtr)
+
+instance StrEncoding KEMPublicKey where
+  strEncode (KEMPublicKey pk) = strEncode (BA.convert pk :: ByteString)
+  strP = KEMPublicKey . BA.convert <$> strP @ByteString
+
+instance Encoding KEMCiphertext where
+  smpEncode (KEMCiphertext c) = smpEncode . Large $ BA.convert c
+  smpP = KEMCiphertext . BA.convert . unLarge <$> smpP
+
+instance ToJSON KEMPublicKey where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+instance FromJSON KEMPublicKey where
+  parseJSON = strParseJSON "KEMPublicKey"
+
+instance ToField KEMSharedKey where
+  toField (KEMSharedKey k) = toField (BA.convert k :: ByteString)
+
+instance FromField KEMSharedKey where
+  fromField f = KEMSharedKey . BA.convert @ByteString <$> fromField f
@@ -0,0 +1,15 @@
+module Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines where
+
+#include "sntrup761.h"
+
+c_SNTRUP761_SECRETKEY_SIZE :: Int
+c_SNTRUP761_SECRETKEY_SIZE = #{const SNTRUP761_SECRETKEY_SIZE}
+
+c_SNTRUP761_PUBLICKEY_SIZE :: Int
+c_SNTRUP761_PUBLICKEY_SIZE = #{const SNTRUP761_PUBLICKEY_SIZE}
+
+c_SNTRUP761_CIPHERTEXT_SIZE :: Int
+c_SNTRUP761_CIPHERTEXT_SIZE = #{const SNTRUP761_CIPHERTEXT_SIZE}
+
+c_SNTRUP761_SIZE :: Int
+c_SNTRUP761_SIZE = #{const SNTRUP761_SIZE}
@@ -0,0 +1,23 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
+  ( c_sntrup761_keypair,
+    c_sntrup761_enc,
+    c_sntrup761_dec,
+  ) where
+
+import Foreign
+import Foreign.C
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (RNGContext, RNGFunc)
+
+-- void sntrup761_keypair (uint8_t *pk, uint8_t *sk, void *random_ctx, sntrup761_random_func *random);
+foreign import ccall "sntrup761_keypair"
+  c_sntrup761_keypair :: Ptr Word8 -> Ptr Word8 -> Ptr RNGContext -> FunPtr RNGFunc -> IO ()
+
+-- void sntrup761_enc (uint8_t *c, uint8_t *k, const uint8_t *pk, void *random_ctx, sntrup761_random_func *random);
+foreign import ccall "sntrup761_enc"
+  c_sntrup761_enc :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr RNGContext -> FunPtr RNGFunc -> IO ()
+
+-- void sntrup761_dec (uint8_t *k, const uint8_t *c, const uint8_t *sk);
+foreign import ccall "sntrup761_dec"
+  c_sntrup761_dec :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
@@ -0,0 +1,30 @@
+module Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
+  ( withDRG,
+    RNGContext,
+    RNGFunc,
+  ) where
+
+import Control.Concurrent.STM
+import Control.Exception (bracket)
+import Crypto.Random (ChaChaDRG)
+import Data.ByteArray (ByteArrayAccess (copyByteArrayToPtr))
+import Foreign
+import Foreign.C
+import qualified Simplex.Messaging.Crypto as C
+
+withDRG :: TVar ChaChaDRG -> (FunPtr RNGFunc -> IO a) -> IO a
+withDRG drg = bracket (createRNGFunc drg) freeHaskellFunPtr
+
+createRNGFunc :: TVar ChaChaDRG -> IO (FunPtr RNGFunc)
+createRNGFunc drg =
+  mkRNGFunc $ \_ctx sz buf -> do
+    bs <- atomically $ C.pseudoRandomBytes (fromIntegral sz) drg
+    copyByteArrayToPtr bs buf
+
+type RNGContext = ()
+
+-- typedef void random_func (void *ctx, size_t length, uint8_t *dst);
+type RNGFunc = Ptr RNGContext -> CSize -> Ptr Word8 -> IO ()
+
+foreign import ccall "wrapper"
+  mkRNGFunc :: RNGFunc -> IO (FunPtr RNGFunc)
@@ -11,6 +11,7 @@ module Simplex.Messaging.Encoding
  ( Encoding (..),
    Tail (..),
    Large (..),
+    _smpP,
    smpEncodeList,
    smpListP,
    lenEncode,
@@ -143,6 +144,9 @@ instance Encoding SystemTime where
  smpP = MkSystemTime <$> smpP <*> pure 0
  {-# INLINE smpP #-}

+_smpP :: Encoding a => Parser a
+_smpP = A.space *> smpP
+
 -- lists encode/parse as a sequence of items prefixed with list length (as 1 byte)
 smpEncodeList :: Encoding a => [a] -> ByteString
 smpEncodeList xs = B.cons (lenEncode $ length xs) . B.concat $ map smpEncode xs
@@ -1203,9 +1203,6 @@ instance ProtocolEncoding ErrorType BrokerMsg where
      | B.null queueId -> Left $ CMD NO_ENTITY
      | otherwise -> Right cmd

-_smpP :: Encoding a => Parser a
-_smpP = A.space *> smpP
-
 -- | Parse SMP protocol commands and broker messages
 parseProtocol :: forall err msg. ProtocolEncoding err msg => Version -> ByteString -> Either err msg
 parseProtocol v s =
@@ -6,6 +6,7 @@ module Simplex.Messaging.Transport.Buffer where

 import Control.Concurrent.STM
 import qualified Control.Exception as E
+import Control.Monad (forM_)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import GHC.IO.Exception (IOErrorType (..), IOException (..), ioException)
@@ -28,6 +29,14 @@ withBufferLock TBuffer {getLock} =
    (atomically $ takeTMVar getLock)
    (atomically $ putTMVar getLock ())

+-- | Attempt to read some bytes, appending it to the existing buffer
+peekBuffered :: TBuffer -> Int -> IO ByteString -> IO (ByteString, Maybe ByteString)
+peekBuffered tb@TBuffer {buffer} t getChunk = withBufferLock tb $ do
+  old <- readTVarIO buffer
+  next_ <- timeout t getChunk
+  forM_ next_ $ \next -> atomically $ writeTVar buffer $! old <> next
+  pure (old, next_)
+
 getBuffered :: TBuffer -> Int -> Maybe Int -> IO ByteString -> IO ByteString
 getBuffered tb@TBuffer {buffer} n t_ getChunk = withBufferLock tb $ do
  b <- readChunks True =<< readTVarIO buffer
@@ -110,12 +110,13 @@ instance IsString (NonEmpty TransportHost) where fromString = parseString strDec
 data TransportClientConfig = TransportClientConfig
  { socksProxy :: Maybe SocksProxy,
    tcpKeepAlive :: Maybe KeepAliveOpts,
-    logTLSErrors :: Bool
+    logTLSErrors :: Bool,
+    clientCredentials :: Maybe (X.CertificateChain, T.PrivKey)
  }
  deriving (Eq, Show)

 defaultTransportClientConfig :: TransportClientConfig
-defaultTransportClientConfig = TransportClientConfig Nothing (Just defaultKeepAliveOpts) True
+defaultTransportClientConfig = TransportClientConfig Nothing (Just defaultKeepAliveOpts) True Nothing

 clientTransportConfig :: TransportClientConfig -> TransportConfig
 clientTransportConfig TransportClientConfig {logTLSErrors} =
@@ -126,9 +127,9 @@ runTransportClient :: (Transport c, MonadUnliftIO m) => TransportClientConfig ->
 runTransportClient = runTLSTransportClient supportedParameters Nothing

 runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> m a) -> m a
-runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive} proxyUsername host port keyHash client = do
+runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials} proxyUsername host port keyHash client = do
  let hostName = B.unpack $ strEncode host
-      clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash
+      clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash clientCredentials
      connectTCP = case socksProxy of
        Just proxy -> connectSocksClient proxy proxyUsername $ hostAddr host
        _ -> connectTCPClient hostName
@@ -205,14 +206,19 @@ instance ToJSON SocksProxy where
 instance FromJSON SocksProxy where
  parseJSON = strParseJSON "SocksProxy"

-mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> T.ClientParams
-mkTLSClientParams supported caStore_ host port keyHash_ = do
-  let p = B.pack port
+mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe (X.CertificateChain, T.PrivKey) -> T.ClientParams
+mkTLSClientParams supported caStore_ host port cafp_ clientCreds_ =
  (T.defaultParamsClient host p)
-    { T.clientShared = maybe def (\caStore -> def {T.sharedCAStore = caStore}) caStore_,
-      T.clientHooks = maybe def (\keyHash -> def {T.onServerCertificate = \_ _ _ -> validateCertificateChain keyHash host p}) keyHash_,
+    { T.clientShared = def {T.sharedCAStore = fromMaybe (T.sharedCAStore def) caStore_},
+      T.clientHooks =
+        def
+          { T.onServerCertificate = maybe def (\cafp _ _ _ -> validateCertificateChain cafp host p) cafp_,
+            T.onCertificateRequest = maybe def (const . pure . Just) clientCreds_
+          },
      T.clientSupported = supported
    }
+  where
+    p = B.pack port

 validateCertificateChain :: C.KeyHash -> HostName -> ByteString -> X.CertificateChain -> IO [XV.FailedReason]
 validateCertificateChain _ _ _ (X.CertificateChain []) = pure [XV.EmptyChain]
@@ -13,7 +13,7 @@ import Data.ASN1.Types (getObjectID)
 import Data.ASN1.Types.String (ASN1StringEncoding (UTF8))
 import Data.Hourglass (Hours (..), timeAdd)
 import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as NE
+import qualified Data.List.NonEmpty as L
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 import qualified Data.X509 as X509
@@ -34,9 +34,9 @@ tlsCredentials :: NonEmpty Credentials -> (C.KeyHash, TLS.Credentials)
 tlsCredentials credentials = (C.KeyHash rootFP, TLS.Credentials [(X509.CertificateChain certs, privateToTls $ snd leafKey)])
  where
    Fingerprint rootFP = getFingerprint root X509.HashSHA256
-    leafKey = fst $ NE.head credentials
-    root = snd $ NE.last credentials
-    certs = map snd $ NE.toList credentials
+    leafKey = fst $ L.head credentials
+    root = snd $ L.last credentials
+    certs = map snd $ L.toList credentials

 privateToTls :: C.APrivateSignKey -> TLS.PrivKey
 privateToTls (C.APrivateSignKey _ k) = case k of
@@ -66,7 +66,7 @@ defaultHTTP2ClientConfig =
  HTTP2ClientConfig
    { qSize = 64,
      connTimeout = 10000000,
-      transportConfig = TransportClientConfig Nothing Nothing True,
+      transportConfig = TransportClientConfig Nothing Nothing True Nothing,
      bufferSize = defaultHTTP2BufferSize,
      bodyHeadSize = 16384,
      suportedTLSParams = http2TLSParams
@@ -19,7 +19,7 @@ import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Time (NominalDiffTime)
 import GHC.Conc
-import UnliftIO.Async
+import UnliftIO hiding (handle)
 import qualified UnliftIO.Exception as UE

 raceAny_ :: MonadUnliftIO m => [m a] -> m ()
@@ -136,6 +136,9 @@ safeDecodeUtf8 = decodeUtf8With onError
  where
    onError _ _ = Just '?'

+timeoutThrow :: (MonadUnliftIO m, MonadError e m) => e -> Int -> m a -> m a
+timeoutThrow e ms action = timeout ms action >>= maybe (throwError e) pure
+
 threadDelay' :: Int64 -> IO ()
 threadDelay' time
  | time <= 0 = pure ()
@@ -0,0 +1,445 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
+module Simplex.RemoteControl.Client
+  ( RCHostClient (action),
+    RCHostConnection,
+    newRCHostPairing,
+    connectRCHost,
+    cancelHostClient,
+    RCCtrlClient (action),
+    RCCtrlConnection,
+    connectRCCtrl,
+    discoverRCCtrl,
+    confirmCtrlSession,
+    cancelCtrlClient,
+    RCStepTMVar,
+    rcEncryptBody,
+    rcDecryptBody,
+    xrcpBlockSize,
+  ) where
+
+import Control.Applicative ((<|>))
+import Control.Logger.Simple
+import Control.Monad
+import Control.Monad.Except
+import Control.Monad.IO.Class
+import Crypto.Random (ChaChaDRG)
+import qualified Data.Aeson as J
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as LB
+import Data.Default (def)
+import Data.Functor (($>))
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
+import Data.Maybe (isNothing)
+import qualified Data.Text as T
+import Data.Time.Clock.System (getSystemTime)
+import qualified Data.X509 as X509
+import Data.X509.Validation (Fingerprint (..), getFingerprint)
+import Network.Socket (PortNumber, SockAddr (..), hostAddressToTuple)
+import qualified Network.TLS as TLS
+import qualified Network.UDP as UDP
+import Simplex.Messaging.Agent.Client ()
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Lazy (LazyByteString)
+import qualified Simplex.Messaging.Crypto.Lazy as LC
+import Simplex.Messaging.Crypto.SNTRUP761
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Transport (TLS (..), cGet, cPut)
+import Simplex.Messaging.Transport.Buffer (peekBuffered)
+import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost (..), defaultTransportClientConfig, runTransportClient)
+import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
+import Simplex.Messaging.Util
+import Simplex.Messaging.Version
+import Simplex.RemoteControl.Discovery (getLocalAddress, recvAnnounce, startTLSServer, withListener, withSender)
+import Simplex.RemoteControl.Invitation
+import Simplex.RemoteControl.Types
+import UnliftIO
+import UnliftIO.Concurrent
+
+currentRCVersion :: Version
+currentRCVersion = 1
+
+supportedRCVRange :: VersionRange
+supportedRCVRange = mkVersionRange 1 currentRCVersion
+
+xrcpBlockSize :: Int
+xrcpBlockSize = 16384
+
+helloBlockSize :: Int
+helloBlockSize = 12288
+
+encInvitationSize :: Int
+encInvitationSize = 900
+
+newRCHostPairing :: IO RCHostPairing
+newRCHostPairing = do
+  ((_, caKey), caCert) <- genCredentials Nothing (-25, 24 * 999999) "ca"
+  (_, idPrivKey) <- C.generateKeyPair'
+  pure RCHostPairing {caKey, caCert, idPrivKey, knownHost = Nothing}
+
+data RCHostClient = RCHostClient
+  { action :: Async (),
+    client_ :: RCHClient_
+  }
+
+data RCHClient_ = RCHClient_
+  { startedPort :: TMVar (Maybe PortNumber),
+    announcer :: TMVar (Async (Either RCErrorType ())),
+    hostCAHash :: TMVar C.KeyHash,
+    endSession :: TMVar ()
+  }
+
+type RCHostConnection = (RCSignedInvitation, RCHostClient, RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)))
+
+connectRCHost :: TVar ChaChaDRG -> RCHostPairing -> J.Value -> Bool -> ExceptT RCErrorType IO RCHostConnection
+connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ctrlAppInfo multicast = do
+  r <- newEmptyTMVarIO
+  host <- getLocalAddress >>= maybe (throwError RCENoLocalAddress) pure
+  c@RCHClient_ {startedPort, announcer} <- liftIO mkClient
+  hostKeys <- liftIO genHostKeys
+  action <- runClient c r hostKeys `putRCError` r
+  -- wait for the port to make invitation
+  -- TODO can't we actually find to which interface the server got connected to get host there?
+  portNum <- atomically $ readTMVar startedPort
+  signedInv@RCSignedInvitation {invitation} <- maybe (throwError RCETLSStartFailed) (liftIO . mkInvitation hostKeys host) portNum
+  when multicast $ case knownHost of
+    Nothing -> throwError RCENewController
+    Just KnownHostPairing {hostDhPubKey} -> do
+      ann <- async . liftIO . runExceptT $ announceRC drg 60 idPrivKey hostDhPubKey hostKeys invitation
+      atomically $ putTMVar announcer ann
+  pure (signedInv, RCHostClient {action, client_ = c}, r)
+  where
+    mkClient :: IO RCHClient_
+    mkClient = do
+      startedPort <- newEmptyTMVarIO
+      announcer <- newEmptyTMVarIO
+      endSession <- newEmptyTMVarIO
+      hostCAHash <- newEmptyTMVarIO
+      pure RCHClient_ {startedPort, announcer, hostCAHash, endSession}
+    runClient :: RCHClient_ -> RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> RCHostKeys -> ExceptT RCErrorType IO (Async ())
+    runClient RCHClient_ {startedPort, announcer, hostCAHash, endSession} r hostKeys = do
+      tlsCreds <- liftIO $ genTLSCredentials caKey caCert
+      startTLSServer startedPort tlsCreds (tlsHooks r knownHost hostCAHash) $ \tls ->
+        void . runExceptT $ do
+          r' <- newEmptyTMVarIO
+          whenM (atomically $ tryPutTMVar r $ Right (tlsUniq tls, tls, r')) $
+            runSession tls r' `putRCError` r'
+      where
+        runSession tls r' = do
+          logDebug "Incoming TLS connection"
+          hostEncHello <- receiveRCPacket tls
+          logDebug "Received host HELLO"
+          hostCA <- atomically $ takeTMVar hostCAHash
+          (ctrlEncHello, sessionKeys, helloBody, pairing') <- prepareHostSession drg hostCA pairing hostKeys hostEncHello
+          sendRCPacket tls ctrlEncHello
+          logDebug "Sent ctrl HELLO"
+          whenM (atomically $ tryPutTMVar r' $ Right (RCHostSession {tls, sessionKeys}, helloBody, pairing')) $ do
+            atomically (tryReadTMVar announcer) >>= mapM_ uninterruptibleCancel
+            -- can use `RCHostSession` until `endSession` is signalled
+            logDebug "Holding session"
+            atomically $ takeTMVar endSession
+    tlsHooks :: TMVar a -> Maybe KnownHostPairing -> TMVar C.KeyHash -> TLS.ServerHooks
+    tlsHooks r knownHost_ hostCAHash =
+      def
+        { TLS.onNewHandshake = \_ -> atomically $ isNothing <$> tryReadTMVar r,
+          TLS.onClientCertificate = \(X509.CertificateChain chain) ->
+            case chain of
+              [_leaf, ca] -> do
+                let kh = certFingerprint ca
+                    accept = maybe True (\h -> h.hostFingerprint == kh) knownHost_
+                if accept
+                  then atomically (putTMVar hostCAHash kh) $> TLS.CertificateUsageAccept
+                  else pure $ TLS.CertificateUsageReject TLS.CertificateRejectUnknownCA
+              _ ->
+                pure $ TLS.CertificateUsageReject TLS.CertificateRejectUnknownCA
+        }
+    genHostKeys :: IO RCHostKeys
+    genHostKeys = do
+      sessKeys <- C.generateKeyPair'
+      dhKeys <- C.generateKeyPair'
+      pure RCHostKeys {sessKeys, dhKeys}
+    mkInvitation :: RCHostKeys -> TransportHost -> PortNumber -> IO RCSignedInvitation
+    mkInvitation RCHostKeys {sessKeys, dhKeys} host portNum = do
+      ts <- getSystemTime
+      let inv =
+            RCInvitation
+              { ca = certFingerprint caCert,
+                host,
+                port = fromIntegral portNum,
+                v = supportedRCVRange,
+                app = ctrlAppInfo,
+                ts,
+                skey = fst sessKeys,
+                idkey = C.publicKey idPrivKey,
+                dh = fst dhKeys
+              }
+      pure $ signInvitation (snd sessKeys) idPrivKey inv
+
+genTLSCredentials :: C.APrivateSignKey -> C.SignedCertificate -> IO TLS.Credentials
+genTLSCredentials caKey caCert = do
+  let caCreds = (C.signatureKeyPair caKey, caCert)
+  leaf <- genCredentials (Just caCreds) (0, 24 * 999999) "localhost" -- session-signing cert
+  pure . snd $ tlsCredentials (leaf :| [caCreds])
+
+certFingerprint :: X509.SignedCertificate -> C.KeyHash
+certFingerprint caCert = C.KeyHash fp
+  where
+    Fingerprint fp = getFingerprint caCert X509.HashSHA256
+
+cancelHostClient :: RCHostClient -> IO ()
+cancelHostClient RCHostClient {action, client_ = RCHClient_ {announcer, endSession}} = do
+  atomically $ putTMVar endSession ()
+  atomically (tryTakeTMVar announcer) >>= mapM_ uninterruptibleCancel
+  uninterruptibleCancel action
+
+prepareHostSession :: TVar ChaChaDRG -> C.KeyHash -> RCHostPairing -> RCHostKeys -> RCHostEncHello -> ExceptT RCErrorType IO (RCCtrlEncHello, HostSessKeys, RCHostHello, RCHostPairing)
+prepareHostSession
+  drg
+  tlsHostFingerprint
+  pairing@RCHostPairing {idPrivKey, knownHost = knownHost_}
+  RCHostKeys {sessKeys = (_, sessPrivKey), dhKeys = (_, dhPrivKey)}
+  RCHostEncHello {dhPubKey, nonce, encBody} = do
+    let sharedKey = C.dh' dhPubKey dhPrivKey
+    helloBody <- liftEitherWith (const RCEDecrypt) $ C.cbDecrypt sharedKey nonce encBody
+    hostHello@RCHostHello {v, ca, kem = kemPubKey} <- liftEitherWith RCESyntax $ J.eitherDecodeStrict helloBody
+    unless (ca == tlsHostFingerprint) $ throwError RCEIdentity
+    (kemCiphertext, kemSharedKey) <- liftIO $ sntrup761Enc drg kemPubKey
+    let hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey
+    unless (isCompatible v supportedRCVRange) $ throwError RCEVersion
+    let keys = HostSessKeys {hybridKey, idPrivKey, sessPrivKey}
+    knownHost' <- updateKnownHost ca dhPubKey
+    let ctrlHello = RCCtrlHello {}
+    -- TODO send error response if something fails
+    nonce' <- liftIO . atomically $ C.pseudoRandomCbNonce drg
+    encBody' <- liftEitherWith (const RCEBlockSize) $ kcbEncrypt hybridKey nonce' (LB.toStrict $ J.encode ctrlHello) helloBlockSize
+    let ctrlEncHello = RCCtrlEncHello {kem = kemCiphertext, nonce = nonce', encBody = encBody'}
+    pure (ctrlEncHello, keys, hostHello, pairing {knownHost = Just knownHost'})
+    where
+      updateKnownHost :: C.KeyHash -> C.PublicKeyX25519 -> ExceptT RCErrorType IO KnownHostPairing
+      updateKnownHost ca hostDhPubKey = case knownHost_ of
+        Just h -> do
+          unless (h.hostFingerprint == tlsHostFingerprint) . throwError $
+            RCEInternal "TLS host CA is different from host pairing, should be caught in TLS handshake"
+          pure (h :: KnownHostPairing) {hostDhPubKey}
+        Nothing -> pure KnownHostPairing {hostFingerprint = ca, hostDhPubKey}
+
+data RCCtrlClient = RCCtrlClient
+  { action :: Async (),
+    client_ :: RCCClient_
+  }
+
+data RCCClient_ = RCCClient_
+  { confirmSession :: TMVar Bool,
+    endSession :: TMVar ()
+  }
+
+type RCCtrlConnection = (RCCtrlClient, RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)))
+
+-- app should determine whether it is a new or known pairing based on CA fingerprint in the invitation
+connectRCCtrl :: TVar ChaChaDRG -> RCVerifiedInvitation -> Maybe RCCtrlPairing -> J.Value -> ExceptT RCErrorType IO RCCtrlConnection
+connectRCCtrl drg (RCVerifiedInvitation inv@RCInvitation {ca, idkey}) pairing_ hostAppInfo = do
+  pairing' <- maybe (liftIO newCtrlPairing) updateCtrlPairing pairing_
+  connectRCCtrl_ drg pairing' inv hostAppInfo
+  where
+    newCtrlPairing :: IO RCCtrlPairing
+    newCtrlPairing = do
+      ((_, caKey), caCert) <- genCredentials Nothing (0, 24 * 999999) "ca"
+      (_, dhPrivKey) <- C.generateKeyPair'
+      pure RCCtrlPairing {caKey, caCert, ctrlFingerprint = ca, idPubKey = idkey, dhPrivKey, prevDhPrivKey = Nothing}
+    updateCtrlPairing :: RCCtrlPairing -> ExceptT RCErrorType IO RCCtrlPairing
+    updateCtrlPairing pairing@RCCtrlPairing {ctrlFingerprint, idPubKey, dhPrivKey = currDhPrivKey} = do
+      unless (ca == ctrlFingerprint && idPubKey == idkey) $ throwError RCEIdentity
+      (_, dhPrivKey) <- liftIO C.generateKeyPair'
+      pure pairing {dhPrivKey, prevDhPrivKey = Just currDhPrivKey}
+
+connectRCCtrl_ :: TVar ChaChaDRG -> RCCtrlPairing -> RCInvitation -> J.Value -> ExceptT RCErrorType IO RCCtrlConnection
+connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca, host, port} hostAppInfo = do
+  r <- newEmptyTMVarIO
+  c <- liftIO mkClient
+  action <- async $ runClient c r `putRCError` r
+  pure (RCCtrlClient {action, client_ = c}, r)
+  where
+    mkClient :: IO RCCClient_
+    mkClient = do
+      confirmSession <- newEmptyTMVarIO
+      endSession <- newEmptyTMVarIO
+      pure RCCClient_ {confirmSession, endSession}
+    runClient :: RCCClient_ -> RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> ExceptT RCErrorType IO ()
+    runClient RCCClient_ {confirmSession, endSession} r = do
+      clientCredentials <-
+        liftIO (genTLSCredentials caKey caCert) >>= \case
+          TLS.Credentials (creds : _) -> pure $ Just creds
+          _ -> throwError $ RCEInternal "genTLSCredentials must generate credentials"
+      let clientConfig = defaultTransportClientConfig {clientCredentials}
+      runTransportClient clientConfig Nothing host (show port) (Just ca) $ \tls@TLS {tlsBuffer, tlsContext} -> do
+        -- pump socket to detect connection problems
+        liftIO $ peekBuffered tlsBuffer 100000 (TLS.recvData tlsContext) >>= logDebug . tshow -- should normally be ("", Nothing) here
+        logDebug "Got TLS connection"
+        r' <- newEmptyTMVarIO
+        whenM (atomically $ tryPutTMVar r $ Right (tlsUniq tls, tls, r')) $ do
+          logDebug "Waiting for session confirmation"
+          whenM (atomically $ readTMVar confirmSession) $ runSession tls r' `putRCError` r'
+      where
+        runSession tls r' = do
+          (sharedKey, kemPrivKey, hostEncHello) <- prepareHostHello drg pairing' inv hostAppInfo
+          sendRCPacket tls hostEncHello
+          ctrlEncHello <- receiveRCPacket tls
+          logDebug "Received ctrl HELLO"
+          ctrlSessKeys <- prepareCtrlSession pairing' inv sharedKey kemPrivKey ctrlEncHello
+          whenM (atomically $ tryPutTMVar r' $ Right (RCCtrlSession {tls, sessionKeys = ctrlSessKeys}, pairing')) $ do
+            logDebug "Session started"
+            -- release second putTMVar in confirmCtrlSession
+            void . atomically $ takeTMVar confirmSession
+            atomically $ takeTMVar endSession
+            logDebug "Session ended"
+
+catchRCError :: ExceptT RCErrorType IO a -> (RCErrorType -> ExceptT RCErrorType IO a) -> ExceptT RCErrorType IO a
+catchRCError = catchAllErrors (RCEException . show)
+{-# INLINE catchRCError #-}
+
+putRCError :: ExceptT RCErrorType IO a -> TMVar (Either RCErrorType b) -> ExceptT RCErrorType IO a
+a `putRCError` r = a `catchRCError` \e -> atomically (tryPutTMVar r $ Left e) >> throwError e
+
+sendRCPacket :: Encoding a => TLS -> a -> ExceptT RCErrorType IO ()
+sendRCPacket tls pkt = do
+  b <- liftEitherWith (const RCEBlockSize) $ C.pad (smpEncode pkt) xrcpBlockSize
+  liftIO $ cPut tls b
+
+receiveRCPacket :: Encoding a => TLS -> ExceptT RCErrorType IO a
+receiveRCPacket tls = do
+  b <- liftIO $ cGet tls xrcpBlockSize
+  when (B.length b /= xrcpBlockSize) $ throwError RCEBlockSize
+  b' <- liftEitherWith (const RCEBlockSize) $ C.unPad b
+  liftEitherWith RCESyntax $ smpDecode b'
+
+prepareHostHello :: TVar ChaChaDRG -> RCCtrlPairing -> RCInvitation -> J.Value -> ExceptT RCErrorType IO (C.DhSecretX25519, KEMSecretKey, RCHostEncHello)
+prepareHostHello
+  drg
+  RCCtrlPairing {caCert, dhPrivKey}
+  RCInvitation {v, dh = dhPubKey}
+  hostAppInfo = do
+    logDebug "Preparing session"
+    case compatibleVersion v supportedRCVRange of
+      Nothing -> throwError RCEVersion
+      Just (Compatible v') -> do
+        nonce <- liftIO . atomically $ C.pseudoRandomCbNonce drg
+        (kemPubKey, kemPrivKey) <- liftIO $ sntrup761Keypair drg
+        let helloBody = RCHostHello {v = v', ca = certFingerprint caCert, app = hostAppInfo, kem = kemPubKey}
+            sharedKey = C.dh' dhPubKey dhPrivKey
+        encBody <- liftEitherWith (const RCEBlockSize) $ C.cbEncrypt sharedKey nonce (LB.toStrict $ J.encode helloBody) helloBlockSize
+        -- let sessKeys = CtrlSessKeys {hybridKey, idPubKey, sessPubKey = skey}
+        let hostEncHello = RCHostEncHello {dhPubKey = C.publicKey dhPrivKey, nonce, encBody}
+        pure (sharedKey, kemPrivKey, hostEncHello)
+
+prepareCtrlSession :: RCCtrlPairing -> RCInvitation -> C.DhSecretX25519 -> KEMSecretKey -> RCCtrlEncHello -> ExceptT RCErrorType IO CtrlSessKeys
+prepareCtrlSession
+  RCCtrlPairing {idPubKey, dhPrivKey}
+  RCInvitation {skey, dh = dhPubKey}
+  sharedKey
+  kemPrivKey = \case
+    RCCtrlEncHello {kem = kemCiphertext, nonce, encBody} -> do
+      kemSharedKey <- liftIO $ sntrup761Dec kemCiphertext kemPrivKey
+      let hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey
+      helloBody <- liftEitherWith (const RCEDecrypt) $ kcbDecrypt hybridKey nonce encBody
+      logDebug "Decrypted ctrl HELLO"
+      RCCtrlHello {} <- liftEitherWith RCESyntax $ J.eitherDecodeStrict helloBody
+      pure CtrlSessKeys {hybridKey, idPubKey, sessPubKey = skey}
+    RCCtrlEncError {nonce, encMessage} -> do
+      message <- liftEitherWith (const RCEDecrypt) $ C.cbDecrypt sharedKey nonce encMessage
+      throwError $ RCECtrlError $ T.unpack $ safeDecodeUtf8 message
+
+-- * Multicast discovery
+
+announceRC :: TVar ChaChaDRG -> Int -> C.PrivateKeyEd25519 -> C.PublicKeyX25519 -> RCHostKeys -> RCInvitation -> ExceptT RCErrorType IO ()
+announceRC drg maxCount idPrivKey knownDhPub RCHostKeys {sessKeys, dhKeys} inv = withSender $ \sender -> do
+  replicateM_ maxCount $ do
+    logDebug "Announcing..."
+    nonce <- atomically $ C.pseudoRandomCbNonce drg
+    encInvitation <- liftEitherWith undefined $ C.cbEncrypt sharedKey nonce sigInvitation encInvitationSize
+    liftIO . UDP.send sender $ smpEncode RCEncInvitation {dhPubKey, nonce, encInvitation}
+    threadDelay 1000000
+  where
+    sigInvitation = strEncode $ signInvitation sPrivKey idPrivKey inv
+    (_sPub, sPrivKey) = sessKeys
+    sharedKey = C.dh' knownDhPub dhPrivKey
+    (dhPubKey, dhPrivKey) = dhKeys
+
+discoverRCCtrl :: TMVar Int -> NonEmpty RCCtrlPairing -> ExceptT RCErrorType IO (RCCtrlPairing, RCVerifiedInvitation)
+discoverRCCtrl subscribers pairings =
+  timeoutThrow RCENotDiscovered 30000000 $ withListener subscribers $ \listener ->
+    loop $ do
+      (source, bytes) <- recvAnnounce listener
+      encInvitation <- liftEitherWith (const RCEInvitation) $ smpDecode bytes
+      r@(_, RCVerifiedInvitation RCInvitation {host}) <- findRCCtrlPairing pairings encInvitation
+      case source of
+        SockAddrInet _ ha | THIPv4 (hostAddressToTuple ha) == host -> pure ()
+        _ -> throwError RCEInvitation
+      pure r
+  where
+    loop :: ExceptT RCErrorType IO a -> ExceptT RCErrorType IO a
+    loop action =
+      liftIO (runExceptT action) >>= \case
+        Left err -> logError (tshow err) >> loop action
+        Right res -> pure res
+
+findRCCtrlPairing :: NonEmpty RCCtrlPairing -> RCEncInvitation -> ExceptT RCErrorType IO (RCCtrlPairing, RCVerifiedInvitation)
+findRCCtrlPairing pairings RCEncInvitation {dhPubKey, nonce, encInvitation} = do
+  (pairing, signedInvStr) <- liftEither $ decrypt (L.toList pairings)
+  signedInv <- liftEitherWith RCESyntax $ strDecode signedInvStr
+  inv@(RCVerifiedInvitation RCInvitation {dh = invDh}) <- maybe (throwError RCEInvitation) pure $ verifySignedInvitation signedInv
+  unless (invDh == dhPubKey) $ throwError RCEInvitation
+  pure (pairing, inv)
+  where
+    decrypt :: [RCCtrlPairing] -> Either RCErrorType (RCCtrlPairing, ByteString)
+    decrypt [] = Left RCECtrlNotFound
+    decrypt (pairing@RCCtrlPairing {dhPrivKey, prevDhPrivKey} : rest) =
+      let r = decrypt_ dhPrivKey <|> (decrypt_ =<< prevDhPrivKey)
+       in maybe (decrypt rest) (Right . (pairing,)) r
+    decrypt_ :: C.PrivateKeyX25519 -> Maybe ByteString
+    decrypt_ dhPrivKey =
+      let key = C.dh' dhPubKey dhPrivKey
+       in eitherToMaybe $ C.cbDecrypt key nonce encInvitation
+
+-- * Controller handle operations
+
+-- application should call this function when TMVar resolves
+confirmCtrlSession :: RCCtrlClient -> Bool -> IO ()
+confirmCtrlSession RCCtrlClient {client_ = RCCClient_ {confirmSession}} res = do
+  atomically $ putTMVar confirmSession res
+  -- controler does takeTMVar, freeing the slot
+  -- TODO add timeout
+  atomically $ putTMVar confirmSession res -- wait for Ctrl to take the var
+
+cancelCtrlClient :: RCCtrlClient -> IO ()
+cancelCtrlClient RCCtrlClient {action, client_ = RCCClient_ {endSession}} = do
+  atomically $ putTMVar endSession ()
+  uninterruptibleCancel action
+
+-- * Session encryption
+
+rcEncryptBody :: TVar ChaChaDRG -> KEMHybridSecret -> LazyByteString -> ExceptT RCErrorType IO (C.CbNonce, LazyByteString)
+rcEncryptBody drg hybridKey s = do
+  nonce <- atomically $ C.pseudoRandomCbNonce drg
+  let len = LB.length s
+  ct <- liftEitherWith (const RCEEncrypt) $ LC.kcbEncryptTailTag hybridKey nonce s len (len + 8)
+  pure (nonce, ct)
+
+rcDecryptBody :: KEMHybridSecret -> C.CbNonce -> LazyByteString -> ExceptT RCErrorType IO LazyByteString
+rcDecryptBody hybridKey nonce ct = do
+  let len = LB.length ct - 16
+  when (len < 0) $ throwError RCEDecrypt
+  (ok, s) <- liftEitherWith (const RCEDecrypt) $ LC.kcbDecryptTailTag hybridKey nonce len ct
+  unless ok $ throwError RCEDecrypt
+  pure s
@@ -0,0 +1,150 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+-- XXX: remove non-discovery functions
+module Simplex.RemoteControl.Discovery where
+
+import Control.Logger.Simple
+import Control.Monad
+import Crypto.Random (getRandomBytes)
+import Data.ByteString (ByteString)
+import Data.Default (def)
+import Data.Maybe (listToMaybe, mapMaybe)
+import Data.String (IsString)
+import Network.Info (IPv4 (..), NetworkInterface (..), getNetworkInterfaces)
+import qualified Network.Socket as N
+import qualified Network.TLS as TLS
+import qualified Network.UDP as UDP
+import Simplex.Messaging.Encoding (Encoding (..))
+import Simplex.Messaging.Transport (supportedParameters)
+import qualified Simplex.Messaging.Transport as Transport
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServerSocket, startTCPServer)
+import Simplex.Messaging.Util (ifM, tshow)
+import Simplex.RemoteControl.Discovery.Multicast (setMembership)
+import Simplex.RemoteControl.Types
+import UnliftIO
+
+-- | mDNS multicast group
+pattern MULTICAST_ADDR_V4 :: (IsString a, Eq a) => a
+pattern MULTICAST_ADDR_V4 = "224.0.0.251"
+
+pattern ANY_ADDR_V4 :: (IsString a, Eq a) => a
+pattern ANY_ADDR_V4 = "0.0.0.0"
+
+pattern DISCOVERY_PORT :: (IsString a, Eq a) => a
+pattern DISCOVERY_PORT = "5227"
+
+getLocalAddress :: MonadIO m => m (Maybe TransportHost)
+getLocalAddress = listToMaybe . mapMaybe usable <$> liftIO getNetworkInterfaces
+  where
+    usable NetworkInterface {ipv4 = IPv4 ha} = case N.hostAddressToTuple ha of
+      (0, 0, 0, 0) -> Nothing -- "no" address
+      (255, 255, 255, 255) -> Nothing -- broadcast
+      (127, _, _, _) -> Nothing -- localhost
+      (169, 254, _, _) -> Nothing -- link-local
+      ok -> Just $ THIPv4 ok
+
+getLocalAddressMulticast :: MonadIO m => TMVar Int -> m (Maybe TransportHost)
+getLocalAddressMulticast subscribers = liftIO $ do
+  probe <- mkIpProbe
+  let bytes = smpEncode probe
+  withListener subscribers $ \receiver ->
+    withSender $ \sender -> do
+      UDP.send sender bytes
+      let expect = do
+            UDP.recvFrom receiver >>= \case
+              (p, _) | p /= bytes -> expect
+              (_, UDP.ClientSockAddr (N.SockAddrInet _port host) _cmsg) -> pure $ THIPv4 (N.hostAddressToTuple host)
+              (_, UDP.ClientSockAddr _badAddr _) -> error "receiving from IPv4 socket"
+      timeout 1000000 expect
+
+mkIpProbe :: MonadIO m => m IpProbe
+mkIpProbe = do
+  randomNonce <- liftIO $ getRandomBytes 32
+  pure IpProbe {versionRange = ipProbeVersionRange, randomNonce}
+
+-- | Send replay-proof announce datagrams
+-- runAnnouncer :: (C.PrivateKeyEd25519, Announce) -> IO ()
+-- runAnnouncer (announceKey, initialAnnounce) = withSender $ loop initialAnnounce
+--   where
+--     loop announce sock = do
+--       UDP.send sock $ smpEncode (signAnnounce announceKey announce)
+--       threadDelay 1000000
+--       loop announce {announceCounter = announceCounter announce + 1} sock
+
+-- XXX: move to RemoteControl.Client
+startTLSServer :: MonadUnliftIO m => TMVar (Maybe N.PortNumber) -> TLS.Credentials -> TLS.ServerHooks -> (Transport.TLS -> IO ()) -> m (Async ())
+startTLSServer startedOnPort credentials hooks server = async . liftIO $ do
+  started <- newEmptyTMVarIO
+  bracketOnError (startTCPServer started "0") (\_e -> setPort Nothing) $ \socket ->
+    ifM
+      (atomically $ readTMVar started)
+      (runServer started socket)
+      (setPort Nothing)
+  where
+    runServer started socket = do
+      port <- N.socketPort socket
+      logInfo $ "System-assigned port: " <> tshow port
+      setPort $ Just port
+      runTransportServerSocket started (pure socket) "RCP TLS" serverParams defaultTransportServerConfig server
+    setPort = void . atomically . tryPutTMVar startedOnPort
+    serverParams =
+      def
+        { TLS.serverWantClientCert = True,
+          TLS.serverShared = def {TLS.sharedCredentials = credentials},
+          TLS.serverHooks = hooks,
+          TLS.serverSupported = supportedParameters
+        }
+
+withSender :: MonadUnliftIO m => (UDP.UDPSocket -> m a) -> m a
+withSender = bracket (liftIO $ UDP.clientSocket MULTICAST_ADDR_V4 DISCOVERY_PORT False) (liftIO . UDP.close)
+
+withListener :: MonadUnliftIO m => TMVar Int -> (UDP.ListenSocket -> m a) -> m a
+withListener subscribers = bracket (openListener subscribers) (closeListener subscribers)
+
+openListener :: MonadIO m => TMVar Int -> m UDP.ListenSocket
+openListener subscribers = liftIO $ do
+  sock <- UDP.serverSocket (MULTICAST_ADDR_V4, read DISCOVERY_PORT)
+  logDebug $ "Discovery listener socket: " <> tshow sock
+  let raw = UDP.listenSocket sock
+  -- N.setSocketOption raw N.Broadcast 1
+  joinMulticast subscribers raw (listenerHostAddr4 sock)
+  pure sock
+
+closeListener :: MonadIO m => TMVar Int -> UDP.ListenSocket -> m ()
+closeListener subscribers sock =
+  liftIO $
+    partMulticast subscribers (UDP.listenSocket sock) (listenerHostAddr4 sock) `finally` UDP.stop sock
+
+joinMulticast :: TMVar Int -> N.Socket -> N.HostAddress -> IO ()
+joinMulticast subscribers sock group = do
+  now <- atomically $ takeTMVar subscribers
+  when (now == 0) $ do
+    setMembership sock group True >>= \case
+      Left e -> atomically (putTMVar subscribers now) >> logError ("setMembership failed " <> tshow e)
+      Right () -> atomically $ putTMVar subscribers (now + 1)
+
+partMulticast :: TMVar Int -> N.Socket -> N.HostAddress -> IO ()
+partMulticast subscribers sock group = do
+  now <- atomically $ takeTMVar subscribers
+  when (now == 1) $
+    setMembership sock group False >>= \case
+      Left e -> atomically (putTMVar subscribers now) >> logError ("setMembership failed " <> tshow e)
+      Right () -> atomically $ putTMVar subscribers (now - 1)
+
+listenerHostAddr4 :: UDP.ListenSocket -> N.HostAddress
+listenerHostAddr4 sock = case UDP.mySockAddr sock of
+  N.SockAddrInet _port host -> host
+  _ -> error "MULTICAST_ADDR_V4 is V4"
+
+recvAnnounce :: MonadIO m => UDP.ListenSocket -> m (N.SockAddr, ByteString)
+recvAnnounce sock = liftIO $ do
+  (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
+  pure (source, invite)
@@ -0,0 +1,48 @@
+module Simplex.RemoteControl.Discovery.Multicast
+  ( setMembership
+  ) where
+
+import Foreign (Ptr, allocaBytes, castPtr, pokeByteOff)
+import Foreign.C.Types (CInt (..))
+import Network.Socket
+
+#include <HsNet.h>
+
+{- | Toggle multicast group membership.
+
+NB: Group membership is per-host, not per-process. A socket is only used to access system interface for groups.
+-}
+setMembership :: Socket -> HostAddress -> Bool -> IO (Either CInt ())
+setMembership sock group membership = allocaBytes #{size struct ip_mreq} $ \mReqPtr -> do
+  #{poke struct ip_mreq, imr_multiaddr} mReqPtr group
+  #{poke struct ip_mreq, imr_interface} mReqPtr (0 :: HostAddress) -- attempt to contact the group on ANY interface
+  withFdSocket sock $ \fd -> do
+    rc <- c_setsockopt fd c_IPPROTO_IP flag (castPtr mReqPtr) (#{size struct ip_mreq})
+    if rc == 0
+      then pure $ Right ()
+      else pure $ Left rc
+  where
+    flag = if membership then c_IP_ADD_MEMBERSHIP else c_IP_DROP_MEMBERSHIP
+
+#ifdef mingw32_HOST_OS
+
+foreign import stdcall unsafe "setsockopt"
+    c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt
+
+c_IP_ADD_MEMBERSHIP, c_IP_DROP_MEMBERSHIP :: CInt
+c_IP_ADD_MEMBERSHIP  = 12
+c_IP_DROP_MEMBERSHIP = 13
+
+#else
+
+foreign import ccall unsafe "setsockopt"
+    c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt
+
+c_IP_ADD_MEMBERSHIP, c_IP_DROP_MEMBERSHIP :: CInt
+c_IP_ADD_MEMBERSHIP  = #const IP_ADD_MEMBERSHIP
+c_IP_DROP_MEMBERSHIP = #const IP_DROP_MEMBERSHIP
+
+#endif
+
+c_IPPROTO_IP :: CInt
+c_IPPROTO_IP = #const IPPROTO_IP
@@ -0,0 +1,169 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.RemoteControl.Invitation
+  ( RCInvitation (..)
+  , signInvitation
+  , RCSignedInvitation (..)
+  , verifySignedInvitation
+  , RCVerifiedInvitation (..)
+  , RCEncInvitation (..)
+  ) where
+
+import qualified Data.Aeson as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as LB
+import Data.Time.Clock.System (SystemTime)
+import Data.Word (Word16)
+import Network.HTTP.Types (parseSimpleQuery)
+import Network.HTTP.Types.URI (SimpleQuery, renderSimpleQuery, urlDecode)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Transport.Client (TransportHost)
+import Simplex.Messaging.Version (VersionRange)
+
+data RCInvitation = RCInvitation
+  { -- | CA TLS certificate fingerprint of the controller.
+    --
+    -- This is part of long term identity of the controller established during the first session, and repeated in the subsequent session announcements.
+    ca :: C.KeyHash,
+    host :: TransportHost,
+    port :: Word16,
+    -- | Supported version range for remote control protocol
+    v :: VersionRange,
+    -- | Application information
+    app :: J.Value,
+    -- | Session start time in seconds since epoch
+    ts :: SystemTime,
+    -- | Session Ed25519 public key used to verify the announcement and commands
+    --
+    -- This mitigates the compromise of the long term signature key, as the controller will have to sign each command with this key first.
+    skey :: C.PublicKeyEd25519,
+    -- | Long-term Ed25519 public key used to verify the announcement and commands.
+    --
+    -- Is apart of the long term controller identity.
+    idkey :: C.PublicKeyEd25519,
+    -- | Session X25519 DH key
+    dh :: C.PublicKeyX25519
+  }
+  deriving (Show)
+
+instance StrEncoding RCInvitation where
+  strEncode RCInvitation {ca, host, port, v, app, ts, skey, idkey, dh} =
+    mconcat
+      [ "xrcp:/",
+        strEncode ca,
+        "@",
+        strEncode host,
+        ":",
+        strEncode port,
+        "#/?",
+        renderSimpleQuery False query
+      ]
+    where
+      query =
+        [ ("v", strEncode v),
+          ("app", LB.toStrict $ J.encode app),
+          ("ts", strEncode ts),
+          ("skey", strEncode skey),
+          ("idkey", strEncode idkey),
+          ("dh", strEncode dh)
+        ]
+
+  strP = do
+    _ <- A.string "xrcp:/"
+    ca <- strP
+    _ <- A.char '@'
+    host <- A.takeWhile (/= ':') >>= either fail pure . strDecode . urlDecode True
+    _ <- A.char ':'
+    port <- strP
+    _ <- A.string "#/?"
+
+    q <- parseSimpleQuery <$> A.takeWhile (/= ' ')
+    v <- requiredP q "v" strDecode
+    app <- requiredP q "app" $ J.eitherDecodeStrict . urlDecode True
+    ts <- requiredP q "ts" $ strDecode . urlDecode True
+    skey <- requiredP q "skey" $ parseAll strP
+    idkey <- requiredP q "idkey" $ parseAll strP
+    dh <- requiredP q "dh" $ parseAll strP
+    pure RCInvitation {ca, host, port, v, app, ts, skey, idkey, dh}
+
+data RCSignedInvitation = RCSignedInvitation
+  { invitation :: RCInvitation,
+    ssig :: C.Signature 'C.Ed25519,
+    idsig :: C.Signature 'C.Ed25519
+  }
+  deriving (Show)
+
+-- | URL-encoded and signed for showing in QR code
+instance StrEncoding RCSignedInvitation where
+  strEncode RCSignedInvitation {invitation, ssig, idsig} =
+    mconcat
+      [ strEncode invitation,
+        "&ssig=",
+        strEncode $ C.signatureBytes ssig,
+        "&idsig=",
+        strEncode $ C.signatureBytes idsig
+      ]
+
+  strP = do
+    -- TODO this assumes some order or parameters, can be made independent
+    (url, invitation) <- A.match strP
+    sigs <- case B.breakSubstring "&ssig=" url of
+      (_, sigs) | B.null sigs -> fail "missing signatures"
+      (_, sigs) -> pure $ parseSimpleQuery $ B.drop 1 sigs
+    ssig <- requiredP sigs "ssig" $ parseAll strP
+    idsig <- requiredP sigs "idsig" $ parseAll strP
+    pure RCSignedInvitation {invitation, ssig, idsig}
+
+signInvitation :: C.PrivateKey C.Ed25519 -> C.PrivateKey C.Ed25519 -> RCInvitation -> RCSignedInvitation
+signInvitation sKey idKey invitation = RCSignedInvitation {invitation, ssig, idsig}
+  where
+    uri = strEncode invitation
+    ssig =
+      case C.sign (C.APrivateSignKey C.SEd25519 sKey) uri of
+        C.ASignature C.SEd25519 s -> s
+        _ -> error "signing with ed25519"
+    inviteUrlSigned = mconcat [uri, "&ssig=", strEncode ssig]
+    idsig =
+      case C.sign (C.APrivateSignKey C.SEd25519 idKey) inviteUrlSigned of
+        C.ASignature C.SEd25519 s -> s
+        _ -> error "signing with ed25519"
+
+newtype RCVerifiedInvitation = RCVerifiedInvitation RCInvitation
+  deriving (Show)
+
+verifySignedInvitation :: RCSignedInvitation -> Maybe RCVerifiedInvitation
+verifySignedInvitation RCSignedInvitation {invitation, ssig, idsig} =
+  if C.verify' skey ssig inviteURL && C.verify' idkey idsig inviteURLS
+    then Just $ RCVerifiedInvitation invitation
+    else Nothing
+  where
+    RCInvitation {skey, idkey} = invitation
+    inviteURL = strEncode invitation
+    inviteURLS = mconcat [inviteURL, "&ssig=", strEncode ssig]
+
+data RCEncInvitation = RCEncInvitation
+  { dhPubKey :: C.PublicKeyX25519,
+    nonce :: C.CbNonce,
+    encInvitation :: ByteString
+  }
+
+instance Encoding RCEncInvitation where
+  smpEncode RCEncInvitation {dhPubKey, nonce, encInvitation} =
+    smpEncode (dhPubKey, nonce, Tail encInvitation)
+  smpP = do
+    (dhPubKey, nonce, Tail encInvitation) <- smpP
+    pure RCEncInvitation {dhPubKey, nonce, encInvitation}
+
+-- * Utils
+
+requiredP :: MonadFail m => SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
+requiredP q k f = maybe (fail $ "missing " <> show k) (either fail pure . f) $ lookup k q
@@ -0,0 +1,228 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.RemoteControl.Types where
+
+import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString (ByteString)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.SNTRUP761
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
+import Simplex.Messaging.Transport (TLS)
+import Simplex.Messaging.Util (safeDecodeUtf8)
+import Simplex.Messaging.Version (Version, VersionRange, mkVersionRange)
+import UnliftIO
+
+data RCErrorType
+  = RCEInternal {internalErr :: String}
+  | RCEIdentity
+  | RCENoLocalAddress
+  | RCENewController
+  | RCENotDiscovered
+  | RCETLSStartFailed
+  | RCEException {exception :: String}
+  | RCECtrlAuth
+  | RCECtrlNotFound
+  | RCECtrlError {ctrlErr :: String}
+  | RCEInvitation
+  | RCEVersion
+  | RCEEncrypt
+  | RCEDecrypt
+  | RCEBlockSize
+  | RCESyntax {syntaxErr :: String}
+  deriving (Eq, Show, Exception)
+
+instance StrEncoding RCErrorType where
+  strEncode = \case
+    RCEInternal err -> "INTERNAL" <> text err
+    RCEIdentity -> "IDENTITY"
+    RCENoLocalAddress -> "NO_LOCAL_ADDR"
+    RCENewController -> "NEW_CONTROLLER"
+    RCENotDiscovered -> "NOT_DISCOVERED"
+    RCETLSStartFailed -> "CTRL_TLS_START"
+    RCEException err -> "EXCEPTION" <> text err
+    RCECtrlAuth -> "CTRL_AUTH"
+    RCECtrlNotFound -> "CTRL_NOT_FOUND"
+    RCECtrlError err -> "CTRL_ERROR" <> text err
+    RCEInvitation -> "INVITATION"
+    RCEVersion -> "VERSION"
+    RCEEncrypt -> "ENCRYPT"
+    RCEDecrypt -> "DECRYPT"
+    RCEBlockSize -> "BLOCK_SIZE"
+    RCESyntax err -> "SYNTAX" <> text err
+    where
+      text = (" " <>) . encodeUtf8 . T.pack
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "INTERNAL" -> RCEInternal <$> textP
+      "IDENTITY" -> pure RCEIdentity
+      "NO_LOCAL_ADDR" -> pure RCENoLocalAddress
+      "NEW_CONTROLLER" -> pure RCENewController
+      "NOT_DISCOVERED" -> pure RCENotDiscovered
+      "CTRL_TLS_START" -> pure RCETLSStartFailed
+      "EXCEPTION" -> RCEException <$> textP
+      "CTRL_AUTH" -> pure RCECtrlAuth
+      "CTRL_NOT_FOUND" -> pure RCECtrlNotFound
+      "CTRL_ERROR" -> RCECtrlError <$> textP
+      "INVITATION" -> pure RCEInvitation
+      "VERSION" -> pure RCEVersion
+      "ENCRYPT" -> pure RCEEncrypt
+      "DECRYPT" -> pure RCEDecrypt
+      "BLOCK_SIZE" -> pure RCEBlockSize
+      "SYNTAX" -> RCESyntax <$> textP
+      _ -> fail "bad RCErrorType"
+    where
+      textP = T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString)
+
+-- * Discovery
+
+ipProbeVersionRange :: VersionRange
+ipProbeVersionRange = mkVersionRange 1 1
+
+data IpProbe = IpProbe
+  { versionRange :: VersionRange,
+    randomNonce :: ByteString
+  }
+  deriving (Show)
+
+instance Encoding IpProbe where
+  smpEncode IpProbe {versionRange, randomNonce} = smpEncode (versionRange, 'I', randomNonce)
+
+  smpP = IpProbe <$> (smpP <* "I") *> smpP
+
+-- * Session
+
+data RCHostHello = RCHostHello
+  { v :: Version,
+    ca :: C.KeyHash,
+    app :: J.Value,
+    kem :: KEMPublicKey
+  }
+  deriving (Show)
+
+$(JQ.deriveJSON defaultJSON ''RCHostHello)
+
+data RCCtrlHello = RCCtrlHello {}
+  deriving (Show)
+
+$(JQ.deriveJSON defaultJSON {J.nullaryToObject = True} ''RCCtrlHello)
+
+-- | Long-term part of controller (desktop) connection to host (mobile)
+data RCHostPairing = RCHostPairing
+  { caKey :: C.APrivateSignKey,
+    caCert :: C.SignedCertificate,
+    idPrivKey :: C.PrivateKeyEd25519,
+    knownHost :: Maybe KnownHostPairing
+  }
+
+data KnownHostPairing = KnownHostPairing
+  { hostFingerprint :: C.KeyHash, -- this is only changed in the first session, long-term identity of connected remote host
+    hostDhPubKey :: C.PublicKeyX25519
+  }
+
+-- | Long-term part of host (mobile) connection to controller (desktop)
+data RCCtrlPairing = RCCtrlPairing
+  { caKey :: C.APrivateSignKey,
+    caCert :: C.SignedCertificate,
+    ctrlFingerprint :: C.KeyHash, -- long-term identity of connected remote controller
+    idPubKey :: C.PublicKeyEd25519,
+    dhPrivKey :: C.PrivateKeyX25519,
+    prevDhPrivKey :: Maybe C.PrivateKeyX25519
+  }
+
+data RCHostKeys = RCHostKeys
+  { sessKeys :: C.KeyPair 'C.Ed25519,
+    dhKeys :: C.KeyPair 'C.X25519
+  }
+
+-- Connected session with Host
+data RCHostSession = RCHostSession
+  { tls :: TLS,
+    sessionKeys :: HostSessKeys
+  }
+
+data HostSessKeys = HostSessKeys
+  { hybridKey :: KEMHybridSecret,
+    idPrivKey :: C.PrivateKeyEd25519,
+    sessPrivKey :: C.PrivateKeyEd25519
+  }
+
+-- Host: RCCtrlPairing + RCInvitation => (RCCtrlSession, RCCtrlPairing)
+
+data RCCtrlSession = RCCtrlSession
+  { tls :: TLS,
+    sessionKeys :: CtrlSessKeys
+  }
+
+data CtrlSessKeys = CtrlSessKeys
+  { hybridKey :: KEMHybridSecret,
+    idPubKey :: C.PublicKeyEd25519,
+    sessPubKey :: C.PublicKeyEd25519
+  }
+
+data RCHostEncHello = RCHostEncHello
+  { dhPubKey :: C.PublicKeyX25519,
+    nonce :: C.CbNonce,
+    encBody :: ByteString
+  }
+  deriving (Show)
+
+instance Encoding RCHostEncHello where
+  smpEncode RCHostEncHello {dhPubKey, nonce, encBody} =
+    "HELLO " <> smpEncode (dhPubKey, nonce, Tail encBody)
+  smpP = do
+    (dhPubKey, nonce, Tail encBody) <- "HELLO " *> smpP
+    pure RCHostEncHello {dhPubKey, nonce, encBody}
+
+data RCCtrlEncHello
+  = RCCtrlEncHello {kem :: KEMCiphertext, nonce :: C.CbNonce, encBody :: ByteString}
+  | RCCtrlEncError {nonce :: C.CbNonce, encMessage :: ByteString}
+  deriving (Show)
+
+instance Encoding RCCtrlEncHello where
+  smpEncode = \case
+    RCCtrlEncHello {kem, nonce, encBody} -> "HELLO " <> smpEncode (kem, nonce, Tail encBody)
+    RCCtrlEncError {nonce, encMessage} -> "ERROR " <> smpEncode (nonce, Tail encMessage)
+  smpP =
+    A.takeTill (== ' ') >>= \case
+      "HELLO" -> do
+        (kem, nonce, Tail encBody) <- _smpP
+        pure RCCtrlEncHello {kem, nonce, encBody}
+      "ERROR" -> do
+        (nonce, Tail encMessage) <- _smpP
+        pure RCCtrlEncError {nonce, encMessage}
+      _ -> fail "bad RCCtrlEncHello"
+
+-- * Utils
+
+-- | tlsunique channel binding
+type SessionCode = ByteString
+
+type RCStepTMVar a = TMVar (Either RCErrorType a)
+
+type Tasks = TVar [Async ()]
+
+asyncRegistered :: MonadUnliftIO m => Tasks -> m () -> m ()
+asyncRegistered tasks action = async action >>= registerAsync tasks
+
+registerAsync :: MonadIO m => Tasks -> Async () -> m ()
+registerAsync tasks = atomically . modifyTVar tasks . (:)
+
+cancelTasks :: MonadIO m => Tasks -> m ()
+cancelTasks tasks = readTVarIO tasks >>= mapM_ cancel
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCE") ''RCErrorType)
@@ -143,7 +143,7 @@ prevRange vr = vr {maxVersion = maxVersion vr - 1}
 runRight_ :: (Eq e, Show e, HasCallStack) => ExceptT e IO () -> Expectation
 runRight_ action = runExceptT action `shouldReturn` Right ()

-runRight :: HasCallStack => ExceptT AgentErrorType IO a -> IO a
+runRight :: (Show e, HasCallStack) => ExceptT e IO a -> IO a
 runRight action =
  runExceptT action >>= \case
    Right x -> pure x
@@ -3,8 +3,9 @@

 module CoreTests.CryptoTests (cryptoTests) where

+import Control.Concurrent.STM
 import Control.Monad.Except
-import Crypto.Random (getRandomBytes)
+import Crypto.Random (drgNew, getRandomBytes)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Either (isRight)
@@ -15,6 +16,7 @@ import qualified Data.Text.Lazy as LT
 import qualified Data.Text.Lazy.Encoding as LE
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Test.Hspec
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
 import Test.QuickCheck
@@ -87,6 +89,8 @@ cryptoTests = do
    describe "Ed448" $ testEncoding C.SEd448
    describe "X25519" $ testEncoding C.SX25519
    describe "X448" $ testEncoding C.SX448
+  describe "sntrup761" $
+    it "should enc/dec key" testSNTRUP761

 testPadUnpadFile :: IO ()
 testPadUnpadFile = do
@@ -197,3 +201,11 @@ testEncoding alg = it "should encode / decode key" . ioProperty $ do
  pure $ \(_ :: Int) ->
    C.decodePubKey (C.encodePubKey k) == Right k
      && C.decodePrivKey (C.encodePrivKey pk) == Right pk
+
+testSNTRUP761 :: IO ()
+testSNTRUP761 = do
+  drg <- newTVarIO =<< drgNew
+  (pk, sk) <- sntrup761Keypair drg
+  (c, KEMSharedKey k) <- sntrup761Enc drg pk
+  KEMSharedKey k' <- sntrup761Dec c sk
+  k' `shouldBe` k
@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-orphans #-}

 module CoreTests.ProtocolErrorTests where
@@ -17,6 +18,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (CommandError (..), ErrorType (..))
 import Simplex.Messaging.Transport (HandshakeError (..), TransportError (..))
+import Simplex.RemoteControl.Types (RCErrorType (..))
 import Test.Hspec
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
 import Test.QuickCheck
@@ -58,6 +60,8 @@ deriving instance Generic HandshakeError

 deriving instance Generic XFTPErrorType

+deriving instance Generic RCErrorType
+
 instance Arbitrary AgentErrorType where arbitrary = genericArbitraryU

 instance Arbitrary CommandErrorType where arbitrary = genericArbitraryU
@@ -79,3 +83,5 @@ instance Arbitrary TransportError where arbitrary = genericArbitraryU
 instance Arbitrary HandshakeError where arbitrary = genericArbitraryU

 instance Arbitrary XFTPErrorType where arbitrary = genericArbitraryU
+
+instance Arbitrary RCErrorType where arbitrary = genericArbitraryU
@@ -0,0 +1,152 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module RemoteControl where
+
+import AgentTests.FunctionalAPITests (runRight)
+import Control.Logger.Simple
+import Crypto.Random (ChaChaDRG, drgNew)
+import qualified Data.Aeson as J
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Simplex.RemoteControl.Client as RC
+import Simplex.RemoteControl.Invitation (RCSignedInvitation, verifySignedInvitation)
+import Simplex.RemoteControl.Types
+import Test.Hspec
+import UnliftIO
+import UnliftIO.Concurrent
+
+remoteControlTests :: Spec
+remoteControlTests = do
+  describe "New controller/host pairing" $ do
+    it "should connect to new pairing" testNewPairing
+    it "should connect to existing pairing" testExistingPairing
+  describe "Multicast discovery" $ do
+    it "should find paired host and connect" testMulticast
+
+testNewPairing :: IO ()
+testNewPairing = do
+  drg <- drgNew >>= newTVarIO
+  hp <- RC.newRCHostPairing
+  invVar <- newEmptyMVar
+  ctrlSessId <- async . runRight $ do
+    logNote "c 1"
+    (inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") False
+    logNote "c 2"
+    putMVar invVar (inv, hc)
+    logNote "c 3"
+    Right (sessId, _tls, r') <- atomically $ takeTMVar r
+    logNote "c 4"
+    Right (_rcHostSession, _rcHelloBody, _hp') <- atomically $ takeTMVar r'
+    logNote "c 5"
+    threadDelay 250000
+    logNote "ctrl: ciao"
+    liftIO $ RC.cancelHostClient hc
+    pure sessId
+
+  (signedInv, hc) <- takeMVar invVar
+  -- logNote $ decodeUtf8 $ strEncode inv
+  inv <- maybe (fail "bad invite") pure $ verifySignedInvitation signedInv
+
+  hostSessId <- async . runRight $ do
+    logNote "h 1"
+    (rcCtrlClient, r) <- RC.connectRCCtrl drg inv Nothing (J.String "app")
+    logNote "h 2"
+    Right (sessId', _tls, r') <- atomically $ takeTMVar r
+    logNote "h 3"
+    liftIO $ RC.confirmCtrlSession rcCtrlClient True
+    logNote "h 4"
+    Right (_rcCtrlSession, _rcCtrlPairing) <- atomically $ takeTMVar r'
+    logNote "h 5"
+    threadDelay 250000
+    logNote "ctrl: adios"
+    pure sessId'
+
+  waitCatch hc.action >>= \case
+    Left err -> fromException err `shouldBe` Just AsyncCancelled
+    Right () -> fail "Unexpected controller finish"
+
+  timeout 5000000 (waitBoth ctrlSessId hostSessId) >>= \case
+    Just (sessId, sessId') -> sessId `shouldBe` sessId'
+    _ -> fail "timeout"
+
+testExistingPairing :: IO ()
+testExistingPairing = do
+  drg <- drgNew >>= newTVarIO
+  invVar <- newEmptyMVar
+  hp <- liftIO $ RC.newRCHostPairing
+  ctrl <- runCtrl drg False hp invVar
+  inv <- takeMVar invVar
+  let cp_ = Nothing
+  host <- runHostURI drg cp_ inv
+  timeout 5000000 (waitBoth ctrl host) >>= \case
+    Nothing -> fail "timeout"
+    Just (hp', cp') -> do
+      ctrl' <- runCtrl drg False hp' invVar
+      inv' <- takeMVar invVar
+      host' <- runHostURI drg (Just cp') inv'
+      timeout 5000000 (waitBoth ctrl' host') >>= \case
+        Nothing -> fail "timeout"
+        Just (_hp2, cp2) -> do
+          ctrl2 <- runCtrl drg False hp' invVar -- old host pairing used to test controller not updating state
+          inv2 <- takeMVar invVar
+          host2 <- runHostURI drg (Just cp2) inv2
+          timeout 5000000 (waitBoth ctrl2 host2) >>= \case
+            Nothing -> fail "timeout"
+            Just (hp3, cp3) -> do
+              ctrl3 <- runCtrl drg False hp3 invVar
+              inv3 <- takeMVar invVar
+              host3 <- runHostURI drg (Just cp3) inv3
+              timeout 5000000 (waitBoth ctrl3 host3) >>= \case
+                Nothing -> fail "timeout"
+                Just _ -> pure ()
+
+testMulticast :: IO ()
+testMulticast = do
+  drg <- drgNew >>= newTVarIO
+  subscribers <- newTMVarIO 0
+  invVar <- newEmptyMVar
+  hp <- liftIO RC.newRCHostPairing
+  ctrl <- runCtrl drg False hp invVar
+  inv <- takeMVar invVar
+  let cp_ = Nothing
+  host <- runHostURI drg cp_ inv
+  timeout 5000000 (waitBoth ctrl host) >>= \case
+    Nothing -> fail "timeout"
+    Just (hp', cp') -> do
+      ctrl' <- runCtrl drg True hp' invVar
+      _inv <- takeMVar invVar
+      host' <- runHostMulticast drg subscribers cp'
+      timeout 5000000 (waitBoth ctrl' host') >>= \case
+        Nothing -> fail "timeout"
+        Just _ -> pure ()
+
+runCtrl :: TVar ChaChaDRG -> Bool -> RCHostPairing -> MVar RCSignedInvitation -> IO (Async RCHostPairing)
+runCtrl drg multicast hp invVar = async . runRight $ do
+  (inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") multicast
+  putMVar invVar inv
+  Right (_sessId, _tls, r') <- atomically $ takeTMVar r
+  Right (_rcHostSession, _rcHelloBody, hp') <- atomically $ takeTMVar r'
+  threadDelay 250000
+  liftIO $ RC.cancelHostClient hc
+  pure hp'
+
+runHostURI :: TVar ChaChaDRG -> Maybe RCCtrlPairing -> RCSignedInvitation -> IO (Async RCCtrlPairing)
+runHostURI drg cp_ signedInv = async . runRight $ do
+  inv <- maybe (fail "bad invite") pure $ verifySignedInvitation signedInv
+  (rcCtrlClient, r) <- RC.connectRCCtrl drg inv cp_ (J.String "app")
+  Right (_sessId', _tls, r') <- atomically $ takeTMVar r
+  liftIO $ RC.confirmCtrlSession rcCtrlClient True
+  Right (_rcCtrlSession, cp') <- atomically $ takeTMVar r'
+  threadDelay 250000
+  pure cp'
+
+runHostMulticast :: TVar ChaChaDRG -> TMVar Int -> RCCtrlPairing -> IO (Async RCCtrlPairing)
+runHostMulticast drg subscribers cp = async . runRight $ do
+  (pairing, inv) <- RC.discoverRCCtrl subscribers (cp :| [])
+  (rcCtrlClient, r) <- RC.connectRCCtrl drg inv (Just pairing) (J.String "app")
+  Right (_sessId', _tls, r') <- atomically $ takeTMVar r
+  liftIO $ RC.confirmCtrlSession rcCtrlClient True
+  Right (_rcCtrlSession, cp') <- atomically $ takeTMVar r'
+  threadDelay 250000
+  pure cp'
@@ -14,6 +14,7 @@ import CoreTests.UtilTests
 import CoreTests.VersionRangeTests
 import FileDescriptionTests (fileDescriptionTests)
 import NtfServerTests (ntfServerTests)
+import RemoteControl (remoteControlTests)
 import ServerTests
 import Simplex.Messaging.Transport (TLS, Transport (..))
 import Simplex.Messaging.Transport.WebSockets (WS)
@@ -56,4 +57,5 @@ main = do
          describe "XFTP file description" fileDescriptionTests
          describe "XFTP CLI" xftpCLITests
          describe "XFTP agent" xftpAgentTests
+        describe "XRCP" remoteControlTests
        describe "Server CLIs" cliTests