0.4.1

* include migrations in the package, update versions

* update DigitalOcean version

.github/FUNDING.yml

@@ -0,0 +1 @@
+open_collective: simplex-chat

.github/workflows/build.yml

@@ -70,7 +70,7 @@ jobs:
       - name: Build & test
         id: build_test
         run: |
-          stack build --test
+          stack build --test --force-dirty
           echo "::set-output name=LOCAL_INSTALL_ROOT::$(stack path --local-install-root)"
 
       - name: Upload binaries to release

.gitignore

@@ -1,4 +1,4 @@
 *.lock
-*.cabal
 *.db
+*.db.bak
 *.session.sql

CHANGELOG.md

@@ -1,3 +1,31 @@
+# 0.4.1
+
+- Include migrations in the package
+
+# 0.4.0
+
+- SMP server implementation and [SMP protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md) changes:
+  - support 3072 bit RSA key size
+  - add SMP queue quotas
+  - set default transport block size to 4096 bits
+  - allow SMP client to change transport block size during transport connection handshake
+- SMP agent implementation and protocol changes:
+  - additional connection confirmation step for initiating party
+  - automatically resume subscribed duplex connections once transport connection is resumed
+  - passing an arbitrary binary information between parties during the duplex connection handshake - can be used to identify parties
+  - asynchronous duplex connection handshake - the parties do not have to be online at the same time
+  - asynchronous message delivery - the agent does not need transport connection to accept client messages for delivery
+  - additional confirmation of message reception from the client to prevent message loss in case of process termination
+  - set transport block size to 8192 bits (in the future the agent protocol can allow to have different block sizes for different duplex connections)
+  - added client commands and notifications (see [agent protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md)):
+    - `REQ` - the notification about joining party establishing connection
+    - `ACPT` - the command to accept connection with the joining party
+    - `INFO` - the notification with the information from the initiating party
+    - `DOWN`/`UP` - the notifications about losing/resuming the connection
+    - `ACK` - the command to confirm that the message reception/processing is complete
+    - `MID` - the response to `SEND` confirming that the message is accepted by the agent
+    - `MERR` - the notification about permanent message delivery error (e.g., `ERR AUTH` indicating that the queue was removed)
+
 # 0.3.2
 
 - Support websockets

README.md

@@ -13,11 +13,9 @@ SimpleXMQ is implemented in Haskell - it benefits from robust software transacti
 
 ## SimpleXMQ roadmap
 
-- Streams - high performance message queues. See [Streams RFC](https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-02-28-streams.md) for details.
-- "Small" connection groups, when each message will be sent by the SMP agent to multiple connections with a single client command. See [Groups RFC](https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-03-18-groups.md) for details.
-- SMP agents cluster to share connections and message management by multiple agents (for example, it would enable multi-device use for [simplex-chat](https://github.com/simplex-chat/simplex-chat)).
 - SMP queue redundancy and rotation in SMP agent duplex connections.
-- "Large" groups design and implementation. 
+- SMP agents synchronization to share connections and messages between multiple agents (it would allow using multiple devices for [simplex-chat](https://github.com/simplex-chat/simplex-chat)).
+- Streams - high performance message queues. See [Streams RFC](https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-02-28-streams.md) for details.
 
 ## Components
 
@@ -50,12 +48,50 @@ See [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI for
 
 ## Using SMP server and SMP agent
 
-You can either run SMP server locally or try local SMP agent with the deployed demo server:
+You can either run your own SMP server locally or deploy using [Linode StackScript](#deploy-smp-server-on-linode), or try local SMP agent with the deployed servers:
 
-`smp1.simplex.im:5223#pLdiGvm0jD1CMblnov6Edd/391OrYsShw+RgdfR0ChA=`
+`smp2.simplex.im#z5W2QLQ1Br3Yd6CoWg7bIq1bHdwK7Y8bEiEXBs/WfAg=` (London, UK)
+`smp3.simplex.im#nxc7HnrnM8dOKgkMp008ub/9o9LXJlxlMrMpR+mfMQw=` (Fremont, CA)
 
 It's the easiest to try SMP agent via a prototype [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI.
 
+[<img alt="Linode" src="https://raw.githubusercontent.com/simplex-chat/simplexmq/master/img/linode.svg" align="right" width="200">](https://cloud.linode.com/stackscripts/748014)
+
+## Deploy SMP server on Linode
+
+You can get Linode [free credits](https://www.linode.com/lp/affiliate-referral/?irclickid=02-QkdTEpxyLW0W0EOSREQreUkB2DtzGE2lGTE0&irgwc=1&utm_source=impact) to deploy SMP server.
+
+Deployment on [Linode](https://www.linode.com/) is performed via StackScripts, which serve as recipes for Linode instances, also called Linodes. To deploy SMP server on Linode:
+
+- Create a Linode account or login with an already existing one.
+- Open [SMP server StackScript](https://cloud.linode.com/stackscripts/748014) and click "Deploy New Linode".
+- You can optionally configure the following parameters:
+    - [SMP Server store log](#SMP-server) flag for queue persistence on server restart (recommended).
+    - [Linode API token](https://www.linode.com/docs/guides/getting-started-with-the-linode-api#get-an-access-token) for attaching server info as tags to Linode (server address, public key hash, version) and adding A record to your 2nd level domain (Note: 2nd level e.g. `example.com` domain should be [created](https://cloud.linode.com/domains/create) in your account prior to deployment). The API token access scope should be read/write access to "linodes" (to update linode tags - you need them), and "domains" (to add A record for the 3rd level domain, e.g. `smp`).
+    - Domain name to use instead of Linode ip address, e.g. `smp.example.com`.
+- Choose the region and plan according to your requirements (for regular use Shared CPU Nanode should be sufficient).
+- Provide ssh key to be able to connect to your Linode via ssh. This step is required if you haven't provided a Linode API token, because you will need to login to your Linode and get a public key hash either from the welcome message or from the file `/etc/opt/simplex/pub_key_hash` on your Linode after SMP server starts.
+- Deploy your Linode. After it starts wait for SMP server to start and for tags to appear (if a Linode API token was provided). It may take up to 5 minutes depending on the connection speed on the Linode. Connecting Linode IP address to provided domain name may take some additional time.
+- Get `hostname` and `hash` either from Linode tags (click on a tag and copy it's value from the browser search panel) or via ssh. Linode has a good [guide](https://www.linode.com/docs/guides/use-public-key-authentication-with-ssh/) about ssh.
+- Great, your own SMP server is ready! Use `address#hash` as SMP server address in the client.
+
+Please submit an [issue](https://github.com/simplex-chat/simplexmq/issues) if any problems occur.
+
+[<img alt="DigitalOcean" src="https://raw.githubusercontent.com/simplex-chat/simplexmq/master/img/digitalocean.png" align="right" width="300">](https://marketplace.digitalocean.com/apps/simplex-server)
+
+## Deploy SMP server on DigitalOcean
+
+You can deploy SMP server using [SimpleX Server 1-click app](https://marketplace.digitalocean.com/apps/simplex-server) from DigitalOcean marketplace:
+
+- Create a DigitalOcean account or login with an already existing one.
+- Click 'Create SimpleX server Droplet' button.
+- Choose the region and plan according to your requirements (cheapest Regular plan should be sufficient).
+- Provide ssh key and confirm Droplet creation. 
+- SSH to created Droplet (`ssh root@<droplet_ip_address>`) to get SMP server public key hash - either from the welcome message or from `/etc/opt/simplex/pub_key_hash`. DigitalOcean has a good guide on [how to login to Droplet via ssh](https://docs.digitalocean.com/products/droplets/how-to/connect-with-ssh/).
+- Great, your own SMP server is ready! Use `ip_address#hash` as SMP server address in the client.
+
+Please submit an [issue](https://github.com/simplex-chat/simplexmq/issues) if any problems occur.
+
 ## SMP server design
 
 ![SMP server design](https://raw.githubusercontent.com/simplex-chat/simplexmq/master/design/server.svg)

apps/smp-agent/Main.hs

@@ -8,20 +8,10 @@ import Control.Logger.Simple
 import qualified Data.List.NonEmpty as L
 import Simplex.Messaging.Agent (runSMPAgent)
 import Simplex.Messaging.Agent.Env.SQLite
-import Simplex.Messaging.Client (smpDefaultConfig)
 import Simplex.Messaging.Transport (TCP, Transport (..))
 
 cfg :: AgentConfig
-cfg =
-  AgentConfig
-    { tcpPort = "5224",
-      smpServers = L.fromList ["localhost:5223#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="],
-      rsaKeySize = 2048 `div` 8,
-      connIdBytes = 12,
-      tbqSize = 16,
-      dbFile = "smp-agent.db",
-      smpCfg = smpDefaultConfig
-    }
+cfg = defaultAgentConfig {smpServers = L.fromList ["localhost:5223#bU0K+bRg24xWW//lS0umO1Zdw/SXqpJNtm1/RrPLViE="]}
 
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}

apps/smp-server/Main.hs

@@ -29,19 +29,25 @@ import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
 import System.IO (IOMode (..), hFlush, stdout)
+import Text.Read (readEither)
 
 defaultServerPort :: ServiceName
 defaultServerPort = "5223"
 
+defaultBlockSize :: Int
+defaultBlockSize = 4096
+
 serverConfig :: ServerConfig
 serverConfig =
   ServerConfig
     { tbqSize = 16,
+      msgQueueQuota = 256,
       queueIdBytes = 12,
       msgIdBytes = 6,
       -- below parameters are set based on ini file /etc/opt/simplex/smp-server.ini
       transports = undefined,
       storeLog = undefined,
+      blockSize = undefined,
       serverPrivateKey = undefined
     }
 
@@ -96,9 +102,9 @@ getConfig opts = do
   pure $ makeConfig ini pk storeLog
 
 makeConfig :: IniOpts -> C.FullPrivateKey -> Maybe (StoreLog 'ReadMode) -> ServerConfig
-makeConfig IniOpts {serverPort, enableWebsockets} pk storeLog =
+makeConfig IniOpts {serverPort, blockSize, enableWebsockets} pk storeLog =
   let transports = (serverPort, transport @TCP) : [("80", transport @WS) | enableWebsockets]
-   in serverConfig {serverPrivateKey = pk, storeLog, transports}
+   in serverConfig {serverPrivateKey = pk, storeLog, blockSize, transports}
 
 printConfig :: ServerConfig -> IO ()
 printConfig ServerConfig {serverPrivateKey, storeLog} = do
@@ -109,6 +115,7 @@ printConfig ServerConfig {serverPrivateKey, storeLog} = do
 
 initializeServer :: ServerOpts -> IO ServerConfig
 initializeServer opts = do
+  createDirectoryIfMissing False cfgDir
   ini <- createIni opts
   pk <- createKey ini
   storeLog <- openStoreLog opts ini
@@ -138,6 +145,7 @@ data IniOpts = IniOpts
     storeLogFile :: FilePath,
     serverKeyFile :: FilePath,
     serverPort :: ServiceName,
+    blockSize :: Int,
     enableWebsockets :: Bool
   }
 
@@ -150,7 +158,8 @@ readIni = do
       serverKeyFile = opt defaultKeyFile "TRANSPORT" "key_file" ini
       serverPort = opt defaultServerPort "TRANSPORT" "port" ini
       enableWebsockets = (== Right "on") $ lookupValue "TRANSPORT" "websockets" ini
-  pure IniOpts {enableStoreLog, storeLogFile, serverKeyFile, serverPort, enableWebsockets}
+  blockSize <- liftEither . readEither $ opt (show defaultBlockSize) "TRANSPORT" "block_size" ini
+  pure IniOpts {enableStoreLog, storeLogFile, serverKeyFile, serverPort, blockSize, enableWebsockets}
   where
     opt :: String -> Text -> Text -> Ini -> String
     opt def section key ini = either (const def) T.unpack $ lookupValue section key ini
@@ -176,6 +185,9 @@ createIni ServerOpts {enableStoreLog} = do
       <> "\n\
          \# port: "
       <> defaultServerPort
+      <> "\n\
+         \# block_size: "
+      <> show defaultBlockSize
       <> "\n\
          \websockets: on\n"
   pure
@@ -184,6 +196,7 @@ createIni ServerOpts {enableStoreLog} = do
         storeLogFile = defaultStoreLogFile,
         serverKeyFile = defaultKeyFile,
         serverPort = defaultServerPort,
+        blockSize = defaultBlockSize,
         enableWebsockets = True
       }
 
@@ -201,7 +214,6 @@ readKey IniOpts {serverKeyFile} = do
 
 createKey :: IniOpts -> IO C.FullPrivateKey
 createKey IniOpts {serverKeyFile} = do
-  createDirectoryIfMissing True cfgDir
   (_, pk) <- C.generateKeyPair newKeySize
   S.writeKeyFile S.TraditionalFormat serverKeyFile [PrivKeyRSA $ C.rsaPrivateKey pk]
   pure pk
@@ -222,7 +234,7 @@ confirm msg = do
   when (map toLower ok /= "y") exitFailure
 
 serverKeyHash :: C.FullPrivateKey -> B.ByteString
-serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey
+serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey'
 
 openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode))
 openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f}

img/linode.svg

@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 506.94 131.5"><path d="m109.65 58.21-18.21-10.07-15.37 9.38-.19 9.59-7.47-4.92-10.16 6.19-.44-10.48-10.48-7 10-5.17c-.08 0 0 1-1.48-34.34l-23.65-11.39-32.2 10 7.19 34.63 10.81 8.37-8.22 3.9 5.37 26.1 7.55 7.09-5.4 3.29 4.19 20.18 16.94 17.94c.08-.1 1.78-1.41 21.79-17.32l-.58-13.71 8.58 7.28c.12-.12 1.84-1.39 17.56-13.89l.61-10.14 6.48 4.5c.13-.12 1.58-1.22 14.26-11.33z" fill="#231f20"/><path d="m94.54 69 15.11-10.79-18.21-10.07-15.37 9.38z"/><path d="m92.87 88.2 1.67-19.2-18.47-11.48-.38 18.75z" fill="#004b16"/><path d="m68.22 107.73v-19.89l-18.66-14.15 1.47 19.54z" fill="#004b16"/><path d="m68.22 87.84 18.74-13.43-18.55-12.22-18.85 11.5z"/><path d="m38.43 131.48-2.98-20.32-18.15-17.8 4.19 20.18z" fill="#004b16"/><path d="m35.45 111.16 23.91-17.06-18.53-15.09-23.53 14.35z"/><path d="m33.9 100.6-3.94-26.88-20.22-16.81 5.41 26.07z" fill="#004b16"/><path d="m29.96 73.72 27.85-15.82-20.8-13.94-27.27 12.95z"/><path d="m28.07 60.88-5.4-36.81-22.67-14.06 7.19 34.62z" fill="#004b16"/><path d="m22.67 24.07 33.14-12.7-23.61-11.37-32.2 10.01z"/><g fill="#1cb35c"><path d="m107.13 76.87c-14.02 11.13-14.33 11.33-14.26 11.33 1.74-20.1 1.59-19.2 1.67-19.2 16-11.45 15-10.79 15.11-10.79z"/><path d="m85.78 93.84c-17.35 13.8-17.63 13.89-17.56 13.89-.17-20.82-.07-19.89 0-19.89 20-14.3 18.67-13.43 18.74-13.43z"/><path d="m60.22 114.16c-21.66 17.22-21.86 17.32-21.79 17.32-3.07-20.94-3-20.32-3-20.32 25.47-18.16 23.86-17.06 23.93-17.06z"/><path d="m55.81 11.37c1.52 35.37 1.4 34.34 1.48 34.34-28.66 14.89-29.29 15.17-29.22 15.17-5.52-37.63-5.47-36.81-5.4-36.81z"/><path d="m57.81 57.9c1.15 26.81 1 25.88 1.11 25.88-24.81 16.67-25.09 16.82-25 16.82-4-27.58-4-26.88-3.94-26.88z"/></g><path xmlns="http://www.w3.org/2000/svg" d="m151.61 14.24 16.58-4v79.88q0 13.13 7.83 15.65-3.84 7.31-13.13 7.3-11.28 0-11.28-15.66z"/><path d="m186.66 111.72v-57.42h-9.08v-13.6h25.86v71zm8.56-98.54a9.62 9.62 0 1 1 -9.62 9.62 9.63 9.63 0 0 1 9.62-9.62z"/><path d="m262.94 111.74v-41.06c0-6.05-1.16-10.48-3.48-13.26s-6.11-4.18-11.37-4.18a17.74 17.74 0 0 0 -7.8 2.06 18 18 0 0 0 -6.46 5.1v51.34h-16.59v-71h11.94l3 6.64q6.76-8 20-8 12.66 0 20 7.59t7.33 21.19v43.58z"/><path d="m288.42 76.06q0-16.26 9.38-26.47t24.77-10.21q16.19 0 25.14 9.82t9 26.86q0 17-9.12 27t-25 10q-16.18 0-25.17-10.12t-9-26.88zm17.24 0q0 23.47 16.91 23.48a14.54 14.54 0 0 0 12.31-6.11q4.55-6.09 4.54-17.37 0-23.14-16.85-23.15a14.61 14.61 0 0 0 -12.33 6.09q-4.58 6.11-4.58 17.06z"/><path d="m412.37 111.74v-4.31c-1.37 1.5-3.71 2.82-7 3.95a31.33 31.33 0 0 1 -10.15 1.69q-14.87 0-23.38-9.42t-8.52-26.27q0-16.84 9.78-27.42a32 32 0 0 1 24.51-10.58 32.37 32.37 0 0 1 14.72 3.32v-28.46l16.58-4v101.5zm0-54.06a17.6 17.6 0 0 0 -11.07-4.24q-10 0-15.33 6.07t-5.37 17.41q0 22.15 21.36 22.15a16.11 16.11 0 0 0 5.87-1.42c2.32-1 3.83-1.92 4.54-2.89z"/><path d="m505.55 81.3h-50.74q.46 8.49 5.83 13.2t14.46 4.7q11.34 0 17.25-5.9l6.43 12.7q-8.75 7.09-26.13 7.1-16.25 0-25.7-9.52t-9.45-26.58q0-16.78 10.38-27.2a33.91 33.91 0 0 1 24.9-10.41q15.45 0 24.81 9.22t9.35 23.48a46.28 46.28 0 0 1 -1.39 9.21zm-50.15-12.47h34.89q-1.73-15.58-17.24-15.59-14.2 0-17.65 15.59z"/></svg>

migrations/20210101_initial.sql

@@ -0,0 +1,117 @@
+CREATE TABLE IF NOT EXISTS servers(
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  key_hash BLOB,
+  PRIMARY KEY (host, port)
+) WITHOUT ROWID;
+
+CREATE TABLE IF NOT EXISTS rcv_queues(
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  rcv_id BLOB NOT NULL,
+  conn_alias BLOB NOT NULL,
+  rcv_private_key BLOB NOT NULL,
+  snd_id BLOB,
+  snd_key BLOB,
+  decrypt_key BLOB NOT NULL,
+  verify_key BLOB,
+  status TEXT NOT NULL,
+  PRIMARY KEY (host, port, rcv_id),
+  FOREIGN KEY (host, port) REFERENCES servers (host, port),
+  FOREIGN KEY (conn_alias)
+    REFERENCES connections (conn_alias)
+    ON DELETE CASCADE
+    DEFERRABLE INITIALLY DEFERRED,
+  UNIQUE (host, port, snd_id)
+) WITHOUT ROWID;
+
+CREATE TABLE IF NOT EXISTS snd_queues(
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  snd_id BLOB NOT NULL,
+  conn_alias BLOB NOT NULL,
+  snd_private_key BLOB NOT NULL,
+  encrypt_key BLOB NOT NULL,
+  sign_key BLOB NOT NULL,
+  status TEXT NOT NULL,
+  PRIMARY KEY (host, port, snd_id),
+  FOREIGN KEY (host, port) REFERENCES servers (host, port),
+  FOREIGN KEY (conn_alias)
+    REFERENCES connections (conn_alias)
+    ON DELETE CASCADE
+    DEFERRABLE INITIALLY DEFERRED
+) WITHOUT ROWID;
+
+CREATE TABLE IF NOT EXISTS connections(
+  conn_alias BLOB NOT NULL,
+  rcv_host TEXT,
+  rcv_port TEXT,
+  rcv_id BLOB,
+  snd_host TEXT,
+  snd_port TEXT,
+  snd_id BLOB,
+  last_internal_msg_id INTEGER NOT NULL,
+  last_internal_rcv_msg_id INTEGER NOT NULL,
+  last_internal_snd_msg_id INTEGER NOT NULL,
+  last_external_snd_msg_id INTEGER NOT NULL,
+  last_rcv_msg_hash BLOB NOT NULL,
+  last_snd_msg_hash BLOB NOT NULL,
+  PRIMARY KEY (conn_alias),
+  FOREIGN KEY (rcv_host, rcv_port, rcv_id) REFERENCES rcv_queues (host, port, rcv_id),
+  FOREIGN KEY (snd_host, snd_port, snd_id) REFERENCES snd_queues (host, port, snd_id)
+) WITHOUT ROWID;
+
+CREATE TABLE IF NOT EXISTS messages(
+  conn_alias BLOB NOT NULL,
+  internal_id INTEGER NOT NULL,
+  internal_ts TEXT NOT NULL,
+  internal_rcv_id INTEGER,
+  internal_snd_id INTEGER,
+  body TEXT NOT NULL,  -- deprecated
+  PRIMARY KEY (conn_alias, internal_id),
+  FOREIGN KEY (conn_alias)
+    REFERENCES connections (conn_alias)
+    ON DELETE CASCADE,
+  FOREIGN KEY (conn_alias, internal_rcv_id)
+    REFERENCES rcv_messages (conn_alias, internal_rcv_id)
+    ON DELETE CASCADE
+    DEFERRABLE INITIALLY DEFERRED,
+  FOREIGN KEY (conn_alias, internal_snd_id)
+    REFERENCES snd_messages (conn_alias, internal_snd_id)
+    ON DELETE CASCADE
+    DEFERRABLE INITIALLY DEFERRED
+) WITHOUT ROWID;
+
+CREATE TABLE IF NOT EXISTS rcv_messages(
+  conn_alias BLOB NOT NULL,
+  internal_rcv_id INTEGER NOT NULL,
+  internal_id INTEGER NOT NULL,
+  external_snd_id INTEGER NOT NULL,
+  external_snd_ts TEXT NOT NULL,
+  broker_id BLOB NOT NULL,
+  broker_ts TEXT NOT NULL,
+  rcv_status TEXT NOT NULL,
+  ack_brocker_ts TEXT,
+  ack_sender_ts TEXT,
+  internal_hash BLOB NOT NULL,
+  external_prev_snd_hash BLOB NOT NULL,
+  integrity BLOB NOT NULL,
+  PRIMARY KEY (conn_alias, internal_rcv_id),
+  FOREIGN KEY (conn_alias, internal_id)
+    REFERENCES messages (conn_alias, internal_id)
+    ON DELETE CASCADE
+) WITHOUT ROWID;
+
+CREATE TABLE IF NOT EXISTS snd_messages(
+  conn_alias BLOB NOT NULL,
+  internal_snd_id INTEGER NOT NULL,
+  internal_id INTEGER NOT NULL,
+  snd_status TEXT NOT NULL,
+  sent_ts TEXT,
+  delivered_ts TEXT,
+  internal_hash BLOB NOT NULL,
+  PRIMARY KEY (conn_alias, internal_snd_id),
+  FOREIGN KEY (conn_alias, internal_id)
+    REFERENCES messages (conn_alias, internal_id)
+    ON DELETE CASCADE
+) WITHOUT ROWID;

migrations/20210624_confirmations.sql

@@ -0,0 +1,9 @@
+CREATE TABLE conn_confirmations (
+  confirmation_id BLOB NOT NULL PRIMARY KEY,
+  conn_alias BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  sender_key BLOB NOT NULL,
+  sender_conn_info BLOB NOT NULL,
+  accepted INTEGER NOT NULL,
+  own_conn_info BLOB,
+  created_at TEXT NOT NULL DEFAULT (datetime('now'))
+) WITHOUT ROWID;

migrations/20210809_snd_messages.sql

@@ -0,0 +1,3 @@
+ALTER TABLE messages ADD msg_body BLOB NOT NULL DEFAULT x'';  -- this field replaces body TEXT
+-- TODO possibly migrate the data from body if it is possible in migration
+ALTER TABLE snd_messages ADD previous_msg_hash BLOB NOT NULL DEFAULT x'';

migrations/README.md

@@ -0,0 +1,9 @@
+# SQLite database migrations
+
+These migrations are [embedded](../src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs) into the executable and run when SMP agent starts (as a separate executable or as a part of [simplex-chat](https://github.com/simplex-chat/simplex-chat) app).
+
+Migration file names must have a format `YYYYMMDD-name.sql` - they will be executed in the order or lexicographic sorting of the names, the files with any other extension than `.sql` are ignored.
+
+The proposed approach is to minimize the number of migrations and merge them together when possible, to align with the agent releases.
+
+**Please note**: Adding or editing migrations will NOT update the migrations embedded into the executable, unless the [Migrations](../src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs) module is rebuilt - use `stack build --force-dirty` (in addition to edited files it seems to rebuild the files with TH splices and their dependencies, not all files as with `stack clean`).

package.yaml

@@ -1,5 +1,5 @@
 name: simplexmq
-version: 0.3.2
+version: 0.4.1
 synopsis: SimpleXMQ message broker
 description:  |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -20,9 +20,10 @@ category: Chat, Network, Web, System, Cryptography
 extra-source-files:
   - README.md
   - CHANGELOG.md
+  - migrations/*.*
 
 dependencies:
-  - ansi-terminal == 0.10.*
+  - ansi-terminal >= 0.10 && < 0.12
   - asn1-encoding == 0.9.*
   - asn1-types == 0.3.*
   - async == 2.2.*
@@ -30,18 +31,22 @@ dependencies:
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3
   - bytestring == 0.10.*
+  - composition == 1.0.*
+  - constraints >= 0.12 && < 0.14
   - containers == 0.6.*
-  - cryptonite == 0.27.*
+  - cryptonite >= 0.27 && < 0.30
+  - direct-sqlite == 2.3.*
   - directory == 1.3.*
+  - file-embed == 0.0.14.*
   - filepath == 1.4.*
-  - generic-random == 1.3.*
+  - generic-random >= 1.3 && < 1.5
   - iso8601-time == 0.1.*
   - memory == 0.15.*
   - mtl == 2.2.*
   - network == 3.1.*
   - network-transport == 0.5.*
   - QuickCheck == 2.14.*
-  - random == 1.1.*
+  - random >= 1.1 && < 1.3
   - simple-logger == 0.1.*
   - sqlite-simple == 0.4.*
   - stm == 2.5.*
@@ -64,7 +69,7 @@ executables:
     dependencies:
       - cryptostore == 0.2.*
       - ini == 0.4.*
-      - optparse-applicative == 0.15.*
+      - optparse-applicative >= 0.15 && < 0.17
       - simplexmq
     ghc-options:
       - -threaded
@@ -86,7 +91,6 @@ tests:
       - hspec == 2.7.*
       - hspec-core == 2.7.*
       - HUnit == 1.6.*
-      - random == 1.1.*
       - QuickCheck == 2.14.*
       - timeit == 2.0.*
 

protocol/agent-protocol.md

@@ -16,9 +16,10 @@
   - [Client commands and server responses](#client-commands-and-server-responses)
     - [NEW command and INV response](#new-command-and-inv-response)
     - [JOIN command](#join-command)
-    - [CON notification](#con-notification)
+    - [REQ notification and ACPT command](#req-notification-and-acpt-command)
+    - [INFO and CON notifications](#info-and-con-notifications)
     - [SUB command](#sub-command)
-    - [SEND command and SENT response](#send-command-and-sent-response)
+    - [SEND command and MID, SENT and MERR responses](#send-command-and-mid-sent-and-merr-responses)
     - [MSG notification](#msg-notification)
     - [END notification](#end-notification)
     - [OFF command](#off-command)
@@ -73,18 +74,22 @@ SMP agent protocol has 3 main parts:
 The procedure of establishing a duplex connection is explained on the example of Alice and Bob creating a bi-directional connection comprised of two unidirectional (simplex) queues, using SMP agents (A and B) to facilitate it, and two different SMP servers (which could be the same server). It is shown on the diagram above and has these steps:
 
 1. Alice requests the new connection from the SMP agent A using `NEW` command.
-2. Agent A creates an SMP queue on the server (using [SMP protocol](./simplex-messaging.md)) and responds to Alice with the invitation that contains queue information and the encryption key Bob's agent B should use. The invitation format is described in [Connection invitation](#connection-invitation).
+2. Agent A creates an SMP connection on the server (using [SMP protocol](./simplex-messaging.md)) and responds to Alice with the invitation that contains queue information and the encryption key Bob's agent B should use. The invitation format is described in [Connection invitation](#connection-invitation).
 3. Alice sends the invitation to Bob via any secure channel they have (out-of-band message).
 4. Bob sends `JOIN` command with the invitation as a parameter to agent B to accept the connection.
-5. Establishing Alice's SMP queue (with SMP protocol commands):
-  - Agent B sends unauthenticated message to SMP queue with ephemeral key that will be used to authenticate commands to the queue, as described in SMP protocol.
-  - Agent A receives the KEY and secures the queue.
+5. Establishing Alice's SMP connection (with SMP protocol commands):
+  - Agent B sends an "SMP confirmation" to the SMP queue specified in the invitation - SMP confirmation is an unauthenticated message with an ephemeral key that will be used to authenticate Bob's commands to the queue, as described in SMP protocol, and Bob's info.
+  - Agent A receives the SMP confirmation containing Bob's key and info.
+  - Agent A notifies Alice sending REQ notification with Bob's info.
+  - Alice accepts connection request with ACPT command.
+  - Agent A secures the queue.
   - Agent B tries sending authenticated SMP SEND command with agent `HELLO` message until it succeeds. Once it succeeds, Bob's agent "knows" the queue is secured.
 6. Agent B creates a new SMP queue on the server.
 7. Establish Bob's SMP queue:
   - Agent B sends `REPLY` message with the invitation to this 2nd queue to Alice's agent (via the 1st queue).
-  - Agent A having received this `REPLY` message sends unauthenticated message to SMP queue with Alice agent's ephemeral key that will be used to authenticate commands to the queue, as described in SMP protocol.
-  - Bob's agent receives the key and secures the queue.
+  - Agent A, having received this `REPLY` message, sends unauthenticated message to SMP queue with Alice agent's ephemeral key that will be used to authenticate Alice's commands to the queue, as described in SMP protocol, and Alice's info.
+  - Bob's agent receives the key and Alice's information and secures the queue.
+  - Bob's agent sends the notification `INFO` with Alice's information to Bob.
   - Alice's agent keeps sending `HELLO` message until it succeeds.
 8. Agents A and B notify Alice and Bob that connection is established.
   - Once sending `HELLO` succeeds, Alice's agent sends to Alice `CON` notification that confirms that now both parties can communicate.
@@ -193,13 +198,25 @@ cId = encoded
 cName = 1*(ALPHA / DIGIT / "_" / "-")
 
 agentCommand = (userCmd / agentMsg) CRLF
-userCmd = newCmd / joinCmd / subscribeCmd / sendCmd / acknowledgeCmd / suspendCmd / deleteCmd
-agentMsg = invitation / connected / unsubscribed / message / sent / received / ok / error
+userCmd = newCmd / joinCmd / acceptCmd / subscribeCmd / sendCmd / acknowledgeCmd / suspendCmd / deleteCmd
+agentMsg = invitation / connRequest / connInfo / connected / unsubscribed / connDown / connUp / messageId / sent / messageError / message / received / ok / error
 
 newCmd = %s"NEW" [SP %s"NO_ACK"] ; response is `invitation` or `error`
+; NO_ACK parameter currently not supported
 
 invitation = %s"INV" SP <queueInfo> ; `queueInfo` is the same as in out-of-band message, see SMP protocol
 
+connRequest = %s"REQ" SP confirmationId SP msgBody
+; msgBody here is any binary information identifying connection request
+
+confirmationId = 1*DIGIT
+
+acceptCmd = %s"ACPT" SP confirmationId SP msgBody
+; msgBody here is any binary information identifying connecting party
+
+connInfo = %s"INFO" SP msgBody
+; msgBody here is any binary information identifying connecting party
+
 connected = %s"CON"
 
 subscribeCmd = %s"SUB" ; response is `ok` or `error`
@@ -208,6 +225,12 @@ unsubscribed = %s"END"
 ; when another agent (or another client of the same agent)
 ; subscribes to the same SMP queue on the server
 
+connDown = %s"DOWN"
+; lost connection (e.g. because of Internet connectivity or server is down)
+
+connUp = %s"UP"
+; restored connection
+
 joinCmd = %s"JOIN" SP <queueInfo> [SP %s"NO_REPLY"] [SP %s"NO_ACK"]
 ; `queueInfo` is the same as in out-of-band message, see SMP protocol
 ; response is `connected` or `error`
@@ -225,18 +248,22 @@ binaryMsg = size CRLF msgBody CRLF ; the last CRLF is in addition to CRLF in the
 size = 1*DIGIT ; size in bytes
 msgBody = *OCTET ; any content of specified size - safe for binary
 
+messageId = %s"MID" SP agentMsgId
+
 sent = %s"SENT" SP agentMsgId
 
+messageError = %s"MERR" SP agentMsgId SP <errorType>
+
 message = %s"MSG" SP msgIntegrity SP recipientMeta SP brokerMeta SP senderMeta SP binaryMsg
 recipientMeta = %s"R=" agentMsgId "," agentTimestamp ; receiving agent message metadata 
 brokerMeta = %s"B=" brokerMsgId "," brokerTimestamp ; broker (server) message metadata
 senderMeta = %s"S=" agentMsgId "," agentTimestamp ; sending agent message metadata 
 brokerMsgId = encoded
 brokerTimestamp = <date-time>
-msgIntegrity = ok / messageError
+msgIntegrity = ok / msgIntegrityError
 
-messageError = %s"ERR" SP messageErrorType
-messageErrorType = skippedMsgErr / badMsgIdErr / badHashErr
+msgIntegrityError = %s"ERR" SP msgIntegrityErrorType
+msgIntegrityErrorType = skippedMsgErr / badMsgIdErr / badHashErr
 
 skippedMsgErr = %s"NO_ID" SP missingFromMsgId SP missingToMsgId
 badMsgIdErr = %s"ID" SP previousMsgId ; ID is lower than the previous
@@ -247,7 +274,6 @@ missingToMsgId = agentMsgId
 previousMsgId = agentMsgId
 
 acknowledgeCmd = %s"ACK" SP agentMsgId ; ID assigned by receiving agent (in MSG "R")
-; currently not implemented
 
 received = %s"RCVD" SP agentMsgId ; ID assigned by sending agent (in SENT response)
 ; currently not implemented
@@ -261,27 +287,41 @@ error = %s"ERR" SP <errorType>
 
 #### NEW command and INV response
 
-`NEW` command is used to create a connection and an invitation to be sent out-of-band to another protocol user. It should be used by the client of the agent that initiates creating a duplex connection.
+`NEW` command is used to create a connection and an invitation to be sent out-of-band to another protocol user (the joining party). It should be used by the client of the agent that initiates creating a duplex connection (the initiating party).
 
-`INV` response is sent by the agent to the client.
+`INV` response is sent by the agent to the client of the initiating party.
 
 #### JOIN command
 
-It is used to create a connection and accept the invitation received out-of-band. It should be used by the client of the agent that accepts the connection.
+It is used to create a connection and accept the invitation received out-of-band. It should be used by the client of the agent that accepts the connection (the joining party).
 
-#### CON notification
+#### REQ notification and ACPT command
 
-It is sent by both agents managing duplex connection to their clients once the connection is established and ready to accept client messages.
+When the joining party uses `JOIN` command, the initiating party will receive `REQ` notification with some numeric identifier and an additional binary information, that can be used to identify the joining party or for any other purpose.
+
+To continue with the connection the initiating party should use `ACPT` command.
+
+#### INFO and CON notifications
+
+After the initiating party proceeds with the connection using `ACPT` command, the joining party will receive `INFO` notification that can be used to identify the initiating party or for any other purpose.
+
+Once the connection is established and ready to accept client messages, both agents will send `CON` notification to their clients.
 
 #### SUB command
 
 This command can be used by the client to resume receiving messages from the connection that was created in another TCP/client session. Agent response to this command can be `OK` or `ERR` in case connection does not exist (or can only be used to send connections - e.g. when the reply queue was not created).
 
-#### SEND command and SENT response
+#### SEND command and MID, SENT and MERR responses
 
-`SEND` command is used to the client to send messages
+`SEND` command is used by the client to send messages.
 
-`SENT` response is sent by the agent to confirm that the message was delivered to the SMP server. Message ID in this response is the sequential message number that includes both sent and received messages in the connection.
+`MID` notification with the message ID (the sequential message number that includes both sent and received messages in the connection) is sent to the client to confirm that the message is accepted by the agent, before it is sent to the SMP server.
+
+`SENT` response is sent by the agent to confirm that the message was delivered to the SMP server. This notification contains the same message ID as `MID` notification. `SENT` notification, depending on network availability, can be sent at any time later, potentially in the next client session.
+
+In case of the failure to send the message for any other reason than network connection or message queue quota - e.g. authentication error (`ERR AUTH`) or syntax error (`ERR CMD error`), the agent will send to the client `MERR` notification with the message ID, and this message delivery will no longer be attempted.
+
+In case of client disconnecting from the agent, the pending messages will not be sent until the client re-connects to the agent and subscribes to the connection that has pending messages.
 
 #### MSG notification
 
@@ -294,6 +334,12 @@ It is sent by the agent to the client when agent receives the message from the S
 
 It is sent by the agent to the client when agent receives SMP protocol `END` notification from SMP server. It indicates that another agent has subscribed to the same SMP queue on the server and the server terminated the subscription of the current agent.
 
+#### DOWN and UP notifications
+
+These notifications are sent when server or network connection is, respectively, `DOWN` or back `UP`.
+
+All the subscriptions made in the current client session will be automatically resumed when `UP` notification is received.
+
 #### OFF command
 
 It is used to suspend the receiving SMP queue - sender will no longer be able to send the messages to the connection, but the recipient can retrieve the remaining messages. Agent response to this command can be `OK` or `ERR`. This command is irreversible.

protocol/diagrams/duplex-messaging/duplex-creating.mmd

@@ -27,11 +27,14 @@ sequenceDiagram
   note over BA: status: NONE/NEW
 
   note over BA, AA: 5. establish Alice's SMP queue
-  BA ->> AS: SEND: KEY: sender's server key
+  BA ->> AS: SEND: Bob's info and sender server key (SMP confirmation)
   note over BA: status: NONE/CONFIRMED
   activate BA
-  AS ->> AA: MSG: KEY: sender's server key
+  AS ->> AA: MSG: Bob's info and<br>sender server key
   note over AA: status: CONFIRMED/NONE
+  AA ->> AS: ACK: confirm message
+  AA ->> A: REQ: connection request ID<br>and Bob's info
+  A ->> AA: ACPT: accept connection request,<br>send Alice's info
   AA ->> AS: KEY: secure queue
   note over AA: status: SECURED/NONE
 
@@ -40,6 +43,7 @@ sequenceDiagram
   note over BA: status: NONE/ACTIVE
   AS ->> AA: MSG: HELLO: Alice's agent<br>knows Bob can send
   note over AA: status: ACTIVE/NONE
+  AA ->> AS: ACK: confirm message
 
   note over BA, BS: 6. create Bob's SMP queue
   BA ->> BS: NEW: create SMP queue
@@ -51,12 +55,15 @@ sequenceDiagram
   note over BA: status: PENDING/ACTIVE
   AS ->> AA: MSG: REPLY: invitation<br>to connect
   note over AA: status: ACTIVE/NEW
+  AA ->> AS: ACK: confirm message
 
-  AA ->> BS: SEND: KEY: sender's server key
+  AA ->> BS: SEND: Alice's info and sender's server key
   note over AA: status: ACTIVE/CONFIRMED
   activate AA
-  BS ->> BA: MSG: KEY: sender's server key
+  BS ->> BA: MSG: Alice's info and<br>sender's server key
   note over BA: status: CONFIRMED/ACTIVE
+  BA ->> B: INFO: Alice's info
+  BA ->> BS: ACK: confirm message
   BA ->> BS: KEY: secure queue
   note over BA: status: SECURED/ACTIVE
 
@@ -65,6 +72,7 @@ sequenceDiagram
   note over AA: status: ACTIVE/ACTIVE
   BS ->> BA: MSG: HELLO: Bob's agent<br>knows Alice can send
   note over BA: status: ACTIVE/ACTIVE
+  BA ->> BS: ACK: confirm message
 
   note over A, B: 8. notify users about connection success
   AA ->> A: CON: connected

protocol/simplex-messaging.md

@@ -410,7 +410,7 @@ secure = %s"KEY" SP senderKey
 senderKey = %s"rsa:" x509encoded ; the sender's RSA public key for this queue
 ```
 
-`senderKey` is received from the sender as part of the first message - see [Send Message Command](#send-message-command).
+`senderKey` is received from the sender as part of the first message - see [Send Message](#send-message) command.
 
 Once the queue is secured only signed messages can be sent to it.
 
@@ -535,7 +535,8 @@ No further messages should be delivered to unsubscribed transport connection.
   - transmission has no required signature or queue ID (`NO_AUTH`)
   - transmission has unexpected credentials (`HAS_AUTH`)
   - transmission has no required queue ID (`NO_QUEUE`)
-- authentication error (`AUTH`) - incorrect signature, unknown (or suspended) queue, sender's ID is used in place of recipient's and vice versa, and some other cases (see [Send message command](#send-message-command)).
+- authentication error (`AUTH`) - incorrect signature, unknown (or suspended) queue, sender's ID is used in place of recipient's and vice versa, and some other cases (see [Send message](#send-message) command).
+- message queue quota exceeded error (`QUOTA`) - too many messages were sent to the message queue. Further messages can only be sent after the recipient retrieves the messages.
 - incorrect message body size (`SIZE`).
 - internal server error (`INTERNAL`).
 

rfcs/2021-01-26-crypto.md

@@ -145,9 +145,9 @@ For each message, the agent performs the following actions to encrypt it:
 3. Encrypt the message using this AES256 key with [AES-GCM-SIV](https://hackage.haskell.org/package/cryptonite-0.28/docs/Crypto-Cipher-AESGCMSIV.html) (AEAD scheme) using the function `encrypt` with a random nonce.
 4. Encrypt the AES256 key with public encryption key for the queue using RSA-OAEP [encrypt](https://hackage.haskell.org/package/cryptonite-0.28/docs/Crypto-PubKey-RSA-OAEP.html#v:encrypt) function parameterized with [SHA256](https://hackage.haskell.org/package/cryptonite-0.28/docs/Crypto-Hash-Algorithms.html#t:SHA256) algorithm.
 5. The message to send is concatenation of:
-  1. encrypted AES256 key,
-  2. AuthTag from encryption in step 3, 
-  3. encrypted message (in this order)
+    1. encrypted AES256 key,
+    2. AuthTag from encryption in step 3, 
+    3. encrypted message (in this order).
 
 As there is no additional data that is sent e2e in clear text, we potentially need some simpler algorithm, possibly the one implemented in the tutorial, that implements authenticated encryption without additional (unencrypted) data.
 
@@ -155,7 +155,7 @@ Or we could use this algorithm to allow some data that is sent e2e in clear text
 
 ### Message decryption
 
-Agent decrypt the message following the same steps in the opposite order
+Agent decrypts the message following the same steps in the opposite order:
 
 1. Split encrypted message to AES256 key, AuthTag and encrypted message - tag and key have fixed size (?).
 2. Decrypt AES256 key using the decryption key (the private key that recipient has).

rfcs/2021-03-18-groups.md

@@ -1,25 +0,0 @@
-# SMP agent groups
-
-## Problems
-
-- device/user profile synchronisation
-- chat group communication
-
-Both problems would require message broadcast between a group of SMP agents.
-
-## Solution: basic symmetric groups via SMP agent protocol
-
-Additional commands and message envelopes to SMP agent protocol to provide an abstraction layer for device synchronisation and chat groups.
-
-The groups are fully symmetric, all agent who are members of the group have equal rights and can join and leave group at any time.
-
-All the information about the groups is stored only in agents, the commands are used to synchronise the group state between the agents.
-
-```abnf
-group_command = create_group / add_to_group / remove_from_group / leave_group
-group_response = group_created / added_to_group / removed_from_group
-group_notification = added_to_group_by / removed_from_group_by / left_group
-create_group = %s"GNEW " group_name ; cAlias must be empty
-add_to_group = %s"GADD " group_name ; cAlias is the connection to add to the group
-added_to_group = %s"GADDED " name ; cAlias is the connection added to the group
-```

rfcs/2021-05-23-broadcast.md

@@ -0,0 +1,50 @@
+# SMP agent broadcast
+
+## Problem
+
+Support agent message broadcast to multiple connections.
+
+It is done in ad-hoc way as part of the previous [groups proposal](./2021-05-23-groups2.md) - this proposal defines broadcast as a separate agent primitive to simplify group management.
+
+It can also be used for other purposes when the same message needs to be sent to multiple recipients without creating groups.
+
+## Solution
+
+A minimal protocol of additional client commands to create, manage and use broadcasts.
+
+From the point of view of the recipient this will look like a normal message, as if the sending agent executed multiple send commands (in fact, broadcast can be implemented by agent sending itself multiple SEND commands)
+
+### Commands and messages
+
+- command `B:bId? NEW` - create broadcast (response is `B:bId OK`, or `ERR` if broadcast already exists)
+- command `B:bId ADD C:cId` - add existing connection to a broadcast (response is `B:bId OK` or `ERR`, e.g. if connection already added or does not exist)
+- command `B:bId SEND msg` - broadcast message (response is multiple `B:cId SENT [C:bId] msgId` or ERR, separately for each connection and then for the broadcast)
+- message `B:bId SENT [C:bId] msgId` - notification that the message is sent to a specific or all recipients
+- command `B:bId REM C:cId` - remove connection from broadcast (response is `B:bId OK` or `ERR`)
+- message `B:bId EMPTY` - all connections were removed from the broadcast
+- command `B:bId DEL` - delete broadcast (response is `B:bId OK` and when the last connection is removed an additional `B:bId EMPTY` is sent)
+- command `B:bId LS` - list connections in broadcast, response is `B:Id MS space_separated_connections`
+- message `B:bId MS space_separated_connections`
+
+## Questions
+
+1. Should broadcast IDs use the same namespace as connection IDs (and as group IDs)? Having the same namespace for all abstractions that the agent can operate on can be helpful, as it can also allow implementing some queries to determine which type a given ID has, but it also increases implementation complexity.
+
+2. Given that this abstraction would be used as internal abstraction for groups (same as connections internal to the group), it might be better to implement "agent users", each with its own connection namespace. In this case agent would use itself as one of the users.
+
+3. There is a similarity of commands for connections, groups and broadcasts, they only differ on the single-letter prefix. We could do one of the following:
+  - use the same command for different object types. This feels incorrect and error prone on its own.
+  - extend transmission structure with the field defining the object type (connection, group, broadcast, etc.).
+
+In this case, the transmission would look like:
+
+```
+agentTransmission = [corrId] CRLF objectType:[objectID] CRLF agentCommand
+objectType = C | B | G ; this is the additional field
+```
+
+This approach would allow reusing the existing command avoiding the unnecessary repetition.
+
+In this case, the command type could be parameterized with the list of supported agent object types, so we can ensure on the type level that only allowed commands can be constructed.
+
+EDIT: This approach is already implemented

rfcs/2021-05-23-introduction.md

@@ -0,0 +1,41 @@
+# SMP agent introduction
+
+## Problem
+
+Allow an agent client to connect two connections it has directly, with the agent acting as an out-of-band channel.
+
+It can be used both separately as part of some client functionality, and as part of group protocol.
+
+## Solution
+
+A protocol with commands and message envelopes to exchange the information between parties to establish connection.
+
+### Commands and messages
+
+Below commands are for the scenario when A introduces B to M.
+
+- command `C:idAB INTRO C:idAM infoM` - initiate introduction of the connection cIdB to connection cIdM (response is `C:idAB OK`)
+- message `C:idBA REQ C:invId infoM` - notification to confirm introduction
+- command `C:idBM? ACPT C:invId` - accept offer to be introduced (response is `C:idBM OK`, followed by `C:idBM CON`)
+- message `C:idBM CON` - confirmation that connection is established to both introduced parties
+- message `C:idAB CON C:idAM` - confirmation that connection is established to the introducer
+
+### Agent envelopes
+
+- `INTRO C:extIntroIdM infoM` - new introduction offered by introducer
+- `INV C:extIntroIdB prv:invBM infoB` - invitation to join connection from B to M sent via A
+- `REQ C:extIntroIdB prv:invBM infoB` - new introduction forwarded by the introducer
+- `CON C:extIntroId` - confirmation that the connection is established sent by both introduced parties to the introducer
+
+## Namespace
+
+Given that the introduction objects are short lived, they should not reuse the same commands or share the same namespace as connections, broadcasts and groups, but they probably should share the namespace with group and connection invitations.
+
+## Introduction protocol costs
+
+5 messages + cost to establish a connection
+
+
+The [sequence digram for introduction](https://mermaid.ink/img/eyJjb2RlIjoic2VxdWVuY2VEaWFncmFtXG4gIHBhcnRpY2lwYW50IEEgYXMgQWxpY2UgKEEpIC0gdGhlIGludHJvZHVjZXJcbiAgcGFydGljaXBhbnQgQUEgYXMgQWxpY2Unczxicj5hZ2VudCAoQUEpXG4gIHBhcnRpY2lwYW50IEIgYXMgQm9iIChCKSAtIGludHJvZHVjZWRcbiAgcGFydGljaXBhbnQgQkEgYXMgQm9iJ3M8YnI-YWdlbnQgKEJBKVxuICBwYXJ0aWNpcGFudCBNIGFzIE1hcmsgKE0pIC0gaW50cm9kdWNlZCB0b1xuICBwYXJ0aWNpcGFudCBNQSBhcyBNYXJrJ3M8YnI-YWdlbnQgKE1BKVxuXG4gIG5vdGUgb3ZlciBBLCBBQTogMS4gY3JlYXRlIGludHJvZHVjdGlvblxuICBBIC0-PiBBQTogQzppZEFCIElOVFJPIEM6aWRBTSBpbmZvTTxicj4oaWRBQiAtIGNvbm4gYWxpYXMgQSBoYXMgZm9yIEIsPGJyPmlkQU0gLSBmb3IgTSlcbiAgQUEgLT4-IEE6IEM6aWRBQiBPS1xuXG4gIG5vdGUgb3ZlciBBLCBCQTogMi4gc2VuZCBpbnRybyB0byBCb2JcblxuICBBQSAtPj4gQkE6IHZpYSBpZEFCOiBJTlRSTyBDOmV4dEludHJvSWRNIGluZm9NXG4gIEJBIC0-PiBCOiBDOmlkQkEgUkVRIEM6aW50SW50cm9JZE0gaW5mb01cbiAgQiAtPj4gQkE6IEM6aWRCTT8gQUNQVCBDOmludEludHJvSWRNXG4gIEJBIC0-PiBCOiBDOmlkQk0gT0tcblxuICBub3RlIG92ZXIgQkE6IDMuIGNyZWF0ZSBjb25uZWN0aW9uIGZvciAgTSBpZEJNXG5cbiAgQkEgLT4-IEFBOiB2aWEgaWRCQTogSU5WIEM6ZXh0SW50cm9JZE0gcHJ2OmludkJNIGluZm9CXG5cbiAgbm90ZSBvdmVyIEFBLCBNOiA0LiBzZW5kIGludHJvIHRvIE1hcmtcblxuICBBQSAtPj4gTUE6IHZpYSBpZEFNOiBSRVEgQzpleHRJbnRyb0lkQiBwcnY6aW52Qk0gaW5mb0JcblxuICBub3RlIG92ZXIgTUEsIEI6IDUuIE1hcmsgY29ubmVjdHMgdG8gQm9iXG5cbiAgTUEgLT4-IE06IEM6aWRNQSBSRVEgQzppbnRJbnRyb0lkQiBpbmZvQlxuICBNIC0-PiBNQTogQzppZE1CPyBBQ1BUIEM6aW50SW50cm9JZEJcbiAgTUEgLT4-IE06IEM6aWRNQiBPS1xuXG4gIE1BIC0-PiBCQTogIGVzdGFibGlzaCBjb25uZWN0aW9uIGlkQk0gLT4gaWRNQlxuXG4gIG5vdGUgb3ZlciBBLCBNQTogNi4gbm90aWZ5IGFsbCBjbGllbnRzXG5cbiAgTUEgLT4-IE06IEM6aWRNQiBDT05cbiAgTUEgLT4-IEFBOiB2aWEgaWRNQTogQ09OIEM6ZXh0SW50cm9JZEJcbiAgQkEgLT4-IEI6IEM6aWRCTSBDT05cbiAgQkEgLT4-IEFBOiB2aWEgaWRCQTogQ09OIEM6ZXh0SW50cm9JZEJcbiAgQUEgLT4-IEE6IEM6aWRBQiBDT04gQzppZEFNXG4iLCJtZXJtYWlkIjp7fSwidXBkYXRlRWRpdG9yIjpmYWxzZX0), the source is [here](./intro.mmd).
+
+![sequence digram for introduction](https://mermaid.ink/svg/eyJjb2RlIjoic2VxdWVuY2VEaWFncmFtXG4gIHBhcnRpY2lwYW50IEEgYXMgQWxpY2UgKEEpIC0gdGhlIGludHJvZHVjZXJcbiAgcGFydGljaXBhbnQgQUEgYXMgQWxpY2Unczxicj5hZ2VudCAoQUEpXG4gIHBhcnRpY2lwYW50IEIgYXMgQm9iIChCKSAtIGludHJvZHVjZWRcbiAgcGFydGljaXBhbnQgQkEgYXMgQm9iJ3M8YnI-YWdlbnQgKEJBKVxuICBwYXJ0aWNpcGFudCBNIGFzIE1hcmsgKE0pIC0gaW50cm9kdWNlZCB0b1xuICBwYXJ0aWNpcGFudCBNQSBhcyBNYXJrJ3M8YnI-YWdlbnQgKE1BKVxuXG4gIG5vdGUgb3ZlciBBLCBBQTogMS4gY3JlYXRlIGludHJvZHVjdGlvblxuICBBIC0-PiBBQTogQzppZEFCIElOVFJPIEM6aWRBTSBpbmZvTTxicj4oaWRBQiAtIGNvbm4gYWxpYXMgQSBoYXMgZm9yIEIsPGJyPmlkQU0gLSBmb3IgTSlcbiAgQUEgLT4-IEE6IEM6aWRBQiBPS1xuXG4gIG5vdGUgb3ZlciBBLCBCQTogMi4gc2VuZCBpbnRybyB0byBCb2JcblxuICBBQSAtPj4gQkE6IHZpYSBpZEFCOiBJTlRSTyBDOmV4dEludHJvSWRNIGluZm9NXG4gIEJBIC0-PiBCOiBDOmlkQkEgUkVRIEM6aW50SW50cm9JZE0gaW5mb01cbiAgQiAtPj4gQkE6IEM6aWRCTT8gQUNQVCBDOmludEludHJvSWRNXG4gIEJBIC0-PiBCOiBDOmlkQk0gT0tcblxuICBub3RlIG92ZXIgQkE6IDMuIGNyZWF0ZSBjb25uZWN0aW9uIGZvciAgTSBpZEJNXG5cbiAgQkEgLT4-IEFBOiB2aWEgaWRCQTogSU5WIEM6ZXh0SW50cm9JZE0gcHJ2OmludkJNIGluZm9CXG5cbiAgbm90ZSBvdmVyIEFBLCBNOiA0LiBzZW5kIGludHJvIHRvIE1hcmtcblxuICBBQSAtPj4gTUE6IHZpYSBpZEFNOiBSRVEgQzpleHRJbnRyb0lkQiBwcnY6aW52Qk0gaW5mb0JcblxuICBub3RlIG92ZXIgTUEsIEI6IDUuIE1hcmsgY29ubmVjdHMgdG8gQm9iXG5cbiAgTUEgLT4-IE06IEM6aWRNQSBSRVEgQzppbnRJbnRyb0lkQiBpbmZvQlxuICBNIC0-PiBNQTogQzppZE1CPyBBQ1BUIEM6aW50SW50cm9JZEJcbiAgTUEgLT4-IE06IEM6aWRNQiBPS1xuXG4gIE1BIC0-PiBCQTogIGVzdGFibGlzaCBjb25uZWN0aW9uIGlkQk0gLT4gaWRNQlxuXG4gIG5vdGUgb3ZlciBBLCBNQTogNi4gbm90aWZ5IGFsbCBjbGllbnRzXG5cbiAgTUEgLT4-IE06IEM6aWRNQiBDT05cbiAgTUEgLT4-IEFBOiB2aWEgaWRNQTogQ09OIEM6ZXh0SW50cm9JZEJcbiAgQkEgLT4-IEI6IEM6aWRCTSBDT05cbiAgQkEgLT4-IEFBOiB2aWEgaWRCQTogQ09OIEM6ZXh0SW50cm9JZEJcbiAgQUEgLT4-IEE6IEM6aWRBQiBDT04gQzppZEFNXG4iLCJtZXJtYWlkIjp7fSwidXBkYXRlRWRpdG9yIjpmYWxzZX0)

rfcs/groups.mmd

@@ -0,0 +1,135 @@
+sequenceDiagram
+  participant M as Existing<br>member (M)
+  participant MA as Existing<br>member<br>agent (MA)
+  participant A as Alice (A)
+  participant AA as Alice's<br>agent (AA)
+  participant BA as Bob's<br>agent (BA)
+  participant B as Bob (B)
+
+  note over A, AA: 1. create new group (no members)
+  A ->> AA: G:gidA? NEW<br>(gidA - group ID of this group for A,<br>can be generated by the agent)
+
+  note over AA: create "internal" broadcast associated with the group<br>(B: NEW)
+
+  AA ->> A: G:gidA OK
+
+  note over A, BA: 2. add Bob to group
+
+  A ->> AA: C:idAB INTRO G:gidA gInfo<br>(idAB - conn alias A has for B)
+  
+  note over AA: generate new random ID for member B (midB, unique per group)<br>initiate "internal" connection gidAB for B in group<br>(internal means that it is not visible to the clients<br>and cannot be used with client commands)
+
+  AA ->> BA: via idAB: GROUP C:midB g:gInvAB gInfo
+  BA ->> B: C:idBA REQ G:invID gInfo<br>(invID - to refer to it in ACPT)
+  B ->> BA: G:gidB? ACPT G:invID<br>(RJCT G:invID could be added)
+
+  note over BA: create group and "internal" broadcast associated with the group<br>(B: NEW)
+
+  BA ->> B: G:gidB OK
+
+  BA ->> AA: establish internal connection gidBA (using g:gInvAB) for A in group
+
+  note over BA, AA: add connections gidBA and gidAB to broadcasts<br>(B: ADD)
+ 
+  AA ->> A: G:gidA CON C:idAB
+  BA ->> B: G:gidA CON C:idBA
+
+  note over M, B: For each existing member M:<br>create and accept internal introduction between connections, related to the group, via gidAB/BA/AM/MA, connections created are gidBM and gidMB<br>The fact that the introduction arrives via connection allocated for the group, allows agents identify it as a new group member, ID used in introductions is group-scoped member ID.
+
+  note over A, BA: once all members were sent to B
+  AA ->> BA: via gidAB: MEM C:midB
+
+  note over BA, B: once all members are connected
+  BA ->> B: G:gidB MEM
+
+  note over A, AA: once all members reported connection
+  AA ->> A: G:gidA MEM C:idAB
+
+  note over M, AA: for each member M
+
+  AA ->> MA: via gidAM: MEM C:midB
+  MA ->> M: G:gidM MEM C:idMB
+  
+  note over M, B: 3. B sends message to the group
+
+  B ->> BA: G:gidB SEND msg
+
+  note over BA: send message via associated broadcast and respond to client with SENT notifications
+
+  BA ->> B: G:gidB SENT C:idBA intMsgID
+  BA ->> B: G:gidB SENT C:idBM intMsgID
+  
+  note over BA, B: once sent to all
+  BA ->> B: G:gidB SENT intMsgID
+
+  AA ->> A: G:gidA MSG C:idAB intMsgID msgdata
+  A ->> AA: G:gidA ACK intMsgID
+  AA ->> BA: via gidAB: RCVD extMsgID hash sig
+  BA ->> B: G:gidA RCVD C:idBA intMsgID status<br>(status - message integrity check)
+
+  MA ->> M: G:gidM MSG C:idMB intMsgID msgdata
+  M ->> MA: G:gidM ACK intMsgID
+  MA ->> BA: via gidMB: RCVD extMsgID hash sig
+  BA ->> B: G:gidM RCVD C:idBM intMsgID status
+
+  note over BA, B: once received by all
+  BA ->> B: G:gidM RCVD intMsgID status
+
+  note over M, B: 4a. A leaves group
+
+  A ->> AA: G:gidA LEAVE
+  AA ->> A: G:gidA OK
+  AA ->> BA: via gidAB: LEFT
+  note over AA: remove gidAB, remove from broadcast
+  note over BA: remove gidBA, remove from broadcast
+  BA ->> B: G:gidB LEFT C:idBA
+
+  AA ->> MA: via gidAM: LEFT
+  note over AA: remove gidAM, remove from broadcast
+  note over MA: remove gidMA, remove from broadcast
+  MA ->> M: G:gidM LEFT C:idMA
+
+  AA ->> A: G:gidA LEFT
+
+  note over B, BA: if all members left
+  BA ->> B: G:gidB: EMPTY
+
+  note over M, B: 4b. A removes B from group
+
+  A ->> AA: G:gidA REM C:idAB
+  AA ->> A: G:gidA OK
+  AA ->> BA: via gidAB: OUT
+  note over BA: remove gidBA, all gidBM
+  BA ->> B: G:gidB OUT C:idBA
+
+  note over AA: remove gidAB
+  AA ->> A: G:gidA OK
+
+  note over M, B: below steps happen for each existing member M
+
+  AA ->> MA: via gidAM: REM C:midB
+  note over MA: remove gidMB
+  MA ->> AA: via gidMA: REMD C:midB
+  MA ->> M: G:gidM REMD C:idMB C:idMA<br>(B removed by A)
+
+  note over A, AA: once all members removed B
+
+  AA ->> A: G:gidA REMD C:idAB<br>(B removed by this agent)
+
+  note over M, B: 4c. A deletes group
+  A ->> AA: G:gidA DEL
+  AA ->> A: G:gidA OK
+  
+  AA ->> BA: via gidAB: DEL
+  note over BA: remove all group connections and messages
+  BA ->> B: G:gidB DELD C:idBA<br>(group deleted by A)
+  BA ->> AA: via gidBA: DELD
+  AA ->> A: G:gidA DELD C:idAB
+
+  AA ->> MA: via gidAM: DEL
+  note over MA: remove all group connections and messages
+  MA ->> M: G:gidM DELD C:idMA<br>(group deleted by A)
+  MA ->> AA: via gidMA: DELD
+  AA ->> A: G:gidA DELD C:idAM
+
+  AA ->> A: G:gidA DELD<br>(group deleted by this agent - all confirmed)

rfcs/intro.mmd

@@ -0,0 +1,42 @@
+sequenceDiagram
+  participant A as Alice (A) - the introducer
+  participant AA as Alice's<br>agent (AA)
+  participant B as Bob (B) - introduced
+  participant BA as Bob's<br>agent (BA)
+  participant M as Mark (M) - introduced to
+  participant MA as Mark's<br>agent (MA)
+
+  note over A, AA: 1. create introduction
+  A ->> AA: C:idAB INTRO C:idAM infoM<br>(idAB - conn alias A has for B,<br>idAM - for M)
+  AA ->> A: C:idAB OK
+
+  note over A, BA: 2. send intro to Bob
+
+  AA ->> BA: via idAB: INTRO C:extIntroIdM infoM
+  BA ->> B: C:idBA REQ C:intIntroIdM infoM
+  B ->> BA: C:idBM? ACPT C:intIntroIdM
+  BA ->> B: C:idBM OK
+
+  note over BA: 3. create connection for  M idBM
+
+  BA ->> AA: via idBA: INV C:extIntroIdM invBM infoB
+
+  note over AA, M: 4. send intro to Mark
+
+  AA ->> MA: via idAM: REQ C:extIntroIdB invBM infoB
+
+  note over MA, B: 5. Mark connects to Bob
+
+  MA ->> M: C:idMA REQ C:intIntroIdB infoB
+  M ->> MA: C:idMB? ACPT C:intIntroIdB
+  MA ->> M: C:idMB OK
+
+  MA ->> BA:  establish connection idBM -> idMB
+
+  note over A, MA: 6. notify all clients
+
+  MA ->> M: C:idMB CON
+  MA ->> AA: via idMA: CON C:extIntroIdB
+  BA ->> B: C:idBM CON
+  BA ->> AA: via idBA: CON C:extIntroIdB
+  AA ->> A: C:idAB CON C:idAM

rfcs/protocol_overview.md

@@ -0,0 +1,146 @@
+# Overview of SMP agent protocol commands
+
+## Connections
+
+### Commands and messages
+
+A initiates connection, B accepts
+
+- command `C:idB? NEW` - create connection
+- message `C:idB INV cInv`
+- command `C:idA? JOIN cInv replyMode` - join connection (response `OK`, followed by `CON`)
+- *message* `C:idB REQ prv:invId infoB` - request from B joining sent to A (not implemented)
+- *command* `C:idB ACPT prv:invId` - A confirms B joining (not implemented)
+- message `C:id CON` - connection is established
+- command `C:id SUB` - subscribe to connection
+- message `C:id END` - unsubscribed from connection
+- command `C:idB SEND msg` - send message
+- message `C:idA SENT msgId` - confirmation that the message is sent
+- message `C:id MSG msgId msgMeta msgIntegrity msgBody` - received message
+- *command* `C:idB ACK msgId` - acknowledge message reception (not implemented)
+- *message* `C:idA RCVD msgId msgIntegrity` - confirmation of message reception and integrity (not implemented)
+- command `C:id OFF` - suspend connection
+- command `C:id DEL` - delete connection
+- message `C:id? OK` - command confirmation
+- message `C:id? ERR e` - error
+
+### Envelopes
+
+- `MSG `
+- `HELLO verificationKey ackMode`
+- `REPLY replyInv`
+
+## Broadcasts
+
+### Commands & messages
+
+- command `B:id? NEW` - create broadcast (response is `B:id OK`)
+- command `B:id SEND msg` - broadcast message (response is multiple `C:id SENT msgId` or ERR, separately for each connection, followed by `B:id SENT msgId` once sent to all)
+- message `B:id SENT msgId` - notification that the message is sent and its internal ID, same as SENT
+- command `B:id ADD cId` - add existing connection to a broadcast (response is `B:id OK` or `ERR`, e.g. if bId is used)
+- command `B:id REM cId` - remove connection from the broadcast (response is `REMD`)
+- message `B:id REMD cId` - connection removed from the broadcast
+- message `B:id EMPTY` - all connections were removed from the broadcast
+- command `B:id DEL` - delete broadcast (response is `B:id OK`)
+- command `B:id LS` - list connections in broadcast, response is `B:id MEM space_separated_connections`
+- message `B:id MEM space_separated_connections`
+
+## Open/public connection
+
+### Commands
+
+- command `O:id? NEW` - create open connection
+- message `O:id INV oInv` - open invitation
+- command `C:id? JOIN oInv replyMode` - join connection (response `OK`, followed by `CON`)
+- message `O:id REQ open:invId infoB` - confirmation from B joining sent to A
+- command `C:idC? ACPT open:invId` - note, that it creates new connection, keeping OPEN connection
+- command `O:id SUB` - subscribe to open connection
+- message `O:id END` - unsubscribed from open connection
+- command `O:id OFF` - suspend open connection
+- command `O:id DEL` - delete open connection
+- message `O:id? OK` - command confirmation
+- message `O:id? ERR e` - error
+
+## Introductions
+
+### Commands
+
+- command `C:idAB INTRO C:idAM infoM` - introduce connection cIdB to connection cIdM (response is `OK`)
+- message `C:idBA REQ C:invId infoM` - notification to confirm introduction
+- command `C:idBM? ACPT C:invId` - accept offer to be introduced (response is `cIdBM OK`, followed by `ICON`)
+- message `C:idBM CON` - confirmation that connection is established to both introduced parties
+- message `C:idAB CON C:idAM` - confirmation that connection is established to the introducer
+
+### Envelopes
+
+- `INTRO C:extIntroIdM infoM` - new introduction offered by introducer
+- `INV C:extIntroIdB prv:invBM infoB` - invitation to join connection from B to M sent via A (can be pub:)
+- `REQ C:extIntroIdB prv:invBM infoB` - new introduction forwarded by introducer
+- `CON C:extIntroIdM` - confirmation that the connection is established sent by both introduced parties to the introducer
+
+## Groups
+
+## Agent commands and messages syntax
+
+- command `G:gId? NEW` - create group (response is `G:gId OK`)
+- command `C:cId INTRO G:gId gInfo` - add existing connection to a group
+- message `C:cId REQ g:invID gInfo` - invitation to join the group
+- command `G:gId? ACPT g:invId` - accept invitation (response is `G gId OK`)
+- message `G:gId CON C:cId` - 2 connections created with some group member (both for group and direct messages)
+- message `G:gId MEM [C:cId]` - connection created with all group members for a given member or current client
+- command `G:gId SEND msg` - send message to group
+- message `G:gId SENT msgId` - notification that the message is sent and its internal ID, same as SENT
+- message `G:gId MSG C:cId msgId msgdata` - received group message from cId, msgdata is the same set of parameters as in `MSG`
+- command `G:gId ACK msgId` - acknowledge message reception by the client
+- message `G:gId RCVD t:cId msgId status` - message delivery notification
+- command `G:gId LEAVE` - leave the group
+- message `G:gId LEFT [C:cId]` - connection cId left the group
+- command `G:gId REM C:cId` - remove group member (response is `gId OK`, followed by `GREMD` notification)
+- message `G:gId REMD C:cId [C:cId]` - member removed
+- message `G:gId OUT C:cId` - you are removed (see question below - should it be just a sequence of GLEFT?)
+- message `G:gId EMPTY` - all members left the group and it is now empty
+- command `G:gId DEL` - delete the group (response is `gId OK`)
+- message `G:gId DELD [C:cId]` - group deleted
+
+## Agent message envelopes syntax
+
+- `GROUP C:mid G:inv gInfo` - invitation to join the group
+- `MEM C:mid` - confirmation that member connected to all members
+- `LEFT` - notification that member left the group
+- `OUT` - you are removed from the group
+- `REM C:mid` - remove member mid from the group
+- `REMD C:mid` - confirmation that member is removed
+- `DEL` - group is deleted
+- `DELD` - confirmation that group is deleted
+
+## Commands and objects
+
+| Dir     | Command / message    | (C)onnection | (O)pen connection | (B)roadcast | (G)roup |
+|:---------:|:--------------------:|:------------:|:-----------------:|:-----------:|:-------:|
+| command | `t:id? NEW`           | ✓ | ✓ | ✓ | ✓ |
+| command | `C:id INTRO t:id info` | ✓ | - | - | ✓ |
+| message | `t:id INV inv`        | ✓ | ✓ | - | - |
+| command | `C:id? JOIN inv replyMode info` | ✓ | - | - | - |
+| message | `t:id REQ invId info` | ✓ | ✓ | - | ✓ |
+| command | `t:id? ACPT invId`    | ✓ | - | - | ✓ |
+| message | `t:id CON [C:id]`     | ✓ | - | - | ✓ |
+| message | `t:id MEM [C:id]`     | - | - | - | ✓ |
+| command | `t:id SUB`            | ✓ | ✓ | - | ✓ |
+| message | `t:id END`            | ✓ | ✓ | - | ✓ |
+| command | `t:id OFF`            | ✓ | ✓ | - | - |
+| command | `t:id DEL`            | ✓ | ✓ | ✓ | ✓ |
+| message | `t:id DELD [C:Id]`    | ✓ | ✓ | ✓ | ✓ |
+| command | `t:id SEND msg`       | ✓ | - | ✓ | ✓ |
+| message | `t:id SENT [t':id] msgId` | ✓ | - | ✓ | ✓ |
+| message | `t:id MSG [C:id] msgId msgdata` | ✓ | - | - | ✓ |
+| command | `t:id ACK msgId`      | ✓ | - | - | ✓ |
+| message | `t:id RCVD [t':id] msgId status` | ✓ | - | - | ✓ |
+| command | `t:id ADD C:id`       | - | - | - | ✓ |
+| command | `t:id REM C:id`       | - | - | ✓ | ✓ |
+| command | `t:id REMD C:id`      | - | - | ✓ | ✓ |
+| message | `t:id EMPTY`          | - | - | ✓ | ✓ |
+| message | `G:id OUT C:id`       | - | - | - | ✓ |
+| command | `t:id LS`             | - | - | ✓ | ✓ |
+| message | `t:id MS cIds`        | - | - | ✓ | ✓ |
+| command | `G:id LEAVE`          | - | - | - | ✓ |
+| message | `G:id LEFT [C:id]`    | - | - | - | ✓ |

scripts/smp-server-digitalocean-droplet/files/opt/simplex/on_login.sh

@@ -0,0 +1,18 @@
+#!/bin/bash
+# receives pubkey_hash file location as the first parameter
+
+ip_address=$(hostname -I | awk '{print$1}')
+hash=$(cat $1)
+
+cat <<EOF
+********************************************************************************
+
+SMP server address: $ip_address#$hash
+Check SMP server status with: systemctl status smp-server
+
+To keep this server secure, the UFW firewall is enabled.
+All ports are BLOCKED except 22 (SSH), 80 (HTTP), 5223 (SMP server).
+
+********************************************************************************
+To stop seeing this message delete line - bash /opt/simplex/on_login.sh - from /root/.bashrc
+EOF

scripts/smp-server-digitalocean-droplet/marketplace-image.json

@@ -0,0 +1,48 @@
+{
+  "variables": {
+    "token": "{{env `DIGITALOCEAN_TOKEN`}}",
+    "image_name": "smp-server-snapshot",
+    "application_name": "SMP server",
+    "release_tag": "v0.4.1"
+  },
+  "sensitive-variables": ["token"],
+  "builders": [
+    {
+      "type": "digitalocean",
+      "api_token": "{{user `token`}}",
+      "image": "ubuntu-20-04-x64",
+      "region": "fra1",
+      "size": "s-1vcpu-1gb",
+      "ssh_username": "root",
+      "snapshot_name": "{{user `image_name`}}"
+    }
+  ],
+  "provisioners": [
+    {
+      "type": "shell",
+      "inline": [
+        "cloud-init status --wait",
+        "mkdir -p /opt/simplex"
+      ]
+    },
+    {
+      "type": "file",
+      "source": "files/opt/",
+      "destination": "/opt/"
+    },
+    {
+      "type": "shell",
+      "environment_vars": [
+        "application_name={{user `application_name`}}",
+        "release_tag={{user `release_tag`}}"
+      ],
+      "scripts": [
+        "scripts/01-packages.sh",
+        "scripts/02-firewall.sh",
+        "scripts/03-init-start.sh",
+        "scripts/90-cleanup.sh",
+        "scripts/99-img-check.sh"
+      ]
+    }
+  ]
+}

scripts/smp-server-digitalocean-droplet/scripts/01-packages.sh

@@ -0,0 +1,8 @@
+#!/bin/sh
+
+# update apt
+apt-get -y update
+apt-get -y upgrade
+
+# packages needed for smp-server init-start.sh
+apt-get install -y jq

scripts/smp-server-digitalocean-droplet/scripts/02-firewall.sh

@@ -0,0 +1,9 @@
+#!/bin/sh
+
+# add firewall
+echo "y" | ufw enable
+
+# open ports
+ufw allow ssh
+ufw allow http
+ufw allow 5223

scripts/smp-server-digitalocean-droplet/scripts/03-init-start.sh

@@ -0,0 +1,53 @@
+#!/bin/bash
+
+bin_dir="/opt/simplex/bin"
+conf_dir="/etc/opt/simplex"
+var_dir="/var/opt/simplex"
+mkdir -p $bin_dir
+mkdir -p $conf_dir
+mkdir -p $var_dir
+
+echo "downloading SMP server release $release_tag"
+curl -s https://api.github.com/repos/simplex-chat/simplexmq/releases/tags/{$release_tag} \
+| jq -r '.assets[].browser_download_url | select(test("smp-server-ubuntu-20_04-x86-64"))' \
+| tr -d \" \
+| wget -qi -
+
+echo "preparing for SMP server initiaization"
+mv smp-server-ubuntu-20_04-x86-64 $bin_dir/smp-server
+chmod +x $bin_dir/smp-server
+
+cat <<EOT >> /etc/profile.d/simplex.sh
+#!/bin/bash
+
+export PATH="$PATH:$bin_dir"
+
+EOT
+source /etc/profile.d/simplex.sh
+
+# prepare SMP server systemd service
+cat <<EOT >> /etc/systemd/system/smp-server.service
+[Unit]
+Description=SMP server systemd service
+
+[Service]
+Type=simple
+ExecStart=/bin/sh -c "$bin_dir/smp-server start"
+
+[Install]
+WantedBy=multi-user.target
+
+EOT
+chmod 644 /etc/systemd/system/smp-server.service
+
+echo "initializing SMP server"
+hash_file="$conf_dir/pubkey_hash"
+smp-server init -l | grep "transport key hash:" | cut -f2 -d":" | xargs > $hash_file
+# turn off websockets support
+sed -e '/websockets/s/^/# /g' -i $conf_dir/smp-server.ini
+# add welcome script to .bashrc
+echo "bash /opt/simplex/on_login.sh $hash_file" >> /root/.bashrc
+
+echo "starting SMP server"
+sudo systemctl enable smp-server
+sudo systemctl start smp-server

scripts/smp-server-digitalocean-droplet/scripts/90-cleanup.sh

@@ -0,0 +1,60 @@
+#!/bin/bash
+
+# DigitalOcean Marketplace Image Validation Tool
+# © 2021 DigitalOcean LLC.
+# This code is licensed under Apache 2.0 license (see LICENSE.md for details)
+
+set -o errexit
+
+# Ensure /tmp exists and has the proper permissions before
+# checking for security updates
+# https://github.com/digitalocean/marketplace-partners/issues/94
+if [[ ! -d /tmp ]]; then
+  mkdir /tmp
+fi
+chmod 1777 /tmp
+
+if [ -n "$(command -v yum)" ]; then
+  yum update -y
+  yum clean all
+elif [ -n "$(command -v apt-get)" ]; then
+  apt-get -y update
+  apt-get -y upgrade
+  apt-get -y autoremove
+  apt-get -y autoclean
+fi
+
+rm -rf /tmp/* /var/tmp/*
+history -c
+cat /dev/null > /root/.bash_history
+unset HISTFILE
+find /var/log -mtime -1 -type f -exec truncate -s 0 {} \;
+rm -rf /var/log/*.gz /var/log/*.[0-9] /var/log/*-????????
+rm -rf /var/lib/cloud/instances/*
+rm -f /root/.ssh/authorized_keys /etc/ssh/*key*
+touch /etc/ssh/revoked_keys
+chmod 600 /etc/ssh/revoked_keys
+
+# Securely erase the unused portion of the filesystem
+GREEN='\033[0;32m'
+NC='\033[0m'
+printf "\n${GREEN}Writing zeros to the remaining disk space to securely
+erase the unused portion of the file system.
+Depending on your disk size this may take several minutes.
+The secure erase will complete successfully when you see:${NC}
+    dd: writing to '/zerofile': No space left on device\n
+Beginning secure erase now\n"
+
+dd if=/dev/zero of=/zerofile &
+  PID=$!
+  while [ -d /proc/$PID ]
+    do
+      printf "."
+      sleep 5
+    done
+sync; rm /zerofile; sync
+cat /dev/null > /var/log/lastlog; cat /dev/null > /var/log/wtmp
+
+rm /var/log/auth.log
+rm /var/log/kern.log
+rm /var/log/ufw.log

scripts/smp-server-digitalocean-droplet/scripts/99-img-check.sh

@@ -0,0 +1,682 @@
+#!/bin/bash
+
+# DigitalOcean Marketplace Image Validation Tool
+# © 2021 DigitalOcean LLC.
+# This code is licensed under Apache 2.0 license (see LICENSE.md for details)
+
+VERSION="v. 1.6"
+RUNDATE=$( date )
+
+# Script should be run with SUDO
+if [ "$EUID" -ne 0 ]
+  then echo "[Error] - This script must be run with sudo or as the root user."
+  exit 1
+fi
+
+STATUS=0
+PASS=0
+WARN=0
+FAIL=0
+
+# $1 == command to check for
+# returns: 0 == true, 1 == false
+cmdExists() {
+    if command -v "$1" > /dev/null 2>&1; then
+        return 0
+    else
+        return 1
+    fi
+}
+
+function getDistro {
+    if [ -f /etc/os-release ]; then
+    # freedesktop.org and systemd
+    . /etc/os-release
+    OS=$NAME
+    VER=$VERSION_ID
+elif type lsb_release >/dev/null 2>&1; then
+    # linuxbase.org
+    OS=$(lsb_release -si)
+    VER=$(lsb_release -sr)
+elif [ -f /etc/lsb-release ]; then
+    # For some versions of Debian/Ubuntu without lsb_release command
+    . /etc/lsb-release
+    OS=$DISTRIB_ID
+    VER=$DISTRIB_RELEASE
+elif [ -f /etc/debian_version ]; then
+    # Older Debian/Ubuntu/etc.
+    OS=Debian
+    VER=$(cat /etc/debian_version)
+elif [ -f /etc/SuSe-release ]; then
+    # Older SuSE/etc.
+    :
+elif [ -f /etc/redhat-release ]; then
+    # Older Red Hat, CentOS, etc.
+    VER=$( cat /etc/redhat-release | cut -d" " -f3 | cut -d "." -f1)
+    d=$( cat /etc/redhat-release | cut -d" " -f1 | cut -d "." -f1)
+    if [[ $d == "CentOS" ]]; then
+      OS="CentOS Linux"
+    fi
+else
+    # Fall back to uname, e.g. "Linux <version>", also works for BSD, etc.
+    OS=$(uname -s)
+    VER=$(uname -r)
+fi
+}
+function loadPasswords {
+SHADOW=$(cat /etc/shadow)
+}
+
+function checkAgent {
+  # Check for the presence of the do-agent in the filesystem
+  if [ -d /var/opt/digitalocean/do-agent ];then
+     echo -en "\e[41m[FAIL]\e[0m DigitalOcean Monitoring Agent detected.\n"
+            ((FAIL++))
+            STATUS=2
+      if [[ $OS == "CentOS Linux" ]]; then
+        echo "The agent can be removed with 'sudo yum remove do-agent' "
+      elif [[ $OS == "Ubuntu" ]]; then
+        echo "The agent can be removed with 'sudo apt-get purge do-agent' "
+      fi
+  else
+    echo -en "\e[32m[PASS]\e[0m DigitalOcean Monitoring agent was not found\n"
+    ((PASS++))
+  fi
+}
+
+function checkLogs {
+    cp_ignore="/var/log/cpanel-install.log"
+    echo -en "\nChecking for log files in /var/log\n\n"
+    # Check if there are log archives or log files that have not been recently cleared.
+    for f in /var/log/*-????????; do
+      [[ -e $f ]] || break
+      if [ $f != $cp_ignore ]; then
+        echo -en "\e[93m[WARN]\e[0m Log archive ${f} found\n"
+        ((WARN++))
+        if [[ $STATUS != 2 ]]; then
+            STATUS=1
+        fi
+      fi
+    done
+    for f in  /var/log/*.[0-9];do
+      [[ -e $f ]] || break
+        echo -en "\e[93m[WARN]\e[0m Log archive ${f} found\n"
+        ((WARN++))
+        if [[ $STATUS != 2 ]]; then
+            STATUS=1
+        fi
+    done
+    for f in /var/log/*.log; do
+      [[ -e $f ]] || break
+      if [[ "${f}" = '/var/log/lfd.log' && "$( cat "${f}" | egrep -v '/var/log/messages has been reset| Watching /var/log/messages' | wc -c)" -gt 50 ]]; then
+        if [ $f != $cp_ignore ]; then
+        echo -en "\e[93m[WARN]\e[0m un-cleared log file, ${f} found\n"
+        ((WARN++))
+        if [[ $STATUS != 2 ]]; then
+            STATUS=1
+        fi
+      fi
+      elif [[ "${f}" != '/var/log/lfd.log' && "$( cat "${f}" | wc -c)" -gt 50 ]]; then
+      if [ $f != $cp_ignore ]; then
+        echo -en "\e[93m[WARN]\e[0m un-cleared log file, ${f} found\n"
+        ((WARN++))
+        if [[ $STATUS != 2 ]]; then
+            STATUS=1
+        fi
+      fi
+    fi
+    done
+}
+function checkTMP {
+  # Check the /tmp directory to ensure it is empty.  Warn on any files found.
+  return 1
+}
+function checkRoot {
+    user="root"
+    uhome="/root"
+    for usr in $SHADOW
+    do
+      IFS=':' read -r -a u <<< "$usr"
+      if [[ "${u[0]}" == "${user}" ]]; then
+        if [[ ${u[1]} == "!" ]] || [[ ${u[1]} == "!!" ]] || [[ ${u[1]} == "*" ]]; then
+            echo -en "\e[32m[PASS]\e[0m User ${user} has no password set.\n"
+            ((PASS++))
+        else
+            echo -en "\e[41m[FAIL]\e[0m User ${user} has a password set on their account.\n"
+            ((FAIL++))
+            STATUS=2
+        fi
+      fi
+    done
+    if [ -d ${uhome}/ ]; then
+            if [ -d ${uhome}/.ssh/ ]; then
+                if  ls ${uhome}/.ssh/*> /dev/null 2>&1; then
+                    for key in ${uhome}/.ssh/*
+                        do
+                             if  [ "${key}" == "${uhome}/.ssh/authorized_keys" ]; then
+
+                                if [ "$( cat "${key}" | wc -c)" -gt 50 ]; then
+                                    echo -en "\e[41m[FAIL]\e[0m User \e[1m${user}\e[0m has a populated authorized_keys file in \e[93m${key}\e[0m\n"
+                                    akey=$(cat ${key})
+                                    echo "File Contents:"
+                                    echo $akey
+                                    echo "--------------"
+                                    ((FAIL++))
+                                    STATUS=2
+                                fi
+                            elif  [ "${key}" == "${uhome}/.ssh/id_rsa" ]; then
+                                if [ "$( cat "${key}" | wc -c)" -gt 0 ]; then
+                                  echo -en "\e[41m[FAIL]\e[0m User \e[1m${user}\e[0m has a private key file in \e[93m${key}\e[0m\n"
+                                      akey=$(cat ${key})
+                                      echo "File Contents:"
+                                      echo $akey
+                                      echo "--------------"
+                                      ((FAIL++))
+                                      STATUS=2
+                                else
+                                  echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has empty private key file in \e[93m${key}\e[0m\n"
+                                  ((WARN++))
+                                  if [[ $STATUS != 2 ]]; then
+                                    STATUS=1
+                                  fi
+                                fi
+                            elif  [ "${key}" != "${uhome}/.ssh/known_hosts" ]; then
+                                 echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has a file in their .ssh directory at \e[93m${key}\e[0m\n"
+                                    ((WARN++))
+                                    if [[ $STATUS != 2 ]]; then
+                                        STATUS=1
+                                    fi
+                            else
+                                if [ "$( cat "${key}" | wc -c)" -gt 50 ]; then
+                                    echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has a populated known_hosts file in \e[93m${key}\e[0m\n"
+                                    ((WARN++))
+                                    if [[ $STATUS != 2 ]]; then
+                                        STATUS=1
+                                    fi
+                                fi
+                            fi
+                        done
+                else
+                    echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m has no SSH keys present\n"
+                fi
+            else
+                echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m does not have an .ssh directory\n"
+            fi
+             if [ -f /root/.bash_history ];then
+
+                      BH_S=$( cat /root/.bash_history | wc -c)
+
+                      if [[ $BH_S -lt 200 ]]; then
+                          echo -en "\e[32m[PASS]\e[0m ${user}'s Bash History appears to have been cleared\n"
+                          ((PASS++))
+                      else
+                          echo -en "\e[41m[FAIL]\e[0m ${user}'s Bash History should be cleared to prevent sensitive information from leaking\n"
+                          ((FAIL++))
+                              STATUS=2
+                      fi
+
+                      return 1;
+                  else
+                      echo -en "\e[32m[PASS]\e[0m The Root User's Bash History is not present\n"
+                      ((PASS++))
+                  fi
+        else
+            echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m does not have a directory in /home\n"
+        fi
+        echo -en "\n\n"
+    return 1
+}
+
+function checkUsers {
+    # Check each user-created account
+    for user in $(awk -F: '$3 >= 1000 && $1 != "nobody" {print $1}' /etc/passwd;)
+    do
+      # Skip some other non-user system accounts
+      if [[ $user == "centos" ]]; then
+        :
+      elif [[ $user == "nfsnobody" ]]; then
+        :
+    else
+      echo -en "\nChecking user: ${user}...\n"
+      for usr in $SHADOW
+        do
+          IFS=':' read -r -a u <<< "$usr"
+          if [[ "${u[0]}" == "${user}" ]]; then
+              if [[ ${u[1]} == "!" ]] || [[ ${u[1]} == "!!" ]] || [[ ${u[1]} == "*" ]]; then
+                  echo -en "\e[32m[PASS]\e[0m User ${user} has no password set.\n"
+                  ((PASS++))
+              else
+                  echo -en "\e[41m[FAIL]\e[0m User ${user} has a password set on their account. Only system users are allowed on the image.\n"
+                  ((FAIL++))
+                  STATUS=2
+              fi
+          fi
+        done
+        #echo "User Found: ${user}"
+        uhome="/home/${user}"
+        if [ -d "${uhome}/" ]; then
+            if [ -d "${uhome}/.ssh/" ]; then
+                if  ls "${uhome}/.ssh/*"> /dev/null 2>&1; then
+                    for key in ${uhome}/.ssh/*
+                        do
+                            if  [ "${key}" == "${uhome}/.ssh/authorized_keys" ]; then
+                                if [ "$( cat "${key}" | wc -c)" -gt 50 ]; then
+                                    echo -en "\e[41m[FAIL]\e[0m User \e[1m${user}\e[0m has a populated authorized_keys file in \e[93m${key}\e[0m\n"
+                                    akey=$(cat ${key})
+                                    echo "File Contents:"
+                                    echo $akey
+                                    echo "--------------"
+                                    ((FAIL++))
+                                    STATUS=2
+                                fi
+                              elif  [ "${key}" == "${uhome}/.ssh/id_rsa" ]; then
+                                if [ "$( cat "${key}" | wc -c)" -gt 0 ]; then
+                                  echo -en "\e[41m[FAIL]\e[0m User \e[1m${user}\e[0m has a private key file in \e[93m${key}\e[0m\n"
+                                      akey=$(cat ${key})
+                                      echo "File Contents:"
+                                      echo $akey
+                                      echo "--------------"
+                                      ((FAIL++))
+                                      STATUS=2
+                                else
+                                  echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has empty private key file in \e[93m${key}\e[0m\n"
+                                  ((WARN++))
+                                  if [[ $STATUS != 2 ]]; then
+                                    STATUS=1
+                                  fi
+                                fi
+                            elif  [ "${key}" != "${uhome}/.ssh/known_hosts" ]; then
+
+                                 echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has a file in their .ssh directory named \e[93m${key}\e[0m\n"
+                                 ((WARN++))
+                                 if [[ $STATUS != 2 ]]; then
+                                        STATUS=1
+                                    fi
+
+                            else
+                                if [ "$( cat "${key}" | wc -c)" -gt 50 ]; then
+                                    echo -en "\e[93m[WARN]\e[0m User \e[1m${user}\e[0m has a known_hosts file in \e[93m${key}\e[0m\n"
+                                    ((WARN++))
+                                    if [[ $STATUS != 2 ]]; then
+                                        STATUS=1
+                                    fi
+                                fi
+                            fi
+
+
+                        done
+                else
+                    echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m has no SSH keys present\n"
+                fi
+            else
+                echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m does not have an .ssh directory\n"
+            fi
+        else
+            echo -en "\e[32m[ OK ]\e[0m User \e[1m${user}\e[0m does not have a directory in /home\n"
+        fi
+
+         # Check for an uncleared .bash_history for this user
+              if [ -f "${uhome}/.bash_history" ]; then
+                            BH_S=$( cat "${uhome}/.bash_history" | wc -c )
+
+                            if [[ $BH_S -lt 200 ]]; then
+                                echo -en "\e[32m[PASS]\e[0m ${user}'s Bash History appears to have been cleared\n"
+                                ((PASS++))
+                            else
+                                echo -en "\e[41m[FAIL]\e[0m ${user}'s Bash History should be cleared to prevent sensitive information from leaking\n"
+                                ((FAIL++))
+                                    STATUS=2
+
+                            fi
+                           echo -en "\n\n"
+                         fi
+        fi
+    done
+}
+function checkFirewall {
+
+    if [[ $OS == "Ubuntu" ]]; then
+      fw="ufw"
+      ufwa=$(ufw status |head -1| sed -e "s/^Status:\ //")
+      if [[ $ufwa == "active" ]]; then
+        FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+      else
+        FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+      fi
+    elif [[ $OS == "CentOS Linux" ]]; then
+      if [ -f /usr/lib/systemd/system/csf.service ]; then
+        fw="csf"
+        if [[ $(systemctl status $fw >/dev/null 2>&1) ]]; then
+
+        FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+        elif cmdExists "firewall-cmd"; then
+          if [[ $(systemctl is-active firewalld >/dev/null 2>&1 && echo 1 || echo 0) ]]; then
+           FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+          ((PASS++))
+          else
+            FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+          ((WARN++))
+          fi
+        else
+          FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+        fi
+      else
+        fw="firewalld"
+        if [[ $(systemctl is-active firewalld >/dev/null 2>&1 && echo 1 || echo 0) ]]; then
+          FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+        else
+          FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+        fi
+      fi
+    elif [[ "$OS" =~ Debian.* ]]; then
+      # user could be using a number of different services for managing their firewall
+      # we will check some of the most common
+      if cmdExists 'ufw'; then
+        fw="ufw"
+        ufwa=$(ufw status |head -1| sed -e "s/^Status:\ //")
+        if [[ $ufwa == "active" ]]; then
+        FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+      else
+        FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+      fi
+      elif cmdExists "firewall-cmd"; then
+        fw="firewalld"
+        if [[ $(systemctl is-active --quiet $fw) ]]; then
+          FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+        else
+          FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+        fi
+      else
+        # user could be using vanilla iptables, check if kernel module is loaded
+        fw="iptables"
+        if [[ $(lsmod | grep -q '^ip_tables' 2>/dev/null) ]]; then
+          FW_VER="\e[32m[PASS]\e[0m Firewall service (${fw}) is active\n"
+        ((PASS++))
+        else
+          FW_VER="\e[93m[WARN]\e[0m No firewall is configured. Ensure ${fw} is installed and configured\n"
+        ((WARN++))
+        fi
+      fi
+    fi
+
+}
+function checkUpdates {
+    if [[ $OS == "Ubuntu" ]] || [[ "$OS" =~ Debian.* ]]; then
+        # Ensure /tmp exists and has the proper permissions before
+        # checking for security updates
+        # https://github.com/digitalocean/marketplace-partners/issues/94
+        if [[ ! -d /tmp ]]; then
+          mkdir /tmp
+        fi
+        chmod 1777 /tmp
+
+        echo -en "\nUpdating apt package database to check for security updates, this may take a minute...\n\n"
+        apt-get -y update > /dev/null
+
+        uc=$(apt-get --just-print upgrade | grep -i "security" | wc -l)
+        if [[ $uc -gt 0 ]]; then
+          update_count=$(( ${uc} / 2 ))
+        else
+          update_count=0
+        fi
+
+        if [[ $update_count -gt 0 ]]; then
+            echo -en "\e[41m[FAIL]\e[0m There are ${update_count} security updates available for this image that have not been installed.\n"
+            echo -en
+            echo -en "Here is a list of the security updates that are not installed:\n"
+            sleep 2
+            apt-get --just-print upgrade | grep -i security | awk '{print $2}' | awk '!seen[$0]++'
+            echo -en
+            ((FAIL++))
+            STATUS=2
+        else
+            echo -en "\e[32m[PASS]\e[0m There are no pending security updates for this image.\n\n"
+        fi
+    elif [[ $OS == "CentOS Linux" ]]; then
+        echo -en "\nChecking for available security updates, this may take a minute...\n\n"
+
+        update_count=$(yum check-update --security --quiet | wc -l)
+         if [[ $update_count -gt 0 ]]; then
+            echo -en "\e[41m[FAIL]\e[0m There are ${update_count} security updates available for this image that have not been installed.\n"
+            ((FAIL++))
+            STATUS=2
+        else
+            echo -en "\e[32m[PASS]\e[0m There are no pending security updates for this image.\n"
+            ((PASS++))
+        fi
+    else
+        echo "Error encountered"
+        exit 1
+    fi
+
+    return 1;
+}
+function checkCloudInit {
+
+    if hash cloud-init 2>/dev/null; then
+        CI="\e[32m[PASS]\e[0m Cloud-init is installed.\n"
+        ((PASS++))
+    else
+        CI="\e[41m[FAIL]\e[0m No valid verison of cloud-init was found.\n"
+        ((FAIL++))
+        STATUS=2
+    fi
+    return 1
+}
+function checkMongoDB {
+  # Check if MongoDB is installed
+  # If it is, verify the version is allowed (non-SSPL)
+
+   if [[ $OS == "Ubuntu" ]] || [[ "$OS" =~ Debian.* ]]; then
+
+     if [[ -f "/usr/bin/mongod" ]]; then
+       version=$(/usr/bin/mongod --version --quiet | grep "db version" | sed -e "s/^db\ version\ v//")
+
+      if version_gt $version 4.0.0; then
+        if version_gt $version 4.0.3; then
+          echo -en "\e[41m[FAIL]\e[0m An SSPL version of MongoDB is present, ${version}"
+          ((FAIL++))
+           STATUS=2
+        else
+          echo -en "\e[32m[PASS]\e[0m The version of MongoDB installed, ${version} is not under the SSPL"
+          ((PASS++))
+        fi
+      else
+         if version_gt $version 3.6.8; then
+          echo -en "\e[41m[FAIL]\e[0m An SSPL version of MongoDB is present, ${version}"
+          ((FAIL++))
+           STATUS=2
+        else
+          echo -en "\e[32m[PASS]\e[0m The version of MongoDB installed, ${version} is not under the SSPL"
+          ((PASS++))
+        fi
+      fi
+
+
+     else
+       echo -en "\e[32m[PASS]\e[0m MongoDB is not installed"
+       ((PASS++))
+     fi
+
+   elif [[ $OS == "CentOS Linux" ]]; then
+
+    if [[ -f "/usr/bin/mongod" ]]; then
+       version=$(/usr/bin/mongod --version --quiet | grep "db version" | sed -e "s/^db\ version\ v//")
+
+
+       if version_gt $version 4.0.0; then
+        if version_gt $version 4.0.3; then
+          echo -en "\e[41m[FAIL]\e[0m An SSPL version of MongoDB is present"
+          ((FAIL++))
+           STATUS=2
+        else
+          echo -en "\e[32m[PASS]\e[0m The version of MongoDB installed is not under the SSPL"
+          ((PASS++))
+        fi
+      else
+         if version_gt $version 3.6.8; then
+          echo -en "\e[41m[FAIL]\e[0m An SSPL version of MongoDB is present"
+          ((FAIL++))
+           STATUS=2
+        else
+          echo -en "\e[32m[PASS]\e[0m The version of MongoDB installed is not under the SSPL"
+          ((PASS++))
+        fi
+      fi
+
+
+
+     else
+       echo -en "\e[32m[PASS]\e[0m MongoDB is not installed"
+       ((PASS++))
+     fi
+
+  else
+    echo "ERROR: Unable to identify distribution"
+    ((FAIL++))
+    STATUS 2
+    return 1
+  fi
+
+
+}
+
+function version_gt() { test "$(printf '%s\n' "$@" | sort -V | head -n 1)" != "$1"; }
+
+
+clear
+echo "DigitalOcean Marketplace Image Validation Tool ${VERSION}"
+echo "Executed on: ${RUNDATE}"
+echo "Checking local system for Marketplace compatibility..."
+
+getDistro
+
+echo -en "\n\e[1mDistribution:\e[0m ${OS}\n"
+echo -en "\e[1mVersion:\e[0m ${VER}\n\n"
+
+ost=0
+osv=0
+
+if [[ $OS == "Ubuntu" ]]; then
+        ost=1
+    if [[ $VER == "20.04" ]]; then
+        osv=1
+    elif [[ $VER == "18.04" ]]; then
+        osv=1
+    elif [[ $VER == "16.04" ]]; then
+        osv=1
+    else
+        osv=0
+    fi
+
+elif [[ "$OS" =~ Debian.* ]]; then
+    ost=1
+    case "$VER" in
+        9)
+            osv=1
+            ;;
+        10)
+            osv=1
+            ;;
+        *)
+            osv=2
+            ;;
+    esac
+
+elif [[ $OS == "CentOS Linux" ]]; then
+        ost=1
+    if [[ $VER == "8" ]]; then
+        osv=1
+    elif [[ $VER == "7" ]]; then
+        osv=1
+    elif [[ $VER == "6" ]]; then
+        osv=1
+    else
+        osv=2
+    fi
+else
+    ost=0
+fi
+
+if [[ $ost == 1 ]]; then
+    echo -en "\e[32m[PASS]\e[0m Supported Operating System Detected: ${OS}\n"
+    ((PASS++))
+else
+    echo -en "\e[41m[FAIL]\e[0m ${OS} is not a supported Operating System\n"
+    ((FAIL++))
+    STATUS=2
+fi
+
+if [[ $osv == 1 ]]; then
+    echo -en "\e[32m[PASS]\e[0m Supported Release Detected: ${VER}\n"
+    ((PASS++))
+elif [[ $ost == 1 ]]; then
+    echo -en "\e[41m[FAIL]\e[0m ${OS} ${VER} is not a supported Operating System Version\n"
+    ((FAIL++))
+    STATUS=2
+else
+    echo "Exiting..."
+    exit 1
+fi
+
+checkCloudInit
+
+echo -en "${CI}"
+
+checkFirewall
+
+echo -en "${FW_VER}"
+
+checkUpdates
+
+loadPasswords
+
+checkLogs
+
+echo -en "\n\nChecking all user-created accounts...\n"
+checkUsers
+
+echo -en "\n\nChecking the root account...\n"
+checkRoot
+
+checkAgent
+
+checkMongoDB
+
+
+# Summary
+echo -en "\n\n---------------------------------------------------------------------------------------------------\n"
+
+if [[ $STATUS == 0 ]]; then
+    echo -en "Scan Complete.\n\e[32mAll Tests Passed!\e[0m\n"
+elif [[ $STATUS == 1 ]]; then
+    echo -en "Scan Complete. \n\e[93mSome non-critical tests failed.  Please review these items.\e[0m\e[0m\n"
+else
+    echo -en "Scan Complete. \n\e[41mOne or more tests failed.  Please review these items and re-test.\e[0m\n"
+fi
+echo "---------------------------------------------------------------------------------------------------"
+echo -en "\e[1m${PASS} Tests PASSED\e[0m\n"
+echo -en "\e[1m${WARN} WARNINGS\e[0m\n"
+echo -en "\e[1m${FAIL} Tests FAILED\e[0m\n"
+echo -en "---------------------------------------------------------------------------------------------------\n"
+
+if [[ $STATUS == 0 ]]; then
+    echo -en "We did not detect any issues with this image. Please be sure to manually ensure that all software installed on the base system is functional, secure and properly configured (or facilities for configuration on first-boot have been created).\n\n"
+    exit 0
+elif [[ $STATUS == 1 ]]; then
+    echo -en "Please review all [WARN] items above and ensure they are intended or resolved.  If you do not have a specific requirement, we recommend resolving these items before image submission\n\n"
+    exit 0
+else
+    echo -en "Some critical tests failed.  These items must be resolved and this scan re-run before you submit your image to the DigitalOcean Marketplace.\n\n"
+    exit 1
+fi

scripts/smp-server-linode.sh

@@ -0,0 +1,125 @@
+#!/bin/bash
+# <UDF name="enable_store_log" label="Store log - persists SMP queues to append only log and restores them upon server restart." default="on" oneof="on, off" />
+# <UDF name="api_token" label="Linode API token - enables StackScript to create tags containing SMP server domain/ip address, transport key hash and server version. Use `domain#hash` or `ip#hash` as SMP server address in the client. Note: minimal permissions token should have are - read/write access to `linodes` (to update linode tags - you need them) and `domains` (to add A record for the chosen 3rd level domain)" default="" />
+# <UDF name="fqdn" label="FQDN (Fully qualified domain name) - provide third level domain name (ex: smp.example.com). If provided can be used instead of ip address." default="" />
+
+# log all stdout output to stackscript.log
+exec &> >(tee -i /var/log/stackscript.log)
+# uncomment next line to enable debugging features
+# set -xeo pipefail
+
+cd $HOME
+
+sudo apt-get -y update 
+sudo apt-get -y upgrade
+sudo apt-get install -y jq
+
+# add firewall
+echo "y" | ufw enable
+# open ports
+ufw allow ssh
+ufw allow http
+ufw allow 5223
+
+bin_dir="/opt/simplex/bin"
+conf_dir="/etc/opt/simplex"
+var_dir="/var/opt/simplex"
+mkdir -p $bin_dir
+mkdir -p $conf_dir
+mkdir -p $var_dir
+
+# retrieve latest release info and download smp-server executable
+curl -s https://api.github.com/repos/simplex-chat/simplexmq/releases/latest > release.json
+jq '.assets[].browser_download_url | select(test("smp-server-ubuntu-20_04-x86-64"))' release.json \
+| tr -d \" \
+| wget -qi -
+
+mv smp-server-ubuntu-20_04-x86-64 $bin_dir/smp-server
+chmod +x $bin_dir/smp-server
+
+cat <<EOT >> /etc/profile.d/simplex.sh
+#!/bin/bash
+
+export PATH="$PATH:$bin_dir"
+
+EOT
+source /etc/profile.d/simplex.sh
+
+# initialize SMP server
+init_opts=()
+[[ $ENABLE_STORE_LOG == "on" ]] && init_opts+=(-l)
+hash_file="$conf_dir/pubkey_hash"
+smp-server init "${init_opts[@]}" | grep "transport key hash:" | cut -f2 -d":" | xargs > $hash_file
+# turn off websockets support
+sed -e '/websockets/s/^/# /g' -i $conf_dir/smp-server.ini
+# create script that will run on login
+on_login_script="/opt/simplex/on_login.sh"
+cat <<EOT >> $on_login_script
+#!/bin/bash
+# receives pubkey_hash file location as the first parameter
+
+ip_address=\$(hostname -I | awk '{print\$1}')
+hash=\$(cat \$1)
+
+cat <<EOF
+********************************************************************************
+
+SMP server address: \$ip_address#\$hash
+Check SMP server status with: systemctl status smp-server
+
+To keep this server secure, the UFW firewall is enabled.
+All ports are BLOCKED except 22 (SSH), 80 (HTTP), 5223 (SMP server).
+
+********************************************************************************
+To stop seeing this message delete line - bash /opt/simplex/on_login.sh - from /root/.bashrc
+EOF
+
+EOT
+chmod +x $on_login_script
+echo "bash $on_login_script $hash_file" >> /root/.bashrc
+
+# create A record and update linode's tags
+if [ ! -z "$API_TOKEN" ]; then
+     ip_address=$(curl ifconfig.me)
+     address=$ip_address
+     if [ ! -z "$FQDN" ]; then
+          domain_address=$(echo $FQDN | rev | cut -d "." -f 1,2 | rev)
+          domain_id=$(curl -H "Authorization: Bearer $API_TOKEN" https://api.linode.com/v4/domains \
+          | jq --arg da "$domain_address" '.data[] | select( .domain == $da ) | .id')
+          if [[ ! -z $domain_id ]]; then
+               curl -s -H "Content-Type: application/json" \
+                    -H "Authorization: Bearer $API_TOKEN" \
+                    -X POST -d "{\"type\":\"A\",\"name\":\"$FQDN\",\"target\":\"$ip_address\"}" \
+                    https://api.linode.com/v4/domains/${domain_id}/records
+               address=$FQDN
+          fi
+     fi
+
+     hash=$(cat $hash_file)
+     release_version=$(jq '.tag_name' release.json | tr -d \")
+
+     curl -s -H "Content-Type: application/json" \
+          -H "Authorization: Bearer $API_TOKEN" \
+          -X PUT -d "{\"tags\":[\"$address\",\"#$hash\",\"$release_version\"]}" \
+          https://api.linode.com/v4/linode/instances/$LINODE_ID
+fi
+
+# create, enable and start SMP server systemd service
+cat <<EOT >> /etc/systemd/system/smp-server.service
+[Unit]
+Description=SMP server systemd service
+
+[Service]
+Type=simple
+ExecStart=/bin/sh -c "$bin_dir/smp-server start"
+
+[Install]
+WantedBy=multi-user.target
+
+EOT
+chmod 644 /etc/systemd/system/smp-server.service
+sudo systemctl enable smp-server
+sudo systemctl start smp-server
+
+# cleanup
+rm release.json

simplexmq.cabal

@@ -0,0 +1,254 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 706d2f9155c3f3be0f08ea0d6c8954c0e2b9a6e22615f7b19499a3a349af7cc9
+
+name:           simplexmq
+version:        0.4.1
+synopsis:       SimpleXMQ message broker
+description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
+                <./docs/Simplex-Messaging-Client.html client> and
+                <./docs/Simplex-Messaging-Agent.html agent> for SMP protocols:
+                .
+                * <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md SMP protocol>
+                * <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md SMP agent protocol>
+                .
+                See <https://github.com/simplex-chat/simplex-chat terminal chat prototype> built with SimpleXMQ broker.
+category:       Chat, Network, Web, System, Cryptography
+homepage:       https://github.com/simplex-chat/simplexmq#readme
+author:         simplex.chat
+maintainer:     [email protected]
+copyright:      2020 simplex.chat
+license:        AGPL-3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    CHANGELOG.md
+    migrations/20210101_initial.sql
+    migrations/20210624_confirmations.sql
+    migrations/20210809_snd_messages.sql
+    migrations/README.md
+
+library
+  exposed-modules:
+      Simplex.Messaging.Agent
+      Simplex.Messaging.Agent.Client
+      Simplex.Messaging.Agent.Env.SQLite
+      Simplex.Messaging.Agent.Protocol
+      Simplex.Messaging.Agent.RetryInterval
+      Simplex.Messaging.Agent.Store
+      Simplex.Messaging.Agent.Store.SQLite
+      Simplex.Messaging.Agent.Store.SQLite.Migrations
+      Simplex.Messaging.Client
+      Simplex.Messaging.Crypto
+      Simplex.Messaging.Parsers
+      Simplex.Messaging.Protocol
+      Simplex.Messaging.Server
+      Simplex.Messaging.Server.Env.STM
+      Simplex.Messaging.Server.MsgStore
+      Simplex.Messaging.Server.MsgStore.STM
+      Simplex.Messaging.Server.QueueStore
+      Simplex.Messaging.Server.QueueStore.STM
+      Simplex.Messaging.Server.StoreLog
+      Simplex.Messaging.Transport
+      Simplex.Messaging.Transport.WebSockets
+      Simplex.Messaging.Util
+  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
+  build-depends:
+      QuickCheck ==2.14.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , file-embed ==0.0.14.*
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.*
+    , network-transport ==0.5.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+  default-language: Haskell2010
+
+executable smp-agent
+  main-is: Main.hs
+  other-modules:
+      Paths_simplexmq
+  hs-source-dirs:
+      apps/smp-agent
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  build-depends:
+      QuickCheck ==2.14.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , file-embed ==0.0.14.*
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.*
+    , network-transport ==0.5.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , simplexmq
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+  default-language: Haskell2010
+
+executable smp-server
+  main-is: Main.hs
+  other-modules:
+      Paths_simplexmq
+  hs-source-dirs:
+      apps/smp-server
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  build-depends:
+      QuickCheck ==2.14.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , file-embed ==0.0.14.*
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , ini ==0.4.*
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.*
+    , network-transport ==0.5.*
+    , optparse-applicative >=0.15 && <0.17
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , simplexmq
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+  default-language: Haskell2010
+
+test-suite smp-server-test
+  type: exitcode-stdio-1.0
+  main-is: Test.hs
+  other-modules:
+      AgentTests
+      AgentTests.FunctionalAPITests
+      AgentTests.SQLiteTests
+      ProtocolErrorTests
+      ServerTests
+      SMPAgentClient
+      SMPClient
+      Paths_simplexmq
+  hs-source-dirs:
+      tests
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
+  build-depends:
+      HUnit ==1.6.*
+    , QuickCheck ==2.14.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.13.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , file-embed ==0.0.14.*
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , hspec ==2.7.*
+    , hspec-core ==2.7.*
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.*
+    , network-transport ==0.5.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , simplexmq
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , timeit ==2.0.*
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+  default-language: Haskell2010

src/Simplex/Messaging/Agent.hs

@@ -1,12 +1,17 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 
 -- |
 -- Module      : Simplex.Messaging.Agent
@@ -21,10 +26,29 @@
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md
 module Simplex.Messaging.Agent
-  ( runSMPAgent,
+  ( -- * SMP agent over TCP
+    runSMPAgent,
     runSMPAgentBlocking,
+
+    -- * queue-based SMP agent
+    getAgentClient,
+    runAgentClient,
+
+    -- * SMP agent functional API
+    AgentClient (..),
+    AgentMonad,
+    AgentErrorMonad,
     getSMPAgentClient,
-    runSMPAgentClient,
+    disconnectAgentClient, -- used in tests
+    withAgentLock,
+    createConnection,
+    joinConnection,
+    acceptConnection,
+    subscribeConnection,
+    sendMessage,
+    ackMessage,
+    suspendConnection,
+    deleteConnection,
   )
 where
 
@@ -34,10 +58,16 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
+import Data.Bifunctor (second)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Composition ((.:), (.:.))
+import Data.Functor (($>))
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Maybe (isJust)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8)
 import Data.Time.Clock
@@ -45,16 +75,17 @@ import Database.SQLite.Simple (SQLError)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
-import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore, connectSQLiteStore)
+import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
 import Simplex.Messaging.Client (SMPServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (CorrId (..), MsgBody, SenderPublicKey)
+import Simplex.Messaging.Protocol (MsgBody, SenderPublicKey)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), runTransportServer)
-import Simplex.Messaging.Util (bshow)
+import Simplex.Messaging.Util (bshow, tryError)
 import System.Random (randomR)
-import UnliftIO.Async (race_)
+import UnliftIO.Async (Async, async, race_)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
@@ -75,18 +106,67 @@ runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort} = runReader
   where
     smpAgent :: forall c m'. (Transport c, MonadUnliftIO m', MonadReader Env m') => TProxy c -> m' ()
     smpAgent _ = runTransportServer started tcpPort $ \(h :: c) -> do
-      liftIO $ putLn h "Welcome to SMP v0.3.2 agent"
-      c <- getSMPAgentClient
+      liftIO $ putLn h "Welcome to SMP v0.4.1 agent"
+      c <- getAgentClient
       logConnection c True
-      race_ (connectClient h c) (runSMPAgentClient c)
-        `E.finally` (closeSMPServerClients c >> logConnection c False)
+      race_ (connectClient h c) (runAgentClient c)
+        `E.finally` disconnectAgentClient c
 
--- | Creates an SMP agent instance that receives commands and sends responses via 'TBQueue's.
-getSMPAgentClient :: (MonadUnliftIO m, MonadReader Env m) => m AgentClient
-getSMPAgentClient = do
-  n <- asks clientCounter
-  cfg <- asks config
-  atomically $ newAgentClient n cfg
+-- | Creates an SMP agent client instance
+getSMPAgentClient :: (MonadRandom m, MonadUnliftIO m) => AgentConfig -> m AgentClient
+getSMPAgentClient cfg = newSMPAgentEnv cfg >>= runReaderT runAgent
+  where
+    runAgent = do
+      c <- getAgentClient
+      action <- async $ subscriber c `E.finally` disconnectAgentClient c
+      pure c {smpSubscriber = action}
+
+disconnectAgentClient :: MonadUnliftIO m => AgentClient -> m ()
+disconnectAgentClient c = closeAgentClient c >> logConnection c False
+
+-- |
+type AgentErrorMonad m = (MonadUnliftIO m, MonadError AgentErrorType m)
+
+-- | Create SMP agent connection (NEW command)
+createConnection :: AgentErrorMonad m => AgentClient -> m (ConnId, SMPQueueInfo)
+createConnection c = withAgentEnv c $ newConn c ""
+
+-- | Join SMP agent connection (JOIN command)
+joinConnection :: AgentErrorMonad m => AgentClient -> SMPQueueInfo -> ConnInfo -> m ConnId
+joinConnection c = withAgentEnv c .: joinConn c ""
+
+-- | Approve confirmation (LET command)
+acceptConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
+acceptConnection c = withAgentEnv c .:. acceptConnection' c
+
+-- | Subscribe to receive connection messages (SUB command)
+subscribeConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
+subscribeConnection c = withAgentEnv c . subscribeConnection' c
+
+-- | Send message to the connection (SEND command)
+sendMessage :: AgentErrorMonad m => AgentClient -> ConnId -> MsgBody -> m AgentMsgId
+sendMessage c = withAgentEnv c .: sendMessage' c
+
+ackMessage :: AgentErrorMonad m => AgentClient -> ConnId -> AgentMsgId -> m ()
+ackMessage c = withAgentEnv c .: ackMessage' c
+
+-- | Suspend SMP agent connection (OFF command)
+suspendConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
+suspendConnection c = withAgentEnv c . suspendConnection' c
+
+-- | Delete SMP agent connection (DEL command)
+deleteConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
+deleteConnection c = withAgentEnv c . deleteConnection' c
+
+withAgentEnv :: AgentClient -> ReaderT Env m a -> m a
+withAgentEnv c = (`runReaderT` agentEnv c)
+
+-- withAgentClient :: AgentErrorMonad m => AgentClient -> ReaderT Env m a -> m a
+-- withAgentClient c = withAgentLock c . withAgentEnv c
+
+-- | Creates an SMP agent client instance that receives commands and sends responses via 'TBQueue's.
+getAgentClient :: (MonadUnliftIO m, MonadReader Env m) => m AgentClient
+getAgentClient = ask >>= atomically . newAgentClient
 
 connectClient :: Transport c => MonadUnliftIO m => c -> AgentClient -> m ()
 connectClient h c = race_ (send h c) (receive h c)
@@ -97,19 +177,15 @@ logConnection c connected =
    in logInfo $ T.unwords ["client", showText (clientId c), event, "Agent"]
 
 -- | Runs an SMP agent instance that receives commands and sends responses via 'TBQueue's.
-runSMPAgentClient :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
-runSMPAgentClient c = do
-  db <- asks $ dbFile . config
-  s1 <- connectSQLiteStore db
-  s2 <- connectSQLiteStore db
-  race_ (subscriber c s1) (client c s2)
+runAgentClient :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
+runAgentClient c = race_ (subscriber c) (client c)
 
 receive :: forall c m. (Transport c, MonadUnliftIO m) => c -> AgentClient -> m ()
-receive h c@AgentClient {rcvQ, sndQ} = forever $ do
-  (corrId, cAlias, cmdOrErr) <- tGet SClient h
+receive h c@AgentClient {rcvQ, subQ} = forever $ do
+  (corrId, connId, cmdOrErr) <- tGet SClient h
   case cmdOrErr of
-    Right cmd -> write rcvQ (corrId, cAlias, cmd)
-    Left e -> write sndQ (corrId, cAlias, ERR e)
+    Right cmd -> write rcvQ (corrId, connId, cmd)
+    Left e -> write subQ (corrId, connId, ERR e)
   where
     write :: TBQueue (ATransmission p) -> ATransmission p -> m ()
     write q t = do
@@ -117,193 +193,330 @@ receive h c@AgentClient {rcvQ, sndQ} = forever $ do
       atomically $ writeTBQueue q t
 
 send :: (Transport c, MonadUnliftIO m) => c -> AgentClient -> m ()
-send h c@AgentClient {sndQ} = forever $ do
-  t <- atomically $ readTBQueue sndQ
+send h c@AgentClient {subQ} = forever $ do
+  t <- atomically $ readTBQueue subQ
   tPut h t
   logClient c "<--" t
 
 logClient :: MonadUnliftIO m => AgentClient -> ByteString -> ATransmission a -> m ()
-logClient AgentClient {clientId} dir (CorrId corrId, cAlias, cmd) = do
-  logInfo . decodeUtf8 $ B.unwords [bshow clientId, dir, "A :", corrId, cAlias, B.takeWhile (/= ' ') $ serializeCommand cmd]
+logClient AgentClient {clientId} dir (corrId, connId, cmd) = do
+  logInfo . decodeUtf8 $ B.unwords [bshow clientId, dir, "A :", corrId, connId, B.takeWhile (/= ' ') $ serializeCommand cmd]
 
-client :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> SQLiteStore -> m ()
-client c@AgentClient {rcvQ, sndQ} st = forever $ do
-  t@(corrId, cAlias, _) <- atomically $ readTBQueue rcvQ
-  runExceptT (processCommand c st t) >>= \case
-    Left e -> atomically $ writeTBQueue sndQ (corrId, cAlias, ERR e)
-    Right _ -> return ()
+client :: forall m. (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
+client c@AgentClient {rcvQ, subQ} = forever $ do
+  (corrId, connId, cmd) <- atomically $ readTBQueue rcvQ
+  withAgentLock c (runExceptT $ processCommand c (connId, cmd))
+    >>= atomically . writeTBQueue subQ . \case
+      Left e -> (corrId, connId, ERR e)
+      Right (connId', resp) -> (corrId, connId', resp)
 
 withStore ::
   AgentMonad m =>
-  (forall m'. (MonadUnliftIO m', MonadError StoreError m') => m' a) ->
+  (forall m'. (MonadUnliftIO m', MonadError StoreError m') => SQLiteStore -> m' a) ->
   m a
 withStore action = do
-  runExceptT (action `E.catch` handleInternal) >>= \case
+  st <- asks store
+  runExceptT (action st `E.catch` handleInternal) >>= \case
     Right c -> return c
     Left e -> throwError $ storeError e
   where
+    -- TODO when parsing exception happens in store, the agent hangs;
+    -- changing SQLError to SomeException does not help
     handleInternal :: (MonadError StoreError m') => SQLError -> m' a
     handleInternal e = throwError . SEInternal $ bshow e
     storeError :: StoreError -> AgentErrorType
     storeError = \case
-      SEConnNotFound -> CONN UNKNOWN
+      SEConnNotFound -> CONN NOT_FOUND
       SEConnDuplicate -> CONN DUPLICATE
+      SEBadConnType CRcv -> CONN SIMPLEX
+      SEBadConnType CSnd -> CONN SIMPLEX
       e -> INTERNAL $ show e
 
-processCommand :: forall m. AgentMonad m => AgentClient -> SQLiteStore -> ATransmission 'Client -> m ()
-processCommand c@AgentClient {sndQ} st (corrId, connAlias, cmd) =
-  case cmd of
-    NEW -> createNewConnection
-    JOIN smpQueueInfo replyMode -> joinConnection smpQueueInfo replyMode
-    SUB -> subscribeConnection connAlias
-    SUBALL -> subscribeAll
-    SEND msgBody -> sendMessage msgBody
-    OFF -> suspendConnection
-    DEL -> deleteConnection
+-- | execute any SMP agent command
+processCommand :: forall m. AgentMonad m => AgentClient -> (ConnId, ACommand 'Client) -> m (ConnId, ACommand 'Agent)
+processCommand c (connId, cmd) = case cmd of
+  NEW -> second INV <$> newConn c connId
+  JOIN smpQueueInfo connInfo -> (,OK) <$> joinConn c connId smpQueueInfo connInfo
+  ACPT confId ownConnInfo -> acceptConnection' c connId confId ownConnInfo $> (connId, OK)
+  SUB -> subscribeConnection' c connId $> (connId, OK)
+  SEND msgBody -> (connId,) . MID <$> sendMessage' c connId msgBody
+  ACK msgId -> ackMessage' c connId msgId $> (connId, OK)
+  OFF -> suspendConnection' c connId $> (connId, OK)
+  DEL -> deleteConnection' c connId $> (connId, OK)
+
+newConn :: AgentMonad m => AgentClient -> ConnId -> m (ConnId, SMPQueueInfo)
+newConn c connId = do
+  srv <- getSMPServer
+  (rq, qInfo) <- newRcvQueue c srv
+  g <- asks idsDrg
+  let cData = ConnData {connId}
+  connId' <- withStore $ \st -> createRcvConn st g cData rq
+  addSubscription c rq connId'
+  pure (connId', qInfo)
+
+joinConn :: AgentMonad m => AgentClient -> ConnId -> SMPQueueInfo -> ConnInfo -> m ConnId
+joinConn c connId qInfo cInfo = do
+  (sq, senderKey, verifyKey) <- newSndQueue qInfo
+  g <- asks idsDrg
+  cfg <- asks config
+  let cData = ConnData {connId}
+  connId' <- withStore $ \st -> createSndConn st g cData sq
+  confirmQueue c sq senderKey cInfo
+  activateQueueJoining c connId' sq verifyKey $ retryInterval cfg
+  pure connId'
+
+activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
+activateQueueJoining c connId sq verifyKey retryInterval =
+  activateQueue c connId sq verifyKey retryInterval createReplyQueue
   where
-    createNewConnection :: m ()
-    createNewConnection = do
-      -- TODO create connection alias if not passed
-      -- make connAlias Maybe?
+    createReplyQueue :: m ()
+    createReplyQueue = do
       srv <- getSMPServer
-      (rq, qInfo) <- newReceiveQueue c srv connAlias
-      withStore $ createRcvConn st rq
-      respond $ INV qInfo
+      (rq, qInfo') <- newRcvQueue c srv
+      addSubscription c rq connId
+      withStore $ \st -> upgradeSndConnToDuplex st connId rq
+      sendControlMessage c sq $ REPLY qInfo'
 
-    getSMPServer :: m SMPServer
-    getSMPServer =
-      asks (smpServers . config) >>= \case
-        srv :| [] -> pure srv
-        servers -> do
-          gen <- asks randomServer
-          i <- atomically . stateTVar gen $ randomR (0, L.length servers - 1)
-          pure $ servers L.!! i
+-- | Approve confirmation (LET command) in Reader monad
+acceptConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
+acceptConnection' c connId confId ownConnInfo =
+  withStore (`getConn` connId) >>= \case
+    SomeConn SCRcv (RcvConnection _ rq) -> do
+      AcceptedConfirmation {senderKey} <- withStore $ \st -> acceptConfirmation st confId ownConnInfo
+      processConfirmation c rq senderKey
+    _ -> throwError $ CMD PROHIBITED
 
-    joinConnection :: SMPQueueInfo -> ReplyMode -> m ()
-    joinConnection qInfo (ReplyMode replyMode) = do
-      -- TODO create connection alias if not passed
-      -- make connAlias Maybe?
-      (sq, senderKey, verifyKey) <- newSendQueue qInfo connAlias
-      withStore $ createSndConn st sq
-      connectToSendQueue c st sq senderKey verifyKey
-      when (replyMode == On) $ createReplyQueue sq
-    -- TODO this response is disabled to avoid two responses in terminal client (OK + CON),
-    -- respond OK
+processConfirmation :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
+processConfirmation c rq sndKey = do
+  withStore $ \st -> setRcvQueueStatus st rq Confirmed
+  secureQueue c rq sndKey
+  withStore $ \st -> setRcvQueueStatus st rq Secured
 
-    subscribeConnection :: ConnAlias -> m ()
-    subscribeConnection cAlias =
-      withStore (getConn st cAlias) >>= \case
-        SomeConn _ (DuplexConnection _ rq _) -> subscribe rq
-        SomeConn _ (RcvConnection _ rq) -> subscribe rq
-        _ -> throwError $ CONN SIMPLEX
+-- | Subscribe to receive connection messages (SUB command) in Reader monad
+subscribeConnection' :: forall m. AgentMonad m => AgentClient -> ConnId -> m ()
+subscribeConnection' c connId =
+  withStore (`getConn` connId) >>= \case
+    SomeConn _ (DuplexConnection _ rq sq) -> do
+      resumeDelivery sq
+      case status (sq :: SndQueue) of
+        Confirmed -> withVerifyKey sq $ \verifyKey -> do
+          conf <- withStore (`getAcceptedConfirmation` connId)
+          secureQueue c rq $ senderKey (conf :: AcceptedConfirmation)
+          withStore $ \st -> setRcvQueueStatus st rq Secured
+          activateSecuredQueue rq sq verifyKey
+        Secured -> withVerifyKey sq $ activateSecuredQueue rq sq
+        Active -> subscribeQueue c rq connId
+        _ -> throwError $ INTERNAL "unexpected queue status"
+    SomeConn _ (SndConnection _ sq) -> do
+      resumeDelivery sq
+      case status (sq :: SndQueue) of
+        Confirmed -> withVerifyKey sq $ \verifyKey ->
+          activateQueueJoining c connId sq verifyKey =<< resumeInterval
+        Active -> throwError $ CONN SIMPLEX
+        _ -> throwError $ INTERNAL "unexpected queue status"
+    SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId
+  where
+    resumeDelivery :: SndQueue -> m ()
+    resumeDelivery SndQueue {server} = do
+      wasDelivering <- resumeMsgDelivery c connId server
+      unless wasDelivering $ do
+        pending <- withStore (`getPendingMsgs` connId)
+        queuePendingMsgs c connId pending
+    withVerifyKey :: SndQueue -> (C.PublicKey -> m ()) -> m ()
+    withVerifyKey sq action =
+      let err = throwError $ INTERNAL "missing signing key public counterpart"
+       in maybe err action . C.publicKey $ signKey sq
+    activateSecuredQueue :: RcvQueue -> SndQueue -> C.PublicKey -> m ()
+    activateSecuredQueue rq sq verifyKey = do
+      activateQueueInitiating c connId sq verifyKey =<< resumeInterval
+      subscribeQueue c rq connId
+    resumeInterval :: m RetryInterval
+    resumeInterval = do
+      r <- asks $ retryInterval . config
+      pure r {initialInterval = 5_000_000}
+
+-- | Send message to the connection (SEND command) in Reader monad
+sendMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> MsgBody -> m AgentMsgId
+sendMessage' c connId msg =
+  withStore (`getConn` connId) >>= \case
+    SomeConn _ (DuplexConnection _ _ sq) -> enqueueMessage sq
+    SomeConn _ (SndConnection _ sq) -> enqueueMessage sq
+    _ -> throwError $ CONN SIMPLEX
+  where
+    enqueueMessage :: SndQueue -> m AgentMsgId
+    enqueueMessage SndQueue {server} = do
+      msgId <- storeSentMsg
+      wasDelivering <- resumeMsgDelivery c connId server
+      pending <-
+        if wasDelivering
+          then pure [PendingMsg {connId, msgId}]
+          else withStore (`getPendingMsgs` connId)
+      queuePendingMsgs c connId pending
+      pure $ unId msgId
       where
-        subscribe rq = subscribeQueue c rq cAlias >> respond' cAlias OK
-
-    -- TODO remove - hack for subscribing to all; respond' and parameterization of subscribeConnection are byproduct
-    subscribeAll :: m ()
-    subscribeAll = withStore (getAllConnAliases st) >>= mapM_ subscribeConnection
-
-    sendMessage :: MsgBody -> m ()
-    sendMessage msgBody =
-      withStore (getConn st connAlias) >>= \case
-        SomeConn _ (DuplexConnection _ _ sq) -> sendMsg sq
-        SomeConn _ (SndConnection _ sq) -> sendMsg sq
-        _ -> throwError $ CONN SIMPLEX
-      where
-        sendMsg sq = do
+        storeSentMsg :: m InternalId
+        storeSentMsg = do
           internalTs <- liftIO getCurrentTime
-          (internalId, internalSndId, previousMsgHash) <- withStore $ updateSndIds st sq
-          let msgStr =
-                serializeSMPMessage
-                  SMPMessage
-                    { senderMsgId = unSndId internalSndId,
-                      senderTimestamp = internalTs,
-                      previousMsgHash,
-                      agentMessage = A_MSG msgBody
-                    }
-              msgHash = C.sha256Hash msgStr
-          withStore $
-            createSndMsg st sq $
-              SndMsgData {internalId, internalSndId, internalTs, msgBody, internalHash = msgHash}
-          sendAgentMessage c sq msgStr
-          respond $ SENT (unId internalId)
+          withStore $ \st -> do
+            (internalId, internalSndId, previousMsgHash) <- updateSndIds st connId
+            let msgBody =
+                  serializeSMPMessage
+                    SMPMessage
+                      { senderMsgId = unSndId internalSndId,
+                        senderTimestamp = internalTs,
+                        previousMsgHash,
+                        agentMessage = A_MSG msg
+                      }
+                internalHash = C.sha256Hash msgBody
+                msgData = SndMsgData {..}
+            createSndMsg st connId msgData
+            pure internalId
 
-    suspendConnection :: m ()
-    suspendConnection =
-      withStore (getConn st connAlias) >>= \case
-        SomeConn _ (DuplexConnection _ rq _) -> suspend rq
-        SomeConn _ (RcvConnection _ rq) -> suspend rq
-        _ -> throwError $ CONN SIMPLEX
-      where
-        suspend rq = suspendQueue c rq >> respond OK
+resumeMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnId -> SMPServer -> m Bool
+resumeMsgDelivery c connId srv = do
+  void $ resume srv (srvMsgDeliveries c) $ runSrvMsgDelivery c srv
+  resume connId (connMsgDeliveries c) $ runMsgDelivery c connId srv
+  where
+    resume :: Ord a => a -> TVar (Map a (Async ())) -> m () -> m Bool
+    resume key actionMap actionProcess = do
+      isDelivering <- isJust . M.lookup key <$> readTVarIO actionMap
+      unless isDelivering $
+        async actionProcess
+          >>= atomically . modifyTVar actionMap . M.insert key
+      pure isDelivering
 
-    deleteConnection :: m ()
-    deleteConnection =
-      withStore (getConn st connAlias) >>= \case
-        SomeConn _ (DuplexConnection _ rq _) -> delete rq
-        SomeConn _ (RcvConnection _ rq) -> delete rq
-        _ -> delConn
-      where
-        delConn = withStore (deleteConn st connAlias) >> respond OK
-        delete rq = do
-          deleteQueue c rq
-          removeSubscription c connAlias
-          delConn
+queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> [PendingMsg] -> m ()
+queuePendingMsgs c connId pending =
+  atomically $ getPendingMsgQ connId (connMsgQueues c) >>= forM_ pending . writeTQueue
 
-    createReplyQueue :: SndQueue -> m ()
-    createReplyQueue sq = do
-      srv <- getSMPServer
-      (rq, qInfo) <- newReceiveQueue c srv connAlias
-      withStore $ upgradeSndConnToDuplex st connAlias rq
-      senderTimestamp <- liftIO getCurrentTime
-      sendAgentMessage c sq . serializeSMPMessage $
-        SMPMessage
-          { senderMsgId = 0,
-            senderTimestamp,
-            previousMsgHash = "",
-            agentMessage = REPLY qInfo
-          }
+getPendingMsgQ :: Ord a => a -> TVar (Map a (TQueue PendingMsg)) -> STM (TQueue PendingMsg)
+getPendingMsgQ key queueMap = do
+  maybe newMsgQueue pure . M.lookup key =<< readTVar queueMap
+  where
+    newMsgQueue :: STM (TQueue PendingMsg)
+    newMsgQueue = do
+      mq <- newTQueue
+      modifyTVar queueMap $ M.insert key mq
+      pure mq
 
-    respond :: ACommand 'Agent -> m ()
-    respond = respond' connAlias
+runMsgDelivery :: AgentMonad m => AgentClient -> ConnId -> SMPServer -> m ()
+runMsgDelivery c connId srv = do
+  mq <- atomically . getPendingMsgQ connId $ connMsgQueues c
+  smq <- atomically . getPendingMsgQ srv $ srvMsgQueues c
+  forever . atomically $ readTQueue mq >>= writeTQueue smq
 
-    respond' :: ConnAlias -> ACommand 'Agent -> m ()
-    respond' cAlias resp = atomically $ writeTBQueue sndQ (corrId, cAlias, resp)
+runSrvMsgDelivery :: forall m. AgentMonad m => AgentClient -> SMPServer -> m ()
+runSrvMsgDelivery c@AgentClient {subQ} srv = do
+  mq <- atomically . getPendingMsgQ srv $ srvMsgQueues c
+  ri <- asks $ reconnectInterval . config
+  forever $ do
+    PendingMsg {connId, msgId} <- atomically $ readTQueue mq
+    let mId = unId msgId
+    withStore (\st -> E.try $ getPendingMsgData st connId msgId) >>= \case
+      Left (e :: E.SomeException) ->
+        notify connId $ MERR mId (INTERNAL $ show e)
+      Right (sq, msgBody) -> do
+        withRetryInterval ri $ \loop -> do
+          tryError (sendAgentMessage c sq msgBody) >>= \case
+            Left e -> case e of
+              SMP SMP.QUOTA -> loop
+              SMP {} -> notify connId $ MERR mId e
+              CMD {} -> notify connId $ MERR mId e
+              _ -> loop
+            Right () -> do
+              notify connId $ SENT mId
+              withStore $ \st -> updateSndMsgStatus st connId msgId SndMsgSent
+  where
+    notify :: ConnId -> ACommand 'Agent -> m ()
+    notify connId cmd = atomically $ writeTBQueue subQ ("", connId, cmd)
 
-subscriber :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> SQLiteStore -> m ()
-subscriber c@AgentClient {msgQ} st = forever $ do
-  -- TODO this will only process messages and notifications
+ackMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> AgentMsgId -> m ()
+ackMessage' c connId msgId = do
+  withStore (`getConn` connId) >>= \case
+    SomeConn _ (DuplexConnection _ rq _) -> ack rq
+    SomeConn _ (RcvConnection _ rq) -> ack rq
+    _ -> throwError $ CONN SIMPLEX
+  where
+    ack :: RcvQueue -> m ()
+    ack rq = do
+      let mId = InternalId msgId
+      withStore $ \st -> checkRcvMsg st connId mId
+      sendAck c rq
+      withStore $ \st -> updateRcvMsgAck st connId mId
+
+-- | Suspend SMP agent connection (OFF command) in Reader monad
+suspendConnection' :: AgentMonad m => AgentClient -> ConnId -> m ()
+suspendConnection' c connId =
+  withStore (`getConn` connId) >>= \case
+    SomeConn _ (DuplexConnection _ rq _) -> suspendQueue c rq
+    SomeConn _ (RcvConnection _ rq) -> suspendQueue c rq
+    _ -> throwError $ CONN SIMPLEX
+
+-- | Delete SMP agent connection (DEL command) in Reader monad
+deleteConnection' :: forall m. AgentMonad m => AgentClient -> ConnId -> m ()
+deleteConnection' c connId =
+  withStore (`getConn` connId) >>= \case
+    SomeConn _ (DuplexConnection _ rq _) -> delete rq
+    SomeConn _ (RcvConnection _ rq) -> delete rq
+    _ -> withStore (`deleteConn` connId)
+  where
+    delete :: RcvQueue -> m ()
+    delete rq = do
+      deleteQueue c rq
+      removeSubscription c connId
+      withStore (`deleteConn` connId)
+
+getSMPServer :: AgentMonad m => m SMPServer
+getSMPServer =
+  asks (smpServers . config) >>= \case
+    srv :| [] -> pure srv
+    servers -> do
+      gen <- asks randomServer
+      i <- atomically . stateTVar gen $ randomR (0, L.length servers - 1)
+      pure $ servers L.!! i
+
+sendControlMessage :: AgentMonad m => AgentClient -> SndQueue -> AMessage -> m ()
+sendControlMessage c sq agentMessage = do
+  senderTimestamp <- liftIO getCurrentTime
+  sendAgentMessage c sq . serializeSMPMessage $
+    SMPMessage
+      { senderMsgId = 0,
+        senderTimestamp,
+        previousMsgHash = "",
+        agentMessage
+      }
+
+subscriber :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
+subscriber c@AgentClient {msgQ} = forever $ do
   t <- atomically $ readTBQueue msgQ
-  runExceptT (processSMPTransmission c st t) >>= \case
+  withAgentLock c (runExceptT $ processSMPTransmission c t) >>= \case
     Left e -> liftIO $ print e
     Right _ -> return ()
 
-processSMPTransmission :: forall m. AgentMonad m => AgentClient -> SQLiteStore -> SMPServerTransmission -> m ()
-processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
-  withStore (getRcvConn st srv rId) >>= \case
-    SomeConn SCDuplex (DuplexConnection _ rq _) -> processSMP SCDuplex rq
-    SomeConn SCRcv (RcvConnection _ rq) -> processSMP SCRcv rq
-    _ -> atomically $ writeTBQueue sndQ ("", "", ERR $ CONN SIMPLEX)
+processSMPTransmission :: forall m. AgentMonad m => AgentClient -> SMPServerTransmission -> m ()
+processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
+  withStore (\st -> getRcvConn st srv rId) >>= \case
+    SomeConn SCDuplex (DuplexConnection cData rq _) -> processSMP SCDuplex cData rq
+    SomeConn SCRcv (RcvConnection cData rq) -> processSMP SCRcv cData rq
+    _ -> atomically $ writeTBQueue subQ ("", "", ERR $ CONN NOT_FOUND)
   where
-    processSMP :: SConnType c -> RcvQueue -> m ()
-    processSMP cType rq@RcvQueue {connAlias, status} =
+    processSMP :: SConnType c -> ConnData -> RcvQueue -> m ()
+    processSMP cType ConnData {connId} rq@RcvQueue {status} =
       case cmd of
         SMP.MSG srvMsgId srvTs msgBody -> do
           -- TODO deduplicate with previously received
           msg <- decryptAndVerify rq msgBody
           let msgHash = C.sha256Hash msg
-          agentMsg <- liftEither $ parseSMPMessage msg
-          case agentMsg of
-            SMPConfirmation senderKey -> smpConfirmation senderKey
-            SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} ->
+          case parseSMPMessage msg of
+            Left e -> notify $ ERR e
+            Right (SMPConfirmation senderKey cInfo) -> smpConfirmation senderKey cInfo >> sendAck c rq
+            Right SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} ->
               case agentMessage of
-                HELLO verifyKey _ -> helloMsg verifyKey msgBody
-                REPLY qInfo -> replyMsg qInfo
+                HELLO verifyKey _ -> helloMsg verifyKey msgBody >> sendAck c rq
+                REPLY qInfo -> replyMsg qInfo >> sendAck c rq
                 A_MSG body -> agentClientMsg previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash
-          sendAck c rq
-          return ()
         SMP.END -> do
-          removeSubscription c connAlias
+          removeSubscription c connId
           logServer "<--" c srv rId "END"
           notify END
         _ -> do
@@ -311,22 +524,25 @@ processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
           notify . ERR $ BROKER UNEXPECTED
       where
         notify :: ACommand 'Agent -> m ()
-        notify msg = atomically $ writeTBQueue sndQ ("", connAlias, msg)
+        notify msg = atomically $ writeTBQueue subQ ("", connId, msg)
 
         prohibited :: m ()
         prohibited = notify . ERR $ AGENT A_PROHIBITED
 
-        smpConfirmation :: SenderPublicKey -> m ()
-        smpConfirmation senderKey = do
+        smpConfirmation :: SenderPublicKey -> ConnInfo -> m ()
+        smpConfirmation senderKey cInfo = do
           logServer "<--" c srv rId "MSG <KEY>"
           case status of
-            New -> do
-              -- TODO currently it automatically allows whoever sends the confirmation
-              -- Commands CONF and LET are not supported in v0.2
-              withStore $ setRcvQueueStatus st rq Confirmed
-              -- TODO update sender key in the store?
-              secureQueue c rq senderKey
-              withStore $ setRcvQueueStatus st rq Secured
+            New -> case cType of
+              SCRcv -> do
+                g <- asks idsDrg
+                let newConfirmation = NewConfirmation {connId, senderKey, senderConnInfo = cInfo}
+                confId <- withStore $ \st -> createConfirmation st g newConfirmation
+                notify $ REQ confId cInfo
+              SCDuplex -> do
+                notify $ INFO cInfo
+                processConfirmation c rq senderKey
+              _ -> prohibited
             _ -> prohibited
 
         helloMsg :: SenderPublicKey -> ByteString -> m ()
@@ -336,9 +552,9 @@ processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
             Active -> prohibited
             _ -> do
               void $ verifyMessage (Just verifyKey) msgBody
-              withStore $ setRcvQueueActive st rq verifyKey
+              withStore $ \st -> setRcvQueueActive st rq verifyKey
               case cType of
-                SCDuplex -> notify CON
+                SCDuplex -> notifyConnected c connId
                 _ -> pure ()
 
         replyMsg :: SMPQueueInfo -> m ()
@@ -346,42 +562,26 @@ processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
           logServer "<--" c srv rId "MSG <REPLY>"
           case cType of
             SCRcv -> do
-              (sq, senderKey, verifyKey) <- newSendQueue qInfo connAlias
-              withStore $ upgradeRcvConnToDuplex st connAlias sq
-              connectToSendQueue c st sq senderKey verifyKey
-              notify CON
+              AcceptedConfirmation {ownConnInfo} <- withStore (`getAcceptedConfirmation` connId)
+              (sq, senderKey, verifyKey) <- newSndQueue qInfo
+              withStore $ \st -> upgradeRcvConnToDuplex st connId sq
+              confirmQueue c sq senderKey ownConnInfo
+              withStore (`removeConfirmations` connId)
+              cfg <- asks config
+              activateQueueInitiating c connId sq verifyKey $ retryInterval cfg
             _ -> prohibited
 
         agentClientMsg :: PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m ()
-        agentClientMsg receivedPrevMsgHash senderMeta brokerMeta msgBody msgHash = do
+        agentClientMsg externalPrevSndHash sender broker msgBody internalHash = do
           logServer "<--" c srv rId "MSG <MSG>"
-          case status of
-            Active -> do
-              internalTs <- liftIO getCurrentTime
-              (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore $ updateRcvIds st rq
-              let msgIntegrity = checkMsgIntegrity prevExtSndId (fst senderMeta) prevRcvMsgHash receivedPrevMsgHash
-              withStore $
-                createRcvMsg st rq $
-                  RcvMsgData
-                    { internalId,
-                      internalRcvId,
-                      internalTs,
-                      senderMeta,
-                      brokerMeta,
-                      msgBody,
-                      internalHash = msgHash,
-                      externalPrevSndHash = receivedPrevMsgHash,
-                      msgIntegrity
-                    }
-              notify
-                MSG
-                  { recipientMeta = (unId internalId, internalTs),
-                    senderMeta,
-                    brokerMeta,
-                    msgBody,
-                    msgIntegrity
-                  }
-            _ -> prohibited
+          internalTs <- liftIO getCurrentTime
+          (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore (`updateRcvIds` connId)
+          let integrity = checkMsgIntegrity prevExtSndId (fst sender) prevRcvMsgHash externalPrevSndHash
+              recipient = (unId internalId, internalTs)
+              msgMeta = MsgMeta {integrity, recipient, sender, broker}
+              rcvMsg = RcvMsgData {..}
+          withStore $ \st -> createRcvMsg st connId rcvMsg
+          notify $ MSG msgMeta msgBody
 
         checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity
         checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash receivedPrevMsgHash
@@ -392,16 +592,39 @@ processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
           | internalPrevMsgHash /= receivedPrevMsgHash = MsgError MsgBadHash
           | otherwise = MsgError MsgDuplicate -- this case is not possible
 
-connectToSendQueue :: AgentMonad m => AgentClient -> SQLiteStore -> SndQueue -> SenderPublicKey -> VerificationKey -> m ()
-connectToSendQueue c st sq senderKey verifyKey = do
-  sendConfirmation c sq senderKey
-  withStore $ setSndQueueStatus st sq Confirmed
-  sendHello c sq verifyKey
-  withStore $ setSndQueueStatus st sq Active
+confirmQueue :: AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> ConnInfo -> m ()
+confirmQueue c sq senderKey cInfo = do
+  sendConfirmation c sq senderKey cInfo
+  withStore $ \st -> setSndQueueStatus st sq Confirmed
 
-newSendQueue ::
-  (MonadUnliftIO m, MonadReader Env m) => SMPQueueInfo -> ConnAlias -> m (SndQueue, SenderPublicKey, VerificationKey)
-newSendQueue (SMPQueueInfo smpServer senderId encryptKey) connAlias = do
+activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
+activateQueueInitiating c connId sq verifyKey retryInterval =
+  activateQueue c connId sq verifyKey retryInterval $ notifyConnected c connId
+
+activateQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m () -> m ()
+activateQueue c connId sq verifyKey retryInterval afterActivation =
+  getActivation c connId >>= \case
+    Nothing -> async runActivation >>= addActivation c connId
+    Just _ -> pure ()
+  where
+    runActivation :: m ()
+    runActivation = do
+      sendHello c sq verifyKey retryInterval
+      withStore $ \st -> setSndQueueStatus st sq Active
+      removeActivation c connId
+      removeVerificationKey
+      afterActivation
+    removeVerificationKey :: m ()
+    removeVerificationKey =
+      let safeSignKey = C.removePublicKey $ signKey sq
+       in withStore $ \st -> updateSignKey st sq safeSignKey
+
+notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m ()
+notifyConnected c connId = atomically $ writeTBQueue (subQ c) ("", connId, CON)
+
+newSndQueue ::
+  (MonadUnliftIO m, MonadReader Env m) => SMPQueueInfo -> m (SndQueue, SenderPublicKey, VerificationKey)
+newSndQueue (SMPQueueInfo smpServer senderId encryptKey) = do
   size <- asks $ rsaKeySize . config
   (senderKey, sndPrivateKey) <- liftIO $ C.generateKeyPair size
   (verifyKey, signKey) <- liftIO $ C.generateKeyPair size
@@ -409,7 +632,6 @@ newSendQueue (SMPQueueInfo smpServer senderId encryptKey) connAlias = do
         SndQueue
           { server = smpServer,
             sndId = senderId,
-            connAlias,
             sndPrivateKey,
             encryptKey,
             signKey,

src/Simplex/Messaging/Agent/Client.hs

@@ -11,11 +11,13 @@ module Simplex.Messaging.Agent.Client
   ( AgentClient (..),
     newAgentClient,
     AgentMonad,
-    getSMPServerClient,
-    closeSMPServerClients,
-    newReceiveQueue,
+    withAgentLock,
+    closeAgentClient,
+    newRcvQueue,
     subscribeQueue,
+    addSubscription,
     sendConfirmation,
+    RetryInterval (..),
     sendHello,
     secureQueue,
     sendAgentMessage,
@@ -27,9 +29,14 @@ module Simplex.Messaging.Agent.Client
     logServer,
     removeSubscription,
     cryptoError,
+    addActivation,
+    getActivation,
+    removeActivation,
   )
 where
 
+import Control.Concurrent.Async (Async, async, uninterruptibleCancel)
+import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
@@ -40,44 +47,62 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Data.Maybe (isNothing)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text.Encoding
 import Data.Time.Clock
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgBody, QueueId, SenderPublicKey)
 import Simplex.Messaging.Util (bshow, liftEitherError, liftError)
-import UnliftIO.Concurrent
 import UnliftIO.Exception (IOException)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
 data AgentClient = AgentClient
   { rcvQ :: TBQueue (ATransmission 'Client),
-    sndQ :: TBQueue (ATransmission 'Agent),
+    subQ :: TBQueue (ATransmission 'Agent),
     msgQ :: TBQueue SMPServerTransmission,
     smpClients :: TVar (Map SMPServer SMPClient),
-    subscrSrvrs :: TVar (Map SMPServer (Set ConnAlias)),
-    subscrConns :: TVar (Map ConnAlias SMPServer),
-    clientId :: Int
+    subscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)),
+    subscrConns :: TVar (Map ConnId SMPServer),
+    activations :: TVar (Map ConnId (Async ())), -- activations of send queues in progress
+    connMsgQueues :: TVar (Map ConnId (TQueue PendingMsg)),
+    connMsgDeliveries :: TVar (Map ConnId (Async ())),
+    srvMsgQueues :: TVar (Map SMPServer (TQueue PendingMsg)),
+    srvMsgDeliveries :: TVar (Map SMPServer (Async ())),
+    reconnections :: TVar [Async ()],
+    clientId :: Int,
+    agentEnv :: Env,
+    smpSubscriber :: Async (),
+    lock :: TMVar ()
   }
 
-newAgentClient :: TVar Int -> AgentConfig -> STM AgentClient
-newAgentClient cc AgentConfig {tbqSize} = do
-  rcvQ <- newTBQueue tbqSize
-  sndQ <- newTBQueue tbqSize
-  msgQ <- newTBQueue tbqSize
+newAgentClient :: Env -> STM AgentClient
+newAgentClient agentEnv = do
+  let qSize = tbqSize $ config agentEnv
+  rcvQ <- newTBQueue qSize
+  subQ <- newTBQueue qSize
+  msgQ <- newTBQueue qSize
   smpClients <- newTVar M.empty
   subscrSrvrs <- newTVar M.empty
   subscrConns <- newTVar M.empty
-  clientId <- (+ 1) <$> readTVar cc
-  writeTVar cc clientId
-  return AgentClient {rcvQ, sndQ, msgQ, smpClients, subscrSrvrs, subscrConns, clientId}
+  activations <- newTVar M.empty
+  connMsgQueues <- newTVar M.empty
+  connMsgDeliveries <- newTVar M.empty
+  srvMsgQueues <- newTVar M.empty
+  srvMsgDeliveries <- newTVar M.empty
+  reconnections <- newTVar []
+  clientId <- stateTVar (clientCounter agentEnv) $ \i -> (i + 1, i + 1)
+  lock <- newTMVar ()
+  return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, activations, connMsgQueues, connMsgDeliveries, srvMsgQueues, srvMsgDeliveries, reconnections, clientId, agentEnv, smpSubscriber = undefined, lock}
 
+-- | Agent monad with MonadReader Env and MonadError AgentErrorType
 type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m)
 
 getSMPServerClient :: forall m. AgentMonad m => AgentClient -> SMPServer -> m SMPClient
@@ -95,33 +120,76 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
     connectClient :: m SMPClient
     connectClient = do
       cfg <- asks $ smpCfg . config
-      liftEitherError smpClientError (getSMPClient srv cfg msgQ clientDisconnected)
+      u <- askUnliftIO
+      liftEitherError smpClientError (getSMPClient srv cfg msgQ $ clientDisconnected u)
         `E.catch` internalError
       where
         internalError :: IOException -> m SMPClient
         internalError = throwError . INTERNAL . show
 
-    clientDisconnected :: IO ()
-    clientDisconnected = do
-      removeSubs >>= mapM_ (mapM_ notifySub)
+    clientDisconnected :: UnliftIO m -> IO ()
+    clientDisconnected u = do
+      removeClientSubs >>= (`forM_` serverDown u)
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
-    removeSubs :: IO (Maybe (Set ConnAlias))
-    removeSubs = atomically $ do
+    removeClientSubs :: IO (Maybe (Map ConnId RcvQueue))
+    removeClientSubs = atomically $ do
       modifyTVar smpClients $ M.delete srv
       cs <- M.lookup srv <$> readTVar (subscrSrvrs c)
       modifyTVar (subscrSrvrs c) $ M.delete srv
-      modifyTVar (subscrConns c) $ maybe id deleteKeys cs
+      modifyTVar (subscrConns c) $ maybe id (deleteKeys . M.keysSet) cs
       return cs
       where
         deleteKeys :: Ord k => Set k -> Map k a -> Map k a
         deleteKeys ks m = S.foldr' M.delete m ks
 
-    notifySub :: ConnAlias -> IO ()
-    notifySub connAlias = atomically $ writeTBQueue (sndQ c) ("", connAlias, END)
+    serverDown :: UnliftIO m -> Map ConnId RcvQueue -> IO ()
+    serverDown u cs = unless (M.null cs) $ do
+      mapM_ (notifySub DOWN) $ M.keysSet cs
+      a <- async . unliftIO u $ tryReconnectClient cs
+      atomically $ modifyTVar (reconnections c) (a :)
 
-closeSMPServerClients :: MonadUnliftIO m => AgentClient -> m ()
-closeSMPServerClients c = liftIO $ readTVarIO (smpClients c) >>= mapM_ closeSMPClient
+    tryReconnectClient :: Map ConnId RcvQueue -> m ()
+    tryReconnectClient cs = do
+      ri <- asks $ reconnectInterval . config
+      withRetryInterval ri $ \loop ->
+        reconnectClient cs `catchError` const loop
+
+    reconnectClient :: Map ConnId RcvQueue -> m ()
+    reconnectClient cs = do
+      withAgentLock c . withSMP c srv $ \smp -> do
+        subs <- readTVarIO $ subscrConns c
+        forM_ (M.toList cs) $ \(connId, rq@RcvQueue {rcvPrivateKey, rcvId}) ->
+          when (isNothing $ M.lookup connId subs) $ do
+            subscribeSMPQueue smp rcvPrivateKey rcvId
+              `catchError` \case
+                SMPServerError e -> liftIO $ notifySub (ERR $ SMP e) connId
+                e -> throwError e
+            addSubscription c rq connId
+            liftIO $ notifySub UP connId
+
+    notifySub :: ACommand 'Agent -> ConnId -> IO ()
+    notifySub cmd connId = atomically $ writeTBQueue (subQ c) ("", connId, cmd)
+
+closeAgentClient :: MonadUnliftIO m => AgentClient -> m ()
+closeAgentClient c = liftIO $ do
+  closeSMPServerClients c
+  cancelActions $ activations c
+  cancelActions $ reconnections c
+  cancelActions $ connMsgDeliveries c
+  cancelActions $ srvMsgDeliveries c
+
+closeSMPServerClients :: AgentClient -> IO ()
+closeSMPServerClients c = readTVarIO (smpClients c) >>= mapM_ closeSMPClient
+
+cancelActions :: Foldable f => TVar (f (Async ())) -> IO ()
+cancelActions as = readTVarIO as >>= mapM_ uninterruptibleCancel
+
+withAgentLock :: MonadUnliftIO m => AgentClient -> m a -> m a
+withAgentLock AgentClient {lock} =
+  E.bracket_
+    (void . atomically $ takeTMVar lock)
+    (atomically $ putTMVar lock ())
 
 withSMP_ :: forall a m. AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> m a) -> m a
 withSMP_ c srv action =
@@ -158,8 +226,8 @@ smpClientError = \case
   SMPTransportError e -> BROKER $ TRANSPORT e
   e -> INTERNAL $ show e
 
-newReceiveQueue :: AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> m (RcvQueue, SMPQueueInfo)
-newReceiveQueue c srv connAlias = do
+newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueInfo)
+newRcvQueue c srv = do
   size <- asks $ rsaKeySize . config
   (recipientKey, rcvPrivateKey) <- liftIO $ C.generateKeyPair size
   logServer "-->" c srv "" "NEW"
@@ -170,44 +238,50 @@ newReceiveQueue c srv connAlias = do
         RcvQueue
           { server = srv,
             rcvId,
-            connAlias,
             rcvPrivateKey,
             sndId = Just sId,
-            sndKey = Nothing,
             decryptKey,
             verifyKey = Nothing,
             status = New
           }
-  addSubscription c rq connAlias
   return (rq, SMPQueueInfo srv sId encryptKey)
 
-subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnAlias -> m ()
-subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connAlias = do
+subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
+subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do
   withLogSMP c server rcvId "SUB" $ \smp ->
     subscribeSMPQueue smp rcvPrivateKey rcvId
-  addSubscription c rq connAlias
+  addSubscription c rq connId
 
-addSubscription :: MonadUnliftIO m => AgentClient -> RcvQueue -> ConnAlias -> m ()
-addSubscription c RcvQueue {server} connAlias = atomically $ do
-  modifyTVar (subscrConns c) $ M.insert connAlias server
+addSubscription :: MonadUnliftIO m => AgentClient -> RcvQueue -> ConnId -> m ()
+addSubscription c rq@RcvQueue {server} connId = atomically $ do
+  modifyTVar (subscrConns c) $ M.insert connId server
   modifyTVar (subscrSrvrs c) $ M.alter (Just . addSub) server
   where
-    addSub :: Maybe (Set ConnAlias) -> Set ConnAlias
-    addSub (Just cs) = S.insert connAlias cs
-    addSub _ = S.singleton connAlias
+    addSub :: Maybe (Map ConnId RcvQueue) -> Map ConnId RcvQueue
+    addSub (Just cs) = M.insert connId rq cs
+    addSub _ = M.singleton connId rq
 
-removeSubscription :: AgentMonad m => AgentClient -> ConnAlias -> m ()
-removeSubscription AgentClient {subscrConns, subscrSrvrs} connAlias = atomically $ do
+removeSubscription :: AgentMonad m => AgentClient -> ConnId -> m ()
+removeSubscription AgentClient {subscrConns, subscrSrvrs} connId = atomically $ do
   cs <- readTVar subscrConns
-  writeTVar subscrConns $ M.delete connAlias cs
+  writeTVar subscrConns $ M.delete connId cs
   mapM_
     (modifyTVar subscrSrvrs . M.alter (>>= delSub))
-    (M.lookup connAlias cs)
+    (M.lookup connId cs)
   where
-    delSub :: Set ConnAlias -> Maybe (Set ConnAlias)
+    delSub :: Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue)
     delSub cs =
-      let cs' = S.delete connAlias cs
-       in if S.null cs' then Nothing else Just cs'
+      let cs' = M.delete connId cs
+       in if M.null cs' then Nothing else Just cs'
+
+addActivation :: MonadUnliftIO m => AgentClient -> ConnId -> Async () -> m ()
+addActivation c connId a = atomically . modifyTVar (activations c) $ M.insert connId a
+
+getActivation :: MonadUnliftIO m => AgentClient -> ConnId -> m (Maybe (Async ()))
+getActivation c connId = M.lookup connId <$> readTVarIO (activations c)
+
+removeActivation :: MonadUnliftIO m => AgentClient -> ConnId -> m ()
+removeActivation c connId = atomically . modifyTVar (activations c) $ M.delete connId
 
 logServer :: AgentMonad m => ByteString -> AgentClient -> SMPServer -> QueueId -> ByteString -> m ()
 logServer dir AgentClient {clientId} srv qId cmdStr =
@@ -219,20 +293,23 @@ showServer srv = B.pack $ host srv <> maybe "" (":" <>) (port srv)
 logSecret :: ByteString -> ByteString
 logSecret bs = encode $ B.take 3 bs
 
-sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> m ()
-sendConfirmation c sq@SndQueue {server, sndId} senderKey =
+sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> ConnInfo -> m ()
+sendConfirmation c sq@SndQueue {server, sndId} senderKey cInfo =
   withLogSMP_ c server sndId "SEND <KEY>" $ \smp -> do
     msg <- mkConfirmation smp
     liftSMP $ sendSMPMessage smp Nothing sndId msg
   where
     mkConfirmation :: SMPClient -> m MsgBody
-    mkConfirmation smp = encryptAndSign smp sq . serializeSMPMessage $ SMPConfirmation senderKey
+    mkConfirmation smp = encryptAndSign smp sq . serializeSMPMessage $ SMPConfirmation senderKey cInfo
 
-sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> m ()
-sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey =
+sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> RetryInterval -> m ()
+sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey ri =
   withLogSMP_ c server sndId "SEND <HELLO> (retrying)" $ \smp -> do
     msg <- mkHello smp $ AckMode On
-    liftSMP $ send 8 100000 msg smp
+    liftSMP . withRetryInterval ri $ \loop ->
+      sendSMPMessage smp (Just sndPrivateKey) sndId msg `catchE` \case
+        SMPServerError AUTH -> loop
+        e -> throwE e
   where
     mkHello :: SMPClient -> AckMode -> m ByteString
     mkHello smp ackMode = do
@@ -245,15 +322,6 @@ sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey =
             agentMessage = HELLO verifyKey ackMode
           }
 
-    send :: Int -> Int -> ByteString -> SMPClient -> ExceptT SMPClientError IO ()
-    send 0 _ _ _ = throwE $ SMPServerError AUTH
-    send retry delay msg smp =
-      sendSMPMessage smp (Just sndPrivateKey) sndId msg `catchE` \case
-        SMPServerError AUTH -> do
-          threadDelay delay
-          send (retry - 1) (delay * 3 `div` 2) msg smp
-        e -> throwE e
-
 secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
 secureQueue c RcvQueue {server, rcvId, rcvPrivateKey} senderKey =
   withLogSMP c server rcvId "KEY <key>" $ \smp ->

src/Simplex/Messaging/Agent/Env/SQLite.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 module Simplex.Messaging.Agent.Env.SQLite where
@@ -11,7 +12,9 @@ import Data.List.NonEmpty (NonEmpty)
 import Network.Socket
 import Numeric.Natural
 import Simplex.Messaging.Agent.Protocol (SMPServer)
+import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store.SQLite
+import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Client
 import System.Random (StdGen, newStdGen)
 import UnliftIO.STM
@@ -23,11 +26,43 @@ data AgentConfig = AgentConfig
     connIdBytes :: Int,
     tbqSize :: Natural,
     dbFile :: FilePath,
-    smpCfg :: SMPClientConfig
+    dbPoolSize :: Int,
+    smpCfg :: SMPClientConfig,
+    retryInterval :: RetryInterval,
+    reconnectInterval :: RetryInterval
   }
 
+minute :: Int
+minute = 60_000_000
+
+defaultAgentConfig :: AgentConfig
+defaultAgentConfig =
+  AgentConfig
+    { tcpPort = "5224",
+      smpServers = undefined,
+      rsaKeySize = 2048 `div` 8,
+      connIdBytes = 12,
+      tbqSize = 16,
+      dbFile = "smp-agent.db",
+      dbPoolSize = 4,
+      smpCfg = smpDefaultConfig,
+      retryInterval =
+        RetryInterval
+          { initialInterval = 1_000_000,
+            increaseAfter = minute,
+            maxInterval = 10 * minute
+          },
+      reconnectInterval =
+        RetryInterval
+          { initialInterval = 1_000_000,
+            increaseAfter = 10_000_000,
+            maxInterval = 10_000_000
+          }
+    }
+
 data Env = Env
   { config :: AgentConfig,
+    store :: SQLiteStore,
     idsDrg :: TVar ChaChaDRG,
     clientCounter :: TVar Int,
     reservedMsgSize :: Int,
@@ -35,15 +70,15 @@ data Env = Env
   }
 
 newSMPAgentEnv :: (MonadUnliftIO m, MonadRandom m) => AgentConfig -> m Env
-newSMPAgentEnv config = do
+newSMPAgentEnv cfg = do
   idsDrg <- newTVarIO =<< drgNew
-  _ <- createSQLiteStore $ dbFile config
+  store <- liftIO $ createSQLiteStore (dbFile cfg) (dbPoolSize cfg) Migrations.app
   clientCounter <- newTVarIO 0
   randomServer <- newTVarIO =<< liftIO newStdGen
-  return Env {config, idsDrg, clientCounter, reservedMsgSize, randomServer}
+  return Env {config = cfg, store, idsDrg, clientCounter, reservedMsgSize, randomServer}
   where
     -- 1st rsaKeySize is used by the RSA signature in each command,
     -- 2nd - by encrypted message body header
     -- 3rd - by message signature
     -- smpCommandSize - is the estimated max size for SMP command, queueId, corrId
-    reservedMsgSize = 3 * rsaKeySize config + smpCommandSize (smpCfg config)
+    reservedMsgSize = 3 * rsaKeySize cfg + smpCommandSize (smpCfg cfg)

src/Simplex/Messaging/Agent/Protocol.hs

@@ -1,14 +1,17 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 -- |
@@ -25,9 +28,12 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md
 module Simplex.Messaging.Agent.Protocol
   ( -- * SMP agent protocol types
+    ConnInfo,
     ACommand (..),
     AParty (..),
     SAParty (..),
+    MsgHash,
+    MsgMeta (..),
     SMPMessage (..),
     AMessage (..),
     SMPServer (..),
@@ -40,8 +46,10 @@ module Simplex.Messaging.Agent.Protocol
     ATransmission,
     ATransmissionOrError,
     ARawTransmission,
-    ConnAlias,
-    ReplyMode (..),
+    ConnId,
+    ConfirmationId,
+    IntroId,
+    InvitationId,
     AckMode (..),
     OnOff (..),
     MsgIntegrity (..),
@@ -51,6 +59,8 @@ module Simplex.Messaging.Agent.Protocol
     VerificationKey,
     EncryptionKey,
     DecryptionKey,
+    ACorrId,
+    AgentMsgId,
 
     -- * Parse and serialize
     serializeCommand,
@@ -91,12 +101,11 @@ import Data.Type.Equality
 import Data.Typeable ()
 import GHC.Generics (Generic)
 import Generic.Random (genericArbitraryU)
-import Network.Socket
+import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol
-  ( CorrId (..),
-    ErrorType,
+  ( ErrorType,
     MsgBody,
     MsgId,
     SenderPublicKey,
@@ -112,10 +121,12 @@ import UnliftIO.Exception
 type ARawTransmission = (ByteString, ByteString, ByteString)
 
 -- | Parsed SMP agent protocol transmission.
-type ATransmission p = (CorrId, ConnAlias, ACommand p)
+type ATransmission p = (ACorrId, ConnId, ACommand p)
 
 -- | SMP agent protocol transmission or transmission error.
-type ATransmissionOrError p = (CorrId, ConnAlias, Either AgentErrorType (ACommand p))
+type ATransmissionOrError p = (ACorrId, ConnId, Either AgentErrorType (ACommand p))
+
+type ACorrId = ByteString
 
 -- | SMP agent protocol participants.
 data AParty = Agent | Client
@@ -139,31 +150,29 @@ data ACmd = forall p. ACmd (SAParty p) (ACommand p)
 
 deriving instance Show ACmd
 
+type ConnInfo = ByteString
+
 -- | Parameterized type for SMP agent protocol commands and responses from all participants.
 data ACommand (p :: AParty) where
   NEW :: ACommand Client -- response INV
   INV :: SMPQueueInfo -> ACommand Agent
-  JOIN :: SMPQueueInfo -> ReplyMode -> ACommand Client -- response OK
+  JOIN :: SMPQueueInfo -> ConnInfo -> ACommand Client -- response OK
+  REQ :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
+  ACPT :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
+  INFO :: ConnInfo -> ACommand Agent
   CON :: ACommand Agent -- notification that connection is established
-  -- TODO currently it automatically allows whoever sends the confirmation
-  -- CONF :: OtherPartyId -> ACommand Agent
-  -- LET :: OtherPartyId -> ACommand Client
   SUB :: ACommand Client
-  SUBALL :: ACommand Client -- TODO should be moved to chat protocol - hack for subscribing to all
   END :: ACommand Agent
+  DOWN :: ACommand Agent
+  UP :: ACommand Agent
   -- QST :: QueueDirection -> ACommand Client
   -- STAT :: QueueDirection -> Maybe QueueStatus -> Maybe SubMode -> ACommand Agent
   SEND :: MsgBody -> ACommand Client
+  MID :: AgentMsgId -> ACommand Agent
   SENT :: AgentMsgId -> ACommand Agent
-  MSG ::
-    { recipientMeta :: (AgentMsgId, UTCTime),
-      brokerMeta :: (MsgId, UTCTime),
-      senderMeta :: (AgentMsgId, UTCTime),
-      msgIntegrity :: MsgIntegrity,
-      msgBody :: MsgBody
-    } ->
-    ACommand Agent
-  -- ACK :: AgentMsgId -> ACommand Client
+  MERR :: AgentMsgId -> AgentErrorType -> ACommand Agent
+  MSG :: MsgMeta -> MsgBody -> ACommand Agent
+  ACK :: AgentMsgId -> ACommand Client
   -- RCVD :: AgentMsgId -> ACommand Agent
   OFF :: ACommand Client
   DEL :: ACommand Client
@@ -174,11 +183,27 @@ deriving instance Eq (ACommand p)
 
 deriving instance Show (ACommand p)
 
+type MsgHash = ByteString
+
+-- | Agent message metadata sent to the client
+data MsgMeta = MsgMeta
+  { integrity :: MsgIntegrity,
+    recipient :: (AgentMsgId, UTCTime),
+    broker :: (MsgId, UTCTime),
+    sender :: (AgentMsgId, UTCTime)
+  }
+  deriving (Eq, Show)
+
 -- | SMP message formats.
 data SMPMessage
   = -- | SMP confirmation
     -- (see <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message SMP protocol>)
-    SMPConfirmation SenderPublicKey
+    SMPConfirmation
+      { -- | sender's public key to use for authentication of sender's commands at the recepient's server
+        senderKey :: SenderPublicKey,
+        -- | sender's information to be associated with the connection, e.g. sender's profile information
+        connInfo :: ConnInfo
+      }
   | -- | Agent message header and envelope for client messages
     -- (see <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents SMP agent protocol>)
     SMPMessage
@@ -187,7 +212,7 @@ data SMPMessage
         -- | timestamp from the sending agent
         senderTimestamp :: SenderTimestamp,
         -- | digest of the previous message
-        previousMsgHash :: ByteString,
+        previousMsgHash :: MsgHash,
         -- | messages sent between agents once queue is secured
         agentMessage :: AMessage
       }
@@ -210,12 +235,10 @@ parseSMPMessage :: ByteString -> Either AgentErrorType SMPMessage
 parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
   where
     smpMessageP :: Parser SMPMessage
-    smpMessageP =
-      smpConfirmationP <* A.endOfLine
-        <|> A.endOfLine *> smpClientMessageP
+    smpMessageP = A.endOfLine *> smpClientMessageP <|> smpConfirmationP
 
     smpConfirmationP :: Parser SMPMessage
-    smpConfirmationP = SMPConfirmation <$> ("KEY " *> C.pubKeyP <* A.endOfLine)
+    smpConfirmationP = "KEY " *> (SMPConfirmation <$> C.pubKeyP <* A.endOfLine <* A.endOfLine <*> binaryBodyP <* A.endOfLine)
 
     smpClientMessageP :: Parser SMPMessage
     smpClientMessageP =
@@ -230,7 +253,7 @@ parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
 -- | Serialize SMP message.
 serializeSMPMessage :: SMPMessage -> ByteString
 serializeSMPMessage = \case
-  SMPConfirmation sKey -> smpMessage ("KEY " <> C.serializePubKey sKey) "" ""
+  SMPConfirmation sKey cInfo -> smpMessage ("KEY " <> C.serializePubKey sKey) "" (serializeBinary cInfo) <> "\n"
   SMPMessage {senderMsgId, senderTimestamp, previousMsgHash, agentMessage} ->
     let header = messageHeader senderMsgId senderTimestamp previousMsgHash
         body = serializeAgentMessage agentMessage
@@ -248,9 +271,7 @@ agentMessageP =
   where
     hello = HELLO <$> C.pubKeyP <*> ackMode
     reply = REPLY <$> smpQueueInfoP
-    a_msg = do
-      size :: Int <- A.decimal <* A.endOfLine
-      A_MSG <$> A.take size <* A.endOfLine
+    a_msg = A_MSG <$> binaryBodyP <* A.endOfLine
     ackMode = AckMode <$> (" NO_ACK" $> Off <|> pure On)
 
 -- | SMP queue information parser.
@@ -262,7 +283,7 @@ smpQueueInfoP =
 smpServerP :: Parser SMPServer
 smpServerP = SMPServer <$> server <*> optional port <*> optional kHash
   where
-    server = B.unpack <$> A.takeWhile1 (A.notInClass ":# ")
+    server = B.unpack <$> A.takeWhile1 (A.notInClass ":#,; ")
     port = A.char ':' *> (B.unpack <$> A.takeWhile1 A.isDigit)
     kHash = C.KeyHash <$> (A.char '#' *> base64P)
 
@@ -270,7 +291,7 @@ serializeAgentMessage :: AMessage -> ByteString
 serializeAgentMessage = \case
   HELLO verifyKey ackMode -> "HELLO " <> C.serializePubKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else ""
   REPLY qInfo -> "REPLY " <> serializeSmpQueueInfo qInfo
-  A_MSG body -> "MSG " <> serializeMsg body <> "\n"
+  A_MSG body -> "MSG " <> serializeBinary body <> "\n"
 
 -- | Serialize SMP queue information that is sent out-of-band.
 serializeSmpQueueInfo :: SMPQueueInfo -> ByteString
@@ -291,10 +312,16 @@ data SMPServer = SMPServer
   deriving (Eq, Ord, Show)
 
 instance IsString SMPServer where
-  fromString = parseString . parseAll $ smpServerP
+  fromString = parseString $ parseAll smpServerP
 
 -- | SMP agent connection alias.
-type ConnAlias = ByteString
+type ConnId = ByteString
+
+type ConfirmationId = ByteString
+
+type IntroId = ByteString
+
+type InvitationId = ByteString
 
 -- | Connection modes.
 data OnOff = On | Off deriving (Eq, Show, Read)
@@ -308,9 +335,6 @@ newtype AckMode = AckMode OnOff deriving (Eq, Show)
 data SMPQueueInfo = SMPQueueInfo SMPServer SMP.SenderId EncryptionKey
   deriving (Eq, Show)
 
--- | Connection reply mode (used in JOIN command).
-newtype ReplyMode = ReplyMode OnOff deriving (Eq, Show)
-
 -- | Public key used to E2E encrypt SMP messages.
 type EncryptionKey = C.PublicKey
 
@@ -318,7 +342,7 @@ type EncryptionKey = C.PublicKey
 type DecryptionKey = C.SafePrivateKey
 
 -- | Private key used to sign SMP commands
-type SignatureKey = C.SafePrivateKey
+type SignatureKey = C.APrivateKey
 
 -- | Public key used by SMP server to authorize (verify) SMP commands.
 type VerificationKey = C.PublicKey
@@ -369,11 +393,11 @@ data AgentErrorType
 
 -- | SMP agent protocol command or response error.
 data CommandErrorType
-  = -- | command is prohibited
+  = -- | command is prohibited in this context
     PROHIBITED
   | -- | command syntax is invalid
     SYNTAX
-  | -- | connection alias is required with this command
+  | -- | entity ID is required with this command
     NO_CONN
   | -- | message size is not correct (no terminating space)
     SIZE
@@ -384,7 +408,7 @@ data CommandErrorType
 -- | Connection error.
 data ConnectionErrorType
   = -- | connection alias is not in the database
-    UNKNOWN
+    NOT_FOUND
   | -- | connection alias already exists
     DUPLICATE
   | -- | connection is simplex, but operation requires another queue
@@ -427,18 +451,25 @@ instance Arbitrary BrokerErrorType where arbitrary = genericArbitraryU
 
 instance Arbitrary SMPAgentError where arbitrary = genericArbitraryU
 
--- | AMP agent command and response parser
+-- | SMP agent command and response parser
 commandP :: Parser ACmd
 commandP =
   "NEW" $> ACmd SClient NEW
     <|> "INV " *> invResp
     <|> "JOIN " *> joinCmd
+    <|> "REQ " *> reqCmd
+    <|> "ACPT " *> acptCmd
+    <|> "INFO " *> infoCmd
     <|> "SUB" $> ACmd SClient SUB
-    <|> "SUBALL" $> ACmd SClient SUBALL -- TODO remove - hack for subscribing to all
     <|> "END" $> ACmd SAgent END
+    <|> "DOWN" $> ACmd SAgent DOWN
+    <|> "UP" $> ACmd SAgent UP
     <|> "SEND " *> sendCmd
+    <|> "MID " *> msgIdResp
     <|> "SENT " *> sentResp
+    <|> "MERR " *> msgErrResp
     <|> "MSG " *> message
+    <|> "ACK " *> ackCmd
     <|> "OFF" $> ACmd SClient OFF
     <|> "DEL" $> ACmd SClient DEL
     <|> "ERR " *> agentError
@@ -446,18 +477,23 @@ commandP =
     <|> "OK" $> ACmd SAgent OK
   where
     invResp = ACmd SAgent . INV <$> smpQueueInfoP
-    joinCmd = ACmd SClient <$> (JOIN <$> smpQueueInfoP <*> replyMode)
+    joinCmd = ACmd SClient <$> (JOIN <$> smpQueueInfoP <* A.space <*> A.takeByteString)
+    reqCmd = ACmd SAgent <$> (REQ <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    acptCmd = ACmd SClient <$> (ACPT <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    infoCmd = ACmd SAgent . INFO <$> A.takeByteString
     sendCmd = ACmd SClient . SEND <$> A.takeByteString
+    msgIdResp = ACmd SAgent . MID <$> A.decimal
     sentResp = ACmd SAgent . SENT <$> A.decimal
-    message = do
-      msgIntegrity <- msgIntegrityP <* A.space
-      recipientMeta <- "R=" *> partyMeta A.decimal
-      brokerMeta <- "B=" *> partyMeta base64P
-      senderMeta <- "S=" *> partyMeta A.decimal
-      msgBody <- A.takeByteString
-      return $ ACmd SAgent MSG {recipientMeta, brokerMeta, senderMeta, msgIntegrity, msgBody}
-    replyMode = ReplyMode <$> (" NO_REPLY" $> Off <|> pure On)
-    partyMeta idParser = (,) <$> idParser <* "," <*> tsISO8601P <* A.space
+    msgErrResp = ACmd SAgent <$> (MERR <$> A.decimal <* A.space <*> agentErrorTypeP)
+    message = ACmd SAgent <$> (MSG <$> msgMetaP <* A.space <*> A.takeByteString)
+    ackCmd = ACmd SClient . ACK <$> A.decimal
+    msgMetaP = do
+      integrity <- msgIntegrityP
+      recipient <- " R=" *> partyMeta A.decimal
+      broker <- " B=" *> partyMeta base64P
+      sender <- " S=" *> partyMeta A.decimal
+      pure MsgMeta {integrity, recipient, broker, sender}
+    partyMeta idParser = (,) <$> idParser <* "," <*> tsISO8601P
     agentError = ACmd SAgent . ERR <$> agentErrorTypeP
 
 -- | Message integrity validation result parser.
@@ -478,33 +514,37 @@ serializeCommand :: ACommand p -> ByteString
 serializeCommand = \case
   NEW -> "NEW"
   INV qInfo -> "INV " <> serializeSmpQueueInfo qInfo
-  JOIN qInfo rMode -> "JOIN " <> serializeSmpQueueInfo qInfo <> replyMode rMode
+  JOIN qInfo cInfo -> "JOIN " <> serializeSmpQueueInfo qInfo <> " " <> serializeBinary cInfo
+  REQ confId cInfo -> "REQ " <> confId <> " " <> serializeBinary cInfo
+  ACPT confId cInfo -> "ACPT " <> confId <> " " <> serializeBinary cInfo
+  INFO cInfo -> "INFO " <> serializeBinary cInfo
   SUB -> "SUB"
-  SUBALL -> "SUBALL" -- TODO remove - hack for subscribing to all
   END -> "END"
-  SEND msgBody -> "SEND " <> serializeMsg msgBody
+  DOWN -> "DOWN"
+  UP -> "UP"
+  SEND msgBody -> "SEND " <> serializeBinary msgBody
+  MID mId -> "MID " <> bshow mId
   SENT mId -> "SENT " <> bshow mId
-  MSG {recipientMeta = (rmId, rTs), brokerMeta = (bmId, bTs), senderMeta = (smId, sTs), msgIntegrity, msgBody} ->
-    B.unwords
-      [ "MSG",
-        serializeMsgIntegrity msgIntegrity,
-        "R=" <> bshow rmId <> "," <> showTs rTs,
-        "B=" <> encode bmId <> "," <> showTs bTs,
-        "S=" <> bshow smId <> "," <> showTs sTs,
-        serializeMsg msgBody
-      ]
+  MERR mId e -> "MERR " <> bshow mId <> " " <> serializeAgentError e
+  MSG msgMeta msgBody ->
+    "MSG " <> serializeMsgMeta msgMeta <> " " <> serializeBinary msgBody
+  ACK mId -> "ACK " <> bshow mId
   OFF -> "OFF"
   DEL -> "DEL"
   CON -> "CON"
   ERR e -> "ERR " <> serializeAgentError e
   OK -> "OK"
   where
-    replyMode :: ReplyMode -> ByteString
-    replyMode = \case
-      ReplyMode Off -> " NO_REPLY"
-      ReplyMode On -> ""
     showTs :: UTCTime -> ByteString
     showTs = B.pack . formatISO8601Millis
+    serializeMsgMeta :: MsgMeta -> ByteString
+    serializeMsgMeta MsgMeta {integrity, recipient = (rmId, rTs), broker = (bmId, bTs), sender = (smId, sTs)} =
+      B.unwords
+        [ serializeMsgIntegrity integrity,
+          "R=" <> bshow rmId <> "," <> showTs rTs,
+          "B=" <> encode bmId <> "," <> showTs bTs,
+          "S=" <> bshow smId <> "," <> showTs sTs
+        ]
 
 -- | Serialize message integrity validation result.
 serializeMsgIntegrity :: MsgIntegrity -> ByteString
@@ -535,14 +575,19 @@ serializeAgentError = \case
   BROKER (TRANSPORT e) -> "BROKER TRANSPORT " <> serializeTransportError e
   e -> bshow e
 
-serializeMsg :: ByteString -> ByteString
-serializeMsg body = bshow (B.length body) <> "\n" <> body
+binaryBodyP :: Parser ByteString
+binaryBodyP = do
+  size :: Int <- A.decimal <* A.endOfLine
+  A.take size
+
+serializeBinary :: ByteString -> ByteString
+serializeBinary body = bshow (B.length body) <> "\n" <> body
 
 -- | Send raw (unparsed) SMP agent protocol transmission to TCP connection.
 tPutRaw :: Transport c => c -> ARawTransmission -> IO ()
-tPutRaw h (corrId, connAlias, command) = do
+tPutRaw h (corrId, entity, command) = do
   putLn h corrId
-  putLn h connAlias
+  putLn h entity
   putLn h command
 
 -- | Receive raw (unparsed) SMP agent protocol transmission from TCP connection.
@@ -551,7 +596,7 @@ tGetRaw h = (,,) <$> getLn h <*> getLn h <*> getLn h
 
 -- | Send SMP agent protocol command (or response) to TCP connection.
 tPut :: (Transport c, MonadIO m) => c -> ATransmission p -> m ()
-tPut h (CorrId corrId, connAlias, command) =
+tPut h (corrId, connAlias, command) =
   liftIO $ tPutRaw h (corrId, connAlias, serializeCommand command)
 
 -- | Receive client and agent transmissions from TCP connection.
@@ -559,38 +604,42 @@ tGet :: forall c m p. (Transport c, MonadIO m) => SAParty p -> c -> m (ATransmis
 tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
   where
     tParseLoadBody :: ARawTransmission -> m (ATransmissionOrError p)
-    tParseLoadBody t@(corrId, connAlias, command) = do
-      let cmd = parseCommand command >>= fromParty >>= tConnAlias t
+    tParseLoadBody t@(corrId, connId, command) = do
+      let cmd = parseCommand command >>= fromParty >>= tConnId t
       fullCmd <- either (return . Left) cmdWithMsgBody cmd
-      return (CorrId corrId, connAlias, fullCmd)
+      return (corrId, connId, fullCmd)
 
     fromParty :: ACmd -> Either AgentErrorType (ACommand p)
     fromParty (ACmd (p :: p1) cmd) = case testEquality party p of
       Just Refl -> Right cmd
       _ -> Left $ CMD PROHIBITED
 
-    tConnAlias :: ARawTransmission -> ACommand p -> Either AgentErrorType (ACommand p)
-    tConnAlias (_, connAlias, _) cmd = case cmd of
-      -- NEW and JOIN have optional connAlias
+    tConnId :: ARawTransmission -> ACommand p -> Either AgentErrorType (ACommand p)
+    tConnId (_, connId, _) cmd = case cmd of
+      -- NEW, JOIN and ACPT have optional connId
       NEW -> Right cmd
-      JOIN _ _ -> Right cmd
-      -- ERROR response does not always have connAlias
+      JOIN {} -> Right cmd
+      -- ERROR response does not always have connId
       ERR _ -> Right cmd
-      -- other responses must have connAlias
+      -- other responses must have connId
       _
-        | B.null connAlias -> Left $ CMD NO_CONN
+        | B.null connId -> Left $ CMD NO_CONN
         | otherwise -> Right cmd
 
     cmdWithMsgBody :: ACommand p -> m (Either AgentErrorType (ACommand p))
     cmdWithMsgBody = \case
-      SEND body -> SEND <$$> getMsgBody body
-      MSG agentMsgId srvTS agentTS integrity body -> MSG agentMsgId srvTS agentTS integrity <$$> getMsgBody body
-      cmd -> return $ Right cmd
+      SEND body -> SEND <$$> getBody body
+      MSG msgMeta body -> MSG msgMeta <$$> getBody body
+      JOIN qInfo cInfo -> JOIN qInfo <$$> getBody cInfo
+      REQ confId cInfo -> REQ confId <$$> getBody cInfo
+      ACPT confId cInfo -> ACPT confId <$$> getBody cInfo
+      INFO cInfo -> INFO <$$> getBody cInfo
+      cmd -> pure $ Right cmd
 
     -- TODO refactor with server
-    getMsgBody :: MsgBody -> m (Either AgentErrorType MsgBody)
-    getMsgBody msgBody =
-      case B.unpack msgBody of
+    getBody :: ByteString -> m (Either AgentErrorType ByteString)
+    getBody binary =
+      case B.unpack binary of
         ':' : body -> return . Right $ B.pack body
         str -> case readMaybe str :: Maybe Int of
           Just size -> liftIO $ do

src/Simplex/Messaging/Agent/RetryInterval.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Agent.RetryInterval where
+
+import Control.Concurrent (threadDelay)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+
+data RetryInterval = RetryInterval
+  { initialInterval :: Int,
+    increaseAfter :: Int,
+    maxInterval :: Int
+  }
+
+withRetryInterval :: forall m. MonadIO m => RetryInterval -> (m () -> m ()) -> m ()
+withRetryInterval RetryInterval {initialInterval, increaseAfter, maxInterval} action =
+  callAction 0 initialInterval
+  where
+    callAction :: Int -> Int -> m ()
+    callAction elapsedTime delay = action loop
+      where
+        loop = do
+          let newDelay =
+                if elapsedTime < increaseAfter || delay == maxInterval
+                  then delay
+                  else min (delay * 3 `div` 2) maxInterval
+          liftIO $ threadDelay delay
+          callAction (elapsedTime + delay) newDelay

src/Simplex/Messaging/Agent/Store.hs

@@ -9,7 +9,9 @@
 
 module Simplex.Messaging.Agent.Store where
 
+import Control.Concurrent.STM (TVar)
 import Control.Exception (Exception)
+import Crypto.Random (ChaChaDRG)
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Kind (Type)
@@ -30,26 +32,36 @@ import qualified Simplex.Messaging.Protocol as SMP
 -- | Store class type. Defines store access methods for implementations.
 class Monad m => MonadAgentStore s m where
   -- Queue and Connection management
-  createRcvConn :: s -> RcvQueue -> m ()
-  createSndConn :: s -> SndQueue -> m ()
-  getConn :: s -> ConnAlias -> m SomeConn
-  getAllConnAliases :: s -> m [ConnAlias] -- TODO remove - hack for subscribing to all
+  createRcvConn :: s -> TVar ChaChaDRG -> ConnData -> RcvQueue -> m ConnId
+  createSndConn :: s -> TVar ChaChaDRG -> ConnData -> SndQueue -> m ConnId
+  getConn :: s -> ConnId -> m SomeConn
+  getAllConnIds :: s -> m [ConnId] -- TODO remove - hack for subscribing to all
   getRcvConn :: s -> SMPServer -> SMP.RecipientId -> m SomeConn
-  deleteConn :: s -> ConnAlias -> m ()
-  upgradeRcvConnToDuplex :: s -> ConnAlias -> SndQueue -> m ()
-  upgradeSndConnToDuplex :: s -> ConnAlias -> RcvQueue -> m ()
+  deleteConn :: s -> ConnId -> m ()
+  upgradeRcvConnToDuplex :: s -> ConnId -> SndQueue -> m ()
+  upgradeSndConnToDuplex :: s -> ConnId -> RcvQueue -> m ()
   setRcvQueueStatus :: s -> RcvQueue -> QueueStatus -> m ()
   setRcvQueueActive :: s -> RcvQueue -> VerificationKey -> m ()
   setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m ()
+  updateSignKey :: s -> SndQueue -> SignatureKey -> m ()
+
+  -- Confirmations
+  createConfirmation :: s -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
+  acceptConfirmation :: s -> ConfirmationId -> ConnInfo -> m AcceptedConfirmation
+  getAcceptedConfirmation :: s -> ConnId -> m AcceptedConfirmation
+  removeConfirmations :: s -> ConnId -> m ()
 
   -- Msg management
-  updateRcvIds :: s -> RcvQueue -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
-  createRcvMsg :: s -> RcvQueue -> RcvMsgData -> m ()
-
-  updateSndIds :: s -> SndQueue -> m (InternalId, InternalSndId, PrevSndMsgHash)
-  createSndMsg :: s -> SndQueue -> SndMsgData -> m ()
-
-  getMsg :: s -> ConnAlias -> InternalId -> m Msg
+  updateRcvIds :: s -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
+  createRcvMsg :: s -> ConnId -> RcvMsgData -> m ()
+  updateSndIds :: s -> ConnId -> m (InternalId, InternalSndId, PrevSndMsgHash)
+  createSndMsg :: s -> ConnId -> SndMsgData -> m ()
+  updateSndMsgStatus :: s -> ConnId -> InternalId -> SndMsgStatus -> m ()
+  getPendingMsgData :: s -> ConnId -> InternalId -> m (SndQueue, MsgBody)
+  getPendingMsgs :: s -> ConnId -> m [PendingMsg]
+  getMsg :: s -> ConnId -> InternalId -> m Msg
+  checkRcvMsg :: s -> ConnId -> InternalId -> m ()
+  updateRcvMsgAck :: s -> ConnId -> InternalId -> m ()
 
 -- * Queue types
 
@@ -57,10 +69,8 @@ class Monad m => MonadAgentStore s m where
 data RcvQueue = RcvQueue
   { server :: SMPServer,
     rcvId :: SMP.RecipientId,
-    connAlias :: ConnAlias,
     rcvPrivateKey :: RecipientPrivateKey,
     sndId :: Maybe SMP.SenderId,
-    sndKey :: Maybe SenderPublicKey,
     decryptKey :: DecryptionKey,
     verifyKey :: Maybe VerificationKey,
     status :: QueueStatus
@@ -71,7 +81,6 @@ data RcvQueue = RcvQueue
 data SndQueue = SndQueue
   { server :: SMPServer,
     sndId :: SMP.SenderId,
-    connAlias :: ConnAlias,
     sndPrivateKey :: SenderPrivateKey,
     encryptKey :: EncryptionKey,
     signKey :: SignatureKey,
@@ -95,9 +104,9 @@ data ConnType = CRcv | CSnd | CDuplex deriving (Eq, Show)
 -- - DuplexConnection is a connection that has both receive and send queues set up,
 --   typically created by upgrading a receive or a send connection with a missing queue.
 data Connection (d :: ConnType) where
-  RcvConnection :: ConnAlias -> RcvQueue -> Connection CRcv
-  SndConnection :: ConnAlias -> SndQueue -> Connection CSnd
-  DuplexConnection :: ConnAlias -> RcvQueue -> SndQueue -> Connection CDuplex
+  RcvConnection :: ConnData -> RcvQueue -> Connection CRcv
+  SndConnection :: ConnData -> SndQueue -> Connection CSnd
+  DuplexConnection :: ConnData -> RcvQueue -> SndQueue -> Connection CDuplex
 
 deriving instance Eq (Connection d)
 
@@ -134,9 +143,26 @@ instance Eq SomeConn where
 
 deriving instance Show SomeConn
 
--- * Message integrity validation types
+newtype ConnData = ConnData {connId :: ConnId}
+  deriving (Eq, Show)
 
-type MsgHash = ByteString
+-- * Confirmation types
+
+data NewConfirmation = NewConfirmation
+  { connId :: ConnId,
+    senderKey :: SenderPublicKey,
+    senderConnInfo :: ConnInfo
+  }
+
+data AcceptedConfirmation = AcceptedConfirmation
+  { confirmationId :: ConfirmationId,
+    connId :: ConnId,
+    senderKey :: SenderPublicKey,
+    senderConnInfo :: ConnInfo,
+    ownConnInfo :: ConnInfo
+  }
+
+-- * Message integrity validation types
 
 -- | Corresponds to `last_external_snd_msg_id` in `connections` table
 type PrevExternalSndId = Int64
@@ -152,15 +178,11 @@ type PrevSndMsgHash = MsgHash
 -- * Message data containers - used on Msg creation to reduce number of parameters
 
 data RcvMsgData = RcvMsgData
-  { internalId :: InternalId,
-    internalRcvId :: InternalRcvId,
-    internalTs :: InternalTs,
-    senderMeta :: (ExternalSndId, ExternalSndTs),
-    brokerMeta :: (BrokerId, BrokerTs),
+  { msgMeta :: MsgMeta,
     msgBody :: MsgBody,
+    internalRcvId :: InternalRcvId,
     internalHash :: MsgHash,
-    externalPrevSndHash :: MsgHash,
-    msgIntegrity :: MsgIntegrity
+    externalPrevSndHash :: MsgHash
   }
 
 data SndMsgData = SndMsgData
@@ -168,9 +190,20 @@ data SndMsgData = SndMsgData
     internalSndId :: InternalSndId,
     internalTs :: InternalTs,
     msgBody :: MsgBody,
-    internalHash :: MsgHash
+    internalHash :: MsgHash,
+    previousMsgHash :: MsgHash
   }
 
+data PendingMsg = PendingMsg
+  { connId :: ConnId,
+    msgId :: InternalId
+  }
+  deriving (Show)
+
+-- * Broadcast types
+
+type BroadcastId = ByteString
+
 -- * Message types
 
 -- | A message in either direction that is stored by the agent.
@@ -241,9 +274,9 @@ data SndMsg = SndMsg
 newtype InternalSndId = InternalSndId {unSndId :: Int64} deriving (Eq, Show)
 
 data SndMsgStatus
-  = Created
-  | Sent
-  | Delivered
+  = SndMsgCreated
+  | SndMsgSent
+  | SndMsgDelivered
   deriving (Eq, Show)
 
 type SentTs = UTCTime
@@ -252,7 +285,7 @@ type DeliveredTs = UTCTime
 
 -- | Base message data independent of direction.
 data MsgBase = MsgBase
-  { connAlias :: ConnAlias,
+  { connAlias :: ConnId,
     -- | Monotonically increasing id of a message per connection, internal to the agent.
     -- Internal Id preserves ordering between both received and sent messages, and is needed
     -- to track the order of the conversation (which can be different for the sender / receiver)
@@ -276,6 +309,8 @@ type InternalTs = UTCTime
 data StoreError
   = -- | IO exceptions in store actions.
     SEInternal ByteString
+  | -- | failed to generate unique random ID
+    SEUniqueID
   | -- | Connection alias not found (or both queues absent).
     SEConnNotFound
   | -- | Connection alias already used.
@@ -283,6 +318,10 @@ data StoreError
   | -- | Wrong connection type, e.g. "send" connection when "receive" or "duplex" is expected, or vice versa.
     -- 'upgradeRcvConnToDuplex' and 'upgradeSndConnToDuplex' do not allow duplex connections - they would also return this error.
     SEBadConnType ConnType
+  | -- | Confirmation not found.
+    SEConfirmationNotFound
+  | -- | Message not found
+    SEMsgNotFound
   | -- | Currently not used. The intention was to pass current expected queue status in methods,
     -- as we always know what it should be at any stage of the protocol,
     -- and in case it does not match use this error.

src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations
+  ( Migration (..),
+    app,
+    initialize,
+    get,
+    run,
+  )
+where
+
+import Control.Monad (forM_)
+import Data.FileEmbed (embedDir, makeRelativeToProject)
+import Data.Function (on)
+import Data.List (intercalate, sortBy)
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (Connection, Only (..))
+import qualified Database.SQLite.Simple as DB
+import Database.SQLite.Simple.QQ (sql)
+import qualified Database.SQLite3 as SQLite3
+import System.FilePath (takeBaseName, takeExtension)
+
+data Migration = Migration {name :: String, up :: Text}
+  deriving (Show)
+
+-- | The list of migrations in ascending order by date
+app :: [Migration]
+app =
+  sortBy (compare `on` name) . map migration . filter sqlFile $
+    $(makeRelativeToProject "migrations" >>= embedDir)
+  where
+    sqlFile (file, _) = takeExtension file == ".sql"
+    migration (file, qStr) = Migration {name = takeBaseName file, up = decodeUtf8 qStr}
+
+get :: Connection -> [Migration] -> IO (Either String [Migration])
+get conn migrations =
+  migrationsToRun migrations . map fromOnly
+    <$> DB.query_ conn "SELECT name FROM migrations ORDER BY name ASC;"
+
+run :: Connection -> [Migration] -> IO ()
+run conn ms = DB.withImmediateTransaction conn . forM_ ms $
+  \Migration {name, up} -> insert name >> execSQL up
+  where
+    insert name = DB.execute conn "INSERT INTO migrations (name, ts) VALUES (?, ?);" . (name,) =<< getCurrentTime
+    execSQL = SQLite3.exec $ DB.connectionHandle conn
+
+initialize :: Connection -> IO ()
+initialize conn =
+  DB.execute_
+    conn
+    [sql|
+      CREATE TABLE IF NOT EXISTS migrations (
+        name TEXT NOT NULL,
+        ts TEXT NOT NULL,
+        PRIMARY KEY (name)
+      );
+    |]
+
+migrationsToRun :: [Migration] -> [String] -> Either String [Migration]
+migrationsToRun appMs [] = Right appMs
+migrationsToRun [] dbMs = Left $ "database version is newer than the app: " <> intercalate ", " dbMs
+migrationsToRun (a : as) (d : ds)
+  | name a == d = migrationsToRun as ds
+  | otherwise = Left $ "different migration in the app/database: " <> name a <> " / " <> d

src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs

@@ -1,167 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-
-module Simplex.Messaging.Agent.Store.SQLite.Schema (createSchema) where
-
-import Database.SQLite.Simple (Connection, Query, execute_)
-import Database.SQLite.Simple.QQ (sql)
-
-createSchema :: Connection -> IO ()
-createSchema conn =
-  mapM_
-    (execute_ conn)
-    [ servers,
-      rcvQueues,
-      sndQueues,
-      connections,
-      messages,
-      rcvMessages,
-      sndMessages
-    ]
-
--- port is either a port number or a service name, see Network.Socket.Info.ServiceName
-servers :: Query
-servers =
-  [sql|
-    CREATE TABLE IF NOT EXISTS servers(
-      host TEXT NOT NULL,
-      port TEXT NOT NULL,
-      key_hash BLOB,
-      PRIMARY KEY (host, port)
-    ) WITHOUT ROWID;
-  |]
-
-rcvQueues :: Query
-rcvQueues =
-  [sql|
-    CREATE TABLE IF NOT EXISTS rcv_queues(
-      host TEXT NOT NULL,
-      port TEXT NOT NULL,
-      rcv_id BLOB NOT NULL,
-      conn_alias BLOB NOT NULL,
-      rcv_private_key BLOB NOT NULL,
-      snd_id BLOB,
-      snd_key BLOB,
-      decrypt_key BLOB NOT NULL,
-      verify_key BLOB,
-      status TEXT NOT NULL,
-      PRIMARY KEY (host, port, rcv_id),
-      FOREIGN KEY (host, port) REFERENCES servers (host, port),
-      FOREIGN KEY (conn_alias)
-        REFERENCES connections (conn_alias)
-        ON DELETE CASCADE
-        DEFERRABLE INITIALLY DEFERRED,
-      UNIQUE (host, port, snd_id)
-    ) WITHOUT ROWID;
-  |]
-
-sndQueues :: Query
-sndQueues =
-  [sql|
-    CREATE TABLE IF NOT EXISTS snd_queues(
-      host TEXT NOT NULL,
-      port TEXT NOT NULL,
-      snd_id BLOB NOT NULL,
-      conn_alias BLOB NOT NULL,
-      snd_private_key BLOB NOT NULL,
-      encrypt_key BLOB NOT NULL,
-      sign_key BLOB NOT NULL,
-      status TEXT NOT NULL,
-      PRIMARY KEY (host, port, snd_id),
-      FOREIGN KEY (host, port) REFERENCES servers (host, port),
-      FOREIGN KEY (conn_alias)
-        REFERENCES connections (conn_alias)
-        ON DELETE CASCADE
-        DEFERRABLE INITIALLY DEFERRED
-    ) WITHOUT ROWID;
-  |]
-
-connections :: Query
-connections =
-  [sql|
-    CREATE TABLE IF NOT EXISTS connections(
-      conn_alias BLOB NOT NULL,
-      rcv_host TEXT,
-      rcv_port TEXT,
-      rcv_id BLOB,
-      snd_host TEXT,
-      snd_port TEXT,
-      snd_id BLOB,
-      last_internal_msg_id INTEGER NOT NULL,
-      last_internal_rcv_msg_id INTEGER NOT NULL,
-      last_internal_snd_msg_id INTEGER NOT NULL,
-      last_external_snd_msg_id INTEGER NOT NULL,
-      last_rcv_msg_hash BLOB NOT NULL,
-      last_snd_msg_hash BLOB NOT NULL,
-      PRIMARY KEY (conn_alias),
-      FOREIGN KEY (rcv_host, rcv_port, rcv_id) REFERENCES rcv_queues (host, port, rcv_id),
-      FOREIGN KEY (snd_host, snd_port, snd_id) REFERENCES snd_queues (host, port, snd_id)
-    ) WITHOUT ROWID;
-  |]
-
-messages :: Query
-messages =
-  [sql|
-    CREATE TABLE IF NOT EXISTS messages(
-      conn_alias BLOB NOT NULL,
-      internal_id INTEGER NOT NULL,
-      internal_ts TEXT NOT NULL,
-      internal_rcv_id INTEGER,
-      internal_snd_id INTEGER,
-      body TEXT NOT NULL,
-      PRIMARY KEY (conn_alias, internal_id),
-      FOREIGN KEY (conn_alias)
-        REFERENCES connections (conn_alias)
-        ON DELETE CASCADE,
-      FOREIGN KEY (conn_alias, internal_rcv_id)
-        REFERENCES rcv_messages (conn_alias, internal_rcv_id)
-        ON DELETE CASCADE
-        DEFERRABLE INITIALLY DEFERRED,
-      FOREIGN KEY (conn_alias, internal_snd_id)
-        REFERENCES snd_messages (conn_alias, internal_snd_id)
-        ON DELETE CASCADE
-        DEFERRABLE INITIALLY DEFERRED
-    ) WITHOUT ROWID;
-  |]
-
-rcvMessages :: Query
-rcvMessages =
-  [sql|
-    CREATE TABLE IF NOT EXISTS rcv_messages(
-      conn_alias BLOB NOT NULL,
-      internal_rcv_id INTEGER NOT NULL,
-      internal_id INTEGER NOT NULL,
-      external_snd_id INTEGER NOT NULL,
-      external_snd_ts TEXT NOT NULL,
-      broker_id BLOB NOT NULL,
-      broker_ts TEXT NOT NULL,
-      rcv_status TEXT NOT NULL,
-      ack_brocker_ts TEXT,
-      ack_sender_ts TEXT,
-      internal_hash BLOB NOT NULL,
-      external_prev_snd_hash BLOB NOT NULL,
-      integrity BLOB NOT NULL,
-      PRIMARY KEY (conn_alias, internal_rcv_id),
-      FOREIGN KEY (conn_alias, internal_id)
-        REFERENCES messages (conn_alias, internal_id)
-        ON DELETE CASCADE
-    ) WITHOUT ROWID;
-  |]
-
-sndMessages :: Query
-sndMessages =
-  [sql|
-    CREATE TABLE IF NOT EXISTS snd_messages(
-      conn_alias BLOB NOT NULL,
-      internal_snd_id INTEGER NOT NULL,
-      internal_id INTEGER NOT NULL,
-      snd_status TEXT NOT NULL,
-      sent_ts TEXT,
-      delivered_ts TEXT,
-      internal_hash BLOB NOT NULL,
-      PRIMARY KEY (conn_alias, internal_snd_id),
-      FOREIGN KEY (conn_alias, internal_id)
-        REFERENCES messages (conn_alias, internal_id)
-        ON DELETE CASCADE
-    ) WITHOUT ROWID;
-  |]

src/Simplex/Messaging/Client.hs

@@ -53,9 +53,10 @@ import Control.Monad
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe
+import Data.Maybe (fromMaybe)
 import Network.Socket (ServiceName)
 import Numeric.Natural
 import Simplex.Messaging.Agent.Protocol (SMPServer (..))
@@ -64,7 +65,7 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport (ATransport (..), TCP, THandle (..), TProxy, Transport (..), TransportError, clientHandshake, runTransportClient)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, liftError, raceAny_)
-import System.Timeout
+import System.Timeout (timeout)
 
 -- | 'SMPClient' is a handle used to send commands to a specific SMP server.
 --
@@ -98,6 +99,9 @@ data SMPClientConfig = SMPClientConfig
     tcpTimeout :: Int,
     -- | period for SMP ping commands (microseconds)
     smpPing :: Int,
+    -- | SMP transport block size, Nothing - the block size will be set by the server.
+    -- Allowed sizes are 4, 8, 16, 32, 64 KiB (* 1024 bytes).
+    smpBlockSize :: Maybe Int,
     -- | estimated maximum size of SMP command excluding message body,
     -- determines the maximum allowed message size
     smpCommandSize :: Int
@@ -111,6 +115,7 @@ smpDefaultConfig =
       defaultTransport = ("5223", transport @TCP),
       tcpTimeout = 4_000_000,
       smpPing = 30_000_000,
+      smpBlockSize = Just 8192,
       smpCommandSize = 256
     }
 
@@ -127,7 +132,7 @@ type Response = Either SMPClientError Cmd
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
 getSMPClient :: SMPServer -> SMPClientConfig -> TBQueue SMPServerTransmission -> IO () -> IO (Either SMPClientError SMPClient)
-getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing} msgQ disconnected =
+getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlockSize} msgQ disconnected =
   atomically mkSMPClient >>= runClient useTransport
   where
     mkSMPClient :: STM SMPClient
@@ -172,7 +177,7 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing} msgQ dis
 
     client :: forall c. Transport c => TProxy c -> SMPClient -> TMVar (Either SMPClientError Int) -> c -> IO ()
     client _ c thVar h =
-      runExceptT (clientHandshake h $ keyHash smpServer) >>= \case
+      runExceptT (clientHandshake h smpBlockSize $ keyHash smpServer) >>= \case
         Left e -> atomically . putTMVar thVar . Left $ SMPTransportError e
         Right th -> do
           atomically $ do
@@ -195,22 +200,27 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing} msgQ dis
     process :: SMPClient -> IO ()
     process SMPClient {rcvQ, sentCommands} = forever $ do
       (_, (corrId, qId, respOrErr)) <- atomically $ readTBQueue rcvQ
-      cs <- readTVarIO sentCommands
-      case M.lookup corrId cs of
-        Nothing -> do
-          case respOrErr of
-            Right (Cmd SBroker cmd) -> atomically $ writeTBQueue msgQ (smpServer, qId, cmd)
-            -- TODO send everything else to errQ and log in agent
-            _ -> return ()
-        Just Request {queueId, responseVar} -> atomically $ do
-          modifyTVar sentCommands $ M.delete corrId
-          putTMVar responseVar $
-            if queueId == qId
-              then case respOrErr of
-                Left e -> Left $ SMPResponseError e
-                Right (Cmd _ (ERR e)) -> Left $ SMPServerError e
-                Right r -> Right r
-              else Left SMPUnexpectedResponse
+      if B.null $ bs corrId
+        then sendMsg qId respOrErr
+        else do
+          cs <- readTVarIO sentCommands
+          case M.lookup corrId cs of
+            Nothing -> sendMsg qId respOrErr
+            Just Request {queueId, responseVar} -> atomically $ do
+              modifyTVar sentCommands $ M.delete corrId
+              putTMVar responseVar $
+                if queueId == qId
+                  then case respOrErr of
+                    Left e -> Left $ SMPResponseError e
+                    Right (Cmd _ (ERR e)) -> Left $ SMPServerError e
+                    Right r -> Right r
+                  else Left SMPUnexpectedResponse
+
+    sendMsg :: QueueId -> Either ErrorType Cmd -> IO ()
+    sendMsg qId = \case
+      Right (Cmd SBroker cmd) -> atomically $ writeTBQueue msgQ (smpServer, qId, cmd)
+      -- TODO send everything else to errQ and log in agent
+      _ -> return ()
 
 -- | Disconnects SMP client from the server and terminates client threads.
 closeSMPClient :: SMPClient -> IO ()

src/Simplex/Messaging/Crypto.hs

@@ -20,18 +20,20 @@
 -- <https://hackage.haskell.org/package/cryptonite cryptonite package>.
 module Simplex.Messaging.Crypto
   ( -- * RSA keys
-    PrivateKey (rsaPrivateKey),
-    SafePrivateKey, -- constructor is not exported
+    PrivateKey (rsaPrivateKey, publicKey),
+    SafePrivateKey (..), -- constructor is not exported
     FullPrivateKey (..),
+    APrivateKey (..),
     PublicKey (..),
     SafeKeyPair,
     FullKeyPair,
     KeyHash (..),
     generateKeyPair,
-    publicKey,
+    publicKey',
     publicKeySize,
     validKeySize,
     safePrivateKey,
+    removePublicKey,
 
     -- * E2E hybrid encryption scheme
     encrypt,
@@ -121,6 +123,9 @@ newtype SafePrivateKey = SafePrivateKey {unPrivateKey :: R.PrivateKey} deriving
 -- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (with PublicKey inside).
 newtype FullPrivateKey = FullPrivateKey {unPrivateKey :: R.PrivateKey} deriving (Eq, Show)
 
+-- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (PublicKey may be inside).
+newtype APrivateKey = APrivateKey {unPrivateKey :: R.PrivateKey} deriving (Eq, Show)
+
 -- | Type-class used for both private key types: SafePrivateKey and FullPrivateKey.
 class PrivateKey k where
   -- unwraps 'Crypto.PubKey.RSA.PrivateKey'
@@ -132,29 +137,53 @@ class PrivateKey k where
   -- smart constructor removing public key from SafePrivateKey but keeping it in FullPrivateKey
   mkPrivateKey :: R.PrivateKey -> k
 
+  -- extracts public key from private key
+  publicKey :: k -> Maybe PublicKey
+
+-- | Remove public key exponent from APrivateKey.
+removePublicKey :: APrivateKey -> APrivateKey
+removePublicKey (APrivateKey R.PrivateKey {private_pub = k, private_d}) =
+  APrivateKey $ unPrivateKey (safePrivateKey (R.public_size k, R.public_n k, private_d) :: SafePrivateKey)
+
 instance PrivateKey SafePrivateKey where
   rsaPrivateKey = unPrivateKey
   _privateKey = SafePrivateKey
   mkPrivateKey R.PrivateKey {private_pub = k, private_d} =
     safePrivateKey (R.public_size k, R.public_n k, private_d)
+  publicKey _ = Nothing
 
 instance PrivateKey FullPrivateKey where
   rsaPrivateKey = unPrivateKey
   _privateKey = FullPrivateKey
   mkPrivateKey = FullPrivateKey
+  publicKey = Just . PublicKey . R.private_pub . rsaPrivateKey
+
+instance PrivateKey APrivateKey where
+  rsaPrivateKey = unPrivateKey
+  _privateKey = APrivateKey
+  mkPrivateKey = APrivateKey
+  publicKey pk =
+    let k = R.private_pub $ rsaPrivateKey pk
+     in if R.public_e k == 0
+          then Nothing
+          else Just $ PublicKey k
 
 instance IsString FullPrivateKey where
-  fromString = parseString (decode >=> decodePrivKey)
+  fromString = parseString $ decode >=> decodePrivKey
 
 instance IsString PublicKey where
-  fromString = parseString (decode >=> decodePubKey)
+  fromString = parseString $ decode >=> decodePubKey
 
 instance ToField SafePrivateKey where toField = toField . encodePrivKey
 
+instance ToField APrivateKey where toField = toField . encodePrivKey
+
 instance ToField PublicKey where toField = toField . encodePubKey
 
 instance FromField SafePrivateKey where fromField = blobFieldParser binaryPrivKeyP
 
+instance FromField APrivateKey where fromField = blobFieldParser binaryPrivKeyP
+
 instance FromField PublicKey where fromField = blobFieldParser binaryPubKeyP
 
 -- | Tuple of RSA 'PublicKey' and 'PrivateKey'.
@@ -217,8 +246,8 @@ generateKeyPair size = loop
 privateKeySize :: PrivateKey k => k -> Int
 privateKeySize = R.public_size . R.private_pub . rsaPrivateKey
 
-publicKey :: FullPrivateKey -> PublicKey
-publicKey = PublicKey . R.private_pub . rsaPrivateKey
+publicKey' :: FullPrivateKey -> PublicKey
+publicKey' = PublicKey . R.private_pub . rsaPrivateKey
 
 publicKeySize :: PublicKey -> Int
 publicKeySize = R.public_size . rsaPublicKey
@@ -227,6 +256,7 @@ validKeySize :: Int -> Bool
 validKeySize = \case
   128 -> True
   256 -> True
+  384 -> True
   512 -> True
   _ -> False
 

src/Simplex/Messaging/Parsers.hs

@@ -30,7 +30,7 @@ base64StringP = do
   pure $ str <> pad
 
 tsISO8601P :: Parser UTCTime
-tsISO8601P = maybe (fail "timestamp") pure . parseISO8601 . B.unpack =<< A.takeTill (== ' ')
+tsISO8601P = maybe (fail "timestamp") pure . parseISO8601 . B.unpack =<< A.takeTill wordEnd
 
 parse :: Parser a -> e -> (ByteString -> Either e a)
 parse parser err = first (const err) . parseAll parser
@@ -42,14 +42,17 @@ parseRead :: Read a => Parser ByteString -> Parser a
 parseRead = (>>= maybe (fail "cannot read") pure . readMaybe . B.unpack)
 
 parseRead1 :: Read a => Parser a
-parseRead1 = parseRead $ A.takeTill (== ' ')
+parseRead1 = parseRead $ A.takeTill wordEnd
 
 parseRead2 :: Read a => Parser a
 parseRead2 = parseRead $ do
-  w1 <- A.takeTill (== ' ') <* A.char ' '
-  w2 <- A.takeTill (== ' ')
+  w1 <- A.takeTill wordEnd <* A.char ' '
+  w2 <- A.takeTill wordEnd
   pure $ w1 <> " " <> w2
 
+wordEnd :: Char -> Bool
+wordEnd c = c == ' ' || c == '\n'
+
 parseString :: (ByteString -> Either String a) -> (String -> a)
 parseString p = either error id . p . B.pack
 

src/Simplex/Messaging/Protocol.hs

@@ -192,6 +192,8 @@ data ErrorType
     CMD CommandError
   | -- | command authorization error - bad signature or non-existing SMP queue
     AUTH
+  | -- | SMP queue capacity is exceeded on the server
+    QUOTA
   | -- | ACK command is sent without message to be acknowledged
     NO_MSG
   | -- | internal server error

src/Simplex/Messaging/Server.hs

@@ -90,7 +90,8 @@ runSMPServerBlocking started cfg@ServerConfig {transports} = do
 runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m ()
 runClient _ h = do
   keyPair <- asks serverKeyPair
-  liftIO (runExceptT $ serverHandshake h keyPair) >>= \case
+  ServerConfig {blockSize} <- asks config
+  liftIO (runExceptT $ serverHandshake h blockSize keyPair) >>= \case
     Right th -> runClientTransport th
     Left _ -> pure ()
 
@@ -157,6 +158,7 @@ verifyTransmission (sig, t@(corrId, queueId, cmd)) = do
       cryptoVerify $ case sigLen of
         128 -> dummyKey128
         256 -> dummyKey256
+        384 -> dummyKey384
         512 -> dummyKey512
         _ -> dummyKey256
     sigLen = B.length $ C.unSignature sig
@@ -169,6 +171,9 @@ dummyKey128 = "MIIBIDANBgkqhkiG9w0BAQEFAAOCAQ0AMIIBCAKBgQC2oeA7s4roXN5K2N6022I1/
 dummyKey256 :: C.PublicKey
 dummyKey256 = "MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAxwmTvaqmdTbkfUGNi8Yu0L/T4cxuOlQlx3zGZ9X9Qx0+oZjknWK+QHrdWTcpS+zH4Hi7fP6kanOQoQ90Hj6Ghl57VU1GEdUPywSw4i1/7t0Wv9uT9Q2ktHp2rqVo3xkC9IVIpL7EZAxdRviIN2OsOB3g4a/F1ZpjxcAaZeOMUugiAX1+GtkLuE0Xn4neYjCaOghLxQTdhybN70VtnkiQLx/X9NjkDIl/spYGm3tQFMyYKkP6IWoEpj0926hJ0fmlmhy8tAOhlZsb/baW5cgkEZ3E9jVVrySCgQzoLQgma610FIISRpRJbSyv26jU7MkMxiyuBiDaFOORkXFttoKbtQKBgEbDS9II2brsz+vfI7uP8atFcawkE52cx4M1UWQhqb1H3tBiRl+qO+dMq1pPQF2bW7dlZAWYzS4W/367bTAuALHBDGB8xi1P4Njhh9vaOgTvuqrHG9NJQ85BLy0qGw8rjIWSIXVmVpfrXFJ8po5l04UE258Ll2yocv3QRQmddQW9"
 
+dummyKey384 :: C.PublicKey
+dummyKey384 = "MIICITANBgkqhkiG9w0BAQEFAAOCAg4AMIICCQKCAYEAthExp77lSFBMB0RedjgKIU+oNH5lMGdMqDCG0E5Ly7X49rFpfDMMN08GDIgvzg9kcwV3ScbPcjUE19wmAShX9f9k3w38KM3wmIBKSiuCREQl0V3xAYp1SYwiAkMNSSwxuIkDEeSOR56WdEcZvqbB4lY9MQlUv70KriPDxZaqKCTKslUezXHQuYPQX6eMnGFK7hxz5Kl5MajV52d+5iXsa8CA+m/e1KVnbelCO+xhN89xG8ALt0CJ9k5Wwo3myLgXi4dmNankCmg8jkh+7y2ywkzxMwH1JydDtV/FLzkbZsbPR2w93TNrTq1RJOuqMyh0VtdBSpxNW/Ft988TkkX2BAWzx82INw7W6/QbHGNtHNB995R4sgeYy8QbEpNGBhQnfQh7yRWygLTVXWKApQzzfCeIoDDWUS7dMv/zXoasAnpDBj+6UhHv3BHrps7kBvRyZQ2d/nUuAqiGd43ljJ++n6vNyFLgZoiV7HLia/FOGMkdt7j92CNmFHxiT6Xl7kRHAoGBAPNoWny2O7LBxzAKMLmQVHBAiKp6RMx+7URvtQDHDHPaZ7F3MvtvmYWwGzund3cQFAaV1EkJoYeI3YRuj6xdXgMyMaP54On++btArb6jUtZuvlC98qE8dEEHQNh+7TsCiMU+ivbeKFxS9A/B7OVedoMnPoJWhatbA9zB/6L1GNPh"
+
 dummyKey512 :: C.PublicKey
 dummyKey512 = "MIICoDANBgkqhkiG9w0BAQEFAAOCAo0AMIICiAKCAgEArkCY9DuverJ4mmzDektv9aZMFyeRV46WZK9NsOBKEc+1ncqMs+LhLti9asKNgUBRbNzmbOe0NYYftrUpwnATaenggkTFxxbJ4JGJuGYbsEdFWkXSvrbWGtM8YUmn5RkAGme12xQ89bSM4VoJAGnrYPHwmcQd+KYCPZvTUsxaxgrJTX65ejHN9BsAn8XtGViOtHTDJO9yUMD2WrJvd7wnNa+0ugEteDLzMU++xS98VC+uA1vfauUqi3yXVchdfrLdVUuM+JE0gUEXCgzjuHkaoHiaGNiGhdPYoAJJdOKQOIHAKdk7Th6OPhirPhc9XYNB4O8JDthKhNtfokvFIFlC4QBRzJhpLIENaEBDt08WmgpOnecZB/CuxkqqOrNa8j5K5jNrtXAI67W46VEC2jeQy/gZwb64Zit2A4D00xXzGbQTPGj4ehcEMhLx5LSCygViEf0w0tN3c3TEyUcgPzvECd2ZVpQLr9Z4a07Ebr+YSuxcHhjg4Rg1VyJyOTTvaCBGm5X2B3+tI4NUttmikIHOYpBnsLmHY2BgfH2KcrIsDyAhInXmTFr/L2+erFarUnlfATd2L8Ti43TNHDedO6k6jI5Gyi62yPwjqPLEIIK8l+pIeNfHJ3pPmjhHBfzFcQLMMMXffHWNK8kWklrQXK+4j4HiPcTBvlO1FEtG9nEIZhUCgYA4a6WtI2k5YNli1C89GY5rGUY7RP71T6RWri/D3Lz9T7GvU+FemAyYmsvCQwqijUOur0uLvwSP8VdxpSUcrjJJSWur2hrPWzWlu0XbNaeizxpFeKbQP+zSrWJ1z8RwfAeUjShxt8q1TuqGqY10wQyp3nyiTGvS+KwZVj5h5qx8NQ=="
 
@@ -292,16 +297,19 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
               QueueActive -> do
                 ms <- asks msgStore
                 msg <- mkMessage
+                quota <- asks $ msgQueueQuota . config
                 atomically $ do
-                  q <- getMsgQueue ms (recipientId qr)
-                  writeMsg q msg
-                  return ok
+                  q <- getMsgQueue ms (recipientId qr) quota
+                  isFull q >>= \case
+                    False -> writeMsg q msg $> ok
+                    True -> pure $ err QUOTA
 
         deliverMessage :: (MsgQueue -> STM (Maybe Message)) -> RecipientId -> Sub -> m Transmission
         deliverMessage tryPeek rId = \case
           Sub {subThread = NoSub} -> do
             ms <- asks msgStore
-            q <- atomically $ getMsgQueue ms rId
+            quota <- asks $ msgQueueQuota . config
+            q <- atomically $ getMsgQueue ms rId quota
             atomically (tryPeek q) >>= \case
               Nothing -> forkSub q $> ok
               Just msg -> atomically setDelivered $> mkResp corrId rId (msgCmd msg)

src/Simplex/Messaging/Server/Env/STM.hs

@@ -25,9 +25,11 @@ import UnliftIO.STM
 data ServerConfig = ServerConfig
   { transports :: [(ServiceName, ATransport)],
     tbqSize :: Natural,
+    msgQueueQuota :: Natural,
     queueIdBytes :: Int,
     msgIdBytes :: Int,
     storeLog :: Maybe (StoreLog 'ReadMode),
+    blockSize :: Int,
     serverPrivateKey :: C.FullPrivateKey
     -- serverId :: ByteString
   }
@@ -86,7 +88,7 @@ newEnv config = do
   idsDrg <- drgNew >>= newTVarIO
   s' <- restoreQueues queueStore `mapM` storeLog (config :: ServerConfig)
   let pk = serverPrivateKey config
-      serverKeyPair = (C.publicKey pk, pk)
+      serverKeyPair = (C.publicKey' pk, pk)
   return Env {config, server, queueStore, msgStore, idsDrg, serverKeyPair, storeLog = s'}
   where
     restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode)

src/Simplex/Messaging/Server/MsgStore.hs

@@ -3,6 +3,7 @@
 module Simplex.Messaging.Server.MsgStore where
 
 import Data.Time.Clock
+import Numeric.Natural
 import Simplex.Messaging.Protocol (Encoded, MsgBody, RecipientId)
 
 data Message = Message
@@ -12,10 +13,11 @@ data Message = Message
   }
 
 class MonadMsgStore s q m | s -> q where
-  getMsgQueue :: s -> RecipientId -> m q
+  getMsgQueue :: s -> RecipientId -> Natural -> m q
   delMsgQueue :: s -> RecipientId -> m ()
 
 class MonadMsgQueue q m where
+  isFull :: q -> m Bool
   writeMsg :: q -> Message -> m () -- non blocking
   tryPeekMsg :: q -> m (Maybe Message) -- non blocking
   peekMsg :: q -> m Message -- blocking

src/Simplex/Messaging/Server/MsgStore/STM.hs

@@ -8,11 +8,12 @@ module Simplex.Messaging.Server.MsgStore.STM where
 
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Numeric.Natural
 import Simplex.Messaging.Protocol (RecipientId)
 import Simplex.Messaging.Server.MsgStore
 import UnliftIO.STM
 
-newtype MsgQueue = MsgQueue {msgQueue :: TQueue Message}
+newtype MsgQueue = MsgQueue {msgQueue :: TBQueue Message}
 
 newtype MsgStoreData = MsgStoreData {messages :: Map RecipientId MsgQueue}
 
@@ -22,13 +23,13 @@ newMsgStore :: STM STMMsgStore
 newMsgStore = newTVar $ MsgStoreData M.empty
 
 instance MonadMsgStore STMMsgStore MsgQueue STM where
-  getMsgQueue :: STMMsgStore -> RecipientId -> STM MsgQueue
-  getMsgQueue store rId = do
+  getMsgQueue :: STMMsgStore -> RecipientId -> Natural -> STM MsgQueue
+  getMsgQueue store rId quota = do
     m <- messages <$> readTVar store
     maybe (newQ m) return $ M.lookup rId m
     where
       newQ m' = do
-        q <- MsgQueue <$> newTQueue
+        q <- MsgQueue <$> newTBQueue quota
         writeTVar store . MsgStoreData $ M.insert rId q m'
         return q
 
@@ -37,15 +38,18 @@ instance MonadMsgStore STMMsgStore MsgQueue STM where
     modifyTVar store $ MsgStoreData . M.delete rId . messages
 
 instance MonadMsgQueue MsgQueue STM where
+  isFull :: MsgQueue -> STM Bool
+  isFull = isFullTBQueue . msgQueue
+
   writeMsg :: MsgQueue -> Message -> STM ()
-  writeMsg = writeTQueue . msgQueue
+  writeMsg = writeTBQueue . msgQueue
 
   tryPeekMsg :: MsgQueue -> STM (Maybe Message)
-  tryPeekMsg = tryPeekTQueue . msgQueue
+  tryPeekMsg = tryPeekTBQueue . msgQueue
 
   peekMsg :: MsgQueue -> STM Message
-  peekMsg = peekTQueue . msgQueue
+  peekMsg = peekTBQueue . msgQueue
 
   -- atomic delete (== read) last and peek next message if available
   tryDelPeekMsg :: MsgQueue -> STM (Maybe Message)
-  tryDelPeekMsg (MsgQueue q) = tryReadTQueue q >> tryPeekTQueue q
+  tryDelPeekMsg (MsgQueue q) = tryReadTBQueue q >> tryPeekTBQueue q

src/Simplex/Messaging/Transport.hs

@@ -63,8 +63,10 @@ import Data.ByteArray (xor)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
+import Data.Maybe(fromMaybe)
 import Data.Set (Set)
 import qualified Data.Set as S
+import Data.String
 import Data.Word (Word32)
 import GHC.Generics (Generic)
 import GHC.IO.Exception (IOErrorType (..))
@@ -73,7 +75,7 @@ import Generic.Random (genericArbitraryU)
 import Network.Socket
 import Network.Transport.Internal (decodeNum16, decodeNum32, encodeEnum16, encodeEnum32, encodeWord32)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Parsers (parse, parseAll, parseRead1)
+import Simplex.Messaging.Parsers (parse, parseAll, parseRead1, parseString)
 import Simplex.Messaging.Util (bshow, liftError)
 import System.IO
 import System.IO.Error
@@ -212,11 +214,14 @@ trimCR s = if B.last s == '\r' then B.init s else s
 data SMPVersion = SMPVersion Int Int Int Int
   deriving (Eq, Ord)
 
+instance IsString SMPVersion where
+  fromString = parseString $ parseAll smpVersionP
+
 major :: SMPVersion -> (Int, Int)
 major (SMPVersion a b _ _) = (a, b)
 
 currentSMPVersion :: SMPVersion
-currentSMPVersion = SMPVersion 0 3 2 0
+currentSMPVersion = "0.4.1.0"
 
 serializeSMPVersion :: SMPVersion -> ByteString
 serializeSMPVersion (SMPVersion a b c d) = B.intercalate "." [bshow a, bshow b, bshow c, bshow d]
@@ -340,21 +345,21 @@ makeNextIV SessionKey {baseIV, counter} = atomically $ do
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
 --
 -- The numbers in function names refer to the steps in the document.
-serverHandshake :: forall c. Transport c => c -> C.FullKeyPair -> ExceptT TransportError IO (THandle c)
-serverHandshake c (k, pk) = do
+serverHandshake :: forall c. Transport c => c -> Int -> C.FullKeyPair -> ExceptT TransportError IO (THandle c)
+serverHandshake c srvBlockSize (k, pk) = do
+  checkValidBlockSize srvBlockSize
   liftIO sendHeaderAndPublicKey_1
   encryptedKeys <- receiveEncryptedKeys_4
-  -- TODO server currently ignores blockSize returned by the client
-  -- this is reserved for future support of streams
-  ClientHandshake {blockSize = _, sndKey, rcvKey} <- decryptParseKeys_5 encryptedKeys
-  th <- liftIO $ transportHandle c rcvKey sndKey transportBlockSize -- keys are swapped here
+  ClientHandshake {blockSize, sndKey, rcvKey} <- decryptParseKeys_5 encryptedKeys
+  checkValidBlockSize blockSize
+  th <- liftIO $ transportHandle c rcvKey sndKey blockSize -- keys are swapped here
   sendWelcome_6 th
   pure th
   where
     sendHeaderAndPublicKey_1 :: IO ()
     sendHeaderAndPublicKey_1 = do
       let sKey = C.encodePubKey k
-          header = ServerHeader {blockSize = transportBlockSize, keySize = B.length sKey}
+          header = ServerHeader {blockSize = srvBlockSize, keySize = B.length sKey}
       cPut c $ binaryServerHeader header
       cPut c sKey
     receiveEncryptedKeys_4 :: ExceptT TransportError IO ByteString
@@ -374,13 +379,14 @@ serverHandshake c (k, pk) = do
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
 --
 -- The numbers in function names refer to the steps in the document.
-clientHandshake :: forall c. Transport c => c -> Maybe C.KeyHash -> ExceptT TransportError IO (THandle c)
-clientHandshake c keyHash = do
+clientHandshake :: forall c. Transport c => c -> Maybe Int -> Maybe C.KeyHash -> ExceptT TransportError IO (THandle c)
+clientHandshake c blkSize_ keyHash = do
+  mapM_ checkValidBlockSize blkSize_
   (k, blkSize) <- getHeaderAndPublicKey_1_2
-  -- TODO currently client always uses the blkSize returned by the server
-  keys@ClientHandshake {sndKey, rcvKey} <- liftIO $ generateKeys_3 blkSize
-  sendEncryptedKeys_4 k keys
-  th <- liftIO $ transportHandle c sndKey rcvKey blkSize
+  let clientBlkSize = fromMaybe blkSize blkSize_
+  chs@ClientHandshake {sndKey, rcvKey} <- liftIO $ generateKeys_3 clientBlkSize
+  sendEncryptedKeys_4 k chs
+  th <- liftIO $ transportHandle c sndKey rcvKey clientBlkSize
   getWelcome_6 th >>= checkVersion
   pure th
   where
@@ -388,8 +394,7 @@ clientHandshake c keyHash = do
     getHeaderAndPublicKey_1_2 = do
       header <- liftIO (cGet c serverHeaderSize)
       ServerHeader {blockSize, keySize} <- liftEither $ parse serverHeaderP (TEHandshake HEADER) header
-      when (blockSize < transportBlockSize || blockSize > maxTransportBlockSize) $
-        throwError $ TEHandshake HEADER
+      checkValidBlockSize blockSize
       s <- liftIO $ cGet c keySize
       maybe (pure ()) (validateKeyHash_2 s) keyHash
       key <- liftEither $ parseKey s
@@ -408,8 +413,8 @@ clientHandshake c keyHash = do
       baseIV <- C.randomIV
       pure SessionKey {aesKey, baseIV, counter = undefined}
     sendEncryptedKeys_4 :: C.PublicKey -> ClientHandshake -> ExceptT TransportError IO ()
-    sendEncryptedKeys_4 k keys =
-      liftError (const $ TEHandshake ENCRYPT) (C.encryptOAEP k $ serializeClientHandshake keys)
+    sendEncryptedKeys_4 k chs =
+      liftError (const $ TEHandshake ENCRYPT) (C.encryptOAEP k $ serializeClientHandshake chs)
         >>= liftIO . cPut c
     getWelcome_6 :: THandle c -> ExceptT TransportError IO SMPVersion
     getWelcome_6 th = ExceptT $ (>>= parseSMPVersion) <$> tGetEncrypted th
@@ -420,17 +425,18 @@ clientHandshake c keyHash = do
       when (major smpVersion > major currentSMPVersion) . throwE $
         TEHandshake MAJOR_VERSION
 
+checkValidBlockSize :: Int -> ExceptT TransportError IO ()
+checkValidBlockSize blkSize =
+  when (blkSize `notElem` transportBlockSizes) . throwError $ TEHandshake HEADER
+
 data ServerHeader = ServerHeader {blockSize :: Int, keySize :: Int}
   deriving (Eq, Show)
 
 binaryRsaTransport :: Int
 binaryRsaTransport = 0
 
-transportBlockSize :: Int
-transportBlockSize = 4096
-
-maxTransportBlockSize :: Int
-maxTransportBlockSize = 65536
+transportBlockSizes :: [Int]
+transportBlockSizes = map (* 1024) [4, 8, 16, 32, 64]
 
 serverHeaderSize :: Int
 serverHeaderSize = 8

src/Simplex/Messaging/Util.hs

@@ -50,3 +50,6 @@ liftError f = liftEitherError f . runExceptT
 
 liftEitherError :: (MonadIO m, MonadError e' m) => (e -> e') -> IO (Either e a) -> m a
 liftEitherError f a = liftIOEither (first f <$> a)
+
+tryError :: MonadError e m => m a -> m (Either e a)
+tryError action = (Right <$> action) `catchError` (pure . Left)

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-17.12
+resolver: lts-18.0
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.

tests/AgentTests.hs

@@ -2,44 +2,64 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PostfixOperators #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
 
-module AgentTests where
+module AgentTests (agentTests) where
 
+import AgentTests.FunctionalAPITests (functionalAPITests)
 import AgentTests.SQLiteTests (storeTests)
 import Control.Concurrent
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import SMPAgentClient
+import SMPClient (testPort, testPort2, testStoreLogFile, withSmpServer, withSmpServerStoreLogOn)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..), TProxy (..), Transport (..))
+import System.Directory (removeFile)
 import System.Timeout
 import Test.Hspec
 
 agentTests :: ATransport -> Spec
 agentTests (ATransport t) = do
+  describe "Functional API" $ functionalAPITests (ATransport t)
   describe "SQLite store" storeTests
   describe "SMP agent protocol syntax" $ syntaxTests t
   describe "Establishing duplex connection" do
     it "should connect via one server and one agent" $
       smpAgentTest2_1_1 $ testDuplexConnection t
+    it "should connect via one server and one agent (random IDs)" $
+      smpAgentTest2_1_1 $ testDuplexConnRandomIds t
     it "should connect via one server and 2 agents" $
       smpAgentTest2_2_1 $ testDuplexConnection t
+    it "should connect via one server and 2 agents (random IDs)" $
+      smpAgentTest2_2_1 $ testDuplexConnRandomIds t
     it "should connect via 2 servers and 2 agents" $
       smpAgentTest2_2_2 $ testDuplexConnection t
+    it "should connect via 2 servers and 2 agents (random IDs)" $
+      smpAgentTest2_2_2 $ testDuplexConnRandomIds t
   describe "Connection subscriptions" do
     it "should connect via one server and one agent" $
       smpAgentTest3_1_1 $ testSubscription t
     it "should send notifications to client when server disconnects" $
       smpAgentServerTest $ testSubscrNotification t
+  describe "Message delivery" do
+    it "should deliver messages after losing server connection and re-connecting" $
+      smpAgentTest2_2_2_needs_server $ testMsgDeliveryServerRestart t
+    it "should deliver pending messages after agent restarting" $
+      smpAgentTest1_1_1 $ testMsgDeliveryAgentRestart t
+
+-- | receive message to handle `h`
+(<#:) :: Transport c => c -> IO (ATransmissionOrError 'Agent)
+(<#:) = tGet SAgent
 
 -- | send transmission `t` to handle `h` and get response
 (#:) :: Transport c => c -> (ByteString, ByteString, ByteString) -> IO (ATransmissionOrError 'Agent)
-h #: t = tPutRaw h t >> tGet SAgent h
+h #: t = tPutRaw h t >> (<#:) h
 
 -- | action and expected response
 -- `h #:t #> r` is the test that sends `t` to `h` and validates that the response is `r`
@@ -58,11 +78,11 @@ correctTransmission (corrId, cAlias, cmdOrErr) = case cmdOrErr of
 
 -- | receive message to handle `h` and validate that it is the expected one
 (<#) :: Transport c => c -> ATransmission 'Agent -> Expectation
-h <# (corrId, cAlias, cmd) = tGet SAgent h `shouldReturn` (corrId, cAlias, Right cmd)
+h <# (corrId, cAlias, cmd) = (h <#:) `shouldReturn` (corrId, cAlias, Right cmd)
 
 -- | receive message to handle `h` and validate it using predicate `p`
 (<#=) :: Transport c => c -> (ATransmission 'Agent -> Bool) -> Expectation
-h <#= p = tGet SAgent h >>= (`shouldSatisfy` p . correctTransmission)
+h <#= p = (h <#:) >>= (`shouldSatisfy` p . correctTransmission)
 
 -- | test that nothing is delivered to handle `h` during 10ms
 (#:#) :: Transport c => c -> String -> Expectation
@@ -74,49 +94,182 @@ h #:# err = tryGet `shouldReturn` ()
         _ -> return ()
 
 pattern Msg :: MsgBody -> ACommand 'Agent
-pattern Msg msgBody <- MSG {msgBody, msgIntegrity = MsgOk}
+pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} msgBody
 
 testDuplexConnection :: Transport c => TProxy c -> c -> c -> IO ()
 testDuplexConnection _ alice bob = do
   ("1", "bob", Right (INV qInfo)) <- alice #: ("1", "bob", "NEW")
   let qInfo' = serializeSmpQueueInfo qInfo
-  bob #: ("11", "alice", "JOIN " <> qInfo') #> ("", "alice", CON)
+  bob #: ("11", "alice", "JOIN " <> qInfo' <> " 14\nbob's connInfo") #> ("11", "alice", OK)
+  ("", "bob", Right (REQ confId "bob's connInfo")) <- (alice <#:)
+  alice #: ("2", "bob", "ACPT " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
+  bob <# ("", "alice", INFO "alice's connInfo")
+  bob <# ("", "alice", CON)
   alice <# ("", "bob", CON)
-  alice #: ("2", "bob", "SEND :hello") =#> \case ("2", "bob", SENT 1) -> True; _ -> False
-  alice #: ("3", "bob", "SEND :how are you?") =#> \case ("3", "bob", SENT 2) -> True; _ -> False
+  alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", MID 1)
+  alice <# ("", "bob", SENT 1)
   bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
+  bob #: ("12", "alice", "ACK 1") #> ("12", "alice", OK)
+  alice #: ("4", "bob", "SEND :how are you?") #> ("4", "bob", MID 2)
+  alice <# ("", "bob", SENT 2)
   bob <#= \case ("", "alice", Msg "how are you?") -> True; _ -> False
-  bob #: ("14", "alice", "SEND 9\nhello too") =#> \case ("14", "alice", SENT 3) -> True; _ -> False
+  bob #: ("13", "alice", "ACK 2") #> ("13", "alice", OK)
+  bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 3)
+  bob <# ("", "alice", SENT 3)
   alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
-  bob #: ("15", "alice", "SEND 9\nmessage 1") =#> \case ("15", "alice", SENT 4) -> True; _ -> False
+  alice #: ("3a", "bob", "ACK 3") #> ("3a", "bob", OK)
+  bob #: ("15", "alice", "SEND 9\nmessage 1") #> ("15", "alice", MID 4)
+  bob <# ("", "alice", SENT 4)
   alice <#= \case ("", "bob", Msg "message 1") -> True; _ -> False
+  alice #: ("4a", "bob", "ACK 4") #> ("4a", "bob", OK)
   alice #: ("5", "bob", "OFF") #> ("5", "bob", OK)
-  bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", ERR (SMP AUTH))
+  bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", MID 5)
+  bob <# ("", "alice", MERR 5 (SMP AUTH))
   alice #: ("6", "bob", "DEL") #> ("6", "bob", OK)
   alice #:# "nothing else should be delivered to alice"
 
+testDuplexConnRandomIds :: Transport c => TProxy c -> c -> c -> IO ()
+testDuplexConnRandomIds _ alice bob = do
+  ("1", bobConn, Right (INV qInfo)) <- alice #: ("1", "", "NEW")
+  let qInfo' = serializeSmpQueueInfo qInfo
+  ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> qInfo' <> " 14\nbob's connInfo")
+  ("", bobConn', Right (REQ confId "bob's connInfo")) <- (alice <#:)
+  bobConn' `shouldBe` bobConn
+  alice #: ("2", bobConn, "ACPT " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False
+  bob <# ("", aliceConn, INFO "alice's connInfo")
+  bob <# ("", aliceConn, CON)
+  alice <# ("", bobConn, CON)
+  alice #: ("2", bobConn, "SEND :hello") #> ("2", bobConn, MID 1)
+  alice <# ("", bobConn, SENT 1)
+  bob <#= \case ("", c, Msg "hello") -> c == aliceConn; _ -> False
+  bob #: ("12", aliceConn, "ACK 1") #> ("12", aliceConn, OK)
+  alice #: ("3", bobConn, "SEND :how are you?") #> ("3", bobConn, MID 2)
+  alice <# ("", bobConn, SENT 2)
+  bob <#= \case ("", c, Msg "how are you?") -> c == aliceConn; _ -> False
+  bob #: ("13", aliceConn, "ACK 2") #> ("13", aliceConn, OK)
+  bob #: ("14", aliceConn, "SEND 9\nhello too") #> ("14", aliceConn, MID 3)
+  bob <# ("", aliceConn, SENT 3)
+  alice <#= \case ("", c, Msg "hello too") -> c == bobConn; _ -> False
+  alice #: ("3a", bobConn, "ACK 3") #> ("3a", bobConn, OK)
+  bob #: ("15", aliceConn, "SEND 9\nmessage 1") #> ("15", aliceConn, MID 4)
+  bob <# ("", aliceConn, SENT 4)
+  alice <#= \case ("", c, Msg "message 1") -> c == bobConn; _ -> False
+  alice #: ("4a", bobConn, "ACK 4") #> ("4a", bobConn, OK)
+  alice #: ("5", bobConn, "OFF") #> ("5", bobConn, OK)
+  bob #: ("17", aliceConn, "SEND 9\nmessage 3") #> ("17", aliceConn, MID 5)
+  bob <# ("", aliceConn, MERR 5 (SMP AUTH))
+  alice #: ("6", bobConn, "DEL") #> ("6", bobConn, OK)
+  alice #:# "nothing else should be delivered to alice"
+
 testSubscription :: Transport c => TProxy c -> c -> c -> c -> IO ()
 testSubscription _ alice1 alice2 bob = do
-  ("1", "bob", Right (INV qInfo)) <- alice1 #: ("1", "bob", "NEW")
-  let qInfo' = serializeSmpQueueInfo qInfo
-  bob #: ("11", "alice", "JOIN " <> qInfo') #> ("", "alice", CON)
-  bob #: ("12", "alice", "SEND 5\nhello") =#> \case ("12", "alice", SENT _) -> True; _ -> False
-  bob #: ("13", "alice", "SEND 11\nhello again") =#> \case ("13", "alice", SENT _) -> True; _ -> False
-  alice1 <# ("", "bob", CON)
+  (alice1, "alice") `connect` (bob, "bob")
+  bob #: ("12", "alice", "SEND 5\nhello") #> ("12", "alice", MID 1)
+  bob <# ("", "alice", SENT 1)
   alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False
+  alice1 #: ("1", "bob", "ACK 1") #> ("1", "bob", OK)
+  bob #: ("13", "alice", "SEND 11\nhello again") #> ("13", "alice", MID 2)
+  bob <# ("", "alice", SENT 2)
   alice1 <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
+  alice1 #: ("2", "bob", "ACK 2") #> ("2", "bob", OK)
   alice2 #: ("21", "bob", "SUB") #> ("21", "bob", OK)
   alice1 <# ("", "bob", END)
-  bob #: ("14", "alice", "SEND 2\nhi") =#> \case ("14", "alice", SENT _) -> True; _ -> False
+  bob #: ("14", "alice", "SEND 2\nhi") #> ("14", "alice", MID 3)
+  bob <# ("", "alice", SENT 3)
   alice2 <#= \case ("", "bob", Msg "hi") -> True; _ -> False
+  alice2 #: ("22", "bob", "ACK 3") #> ("22", "bob", OK)
   alice1 #:# "nothing else should be delivered to alice1"
 
 testSubscrNotification :: Transport c => TProxy c -> (ThreadId, ThreadId) -> c -> IO ()
-testSubscrNotification _ (server, _) client = do
-  client #: ("1", "conn1", "NEW") =#> \case ("1", "conn1", INV _) -> True; _ -> False
+testSubscrNotification t (server, _) client = do
+  client #: ("1", "conn1", "NEW") =#> \case ("1", "conn1", INV {}) -> True; _ -> False
   client #:# "nothing should be delivered to client before the server is killed"
   killThread server
-  client <# ("", "conn1", END)
+  client <# ("", "conn1", DOWN)
+  withSmpServer (ATransport t) $
+    client <# ("", "conn1", ERR (SMP AUTH)) -- this new server does not have the queue
+
+testMsgDeliveryServerRestart :: Transport c => TProxy c -> c -> c -> IO ()
+testMsgDeliveryServerRestart t alice bob = do
+  withServer $ do
+    connect (alice, "alice") (bob, "bob")
+    bob #: ("1", "alice", "SEND 2\nhi") #> ("1", "alice", MID 1)
+    bob <# ("", "alice", SENT 1)
+    alice <#= \case ("", "bob", Msg "hi") -> True; _ -> False
+    alice #: ("11", "bob", "ACK 1") #> ("11", "bob", OK)
+    alice #:# "nothing else delivered before the server is killed"
+
+  alice <# ("", "bob", DOWN)
+  bob #: ("2", "alice", "SEND 11\nhello again") #> ("2", "alice", MID 2)
+  bob #:# "nothing else delivered before the server is restarted"
+  alice #:# "nothing else delivered before the server is restarted"
+
+  withServer $ do
+    bob <# ("", "alice", SENT 2)
+    alice <# ("", "bob", UP)
+    alice <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
+    alice #: ("12", "bob", "ACK 2") #> ("12", "bob", OK)
+
+  removeFile testStoreLogFile
+  where
+    withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` ()
+
+testMsgDeliveryAgentRestart :: Transport c => TProxy c -> c -> IO ()
+testMsgDeliveryAgentRestart t bob = do
+  withAgent $ \alice -> do
+    withServer $ do
+      connect (bob, "bob") (alice, "alice")
+      alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 1)
+      alice <# ("", "bob", SENT 1)
+      bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
+      bob #: ("11", "alice", "ACK 1") #> ("11", "alice", OK)
+      bob #:# "nothing else delivered before the server is down"
+
+    bob <# ("", "alice", DOWN)
+    alice #: ("2", "bob", "SEND 11\nhello again") #> ("2", "bob", MID 2)
+    alice #:# "nothing else delivered before the server is restarted"
+    bob #:# "nothing else delivered before the server is restarted"
+
+  withAgent $ \alice -> do
+    withServer $ do
+      tPutRaw alice ("3", "bob", "SUB")
+      alice <#= \case
+        (corrId, "bob", cmd) ->
+          (corrId == "3" && cmd == OK)
+            || (corrId == "" && cmd == SENT 2)
+        _ -> False
+      bob <# ("", "alice", UP)
+      bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False
+      bob #: ("12", "alice", "ACK 2") #> ("12", "alice", OK)
+
+  removeFile testStoreLogFile
+  removeFile testDB
+  where
+    withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` ()
+    withAgent = withSmpAgentThreadOn_ (ATransport t) (agentTestPort, testPort, testDB) (pure ()) . const . testSMPAgentClientOn agentTestPort
+
+connect :: forall c. Transport c => (c, ByteString) -> (c, ByteString) -> IO ()
+connect (h1, name1) (h2, name2) = do
+  ("c1", _, Right (INV qInfo)) <- h1 #: ("c1", name2, "NEW")
+  let qInfo' = serializeSmpQueueInfo qInfo
+  h2 #: ("c2", name1, "JOIN " <> qInfo' <> " 5\ninfo2") #> ("c2", name1, OK)
+  ("", _, Right (REQ connId "info2")) <- (h1 <#:)
+  h1 #: ("c3", name2, "ACPT " <> connId <> " 5\ninfo1") #> ("c3", name2, OK)
+  h2 <# ("", name1, INFO "info1")
+  h2 <# ("", name1, CON)
+  h1 <# ("", name2, CON)
+
+-- connect' :: forall c. Transport c => c -> c -> IO (ByteString, ByteString)
+-- connect' h1 h2 = do
+--   ("c1", conn2, Right (INV qInfo)) <- h1 #: ("c1", "", "NEW")
+--   let qInfo' = serializeSmpQueueInfo qInfo
+--   ("c2", conn1, Right OK) <- h2 #: ("c2", "", "JOIN " <> qInfo' <> " 5\ninfo2")
+--   ("", _, Right (REQ connId "info2")) <- (h1 <#:)
+--   h1 #: ("c3", conn2, "ACPT " <> connId <> " 5\ninfo1") =#> \case ("c3", c, OK) -> c == conn2; _ -> False
+--   h2 <# ("", conn1, INFO "info1")
+--   h2 <# ("", conn1, CON)
+--   h1 <# ("", conn2, CON)
+--   pure (conn1, conn2)
 
 samplePublicKey :: ByteString
 samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR"
@@ -126,9 +279,8 @@ syntaxTests t = do
   it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX")
   describe "NEW" do
     describe "valid" do
-      -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided)
       -- TODO: add tests with defined connection alias
-      xit "without parameters" $ ("211", "", "NEW") >#>= \case ("211", "", "INV" : _) -> True; _ -> False
+      it "without parameters" $ ("211", "", "NEW") >#>= \case ("211", _, "INV" : _) -> True; _ -> False
     describe "invalid" do
       -- TODO: add tests with defined connection alias
       it "with parameters" $ ("222", "", "NEW hi") >#> ("222", "", "ERR CMD SYNTAX")
@@ -138,7 +290,7 @@ syntaxTests t = do
       -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided)
       -- TODO: add tests with defined connection alias
       it "using same server as in invitation" $
-        ("311", "", "JOIN smp::localhost:5000::1234::" <> samplePublicKey) >#> ("311", "", "ERR SMP AUTH")
+        ("311", "a", "JOIN smp::localhost:5000::1234::" <> samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH")
     describe "invalid" do
       -- TODO: JOIN is not merged yet - to be added
       it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX")

tests/AgentTests/FunctionalAPITests.hs

@@ -0,0 +1,163 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+
+module AgentTests.FunctionalAPITests (functionalAPITests) where
+
+import Control.Monad.Except (ExceptT, runExceptT)
+import Control.Monad.IO.Unlift
+import SMPAgentClient
+import SMPClient (withSmpServer)
+import Simplex.Messaging.Agent
+import Simplex.Messaging.Agent.Env.SQLite (dbFile)
+import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
+import Simplex.Messaging.Transport (ATransport (..))
+import System.Timeout
+import Test.Hspec
+import UnliftIO.STM
+
+(##>) :: MonadIO m => m (ATransmission 'Agent) -> ATransmission 'Agent -> m ()
+a ##> t = a >>= \t' -> liftIO (t' `shouldBe` t)
+
+(=##>) :: MonadIO m => m (ATransmission 'Agent) -> (ATransmission 'Agent -> Bool) -> m ()
+a =##> p = a >>= \t -> liftIO (t `shouldSatisfy` p)
+
+get :: MonadIO m => AgentClient -> m (ATransmission 'Agent)
+get c = atomically (readTBQueue $ subQ c)
+
+pattern Msg :: MsgBody -> ACommand 'Agent
+pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} msgBody
+
+functionalAPITests :: ATransport -> Spec
+functionalAPITests t = do
+  describe "Establishing duplex connection" $
+    it "should connect via one server using SMP agent clients" $
+      withSmpServer t testAgentClient
+  describe "Establishing connection asynchronously" $ do
+    it "should connect with initiating client going offline" $
+      withSmpServer t testAsyncInitiatingOffline
+    it "should connect with joining client going offline before its queue activation" $
+      withSmpServer t testAsyncJoiningOfflineBeforeActivation
+    -- TODO a valid test case but not trivial to implement, probably requires some agent rework
+    xit "should connect with joining client going offline after its queue activation" $
+      withSmpServer t testAsyncJoiningOfflineAfterActivation
+    it "should connect with both clients going offline" $
+      withSmpServer t testAsyncBothOffline
+
+testAgentClient :: IO ()
+testAgentClient = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  Right () <- runExceptT $ do
+    (bobId, qInfo) <- createConnection alice
+    aliceId <- joinConnection bob qInfo "bob's connInfo"
+    ("", _, REQ confId "bob's connInfo") <- get alice
+    acceptConnection alice bobId confId "alice's connInfo"
+    get alice ##> ("", bobId, CON)
+    get bob ##> ("", aliceId, INFO "alice's connInfo")
+    get bob ##> ("", aliceId, CON)
+    1 <- sendMessage alice bobId "hello"
+    get alice ##> ("", bobId, SENT 1)
+    2 <- sendMessage alice bobId "how are you?"
+    get alice ##> ("", bobId, SENT 2)
+    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+    ackMessage bob aliceId 1
+    get bob =##> \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False
+    ackMessage bob aliceId 2
+    3 <- sendMessage bob aliceId "hello too"
+    get bob ##> ("", aliceId, SENT 3)
+    4 <- sendMessage bob aliceId "message 1"
+    get bob ##> ("", aliceId, SENT 4)
+    get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
+    ackMessage alice bobId 3
+    get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False
+    ackMessage alice bobId 4
+    suspendConnection alice bobId
+    5 <- sendMessage bob aliceId "message 2"
+    get bob ##> ("", aliceId, MERR 5 (SMP AUTH))
+    deleteConnection alice bobId
+    liftIO $ noMessages alice "nothing else should be delivered to alice"
+  pure ()
+  where
+    noMessages :: AgentClient -> String -> Expectation
+    noMessages c err = tryGet `shouldReturn` ()
+      where
+        tryGet =
+          10000 `timeout` get c >>= \case
+            Just _ -> error err
+            _ -> return ()
+
+testAsyncInitiatingOffline :: IO ()
+testAsyncInitiatingOffline = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  Right () <- runExceptT $ do
+    (bobId, qInfo) <- createConnection alice
+    disconnectAgentClient alice
+    aliceId <- joinConnection bob qInfo "bob's connInfo"
+    alice' <- liftIO $ getSMPAgentClient cfg
+    subscribeConnection alice' bobId
+    ("", _, REQ confId "bob's connInfo") <- get alice'
+    acceptConnection alice' bobId confId "alice's connInfo"
+    get alice' ##> ("", bobId, CON)
+    get bob ##> ("", aliceId, INFO "alice's connInfo")
+    get bob ##> ("", aliceId, CON)
+    exchangeGreetings alice' bobId bob aliceId
+  pure ()
+
+testAsyncJoiningOfflineBeforeActivation :: IO ()
+testAsyncJoiningOfflineBeforeActivation = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  Right () <- runExceptT $ do
+    (bobId, qInfo) <- createConnection alice
+    aliceId <- joinConnection bob qInfo "bob's connInfo"
+    disconnectAgentClient bob
+    ("", _, REQ confId "bob's connInfo") <- get alice
+    acceptConnection alice bobId confId "alice's connInfo"
+    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
+    subscribeConnection bob' aliceId
+    get alice ##> ("", bobId, CON)
+    get bob' ##> ("", aliceId, INFO "alice's connInfo")
+    get bob' ##> ("", aliceId, CON)
+    exchangeGreetings alice bobId bob' aliceId
+  pure ()
+
+testAsyncJoiningOfflineAfterActivation :: IO ()
+testAsyncJoiningOfflineAfterActivation = error "not implemented"
+
+testAsyncBothOffline :: IO ()
+testAsyncBothOffline = do
+  alice <- getSMPAgentClient cfg
+  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  Right () <- runExceptT $ do
+    (bobId, qInfo) <- createConnection alice
+    disconnectAgentClient alice
+    aliceId <- joinConnection bob qInfo "bob's connInfo"
+    disconnectAgentClient bob
+    alice' <- liftIO $ getSMPAgentClient cfg
+    subscribeConnection alice' bobId
+    ("", _, REQ confId "bob's connInfo") <- get alice'
+    acceptConnection alice' bobId confId "alice's connInfo"
+    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
+    subscribeConnection bob' aliceId
+    get alice' ##> ("", bobId, CON)
+    get bob' ##> ("", aliceId, INFO "alice's connInfo")
+    get bob' ##> ("", aliceId, CON)
+    exchangeGreetings alice' bobId bob' aliceId
+  pure ()
+
+exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
+exchangeGreetings alice bobId bob aliceId = do
+  1 <- sendMessage alice bobId "hello"
+  get alice ##> ("", bobId, SENT 1)
+  get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+  ackMessage bob aliceId 1
+  2 <- sendMessage bob aliceId "hello too"
+  get bob ##> ("", aliceId, SENT 2)
+  get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
+  ackMessage alice bobId 2

tests/AgentTests/SQLiteTests.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -8,9 +9,11 @@
 module AgentTests.SQLiteTests (storeTests) where
 
 import Control.Concurrent.Async (concurrently_)
+import Control.Concurrent.STM
 import Control.Monad (replicateM_)
 import Control.Monad.Except (ExceptT, runExceptT)
 import qualified Crypto.PubKey.RSA as R
+import Crypto.Random (drgNew)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -22,8 +25,9 @@ import SMPClient (testKeyHash)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
+import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import qualified Simplex.Messaging.Crypto as C
-import System.Random (Random (randomIO))
+import System.Random
 import Test.Hspec
 import UnliftIO.Directory (removeFile)
 
@@ -39,7 +43,7 @@ withStore2 = before connect2 . after (removeStore . fst)
     connect2 :: IO (SQLiteStore, SQLiteStore)
     connect2 = do
       s1 <- createStore
-      s2 <- connectSQLiteStore $ dbFilePath s1
+      s2 <- connectSQLiteStore (dbFilePath s1) 4
       pure (s1, s2)
 
 createStore :: IO SQLiteStore
@@ -47,12 +51,15 @@ createStore = do
   -- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous
   -- IO operations on multiple similarly named files; error seems to be environment specific
   r <- randomIO :: IO Word32
-  createSQLiteStore $ testDB <> show r
+  createSQLiteStore (testDB <> show r) 4 Migrations.app
 
 removeStore :: SQLiteStore -> IO ()
 removeStore store = do
-  DB.close $ dbConn store
+  close store
   removeFile $ dbFilePath store
+  where
+    close :: SQLiteStore -> IO ()
+    close st = mapM_ DB.close =<< atomically (flushTBQueue $ dbConnPool st)
 
 returnsResult :: (Eq a, Eq e, Show a, Show e) => ExceptT e IO a -> a -> Expectation
 action `returnsResult` r = runExceptT action `shouldReturn` Right r
@@ -73,11 +80,13 @@ storeTests = do
       describe "Queue and Connection management" do
         describe "createRcvConn" do
           testCreateRcvConn
+          testCreateRcvConnRandomId
           testCreateRcvConnDuplicate
         describe "createSndConn" do
           testCreateSndConn
+          testCreateSndConnRandomID
           testCreateSndConnDuplicate
-        describe "getAllConnAliases" testGetAllConnAliases
+        describe "getAllConnIds" testGetAllConnIds
         describe "getRcvConn" testGetRcvConn
         describe "deleteConn" do
           testDeleteRcvConn
@@ -104,24 +113,29 @@ storeTests = do
 testConcurrentWrites :: SpecWith (SQLiteStore, SQLiteStore)
 testConcurrentWrites =
   it "should complete multiple concurrent write transactions w/t sqlite busy errors" $ \(s1, s2) -> do
-    _ <- runExceptT $ createRcvConn s1 rcvQueue1
-    concurrently_ (runTest s1) (runTest s2)
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn s1 g cData1 rcvQueue1
+    let ConnData {connId} = cData1
+    concurrently_ (runTest s1 connId) (runTest s2 connId)
   where
-    runTest :: SQLiteStore -> IO (Either StoreError ())
-    runTest store = runExceptT . replicateM_ 100 $ do
-      (internalId, internalRcvId, _, _) <- updateRcvIds store rcvQueue1
+    runTest :: SQLiteStore -> ConnId -> IO (Either StoreError ())
+    runTest store connId = runExceptT . replicateM_ 100 $ do
+      (internalId, internalRcvId, _, _) <- updateRcvIds store connId
       let rcvMsgData = mkRcvMsgData internalId internalRcvId 0 "0" "hash_dummy"
-      createRcvMsg store rcvQueue1 rcvMsgData
+      createRcvMsg store connId rcvMsgData
 
 testCompiledThreadsafe :: SpecWith SQLiteStore
 testCompiledThreadsafe =
-  it "compiled sqlite library should be threadsafe" $ \store -> do
-    compileOptions <- DB.query_ (dbConn store) "pragma COMPILE_OPTIONS;" :: IO [[T.Text]]
+  it "compiled sqlite library should be threadsafe" . withStoreConnection $ \db -> do
+    compileOptions <- DB.query_ db "pragma COMPILE_OPTIONS;" :: IO [[T.Text]]
     compileOptions `shouldNotContain` [["THREADSAFE=0"]]
 
+withStoreConnection :: (DB.Connection -> IO a) -> SQLiteStore -> IO a
+withStoreConnection = flip withConnection
+
 testForeignKeysEnabled :: SpecWith SQLiteStore
 testForeignKeysEnabled =
-  it "foreign keys should be enabled" $ \store -> do
+  it "foreign keys should be enabled" . withStoreConnection $ \db -> do
     let inconsistentQuery =
           [sql|
             INSERT INTO connections
@@ -129,18 +143,19 @@ testForeignKeysEnabled =
             VALUES
               ("conn1", "smp.simplex.im", "5223", "1234", "smp.simplex.im", "5223", "2345");
           |]
-    DB.execute_ (dbConn store) inconsistentQuery
+    DB.execute_ db inconsistentQuery
       `shouldThrow` (\e -> DB.sqlError e == DB.ErrorConstraint)
 
+cData1 :: ConnData
+cData1 = ConnData {connId = "conn1"}
+
 rcvQueue1 :: RcvQueue
 rcvQueue1 =
   RcvQueue
     { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
       rcvId = "1234",
-      connAlias = "conn1",
       rcvPrivateKey = C.safePrivateKey (1, 2, 3),
       sndId = Just "2345",
-      sndKey = Nothing,
       decryptKey = C.safePrivateKey (1, 2, 3),
       verifyKey = Nothing,
       status = New
@@ -151,74 +166,104 @@ sndQueue1 =
   SndQueue
     { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
       sndId = "3456",
-      connAlias = "conn1",
       sndPrivateKey = C.safePrivateKey (1, 2, 3),
       encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
-      signKey = C.safePrivateKey (1, 2, 3),
+      signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
       status = New
     }
 
 testCreateRcvConn :: SpecWith SQLiteStore
 testCreateRcvConn =
   it "should create RcvConnection and add SndQueue" $ \store -> do
-    createRcvConn store rcvQueue1
-      `returnsResult` ()
+    g <- newTVarIO =<< drgNew
+    createRcvConn store g cData1 rcvQueue1
+      `returnsResult` "conn1"
     getConn store "conn1"
-      `returnsResult` SomeConn SCRcv (RcvConnection "conn1" rcvQueue1)
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
     upgradeRcvConnToDuplex store "conn1" sndQueue1
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 sndQueue1)
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)
+
+testCreateRcvConnRandomId :: SpecWith SQLiteStore
+testCreateRcvConnRandomId =
+  it "should create RcvConnection and add SndQueue with random ID" $ \store -> do
+    g <- newTVarIO =<< drgNew
+    Right connId <- runExceptT $ createRcvConn store g cData1 {connId = ""} rcvQueue1
+    getConn store connId
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 {connId} rcvQueue1)
+    upgradeRcvConnToDuplex store connId sndQueue1
+      `returnsResult` ()
+    getConn store connId
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 {connId} rcvQueue1 sndQueue1)
 
 testCreateRcvConnDuplicate :: SpecWith SQLiteStore
 testCreateRcvConnDuplicate =
   it "should throw error on attempt to create duplicate RcvConnection" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
-    createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
+    createRcvConn store g cData1 rcvQueue1
       `throwsError` SEConnDuplicate
 
 testCreateSndConn :: SpecWith SQLiteStore
 testCreateSndConn =
   it "should create SndConnection and add RcvQueue" $ \store -> do
-    createSndConn store sndQueue1
-      `returnsResult` ()
+    g <- newTVarIO =<< drgNew
+    createSndConn store g cData1 sndQueue1
+      `returnsResult` "conn1"
     getConn store "conn1"
-      `returnsResult` SomeConn SCSnd (SndConnection "conn1" sndQueue1)
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 sndQueue1)
     upgradeSndConnToDuplex store "conn1" rcvQueue1
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 sndQueue1)
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)
+
+testCreateSndConnRandomID :: SpecWith SQLiteStore
+testCreateSndConnRandomID =
+  it "should create SndConnection and add RcvQueue with random ID" $ \store -> do
+    g <- newTVarIO =<< drgNew
+    Right connId <- runExceptT $ createSndConn store g cData1 {connId = ""} sndQueue1
+    getConn store connId
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 {connId} sndQueue1)
+    upgradeSndConnToDuplex store connId rcvQueue1
+      `returnsResult` ()
+    getConn store connId
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 {connId} rcvQueue1 sndQueue1)
 
 testCreateSndConnDuplicate :: SpecWith SQLiteStore
 testCreateSndConnDuplicate =
   it "should throw error on attempt to create duplicate SndConnection" $ \store -> do
-    _ <- runExceptT $ createSndConn store sndQueue1
-    createSndConn store sndQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createSndConn store g cData1 sndQueue1
+    createSndConn store g cData1 sndQueue1
       `throwsError` SEConnDuplicate
 
-testGetAllConnAliases :: SpecWith SQLiteStore
-testGetAllConnAliases =
+testGetAllConnIds :: SpecWith SQLiteStore
+testGetAllConnIds =
   it "should get all conn aliases" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
-    _ <- runExceptT $ createSndConn store sndQueue1 {connAlias = "conn2"}
-    getAllConnAliases store
-      `returnsResult` ["conn1" :: ConnAlias, "conn2" :: ConnAlias]
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
+    _ <- runExceptT $ createSndConn store g cData1 {connId = "conn2"} sndQueue1
+    getAllConnIds store
+      `returnsResult` ["conn1" :: ConnId, "conn2" :: ConnId]
 
 testGetRcvConn :: SpecWith SQLiteStore
 testGetRcvConn =
   it "should get connection using rcv queue id and server" $ \store -> do
     let smpServer = SMPServer "smp.simplex.im" (Just "5223") testKeyHash
     let recipientId = "1234"
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
     getRcvConn store smpServer recipientId
-      `returnsResult` SomeConn SCRcv (RcvConnection (connAlias (rcvQueue1 :: RcvQueue)) rcvQueue1)
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
 
 testDeleteRcvConn :: SpecWith SQLiteStore
 testDeleteRcvConn =
   it "should create RcvConnection and delete it" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
     getConn store "conn1"
-      `returnsResult` SomeConn SCRcv (RcvConnection "conn1" rcvQueue1)
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
     deleteConn store "conn1"
       `returnsResult` ()
     -- TODO check queues are deleted as well
@@ -228,9 +273,10 @@ testDeleteRcvConn =
 testDeleteSndConn :: SpecWith SQLiteStore
 testDeleteSndConn =
   it "should create SndConnection and delete it" $ \store -> do
-    _ <- runExceptT $ createSndConn store sndQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createSndConn store g cData1 sndQueue1
     getConn store "conn1"
-      `returnsResult` SomeConn SCSnd (SndConnection "conn1" sndQueue1)
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 sndQueue1)
     deleteConn store "conn1"
       `returnsResult` ()
     -- TODO check queues are deleted as well
@@ -240,10 +286,11 @@ testDeleteSndConn =
 testDeleteDuplexConn :: SpecWith SQLiteStore
 testDeleteDuplexConn =
   it "should create DuplexConnection and delete it" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
     _ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 sndQueue1)
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)
     deleteConn store "conn1"
       `returnsResult` ()
     -- TODO check queues are deleted as well
@@ -253,15 +300,15 @@ testDeleteDuplexConn =
 testUpgradeRcvConnToDuplex :: SpecWith SQLiteStore
 testUpgradeRcvConnToDuplex =
   it "should throw error on attempt to add SndQueue to SndConnection or DuplexConnection" $ \store -> do
-    _ <- runExceptT $ createSndConn store sndQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createSndConn store g cData1 sndQueue1
     let anotherSndQueue =
           SndQueue
             { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
               sndId = "2345",
-              connAlias = "conn1",
               sndPrivateKey = C.safePrivateKey (1, 2, 3),
               encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
-              signKey = C.safePrivateKey (1, 2, 3),
+              signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
               status = New
             }
     upgradeRcvConnToDuplex store "conn1" anotherSndQueue
@@ -273,15 +320,14 @@ testUpgradeRcvConnToDuplex =
 testUpgradeSndConnToDuplex :: SpecWith SQLiteStore
 testUpgradeSndConnToDuplex =
   it "should throw error on attempt to add RcvQueue to RcvConnection or DuplexConnection" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
     let anotherRcvQueue =
           RcvQueue
             { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
               rcvId = "3456",
-              connAlias = "conn1",
               rcvPrivateKey = C.safePrivateKey (1, 2, 3),
               sndId = Just "4567",
-              sndKey = Nothing,
               decryptKey = C.safePrivateKey (1, 2, 3),
               verifyKey = Nothing,
               status = New
@@ -295,40 +341,43 @@ testUpgradeSndConnToDuplex =
 testSetRcvQueueStatus :: SpecWith SQLiteStore
 testSetRcvQueueStatus =
   it "should update status of RcvQueue" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
     getConn store "conn1"
-      `returnsResult` SomeConn SCRcv (RcvConnection "conn1" rcvQueue1)
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
     setRcvQueueStatus store rcvQueue1 Confirmed
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCRcv (RcvConnection "conn1" rcvQueue1 {status = Confirmed})
+      `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1 {status = Confirmed})
 
 testSetSndQueueStatus :: SpecWith SQLiteStore
 testSetSndQueueStatus =
   it "should update status of SndQueue" $ \store -> do
-    _ <- runExceptT $ createSndConn store sndQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createSndConn store g cData1 sndQueue1
     getConn store "conn1"
-      `returnsResult` SomeConn SCSnd (SndConnection "conn1" sndQueue1)
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 sndQueue1)
     setSndQueueStatus store sndQueue1 Confirmed
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCSnd (SndConnection "conn1" sndQueue1 {status = Confirmed})
+      `returnsResult` SomeConn SCSnd (SndConnection cData1 sndQueue1 {status = Confirmed})
 
 testSetQueueStatusDuplex :: SpecWith SQLiteStore
 testSetQueueStatusDuplex =
   it "should update statuses of RcvQueue and SndQueue in DuplexConnection" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
     _ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 sndQueue1)
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)
     setRcvQueueStatus store rcvQueue1 Secured
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 {status = Secured} sndQueue1)
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 {status = Secured} sndQueue1)
     setSndQueueStatus store sndQueue1 Confirmed
       `returnsResult` ()
     getConn store "conn1"
-      `returnsResult` SomeConn SCDuplex (DuplexConnection "conn1" rcvQueue1 {status = Secured} sndQueue1 {status = Confirmed})
+      `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 {status = Secured} sndQueue1 {status = Confirmed})
 
 testSetRcvQueueStatusNoQueue :: SpecWith SQLiteStore
 testSetRcvQueueStatusNoQueue =
@@ -351,31 +400,36 @@ ts = UTCTime (fromGregorian 2021 02 24) (secondsToDiffTime 0)
 mkRcvMsgData :: InternalId -> InternalRcvId -> ExternalSndId -> BrokerId -> MsgHash -> RcvMsgData
 mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash =
   RcvMsgData
-    { internalId,
-      internalRcvId,
-      internalTs = ts,
-      senderMeta = (externalSndId, ts),
-      brokerMeta = (brokerId, ts),
+    { internalRcvId,
+      msgMeta =
+        MsgMeta
+          { integrity = MsgOk,
+            recipient = (unId internalId, ts),
+            sender = (externalSndId, ts),
+            broker = (brokerId, ts)
+          },
       msgBody = hw,
       internalHash,
-      externalPrevSndHash = "hash_from_sender",
-      msgIntegrity = MsgOk
+      externalPrevSndHash = "hash_from_sender"
     }
 
-testCreateRcvMsg' :: SQLiteStore -> PrevExternalSndId -> PrevRcvMsgHash -> RcvQueue -> RcvMsgData -> Expectation
-testCreateRcvMsg' store expectedPrevSndId expectedPrevHash rcvQueue rcvMsgData@RcvMsgData {..} = do
-  updateRcvIds store rcvQueue
-    `returnsResult` (internalId, internalRcvId, expectedPrevSndId, expectedPrevHash)
-  createRcvMsg store rcvQueue rcvMsgData
+testCreateRcvMsg' :: SQLiteStore -> PrevExternalSndId -> PrevRcvMsgHash -> ConnId -> RcvMsgData -> Expectation
+testCreateRcvMsg' st expectedPrevSndId expectedPrevHash connId rcvMsgData@RcvMsgData {..} = do
+  let MsgMeta {recipient = (internalId, _)} = msgMeta
+  updateRcvIds st connId
+    `returnsResult` (InternalId internalId, internalRcvId, expectedPrevSndId, expectedPrevHash)
+  createRcvMsg st connId rcvMsgData
     `returnsResult` ()
 
 testCreateRcvMsg :: SpecWith SQLiteStore
 testCreateRcvMsg =
-  it "should reserve internal ids and create a RcvMsg" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+  it "should reserve internal ids and create a RcvMsg" $ \st -> do
+    g <- newTVarIO =<< drgNew
+    let ConnData {connId} = cData1
+    _ <- runExceptT $ createRcvConn st g cData1 rcvQueue1
     -- TODO getMsg to check message
-    testCreateRcvMsg' store 0 "" rcvQueue1 $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "hash_dummy"
-    testCreateRcvMsg' store 1 "hash_dummy" rcvQueue1 $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "new_hash_dummy"
+    testCreateRcvMsg' st 0 "" connId $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "hash_dummy"
+    testCreateRcvMsg' st 1 "hash_dummy" connId $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "new_hash_dummy"
 
 mkSndMsgData :: InternalId -> InternalSndId -> MsgHash -> SndMsgData
 mkSndMsgData internalId internalSndId internalHash =
@@ -384,32 +438,37 @@ mkSndMsgData internalId internalSndId internalHash =
       internalSndId,
       internalTs = ts,
       msgBody = hw,
-      internalHash
+      internalHash,
+      previousMsgHash = internalHash
     }
 
-testCreateSndMsg' :: SQLiteStore -> PrevSndMsgHash -> SndQueue -> SndMsgData -> Expectation
-testCreateSndMsg' store expectedPrevHash sndQueue sndMsgData@SndMsgData {..} = do
-  updateSndIds store sndQueue
+testCreateSndMsg' :: SQLiteStore -> PrevSndMsgHash -> ConnId -> SndMsgData -> Expectation
+testCreateSndMsg' store expectedPrevHash connId sndMsgData@SndMsgData {..} = do
+  updateSndIds store connId
     `returnsResult` (internalId, internalSndId, expectedPrevHash)
-  createSndMsg store sndQueue sndMsgData
+  createSndMsg store connId sndMsgData
     `returnsResult` ()
 
 testCreateSndMsg :: SpecWith SQLiteStore
 testCreateSndMsg =
   it "should create a SndMsg and return InternalId and PrevSndMsgHash" $ \store -> do
-    _ <- runExceptT $ createSndConn store sndQueue1
+    g <- newTVarIO =<< drgNew
+    let ConnData {connId} = cData1
+    _ <- runExceptT $ createSndConn store g cData1 sndQueue1
     -- TODO getMsg to check message
-    testCreateSndMsg' store "" sndQueue1 $ mkSndMsgData (InternalId 1) (InternalSndId 1) "hash_dummy"
-    testCreateSndMsg' store "hash_dummy" sndQueue1 $ mkSndMsgData (InternalId 2) (InternalSndId 2) "new_hash_dummy"
+    testCreateSndMsg' store "" connId $ mkSndMsgData (InternalId 1) (InternalSndId 1) "hash_dummy"
+    testCreateSndMsg' store "hash_dummy" connId $ mkSndMsgData (InternalId 2) (InternalSndId 2) "new_hash_dummy"
 
 testCreateRcvAndSndMsgs :: SpecWith SQLiteStore
 testCreateRcvAndSndMsgs =
   it "should create multiple RcvMsg and SndMsg, correctly ordering internal Ids and returning previous state" $ \store -> do
-    _ <- runExceptT $ createRcvConn store rcvQueue1
+    g <- newTVarIO =<< drgNew
+    let ConnData {connId} = cData1
+    _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
     _ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1
-    testCreateRcvMsg' store 0 "" rcvQueue1 $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "rcv_hash_1"
-    testCreateRcvMsg' store 1 "rcv_hash_1" rcvQueue1 $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "rcv_hash_2"
-    testCreateSndMsg' store "" sndQueue1 $ mkSndMsgData (InternalId 3) (InternalSndId 1) "snd_hash_1"
-    testCreateRcvMsg' store 2 "rcv_hash_2" rcvQueue1 $ mkRcvMsgData (InternalId 4) (InternalRcvId 3) 3 "3" "rcv_hash_3"
-    testCreateSndMsg' store "snd_hash_1" sndQueue1 $ mkSndMsgData (InternalId 5) (InternalSndId 2) "snd_hash_2"
-    testCreateSndMsg' store "snd_hash_2" sndQueue1 $ mkSndMsgData (InternalId 6) (InternalSndId 3) "snd_hash_3"
+    testCreateRcvMsg' store 0 "" connId $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "rcv_hash_1"
+    testCreateRcvMsg' store 1 "rcv_hash_1" connId $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "rcv_hash_2"
+    testCreateSndMsg' store "" connId $ mkSndMsgData (InternalId 3) (InternalSndId 1) "snd_hash_1"
+    testCreateRcvMsg' store 2 "rcv_hash_2" connId $ mkRcvMsgData (InternalId 4) (InternalRcvId 3) 3 "3" "rcv_hash_3"
+    testCreateSndMsg' store "snd_hash_1" connId $ mkSndMsgData (InternalId 5) (InternalSndId 2) "snd_hash_2"
+    testCreateSndMsg' store "snd_hash_2" connId $ mkSndMsgData (InternalId 6) (InternalSndId 3) "snd_hash_3"

tests/SMPAgentClient.hs

@@ -24,6 +24,7 @@ import SMPClient
 import Simplex.Messaging.Agent (runSMPAgentBlocking)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Client (SMPClientConfig (..), smpDefaultConfig)
 import Simplex.Messaging.Transport
 import Test.Hspec
@@ -95,11 +96,15 @@ smpAgentTestN_1 n test' = runSmpAgentTestN_1 n test' `shouldReturn` ()
 smpAgentTest2_2_2 :: forall c. Transport c => (c -> c -> IO ()) -> Expectation
 smpAgentTest2_2_2 test' =
   withSmpServerOn (transport @c) testPort2 $
-    smpAgentTestN
-      [ (agentTestPort, testPort, testDB),
-        (agentTestPort2, testPort2, testDB2)
-      ]
-      _test
+    smpAgentTest2_2_2_needs_server test'
+
+smpAgentTest2_2_2_needs_server :: forall c. Transport c => (c -> c -> IO ()) -> Expectation
+smpAgentTest2_2_2_needs_server test' =
+  smpAgentTestN
+    [ (agentTestPort, testPort, testDB),
+      (agentTestPort2, testPort2, testDB2)
+    ]
+    _test
   where
     _test [h1, h2] = test' h1 h2
     _test _ = error "expected 2 handles"
@@ -139,13 +144,20 @@ smpAgentTest3_1_1 test' = smpAgentTestN_1 3 _test
     _test [h1, h2, h3] = test' h1 h2 h3
     _test _ = error "expected 3 handles"
 
+smpAgentTest1_1_1 :: forall c. Transport c => (c -> IO ()) -> Expectation
+smpAgentTest1_1_1 test' =
+  smpAgentTestN
+    [(agentTestPort2, testPort2, testDB2)]
+    _test
+  where
+    _test [h] = test' h
+    _test _ = error "expected 1 handle"
+
 cfg :: AgentConfig
 cfg =
-  AgentConfig
+  defaultAgentConfig
     { tcpPort = agentTestPort,
       smpServers = L.fromList ["localhost:5000#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="],
-      rsaKeySize = 2048 `div` 8,
-      connIdBytes = 12,
       tbqSize = 1,
       dbFile = testDB,
       smpCfg =
@@ -153,15 +165,19 @@ cfg =
           { qSize = 1,
             defaultTransport = (testPort, transport @TCP),
             tcpTimeout = 500_000
-          }
+          },
+      retryInterval = (retryInterval defaultAgentConfig) {initialInterval = 50_000}
     }
 
-withSmpAgentThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> (ThreadId -> m a) -> m a
-withSmpAgentThreadOn t (port', smpPort', db') =
+withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a
+withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess =
   let cfg' = cfg {tcpPort = port', dbFile = db', smpServers = L.fromList [SMPServer "localhost" (Just smpPort') testKeyHash]}
    in serverBracket
         (\started -> runSMPAgentBlocking t started cfg')
-        (removeFile db')
+        afterProcess
+
+withSmpAgentThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> (ThreadId -> m a) -> m a
+withSmpAgentThreadOn t a@(_, _, db') = withSmpAgentThreadOn_ t a $ removeFile db'
 
 withSmpAgentOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m a -> m a
 withSmpAgentOn t (port', smpPort', db') = withSmpAgentThreadOn t (port', smpPort', db') . const
@@ -173,7 +189,7 @@ testSMPAgentClientOn :: (Transport c, MonadUnliftIO m) => ServiceName -> (c -> m
 testSMPAgentClientOn port' client = do
   runTransportClient agentTestHost port' $ \h -> do
     line <- liftIO $ getLn h
-    if line == "Welcome to SMP v0.3.2 agent"
+    if line == "Welcome to SMP v0.4.1 agent"
       then client h
       else error $ "wrong welcome message: " <> B.unpack line
 

tests/SMPClient.hs

@@ -39,6 +39,9 @@ testPort2 = "5001"
 testKeyHashStr :: B.ByteString
 testKeyHashStr = "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
 
+testBlockSize :: Maybe Int
+testBlockSize = Just 8192
+
 testKeyHash :: Maybe C.KeyHash
 testKeyHash = Just "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
 
@@ -48,7 +51,7 @@ testStoreLogFile = "tests/tmp/smp-server-store.log"
 testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testSMPClient client =
   runTransportClient testHost testPort $ \h ->
-    liftIO (runExceptT $ clientHandshake h testKeyHash) >>= \case
+    liftIO (runExceptT $ clientHandshake h testBlockSize testKeyHash) >>= \case
       Right th -> client th
       Left e -> error $ show e
 
@@ -57,9 +60,11 @@ cfg =
   ServerConfig
     { transports = undefined,
       tbqSize = 1,
+      msgQueueQuota = 4,
       queueIdBytes = 12,
       msgIdBytes = 6,
       storeLog = Nothing,
+      blockSize = 8192,
       serverPrivateKey =
         -- full RSA private key (only for tests)
         "MIIFIwIBAAKCAQEArZyrri/NAwt5buvYjwu+B/MQeJUszDBpRgVqNddlI9kNwDXu\

tests/ServerTests.hs

@@ -337,12 +337,19 @@ testTiming (ATransport t) =
         (testSameTiming rh sh)
         [ (128, 128, 100),
           (128, 256, 25),
+          (128, 384, 15),
           -- (128, 512, 15),
           (256, 128, 100),
-          (256, 256, 25)
+          (256, 256, 25),
+          (256, 384, 15),
           -- (256, 512, 15),
+          (384, 128, 100),
+          (384, 256, 25),
+          (384, 384, 15)
+          -- (384, 512, 15),
           -- (512, 128, 100),
           -- (512, 256, 25),
+          -- (512, 384, 15),
           -- (512, 512, 15)
         ]
   where

tests/Test.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE TypeApplications #-}
 
-import AgentTests
+import AgentTests (agentTests)
 import ProtocolErrorTests
 import ServerTests
 import Simplex.Messaging.Transport (TCP, Transport (..))