Merge branch 'v5' into v5-ghc844

This commit is contained in:
Evgeny Poberezkin committed 2021-12-10 12:01:01 +00:00
commit d4770b2b8f
39 files changed
+2400 -806

No files matched your search

+10
View File
@@ -1,3 +1,13 @@
# 0.5.0
- No changes in SMP server implementation - it is backwards compatible with v0.4.1
- SMP agent changes:
- URI syntax for SMP queues and connection requests.
- long-term connections links ("contacts") in SMP agent protocol.
- agent command changes:
- `REQ` notification and `ACPT` command are used only with long-term connection links.
- `CONF` notification and `LET` commands are used for normal duplex connections.
# 0.4.1
- Include migrations in the package
+8 -8
View File
@@ -101,7 +101,7 @@ getConfig opts = do
storeLog <- liftIO $ openStoreLog opts ini
pure $ makeConfig ini pk storeLog
makeConfig :: IniOpts -> C.FullPrivateKey -> Maybe (StoreLog 'ReadMode) -> ServerConfig
makeConfig :: IniOpts -> C.PrivateKey 'C.RSA -> Maybe (StoreLog 'ReadMode) -> ServerConfig
makeConfig IniOpts {serverPort, blockSize, enableWebsockets} pk storeLog =
let transports = (serverPort, transport @TCP) : [("80", transport @WS) | enableWebsockets]
in serverConfig {serverPrivateKey = pk, storeLog, blockSize, transports}
@@ -200,11 +200,11 @@ createIni ServerOpts {enableStoreLog} = do
enableWebsockets = True
}
readKey :: IniOpts -> ExceptT String IO C.FullPrivateKey
readKey :: IniOpts -> ExceptT String IO (C.PrivateKey 'C.RSA)
readKey IniOpts {serverKeyFile} = do
fileExists serverKeyFile
liftIO (S.readKeyFile serverKeyFile) >>= \case
[S.Unprotected (PrivKeyRSA pk)] -> pure $ C.FullPrivateKey pk
[S.Unprotected (PrivKeyRSA pk)] -> pure $ C.PrivateKeyRSA pk
[_] -> err "not RSA key"
[] -> err "invalid key file format"
_ -> err "more than one key"
@@ -212,10 +212,10 @@ readKey IniOpts {serverKeyFile} = do
err :: String -> ExceptT String IO b
err e = throwE $ e <> ": " <> serverKeyFile
createKey :: IniOpts -> IO C.FullPrivateKey
createKey :: IniOpts -> IO (C.PrivateKey 'C.RSA)
createKey IniOpts {serverKeyFile} = do
(_, pk) <- C.generateKeyPair newKeySize
S.writeKeyFile S.TraditionalFormat serverKeyFile [PrivKeyRSA $ C.rsaPrivateKey pk]
(_, pk) <- C.generateKeyPair' newKeySize C.SRSA
S.writeKeyFile S.TraditionalFormat serverKeyFile [C.privateToX509 pk]
pure pk
fileExists :: FilePath -> ExceptT String IO ()
@@ -233,8 +233,8 @@ confirm msg = do
ok <- getLine
when (map toLower ok /= "y") exitFailure
serverKeyHash :: C.FullPrivateKey -> B.ByteString
serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey'
serverKeyHash :: C.PrivateKey 'C.RSA -> B.ByteString
serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey
openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode))
openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f}
+1 -1
View File
@@ -50,7 +50,7 @@ CREATE TABLE IF NOT EXISTS connections(
snd_host TEXT,
snd_port TEXT,
snd_id BLOB,
last_internal_msg_id INTEGER NOT NULL,
last_internal_msg_id INTEGER NOT NULL, -- TODO add defauls here and below in the new schema
last_internal_rcv_msg_id INTEGER NOT NULL,
last_internal_snd_msg_id INTEGER NOT NULL,
last_external_snd_msg_id INTEGER NOT NULL,
+11
View File
@@ -0,0 +1,11 @@
ALTER TABLE connections ADD conn_mode TEXT NOT NULL DEFAULT 'INV';
CREATE TABLE conn_invitations (
invitation_id BLOB NOT NULL PRIMARY KEY,
contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
cr_invitation BLOB NOT NULL,
recipient_conn_info BLOB NOT NULL,
accepted INTEGER NOT NULL DEFAULT 0,
own_conn_info BLOB,
created_at TEXT NOT NULL DEFAULT (datetime('now'))
) WITHOUT ROWID;
+2 -1
View File
@@ -1,5 +1,5 @@
name: simplexmq
version: 0.4.1
version: 0.5.0
synopsis: SimpleXMQ message broker
description: |
This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -39,6 +39,7 @@ dependencies:
- directory == 1.3.*
- file-embed >= 0.0.10.0 && <= 0.0.15.0
- filepath == 1.4.*
- http-types == 0.12.*
- generic-random >= 1.2 && < 1.5
- iso8601-time == 0.1.*
- memory >= 0.14 && < 0.16
+155 -72
View File
@@ -12,10 +12,15 @@
- [HELLO message](#hello-message)
- [REPLY message](#reply-message)
- [MSG message](#msg-message)
- [INV message](#inv-message)
- [ACK message](#ack-message)
- [NEW message](#new-message)
- [DEL message](#del-message)
- [SMP agent commands](#smp-agent-commands)
- [Client commands and server responses](#client-commands-and-server-responses)
- [NEW command and INV response](#new-command-and-inv-response)
- [JOIN command](#join-command)
- [CONF notification and LET command](#conf-notification-and-let-command)
- [REQ notification and ACPT command](#req-notification-and-acpt-command)
- [INFO and CON notifications](#info-and-con-notifications)
- [SUB command](#sub-command)
@@ -24,71 +29,68 @@
- [END notification](#end-notification)
- [OFF command](#off-command)
- [DEL command](#del-command)
- [Connection invitation](#connection-invitation)
- [Connection request](#connection-request)
## Abstract
The purpose of SMP agent protocol is to define the syntax and the semantics of communications between the client and the agent that connects to [SMP](./simplex-messaging.md) servers.
It provides:
- convenient protocol to create and manage bi-directional (duplex) connections between the users of SMP agents consisting of two (or more) separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections and any information about the servers location from the users of the protocol.
- management of E2E encryption between SMP agents, generating ephemeral RSA keys for each connection.
- SMP command authentication on SMP servers, generating ephemeral RSA keys for each SMP queue.
- TCP transport handshake and encryption with SMP servers.
- protocol to create and manage bi-directional (duplex) connections between the users of SMP agents consisting of two (or more) separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections and any information about the servers location from the users of the agent protocol.
- management of E2E encryption between SMP agents, generating ephemeral asymmetric keys for each connection.
- SMP command authentication on SMP servers, generating ephemeral keys for each SMP queue.
- TCP/TLS transport handshake with SMP servers.
- validation of message integrity.
SMP agent protocols provides no encryption or any security on the client side - it is assumed that the agent is executed in the trusted and secure environment.
The future versions of this protocol could provide:
- managing redundant SMP queues with more than 1 queue in each direction.
- managing simple symmetric groups as a foundation for chat groups and device synchronization.
- agent cluster - synchronizing states of multiple agents.
- secure "synchronous" streams with symmetric message encryption and connection-level authentication (requires extending [SMP protocol](./simplex-messaging.md)) - it can be used, e.g., for file transfers.
SMP agent protocol provides no encryption or security on the client side - it is assumed that the agent is executed in the trusted and secure environment, in one of three ways:
- via TCP network using secure connection.
- via local port (when the agent runs on the same device as a separate process).
- via agent library, when the agent logic is included directly into the client application - [SimpleX Chat for terminal](https://github.com/simplex-chat/simplex-chat) uses this approach.
## SMP agent
SMP agent is a client-side process or library that communicates via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) with other SMP agents according to the commands received from its users. This protocol is a middle layer in SMP protocols stack (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections").
SMP agents communicate with each other via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) according to the commands received from its users. This protocol is a middle layer in SimpleX protocols (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections").
The agent must have a persistent storage to manage the states of known connections and of the client-side information of two SMP queues that each connection consists of, and also the buffer of the most recent messages. The number of the messages that should be stored is implementation specific, depending on the error management approach that the agent implements; at the very least the agent must store the hash and id of the last received message.
The agent must have a persistent storage to manage the states of known connections and of the client-side information of SMP queues that each connection consists of, and also the buffer of the most recent sent and received messages. The number of the messages that should be stored is implementation specific, depending on the error management approach that the agent implements; at the very least the agent must store the hashes and IDs of the last received and sent messages.
## SMP servers management
SMP agent protocol commands do not contain SMP servers that the agent will use to establish the connections between their users. The servers are part of the agent configuration and can be dynamically added and removed by the agent implementation:
SMP agent protocol commands do not contain the addresses of the SMP servers that the agent will use to create and use the connections (excluding the server address in queue URIs used in JOIN command). The list of the servers is a part of the agent configuration and can be dynamically changed by the agent implementation:
- by the client applications via any API that is outside of scope of this protocol.
- by the agents themselves based on servers availability and latency.
- by the agents themselves based on availability and latency of the configured servers.
## SMP agent protocol components
SMP agent protocol has 3 main parts:
- the syntax and semantics of messages that SMP agents exchange between each other in order to:
- negotiate establishing unidirectional (simplex) encrypted queues on SMP server(s)
- the syntax and semantics of the messages that SMP agents exchange with each other in order to:
- negotiate establishing unidirectional (simplex) encrypted queues on SMP servers.
- exchange client messages and delivery notifications, providing sequential message IDs and message integrity (by including the hash of the previous message).
- the syntax and semantics of the commands (a higher level interface than SMP protocol) that are sent over TCP or other sequential protocol by agent clients to the agents. This protocol allows to create and manage multiple connections, each consisting of two simplex SMP queues.
- the syntax and semantics of the message that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including SMP server, queue ID and encryption key) to ensure [E2E encryption][1] the integrity of SMP queues and protection against active attacks ([MITM attacks][2]).
- the syntax and semantics of the commands that are sent by the agent clients to the agents. This protocol allows to create and manage multiple connections, each consisting of two or more SMP queues.
- the syntax and semantics of the message that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including queue URIs) to protect [E2E encryption][1] from active attacks ([MITM attacks][2]).
## Duplex connection procedure
![Duplex connection procedure](./diagrams/duplex-messaging/duplex-creating.svg)
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:
The procedure of establishing a duplex connection is explained on the example of Alice and Bob creating a bi-directional connection consisting 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 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 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.
1. Alice requests the new connection from the SMP agent A using SMP NEW command.
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 request](#connection-request).
3. Alice sends the [connection request](#connection-request) to Bob via any secure channel (out-of-band message).
4. Bob sends `JOIN` command with the connection request as a parameter to agent B to accept the connection.
5. Establishing Alice's SMP queue (with SMP protocol commands):
- Agent B sends an "SMP confirmation" with SMP SEND command to the SMP queue specified in the connection request - 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 (profile, public key for E2E encryption, etc.). This message is encrypted using key passed in the connection request (or with the derived key, in which case public key for key derivation should be sent in clear text).
- Agent A receives the SMP confirmation containing Bob's key and info as SMP MSG.
- Agent A notifies Alice sending REQ notification with Bob's info.
- Alice accepts connection request with ACPT command.
- Agent A secures the queue.
- Agent A secures the queue with SMP KEY command.
- 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 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.
- Agent B sends `REPLY` message (SMP SEND command) with the connection request to this 2nd queue to Alice's agent (via the 1st queue) - this connection request SHOULD use "simplex" URI scheme.
- Agent A, having received `REPLY` message, sends unauthenticated message (SMP SEND) 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 (SMP KEY).
- 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.
@@ -97,17 +99,21 @@ The procedure of establishing a duplex connection is explained on the example of
At this point the duplex connection between Alice and Bob is established, they can use `SEND` command to send messages. The diagram also shows how the connection status changes for both parties, where the first part is the status of the SMP queue to receive messages, and the second part - the status of the queue to send messages.
The most communication happens between the agents and servers, from the point of view of Alice and Bob they have only 3 steps to do:
The most communication happens between the agents and servers, from the point of view of Alice and Bob there are 4 steps (not including notifications):
1. Alice requests a new connection with `NEW` command and receives the invitation.
2. Alice passes invitation out-of-band to Bob.
3. Bob accepts the connection by sending `JOIN` command with the invitation to his agent.
2. Alice passes connection request out-of-band to Bob.
3. Bob accepts the connection with `JOIN` command with the connection request to his agent.
4. Alice accepts the connection with `ACPT` command.
5. Both parties receive `CON` notification once duplex connection is established.
Clients SHOULD support establishing duplex connection asynchronously (when parties are intermittently offline) by persisting intermediate states and resuming SMP queue subscriptions.
## Communication between SMP agents
SMP agents communicate via SMP servers managing creation, deletion and operations of SMP queues.
To establish duplex connections and to send messages on behalf of their clients, SMP agents communicate via SMP servers.
Agents can use SMP message client body (the part of the SMP message after header - see [SMP protocol](./simplex-messaging.md)) to transmit agent client messages and exchange messages between each other.
Agents use SMP message client body (the part of the SMP message after header - see [SMP protocol](./simplex-messaging.md)) to transmit agent client messages and exchange messages between each other.
Each SMP message client body, once decrypted, contains 3 parts (one of them may include binary message body), as defined by `decryptedSmpMessageBody` syntax:
@@ -115,8 +121,9 @@ Each SMP message client body, once decrypted, contains 3 parts (one of them may
- `agentMessage` - a command/message to the other SMP agent:
- to establish the connection with two SMP queues (`helloMsg`, `replyQueueMsg`)
- to send and to acknowledge user messages (`clientMsg`, `acknowledgeMsg`)
- to notify another agent about queue deletion (`deleteQueueMsg`)
- `msgPadding` - an optional message padding to make all SMP messages have consistent size as an additional privacy protection measure.
- to manage SMP queue rotation (`newQueueMessage`, `deleteQueueMsg`)
- to manage encryption key rotation (TODO)
- `msgPadding` - an optional message padding to make all SMP messages have constant size, to prevent servers from observing the actual message size.
### Messages between SMP agents
@@ -130,7 +137,9 @@ agentTimestamp = <date-time> ; RFC3339
previousMsgHash = encoded
encoded = <base64 encoded>
agentMessage = helloMsg / replyQueueMsg / deleteQueueMsg / clientMsg / acknowledgeMsg
agentMessage = helloMsg / replyQueueMsg /
clientMsg / invitationMsg/ acknowledgeMsg /
newQueueMessage / deleteQueueMsg
msgPadding = *OCTET ; optional random bytes to get messages to the same size (as defined in SMP message size)
@@ -138,19 +147,21 @@ helloMsg = %s"HELLO" SP signatureVerificationKey [SP %s"NO_ACK"]
; NO_ACK means that acknowledgements to client messages will NOT be sent in this connection by the agent that sent `HELLO` message.
signatureVerificationKey = encoded
replyQueueMsg = %s"REPLY" SP <queueInfo> ; `queueInfo` is the same as in out-of-band message, see SMP protocol
replyQueueMsg = %s"REPLY" SP connectionRequest ; `connectionRequest` is defined below
; this message can only be sent by the second connection party
deleteQueueMsg = %s"DEL" ; notification that recipient queue will be deleted
; no need to notify the other party about suspending queue separately, as suspended and deleted queues are the same to the sender
; NOT SUPPORTED with the current implementation
clientMsg = %s"MSG" SP size CRLF clientMsgBody CRLF ; CRLF is in addition to CRLF in decryptedSmpMessageBody
size = 1*DIGIT
clientMsgBody = *OCTET
acknowledgeMsg = %s"ACK" SP agentMsgId SP ackStatus
; NOT SUPPORTED with the current implementation
invitationMsg = %s"INV" SP connReqInvitation SP connInfo
; `connReqInvitation` and `connInfo` are defined below
acknowledgeMsg = %s"ACK" SP agentMsgId SP msgHash SP ackStatus
; NOT SUPPORTED in the current implementation
msgHash = encoded
; base64 encoded hash of the received message
ackStatus = %s"OK" / ackError
@@ -160,26 +171,51 @@ ackErrorType = ackUnknownMsg / ackProhibitedMsg / ackSyntaxErr
ackUnknownMsg = %s"UNKNOWN"
ackProhibitedMsg = %s"PROHIBITED" ; e.g. "HELLO" or "REPLY"
ackProhibitedMsg = %s"PROHIBITED" ; unexpected message e.g. "HELLO" or "REPLY"
ackSyntaxErr = %s"SYNTAX" SP syntaxErrCode
syntaxErrCode = 1*DIGIT ; TODO
newQueueMsg = %s"NEW" SP queueURI
; this message can be sent by any party to add SMP queue to the connection.
; NOT SUPPORTED in the current implementation
deleteQueueMsg = %s"DEL" SP queueURI
; notification that the queue with passed URI will be deleted
; no need to notify the other party about suspending queue separately, as suspended and deleted queues are indistinguishable to the sender
; NOT SUPPORTED in the current implementation
```
#### HELLO message
This is the first message that both agents send after the respective SMP queue is secured by the receiving agent (see diagram). It contains the verification key that the sender will use to cryptographically sign the messages.
This is the first message that both agents send after the respective SMP queue is secured by the receiving agent (see diagram). It MAY contain the public key that the recipient would use to verify messages signed by the sender.
Sending agent might need to retry sending HELLO message, as it would not have any other confirmation that the queue is secured other than the success of sending this message with the signed SEND command of SMP protocol.
Sending agent might need to retry sending HELLO message, as it would not have any other confirmation that the queue is secured other than the success of sending this message with the signed SMP SEND command.
#### REPLY message
This is the message that is sent by the agent that received an out-of-band invitation to pass the invitation to the reply SMP queue to the agent that originated the connection (see diagram).
This is the message that is sent by the agent that received an out-of-band connection request to pass the connection request for the reply SMP queues to the agent that originated the connection (see diagram).
#### MSG message
This is the agent envelope used to send client messages once the connection is established. Do not confuse it with the MSG response from SMP server to the agent and MSG response from SMP agent to the client that are sent in different contexts.
#### INV message
This message is sent to the SMP queue(s) in `connReqContact`, to establish a new connection via existing unsecured queue, that acts as a permanent connection link of a user.
#### ACK message
This message is sent to confirm the client message reception. It includes received message number, message hash and the reception status.
#### NEW message
This message is sent to add an additional SMP queue to the connection. Unlike REPLY message it can be sent at any time.
#### DEL message
This message is sent to notify that the queue with passed URI will be deleted - having received this message, the receiving agent should no longer send messages to this queue. In case it was the only queue in the connection to which the agent could send the messages, it MAY also delete the reply queue(s) in the connection.
## SMP agent commands
This part describes the transmissions between users and client-side SMP agents: commands that the users send to create and operate duplex connections and SMP agent responses and messages they deliver.
@@ -198,22 +234,32 @@ cId = encoded
cName = 1*(ALPHA / DIGIT / "_" / "-")
agentCommand = (userCmd / agentMsg) CRLF
userCmd = newCmd / joinCmd / acceptCmd / subscribeCmd / sendCmd / acknowledgeCmd / suspendCmd / deleteCmd
agentMsg = invitation / connRequest / connInfo / connected / unsubscribed / connDown / connUp / messageId / sent / messageError / message / received / ok / error
userCmd = newCmd / joinCmd / letCmd / acceptCmd / subscribeCmd / sendCmd / acknowledgeCmd / suspendCmd / deleteCmd
agentMsg = invitation / confMsg / connReqMsg / connInfo / connected / unsubscribed / connDown / connUp / messageId / sent / messageError / message / received / ok / error
newCmd = %s"NEW" [SP %s"NO_ACK"] ; response is `invitation` or `error`
newCmd = %s"NEW" SP connectionMode [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
connectionMode = %s"INV" / %s"CON"
connRequest = %s"REQ" SP confirmationId SP msgBody
invitation = %s"INV" SP connectionRequest ; `connectionRequest` is defined below
confMsg = %s"CONF" SP confirmationId SP msgBody
; msgBody here is any binary information identifying connection request
letCmd = %s"LET" SP confirmationId SP msgBody
; msgBody here is any binary information identifying connecting party
confirmationId = 1*DIGIT
acceptCmd = %s"ACPT" SP confirmationId SP msgBody
connReqMsg = %s"REQ" SP invitationId SP msgBody
; msgBody here is any binary information identifying connection request
acceptCmd = %s"ACPT" SP invitationId SP msgBody
; msgBody here is any binary information identifying connecting party
invitationId = 1*DIGIT
connInfo = %s"INFO" SP msgBody
; msgBody here is any binary information identifying connecting party
@@ -231,9 +277,10 @@ connDown = %s"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
joinCmd = %s"JOIN" SP connectionRequest SP connInfo [SP %s"NO_REPLY"] [SP %s"NO_ACK"]
; `connectionRequest` and `connInfo` are defined below
; response is `connected` or `error`
; parameters NO_REPLY and NO_ACK are currently not supported
suspendCmd = %s"OFF" ; can be sent by either party, response `ok` or `error`
@@ -275,9 +322,12 @@ previousMsgId = agentMsgId
acknowledgeCmd = %s"ACK" SP agentMsgId ; ID assigned by receiving agent (in MSG "R")
received = %s"RCVD" SP agentMsgId ; ID assigned by sending agent (in SENT response)
received = %s"RCVD" SP agentMsgId SP msgIntegrity
; ID assigned by sending agent (in SENT response)
; currently not implemented
msgStatus = ok | error
ok = %s"OK"
error = %s"ERR" SP <errorType>
@@ -287,19 +337,27 @@ 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 (the joining party). It should be used by the client of the agent that initiates creating a duplex connection (the initiating party).
`NEW` command is used to create a connection and a connection request 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 of the initiating party.
`NEW` command has `connectionMode` parameter to define the connection mode - to be used to communicate with a single contact (invitation mode, `connectionMode` is `INV`) or to accept connection requests from anybody (contact mode, `connectionMode` is `CON`). The type of connection request is determined by `connectionMode` parameter.
#### 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 (the joining party).
It is used to create a connection and accept the connection request received out-of-band. It should be used by the client of the agent that accepts the connection (the joining party).
#### CONF notification and LET command
When the joining party uses `JOIN` command to accept connection invitation created with `NEW INV` command, the initiating party will receive `CONF` 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 `LET` command.
#### REQ notification and ACPT command
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.
When the joining party uses `JOIN` command to connect to the contact created with `NEW CON` 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.
To continue with the connection the party that created the contact should use `ACPT` command.
#### INFO and CON notifications
@@ -311,17 +369,17 @@ Once the connection is established and ready to accept client messages, both age
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 MID, SENT and MERR responses
#### SEND command and MID, SENT, RCVD and MERR responses
`SEND` command is used by the client to send messages.
`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.
`MID` response 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.
`SENT` notification is sent by the agent to confirm that the message was delivered to at least one of SMP servers. 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.
`RCVD` notification is sent by the agent when it receives `ACK` message from the receiving agent. This notification contains reception status, only one successful notification will be sent, and multiple error notifications will be sent in case `ACK` had error status.
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.
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 to this SMP queue.
#### MSG notification
@@ -348,11 +406,36 @@ It is used to suspend the receiving SMP queue - sender will no longer be able to
It is used to delete the connection and all messages in it, as well as the receiving SMP queue and all messages in it that were remaining on the server. Agent response to this command can be `OK` or `ERR`. This command is irreversible.
## Connection invitation
## Connection request
Connection invitation `queueInfo` is generated by SMP agent in response to `newCmd` command (`"NEW"`), used by another party user with `joinCmd` command (`"JOIN"`), and then another invitation is sent by the agent in `replyQueueMsg` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users).
Connection request `connectionRequest` is generated by SMP agent in response to `newCmd` command (`"NEW"`), used by another party user with `joinCmd` command (`"JOIN"`), and then another connection request is sent by the agent in `replyQueueMsg` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users).
See SMP protocol [out-of-band messages](./simplex-messaging.md#out-of-band-messages) for connection invitation syntax.
Connection request syntax:
```
connectionRequest = connectionScheme "/" connReqType "#/?smp=" smpQueues "&e2e=" e2eEncryption
connReqType = %s"invitation" / %s"contact"
; this parameter has the same meaning as connectionMode in agent commands
; `NEW INV` creates `invitation` connection request, `NEW CON` - `contact`
connectionScheme = (%s"https://" clientAppServer) | %s"simplex:"
clientAppServer = hostname [ ":" port ]
; client app server, e.g. simplex.chat
e2eEncryption = encryptionScheme ":" publicKey
encryptionScheme = %s"rsa" ; end-to-end encryption and key exchange protocols,
; the current hybrid encryption scheme (RSA-OAEP/AES-256-GCM-SHA256)
; will be replaced with double ratchet protocol and DH key exchange.
publicKey = <base64url X509 SPKI key encoding>
smpQueues = smpQueue [ "," 1*smpQueue ] ; SMP queues for the connection
smpQueue = <URL-encoded queueURI defined in SMP protocol>
```
All parameters are passed via URI hash to avoid sending them to the server (in case "https" scheme is used) - they can be used by the client-side code and processed by the client application. Parameters `smp` and `e2e` can be present in any order, any unknown additional parameters SHOULD be ignored.
`clientAppServer` is not an SMP server - it is a server that shows the instruction on how to download the client app that will connect using this connection request. This server can also host a mobile or desktop app manifest so that this link is opened directly in the app if it is installed on the device.
"simplex" URI scheme in `connectionProtocol` can be used instead of client app server, to connect without creating any web traffic. Client apps MUST support this URI scheme.
See SMP protocol [out-of-band messages](./simplex-messaging.md#out-of-band-messages) for syntax of `queueURI`.
[1]: https://en.wikipedia.org/wiki/End-to-end_encryption
[2]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack
+259
View File
@@ -0,0 +1,259 @@
# SimpleX: messaging and application network
## Table of contents
- [SimpleX objectives](#simplex-objectives)
- [SimpleX network](#simplex-network)
- [Threat model](#threat-model)
## SimpleX objectives
1. Provide messaging infrastructure for distributed applications. This infrastructure needs to have the following qualities:
- Security against passive and active (man-in-the-middle) attacks: the parties should have reliable end-to-end encryption and be able to identify and to some extent compensate for the presence of the active attacker who may modify, delete or add messages.
- Privacy: network server operators should have no ability to read or modify messages without detection, and it should be impossible or hard to infer the contacts the users communicate with. Non-malicious network operators should retain no record of participants communications.
- Reliability: the messages should be delivered even if some participating network servers or receiving clients fail, with “at least once” delivery guarantee.
- Integrity: the messages should be delivered without alteration, in the same order, and any unauthorized message change should be detected by the recipient.
- Asynchronous delivery: it should not be required that both communicating parties (client devices, services or applications) are online for reliable message delivery.
- Low latency: the delay introduced by the network should not be higher than 100ms-1s in addition to the underlying TCP network latency.
2. Provide better communication privacy, in particular meta-data privacy (who talks to whom and when), and security, in particular security against active attacks, than the alternative instant messaging solutions.
3. Balance user experience with privacy requirements, prioritizing experience of mobile device users.
## SimpleX network
### Overview
SimpleX network provides asynchronous messaging infrastructure that aims to deliver on the above objectives and to avoid the disadvantages of the alternative solutions.
The key differences of SimpleX network are:
- participants do not need to have globally unique addresses to communicate, instead they use redundant unidirectional (simplex) messaging queues, with a separate set of queues for each contact.
- connection requests are passed out-of-band, non-optionally protecting key exchange against man-in-the-middle attack.
- message queues provided by network servers are used by the clients to create more complex communication scenarios, such as duplex one-to-one communication, transmitting files, group communication without central servers and content/communication channels (requiring a separate type of server to host them, which is out of scope of this document).
- servers do not store any user information (no user profiles, contacts or messages, once they are delivered), and can use in-memory persistence only.
- users can change server provider(s) without losing their communication contacts, simply by changing the configuration on which servers the new queues are created.
SimpleX network has design similar to P2P networks, but unlike most P2P networks it consists of clients and servers, without dependency on any centralized component. Servers provide anonymous unidirectional message queues in order to:
- continuously accept messages for the recipients, even when they are offline.
- provide recipient anonymity, as the messaging queues do not identify the users, and different addresses of the same queue are used for senders and recipients to provide additional protection against server traffic correlation, in case transport connections are compromised.
Coincidentally, SimpleX network reminds [Pond messenger](https://github.com/agl/pond) design, the main differences are:
- Clients can receive messages via multiple servers (in Pond users use one home server and it serves as a user permanent address),
- Clients do not need to poll servers to receive messages, the messages from subscribed queues are delivered via an open transport connection as they are received by the servers, resulting in low latency of message delivery.
### SimpleX servers
Clients communicate with servers (but not with other clients) using SimpleX Messaging Protocol (SMP) running over some transport protocol that provides server authentication, confidentiality with forward secrecy, integrity and transport channel binding (to prevent SMP commands replay).
Users can use multiple servers. They choose the servers they use to receive the messages through, and they communicate with the servers chosen by the recipients to send messages.
It is assumed that users have some degree of trust to the servers, for one of the following reasons:
- They deploy and control the servers themselves from the available open-source code. The advantage of self-deployed servers is that users have full control of server information and activity, but the downside is that it is easier to correlate incoming and outgoing messages by observing server traffic, assuming small number of messages sent via user-hosted servers and irregular communication time. It can be mitigated by:
- sending noise traffic.
- future protocol versions can add configurable per queue message delivery delays (compromising on one of the design objectives of low latency).
- using SMP servers via an onion routing or mix network.
- They use servers from the trusted commercial providers. The more clients the provider has, the less meta-data about the communication times is leaked to the network observers, and even if transport confidentiality is compromised it is not possible to correlate sent and received traffic without compromising the server, because the clients use different queue IDs to send and receive messages, and the message delivered to the recipient is additionally encrypted by the server.
- To some extent, users trust their contacts and the servers they chose that the users send messages to. The client applications could further improve user trust to the servers chosen by their contacts by supporting either the list of servers that are “allowed to send to” or “prohibited to send to” (e.g., known trusted or compromised servers, certain IP ranges, server geographical locations etc.).
If users use the free servers deployed by the volunteers, there is a risk that the server code can maliciously record all queues and messages (even though encrypted) sent via the same transport connection and to gain a partial knowledge of the user’s communications graph and other meta-data. User clients can mitigate it by using some overlay network that protects the privacy of TCP connections, e.g., Tor, and by sending noise traffic between the end users.
The servers authorize users to access (send/receive/etc.) their message queues via a digital signature of transmissions using a unique key pair different for each queue sender and recipient, so no information that is required for the server to authorize users allows to aggregate user communications across multiple queues.
### Transport
SimpleX network does not rely on transport or overlay network for server or client authentication. SMP protocol itself must provide integrity, forward secure confidentiality of communicating parties and mutual authentication even if transport protocol (but not the server) is compromised by the active attacker.
To protect against MITM attack on the transport, the clients should verify server self-signed certificate during TLS handshake by validating its pre-shared hash of the certificate in the server address (either as part of client configuration or passed in SMP connection request).
Clients use TLS1.3 protocol to connect to the server, restricting supported cryptographic protocols as defined in SimpleX Messaging Protocol.
After TCP transport connection is established, and the server is authenticated, the client sends blocks of a fixed size 16Kb, and the server replies with the blocks of the same size. When the actual message is smaller, it should be padded before encryption, and if it is larger, it can be split to chunks by the client application. The first blocks from the client and the server should include protocol version so that the party with the higher version can confirm compatibility and the transport channel identifier as described in SMP protocol.
Client can terminate the server transport connection without losing any messages – removal of the message from the server and the delivery of the next message happens when the client acknowledges the message reception (normally, after it is persisted in the client’s database).
Depending on the privacy requirements of the clients, the client can use a separate transport connection per queue, or receive messages from multiple queues via a single transport connection, for efficiency. In our implementations this configuration will be available to the end users.
### Server implementation
- does not store user access logs.
- does not store messages after the client has received them.
- permanently removes queues after they are deleted by the users
- only stores messages in transit in server operating memory; as clients are expected to use multiple servers to deliver each message, the message loss in one of the servers is acceptable.
### SimpleX clients and agents
Clients are assumed to be running on the trusted devices and can use the locally encrypted storage for messages, contacts, groups and other resources.
SimpleX clients implementing application-level protocols communicate with SimpleX servers via agents. SimpleX agents can be accessed in one of the following ways:
- via TCP network using trusted network connection or an overlay transport network.
- via local port (when the agent runs on the same device as a separate process).
- via agent library, when the agent logic is included directly into the client application.
The last option is the most secure, as it reduces the number of attack vectors in comparison with other options. The current implementation of SimpleX Chat uses this approach.
SimpleX agents provide the following operations:
- Creating and managing bi-directional (duplex) client connections and delivering messages via redundant groups of SimpleX queues.
- Exchanging keys and providing end-to-end encryption. The current prototype uses RSA cryptography with ad-hoc hybrid encryption scheme, we are currently switching it to X3DH for key exchange and double ratchet protocol for E2E encryption.
Communication between the client and the agent and the communication between the agents (via end-to-end encrypted messages delivered via SMP protocol) is described by SimpleX Agent Protocol.
Bi-directional client connections consist of multiple “send” and multiple “receive” queues (for redundancy) that agents use to send and receive messages; each queue should be used for limited amount of time, the rotation of queues is negotiated using SimpleX Agent Protocol.
There are two ways that SimpleX network users can establish the connection:
- Users communicate the initial connection invitation out-of-band, via link or via QR code. This out-of-band communication is assumed secure against active attacks and insecure against passive attacks. Once the connection is established that users are assumed to have confirmed out-of-band, the connection can no longer be compromised even if out-of-band invitation was obtained by the attacker. This out-of-band invitation does not contain any personal information, only the address of the queue and public key for the key exchange for end-to-end encryption.
- Users can create a “contact queue(s)” on SMP servers that would be used to receive connection requests. The important distinction with commonly used addressing systems is that this queue is only used to pass the connection request and not for subsequent messages. So, while it is possible to spam users who created such contact queues with connection requests, they can be removed without disrupting the communication with the existing contacts.
The reply queue addresses and the key exchange for the reply queues is negotiated via the direct queue.
### Message encryption
Messages are encrypted end-to-end using double ratchet protocol. Once the sending client deletes messages it won’t be able to decrypt them again. While messages are numbered within the queue, this only reveals to the servers how messages have been exchanged in a given queue that has a limited lifetime, so the total number of messages exchanged between contacts is not revealed.
The next queue to use is negotiated between agents in encrypted messages, and in most cases, it will be on another server (unless the client is configured to use one server, which is not recommended).
### Client storage
It is assumed that the client device and the storage is trusted, but clients can implement storage encryption using a user-provided passphrase.
## Threat model
### Assumptions
User protects their information and keys.
SimpleX Chat software is authentic.
User device is not compromised, excluding the scenarios below where it is explicitly stated it is compromised.
Used cryptographic primitives are not compromised.
### SimpleX Messaging Protocol server
**can:**
- learn when a queue recipient or sender is online via transmission times.
- correlate multiple queues to a single user in case they are accessed via the same transport connection or from the same IP address.
- correlate multiple queues to a single user based on the time they are accessed. Clients that use message notification servers can mitigate it by only subscribing to the queues after they receive the notifications and disconnecting after some time of inactivity.
- know how many messages is sent via the queue, clients can mitigate it with noise traffic.
- add, drop, duplicate or corrupt messages, but it will be detected by the client on SimpleX Agent Protocol level. Using multiple servers to deliver each message mitigates the loss of messages.
**cannot:**
- decrypt messages
- compromise e2e encryption with MITM attack (as server is only used to pass one of two keys in DH exchange, the first key is passed out-of-band)
### A global passive adversary monitoring all Internet traffic
**can:**
- learn who is using SimpleX Chat.
- learn when messages are sent and received.
- learn which SimpleX Messaging Protocol servers are used.
- in case of low traffic on the servers, correlate senders and recipients by the time messages sent and received.
- observe the approximate size of the files transmitted – to O(log log M) of file size precision.
**cannot, even in case of compromised transport protocol:**
- correlate senders and recipients by the content of messages (as different queue IDs are used for senders and recipients, with additional encryption layer in the delivered messages).
### A local network attacker
**can:**
- observe when a user is using SimpleX Chat.
- block SimpleX Chat traffic.
- determine which servers the user communicates with.
- observe the approximate size of files transmissions and receptions.
**cannot:**
- see who sends messages to the user and who the user sends the messages to
### An attacker who obtained user’s decrypted chat database
**can:**
- see the history of all messages
- see shared profiles of contacts and groups
- receive new user messages, but the user will detect it as the number and the hash of the previous message won’t match. Also, they will be instantly alerted that an unknown device is connected to their message queues, as long as they are online at the same time, as message queues only allow one active subscription.
- delete user’s message queues, so the contacts won’t be able to send messages.
- send messages from the user to their contacts, but the recipients will detect it as soon as the user sends the next message, because the previous message hash won’t match (and potentially won’t be able to decrypt them in case they don’t keep the previous ratchet keys).
**cannot:**
- impersonate a sender and send messages to the user whose database was stolen without also compromising the server (to place the message in the queue) or the user's device at a subsequent time (to place the message in the database).
### A user’s contact
**can:**
- spam the user with messages.
- forever retain messages from the user.
**cannot:**
- prove to a third-party that a message came from a user (assuming a user’s device is not seized)
- prove that two contacts they have is the same user.
- two contacts cannot confirm if they are communicating with the same user.
### An attacker with Internet access
**can:**
- DoS SimpleX messaging servers.
- spam the user who created a “contact queue” (queue for accepting connection requests) by sending multiple connection requests.
**cannot:**
- send messages to the user who they are not connected with.
+124 -87
View File
@@ -7,6 +7,7 @@
- [SMP Model](#smp-model)
- [Out-of-band messages](#out-of-band-messages)
- [Simplex queue](#simplex-queue)
- [SMP queue URI](#smp-queue-uri)
- [SMP procedure](#smp-procedure)
- [SMP qualities and features](#smp-qualities-and-features)
- [Cryptographic algorithms](#cryptographic-algorithms)
@@ -72,37 +73,15 @@ The SMP model has three communication participants: the recipient, the message b
SMP server manages multiple "simplex queues" - data records on the server that identify communication channels from the senders to the recipients. The same communicating party that is the sender in one queue, can be the recipient in another - without exposing this fact to the server.
The queue record consists of 2 unique random IDs generated by the server, one for the recipient and another for the sender, and 2 keys to authenticate the recipient and the sender respectively, provided by the client. The users of SMP protocol must use a unique key for each queue, to avoid the possibility of aggregating and analysing their queues in case SMP server is compromised.
The queue record consists of 2 unique random IDs generated by the server, one for the recipient and another for the sender, and 2 keys to authenticate the recipient and the sender respectively, provided by the client. The users of SMP protocol must use a unique key for each queue, to avoid the possibility of aggregating and analyzing their queues in case SMP server is compromised.
Creating and using the queue requires sending commands to the SMP server from the recipient and the sender - they are described in detail in [SMP commands](#smp-commands) section.
## Out-of-band messages
The out-of-band message with the queue information is sent via some trusted alternative channel from the recipient to the sender. This message is used to share the encryption (a.k.a. "public") key that the sender will use to encrypt the messages (to be decrypted by the recipient), sender queue ID, server hostname and any other information necessary to establish secure encrypted connection with SMP server (see [Appendix A](#appendix-a) for SMP transport protocol).
The out-of-band message with the queue information is sent via some trusted alternative channel from the recipient to the sender. This message is used to share one or several [queue URIs](#smp-queue-uri) that parties can use to establish the initial connection, the encryption scheme and, it can include the public key(s) for end-to-end encryption.
The [ABNF][8] syntax of the message is:
```abnf
queueInfo = %s"smp::" smpServer "::" queueId "::" encryptionKey
smpServer = srvHost [":" port] ["#" serverKeyHash]
srvHost = <hostname> ; RFC1123, RFC5891
port = 1*DIGIT
serverKeyHash = encoded
queueId = encoded
encryptionKey = %s"rsa:" x509encoded ; the recipient's RSA public key for sender to encrypt messages
x509encoded = <base64 X509 key encoding>
encoded = <base64 encoded>
```
`hostname` can be IP address or domain name, as defined in RFC 1123, section 2.1.
`port` is optional, the default TCP port for SMP protocol is 5223.
`serverKeyHash` is an optional hash of the server transport key used during transport handshake (see [Appendix A](#appendix-a)).
Encryption keys are encoded using [X509][11] specification.
Defining the approach to out-of-band message passing is out of scope of this protocol.
The approach to out-of-band message passing and their syntax should be defined in application-level protocols.
## Simplex queue
@@ -130,6 +109,29 @@ Queue is defined by recipient ID `RID` and sender ID `SID`, unique for the serve
The protocol uses different IDs for sender and recipient in order to provide an additional privacy by preventing the correlation of senders and recipients commands sent over the network - in case the encrypted transport is compromised, it would still be difficult to correlate senders and recipients without access to the queue records on the server.
## SMP queue URI
The SMP queue URIs MUST include server identity, queue hostname, an optional port, sender queue ID and the public key that the clients must use to verify responses. Server identity is used to establish secure connection protected from MITM attack with SMP server (see [Appendix A](#appendix-a) for SMP transport protocol).
The [ABNF][8] syntax of the queue URI is:
```abnf
queueURI = %s"smp://" smpServer "/" queueId "#" serverSignaturePublicKey
; serverSignaturePublicKey syntax is defined below
smpServer = serverIdentity "@" srvHost [":" port]
srvHost = <hostname> ; RFC1123, RFC5891
port = 1*DIGIT
serverIdentity = base64url
queueId = base64url
base64url = <base64url encoded binary> ; RFC4648, section 5
```
`hostname` can be IP address or domain name, as defined in RFC 1123, section 2.1.
`port` is optional, the default TCP port for SMP protocol is 5223.
`serverIdentity` is a required hash of the server certificate SPKI block (without line breaks, header and footer) used by the client to validate server certificate during transport handshake (see [Appendix A](#appendix-a))
## SMP procedure
The SMP procedure of creating a simplex queue on SMP server is explained using participants Alice (the recipient) who wants to receive messages from Bob (the sender).
@@ -272,7 +274,7 @@ Simplex Messaging Protocol:
- One unique "public" key is used by the servers to authenticate requests to send the messages into the queue, and another unique "public" key - to retrieve the messages from the queue. "Unique" here means that each "public" key is used only for one queue and is not used for any other context - effectively, this key is not public and does not represent any participant identity.
- Both recipient and sender "public" keys are provided to the server by the queue recipient. "Public" key `RK` is provided when the queue is created, public key `SK` is proviced when the queue is secured.
- Both recipient and sender "public" keys are provided to the server by the queue recipient. "Public" key `RK` is provided when the queue is created, public key `SK` is provided when the queue is secured.
- The "public" keys known to the server and used to authenticate commands from the participants are unrelated to the keys used to encrypt and decrypt the messages - the latter keys are also unique per each queue but they are only known to participants, not to the servers.
@@ -280,7 +282,7 @@ Simplex Messaging Protocol:
## Cryptographic algorithms
Simplex messaging clients need to cryptographically sign commands for the following operations:
Simplex messaging clients and servers must cryptographically sign commands, responses and messages for the following operations:
- With the recipient's key `RK` (server to verify):
- create the queue (`NEW`)
@@ -294,18 +296,22 @@ Simplex messaging clients need to cryptographically sign commands for the follow
- send messages (`SEND`)
- With the optional notifier's key:
- subscribe to message notifications (`NSUB`)
- With the server's key (for recipient and sender to verify)
- queue IDs response (`IDS`)
- notifier queue ID response (`NID`)
- delivered messages (`MSG`)
- `OK` and `ERR` responses (excluding error responses not related to a queue)
To sign and verify commands, clients and servers MUST use RSA-PSS algorithm defined in [RFC3447][2].
To sign/verify transmissions clients and servers MUST use Ed25519 or Ed448 algorithm defined in [RFC8709][15].
To optionally sign and verify messages, clients SHOULD use RSA-PSS algorithm.
To encrypt/decrypt message bodies delivered to the recipients, servers/clients MUST use x25519 or x448 algorithm defined in [RFC8709][15] to derive the shared secret (TODO encryption scheme).
To encrypt and decrypt messages, clients and servers SHOULD use RSA-OAEP algorithm defined in [RFC3447][2].
Clients MUST encrypt message bodies sent via SMP servers - the protocol for this end-to-end encryption should be chosen by the clients using SMP protocol.
The reasons to use these algorithms:
- They are supported by WebCrypto API.
- They are more widely supported than ECC algorithms.
- They are newer versions than RSA-PKCS1-v1_5 encryption and signature schemes.
- Faster operation than RSA algorithms.
- DH key exchange provides forward secrecy.
Future versions of the protocol may allow different cryptographic algorithms.
@@ -348,16 +354,18 @@ Each transmission between the client and the server must have this format/syntax
```abnf
transmission = [signature] SP signed SP pad ; pad to the fixed block size
signed = [corrId] SP [queueId] SP cmd
signed = sessionIdentifier SP [corrId] SP [queueId] SP cmd ; corrId is required in client commands and server responses,
; corrId is empty in server notifications.
cmd = ping / recipientCmd / send / subscribeNotifications / serverMsg
recipientCmd = create / subscribe / secure / enableNotifications /
acknowledge / suspend / delete
serverMsg = pong / queueIds / message / notifierId / messageNotification /
serverMsg = queueIds / message / notifierId / messageNotification /
unsubscribed / ok / error
corrId = 1*(%x21-7F) ; any characters other than control/whitespace
queueId = encoded ; empty queue ID is used with "create" command
signature = encoded
; empty signature can be used with "create", "send" and "ping" commands and server messages
; empty signature can be used with "send" before the queue is secured with secure command
; signature is always empty with "ping" and "serverMsg"
encoded = <base64 encoded binary>
```
@@ -367,23 +375,24 @@ The syntax of specific commands and responses is defined below.
### Correlating responses with commands
The server should send `queueIds`, `error` and `ok` responses in the same order within each queue ID as the commands received in the transport connection, so that they can be correlated by the clients. To simplify correlation of commands and responses, the server should use the same `corrId` in the response as in the command sent by the client.
The server should send `queueIds`, `error` and `ok` responses in the same order within each queue ID as the commands received in the transport connection, so that they can be correlated by the clients. To simplify correlation of commands and responses, the server must use the same `corrId` in the response as in the command sent by the client.
If the transport connection is closed before some responses are sent, these responses should be discarded.
### Command authentication
SMP servers must authenticate all transmissions (excluding `ping` and `send` commands) by verifying the provided signatures. Command signature should be generated by applying RSA-PSS algorithm to the `signed` block of the transmission using the key associated with the queue ID (sender's or recipient's, depending on which queue ID is used).
SMP servers must authenticate all transmissions (excluding `ping` and initial `send` commands) by verifying the client signatures. Command signature should be generated by applying the algorithm specified for the queue to the `signed` block of the transmission, using the key associated with the queue ID (recipient's, sender's or notifier's, depending on which queue ID is used).
### Keep-alive command
To keep the transport connection alive and to generate noise traffic the clients should use `ping` command to which the server responds with `pong` response. This command should be sent unsigned and without queue ID.
To keep the transport connection alive and to generate noise traffic the clients should use `ping` command to which the server responds with `ok` response. This command should be sent unsigned and without queue ID.
```abnf
ping = %s"PING"
pong = %s"PONG"
```
This command is always send unsigned.
### Recipient commands
Sending any of the commands in this section (other than `create`, that is sent without queue ID) is only allowed with recipient's ID (`RID`). If sender's ID is used the server must respond with `"ERR AUTH"` response (see [Error responses](#error-responses)).
@@ -393,24 +402,45 @@ Sending any of the commands in this section (other than `create`, that is sent w
This command is sent by the recipient to the SMP server to create a new queue. The syntax is:
```abnf
create = %s"NEW" SP recipientKey
recipientKey = %s"rsa:" x509encoded ; the recipient's RSA public key for this queue
create = %s"NEW" SP recipientSignaturePublicKey SP recipientDhPublicKey
recipientSignaturePublicKey = signaturePublicKey
; the recipient's public key to verify commands for this queue
signaturePublicKey = signatureScheme ":" x509encoded
signatureScheme = %s"rsa" | %s"ed25519" | %s"ed448"
; "rsa" means deprecated RSA-PSS signature scheme,
; it must not be used for the new queues.
recipientDhPublicKey = dhPublicKey
dhPublicKey = encryptionScheme ":" x509encoded
; the recipient's key for DH exchange to derive the secret
; that the server will use to encrypt delivered message bodies
encryptionScheme = %s"x25519" | %s"x448"
; TODO change to define the encryption scheme, e.g. "crypto_box"
x509encoded = <base64 X509 key encoding>
```
If the queue is created successfully, the server must send `queueIds` response with the recipient's and sender's queue IDs:
If the queue is created successfully, the server must send `queueIds` response with the recipient's and sender's queue IDs and public keys to sign all responses and messages and to encrypt delivered message bodies:
```abnf
queueIds = %s"IDS" SP recipientId SP senderId
SP serverSignaturePublicKey SP serverDhPublicKey
serverSignaturePublicKey = signatureKey
; the server's public key to verify responses and messages for this queue
serverDhPublicKey = dhPublicKey
; the server's key for DH exchange to derive the secret
; that the server will use to encrypt delivered message bodies to the recipient
recipientId = encoded
senderId = encoded
```
This response should be sent with empty queue ID (the second part of the transmission).
Once the queue is created, the recipient gets automatically subscribed to receive the messages from that queue, until the transport connection is closed. The `subscribe` command is needed only to start receiving the messages from the existing queue when the new transport connection is opened.
NEW `transmission` must be signed using the `recipientKey` that was passed in the transmission.
`NEW` transmission MUST be signed using the private part of the `recipientSignaturePublicKey` – this verifies that the client has the private key that will be used to sign subsequent commands for this queue.
`IDS` response transmission MUST be sent signed with `serverSignaturePublicKey` – this verifies that the server has the private key that will be used to sign subsequent responses and messages for this queue. This response should be sent with empty queue ID (the third part of the transmission).
#### Subscribe to queue
@@ -424,13 +454,16 @@ If subscription is successful the server must respond with the first available m
The first message will be delivered either immediately or as soon as it is available; to receive the following message the recipient must acknowledge the reception of the message (see [Acknowledge message delivery](#acknowledge-message-delivery)).
This transmission and its response MUST be signed.
#### Secure queue command
This command is sent by the recipient to the server to add sender's key to the queue:
```abnf
secure = %s"KEY" SP senderKey
senderKey = %s"rsa:" x509encoded ; the sender's RSA public key for this queue
secure = %s"KEY" SP senderSignaturePublicKey
senderSignaturePublicKey = signaturePublicKey
; the sender's key to verify SEND commands for this queue
```
`senderKey` is received from the sender as part of the first message - see [Send Message](#send-message) command.
@@ -443,7 +476,7 @@ This command is sent by the recipient to the server to add notifier's key to the
```abnf
enableNotifications = %s"NKEY" SP notifierKey
notifierKey = %s"rsa:" x509encoded ; the notifier's RSA public key for this queue
notifierKey = signatureScheme ":" x509encoded ; the notifier's public key public key to verify NSUB command for this queue
```
The server will respond with `notifierId` response if notifications were enabled and the notifier's key was successfully added to the queue:
@@ -453,7 +486,7 @@ notifierId = %s"NID" SP notifierId
recipientId = encoded
```
This response is sent with the recipient's queue ID (the second part of the transmission).
This response is sent with the recipient's queue ID (the third part of the transmission).
To receive the message notifications, `subscribeNotifications` command ("NSUB") must be sent signed with the notifier's key.
@@ -528,7 +561,7 @@ The body should be encrypted with the recipient's "public" key (`EK`); once decr
decryptedBody = [clientHeader] CRLF clientBody CRLF
clientHeader = senderKeyMsg
senderKeyMsg = %s"KEY" SP senderKey
senderKey = %s"rsa:" x509encoded ; the sender's RSA public key for this queue
senderKey = signatureScheme ":" x509encoded ; the sender's public key to sign SEND commands for this queue
clientBody = *OCTET
```
@@ -561,7 +594,9 @@ See its syntax in [Create queue command](#create-queue-command)
The server must deliver messages to all subscribed simplex queues on the currently open transport connection. The syntax for the message delivery is:
```abnf
message = %s"MSG" SP msgId SP timestamp SP size SP msgBody SP
message = %s"MSG" SP encryptedMessage
encryptedMessage = <encrypt sentMessage>
sentMessage = msgId SP timestamp SP size SP msgBody SP
msgId = encoded
timestamp = <date-time defined in RFC3339>
```
@@ -570,7 +605,11 @@ timestamp = <date-time defined in RFC3339>
`timestamp` - the UTC time when the server received the message from the sender, must be in date-time format defined by [RFC 3339][10]
`binaryMsg` - see syntax in [Send message](#send-message)
`msgBody` - see syntax in [Send message](#send-message)
When server delivers the messages to the recipient, message body should be encrypted with the secret derived from DH exchange using the keys passed during the queue creation and returned with `queueIds` response.
This is done to prevent the possibility of correlation of incoming and outgoing traffic of SMP server inside transport protocol.
#### Notifier queue ID response
@@ -639,52 +678,47 @@ ok = %s"OK"
Both the recipient and the sender can use TCP or some other, possibly higher level, transport protocol to communicate with the server. The default TCP port for SMP server is 5223.
By default, the client and server should use the protocol presented below, that does not depend on a centralized certificate authority.
For scenarios when meta-data privacy is critical, it is recommended that clients:
- communicating over Tor network,
- establish a separate connection for each SMP queue,
- send noise traffic (using PING command).
Transport is encrypted with [AEAD-GCM][12] protocol with two random symmetric AES 256-bit keys and two random base IVs that will be agreed during the handshake. Both client and the server should maintain two 32-bit word counters, one for the sent and one for the received messages. The IV for each message should be computed by xor-ing the sequential message counter, starting from 0, with the first 32 bits of agreed base IV (the number is encoded in network byte order).
In addition to that, the servers can be deployed as Tor onion services.
To establish the session keys and base IVs, the server should have an asymmetric key pair generated during server deployment and unknown to the clients. The users should know the key hash (256 bits) in advance in order to be able to validate the server public key during transport connection handshake.
The transport protocol should provide the following:
- server authentication (by matching server certificate hash with `serverIdentity`),
- forward secrecy (by encrypting the traffic using ephemeral keys agreed during transport handshake),
- integrity (preventing data modification by the attacker without detection),
- unique channel binding (`sessionIdentifier`) to include in the signed part of SMP transmissions.
The handshake sequence is the following:
By default, the client and server communicate using [TLS 1.3 protocol][13] restricted to:
- TLS_AES_256_GCM_SHA384 cypher suite,
- ed25519 and ed448 EdDSA algorithms for signatures,
- x25519 and x448 ECDHE groups for key exchange.
- servers must send only one self-signed certificate in the handshake, clients must abort the connection in case more than one certificate is sent.
- server and client TLS configuration should not allow resuming the sessions.
1. Once the connection is established, the server sends the `server_header` followed by its public RSA key encoded in X509 binary (not base-64 encoded) format to the client.
2. The client compares the SHA256 hash of the received key with the hash it already has (e.g. received as part of connection invitation or as SMP server configuration). If the hash does not match, the client must terminate the connection.
3. If the hash is the same, the client should generate two random symmetric 256-bit AES keys and two base IVs that will be used as session keys/IVs by the client and the server.
4. The client then should create the `client_handshake` block and send it to the server, encrypted using [RSA-OAEP][2] scheme with the server public key: `rsa-encrypt(client_handshake)`. `snd_aes_key` and `snd_base_iv` will be used by the client to encrypt **sent** messages and by the server to decrypt them, `rcv_aes_key` and `rcv_base_iv` will be used by the client to decrypt **received** messages and by the server to encrypt them. `client_handshake` also contains `block_size` and reserved `protocol` blocks (see syntax).
5. The server should decrypt the received AES keys and base IVs with its private RSA key.
6. In case of successful decryption, the server should send encrypted welcome block (`encrypted_welcome_block`) that contains SMP protocol version supported by the server.
During TLS handshake the client must validate that the hash of the server certificate SPKI block is equal to the `serverIdentity` the client received as part of SMP server address; if the server identity does not match the client must abort the connection.
All the subsequent data, both from the client and from the server, should be sent padded to the fixed agreed block size, encrypted with symmetric AES keys and base IVs (incremented by counters on both sides), that were sent by the client during the handshake. If the application needs to transmit a larger message, it should be broken down into fragments.
Once TLS handshake is complete, client and server will exchange blocks of fixed size (16384 bytes).
Handshake blocks sent by the client and the server have this syntax:
The first block sent by the client should be `clientHello` and the server should respond with `serverHello`:
```abnf
server_header = block_size protocol key_size
block_size = 4*4(OCTET) ; 4-byte block size sent by the server
protocol = 2*2(%x00) ; 0, reserved
key_size = 2*2(OCTET) ; the size of the encoded key in bytes (binary encoded in X509 standard)
clientHello = SP smpVersion SP reserved pad
serverHello = sessionIdentifier SP smpVersion SP reserved pad
sessionIdentifier = <base64 encoded> ; unique session identifier derived from transport connection handshake
; it should be included in all SMP transmissions sent in this transport connection.
client_handshake = client_block_size protocol snd_aes_key snd_base_iv rcv_aes_key rcv_base_iv
client_block_size = 4*4(OCTET) ; 4-byte block size sent by the client,
; to confirm or override the block size sent by the server
client_protocol = 2*2(%x00) ; 0, reserved
snd_aes_key = 32*32(OCTET)
snd_base_iv = 16*16(OCTET)
rcv_aes_key = 32*32(OCTET)
rcv_base_iv = 16*16(OCTET)
transport_block = aes_body_auth_tag aes_encrypted_body
; size is sent by server during handshake, usually 4096 bytes
aes_body_auth_tag = 16*16(OCTET)
aes_encrypted_body = 1*OCTET
encrypted_welcome_block = transport_block
welcome_block = smp_version SP pad ; decrypt(encrypted_welcome_block)
smp_version = %s"v" 1*DIGIT "." 1*DIGIT "." 1*DIGIT ["-" 1*ALPHA "." 1*DIGIT] ; in semver format
; for example: v123.456.789-alpha.7
smpVersion = %s"SMP v" 1*DIGIT "." 1*DIGIT "." 1*DIGIT ; semver format, the version in this document is v0.5.0
reserved = <reserved for additional information>
pad = 1*OCTET
```
For TLS 1.3 transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `serverHello` block to allow communication over some other transport protocol.
The communication party (client or server) that has the lower protocol version should assume that this version will be supported by another party, the party with the higher protocol version should abort the connection in case they cannot support the lower version.
[1]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack
[2]: https://en.wikipedia.org/wiki/End-to-end_encryption
[3]: https://en.wikipedia.org/wiki/QR_code
@@ -697,3 +731,6 @@ pad = 1*OCTET
[10]: https://tools.ietf.org/html/rfc3339
[11]: https://tools.ietf.org/html/rfc5280
[12]: https://tools.ietf.org/html/rfc7714
[13]: https://datatracker.ietf.org/doc/html/rfc8446
[14]: https://datatracker.ietf.org/doc/html/rfc5929#section-3
[15]: https://www.rfc-editor.org/rfc/rfc8709.html
+18
View File
@@ -0,0 +1,18 @@
Scheme name: simplex
Status: Provisional
Applications/protocols that use this scheme name:
This scheme is used for connection requests in SimpleX Agent Protocol,
a middle layer protocol for managing bi-directional communication via
redundant unidirectional SimpleX Messaging Protocol queues.
Contact: Evgeny Poberezkin <ep@simplex.chat>
Change controller: Evgeny Poberezkin <ep@simplex.chat>
References:
The syntax for connection requests in the latest version of SimpleX Agent Protocol:
https://github.com/simplex-chat/simplexmq/blob/v5/protocol/agent-protocol.md#connection-request
SimpleX Messaging Protocol:
https://github.com/simplex-chat/simplexmq/blob/v5/protocol/simplex-messaging.md
+16
View File
@@ -0,0 +1,16 @@
Scheme name: smp
Status: Provisional
Applications/protocols that use this scheme name:
This scheme is used for URIs of message queues in SimpleX Messaging Protocol,
a client-server protocol for asynchronous distributed unidirectional
message transmission via persistent message queues.
Contact: Evgeny Poberezkin <ep@simplex.chat>
Change controller: Evgeny Poberezkin <ep@simplex.chat>
References:
The syntax for message queue URIs in the latest version of SimpleX Messaging Protocol:
https://github.com/simplex-chat/simplexmq/blob/v5/protocol/simplex-messaging.md#smp-queue-uri
+52
View File
@@ -0,0 +1,52 @@
# Open connections
## Problem
This proposal describes how to create invitations that can be used multiple times.
It can be used for:
- an open invitation to join a group.
- an open invitation to connect to a person - e.g. QR code/invitation link on a person's website, or passed from one person to another.
- part of the solution for public DNS-based addresses (when a directory server would map address in some domain name#example.tld to an open invitation).
## Solution
No changes to SMP protocol - a dedicated unsecured SMP queue is used to receive invitations to connect that are sent in encrypted agent message. An unsecured SMP queue is used as an out-of-band channel for establishing another SMP queue.
Additional parameters in commands in SMP agent protocol:
- `NEW` command will have a parameter `INV` or `CON` to create an invitation or a permanent contact connection.
`conn_alias? OPEN` (or `PUB`, `NEWPUB`, tbc) - to create an "open"/"public" queue, the response is an invitation in a different format (TBC):
- should allow multiple servers (probably the original invitation should be extended to support it)
- should have a marker to indicate it's an open/public queue (probably the original invitation should be extended to include an invitation type).
e.g. `smp:<queue_type>::<server1>/<queue_id1>,<server2>/<queue_id2>::<key1>`
`queue_type`:
- `prv` - original invitation, should be accepted with KEY SMP message
- `pub` - open invitation, should be accepted with INV SMP message (to be added to SMP protocol)
```mmd
A ->> AA: oidA? OPEN
AA ->> A: oidA INV pub_inv
...
B ->> BA: cidBA? JOIN pub_inv len CRLF meta_binary CRLF ; change command to require meta, len can be 0 for the current usage ; meta is used to send user profile
BA ->> B: cidBA OK
BA ->> SA ->> AA: INV prv_inv CRLF meta_binary
AA ->> A: oidA CONF invID len meta_binary
A ->> AA cidAB? LET invID
establish connection as usual
BA ->> B: cidBA CON
AA ->> A: cidAB CON
```
That protocol requires addressing the current problem when an invitation cannot be accepted when the party that generated the invitation is not online.
Questions.
1. Do we need to differentiate the semantics of the invitation on the syntax level, or should we allow to just manage it outside of protocol when the receiving agent decides which SMP messages to accept and which to ignore (KEY / INV).
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
+7 -1
View File
@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack
name: simplexmq
version: 0.4.1
version: 0.5.0
synopsis: SimpleXMQ message broker
description: This package includes <./docs/Simplex-Messaging-Server.html server>,
<./docs/Simplex-Messaging-Client.html client> and
@@ -29,6 +29,7 @@ extra-source-files:
migrations/20210101_initial.sql
migrations/20210624_confirmations.sql
migrations/20210809_snd_messages.sql
migrations/20211202_connection_mode.sql
migrations/README.md
library
@@ -79,6 +80,7 @@ library
, file-embed >=0.0.10.0 && <=0.0.15.0
, filepath ==1.4.*
, generic-random >=1.2 && <1.5
, http-types ==0.12.*
, iso8601-time ==0.1.*
, memory >=0.14 && <0.16
, mtl ==2.2.*
@@ -124,6 +126,7 @@ executable smp-agent
, file-embed >=0.0.10.0 && <=0.0.15.0
, filepath ==1.4.*
, generic-random >=1.2 && <1.5
, http-types ==0.12.*
, iso8601-time ==0.1.*
, memory >=0.14 && <0.16
, mtl ==2.2.*
@@ -171,6 +174,7 @@ executable smp-server
, file-embed >=0.0.10.0 && <=0.0.15.0
, filepath ==1.4.*
, generic-random >=1.2 && <1.5
, http-types ==0.12.*
, ini >=0.3 && <0.5
, iso8601-time ==0.1.*
, memory >=0.14 && <0.16
@@ -198,6 +202,7 @@ test-suite smp-server-test
main-is: Test.hs
other-modules:
AgentTests
AgentTests.ConnectionRequestTests
AgentTests.FunctionalAPITests
AgentTests.SQLiteTests
ProtocolErrorTests
@@ -230,6 +235,7 @@ test-suite smp-server-test
, generic-random >=1.2 && <1.5
, hspec >=2.5 && <2.8
, hspec-core >=2.5 && <2.8
, http-types ==0.12.*
, iso8601-time ==0.1.*
, memory >=0.14 && <0.16
, mtl ==2.2.*
+141 -99
View File
@@ -4,8 +4,10 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
@@ -42,7 +44,9 @@ module Simplex.Messaging.Agent
withAgentLock,
createConnection,
joinConnection,
acceptConnection,
allowConnection,
acceptContact,
rejectContact,
subscribeConnection,
sendMessage,
ackMessage,
@@ -63,7 +67,6 @@ 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
@@ -80,10 +83,10 @@ import Simplex.Messaging.Client (SMPServerTransmission)
import qualified Simplex.Messaging.Crypto as C
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, tryError, stateTVar)
import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), currentSMPVersionStr, runTransportServer)
import Simplex.Messaging.Util (bshow, stateTVar, tryError, unlessM)
import System.Random (randomR)
import UnliftIO.Async (Async, async, race_)
import UnliftIO.Async (async, race_)
import qualified UnliftIO.Exception as E
import UnliftIO.STM
@@ -104,7 +107,7 @@ 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.4.1 agent"
liftIO . putLn h $ "Welcome to SMP agent v" <> currentSMPVersionStr
c <- getAgentClient
logConnection c True
race_ (connectClient h c) (runAgentClient c)
@@ -126,16 +129,24 @@ 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 ""
createConnection :: AgentErrorMonad m => AgentClient -> SConnectionMode c -> m (ConnId, ConnectionRequest c)
createConnection c cMode = withAgentEnv c $ newConn c "" cMode
-- | Join SMP agent connection (JOIN command)
joinConnection :: AgentErrorMonad m => AgentClient -> SMPQueueInfo -> ConnInfo -> m ConnId
joinConnection :: AgentErrorMonad m => AgentClient -> ConnectionRequest c -> 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
-- | Allow connection to continue after CONF notification (LET command)
allowConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
allowConnection c = withAgentEnv c .:. allowConnection' c
-- | Accept contact after REQ notification (ACPT command)
acceptContact :: AgentErrorMonad m => AgentClient -> ConfirmationId -> ConnInfo -> m ConnId
acceptContact c = withAgentEnv c .: acceptContact' c ""
-- | Reject contact (RJCT command)
rejectContact :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> m ()
rejectContact c = withAgentEnv c .: rejectContact' c
-- | Subscribe to receive connection messages (SUB command)
subscribeConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
@@ -228,33 +239,39 @@ withStore action = do
SEConnDuplicate -> CONN DUPLICATE
SEBadConnType CRcv -> CONN SIMPLEX
SEBadConnType CSnd -> CONN SIMPLEX
SEInvitationNotFound -> CMD PROHIBITED
e -> INTERNAL $ show e
-- | 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)
NEW (ACM cMode) -> second (INV . ACR cMode) <$> newConn c connId cMode
JOIN (ACR _ cReq) connInfo -> (,OK) <$> joinConn c connId cReq connInfo
LET confId ownCInfo -> allowConnection' c connId confId ownCInfo $> (connId, OK)
ACPT invId ownCInfo -> (,OK) <$> acceptContact' c connId invId ownCInfo
RJCT invId -> rejectContact' c connId invId $> (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
newConn :: AgentMonad m => AgentClient -> ConnId -> SConnectionMode c -> m (ConnId, ConnectionRequest c)
newConn c connId cMode = do
srv <- getSMPServer
(rq, qInfo) <- newRcvQueue c srv
(rq, qUri, encryptKey) <- newRcvQueue c srv
g <- asks idsDrg
let cData = ConnData {connId}
connId' <- withStore $ \st -> createRcvConn st g cData rq
connId' <- withStore $ \st -> createRcvConn st g cData rq cMode
addSubscription c rq connId'
pure (connId', qInfo)
let crData = ConnReqData simplexChat [qUri] encryptKey
pure . (connId',) $ case cMode of
SCMInvitation -> CRInvitation crData
SCMContact -> CRContact crData
joinConn :: AgentMonad m => AgentClient -> ConnId -> SMPQueueInfo -> ConnInfo -> m ConnId
joinConn c connId qInfo cInfo = do
(sq, senderKey, verifyKey) <- newSndQueue qInfo
joinConn :: AgentMonad m => AgentClient -> ConnId -> ConnectionRequest c -> ConnInfo -> m ConnId
joinConn c connId (CRInvitation (ConnReqData _ (qUri :| _) encryptKey)) cInfo = do
(sq, senderKey, verifyKey) <- newSndQueue qUri encryptKey
g <- asks idsDrg
cfg <- asks config
let cData = ConnData {connId}
@@ -262,28 +279,47 @@ joinConn c connId qInfo cInfo = do
confirmQueue c sq senderKey cInfo
activateQueueJoining c connId' sq verifyKey $ retryInterval cfg
pure connId'
joinConn c connId (CRContact (ConnReqData _ (qUri :| _) encryptKey)) cInfo = do
(connId', cReq) <- newConn c connId SCMInvitation
sendInvitation c qUri encryptKey cReq cInfo
pure connId'
activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m ()
activateQueueJoining c connId sq verifyKey retryInterval =
activateQueue c connId sq verifyKey retryInterval createReplyQueue
where
createReplyQueue :: m ()
createReplyQueue = do
srv <- getSMPServer
(rq, qInfo') <- newRcvQueue c srv
(rq, qUri', encryptKey) <- newRcvQueue c srv
addSubscription c rq connId
withStore $ \st -> upgradeSndConnToDuplex st connId rq
sendControlMessage c sq $ REPLY qInfo'
sendControlMessage c sq . REPLY $ CRInvitation $ ConnReqData CRSSimplex [qUri'] encryptKey
-- | Approve confirmation (LET command) in Reader monad
acceptConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
acceptConnection' c connId confId ownConnInfo =
allowConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
allowConnection' c connId confId ownConnInfo = do
withStore (`getConn` connId) >>= \case
SomeConn SCRcv (RcvConnection _ rq) -> do
SomeConn _ (RcvConnection _ rq) -> do
AcceptedConfirmation {senderKey} <- withStore $ \st -> acceptConfirmation st confId ownConnInfo
processConfirmation c rq senderKey
_ -> throwError $ CMD PROHIBITED
-- | Accept contact (ACPT command) in Reader monad
acceptContact' :: AgentMonad m => AgentClient -> ConnId -> InvitationId -> ConnInfo -> m ConnId
acceptContact' c connId invId ownConnInfo = do
Invitation {contactConnId, connReq} <- withStore (`getInvitation` invId)
withStore (`getConn` contactConnId) >>= \case
SomeConn _ ContactConnection {} -> do
withStore $ \st -> acceptInvitation st invId ownConnInfo
joinConn c connId connReq ownConnInfo
_ -> throwError $ CMD PROHIBITED
-- | Reject contact (RJCT command) in Reader monad
rejectContact' :: AgentMonad m => AgentClient -> ConnId -> InvitationId -> m ()
rejectContact' _ contactConnId invId =
withStore $ \st -> deleteInvitation st contactConnId invId
processConfirmation :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
processConfirmation c rq sndKey = do
withStore $ \st -> setRcvQueueStatus st rq Confirmed
@@ -295,38 +331,30 @@ subscribeConnection' :: forall m. AgentMonad m => AgentClient -> ConnId -> m ()
subscribeConnection' c connId =
withStore (`getConn` connId) >>= \case
SomeConn _ (DuplexConnection _ rq sq) -> do
resumeDelivery sq
resumeMsgDelivery c connId sq
case status (sq :: SndQueue) of
Confirmed -> withVerifyKey sq $ \verifyKey -> do
Confirmed -> 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
activateSecuredQueue rq sq
Secured -> activateSecuredQueue rq sq
Active -> subscribeQueue c rq connId
_ -> throwError $ INTERNAL "unexpected queue status"
SomeConn _ (SndConnection _ sq) -> do
resumeDelivery sq
resumeMsgDelivery c connId sq
case status (sq :: SndQueue) of
Confirmed -> withVerifyKey sq $ \verifyKey ->
activateQueueJoining c connId sq verifyKey =<< resumeInterval
Confirmed -> activateQueueJoining c connId sq (verifyKey sq) =<< resumeInterval
Active -> throwError $ CONN SIMPLEX
_ -> throwError $ INTERNAL "unexpected queue status"
SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId
SomeConn _ (ContactConnection _ 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
verifyKey :: SndQueue -> C.APublicVerifyKey
verifyKey = C.publicKey . signKey
activateSecuredQueue :: RcvQueue -> SndQueue -> m ()
activateSecuredQueue rq sq = do
activateQueueInitiating c connId sq (verifyKey sq) =<< resumeInterval
subscribeQueue c rq connId
resumeInterval :: m RetryInterval
resumeInterval = do
@@ -342,14 +370,10 @@ sendMessage' c connId msg =
_ -> throwError $ CONN SIMPLEX
where
enqueueMessage :: SndQueue -> m AgentMsgId
enqueueMessage SndQueue {server} = do
enqueueMessage sq@SndQueue {server} = do
resumeMsgDelivery c connId sq
msgId <- storeSentMsg
wasDelivering <- resumeMsgDelivery c connId server
pending <-
if wasDelivering
then pure [PendingMsg {connId, msgId}]
else withStore (`getPendingMsgs` connId)
queuePendingMsgs c connId pending
queuePendingMsgs c connId server [msgId]
pure $ unId msgId
where
storeSentMsg :: m InternalId
@@ -370,42 +394,41 @@ sendMessage' c connId msg =
createSndMsg st connId msgData
pure internalId
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
resumeMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> m ()
resumeMsgDelivery c connId SndQueue {server} = do
unlessM srvDelivering $
async (runSrvMsgDelivery c server)
>>= atomically . modifyTVar (srvMsgDeliveries c) . M.insert server
unlessM connQueued $
withStore (`getPendingMsgs` connId)
>>= queuePendingMsgs c connId server
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
srvDelivering = isJust . M.lookup server <$> readTVarIO (srvMsgDeliveries c)
connQueued =
atomically $
isJust
<$> stateTVar
(connMsgsQueued c)
(\m -> (M.lookup connId m, M.insert connId True m))
queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> [PendingMsg] -> m ()
queuePendingMsgs c connId pending =
atomically $ getPendingMsgQ connId (connMsgQueues c) >>= forM_ pending . writeTQueue
queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> SMPServer -> [InternalId] -> m ()
queuePendingMsgs c connId server msgIds = atomically $ do
q <- getPendingMsgQ c server
mapM_ (writeTQueue q . PendingMsg connId) msgIds
getPendingMsgQ :: Ord a => a -> TVar (Map a (TQueue PendingMsg)) -> STM (TQueue PendingMsg)
getPendingMsgQ key queueMap = do
maybe newMsgQueue pure . M.lookup key =<< readTVar queueMap
getPendingMsgQ :: AgentClient -> SMPServer -> STM (TQueue PendingMsg)
getPendingMsgQ c srv = do
maybe newMsgQueue pure . M.lookup srv =<< readTVar (srvMsgQueues c)
where
newMsgQueue :: STM (TQueue PendingMsg)
newMsgQueue = do
mq <- newTQueue
modifyTVar queueMap $ M.insert key mq
modifyTVar (srvMsgQueues c) $ M.insert srv mq
pure mq
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
runSrvMsgDelivery :: forall m. AgentMonad m => AgentClient -> SMPServer -> m ()
runSrvMsgDelivery c@AgentClient {subQ} srv = do
mq <- atomically . getPendingMsgQ srv $ srvMsgQueues c
mq <- atomically $ getPendingMsgQ c srv
ri <- asks $ reconnectInterval . config
forever $ do
PendingMsg {connId, msgId} <- atomically $ readTQueue mq
@@ -456,7 +479,8 @@ deleteConnection' c connId =
withStore (`getConn` connId) >>= \case
SomeConn _ (DuplexConnection _ rq _) -> delete rq
SomeConn _ (RcvConnection _ rq) -> delete rq
_ -> withStore (`deleteConn` connId)
SomeConn _ (ContactConnection _ rq) -> delete rq
SomeConn _ (SndConnection _ _) -> withStore (`deleteConn` connId)
where
delete :: RcvQueue -> m ()
delete rq = do
@@ -496,6 +520,7 @@ 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
SomeConn SCContact (ContactConnection cData rq) -> processSMP SCContact cData rq
_ -> atomically $ writeTBQueue subQ ("", "", ERR $ CONN NOT_FOUND)
where
processSMP :: SConnType c -> ConnData -> RcvQueue -> m ()
@@ -506,13 +531,14 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
msg <- decryptAndVerify rq msgBody
let msgHash = C.sha256Hash msg
case parseSMPMessage msg of
Left e -> notify $ ERR e
Left e -> notify (ERR e) >> sendAck c rq
Right (SMPConfirmation senderKey cInfo) -> smpConfirmation senderKey cInfo >> sendAck c rq
Right SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} ->
case agentMessage of
HELLO verifyKey _ -> helloMsg verifyKey msgBody >> sendAck c rq
REPLY qInfo -> replyMsg qInfo >> sendAck c rq
REPLY cReq -> replyMsg cReq >> sendAck c rq
A_MSG body -> agentClientMsg previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash
A_INV cReq cInfo -> smpInvitation cReq cInfo >> sendAck c rq
SMP.END -> do
removeSubscription c connId
logServer "<--" c srv rId "END"
@@ -536,7 +562,7 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
g <- asks idsDrg
let newConfirmation = NewConfirmation {connId, senderKey, senderConnInfo = cInfo}
confId <- withStore $ \st -> createConfirmation st g newConfirmation
notify $ REQ confId cInfo
notify $ CONF confId cInfo
SCDuplex -> do
notify $ INFO cInfo
processConfirmation c rq senderKey
@@ -555,13 +581,13 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
SCDuplex -> notifyConnected c connId
_ -> pure ()
replyMsg :: SMPQueueInfo -> m ()
replyMsg qInfo = do
replyMsg :: ConnectionRequest 'CMInvitation -> m ()
replyMsg (CRInvitation (ConnReqData _ (qUri :| _) encryptKey)) = do
logServer "<--" c srv rId "MSG <REPLY>"
case cType of
SCRcv -> do
AcceptedConfirmation {ownConnInfo} <- withStore (`getAcceptedConfirmation` connId)
(sq, senderKey, verifyKey) <- newSndQueue qInfo
(sq, senderKey, verifyKey) <- newSndQueue qUri encryptKey
withStore $ \st -> upgradeRcvConnToDuplex st connId sq
confirmQueue c sq senderKey ownConnInfo
withStore (`removeConfirmations` connId)
@@ -581,6 +607,17 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
withStore $ \st -> createRcvMsg st connId rcvMsg
notify $ MSG msgMeta msgBody
smpInvitation :: ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
smpInvitation connReq cInfo = do
logServer "<--" c srv rId "MSG <KEY>"
case cType of
SCContact -> do
g <- asks idsDrg
let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo}
invId <- withStore $ \st -> createInvitation st g newInv
notify $ REQ invId cInfo
_ -> prohibited
checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity
checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash receivedPrevMsgHash
| extSndId == prevExtSndId + 1 && internalPrevMsgHash == receivedPrevMsgHash = MsgOk
@@ -595,11 +632,11 @@ confirmQueue c sq senderKey cInfo = do
sendConfirmation c sq senderKey cInfo
withStore $ \st -> setSndQueueStatus st sq Confirmed
activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> 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 :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m () -> m ()
activateQueue c connId sq verifyKey retryInterval afterActivation =
getActivation c connId >>= \case
Nothing -> async runActivation >>= addActivation c connId
@@ -610,22 +647,27 @@ activateQueue c connId sq verifyKey retryInterval afterActivation =
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
(MonadUnliftIO m, MonadReader Env m) => SMPQueueUri -> C.APublicEncryptKey -> m (SndQueue, SenderPublicKey, C.APublicVerifyKey)
newSndQueue qUri encryptKey =
asks (cmdSignAlg . config) >>= \case
C.SignAlg a -> newSndQueue_ a qUri encryptKey
newSndQueue_ ::
(C.SignatureAlgorithm a, C.AlgorithmI a, MonadUnliftIO m, MonadReader Env m) =>
C.SAlgorithm a ->
SMPQueueUri ->
C.APublicEncryptKey ->
m (SndQueue, SenderPublicKey, C.APublicVerifyKey)
newSndQueue_ a (SMPQueueUri smpServer senderId _) encryptKey = do
size <- asks $ rsaKeySize . config
(senderKey, sndPrivateKey) <- liftIO $ C.generateKeyPair size
(verifyKey, signKey) <- liftIO $ C.generateKeyPair size
(senderKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair size a
(verifyKey, signKey) <- liftIO $ C.generateSignatureKeyPair size C.SRSA
let sndQueue =
SndQueue
{ server = smpServer,
+58 -20
View File
@@ -17,6 +17,7 @@ module Simplex.Messaging.Agent.Client
subscribeQueue,
addSubscription,
sendConfirmation,
sendInvitation,
RetryInterval (..),
sendHello,
secureQueue,
@@ -71,8 +72,7 @@ data AgentClient = AgentClient
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 ())),
connMsgsQueued :: TVar (Map ConnId Bool),
srvMsgQueues :: TVar (Map SMPServer (TQueue PendingMsg)),
srvMsgDeliveries :: TVar (Map SMPServer (Async ())),
reconnections :: TVar [Async ()],
@@ -92,14 +92,13 @@ newAgentClient agentEnv = do
subscrSrvrs <- newTVar M.empty
subscrConns <- newTVar M.empty
activations <- newTVar M.empty
connMsgQueues <- newTVar M.empty
connMsgDeliveries <- newTVar M.empty
connMsgsQueued <- 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}
return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, activations, connMsgsQueued, 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)
@@ -175,7 +174,6 @@ closeAgentClient c = liftIO $ do
closeSMPServerClients c
cancelActions $ activations c
cancelActions $ reconnections c
cancelActions $ connMsgDeliveries c
cancelActions $ srvMsgDeliveries c
closeSMPServerClients :: AgentClient -> IO ()
@@ -225,14 +223,24 @@ smpClientError = \case
SMPTransportError e -> BROKER $ TRANSPORT e
e -> INTERNAL $ show e
newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueInfo)
newRcvQueue c srv = do
newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri, C.APublicEncryptKey)
newRcvQueue c srv =
asks (cmdSignAlg . config) >>= \case
C.SignAlg a -> newRcvQueue_ a c srv
newRcvQueue_ ::
(C.SignatureAlgorithm a, C.AlgorithmI a, AgentMonad m) =>
C.SAlgorithm a ->
AgentClient ->
SMPServer ->
m (RcvQueue, SMPQueueUri, C.APublicEncryptKey)
newRcvQueue_ a c srv = do
size <- asks $ rsaKeySize . config
(recipientKey, rcvPrivateKey) <- liftIO $ C.generateKeyPair size
(recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair size a
logServer "-->" c srv "" "NEW"
(rcvId, sId) <- withSMP c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey
logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sId]
(encryptKey, decryptKey) <- liftIO $ C.generateKeyPair size
(encryptKey, decryptKey) <- liftIO $ C.generateEncryptionKeyPair size C.SRSA
let rq =
RcvQueue
{ server = srv,
@@ -243,7 +251,7 @@ newRcvQueue c srv = do
verifyKey = Nothing,
status = New
}
return (rq, SMPQueueInfo srv sId encryptKey)
pure (rq, SMPQueueUri srv sId reservedServerKey, encryptKey)
subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do
@@ -301,7 +309,7 @@ sendConfirmation c sq@SndQueue {server, sndId} senderKey cInfo =
mkConfirmation :: SMPClient -> m MsgBody
mkConfirmation smp = encryptAndSign smp sq . serializeSMPMessage $ SMPConfirmation senderKey cInfo
sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> RetryInterval -> m ()
sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> C.APublicVerifyKey -> 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
@@ -321,6 +329,23 @@ sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey ri =
agentMessage = HELLO verifyKey ackMode
}
sendInvitation :: forall m. AgentMonad m => AgentClient -> SMPQueueUri -> C.APublicEncryptKey -> ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
sendInvitation c SMPQueueUri {smpServer, senderId} encryptKey cReq connInfo = do
withLogSMP_ c smpServer senderId "SEND <INV>" $ \smp -> do
msg <- mkInvitation smp
liftSMP $ sendSMPMessage smp Nothing senderId msg
where
mkInvitation :: SMPClient -> m ByteString
mkInvitation smp = do
senderTimestamp <- liftIO getCurrentTime
encryptUnsigned smp encryptKey . serializeSMPMessage $
SMPMessage
{ senderMsgId = 0,
senderTimestamp,
previousMsgHash = "",
agentMessage = A_INV cReq connInfo
}
secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
secureQueue c RcvQueue {server, rcvId, rcvPrivateKey} senderKey =
withLogSMP c server rcvId "KEY <key>" $ \smp ->
@@ -352,23 +377,36 @@ encryptAndSign smp SndQueue {encryptKey, signKey} msg = do
paddedSize <- asks $ (blockSize smp -) . reservedMsgSize
liftError cryptoError $ do
enc <- C.encrypt encryptKey paddedSize msg
C.Signature sig <- C.sign signKey enc
pure $ sig <> enc
sig <- C.sign signKey enc
pure $ C.signatureBytes sig <> enc
decryptAndVerify :: AgentMonad m => RcvQueue -> ByteString -> m ByteString
decryptAndVerify RcvQueue {decryptKey, verifyKey} msg =
verifyMessage verifyKey msg
>>= liftError cryptoError . C.decrypt decryptKey
verifyMessage :: AgentMonad m => Maybe VerificationKey -> ByteString -> m ByteString
verifyMessage verifyKey msg = do
encryptUnsigned :: AgentMonad m => SMPClient -> C.APublicEncryptKey -> ByteString -> m ByteString
encryptUnsigned smp encryptKey msg = do
paddedSize <- asks $ (blockSize smp -) . reservedMsgSize
size <- asks $ rsaKeySize . config
let (sig, enc) = B.splitAt size msg
liftError cryptoError $ do
enc <- C.encrypt encryptKey paddedSize msg
let sig = B.replicate size ' '
pure $ sig <> enc
verifyMessage :: AgentMonad m => Maybe C.APublicVerifyKey -> ByteString -> m ByteString
verifyMessage verifyKey msg = do
sigSize <- asks $ rsaKeySize . config
let (s, enc) = B.splitAt sigSize msg
case verifyKey of
Nothing -> pure enc
Just k
| C.verify k (C.Signature sig) enc -> pure enc
| otherwise -> throwError $ AGENT A_SIGNATURE
Just k ->
case C.decodeSignature $ B.take (C.signatureSize k) s of
Left _ -> throwError $ AGENT A_SIGNATURE
Right sig ->
if C.verify k sig enc
then pure enc
else throwError $ AGENT A_SIGNATURE
cryptoError :: C.CryptoError -> AgentErrorType
cryptoError = \case
@@ -15,6 +15,7 @@ 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 qualified Simplex.Messaging.Crypto as C
import System.Random (StdGen, newStdGen)
import UnliftIO.STM
@@ -22,6 +23,7 @@ data AgentConfig = AgentConfig
{ tcpPort :: ServiceName,
smpServers :: NonEmpty SMPServer,
rsaKeySize :: Int,
cmdSignAlg :: C.SignAlg,
connIdBytes :: Int,
tbqSize :: Natural,
dbFile :: FilePath,
@@ -40,6 +42,7 @@ defaultAgentConfig =
{ tcpPort = "5224",
smpServers = undefined,
rsaKeySize = 2048 `div` 8,
cmdSignAlg = C.SignAlg C.SEd448,
connIdBytes = 12,
tbqSize = 16,
dbFile = "smp-agent.db",
+256 -59
View File
@@ -10,6 +10,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
@@ -37,7 +38,18 @@ module Simplex.Messaging.Agent.Protocol
SMPMessage (..),
AMessage (..),
SMPServer (..),
SMPQueueInfo (..),
SMPQueueUri (..),
ConnectionMode (..),
SConnectionMode (..),
AConnectionMode (..),
cmInvitation,
cmContact,
ConnectionModeI (..),
ConnectionRequest (..),
AConnectionRequest (..),
ConnReqData (..),
ConnReqScheme (..),
simplexChat,
AgentErrorType (..),
CommandErrorType (..),
ConnectionErrorType (..),
@@ -48,17 +60,12 @@ module Simplex.Messaging.Agent.Protocol
ARawTransmission,
ConnId,
ConfirmationId,
IntroId,
InvitationId,
AckMode (..),
OnOff (..),
MsgIntegrity (..),
MsgErrorType (..),
QueueStatus (..),
SignatureKey,
VerificationKey,
EncryptionKey,
DecryptionKey,
ACorrId,
AgentMsgId,
@@ -67,14 +74,25 @@ module Simplex.Messaging.Agent.Protocol
serializeSMPMessage,
serializeMsgIntegrity,
serializeServer,
serializeSmpQueueInfo,
serializeSMPQueueUri,
reservedServerKey, -- TODO remove
serializeConnMode,
serializeConnMode',
connMode,
connMode',
serializeConnReq,
serializeConnReq',
serializeAgentError,
commandP,
parseSMPMessage,
smpServerP,
smpQueueInfoP,
smpQueueUriP,
connModeT,
connReqP,
connReqP',
msgIntegrityP,
agentErrorTypeP,
agentMessageP,
-- * TCP transport functions
tPut,
@@ -86,21 +104,28 @@ where
import Control.Applicative (optional, (<|>))
import Control.Monad.IO.Class
import qualified Crypto.PubKey.RSA as R
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Base64
import qualified Data.ByteString.Base64.URL as U
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Functor (($>))
import Data.Int (Int64)
import Data.Kind (Type)
import Data.List (find)
import qualified Data.List.NonEmpty as L
import Data.Maybe (isJust)
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Time.ISO8601
import Data.Type.Equality
import Data.Typeable ()
import GHC.Generics (Generic)
import Generic.Random (genericArbitraryU)
import Network.HTTP.Types (parseSimpleQuery, renderSimpleQuery)
import Network.Socket (HostName, ServiceName)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Parsers
@@ -115,7 +140,7 @@ import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTra
import Simplex.Messaging.Util
import Test.QuickCheck (Arbitrary (..))
import Text.Read
import UnliftIO.Exception
import UnliftIO.Exception (Exception)
-- | Raw (unparsed) SMP agent protocol transmission.
type ARawTransmission = (ByteString, ByteString, ByteString)
@@ -154,11 +179,14 @@ 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 -> ConnInfo -> ACommand Client -- response OK
REQ :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
ACPT :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
NEW :: AConnectionMode -> ACommand Client -- response INV
INV :: AConnectionRequest -> ACommand Agent
JOIN :: AConnectionRequest -> ConnInfo -> ACommand Client -- response OK
CONF :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
LET :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
REQ :: InvitationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
ACPT :: InvitationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
RJCT :: InvitationId -> ACommand Client
INFO :: ConnInfo -> ACommand Agent
CON :: ACommand Agent -- notification that connection is established
SUB :: ACommand Client
@@ -183,6 +211,49 @@ deriving instance Eq (ACommand p)
deriving instance Show (ACommand p)
data ConnectionMode = CMInvitation | CMContact
deriving (Eq, Show)
data SConnectionMode (m :: ConnectionMode) where
SCMInvitation :: SConnectionMode CMInvitation
SCMContact :: SConnectionMode CMContact
deriving instance Eq (SConnectionMode m)
deriving instance Show (SConnectionMode m)
instance TestEquality SConnectionMode where
testEquality SCMInvitation SCMInvitation = Just Refl
testEquality SCMContact SCMContact = Just Refl
testEquality _ _ = Nothing
data AConnectionMode = forall m. ACM (SConnectionMode m)
instance Eq AConnectionMode where
ACM m == ACM m' = isJust $ testEquality m m'
cmInvitation :: AConnectionMode
cmInvitation = ACM SCMInvitation
cmContact :: AConnectionMode
cmContact = ACM SCMContact
deriving instance Show AConnectionMode
connMode :: SConnectionMode m -> ConnectionMode
connMode SCMInvitation = CMInvitation
connMode SCMContact = CMContact
connMode' :: ConnectionMode -> AConnectionMode
connMode' CMInvitation = cmInvitation
connMode' CMContact = cmContact
class ConnectionModeI (m :: ConnectionMode) where sConnectionMode :: SConnectionMode m
instance ConnectionModeI CMInvitation where sConnectionMode = SCMInvitation
instance ConnectionModeI CMContact where sConnectionMode = SCMContact
type MsgHash = ByteString
-- | Agent message metadata sent to the client
@@ -223,11 +294,13 @@ data SMPMessage
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents
data AMessage where
-- | the first message in the queue to validate it is secured
HELLO :: VerificationKey -> AckMode -> AMessage
HELLO :: C.APublicVerifyKey -> AckMode -> AMessage
-- | reply queue information
REPLY :: SMPQueueInfo -> AMessage
REPLY :: ConnectionRequest CMInvitation -> AMessage
-- | agent envelope for the client message
A_MSG :: MsgBody -> AMessage
-- | connection request with the invitation to connect
A_INV :: ConnectionRequest CMInvitation -> ConnInfo -> AMessage
deriving (Show)
-- | Parse SMP message.
@@ -238,7 +311,7 @@ parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
smpMessageP = A.endOfLine *> smpClientMessageP <|> smpConfirmationP
smpConfirmationP :: Parser SMPMessage
smpConfirmationP = "KEY " *> (SMPConfirmation <$> C.pubKeyP <* A.endOfLine <* A.endOfLine <*> binaryBodyP <* A.endOfLine)
smpConfirmationP = "KEY " *> (SMPConfirmation <$> C.strKeyP <* A.endOfLine <* A.endOfLine <*> binaryBodyP <* A.endOfLine)
smpClientMessageP :: Parser SMPMessage
smpClientMessageP =
@@ -253,7 +326,7 @@ parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
-- | Serialize SMP message.
serializeSMPMessage :: SMPMessage -> ByteString
serializeSMPMessage = \case
SMPConfirmation sKey cInfo -> smpMessage ("KEY " <> C.serializePubKey sKey) "" (serializeBinary cInfo) <> "\n"
SMPConfirmation sKey cInfo -> smpMessage ("KEY " <> C.serializeKey sKey) "" (serializeBinary cInfo) <> "\n"
SMPMessage {senderMsgId, senderTimestamp, previousMsgHash, agentMessage} ->
let header = messageHeader senderMsgId senderTimestamp previousMsgHash
body = serializeAgentMessage agentMessage
@@ -268,17 +341,14 @@ agentMessageP =
"HELLO " *> hello
<|> "REPLY " *> reply
<|> "MSG " *> a_msg
<|> "INV " *> a_inv
where
hello = HELLO <$> C.pubKeyP <*> ackMode
reply = REPLY <$> smpQueueInfoP
hello = HELLO <$> C.strKeyP <*> ackMode
reply = REPLY <$> connReqP'
a_msg = A_MSG <$> binaryBodyP <* A.endOfLine
a_inv = A_INV <$> connReqP' <* A.space <*> binaryBodyP <* A.endOfLine
ackMode = AckMode <$> (" NO_ACK" $> Off <|> pure On)
-- | SMP queue information parser.
smpQueueInfoP :: Parser SMPQueueInfo
smpQueueInfoP =
"smp::" *> (SMPQueueInfo <$> smpServerP <* "::" <*> base64P <* "::" <*> C.pubKeyP)
-- | SMP server location parser.
smpServerP :: Parser SMPServer
smpServerP = SMPServer <$> server <*> optional port <*> optional kHash
@@ -289,20 +359,115 @@ smpServerP = SMPServer <$> server <*> optional port <*> optional kHash
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
HELLO verifyKey ackMode -> "HELLO " <> C.serializeKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else ""
REPLY cReq -> "REPLY " <> serializeConnReq' cReq
A_MSG body -> "MSG " <> serializeBinary body <> "\n"
A_INV cReq cInfo -> B.unwords ["INV", serializeConnReq' cReq, serializeBinary cInfo] <> "\n"
-- | Serialize SMP queue information that is sent out-of-band.
serializeSmpQueueInfo :: SMPQueueInfo -> ByteString
serializeSmpQueueInfo (SMPQueueInfo srv qId ek) =
B.intercalate "::" ["smp", serializeServer srv, encode qId, C.serializePubKey ek]
serializeSMPQueueUri :: SMPQueueUri -> ByteString
serializeSMPQueueUri (SMPQueueUri srv qId _) =
serializeServerUri srv <> "/" <> U.encode qId <> "#"
-- | SMP queue information parser.
smpQueueUriP :: Parser SMPQueueUri
smpQueueUriP =
SMPQueueUri <$> smpServerUriP <* "/" <*> base64UriP <* "#" <*> pure reservedServerKey
reservedServerKey :: C.APublicVerifyKey
reservedServerKey = C.APublicVerifyKey C.SRSA (C.PublicKeyRSA $ R.PublicKey 1 0 0)
serializeConnReq :: AConnectionRequest -> ByteString
serializeConnReq (ACR _ cr) = serializeConnReq' cr
serializeConnReq' :: ConnectionRequest m -> ByteString
serializeConnReq' = \case
CRInvitation crData -> serialize CMInvitation crData
CRContact crData -> serialize CMContact crData
where
serialize crMode ConnReqData {crScheme, crSmpQueues, crEncryptKey} =
sch <> "/" <> m <> "#/" <> queryStr
where
sch = case crScheme of
CRSSimplex -> "simplex:"
CRSAppServer host port -> B.pack $ "https://" <> host <> maybe "" (':' :) port
m = case crMode of
CMInvitation -> "invitation"
CMContact -> "contact"
queryStr = renderSimpleQuery True [("smp", queues), ("e2e", key)]
queues = B.intercalate "," . map serializeSMPQueueUri $ L.toList crSmpQueues
key = C.serializeKeyUri crEncryptKey
connReqP' :: forall m. ConnectionModeI m => Parser (ConnectionRequest m)
connReqP' = do
ACR m cr <- connReqP
case testEquality m $ sConnectionMode @m of
Just Refl -> pure cr
_ -> fail "bad connection request mode"
connReqP :: Parser AConnectionRequest
connReqP = do
crScheme <- "simplex:" $> CRSSimplex <|> "https://" *> appServer
crMode <- "/" *> mode <* "#/?"
query <- parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
crSmpQueues <- paramP "smp" smpQueues query
crEncryptKey <- paramP "e2e" C.strKeyUriP query
let cReq = ConnReqData {crScheme, crSmpQueues, crEncryptKey}
pure $ case crMode of
CMInvitation -> ACR SCMInvitation $ CRInvitation cReq
CMContact -> ACR SCMContact $ CRContact cReq
where
appServer = CRSAppServer <$> host <*> optional port
host = B.unpack <$> A.takeTill (\c -> c == ':' || c == '/')
port = B.unpack <$> (A.char ':' *> A.takeTill (== '/'))
mode = "invitation" $> CMInvitation <|> "contact" $> CMContact
paramP param parser query =
let p = maybe (fail "") (pure . snd) $ find ((== param) . fst) query
in parseAll parser <$?> p
smpQueues =
maybe (fail "no SMP queues") pure . L.nonEmpty
=<< (smpQueue `A.sepBy1'` A.char ',')
smpQueue = parseAll smpQueueUriP <$?> A.takeTill (== ',')
-- | Serialize SMP server location.
serializeServer :: SMPServer -> ByteString
serializeServer SMPServer {host, port, keyHash} =
B.pack $ host <> maybe "" (':' :) port <> maybe "" (('#' :) . B.unpack . encode . C.unKeyHash) keyHash
serializeServerUri :: SMPServer -> ByteString
serializeServerUri SMPServer {host, port, keyHash} = "smp://" <> kh <> B.pack host <> p
where
kh = maybe "" ((<> "@") . U.encode . C.unKeyHash) keyHash
p = B.pack $ maybe "" (':' :) port
smpServerUriP :: Parser SMPServer
smpServerUriP = do
_ <- "smp://"
keyHash <- optional $ C.KeyHash <$> (U.decode <$?> A.takeTill (== '@') <* A.char '@')
host <- B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ")
port <- optional $ B.unpack <$> (A.char ':' *> A.takeWhile1 A.isDigit)
pure SMPServer {host, port, keyHash}
serializeConnMode :: AConnectionMode -> ByteString
serializeConnMode (ACM cMode) = serializeConnMode' $ connMode cMode
serializeConnMode' :: ConnectionMode -> ByteString
serializeConnMode' = \case
CMInvitation -> "INV"
CMContact -> "CON"
connModeP' :: Parser ConnectionMode
connModeP' = "INV" $> CMInvitation <|> "CON" $> CMContact
connModeP :: Parser AConnectionMode
connModeP = connMode' <$> connModeP'
connModeT :: Text -> Maybe ConnectionMode
connModeT = \case
"INV" -> Just CMInvitation
"CON" -> Just CMContact
_ -> Nothing
-- | SMP server location and transport key digest (hash).
data SMPServer = SMPServer
{ host :: HostName,
@@ -319,8 +484,6 @@ type ConnId = ByteString
type ConfirmationId = ByteString
type IntroId = ByteString
type InvitationId = ByteString
-- | Connection modes.
@@ -332,20 +495,42 @@ newtype AckMode = AckMode OnOff deriving (Eq, Show)
-- | SMP queue information sent out-of-band.
--
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#out-of-band-messages
data SMPQueueInfo = SMPQueueInfo SMPServer SMP.SenderId EncryptionKey
data SMPQueueUri = SMPQueueUri
{ smpServer :: SMPServer,
senderId :: SMP.SenderId,
serverVerifyKey :: C.APublicVerifyKey
}
deriving (Eq, Show)
-- | Public key used to E2E encrypt SMP messages.
type EncryptionKey = C.PublicKey
data ConnectionRequest (m :: ConnectionMode) where
CRInvitation :: ConnReqData -> ConnectionRequest CMInvitation
CRContact :: ConnReqData -> ConnectionRequest CMContact
-- | Private key used to E2E decrypt SMP messages.
type DecryptionKey = C.SafePrivateKey
deriving instance Eq (ConnectionRequest m)
-- | Private key used to sign SMP commands
type SignatureKey = C.APrivateKey
deriving instance Show (ConnectionRequest m)
-- | Public key used by SMP server to authorize (verify) SMP commands.
type VerificationKey = C.PublicKey
data AConnectionRequest = forall m. ACR (SConnectionMode m) (ConnectionRequest m)
instance Eq AConnectionRequest where
ACR m cr == ACR m' cr' = case testEquality m m' of
Just Refl -> cr == cr'
_ -> False
deriving instance Show AConnectionRequest
data ConnReqData = ConnReqData
{ crScheme :: ConnReqScheme,
crSmpQueues :: L.NonEmpty SMPQueueUri,
crEncryptKey :: C.APublicEncryptKey
}
deriving (Eq, Show)
data ConnReqScheme = CRSSimplex | CRSAppServer HostName (Maybe ServiceName)
deriving (Eq, Show)
simplexChat :: ConnReqScheme
simplexChat = CRSAppServer "simplex.chat" Nothing
data QueueDirection = SND | RCV deriving (Show)
@@ -437,7 +622,7 @@ data SMPAgentError
A_PROHIBITED
| -- | cannot RSA/AES-decrypt or parse decrypted header
A_ENCRYPTION
| -- | invalid RSA signature
| -- | invalid signature
A_SIGNATURE
deriving (Eq, Generic, Read, Show, Exception)
@@ -454,11 +639,14 @@ instance Arbitrary SMPAgentError where arbitrary = genericArbitraryU
-- | SMP agent command and response parser
commandP :: Parser ACmd
commandP =
"NEW" $> ACmd SClient NEW
"NEW " *> newCmd
<|> "INV " *> invResp
<|> "JOIN " *> joinCmd
<|> "REQ " *> reqCmd
<|> "CONF " *> confMsg
<|> "LET " *> letCmd
<|> "REQ " *> reqMsg
<|> "ACPT " *> acptCmd
<|> "RJCT " *> rjctCmd
<|> "INFO " *> infoCmd
<|> "SUB" $> ACmd SClient SUB
<|> "END" $> ACmd SAgent END
@@ -476,10 +664,14 @@ commandP =
<|> "CON" $> ACmd SAgent CON
<|> "OK" $> ACmd SAgent OK
where
invResp = ACmd SAgent . INV <$> smpQueueInfoP
joinCmd = ACmd SClient <$> (JOIN <$> smpQueueInfoP <* A.space <*> A.takeByteString)
reqCmd = ACmd SAgent <$> (REQ <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
newCmd = ACmd SClient . NEW <$> connModeP
invResp = ACmd SAgent . INV <$> connReqP
joinCmd = ACmd SClient <$> (JOIN <$> connReqP <* A.space <*> A.takeByteString)
confMsg = ACmd SAgent <$> (CONF <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
letCmd = ACmd SClient <$> (LET <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
reqMsg = ACmd SAgent <$> (REQ <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
acptCmd = ACmd SClient <$> (ACPT <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
rjctCmd = ACmd SClient . RJCT <$> A.takeByteString
infoCmd = ACmd SAgent . INFO <$> A.takeByteString
sendCmd = ACmd SClient . SEND <$> A.takeByteString
msgIdResp = ACmd SAgent . MID <$> A.decimal
@@ -512,11 +704,14 @@ parseCommand = parse commandP $ CMD SYNTAX
-- | Serialize SMP agent command.
serializeCommand :: ACommand p -> ByteString
serializeCommand = \case
NEW -> "NEW"
INV qInfo -> "INV " <> serializeSmpQueueInfo qInfo
JOIN qInfo cInfo -> "JOIN " <> serializeSmpQueueInfo qInfo <> " " <> serializeBinary cInfo
REQ confId cInfo -> "REQ " <> confId <> " " <> serializeBinary cInfo
ACPT confId cInfo -> "ACPT " <> confId <> " " <> serializeBinary cInfo
NEW cMode -> "NEW " <> serializeConnMode cMode
INV cReq -> "INV " <> serializeConnReq cReq
JOIN cReq cInfo -> B.unwords ["JOIN", serializeConnReq cReq, serializeBinary cInfo]
CONF confId cInfo -> B.unwords ["CONF", confId, serializeBinary cInfo]
LET confId cInfo -> B.unwords ["LET", confId, serializeBinary cInfo]
REQ invId cInfo -> B.unwords ["REQ", invId, serializeBinary cInfo]
ACPT invId cInfo -> B.unwords ["ACPT", invId, serializeBinary cInfo]
RJCT invId -> "RJCT " <> invId
INFO cInfo -> "INFO " <> serializeBinary cInfo
SUB -> "SUB"
END -> "END"
@@ -525,9 +720,8 @@ serializeCommand = \case
SEND msgBody -> "SEND " <> serializeBinary msgBody
MID mId -> "MID " <> bshow mId
SENT mId -> "SENT " <> bshow mId
MERR mId e -> "MERR " <> bshow mId <> " " <> serializeAgentError e
MSG msgMeta msgBody ->
"MSG " <> serializeMsgMeta msgMeta <> " " <> serializeBinary msgBody
MERR mId e -> B.unwords ["MERR", bshow mId, serializeAgentError e]
MSG msgMeta msgBody -> B.unwords ["MSG", serializeMsgMeta msgMeta, serializeBinary msgBody]
ACK mId -> "ACK " <> bshow mId
OFF -> "OFF"
DEL -> "DEL"
@@ -617,8 +811,9 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
tConnId :: ARawTransmission -> ACommand p -> Either AgentErrorType (ACommand p)
tConnId (_, connId, _) cmd = case cmd of
-- NEW, JOIN and ACPT have optional connId
NEW -> Right cmd
NEW _ -> Right cmd
JOIN {} -> Right cmd
ACPT {} -> Right cmd
-- ERROR response does not always have connId
ERR _ -> Right cmd
-- other responses must have connId
@@ -630,9 +825,11 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
cmdWithMsgBody = \case
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
JOIN qUri cInfo -> JOIN qUri <$$> getBody cInfo
CONF confId cInfo -> CONF confId <$$> getBody cInfo
LET confId cInfo -> LET confId <$$> getBody cInfo
REQ invId cInfo -> REQ invId <$$> getBody cInfo
ACPT invId cInfo -> ACPT invId <$$> getBody cInfo
INFO cInfo -> INFO <$$> getBody cInfo
cmd -> pure $ Right cmd
+38 -9
View File
@@ -19,6 +19,7 @@ import Data.Kind (Type)
import Data.Time (UTCTime)
import Data.Type.Equality
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Protocol
( MsgBody,
MsgId,
@@ -33,7 +34,7 @@ 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 -> TVar ChaChaDRG -> ConnData -> RcvQueue -> m ConnId
createRcvConn :: s -> TVar ChaChaDRG -> ConnData -> RcvQueue -> SConnectionMode c -> 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
@@ -42,9 +43,8 @@ class Monad m => MonadAgentStore s m where
upgradeRcvConnToDuplex :: s -> ConnId -> SndQueue -> m ()
upgradeSndConnToDuplex :: s -> ConnId -> RcvQueue -> m ()
setRcvQueueStatus :: s -> RcvQueue -> QueueStatus -> m ()
setRcvQueueActive :: s -> RcvQueue -> VerificationKey -> m ()
setRcvQueueActive :: s -> RcvQueue -> C.APublicVerifyKey -> m ()
setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m ()
updateSignKey :: s -> SndQueue -> SignatureKey -> m ()
-- Confirmations
createConfirmation :: s -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
@@ -52,6 +52,12 @@ class Monad m => MonadAgentStore s m where
getAcceptedConfirmation :: s -> ConnId -> m AcceptedConfirmation
removeConfirmations :: s -> ConnId -> m ()
-- Invitations - sent via Contact connections
createInvitation :: s -> TVar ChaChaDRG -> NewInvitation -> m InvitationId
getInvitation :: s -> InvitationId -> m Invitation
acceptInvitation :: s -> InvitationId -> ConnInfo -> m ()
deleteInvitation :: s -> ConnId -> InvitationId -> m ()
-- Msg management
updateRcvIds :: s -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
createRcvMsg :: s -> ConnId -> RcvMsgData -> m ()
@@ -59,7 +65,7 @@ class Monad m => MonadAgentStore s m where
createSndMsg :: s -> ConnId -> SndMsgData -> m ()
updateSndMsgStatus :: s -> ConnId -> InternalId -> SndMsgStatus -> m ()
getPendingMsgData :: s -> ConnId -> InternalId -> m (SndQueue, MsgBody)
getPendingMsgs :: s -> ConnId -> m [PendingMsg]
getPendingMsgs :: s -> ConnId -> m [InternalId]
getMsg :: s -> ConnId -> InternalId -> m Msg
checkRcvMsg :: s -> ConnId -> InternalId -> m ()
updateRcvMsgAck :: s -> ConnId -> InternalId -> m ()
@@ -72,8 +78,8 @@ data RcvQueue = RcvQueue
rcvId :: SMP.RecipientId,
rcvPrivateKey :: RecipientPrivateKey,
sndId :: Maybe SMP.SenderId,
decryptKey :: DecryptionKey,
verifyKey :: Maybe VerificationKey,
decryptKey :: C.APrivateDecryptKey,
verifyKey :: Maybe C.APublicVerifyKey,
status :: QueueStatus
}
deriving (Eq, Show)
@@ -83,8 +89,8 @@ data SndQueue = SndQueue
{ server :: SMPServer,
sndId :: SMP.SenderId,
sndPrivateKey :: SenderPrivateKey,
encryptKey :: EncryptionKey,
signKey :: SignatureKey,
encryptKey :: C.APublicEncryptKey,
signKey :: C.APrivateSignKey,
status :: QueueStatus
}
deriving (Eq, Show)
@@ -92,7 +98,7 @@ data SndQueue = SndQueue
-- * Connection types
-- | Type of a connection.
data ConnType = CRcv | CSnd | CDuplex deriving (Eq, Show)
data ConnType = CRcv | CSnd | CDuplex | CContact deriving (Eq, Show)
-- | Connection of a specific type.
--
@@ -108,6 +114,7 @@ data Connection (d :: ConnType) where
RcvConnection :: ConnData -> RcvQueue -> Connection CRcv
SndConnection :: ConnData -> SndQueue -> Connection CSnd
DuplexConnection :: ConnData -> RcvQueue -> SndQueue -> Connection CDuplex
ContactConnection :: ConnData -> RcvQueue -> Connection CContact
deriving instance Eq (Connection d)
@@ -117,11 +124,13 @@ data SConnType :: ConnType -> Type where
SCRcv :: SConnType CRcv
SCSnd :: SConnType CSnd
SCDuplex :: SConnType CDuplex
SCContact :: SConnType CContact
connType :: SConnType c -> ConnType
connType SCRcv = CRcv
connType SCSnd = CSnd
connType SCDuplex = CDuplex
connType SCContact = CContact
deriving instance Eq (SConnType d)
@@ -131,6 +140,7 @@ instance TestEquality SConnType where
testEquality SCRcv SCRcv = Just Refl
testEquality SCSnd SCSnd = Just Refl
testEquality SCDuplex SCDuplex = Just Refl
testEquality SCContact SCContact = Just Refl
testEquality _ _ = Nothing
-- | Connection of an unknown type.
@@ -163,6 +173,23 @@ data AcceptedConfirmation = AcceptedConfirmation
ownConnInfo :: ConnInfo
}
-- * Invitations
data NewInvitation = NewInvitation
{ contactConnId :: ConnId,
connReq :: ConnectionRequest 'CMInvitation,
recipientConnInfo :: ConnInfo
}
data Invitation = Invitation
{ invitationId :: InvitationId,
contactConnId :: ConnId,
connReq :: ConnectionRequest 'CMInvitation,
recipientConnInfo :: ConnInfo,
ownConnInfo :: Maybe ConnInfo,
accepted :: Bool
}
-- * Message integrity validation types
-- | Corresponds to `last_external_snd_msg_id` in `connections` table
@@ -321,6 +348,8 @@ data StoreError
SEBadConnType ConnType
| -- | Confirmation not found.
SEConfirmationNotFound
| -- | Invitation not found
SEInvitationNotFound
| -- | Message not found
SEMsgNotFound
| -- | Currently not used. The intention was to pass current expected queue status in methods,
+114 -34
View File
@@ -38,7 +38,8 @@ import Data.List (find)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLData (..), SQLError, field)
import Data.Text.Encoding (decodeLatin1)
import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLData (..), SQLError, ToRow, field)
import qualified Database.SQLite.Simple as DB
import Database.SQLite.Simple.FromField
import Database.SQLite.Simple.Internal (Field (..))
@@ -50,6 +51,7 @@ import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration)
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Parsers (blobFieldParser)
import Simplex.Messaging.Protocol (MsgBody)
import qualified Simplex.Messaging.Protocol as SMP
@@ -149,8 +151,8 @@ withTransaction st action = withConnection st $ loop 100 100000
else E.throwIO e
instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteStore m where
createRcvConn :: SQLiteStore -> TVar ChaChaDRG -> ConnData -> RcvQueue -> m ConnId
createRcvConn st gVar cData q@RcvQueue {server} =
createRcvConn :: SQLiteStore -> TVar ChaChaDRG -> ConnData -> RcvQueue -> SConnectionMode c -> m ConnId
createRcvConn st gVar cData q@RcvQueue {server} cMode =
-- TODO if schema has to be restarted, this function can be refactored
-- to create connection first using createWithRandomId
liftIOEither . checkConstraint SEConnDuplicate . withTransaction st $ \db ->
@@ -160,7 +162,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
create db connId = do
upsertServer_ db server
insertRcvQueue_ db connId q
insertRcvConnection_ db cData {connId} q
insertRcvConnection_ db cData {connId} q cMode
pure connId
createSndConn :: SQLiteStore -> TVar ChaChaDRG -> ConnData -> SndQueue -> m ConnId
@@ -247,7 +249,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
|]
[":status" := status, ":host" := host, ":port" := serializePort_ port, ":rcv_id" := rcvId]
setRcvQueueActive :: SQLiteStore -> RcvQueue -> VerificationKey -> m ()
setRcvQueueActive :: SQLiteStore -> RcvQueue -> C.APublicVerifyKey -> m ()
setRcvQueueActive st RcvQueue {rcvId, server = SMPServer {host, port}} verifyKey =
-- ? throw error if queue does not exist?
liftIO . withTransaction st $ \db ->
@@ -278,18 +280,6 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
|]
[":status" := status, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId]
updateSignKey :: SQLiteStore -> SndQueue -> SignatureKey -> m ()
updateSignKey st SndQueue {sndId, server = SMPServer {host, port}} signatureKey =
liftIO . withTransaction st $ \db ->
DB.executeNamed
db
[sql|
UPDATE snd_queues
SET sign_key = :sign_key
WHERE host = :host AND port = :port AND snd_id = :snd_id;
|]
[":sign_key" := signatureKey, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId]
createConfirmation :: SQLiteStore -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
createConfirmation st gVar NewConfirmation {connId, senderKey, senderConnInfo} =
liftIOEither . withTransaction st $ \db ->
@@ -358,6 +348,60 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
|]
[":conn_alias" := connId]
createInvitation :: SQLiteStore -> TVar ChaChaDRG -> NewInvitation -> m InvitationId
createInvitation st gVar NewInvitation {contactConnId, connReq, recipientConnInfo} =
liftIOEither . withTransaction st $ \db ->
createWithRandomId gVar $ \invitationId ->
DB.execute
db
[sql|
INSERT INTO conn_invitations
(invitation_id, contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
|]
(invitationId, contactConnId, connReq, recipientConnInfo)
getInvitation :: SQLiteStore -> InvitationId -> m Invitation
getInvitation st invitationId =
liftIOEither . withTransaction st $ \db ->
invitation
<$> DB.query
db
[sql|
SELECT contact_conn_id, cr_invitation, recipient_conn_info, own_conn_info, accepted
FROM conn_invitations
WHERE invitation_id = ?
AND accepted = 0
|]
(Only invitationId)
where
invitation [(contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted)] =
Right Invitation {invitationId, contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted}
invitation _ = Left SEInvitationNotFound
acceptInvitation :: SQLiteStore -> InvitationId -> ConnInfo -> m ()
acceptInvitation st invitationId ownConnInfo =
liftIO . withTransaction st $ \db -> do
DB.executeNamed
db
[sql|
UPDATE conn_invitations
SET accepted = 1,
own_conn_info = :own_conn_info
WHERE invitation_id = :invitation_id
|]
[ ":own_conn_info" := ownConnInfo,
":invitation_id" := invitationId
]
deleteInvitation :: SQLiteStore -> ConnId -> InvitationId -> m ()
deleteInvitation st contactConnId invId =
liftIOEither . withTransaction st $ \db ->
runExceptT $
ExceptT (getConn_ db contactConnId) >>= \case
SomeConn SCContact _ ->
liftIO $ DB.execute db "DELETE FROM conn_invitations WHERE contact_conn_id = ? AND invitation_id = ?" (contactConnId, invId)
_ -> throwError SEConnNotFound
updateRcvIds :: SQLiteStore -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
updateRcvIds st connId =
liftIO . withTransaction st $ \db -> do
@@ -429,10 +473,10 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
sndQueue :: Maybe SndQueue -> Either StoreError SndQueue
sndQueue = maybe (Left SEConnNotFound) Right
getPendingMsgs :: SQLiteStore -> ConnId -> m [PendingMsg]
getPendingMsgs :: SQLiteStore -> ConnId -> m [InternalId]
getPendingMsgs st connId =
liftIO . withTransaction st $ \db ->
map (PendingMsg connId . fromOnly)
map fromOnly
<$> DB.query db "SELECT internal_id FROM snd_messages WHERE conn_alias = ? AND snd_status = ?" (connId, SndMsgCreated)
getMsg :: SQLiteStore -> ConnId -> InternalId -> m Msg
@@ -500,9 +544,25 @@ instance ToField MsgIntegrity where toField = toField . serializeMsgIntegrity
instance FromField MsgIntegrity where fromField = blobFieldParser msgIntegrityP
instance ToField SMPQueueInfo where toField = toField . serializeSmpQueueInfo
instance ToField SMPQueueUri where toField = toField . serializeSMPQueueUri
instance FromField SMPQueueInfo where fromField = blobFieldParser smpQueueInfoP
instance FromField SMPQueueUri where fromField = blobFieldParser smpQueueUriP
instance ToField AConnectionRequest where toField = toField . serializeConnReq
instance FromField AConnectionRequest where fromField = blobFieldParser connReqP
instance ToField (ConnectionRequest c) where toField = toField . serializeConnReq'
instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequest c) where fromField = blobFieldParser connReqP'
instance ToField ConnectionMode where toField = toField . decodeLatin1 . serializeConnMode'
instance FromField ConnectionMode where fromField = fromTextField_ connModeT
instance ToField (SConnectionMode c) where toField = toField . connMode
instance FromField AConnectionMode where fromField = fromTextField_ $ fmap connMode' . connModeT
fromTextField_ :: (E.Typeable a) => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ fromText = \case
@@ -521,6 +581,22 @@ instance (FromField a, FromField b, FromField c, FromField d, FromField e,
fromRow = (,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
<*> field <*> field <*> field <*> field <*> field
<*> field
instance (FromField a, FromField b, FromField c, FromField d, FromField e,
FromField f, FromField g, FromField h, FromField i, FromField j,
FromField k, FromField l) =>
FromRow (a,b,c,d,e,f,g,h,i,j,k,l) where
fromRow = (,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
<*> field <*> field <*> field <*> field <*> field
<*> field <*> field
instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
ToField g, ToField h, ToField i, ToField j, ToField k, ToField l) =>
ToRow (a,b,c,d,e,f,g,h,i,j,k,l) where
toRow (a,b,c,d,e,f,g,h,i,j,k,l) =
[ toField a, toField b, toField c, toField d, toField e, toField f,
toField g, toField h, toField i, toField j, toField k, toField l
]
{- ORMOLU_ENABLE -}
-- * Server upsert helper
@@ -563,21 +639,24 @@ insertRcvQueue_ dbConn connId RcvQueue {..} = do
":status" := status
]
insertRcvConnection_ :: DB.Connection -> ConnData -> RcvQueue -> IO ()
insertRcvConnection_ dbConn ConnData {connId} RcvQueue {server, rcvId} = do
insertRcvConnection_ :: DB.Connection -> ConnData -> RcvQueue -> SConnectionMode c -> IO ()
insertRcvConnection_ dbConn ConnData {connId} RcvQueue {server, rcvId} cMode = do
let port_ = serializePort_ $ port server
DB.executeNamed
dbConn
[sql|
INSERT INTO connections
( conn_alias, rcv_host, rcv_port, rcv_id, snd_host, snd_port, snd_id, last_internal_msg_id, last_internal_rcv_msg_id, last_internal_snd_msg_id, last_external_snd_msg_id, last_rcv_msg_hash, last_snd_msg_hash)
( conn_alias, rcv_host, rcv_port, rcv_id, snd_host, snd_port, snd_id, last_internal_msg_id, last_internal_rcv_msg_id, last_internal_snd_msg_id, last_external_snd_msg_id, last_rcv_msg_hash, last_snd_msg_hash,
conn_mode )
VALUES
(:conn_alias,:rcv_host,:rcv_port,:rcv_id, NULL, NULL, NULL, 0, 0, 0, 0, x'', x'');
(:conn_alias,:rcv_host,:rcv_port,:rcv_id, NULL, NULL, NULL, 0, 0, 0, 0, x'', x'',
:conn_mode );
|]
[ ":conn_alias" := connId,
":rcv_host" := host server,
":rcv_port" := port_,
":rcv_id" := rcvId
":rcv_id" := rcvId,
":conn_mode" := cMode
]
-- * createSndConn helpers
@@ -626,21 +705,22 @@ getConn_ :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
getConn_ dbConn connId =
getConnData_ dbConn connId >>= \case
Nothing -> pure $ Left SEConnNotFound
Just connData -> do
Just (connData, cMode) -> do
rQ <- getRcvQueueByConnAlias_ dbConn connId
sQ <- getSndQueueByConnAlias_ dbConn connId
pure $ case (rQ, sQ) of
(Just rcvQ, Just sndQ) -> Right $ SomeConn SCDuplex (DuplexConnection connData rcvQ sndQ)
(Just rcvQ, Nothing) -> Right $ SomeConn SCRcv (RcvConnection connData rcvQ)
(Nothing, Just sndQ) -> Right $ SomeConn SCSnd (SndConnection connData sndQ)
pure $ case (rQ, sQ, cMode) of
(Just rcvQ, Just sndQ, CMInvitation) -> Right $ SomeConn SCDuplex (DuplexConnection connData rcvQ sndQ)
(Just rcvQ, Nothing, CMInvitation) -> Right $ SomeConn SCRcv (RcvConnection connData rcvQ)
(Nothing, Just sndQ, CMInvitation) -> Right $ SomeConn SCSnd (SndConnection connData sndQ)
(Just rcvQ, Nothing, CMContact) -> Right $ SomeConn SCContact (ContactConnection connData rcvQ)
_ -> Left SEConnNotFound
getConnData_ :: DB.Connection -> ConnId -> IO (Maybe ConnData)
getConnData_ :: DB.Connection -> ConnId -> IO (Maybe (ConnData, ConnectionMode))
getConnData_ dbConn connId' =
connData
<$> DB.query dbConn "SELECT conn_alias FROM connections WHERE conn_alias = ?;" (Only connId')
<$> DB.query dbConn "SELECT conn_alias, conn_mode FROM connections WHERE conn_alias = ?;" (Only connId')
where
connData [Only connId] = Just ConnData {connId}
connData [(connId, cMode)] = Just (ConnData {connId}, cMode)
connData _ = Nothing
getRcvQueueByConnAlias_ :: DB.Connection -> ConnId -> IO (Maybe RcvQueue)
+8 -8
View File
@@ -81,7 +81,7 @@ data SMPClient = SMPClient
tcpTimeout :: Int,
clientCorrId :: TVar Natural,
sentCommands :: TVar (Map CorrId Request),
sndQ :: TBQueue SignedRawTransmission,
sndQ :: TBQueue SentRawTransmission,
rcvQ :: TBQueue SignedTransmissionOrError,
msgQ :: TBQueue SMPServerTransmission,
blockSize :: Int
@@ -332,14 +332,14 @@ suspendSMPQueue = okSMPCommand $ Cmd SRecipient OFF
deleteSMPQueue :: SMPClient -> RecipientPrivateKey -> QueueId -> ExceptT SMPClientError IO ()
deleteSMPQueue = okSMPCommand $ Cmd SRecipient DEL
okSMPCommand :: Cmd -> SMPClient -> C.SafePrivateKey -> QueueId -> ExceptT SMPClientError IO ()
okSMPCommand :: Cmd -> SMPClient -> C.APrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
okSMPCommand cmd c pKey qId =
sendSMPCommand c (Just pKey) qId cmd >>= \case
Cmd _ OK -> return ()
_ -> throwE SMPUnexpectedResponse
-- | Send any SMP command ('Cmd' type).
sendSMPCommand :: SMPClient -> Maybe C.SafePrivateKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd
sendSMPCommand :: SMPClient -> Maybe C.APrivateSignKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd
sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId cmd = do
corrId <- lift_ getNextCorrId
t <- signTransmission $ serializeTransmission (corrId, qId, cmd)
@@ -353,20 +353,20 @@ sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId
i <- stateTVar clientCorrId $ \i -> (i, i + 1)
pure . CorrId $ bshow i
signTransmission :: ByteString -> ExceptT SMPClientError IO SignedRawTransmission
signTransmission :: ByteString -> ExceptT SMPClientError IO SentRawTransmission
signTransmission t = case pKey of
Nothing -> return ("", t)
Nothing -> return (Nothing, t)
Just pk -> do
sig <- liftError SMPSignatureError $ C.sign pk t
return (sig, t)
return (Just sig, t)
-- two separate "atomically" needed to avoid blocking
sendRecv :: CorrId -> SignedRawTransmission -> IO Response
sendRecv :: CorrId -> SentRawTransmission -> IO Response
sendRecv corrId t = atomically (send corrId t) >>= withTimeout . atomically . takeTMVar
where
withTimeout a = fromMaybe (Left SMPResponseTimeout) <$> timeout tcpTimeout a
send :: CorrId -> SignedRawTransmission -> STM (TMVar Response)
send :: CorrId -> SentRawTransmission -> STM (TMVar Response)
send corrId t = do
r <- newEmptyTMVar
modifyTVar sentCommands . M.insert corrId $ Request qId r
File diff suppressed because it is too large. Load diff
+19 -4
View File
@@ -7,6 +7,7 @@ import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (first)
import Data.ByteString.Base64
import qualified Data.ByteString.Base64.URL as U
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (isAlphaNum)
@@ -24,10 +25,24 @@ base64P :: Parser ByteString
base64P = decode <$?> base64StringP
base64StringP :: Parser ByteString
base64StringP = do
str <- A.takeWhile1 (\c -> isAlphaNum c || c == '+' || c == '/')
pad <- A.takeWhile (== '=')
pure $ str <> pad
base64StringP = paddedBase64 rawBase64P
base64UriP :: Parser ByteString
base64UriP = U.decode <$?> base64UriStringP
base64UriStringP :: Parser ByteString
base64UriStringP = paddedBase64 rawBase64UriP
paddedBase64 :: Parser ByteString -> Parser ByteString
paddedBase64 raw = (<>) <$> raw <*> pad
where
pad = A.takeWhile (== '=')
rawBase64P :: Parser ByteString
rawBase64P = A.takeWhile1 (\c -> isAlphaNum c || c == '+' || c == '/')
rawBase64UriP :: Parser ByteString
rawBase64UriP = A.takeWhile1 (\c -> isAlphaNum c || c == '-' || c == '_')
tsISO8601P :: Parser UTCTime
tsISO8601P = maybe (fail "timestamp") pure . parseISO8601 . B.unpack =<< A.takeTill wordEnd
+36 -36
View File
@@ -34,6 +34,7 @@ module Simplex.Messaging.Protocol
SignedTransmission,
SignedTransmissionOrError,
RawTransmission,
SentRawTransmission,
SignedRawTransmission,
CorrId (..),
QueueId,
@@ -76,6 +77,7 @@ import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Functor (($>))
import Data.Kind
import Data.Maybe (isNothing)
import Data.String
import Data.Time.Clock
import Data.Time.ISO8601
@@ -109,18 +111,21 @@ deriving instance Show Cmd
type Transmission = (CorrId, QueueId, Cmd)
-- | SMP transmission with signature.
type SignedTransmission = (C.Signature, Transmission)
type SignedTransmission = (Maybe C.ASignature, Transmission)
type TransmissionOrError = (CorrId, QueueId, Either ErrorType Cmd)
-- | signed parsed transmission, with parsing error.
type SignedTransmissionOrError = (C.Signature, TransmissionOrError)
type SignedTransmissionOrError = (Maybe C.ASignature, TransmissionOrError)
-- | unparsed SMP transmission with signature.
type RawTransmission = (ByteString, ByteString, ByteString, ByteString)
-- | unparsed SMP transmission with signature.
type SignedRawTransmission = (C.Signature, ByteString)
-- | unparsed sent SMP transmission with signature.
type SignedRawTransmission = (Maybe C.ASignature, ByteString, ByteString, ByteString)
-- | unparsed sent SMP transmission with signature.
type SentRawTransmission = (Maybe C.ASignature, ByteString)
-- | SMP queue ID for the recipient.
type RecipientId = QueueId
@@ -177,24 +182,24 @@ instance IsString CorrId where
-- | Recipient's private key used by the recipient to authorize (sign) SMP commands.
--
-- Only used by SMP agent, kept here so its definition is close to respective public key.
type RecipientPrivateKey = C.SafePrivateKey
type RecipientPrivateKey = C.APrivateSignKey
-- | Recipient's public key used by SMP server to verify authorization of SMP commands.
type RecipientPublicKey = C.PublicKey
type RecipientPublicKey = C.APublicVerifyKey
-- | Sender's private key used by the recipient to authorize (sign) SMP commands.
--
-- Only used by SMP agent, kept here so its definition is close to respective public key.
type SenderPrivateKey = C.SafePrivateKey
type SenderPrivateKey = C.APrivateSignKey
-- | Sender's public key used by SMP server to verify authorization of SMP commands.
type SenderPublicKey = C.PublicKey
type SenderPublicKey = C.APublicVerifyKey
-- | Private key used by push notifications server to authorize (sign) LSTN command.
type NotifierPrivateKey = C.SafePrivateKey
type NotifierPrivateKey = C.APrivateSignKey
-- | Public key used by SMP server to verify authorization of LSTN command sent by push notifications server.
type NotifierPublicKey = C.PublicKey
type NotifierPublicKey = C.APublicVerifyKey
-- | SMP message server ID.
type MsgId = Encoded
@@ -243,11 +248,11 @@ instance Arbitrary CommandError where arbitrary = genericArbitraryU
-- | SMP transmission parser.
transmissionP :: Parser RawTransmission
transmissionP = do
signature <- segment
sig <- segment
corrId <- segment
queueId <- segment
command <- A.takeByteString
return (signature, corrId, queueId, command)
return (sig, corrId, queueId, command)
where
segment = A.takeTill (== ' ') <* " "
@@ -273,11 +278,11 @@ commandP =
<|> "ERR " *> serverError
<|> "PONG" $> Cmd SBroker PONG
where
newCmd = Cmd SRecipient . NEW <$> C.pubKeyP
newCmd = Cmd SRecipient . NEW <$> C.strKeyP
idsResp = Cmd SBroker <$> (IDS <$> (base64P <* A.space) <*> base64P)
nIdsResp = Cmd SBroker . NID <$> base64P
keyCmd = Cmd SRecipient . KEY <$> C.pubKeyP
nKeyCmd = Cmd SRecipient . NKEY <$> C.pubKeyP
keyCmd = Cmd SRecipient . KEY <$> C.strKeyP
nKeyCmd = Cmd SRecipient . NKEY <$> C.strKeyP
sendCmd = do
size <- A.decimal <* A.space
Cmd SSender . SEND <$> A.take size <* A.space
@@ -297,9 +302,9 @@ parseCommand = parse (commandP <* " " <* A.takeByteString) $ CMD SYNTAX
-- | Serialize SMP command.
serializeCommand :: Cmd -> ByteString
serializeCommand = \case
Cmd SRecipient (NEW rKey) -> "NEW " <> C.serializePubKey rKey
Cmd SRecipient (KEY sKey) -> "KEY " <> C.serializePubKey sKey
Cmd SRecipient (NKEY nKey) -> "NKEY " <> C.serializePubKey nKey
Cmd SRecipient (NEW rKey) -> "NEW " <> C.serializeKey rKey
Cmd SRecipient (KEY sKey) -> "KEY " <> C.serializeKey sKey
Cmd SRecipient (NKEY nKey) -> "NKEY " <> C.serializeKey nKey
Cmd SRecipient SUB -> "SUB"
Cmd SRecipient ACK -> "ACK"
Cmd SRecipient OFF -> "OFF"
@@ -328,9 +333,9 @@ serializeErrorType :: ErrorType -> ByteString
serializeErrorType = bshow
-- | Send signed SMP transmission to TCP transport.
tPut :: Transport c => THandle c -> SignedRawTransmission -> IO (Either TransportError ())
tPut th (C.Signature sig, t) =
tPutEncrypted th $ encode sig <> " " <> t <> " "
tPut :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
tPut th (sig, t) =
tPutEncrypted th $ C.serializeSignature sig <> " " <> t <> " "
-- | Serialize SMP transmission.
serializeTransmission :: Transmission -> ByteString
@@ -362,26 +367,21 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate
where
decodeParseValidate :: Either TransportError RawTransmission -> m SignedTransmissionOrError
decodeParseValidate = \case
Right (signature, corrId, queueId, command) ->
let decodedTransmission = liftM2 (,corrId,,command) (validSig =<< decode signature) (decode queueId)
Right (sig, corrId, queueId, command) ->
let decodedTransmission = liftM2 (,corrId,,command) (C.decodeSignature =<< decode sig) (decode queueId)
in either (const $ tError corrId) tParseValidate decodedTransmission
Left _ -> tError ""
validSig :: ByteString -> Either String ByteString
validSig sig
| B.null sig || C.validKeySize (B.length sig) = Right sig
| otherwise = Left "invalid signature size"
tError :: ByteString -> m SignedTransmissionOrError
tError corrId = return (C.Signature "", (CorrId corrId, "", Left BLOCK))
tError corrId = return (Nothing, (CorrId corrId, "", Left BLOCK))
tParseValidate :: RawTransmission -> m SignedTransmissionOrError
tParseValidate :: SignedRawTransmission -> m SignedTransmissionOrError
tParseValidate t@(sig, corrId, queueId, command) = do
let cmd = parseCommand command >>= fromParty >>= tCredentials t
return (C.Signature sig, (CorrId corrId, queueId, cmd))
return (sig, (CorrId corrId, queueId, cmd))
tCredentials :: RawTransmission -> Cmd -> Either ErrorType Cmd
tCredentials (signature, _, queueId, _) cmd = case cmd of
tCredentials :: SignedRawTransmission -> Cmd -> Either ErrorType Cmd
tCredentials (sig, _, queueId, _) cmd = case cmd of
-- IDS response must not have queue ID
Cmd SBroker IDS {} -> Right cmd
-- ERR response does not always have queue ID
@@ -396,7 +396,7 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate
| otherwise -> Right cmd
-- NEW must have signature but NOT queue ID
Cmd SRecipient NEW {}
| B.null signature -> Left $ CMD NO_AUTH
| isNothing sig -> Left $ CMD NO_AUTH
| not (B.null queueId) -> Left $ CMD HAS_AUTH
| otherwise -> Right cmd
-- SEND must have queue ID, signature is not always required
@@ -405,9 +405,9 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate
| otherwise -> Right cmd
-- PING must not have queue ID or signature
Cmd SSender PING
| B.null queueId && B.null signature -> Right cmd
| isNothing sig && B.null queueId -> Right cmd
| otherwise -> Left $ CMD HAS_AUTH
-- other client commands must have both signature and queue ID
Cmd _ _
| B.null signature || B.null queueId -> Left $ CMD NO_AUTH
| isNothing sig || B.null queueId -> Left $ CMD NO_AUTH
| otherwise -> Right cmd
+49 -29
View File
@@ -36,6 +36,7 @@ import Data.Functor (($>))
import qualified Data.Map.Strict as M
import Data.Maybe (isNothing)
import Data.Time.Clock
import Data.Type.Equality
import Network.Socket (ServiceName)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Protocol
@@ -141,59 +142,78 @@ receive h Client {rcvQ} = forever $ do
send :: (Transport c, MonadUnliftIO m) => THandle c -> Client -> m ()
send h Client {sndQ} = forever $ do
t <- atomically $ readTBQueue sndQ
liftIO $ tPut h ("", serializeTransmission t)
liftIO $ tPut h (Nothing, serializeTransmission t)
mkResp :: CorrId -> QueueId -> Command 'Broker -> Transmission
mkResp corrId queueId command = (corrId, queueId, Cmd SBroker command)
verifyTransmission :: forall m. (MonadUnliftIO m, MonadReader Env m) => SignedTransmission -> m Transmission
verifyTransmission (sig, t@(corrId, queueId, cmd)) = do
verifyTransmission (sig_, t@(corrId, queueId, cmd)) = do
(corrId,queueId,) <$> case cmd of
Cmd SBroker _ -> return $ smpErr INTERNAL -- it can only be client command, because `fromClient` was used
Cmd SRecipient (NEW k) -> pure $ verifySignature k
Cmd SRecipient _ -> verifyCmd SRecipient $ verifySignature . recipientKey
Cmd SSender (SEND _) -> verifyCmd SSender $ verifyMaybe sig . senderKey
Cmd SSender (SEND _) -> verifyCmd SSender $ verifyMaybe . senderKey
Cmd SSender PING -> return cmd
Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe sig . fmap snd . notifier
Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe . fmap snd . notifier
where
verifyCmd :: SParty p -> (QueueRec -> Cmd) -> m Cmd
verifyCmd party f = do
st <- asks queueStore
q <- atomically $ getQueue st party queueId
pure $ either (const $ dummyVerify authErr) f q
verifyMaybe :: C.Signature -> Maybe SenderPublicKey -> Cmd
verifyMaybe "" = maybe cmd (const authErr)
verifyMaybe _ = maybe authErr verifySignature
verifySignature :: C.PublicKey -> Cmd
verifySignature key = if verify key then cmd else authErr
verify key
| C.publicKeySize key == sigLen = cryptoVerify key
| otherwise = dummyVerify False
cryptoVerify key = C.verify key sig (serializeTransmission t)
pure $ either (const $ dummyVerify_ sig_ authErr) f q
verifyMaybe :: Maybe C.APublicVerifyKey -> Cmd
verifyMaybe (Just k) = verifySignature k
verifyMaybe _ = maybe cmd (const authErr) sig_
verifySignature :: C.APublicVerifyKey -> Cmd
verifySignature key = case sig_ of
Just s -> if verify key s then cmd else authErr
_ -> authErr
verify :: C.APublicVerifyKey -> C.ASignature -> Bool
verify (C.APublicVerifyKey a k) sig@(C.ASignature a' s) =
case (testEquality a a', C.signatureSize k == C.signatureSize s) of
(Just Refl, True) -> cryptoVerify k s
_ -> dummyVerify sig False
cryptoVerify :: C.SignatureAlgorithm a => C.PublicKey a -> C.Signature a -> Bool
cryptoVerify k s = C.verify' k s (serializeTransmission t)
dummyVerify_ :: Maybe C.ASignature -> a -> a
dummyVerify_ = \case
Just s -> dummyVerify s
_ -> id
dummyVerify :: C.ASignature -> a -> a
dummyVerify (C.ASignature _ s) = seq $ cryptoVerify (dummyPublicKey s) s
smpErr = Cmd SBroker . ERR
authErr = smpErr AUTH
dummyVerify :: a -> a
dummyVerify = seq $
cryptoVerify $ case sigLen of
128 -> dummyKey128
256 -> dummyKey256
384 -> dummyKey384
512 -> dummyKey512
_ -> dummyKey256
sigLen = B.length $ C.unSignature sig
-- These dummy keys are used with `dummyVerify` function to mitigate timing attacks
-- by having the same time of the response whether a queue exists or nor, for all valid key/signature sizes
dummyKey128 :: C.PublicKey
dummyPublicKey :: C.Signature a -> C.PublicKey a
dummyPublicKey = \case
C.SignatureRSA s' -> case B.length s' of
128 -> dummyKey128
256 -> dummyKey256
384 -> dummyKey384
512 -> dummyKey512
_ -> dummyKey256
C.SignatureEd25519 _ -> dummyKeyEd25519
C.SignatureEd448 _ -> dummyKeyEd448
dummyKeyEd25519 :: C.PublicKey 'C.Ed25519
dummyKeyEd25519 = "MCowBQYDK2VwAyEA139Oqs4QgpqbAmB0o7rZf6T19ryl7E65k4AYe0kE3Qs="
dummyKeyEd448 :: C.PublicKey 'C.Ed448
dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"
dummyKey128 :: C.PublicKey 'C.RSA
dummyKey128 = "MIIBIDANBgkqhkiG9w0BAQEFAAOCAQ0AMIIBCAKBgQC2oeA7s4roXN5K2N6022I1/2CTeMKjWH0m00bSZWa4N8LDKeFcShh8YUxZea5giAveViTRNOOVLgcuXbKvR3u24szN04xP0+KnYUuUUIIoT3YSjX0IlomhDhhSyup4BmA0gAZ+D1OaIKZFX6J8yQ1Lr/JGLEfSRsBjw8l+4hs9OwKBgQDKA+YlZvGb3BcpDwKmatiCXN7ZRDWkjXbj8VAW5zV95tSRCCVN48hrFM1H4Ju2QMMUc6kPUVX+eW4ZjdCl5blIqIHMcTmsdcmsDDCg3PjUNrwc6bv/1TcirbAKcmnKt9iurIt6eerxSO7TZUXXMUVsi7eRwb/RUNhpCrpJ/hpIOw=="
dummyKey256 :: C.PublicKey
dummyKey256 :: C.PublicKey 'C.RSA
dummyKey256 = "MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAxwmTvaqmdTbkfUGNi8Yu0L/T4cxuOlQlx3zGZ9X9Qx0+oZjknWK+QHrdWTcpS+zH4Hi7fP6kanOQoQ90Hj6Ghl57VU1GEdUPywSw4i1/7t0Wv9uT9Q2ktHp2rqVo3xkC9IVIpL7EZAxdRviIN2OsOB3g4a/F1ZpjxcAaZeOMUugiAX1+GtkLuE0Xn4neYjCaOghLxQTdhybN70VtnkiQLx/X9NjkDIl/spYGm3tQFMyYKkP6IWoEpj0926hJ0fmlmhy8tAOhlZsb/baW5cgkEZ3E9jVVrySCgQzoLQgma610FIISRpRJbSyv26jU7MkMxiyuBiDaFOORkXFttoKbtQKBgEbDS9II2brsz+vfI7uP8atFcawkE52cx4M1UWQhqb1H3tBiRl+qO+dMq1pPQF2bW7dlZAWYzS4W/367bTAuALHBDGB8xi1P4Njhh9vaOgTvuqrHG9NJQ85BLy0qGw8rjIWSIXVmVpfrXFJ8po5l04UE258Ll2yocv3QRQmddQW9"
dummyKey384 :: C.PublicKey
dummyKey384 :: C.PublicKey 'C.RSA
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 :: C.PublicKey 'C.RSA
dummyKey512 = "MIICoDANBgkqhkiG9w0BAQEFAAOCAo0AMIICiAKCAgEArkCY9DuverJ4mmzDektv9aZMFyeRV46WZK9NsOBKEc+1ncqMs+LhLti9asKNgUBRbNzmbOe0NYYftrUpwnATaenggkTFxxbJ4JGJuGYbsEdFWkXSvrbWGtM8YUmn5RkAGme12xQ89bSM4VoJAGnrYPHwmcQd+KYCPZvTUsxaxgrJTX65ejHN9BsAn8XtGViOtHTDJO9yUMD2WrJvd7wnNa+0ugEteDLzMU++xS98VC+uA1vfauUqi3yXVchdfrLdVUuM+JE0gUEXCgzjuHkaoHiaGNiGhdPYoAJJdOKQOIHAKdk7Th6OPhirPhc9XYNB4O8JDthKhNtfokvFIFlC4QBRzJhpLIENaEBDt08WmgpOnecZB/CuxkqqOrNa8j5K5jNrtXAI67W46VEC2jeQy/gZwb64Zit2A4D00xXzGbQTPGj4ehcEMhLx5LSCygViEf0w0tN3c3TEyUcgPzvECd2ZVpQLr9Z4a07Ebr+YSuxcHhjg4Rg1VyJyOTTvaCBGm5X2B3+tI4NUttmikIHOYpBnsLmHY2BgfH2KcrIsDyAhInXmTFr/L2+erFarUnlfATd2L8Ti43TNHDedO6k6jI5Gyi62yPwjqPLEIIK8l+pIeNfHJ3pPmjhHBfzFcQLMMMXffHWNK8kWklrQXK+4j4HiPcTBvlO1FEtG9nEIZhUCgYA4a6WtI2k5YNli1C89GY5rGUY7RP71T6RWri/D3Lz9T7GvU+FemAyYmsvCQwqijUOur0uLvwSP8VdxpSUcrjJJSWur2hrPWzWlu0XbNaeizxpFeKbQP+zSrWJ1z8RwfAeUjShxt8q1TuqGqY10wQyp3nyiTGvS+KwZVj5h5qx8NQ=="
client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
@@ -265,10 +285,10 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server
withLog $ \s -> logAddNotifier s queueId nId nKey
pure $ NID nId
checkKeySize :: Monad m' => C.PublicKey -> m' (Command 'Broker) -> m' Transmission
checkKeySize :: Monad m' => C.APublicVerifyKey -> m' (Command 'Broker) -> m' Transmission
checkKeySize key action =
mkResp corrId queueId
<$> if C.validKeySize $ C.publicKeySize key
<$> if C.validKeySize key
then action
else pure . ERR $ CMD KEY_SIZE
+3 -3
View File
@@ -30,7 +30,7 @@ data ServerConfig = ServerConfig
msgIdBytes :: Int,
storeLog :: Maybe (StoreLog 'ReadMode),
blockSize :: Int,
serverPrivateKey :: C.FullPrivateKey
serverPrivateKey :: C.PrivateKey 'C.RSA
-- serverId :: ByteString
}
@@ -40,7 +40,7 @@ data Env = Env
queueStore :: QueueStore,
msgStore :: STMMsgStore,
idsDrg :: TVar ChaChaDRG,
serverKeyPair :: C.FullKeyPair,
serverKeyPair :: C.KeyPair 'C.RSA,
storeLog :: Maybe (StoreLog 'WriteMode)
}
@@ -94,7 +94,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)
+10 -10
View File
@@ -62,33 +62,33 @@ storeLogRecordP =
<|> "DELETE " *> (DeleteQueue <$> base64P)
where
createQueueP = CreateQueue <$> queueRecP
secureQueueP = SecureQueue <$> base64P <* A.space <*> C.pubKeyP
secureQueueP = SecureQueue <$> base64P <* A.space <*> C.strKeyP
addNotifierP =
AddNotifier <$> base64P <* A.space <*> base64P <* A.space <*> C.pubKeyP
AddNotifier <$> base64P <* A.space <*> base64P <* A.space <*> C.strKeyP
queueRecP = do
recipientId <- "rid=" *> base64P <* A.space
senderId <- "sid=" *> base64P <* A.space
recipientKey <- "rk=" *> C.pubKeyP <* A.space
senderKey <- "sk=" *> optional C.pubKeyP
notifier <- optional $ (,) <$> (" nid=" *> base64P) <*> (" nk=" *> C.pubKeyP)
recipientKey <- "rk=" *> C.strKeyP <* A.space
senderKey <- "sk=" *> optional C.strKeyP
notifier <- optional $ (,) <$> (" nid=" *> base64P) <*> (" nk=" *> C.strKeyP)
pure QueueRec {recipientId, senderId, recipientKey, senderKey, notifier, status = QueueActive}
serializeStoreLogRecord :: StoreLogRecord -> ByteString
serializeStoreLogRecord = \case
CreateQueue q -> "CREATE " <> serializeQueue q
SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializePubKey sKey
AddNotifier rId nId nKey -> B.unwords ["NOTIFIER", encode rId, encode nId, C.serializePubKey nKey]
SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializeKey sKey
AddNotifier rId nId nKey -> B.unwords ["NOTIFIER", encode rId, encode nId, C.serializeKey nKey]
DeleteQueue rId -> "DELETE " <> encode rId
where
serializeQueue QueueRec {recipientId, senderId, recipientKey, senderKey, notifier} =
B.unwords
[ "rid=" <> encode recipientId,
"sid=" <> encode senderId,
"rk=" <> C.serializePubKey recipientKey,
"sk=" <> maybe "" C.serializePubKey senderKey
"rk=" <> C.serializeKey recipientKey,
"sk=" <> maybe "" C.serializeKey senderKey
]
<> maybe "" serializeNotifier notifier
serializeNotifier (nId, nKey) = " nid=" <> encode nId <> " nk=" <> C.serializePubKey nKey
serializeNotifier (nId, nKey) = " nid=" <> encode nId <> " nk=" <> C.serializeKey nKey
openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode)
openWriteStoreLog f = WriteStoreLog f <$> openFile f WriteMode
+15 -10
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
@@ -44,6 +45,7 @@ module Simplex.Messaging.Transport
tGetEncrypted,
serializeTransportError,
transportErrorP,
currentSMPVersionStr,
-- * Trim trailing CR
trimCR,
@@ -62,7 +64,7 @@ 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.Maybe (fromMaybe)
import Data.Set (Set)
import qualified Data.Set as S
import Data.String
@@ -221,7 +223,10 @@ major :: SMPVersion -> (Int, Int)
major (SMPVersion a b _ _) = (a, b)
currentSMPVersion :: SMPVersion
currentSMPVersion = "0.4.1.0"
currentSMPVersion = "0.5.0.0"
currentSMPVersionStr :: ByteString
currentSMPVersionStr = serializeSMPVersion currentSMPVersion
serializeSMPVersion :: SMPVersion -> ByteString
serializeSMPVersion (SMPVersion a b c d) = B.intercalate "." [bshow a, bshow b, bshow c, bshow d]
@@ -345,7 +350,7 @@ 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 -> Int -> C.FullKeyPair -> ExceptT TransportError IO (THandle c)
serverHandshake :: forall c. Transport c => c -> Int -> C.KeyPair 'C.RSA -> ExceptT TransportError IO (THandle c)
serverHandshake c srvBlockSize (k, pk) = do
checkValidBlockSize srvBlockSize
liftIO sendHeaderAndPublicKey_1
@@ -358,13 +363,13 @@ serverHandshake c srvBlockSize (k, pk) = do
where
sendHeaderAndPublicKey_1 :: IO ()
sendHeaderAndPublicKey_1 = do
let sKey = C.encodePubKey k
let sKey = C.encodeKey k
header = ServerHeader {blockSize = srvBlockSize, keySize = B.length sKey}
cPut c $ binaryServerHeader header
cPut c sKey
receiveEncryptedKeys_4 :: ExceptT TransportError IO ByteString
receiveEncryptedKeys_4 =
liftIO (cGet c $ C.publicKeySize k) >>= \case
liftIO (cGet c $ C.keySize k) >>= \case
"" -> throwE $ TEHandshake TERMINATED
ks -> pure ks
decryptParseKeys_5 :: ByteString -> ExceptT TransportError IO ClientHandshake
@@ -372,7 +377,7 @@ serverHandshake c srvBlockSize (k, pk) = do
liftError (const $ TEHandshake DECRYPT) (C.decryptOAEP pk encKeys)
>>= liftEither . parseClientHandshake
sendWelcome_6 :: THandle c -> ExceptT TransportError IO ()
sendWelcome_6 th = ExceptT . tPutEncrypted th $ serializeSMPVersion currentSMPVersion <> " "
sendWelcome_6 th = ExceptT . tPutEncrypted th $ currentSMPVersionStr <> " "
-- | Client SMP encrypted transport handshake.
--
@@ -390,7 +395,7 @@ clientHandshake c blkSize_ keyHash = do
getWelcome_6 th >>= checkVersion
pure th
where
getHeaderAndPublicKey_1_2 :: ExceptT TransportError IO (C.PublicKey, Int)
getHeaderAndPublicKey_1_2 :: ExceptT TransportError IO (C.PublicKey 'C.RSA, Int)
getHeaderAndPublicKey_1_2 = do
header <- liftIO (cGet c serverHeaderSize)
ServerHeader {blockSize, keySize} <- liftEither $ parse serverHeaderP (TEHandshake HEADER) header
@@ -399,8 +404,8 @@ clientHandshake c blkSize_ keyHash = do
maybe (pure ()) (validateKeyHash_2 s) keyHash
key <- liftEither $ parseKey s
pure (key, blockSize)
parseKey :: ByteString -> Either TransportError C.PublicKey
parseKey = first (const $ TEHandshake RSA_KEY) . parseAll C.binaryPubKeyP
parseKey :: ByteString -> Either TransportError (C.PublicKey 'C.RSA)
parseKey = first (const $ TEHandshake RSA_KEY) . parseAll C.binaryKeyP
validateKeyHash_2 :: ByteString -> C.KeyHash -> ExceptT TransportError IO ()
validateKeyHash_2 k (C.KeyHash kHash)
| C.sha256Hash k == kHash = pure ()
@@ -412,7 +417,7 @@ clientHandshake c blkSize_ keyHash = do
aesKey <- C.randomAesKey
baseIV <- C.randomIV
pure SessionKey {aesKey, baseIV, counter = undefined}
sendEncryptedKeys_4 :: C.PublicKey -> ClientHandshake -> ExceptT TransportError IO ()
sendEncryptedKeys_4 :: C.PublicKey 'C.RSA -> ClientHandshake -> ExceptT TransportError IO ()
sendEncryptedKeys_4 k chs =
liftError (const $ TEHandshake ENCRYPT) (C.encryptOAEP k $ serializeClientHandshake chs)
>>= liftIO . cPut c
+100 -23
View File
@@ -9,14 +9,17 @@
module AgentTests (agentTests) where
import AgentTests.ConnectionRequestTests
import AgentTests.FunctionalAPITests (functionalAPITests)
import AgentTests.SQLiteTests (storeTests)
import Control.Concurrent
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Network.HTTP.Types (urlEncode)
import SMPAgentClient
import SMPClient (testPort, testPort2, testStoreLogFile, withSmpServer, withSmpServerStoreLogOn)
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Agent.Protocol as A
import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
import Simplex.Messaging.Transport (ATransport (..), TProxy (..), Transport (..))
import System.Directory (removeFile)
@@ -25,6 +28,7 @@ import Test.Hspec
agentTests :: ATransport -> Spec
agentTests (ATransport t) = do
describe "Connection request" connectionRequestTests
describe "Functional API" $ functionalAPITests (ATransport t)
describe "SQLite store" storeTests
describe "SMP agent protocol syntax" $ syntaxTests t
@@ -41,6 +45,13 @@ agentTests (ATransport t) = do
smpAgentTest2_2_2 $ testDuplexConnection t
it "should connect via 2 servers and 2 agents (random IDs)" $
smpAgentTest2_2_2 $ testDuplexConnRandomIds t
describe "Establishing connections via `contact connection`" $ do
it "should connect via contact connection with one server and 3 agents" $
smpAgentTest3 $ testContactConnection t
it "should connect via contact connection with one server and 2 agents (random IDs)" $
smpAgentTest2_2_1 $ testContactConnRandomIds t
it "should support rejecting contact request" $
smpAgentTest2_2_1 $ testRejectContactRequest t
describe "Connection subscriptions" $ do
it "should connect via one server and one agent" $
smpAgentTest3_1_1 $ testSubscription t
@@ -97,11 +108,11 @@ 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' <> " 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)
("1", "bob", Right (INV cReq)) <- alice #: ("1", "bob", "NEW INV")
let cReq' = serializeConnReq cReq
bob #: ("11", "alice", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice", OK)
("", "bob", Right (CONF confId "bob's connInfo")) <- (alice <#:)
alice #: ("2", "bob", "LET " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
bob <# ("", "alice", INFO "alice's connInfo")
bob <# ("", "alice", CON)
alice <# ("", "bob", CON)
@@ -129,12 +140,12 @@ testDuplexConnection _ alice bob = do
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 <#:)
("1", bobConn, Right (INV cReq)) <- alice #: ("1", "", "NEW INV")
let cReq' = serializeConnReq cReq
("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> cReq' <> " 14\nbob's connInfo")
("", bobConn', Right (CONF confId "bob's connInfo")) <- (alice <#:)
bobConn' `shouldBe` bobConn
alice #: ("2", bobConn, "ACPT " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False
alice #: ("2", bobConn, "LET " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False
bob <# ("", aliceConn, INFO "alice's connInfo")
bob <# ("", aliceConn, CON)
alice <# ("", bobConn, CON)
@@ -160,6 +171,72 @@ testDuplexConnRandomIds _ alice bob = do
alice #: ("6", bobConn, "DEL") #> ("6", bobConn, OK)
alice #:# "nothing else should be delivered to alice"
testContactConnection :: Transport c => TProxy c -> c -> c -> c -> IO ()
testContactConnection _ alice bob tom = do
("1", "alice_contact", Right (INV cReq)) <- alice #: ("1", "alice_contact", "NEW CON")
let cReq' = serializeConnReq cReq
bob #: ("11", "alice", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice", OK)
("", "alice_contact", Right (REQ aInvId "bob's connInfo")) <- (alice <#:)
alice #: ("2", "bob", "ACPT " <> aInvId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
("", "alice", Right (CONF bConfId "alice's connInfo")) <- (bob <#:)
bob #: ("12", "alice", "LET " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", "alice", OK)
alice <# ("", "bob", INFO "bob's connInfo 2")
alice <# ("", "bob", CON)
bob <# ("", "alice", CON)
alice #: ("3", "bob", "SEND :hi") #> ("3", "bob", MID 1)
alice <# ("", "bob", SENT 1)
bob <#= \case ("", "alice", Msg "hi") -> True; _ -> False
bob #: ("13", "alice", "ACK 1") #> ("13", "alice", OK)
tom #: ("21", "alice", "JOIN " <> cReq' <> " 14\ntom's connInfo") #> ("21", "alice", OK)
("", "alice_contact", Right (REQ aInvId' "tom's connInfo")) <- (alice <#:)
alice #: ("4", "tom", "ACPT " <> aInvId' <> " 16\nalice's connInfo") #> ("4", "tom", OK)
("", "alice", Right (CONF tConfId "alice's connInfo")) <- (tom <#:)
tom #: ("22", "alice", "LET " <> tConfId <> " 16\ntom's connInfo 2") #> ("22", "alice", OK)
alice <# ("", "tom", INFO "tom's connInfo 2")
alice <# ("", "tom", CON)
tom <# ("", "alice", CON)
alice #: ("5", "tom", "SEND :hi there") #> ("5", "tom", MID 1)
alice <# ("", "tom", SENT 1)
tom <#= \case ("", "alice", Msg "hi there") -> True; _ -> False
tom #: ("23", "alice", "ACK 1") #> ("23", "alice", OK)
testContactConnRandomIds :: Transport c => TProxy c -> c -> c -> IO ()
testContactConnRandomIds _ alice bob = do
("1", aliceContact, Right (INV cReq)) <- alice #: ("1", "", "NEW CON")
let cReq' = serializeConnReq cReq
("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> cReq' <> " 14\nbob's connInfo")
("", aliceContact', Right (REQ aInvId "bob's connInfo")) <- (alice <#:)
aliceContact' `shouldBe` aliceContact
("2", bobConn, Right OK) <- alice #: ("2", "", "ACPT " <> aInvId <> " 16\nalice's connInfo")
("", aliceConn', Right (CONF bConfId "alice's connInfo")) <- (bob <#:)
aliceConn' `shouldBe` aliceConn
bob #: ("12", aliceConn, "LET " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", aliceConn, OK)
alice <# ("", bobConn, INFO "bob's connInfo 2")
alice <# ("", bobConn, CON)
bob <# ("", aliceConn, CON)
alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 1)
alice <# ("", bobConn, SENT 1)
bob <#= \case ("", c, Msg "hi") -> c == aliceConn; _ -> False
bob #: ("13", aliceConn, "ACK 1") #> ("13", aliceConn, OK)
testRejectContactRequest :: Transport c => TProxy c -> c -> c -> IO ()
testRejectContactRequest _ alice bob = do
("1", "a_contact", Right (INV cReq)) <- alice #: ("1", "a_contact", "NEW CON")
let cReq' = serializeConnReq cReq
bob #: ("11", "alice", "JOIN " <> cReq' <> " 10\nbob's info") #> ("11", "alice", OK)
("", "a_contact", Right (REQ aInvId "bob's info")) <- (alice <#:)
-- RJCT must use correct contact connection
alice #: ("2a", "bob", "RJCT " <> aInvId) #> ("2a", "bob", ERR $ CONN NOT_FOUND)
alice #: ("2b", "a_contact", "RJCT " <> aInvId) #> ("2b", "a_contact", OK)
alice #: ("3", "bob", "ACPT " <> aInvId <> " 12\nalice's info") #> ("3", "bob", ERR $ A.CMD PROHIBITED)
bob #:# "nothing should be delivered to bob"
testSubscription :: Transport c => TProxy c -> c -> c -> c -> IO ()
testSubscription _ alice1 alice2 bob = do
(alice1, "alice") `connect` (bob, "bob")
@@ -181,7 +258,7 @@ testSubscription _ alice1 alice2 bob = do
testSubscrNotification :: Transport c => TProxy c -> (ThreadId, ThreadId) -> c -> IO ()
testSubscrNotification t (server, _) client = do
client #: ("1", "conn1", "NEW") =#> \case ("1", "conn1", INV {}) -> True; _ -> False
client #: ("1", "conn1", "NEW INV") =#> \case ("1", "conn1", INV {}) -> True; _ -> False
client #:# "nothing should be delivered to client before the server is killed"
killThread server
client <# ("", "conn1", DOWN)
@@ -249,20 +326,20 @@ testMsgDeliveryAgentRestart t bob = do
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)
("c1", _, Right (INV cReq)) <- h1 #: ("c1", name2, "NEW INV")
let cReq' = serializeConnReq cReq
h2 #: ("c2", name1, "JOIN " <> cReq' <> " 5\ninfo2") #> ("c2", name1, OK)
("", _, Right (CONF connId "info2")) <- (h1 <#:)
h1 #: ("c3", name2, "LET " <> 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")
-- ("c1", conn2, Right (INV cReq)) <- h1 #: ("c1", "", "NEW INV")
-- let cReq' = serializeConnReq cReq
-- ("c2", conn1, Right OK) <- h2 #: ("c2", "", "JOIN " <> cReq' <> " 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")
@@ -271,7 +348,7 @@ connect (h1, name1) (h2, name2) = do
-- pure (conn1, conn2)
samplePublicKey :: ByteString
samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR"
samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj-toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP-Tm4sokaFDTIG3QJFzOjC-_9nW4MUjAOFll9PCp9kaEFHJ_YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju_f6kAayvYKW3_lbJNXCmyinAccBosO08_0sUxvtuniIo18kfYJE0UmP1ReCjhMP-O-yOmwZJini_QelJk_Pez8IIDDWnY1qYQsN_q7ocjakOYrpGG7mig6JMFpDJtD6istR"
syntaxTests :: forall c. Transport c => TProxy c -> Spec
syntaxTests t = do
@@ -279,17 +356,17 @@ syntaxTests t = do
describe "NEW" $ do
describe "valid" $ do
-- TODO: add tests with defined connection alias
it "without parameters" $ ("211", "", "NEW") >#>= \case ("211", _, "INV" : _) -> True; _ -> False
it "with correct parameter" $ ("211", "", "NEW INV") >#>= \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")
it "with incorrect parameter" $ ("222", "", "NEW hi") >#> ("222", "", "ERR CMD SYNTAX")
describe "JOIN" $ 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
it "using same server as in invitation" $
("311", "a", "JOIN smp::localhost:5000::1234::" <> samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH")
("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2Flocalhost%3A5001%2F1234-w%3D%3D%23&e2e=" <> urlEncode True 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")
@@ -0,0 +1,69 @@
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
module AgentTests.ConnectionRequestTests where
import qualified Crypto.PubKey.RSA as R
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Parsers (parseAll)
import Test.Hspec
uri :: String
uri = "smp.simplex.im"
srv :: SMPServer
srv =
SMPServer
{ host = "smp.simplex.im",
port = Just "5223",
keyHash = Just (C.KeyHash "\215m\248\251")
}
queue :: SMPQueueUri
queue =
SMPQueueUri
{ smpServer = srv,
senderId = "\215m\248\251",
serverVerifyKey = reservedServerKey
}
appServer :: ConnReqScheme
appServer = CRSAppServer "simplex.chat" Nothing
connectionRequest :: AConnectionRequest
connectionRequest =
ACR SCMInvitation . CRInvitation $
ConnReqData
{ crScheme = appServer,
crSmpQueues = [queue],
crEncryptKey = C.APublicEncryptKey C.SRSA (C.PublicKeyRSA $ R.PublicKey 1 0 0)
}
connectionRequestTests :: Spec
connectionRequestTests = do
describe "connection request parsing / serializing" $ do
it "should serialize SMP queue URIs" $ do
serializeSMPQueueUri queue {smpServer = srv {port = Nothing, keyHash = Nothing}}
`shouldBe` "smp://smp.simplex.im/1234-w==#"
serializeSMPQueueUri queue {smpServer = srv {keyHash = Nothing}}
`shouldBe` "smp://smp.simplex.im:5223/1234-w==#"
serializeSMPQueueUri queue {smpServer = srv {port = Nothing}}
`shouldBe` "smp://1234-w==@smp.simplex.im/1234-w==#"
serializeSMPQueueUri queue
`shouldBe` "smp://1234-w==@smp.simplex.im:5223/1234-w==#"
it "should parse SMP queue URIs" $ do
parseAll smpQueueUriP "smp://smp.simplex.im/1234-w==#"
`shouldBe` Right queue {smpServer = srv {port = Nothing, keyHash = Nothing}}
parseAll smpQueueUriP "smp://smp.simplex.im:5223/1234-w==#"
`shouldBe` Right queue {smpServer = srv {keyHash = Nothing}}
parseAll smpQueueUriP "smp://1234-w==@smp.simplex.im/1234-w==#"
`shouldBe` Right queue {smpServer = srv {port = Nothing}}
parseAll smpQueueUriP "smp://1234-w==@smp.simplex.im:5223/1234-w==#"
`shouldBe` Right queue
it "should serialize connection requests" $ do
serializeConnReq connectionRequest
`shouldBe` "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F1234-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D"
it "should parse connection requests" $ do
parseAll connReqP "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F1234-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D"
`shouldBe` Right connectionRequest
+14 -14
View File
@@ -53,10 +53,10 @@ testAgentClient = do
alice <- getSMPAgentClient cfg
bob <- getSMPAgentClient cfg {dbFile = testDB2}
Right () <- runExceptT $ do
(bobId, qInfo) <- createConnection alice
(bobId, qInfo) <- createConnection alice SCMInvitation
aliceId <- joinConnection bob qInfo "bob's connInfo"
("", _, REQ confId "bob's connInfo") <- get alice
acceptConnection alice bobId confId "alice's connInfo"
("", _, CONF confId "bob's connInfo") <- get alice
allowConnection alice bobId confId "alice's connInfo"
get alice ##> ("", bobId, CON)
get bob ##> ("", aliceId, INFO "alice's connInfo")
get bob ##> ("", aliceId, CON)
@@ -96,13 +96,13 @@ testAsyncInitiatingOffline = do
alice <- getSMPAgentClient cfg
bob <- getSMPAgentClient cfg {dbFile = testDB2}
Right () <- runExceptT $ do
(bobId, qInfo) <- createConnection alice
(bobId, cReq) <- createConnection alice SCMInvitation
disconnectAgentClient alice
aliceId <- joinConnection bob qInfo "bob's connInfo"
aliceId <- joinConnection bob cReq "bob's connInfo"
alice' <- liftIO $ getSMPAgentClient cfg
subscribeConnection alice' bobId
("", _, REQ confId "bob's connInfo") <- get alice'
acceptConnection alice' bobId confId "alice's connInfo"
("", _, CONF confId "bob's connInfo") <- get alice'
allowConnection alice' bobId confId "alice's connInfo"
get alice' ##> ("", bobId, CON)
get bob ##> ("", aliceId, INFO "alice's connInfo")
get bob ##> ("", aliceId, CON)
@@ -114,11 +114,11 @@ testAsyncJoiningOfflineBeforeActivation = do
alice <- getSMPAgentClient cfg
bob <- getSMPAgentClient cfg {dbFile = testDB2}
Right () <- runExceptT $ do
(bobId, qInfo) <- createConnection alice
(bobId, qInfo) <- createConnection alice SCMInvitation
aliceId <- joinConnection bob qInfo "bob's connInfo"
disconnectAgentClient bob
("", _, REQ confId "bob's connInfo") <- get alice
acceptConnection alice bobId confId "alice's connInfo"
("", _, CONF confId "bob's connInfo") <- get alice
allowConnection alice bobId confId "alice's connInfo"
bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
subscribeConnection bob' aliceId
get alice ##> ("", bobId, CON)
@@ -135,14 +135,14 @@ testAsyncBothOffline = do
alice <- getSMPAgentClient cfg
bob <- getSMPAgentClient cfg {dbFile = testDB2}
Right () <- runExceptT $ do
(bobId, qInfo) <- createConnection alice
(bobId, cReq) <- createConnection alice SCMInvitation
disconnectAgentClient alice
aliceId <- joinConnection bob qInfo "bob's connInfo"
aliceId <- joinConnection bob cReq "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"
("", _, CONF confId "bob's connInfo") <- get alice'
allowConnection alice' bobId confId "alice's connInfo"
bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
subscribeConnection bob' aliceId
get alice' ##> ("", bobId, CON)
+52 -24
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -113,7 +114,7 @@ testConcurrentWrites :: SpecWith (SQLiteStore, SQLiteStore)
testConcurrentWrites =
it "should complete multiple concurrent write transactions w/t sqlite busy errors" $ \(s1, s2) -> do
g <- newTVarIO =<< drgNew
_ <- runExceptT $ createRcvConn s1 g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn s1 g cData1 rcvQueue1 SCMInvitation
let ConnData {connId} = cData1
concurrently_ (runTest s1 connId) (runTest s2 connId)
where
@@ -148,14 +149,41 @@ testForeignKeysEnabled =
cData1 :: ConnData
cData1 = ConnData {connId = "conn1"}
testPrivateSignKey :: C.APrivateSignKey
testPrivateSignKey = C.APrivateSignKey C.SRSA testPrivateKey
testPrivateDecryptKey :: C.APrivateDecryptKey
testPrivateDecryptKey = C.APrivateDecryptKey C.SRSA testPrivateKey
testPublicEncryptKey :: C.APublicEncryptKey
testPublicEncryptKey = C.APublicEncryptKey C.SRSA $ C.PublicKeyRSA $ R.PublicKey 1 2 3
testPrivateKey :: C.PrivateKey 'C.RSA
testPrivateKey =
C.PrivateKeyRSA
R.PrivateKey
{ private_pub =
R.PublicKey
{ public_size = 1,
public_n = 2,
public_e = 0
},
private_d = 3,
private_p = 0,
private_q = 0,
private_dP = 0,
private_dQ = 0,
private_qinv = 0
}
rcvQueue1 :: RcvQueue
rcvQueue1 =
RcvQueue
{ server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
rcvId = "1234",
rcvPrivateKey = C.safePrivateKey (1, 2, 3),
rcvPrivateKey = testPrivateSignKey,
sndId = Just "2345",
decryptKey = C.safePrivateKey (1, 2, 3),
decryptKey = testPrivateDecryptKey,
verifyKey = Nothing,
status = New
}
@@ -165,9 +193,9 @@ sndQueue1 =
SndQueue
{ server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
sndId = "3456",
sndPrivateKey = C.safePrivateKey (1, 2, 3),
encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
sndPrivateKey = testPrivateSignKey,
encryptKey = testPublicEncryptKey,
signKey = testPrivateSignKey,
status = New
}
@@ -175,7 +203,7 @@ testCreateRcvConn :: SpecWith SQLiteStore
testCreateRcvConn =
it "should create RcvConnection and add SndQueue" $ \store -> do
g <- newTVarIO =<< drgNew
createRcvConn store g cData1 rcvQueue1
createRcvConn store g cData1 rcvQueue1 SCMInvitation
`returnsResult` "conn1"
getConn store "conn1"
`returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
@@ -188,7 +216,7 @@ 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
Right connId <- runExceptT $ createRcvConn store g cData1 {connId = ""} rcvQueue1 SCMInvitation
getConn store connId
`returnsResult` SomeConn SCRcv (RcvConnection cData1 {connId} rcvQueue1)
upgradeRcvConnToDuplex store connId sndQueue1
@@ -200,8 +228,8 @@ testCreateRcvConnDuplicate :: SpecWith SQLiteStore
testCreateRcvConnDuplicate =
it "should throw error on attempt to create duplicate RcvConnection" $ \store -> do
g <- newTVarIO =<< drgNew
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
createRcvConn store g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
createRcvConn store g cData1 rcvQueue1 SCMInvitation
`throwsError` SEConnDuplicate
testCreateSndConn :: SpecWith SQLiteStore
@@ -241,7 +269,7 @@ testGetAllConnIds :: SpecWith SQLiteStore
testGetAllConnIds =
it "should get all conn aliases" $ \store -> do
g <- newTVarIO =<< drgNew
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
_ <- runExceptT $ createSndConn store g cData1 {connId = "conn2"} sndQueue1
getAllConnIds store
`returnsResult` ["conn1" :: ConnId, "conn2" :: ConnId]
@@ -252,7 +280,7 @@ testGetRcvConn =
let smpServer = SMPServer "smp.simplex.im" (Just "5223") testKeyHash
let recipientId = "1234"
g <- newTVarIO =<< drgNew
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
getRcvConn store smpServer recipientId
`returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
@@ -260,7 +288,7 @@ testDeleteRcvConn :: SpecWith SQLiteStore
testDeleteRcvConn =
it "should create RcvConnection and delete it" $ \store -> do
g <- newTVarIO =<< drgNew
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
getConn store "conn1"
`returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
deleteConn store "conn1"
@@ -286,7 +314,7 @@ testDeleteDuplexConn :: SpecWith SQLiteStore
testDeleteDuplexConn =
it "should create DuplexConnection and delete it" $ \store -> do
g <- newTVarIO =<< drgNew
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
_ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1
getConn store "conn1"
`returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)
@@ -305,9 +333,9 @@ testUpgradeRcvConnToDuplex =
SndQueue
{ server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
sndId = "2345",
sndPrivateKey = C.safePrivateKey (1, 2, 3),
encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
sndPrivateKey = testPrivateSignKey,
encryptKey = testPublicEncryptKey,
signKey = testPrivateSignKey,
status = New
}
upgradeRcvConnToDuplex store "conn1" anotherSndQueue
@@ -320,14 +348,14 @@ testUpgradeSndConnToDuplex :: SpecWith SQLiteStore
testUpgradeSndConnToDuplex =
it "should throw error on attempt to add RcvQueue to RcvConnection or DuplexConnection" $ \store -> do
g <- newTVarIO =<< drgNew
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
let anotherRcvQueue =
RcvQueue
{ server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
rcvId = "3456",
rcvPrivateKey = C.safePrivateKey (1, 2, 3),
rcvPrivateKey = testPrivateSignKey,
sndId = Just "4567",
decryptKey = C.safePrivateKey (1, 2, 3),
decryptKey = testPrivateDecryptKey,
verifyKey = Nothing,
status = New
}
@@ -341,7 +369,7 @@ testSetRcvQueueStatus :: SpecWith SQLiteStore
testSetRcvQueueStatus =
it "should update status of RcvQueue" $ \store -> do
g <- newTVarIO =<< drgNew
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
getConn store "conn1"
`returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1)
setRcvQueueStatus store rcvQueue1 Confirmed
@@ -365,7 +393,7 @@ testSetQueueStatusDuplex :: SpecWith SQLiteStore
testSetQueueStatusDuplex =
it "should update statuses of RcvQueue and SndQueue in DuplexConnection" $ \store -> do
g <- newTVarIO =<< drgNew
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
_ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1
getConn store "conn1"
`returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1)
@@ -425,7 +453,7 @@ testCreateRcvMsg =
it "should reserve internal ids and create a RcvMsg" $ \st -> do
g <- newTVarIO =<< drgNew
let ConnData {connId} = cData1
_ <- runExceptT $ createRcvConn st g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn st g cData1 rcvQueue1 SCMInvitation
-- TODO getMsg to check message
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"
@@ -463,7 +491,7 @@ testCreateRcvAndSndMsgs =
it "should create multiple RcvMsg and SndMsg, correctly ordering internal Ids and returning previous state" $ \store -> do
g <- newTVarIO =<< drgNew
let ConnData {connId} = cData1
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1
_ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
_ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1
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"
+2 -2
View File
@@ -155,7 +155,7 @@ cfg :: AgentConfig
cfg =
defaultAgentConfig
{ tcpPort = agentTestPort,
smpServers = L.fromList ["localhost:5000#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="],
smpServers = L.fromList ["localhost:5001#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="],
tbqSize = 1,
dbFile = testDB,
smpCfg =
@@ -187,7 +187,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.4.1 agent"
if line == "Welcome to SMP agent v" <> currentSMPVersionStr
then client h
else error $ "wrong welcome message: " <> B.unpack line
+11 -10
View File
@@ -12,6 +12,7 @@ import Control.Monad.Except (runExceptT)
import Control.Monad.IO.Unlift
import Crypto.Random
import Data.ByteString.Base64 (encode)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Network.Socket
import qualified Simplex.Messaging.Crypto as C
@@ -31,12 +32,12 @@ testHost :: HostName
testHost = "localhost"
testPort :: ServiceName
testPort = "5000"
testPort = "5001"
testPort2 :: ServiceName
testPort2 = "5001"
testPort2 = "5002"
testKeyHashStr :: B.ByteString
testKeyHashStr :: ByteString
testKeyHashStr = "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
testBlockSize :: Maybe Int
@@ -145,8 +146,8 @@ runSmpTestN nClients test = withSmpServer (transport @c) $ run nClients []
run 0 hs = test hs
run n hs = testSMPClient $ \h -> run (n - 1) (h : hs)
smpServerTest :: forall c. Transport c => TProxy c -> RawTransmission -> IO RawTransmission
smpServerTest _ cmd = runSmpTest $ \(h :: THandle c) -> tPutRaw h cmd >> tGetRaw h
smpServerTest :: forall c. Transport c => TProxy c -> SignedRawTransmission -> IO SignedRawTransmission
smpServerTest _ t = runSmpTest $ \(h :: THandle c) -> tPutRaw h t >> tGetRaw h
smpTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
smpTest _ test' = runSmpTest test' `shouldReturn` ()
@@ -172,12 +173,12 @@ smpTest4 _ test' = smpTestN 4 _test
_test [h1, h2, h3, h4] = test' h1 h2 h3 h4
_test _ = error "expected 4 handles"
tPutRaw :: Transport c => THandle c -> RawTransmission -> IO ()
tPutRaw :: Transport c => THandle c -> SignedRawTransmission -> IO ()
tPutRaw h (sig, corrId, queueId, command) = do
let t = B.intercalate " " [corrId, queueId, command]
void $ tPut h (C.Signature sig, t)
void $ tPut h (sig, t)
tGetRaw :: Transport c => THandle c -> IO RawTransmission
tGetRaw :: Transport c => THandle c -> IO SignedRawTransmission
tGetRaw h = do
("", (CorrId corrId, qId, Right cmd)) <- tGet fromServer h
pure ("", corrId, encode qId, serializeCommand cmd)
(Nothing, (CorrId corrId, qId, Right cmd)) <- tGet fromServer h
pure (Nothing, corrId, encode qId, serializeCommand cmd)
+93 -66
View File
@@ -43,14 +43,14 @@ serverTests t = do
pattern Resp :: CorrId -> QueueId -> Command 'Broker -> SignedTransmissionOrError
pattern Resp corrId queueId command <- ("", (corrId, queueId, Right (Cmd SBroker command)))
sendRecv :: Transport c => THandle c -> (ByteString, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
sendRecv :: Transport c => THandle c -> (Maybe C.ASignature, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
sendRecv h (sgn, corrId, qId, cmd) = tPutRaw h (sgn, corrId, encode qId, cmd) >> tGet fromServer h
signSendRecv :: Transport c => THandle c -> C.SafePrivateKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
signSendRecv :: Transport c => THandle c -> C.APrivateSignKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
signSendRecv h pk (corrId, qId, cmd) = do
let t = B.intercalate " " [corrId, encode qId, cmd]
Right sig <- runExceptT $ C.sign pk t
_ <- tPut h (sig, t)
_ <- tPut h (Just sig, t)
tGet fromServer h
cmdSEND :: ByteString -> ByteString
@@ -63,8 +63,8 @@ testCreateSecure :: ATransport -> Spec
testCreateSecure (ATransport t) =
it "should create (NEW) and secure (KEY) queue" $
smpTest t $ \h -> do
(rPub, rKey) <- C.generateKeyPair rsaKeySize
Resp "abcd" rId1 (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
(rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
Resp "abcd" rId1 (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializeKey rPub)
(rId1, "") #== "creates queue"
Resp "bcda" sId1 ok1 <- sendRecv h ("", "bcda", sId, "SEND 5 hello ")
@@ -80,12 +80,12 @@ testCreateSecure (ATransport t) =
Resp "dabc" _ err6 <- signSendRecv h rKey ("dabc", rId, "ACK")
(err6, ERR NO_MSG) #== "replies ERR when message acknowledged without messages"
(sPub, sKey) <- C.generateKeyPair rsaKeySize
(sPub, sKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
Resp "abcd" sId2 err1 <- signSendRecv h sKey ("abcd", sId, "SEND 5 hello ")
(err1, ERR AUTH) #== "rejects signed SEND"
(sId2, sId) #== "same queue ID in response 2"
let keyCmd = "KEY " <> C.serializePubKey sPub
let keyCmd = "KEY " <> C.serializeKey sPub
Resp "bcda" _ err2 <- sendRecv h (sampleSig, "bcda", rId, keyCmd)
(err2, ERR AUTH) #== "rejects KEY with wrong signature"
@@ -115,12 +115,12 @@ testCreateDelete :: ATransport -> Spec
testCreateDelete (ATransport t) =
it "should create (NEW), suspend (OFF) and delete (DEL) queue" $
smpTest2 t $ \rh sh -> do
(rPub, rKey) <- C.generateKeyPair rsaKeySize
Resp "abcd" rId1 (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
(rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
Resp "abcd" rId1 (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializeKey rPub)
(rId1, "") #== "creates queue"
(sPub, sKey) <- C.generateKeyPair rsaKeySize
Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, "KEY " <> C.serializePubKey sPub)
(sPub, sKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, "KEY " <> C.serializeKey sPub)
(ok1, OK) #== "secures queue"
Resp "cdab" _ ok2 <- signSendRecv sh sKey ("cdab", sId, "SEND 5 hello ")
@@ -183,22 +183,22 @@ testDuplex :: ATransport -> Spec
testDuplex (ATransport t) =
it "should create 2 simplex connections and exchange messages" $
smpTest2 t $ \alice bob -> do
(arPub, arKey) <- C.generateKeyPair rsaKeySize
Resp "abcd" _ (IDS aRcv aSnd) <- signSendRecv alice arKey ("abcd", "", "NEW " <> C.serializePubKey arPub)
(arPub, arKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
Resp "abcd" _ (IDS aRcv aSnd) <- signSendRecv alice arKey ("abcd", "", "NEW " <> C.serializeKey arPub)
-- aSnd ID is passed to Bob out-of-band
(bsPub, bsKey) <- C.generateKeyPair rsaKeySize
Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, cmdSEND $ "key " <> C.serializePubKey bsPub)
(bsPub, bsKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, cmdSEND $ "key " <> C.serializeKey bsPub)
-- "key ..." is ad-hoc, different from SMP protocol
Resp "" _ (MSG _ _ msg1) <- tGet fromServer alice
Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, "ACK")
["key", bobKey] <- return $ B.words msg1
(bobKey, C.serializePubKey bsPub) #== "key received from Bob"
(bobKey, C.serializeKey bsPub) #== "key received from Bob"
Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, "KEY " <> bobKey)
(brPub, brKey) <- C.generateKeyPair rsaKeySize
Resp "abcd" _ (IDS bRcv bSnd) <- signSendRecv bob brKey ("abcd", "", "NEW " <> C.serializePubKey brPub)
(brPub, brKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
Resp "abcd" _ (IDS bRcv bSnd) <- signSendRecv bob brKey ("abcd", "", "NEW " <> C.serializeKey brPub)
Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, cmdSEND $ "reply_id " <> encode bSnd)
-- "reply_id ..." is ad-hoc, it is not a part of SMP protocol
@@ -207,14 +207,14 @@ testDuplex (ATransport t) =
["reply_id", bId] <- return $ B.words msg2
(bId, encode bSnd) #== "reply queue ID received from Bob"
(asPub, asKey) <- C.generateKeyPair rsaKeySize
Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, cmdSEND $ "key " <> C.serializePubKey asPub)
(asPub, asKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, cmdSEND $ "key " <> C.serializeKey asPub)
-- "key ..." is ad-hoc, different from SMP protocol
Resp "" _ (MSG _ _ msg3) <- tGet fromServer bob
Resp "abcd" _ OK <- signSendRecv bob brKey ("abcd", bRcv, "ACK")
["key", aliceKey] <- return $ B.words msg3
(aliceKey, C.serializePubKey asPub) #== "key received from Alice"
(aliceKey, C.serializeKey asPub) #== "key received from Alice"
Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, "KEY " <> aliceKey)
Resp "cdab" _ OK <- signSendRecv bob bsKey ("cdab", aSnd, "SEND 8 hi alice ")
@@ -233,8 +233,8 @@ testSwitchSub :: ATransport -> Spec
testSwitchSub (ATransport t) =
it "should create simplex connections and switch subscription to another TCP connection" $
smpTest3 t $ \rh1 rh2 sh -> do
(rPub, rKey) <- C.generateKeyPair rsaKeySize
Resp "abcd" _ (IDS rId sId) <- signSendRecv rh1 rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
(rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
Resp "abcd" _ (IDS rId sId) <- signSendRecv rh1 rKey ("abcd", "", "NEW " <> C.serializeKey rPub)
Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, "SEND 5 test1 ")
(ok1, OK) #== "sent test message 1"
Resp "cdab" _ ok2 <- sendRecv sh ("", "cdab", sId, cmdSEND "test2, no ACK")
@@ -270,9 +270,9 @@ testSwitchSub (ATransport t) =
testWithStoreLog :: ATransport -> Spec
testWithStoreLog at@(ATransport t) =
it "should store simplex queues to log and restore them after server restart" $ do
(sPub1, sKey1) <- C.generateKeyPair rsaKeySize
(sPub2, sKey2) <- C.generateKeyPair rsaKeySize
(nPub, nKey) <- C.generateKeyPair rsaKeySize
(sPub1, sKey1) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
(sPub2, sKey2) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
(nPub, nKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
senderId1 <- newTVarIO ""
senderId2 <- newTVarIO ""
notifierId <- newTVarIO ""
@@ -280,7 +280,7 @@ testWithStoreLog at@(ATransport t) =
withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do
(sId1, rId, rKey) <- createAndSecureQueue h sPub1
atomically $ writeTVar senderId1 sId1
Resp "abcd" _ (NID nId) <- signSendRecv h rKey ("abcd", rId, "NKEY " <> C.serializePubKey nPub)
Resp "abcd" _ (NID nId) <- signSendRecv h rKey ("abcd", rId, "NKEY " <> C.serializeKey nPub)
atomically $ writeTVar notifierId nId
Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, "NSUB")
Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ")
@@ -331,11 +331,11 @@ testWithStoreLog at@(ATransport t) =
Right l -> pure l
Left (_ :: SomeException) -> logSize
createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.SafePrivateKey)
createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.APrivateSignKey)
createAndSecureQueue h sPub = do
(rPub, rKey) <- C.generateKeyPair rsaKeySize
Resp "abcd" "" (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
let keyCmd = "KEY " <> C.serializePubKey sPub
(rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
Resp "abcd" "" (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializeKey rPub)
let keyCmd = "KEY " <> C.serializeKey sPub
Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, keyCmd)
(rId', rId) #== "same queue ID"
pure (sId, rId, rKey)
@@ -346,54 +346,81 @@ testTiming (ATransport t) =
smpTest2 t $ \rh sh ->
mapM_
(testSameTiming rh sh)
[ (128, 128, 100),
(128, 256, 25),
(128, 384, 15),
-- (128, 512, 15),
(256, 128, 100),
(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),
[ (32, 32, 200),
(32, 57, 100),
(32, 128, 40),
(32, 256, 20),
(57, 32, 200),
(57, 57, 100),
(57, 128, 40),
(57, 256, 20),
(128, 32, 200),
(128, 57, 100),
(128, 128, 40),
(128, 256, 20),
(256, 32, 200),
(256, 57, 100),
(256, 128, 40),
(256, 256, 20)
-- (256, 384, 15),
-- (256, 512, 10),
-- (384, 128, 40),
-- (384, 256, 20),
-- (384, 384, 15),
-- (384, 512, 10),
-- (512, 128, 40),
-- (512, 256, 20),
-- (512, 384, 15),
-- (512, 512, 15)
-- (512, 512, 10)
]
where
timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
similarTime t1 t2 = abs (t1 - t2) / t1 < 0.2 `shouldBe` True
similarTime t1 t2 = abs (t2 / t1 - 1) < 0.25 `shouldBe` True
testSameTiming :: Transport c => THandle c -> THandle c -> (Int, Int, Int) -> Expectation
testSameTiming rh sh (senderKeySize, badKeySize, n) = do
(rPub, rKey) <- C.generateKeyPair rsaKeySize
Resp "abcd" "" (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
testSameTiming rh sh (goodKeySize, badKeySize, n) = do
(rPub, rKey) <- generateKeys goodKeySize
Resp "abcd" "" (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializeKey rPub)
Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, "SUB")
(sPub, sKey) <- C.generateKeyPair senderKeySize
let keyCmd = "KEY " <> C.serializePubKey sPub
(_, badKey) <- generateKeys badKeySize
-- runTimingTest rh badKey rId "SUB"
(sPub, sKey) <- generateKeys goodKeySize
let keyCmd = "KEY " <> C.serializeKey sPub
Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, keyCmd)
(_, badKey) <- C.generateKeyPair badKeySize
Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, "SEND 5 hello ")
timeWrongKey <- timeRepeat n $ do
Resp "cdab" _ (ERR AUTH) <- signSendRecv sh badKey ("cdab", sId, "SEND 5 hello ")
return ()
timeNoQueue <- timeRepeat n $ do
Resp "dabc" _ (ERR AUTH) <- signSendRecv sh badKey ("dabc", "1234", "SEND 5 hello ")
return ()
Resp "" _ (MSG _ _ "hello") <- tGet fromServer rh
similarTime timeNoQueue timeWrongKey
runTimingTest sh badKey sId "SEND 5 hello "
where
generateKeys = \case
32 -> C.generateSignatureKeyPair 0 C.SEd25519
57 -> C.generateSignatureKeyPair 0 C.SEd448
size -> C.generateSignatureKeyPair size C.SRSA
runTimingTest h badKey qId cmd = do
timeWrongKey <- timeRepeat n $ do
Resp "cdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdab", qId, cmd)
return ()
timeNoQueue <- timeRepeat n $ do
Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", "1234", cmd)
return ()
-- (putStrLn . unwords . map show)
-- [ fromIntegral goodKeySize,
-- fromIntegral badKeySize,
-- timeWrongKey,
-- timeNoQueue,
-- timeWrongKey / timeNoQueue - 1
-- ]
similarTime timeNoQueue timeWrongKey
testMessageNotifications :: ATransport -> Spec
testMessageNotifications (ATransport t) =
it "should create simplex connection, subscribe notifier and deliver notifications" $ do
(sPub, sKey) <- C.generateKeyPair rsaKeySize
(nPub, nKey) <- C.generateKeyPair rsaKeySize
(sPub, sKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
(nPub, nKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
smpTest4 t $ \rh sh nh1 nh2 -> do
(sId, rId, rKey) <- createAndSecureQueue rh sPub
Resp "1" _ (NID nId) <- signSendRecv rh rKey ("1", rId, "NKEY " <> C.serializePubKey nPub)
Resp "1" _ (NID nId) <- signSendRecv rh rKey ("1", rId, "NKEY " <> C.serializeKey nPub)
Resp "2" _ OK <- signSendRecv nh1 nKey ("2", nId, "NSUB")
Resp "3" _ OK <- signSendRecv sh sKey ("3", sId, "SEND 5 hello ")
Resp "" _ (MSG _ _ "hello") <- tGet fromServer rh
@@ -411,8 +438,8 @@ testMessageNotifications (ATransport t) =
samplePubKey :: ByteString
samplePubKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR"
sampleSig :: ByteString
sampleSig = "\128\207*\159eq\220i!\"\157\161\130\184\226\246\232_\\\170`\180\160\230sI\154\197\211\252\SUB\246\206ELL\t9K\ESC\196?\128\215%\222\148\NAK;9\155f\164\217e\242\156\CAN9\253\r\170\174'w\211\228?\205)\215\150\255\247z\DC115\DC1{\bn\145\rKD,K\230\202d8\233\167|7y\t_S\EM\248\EOT\216\172\167d\181\224)\137\ACKo\197j#c\217\243\228.\167\228\205\144\vr\134"
sampleSig :: Maybe C.ASignature
sampleSig = "gM8qn2Vx3GkhIp2hgrji9uhfXKpgtKDmc0maxdP8GvbORUxMCTlLG8Q/gNcl3pQVOzmbZqTZZfKcGDn9DaquJ3fT5D/NKdeW//d6ETE1EXsIbpENS0QsS+bKZDjpp3w3eQlfUxn4BNisp2S14CmJBm/FaiNj2fPkLqfkzZALcoY="
syntaxTests :: ATransport -> Spec
syntaxTests (ATransport t) = do
@@ -451,5 +478,5 @@ syntaxTests (ATransport t) = do
it "wrong terminator" $ (sampleSig, "bcda", "12345678", cmd <> "=") >#> ("", "bcda", "12345678", "ERR CMD SYNTAX")
it "no signature" $ ("", "cdab", "12345678", cmd) >#> ("", "cdab", "12345678", "ERR CMD NO_AUTH")
it "no queue ID" $ (sampleSig, "dabc", "", cmd) >#> ("", "dabc", "", "ERR CMD NO_AUTH")
(>#>) :: RawTransmission -> RawTransmission -> Expectation
(>#>) :: SignedRawTransmission -> SignedRawTransmission -> Expectation
command >#> response = smpServerTest t command `shouldReturn` response