agent: use double ratchet from the first message in contact addresses, request rejection, RPC (#1831)

* agent: initialize double ratchet from the invitation via contact address (#1829)

* rfc: agent support for PRC pattern without duplex connection

* update rfc, plan

* corrections

Co-authored-by: Evgeny <evgeny@poberezkin.com>

* split rfcs, add plan

* update rfc

* update rfc and plan

* update plan

* add double ratchet keys to address

* agent schema

* fix version in test

* change ContactRequest encoding

* fix tests

* update plan

* tests, refactor

* fix compilation

* refactor

* refactor more

* fix

* add export

* fix

* refactor

* refactor

* update schema

* rename

* refactor

* refactor 2

* comment, type

* type

* rename

* refactor more

* move type

* refactor

* remove comment

* diff

* refactor

* comment

* puns

* get correct key

* rename

* add autoincrement

* refactor

* move

* move back

* simplify

* rename

* refactor

* tuple

* comment

* split decryption

* refactor

* rename

* refactor

* move

* remove createSndQueue

* remove comment

* remove JoinInvitationReq

* simplify

* rename

* fix

* type synonim

* getConnData

* simplify

* move

* encoding

* version

* async join with ratchet keys

* fix encoding

* rotate address ratchet keys

* rename, parameter order

* refactor, include ratchet keys into ConnectionRequestUri

* simplify

* remove records

* refactor

* rename, encoding

* clean up

* refactor

* compatible

* addrKeysE2EVersion

* support IKUsePQ for contact addresses

* comments, refactor condition

* typos

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>

* agent: contact request rejection and service requests (#1833)

* agent: request rejection

* implement RPC requests/responses

* simplify rpc, test, async

* renames

* clean up

* fix

* fix query

* set flag at creation

* move

* command type, schema

* rename

* refactor

* typo

Co-authored-by: simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com>

* allow overriding the service request timeout per request

* fixes

* use SSENT event for service replies

* AgentServiceError encoding

* sign service requests

* add bad signature error

* update the plan

* clean up

* refactor

* empty line

Co-authored-by: simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com>

* add indices

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
Co-authored-by: simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com>

* update schemas

* tryAllErrors

* combine queries

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
Co-authored-by: simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com>
This commit is contained in:
Evgeny
2026-07-31 19:32:34 +01:00
committed by GitHub
co-authored by Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com> simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com> simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com> Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com> simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com> Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com> simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com>
parent 066a93861b
commit e4e5ce75fa
31 changed files with 2382 additions and 390 deletions
+184 -41
View File
@@ -1,6 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
@@ -54,8 +55,10 @@ module Simplex.Messaging.Agent.Protocol
-- * SMP agent protocol types
ConnInfo,
SndQueueSecured,
UseRatchetKeys,
AEntityId,
ACommand (..),
JoinRequest (..),
AEvent (..),
AEvt (..),
ACommandTag (..),
@@ -80,6 +83,7 @@ module Simplex.Messaging.Agent.Protocol
SMPConfirmation (..),
AgentMsgEnvelope (..),
AgentMessage (..),
RequestSignature (..),
AgentMessageType (..),
APrivHeader (..),
AMessage (..),
@@ -107,6 +111,9 @@ module Simplex.Messaging.Agent.Protocol
ConnectionModeI (..),
ConnectionRequestUri (..),
AConnectionRequestUri (..),
BinaryConnectionRequestUri (..),
ABinaryConnectionRequestUri (..),
binaryConnReq,
ShortLinkCreds (..),
ConnReqUriData (..),
CRClientData,
@@ -118,6 +125,10 @@ module Simplex.Messaging.Agent.Protocol
UserConnLinkData (..),
UserContactData (..),
UserLinkData (..),
AddressRatchetKeys,
NewRatchetKeys,
DRInvitation (..),
RatchetKeyId (..),
OwnerAuth (..),
OwnerId,
ConnectionLink (..),
@@ -151,6 +162,7 @@ module Simplex.Messaging.Agent.Protocol
ConnectionErrorType (..),
BrokerErrorType (..),
SMPAgentError (..),
AgentServiceError (..),
DroppedMsg (..),
AgentCryptoError (..),
cryptoErrToSyncState,
@@ -200,6 +212,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Base64.URL as B64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as LB
import Data.Char (toLower, toUpper)
import Data.Foldable (find)
import Data.Functor (($>))
@@ -230,9 +243,11 @@ import Simplex.Messaging.Crypto.Ratchet
( InitialKeys (..),
PQEncryption (..),
PQSupport,
RatchetX448,
RcvE2ERatchetParams,
RcvE2ERatchetParamsUri,
SndE2ERatchetParams,
RcvE2EPrivRatchetParams,
pattern PQSupportOff,
pattern PQSupportOn,
)
@@ -393,13 +408,18 @@ type ConnInfo = ByteString
type SndQueueSecured = Bool
type UseRatchetKeys = Bool
-- | Parameterized type for SMP agent events
data AEvent (e :: AEntity) where
INV :: AConnectionRequestUri -> AEvent AEConn
LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn
LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> AEvent AEConn
LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> ConnectionRequestUri 'CMContact -> AEvent AEConn
CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender
REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> Bool -> AEvent AEConn -- ConnInfo is from sender; Bool - rejection reason can be sent
SREQ :: InvitationId -> Maybe C.PublicKeyEd25519 -> MsgBody -> AEvent AEConn
SSENT :: AgentMsgId -> Maybe SMPServer -> AEvent AEConn
RJCT :: ConnInfo -> AEvent AEConn
INFO :: PQSupport -> ConnInfo -> AEvent AEConn
CON :: PQEncryption -> AEvent AEConn -- notification that connection is established
END :: AEvent AEConn
@@ -454,15 +474,15 @@ instance Eq AEvtTag where
deriving instance Show AEvtTag
data ACommand
= NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV
= NEW Bool AConnectionMode InitialKeys SubscriptionMode UseRatchetKeys -- response INV
| LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK
| LGET (ConnShortLink 'CMContact) -- response LDATA
| JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo
| JOIN JoinRequest SubscriptionMode ConnInfo
| LET ConfirmationId ConnInfo -- ConnInfo is from client
| ACK AgentMsgId (Maybe MsgReceiptInfo)
| SWCH
| DEL
deriving (Eq, Show)
deriving (Show)
data ACommandTag
= NEW_
@@ -481,6 +501,9 @@ data AEventTag (e :: AEntity) where
LDATA_ :: AEventTag AEConn
CONF_ :: AEventTag AEConn
REQ_ :: AEventTag AEConn
SREQ_ :: AEventTag AEConn
SSENT_ :: AEventTag AEConn
RJCT_ :: AEventTag AEConn
INFO_ :: AEventTag AEConn
CON_ :: AEventTag AEConn
END_ :: AEventTag AEConn
@@ -544,6 +567,9 @@ aEventTag = \case
LDATA {} -> LDATA_
CONF {} -> CONF_
REQ {} -> REQ_
SREQ {} -> SREQ_
SSENT {} -> SSENT_
RJCT {} -> RJCT_
INFO {} -> INFO_
CON _ -> CON_
END -> END_
@@ -843,6 +869,12 @@ data AgentMsgEnvelope
connReq :: ConnectionRequestUri 'CMInvitation,
connInfo :: ByteString -- this message is only encrypted with per-queue E2E, not with double ratchet,
}
| AgentContactRequest -- DR request to a contact address that published DR keys: a contact invitation or a service (RPC) request
{ agentVersion :: VersionSMPA,
e2eSndParams :: SndE2ERatchetParams 'C.X448,
ratchetKeyId :: RatchetKeyId,
encConnInfo :: ByteString
}
| AgentRatchetKey
{ agentVersion :: VersionSMPA,
e2eEncryption :: RcvE2ERatchetParams 'C.X448,
@@ -858,6 +890,8 @@ instance Encoding AgentMsgEnvelope where
smpEncode (agentVersion, 'M', Tail encAgentMessage)
AgentInvitation {agentVersion, connReq, connInfo} ->
smpEncode (agentVersion, 'I', Large $ strEncode connReq, Tail connInfo)
AgentContactRequest {agentVersion, e2eSndParams, ratchetKeyId, encConnInfo} ->
smpEncode (agentVersion, 'A', e2eSndParams, ratchetKeyId, Tail encConnInfo)
AgentRatchetKey {agentVersion, e2eEncryption, info} ->
smpEncode (agentVersion, 'R', e2eEncryption, Tail info)
smpP = do
@@ -873,12 +907,22 @@ instance Encoding AgentMsgEnvelope where
connReq <- strDecode . unLarge <$?> smpP
Tail connInfo <- smpP
pure AgentInvitation {agentVersion, connReq, connInfo}
'A' -> do
(e2eSndParams, ratchetKeyId, Tail encConnInfo) <- smpP
pure AgentContactRequest {agentVersion, e2eSndParams, ratchetKeyId, encConnInfo}
'R' -> do
e2eEncryption <- smpP
Tail info <- smpP
pure AgentRatchetKey {agentVersion, e2eEncryption, info}
_ -> fail "bad AgentMsgEnvelope"
data RequestSignature = RequestSignature C.PublicKeyEd25519 (C.Signature 'C.Ed25519)
deriving (Eq, Show)
instance Encoding RequestSignature where
smpEncode (RequestSignature k sig) = smpEncode (k, sig)
smpP = RequestSignature <$> smpP <*> smpP
-- SMP agent message formats (after double ratchet decryption,
-- or in case of AgentInvitation - in plain text body)
-- AgentRatchetInfo is not encrypted with double ratchet, but with per-queue E2E encryption
@@ -890,6 +934,9 @@ data AgentMessage
AgentConnInfoReply (NonEmpty SMPQueueInfo) ConnInfo
| AgentRatchetInfo ByteString
| AgentMessage APrivHeader AMessage
| AgentServiceRequest (NonEmpty SMPQueueInfo) (Maybe RequestSignature) MsgBody
| AgentServiceResponse MsgBody
| AgentRejection ByteString
deriving (Show)
instance Encoding AgentMessage where
@@ -898,12 +945,18 @@ instance Encoding AgentMessage where
AgentConnInfoReply smpQueues cInfo -> smpEncode ('D', smpQueues, Tail cInfo) -- 'D' stands for "duplex"
AgentRatchetInfo info -> smpEncode ('R', Tail info)
AgentMessage hdr aMsg -> smpEncode ('M', hdr, aMsg)
AgentServiceRequest qs sig_ body -> smpEncode ('A', qs, sig_, Tail body)
AgentServiceResponse body -> smpEncode ('P', Tail body)
AgentRejection reason -> smpEncode ('J', Tail reason)
smpP =
smpP >>= \case
'I' -> AgentConnInfo . unTail <$> smpP
'D' -> AgentConnInfoReply <$> smpP <*> (unTail <$> smpP)
'R' -> AgentRatchetInfo . unTail <$> smpP
'M' -> AgentMessage <$> smpP <*> smpP
'A' -> AgentServiceRequest <$> smpP <*> smpP <*> (unTail <$> smpP)
'P' -> AgentServiceResponse . unTail <$> smpP
'J' -> AgentRejection . unTail <$> smpP
_ -> fail "bad AgentMessage"
-- internal type for storing message type in the database
@@ -920,6 +973,9 @@ data AgentMessageType
| AM_QUSE_
| AM_QTEST_
| AM_EREADY_
| AM_SRV_REQ
| AM_SRV_RESP
| AM_RJCT
deriving (Eq, Show)
instance Encoding AgentMessageType where
@@ -936,6 +992,9 @@ instance Encoding AgentMessageType where
AM_QUSE_ -> "QU"
AM_QTEST_ -> "QT"
AM_EREADY_ -> "E"
AM_SRV_REQ -> "A"
AM_SRV_RESP -> "P"
AM_RJCT -> "J"
smpP =
A.anyChar >>= \case
'C' -> pure AM_CONN_INFO
@@ -953,6 +1012,9 @@ instance Encoding AgentMessageType where
'T' -> pure AM_QTEST_
_ -> fail "bad AgentMessageType"
'E' -> pure AM_EREADY_
'A' -> pure AM_SRV_REQ
'P' -> pure AM_SRV_RESP
'J' -> pure AM_RJCT
_ -> fail "bad AgentMessageType"
agentMessageType :: AgentMessage -> AgentMessageType
@@ -961,6 +1023,9 @@ agentMessageType = \case
AgentConnInfoReply {} -> AM_CONN_INFO_REPLY
AgentRatchetInfo _ -> AM_RATCHET_INFO
AgentMessage _ aMsg -> aMessageType aMsg
AgentServiceRequest {} -> AM_SRV_REQ
AgentServiceResponse {} -> AM_SRV_RESP
AgentRejection {} -> AM_RJCT
data APrivHeader = APrivHeader
{ -- | sequential ID assigned by the sending agent
@@ -1131,11 +1196,13 @@ instance Encoding AMessageReceipt where
instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where
strEncode = \case
CRInvitationUri crData e2eParams -> crEncode "invitation" crData (Just e2eParams)
CRContactUri crData -> crEncode "contact" crData Nothing
CRInvitationUri crData e2eParams -> crEncode "invitation" crData (Just e2eParams, Nothing)
CRContactUri crData rks -> crEncode "contact" crData $ case rks of
Just (ratchetKeyId, e2eRcvParams) -> (Just e2eRcvParams, Just ratchetKeyId)
Nothing -> (Nothing, Nothing)
where
crEncode :: ByteString -> ConnReqUriData -> Maybe (RcvE2ERatchetParamsUri 'C.X448) -> ByteString
crEncode crMode ConnReqUriData {crScheme, crAgentVRange, crSmpQueues, crClientData} e2eParams =
crEncode :: ByteString -> ConnReqUriData -> (Maybe (RcvE2ERatchetParamsUri 'C.X448), Maybe RatchetKeyId) -> ByteString
crEncode crMode ConnReqUriData {crScheme, crAgentVRange, crSmpQueues, crClientData} (e2eParams, rk) =
strEncode crScheme <> "/" <> crMode <> "#/?" <> queryStr
where
queryStr =
@@ -1143,23 +1210,24 @@ instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where
-- semicolon is used to separate SMP queues because comma is used to separate server address hostnames
[("v", strEncode crAgentVRange), ("smp", B.intercalate ";" $ map strEncode $ L.toList crSmpQueues)]
<> maybe [] (\e2e -> [("e2e", strEncode e2e)]) e2eParams
<> maybe [] (\k -> [("rk", strEncode k)]) rk
<> maybe [] (\cd -> [("data", encodeUtf8 cd)]) crClientData
strP = connReqUriP' (Just SSSimplex)
instance ConnectionModeI m => Encoding (ConnectionRequestUri m) where
instance ConnectionModeI m => Encoding (BinaryConnectionRequestUri m) where
smpEncode = \case
CRInvitationUri crData e2eParams -> smpEncode (CMInvitation, crData, e2eParams)
CRContactUri crData -> smpEncode (CMContact, crData)
smpP = (\(ACR _ cr) -> checkConnMode cr) <$?> smpP
BCRInvitationUri crData e2eParams -> smpEncode (CMInvitation, crData, e2eParams)
BCRContactUri crData -> smpEncode (CMContact, crData)
smpP = (\(ABCR _ cr) -> checkConnMode cr) <$?> smpP
{-# INLINE smpP #-}
instance Encoding AConnectionRequestUri where
smpEncode (ACR _ cr) = smpEncode cr
instance Encoding ABinaryConnectionRequestUri where
smpEncode (ABCR _ cr) = smpEncode cr
{-# INLINE smpEncode #-}
smpP =
smpP >>= \case
CMInvitation -> ACR SCMInvitation <$> (CRInvitationUri <$> smpP <*> smpP)
CMContact -> ACR SCMContact . CRContactUri <$> smpP
CMInvitation -> ABCR SCMInvitation <$> (BCRInvitationUri <$> smpP <*> smpP)
CMContact -> ABCR SCMContact . BCRContactUri <$> smpP
instance Encoding ConnReqUriData where
smpEncode ConnReqUriData {crAgentVRange, crSmpQueues, crClientData} =
@@ -1202,7 +1270,10 @@ connReqUriP overrideScheme = do
pure . ACR SCMInvitation $ CRInvitationUri crData crE2eParams
-- contact links are adjusted to the minimum version supported by the agent
-- to preserve compatibility with the old links published online
CMContact -> pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange}
CMContact -> do
e2e_ <- queryParam_ "e2e" query
rk_ <- queryParam_ "rk" query
pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange} ((,) <$> rk_ <*> e2e_)
where
crModeP = "invitation" $> CMInvitation <|> "contact" $> CMContact
-- semicolon is used to separate SMP queues because comma is used to separate server address hostnames
@@ -1328,6 +1399,7 @@ sameQueue addr q = sameQAddress addr (qAddress q)
data SMPQueueInfo = SMPQueueInfo {clientVersion :: VersionSMPC, queueAddress :: SMPQueueAddress}
deriving (Eq, Show)
deriving (ToJSON, FromJSON) via (StrJSON "SMPQueueInfo" SMPQueueInfo)
instance Encoding SMPQueueInfo where
smpEncode (SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode})
@@ -1433,6 +1505,10 @@ instance StrEncoding SMPQueueUri where
_ -> Nothing
pure (vr, maybe [] thList_ hs_, dhKey, queueMode)
instance StrEncoding SMPQueueInfo where
strEncode (SMPQueueInfo v addr) = strEncode (SMPQueueUri (versionToRange v) addr)
strP = (\(SMPQueueUri vr addr) -> SMPQueueInfo (maxVersion vr) addr) <$> strP
instance Encoding SMPQueueUri where
smpEncode (SMPQueueUri clientVRange@(VersionRange minV maxV) SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode})
-- The condition is for minVersion as earlier clients won't be able to support it.
@@ -1452,16 +1528,30 @@ instance Encoding SMPQueueUri where
queueModeP :: Parser (Maybe QueueMode)
queueModeP = Just <$> smpP <|> optional ((\case True -> QMMessaging; _ -> QMContact) <$> smpP)
data BinaryConnectionRequestUri (m :: ConnectionMode) where
BCRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> BinaryConnectionRequestUri CMInvitation
BCRContactUri :: ConnReqUriData -> BinaryConnectionRequestUri CMContact
deriving instance Eq (BinaryConnectionRequestUri m)
deriving instance Show (BinaryConnectionRequestUri m)
data ABinaryConnectionRequestUri = forall m. ConnectionModeI m => ABCR (SConnectionMode m) (BinaryConnectionRequestUri m)
data ConnectionRequestUri (m :: ConnectionMode) where
CRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> ConnectionRequestUri CMInvitation
-- contact connection request does NOT contain E2E encryption parameters for double ratchet -
-- they are passed in AgentInvitation message
CRContactUri :: ConnReqUriData -> ConnectionRequestUri CMContact
-- optional contact address DR keys for double ratchet e2e from message 1
CRContactUri :: ConnReqUriData -> Maybe AddressRatchetKeys -> ConnectionRequestUri CMContact
simplexConnReqUri :: ConnectionRequestUri m -> ConnectionRequestUri m
simplexConnReqUri = \case
CRInvitationUri crData e2eParams -> CRInvitationUri crData {crScheme = SSSimplex} e2eParams
CRContactUri crData -> CRContactUri crData {crScheme = SSSimplex}
CRContactUri crData rk -> CRContactUri crData {crScheme = SSSimplex} rk
binaryConnReq :: ConnectionRequestUri m -> BinaryConnectionRequestUri m
binaryConnReq = \case
CRInvitationUri crData e2eParams -> BCRInvitationUri crData e2eParams
CRContactUri crData _ -> BCRContactUri crData
deriving instance Eq (ConnectionRequestUri m)
@@ -1519,9 +1609,12 @@ data PreparedLinkParams = PreparedLinkParams
-- | smpEncode of FixedLinkData (includes linkEntityId)
plpSignedFixedData :: ByteString,
-- | Server with basic auth (not stored in link)
plpSrvWithAuth :: SMPServerWithAuth
plpSrvWithAuth :: SMPServerWithAuth,
-- | Initial PQ keys
plpInitKeys :: InitialKeys,
-- | Contact address double ratchet keys
plpAddressKeys :: Maybe (RatchetKeyId, RcvE2EPrivRatchetParams 'C.X448)
}
deriving (Show)
instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode
@@ -1733,7 +1826,7 @@ findPresetServer ProtocolServer {host = h :| _} = find (\ProtocolServer {host =
{-# INLINE findPresetServer #-}
sameConnReqContact :: ConnectionRequestUri 'CMContact -> ConnectionRequestUri 'CMContact -> Bool
sameConnReqContact (CRContactUri ConnReqUriData {crSmpQueues = qs}) (CRContactUri ConnReqUriData {crSmpQueues = qs'}) =
sameConnReqContact (CRContactUri ConnReqUriData {crSmpQueues = qs} _) (CRContactUri ConnReqUriData {crSmpQueues = qs'} _) =
L.length qs == L.length qs' && all same (L.zip qs qs')
where
same (q, q') = sameQAddress (qAddress q) (qAddress q')
@@ -1772,7 +1865,7 @@ type CRClientData = Text
data FixedLinkData c = FixedLinkData
{ agentVRange :: VersionRangeSMPA,
rootKey :: C.PublicKeyEd25519,
linkConnReq :: ConnectionRequestUri c,
linkConnReq :: BinaryConnectionRequestUri c,
linkEntityId :: Maybe ByteString
}
deriving (Eq, Show)
@@ -1785,6 +1878,31 @@ deriving instance Eq (ConnLinkData c)
deriving instance Show (ConnLinkData c)
newtype RatchetKeyId = RatchetKeyId ByteString
deriving (Eq, Show)
deriving newtype (Encoding, StrEncoding)
-- | double ratchet keys in contact address
type AddressRatchetKeys = (RatchetKeyId, RcvE2ERatchetParamsUri 'C.X448)
-- | Whether to rotate double ratchet keys in contact address
type NewRatchetKeys = Bool
-- | stored invitation with double ratchet keys
data DRInvitation = DRInvitation
{ ratchetState :: RatchetX448,
replyQueue :: SMPQueueInfo,
agentVersion :: VersionSMPA,
pqSupport :: PQSupport
}
deriving (Show)
data JoinRequest
= JRConnReq {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport}
| JRServiceReq {contactReq :: ConnectionRequestUri 'CMContact, joinPQSupport :: PQSupport, requestKey :: Maybe (C.StoredPrivateKey C.Ed25519)}
| JRInvitationDR DRInvitation
deriving (Show)
data UserContactData = UserContactData
{ -- direct connection via connReq in fixed data is allowed.
direct :: Bool,
@@ -1792,7 +1910,8 @@ data UserContactData = UserContactData
owners :: [OwnerAuth],
-- alternative addresses of chat relays that receive requests for this contact address.
relays :: [ConnShortLink 'CMContact],
userData :: UserLinkData
userData :: UserLinkData,
ratchetKeys :: Maybe AddressRatchetKeys
}
deriving (Eq, Show)
@@ -1870,10 +1989,12 @@ validateLinkOwners rootKey = go []
instance ConnectionModeI c => Encoding (FixedLinkData c) where
smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} =
-- TODO this encoding is not extensible, replace with smpEncode (fromMaybe "" linkEntityId) - safe to do it in 2027
smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId
smpP = do
(agentVRange, rootKey, linkConnReq) <- smpP
linkEntityId <- optional smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
linkEntityId <- ((\s -> if B.null s then Nothing else Just s) =<<) <$> optional smpP
_ <- A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding (added in January 2026)
pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId}
instance ConnectionModeI c => Encoding (ConnLinkData c) where
@@ -1920,14 +2041,13 @@ instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where
{-# INLINE strP #-}
instance Encoding UserContactData where
smpEncode UserContactData {direct, owners, relays, userData} =
B.concat [smpEncode direct, smpEncodeList owners, smpEncodeList relays, smpEncode userData]
smpEncode UserContactData {direct, owners, relays, userData, ratchetKeys} =
smpEncode (direct, EncList owners, EncList relays, userData, ratchetKeys)
smpP = do
direct <- smpP
owners <- smpListP
relays <- smpListP
userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
pure UserContactData {direct, owners, relays, userData}
(direct, EncList owners, EncList relays, userData) <- smpP
ratchetKeys <- smpP <|> pure Nothing
_ <- A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
pure UserContactData {direct, owners, relays, userData, ratchetKeys}
instance Encoding UserLinkData where
smpEncode (UserLinkData s) = if B.length s <= 254 then smpEncode s else smpEncode ('\255', Large s)
@@ -2090,8 +2210,17 @@ data SMPAgentError
A_DUPLICATE {droppedMsg_ :: Maybe DroppedMsg}
| -- | error in the message to add/delete/etc queue in connection
A_QUEUE {queueErr :: String}
| A_SERVICE {serviceError :: AgentServiceError}
deriving (Eq, Show, Exception)
data AgentServiceError
= ASERejected {rejectReason :: Text}
| ASETimeout
| ASENoPendingRequest
| ASENotDRAddress
| ASEBadSignature
deriving (Eq, Show)
data AgentCryptoError
= -- | AES decryption error
DECRYPT_AES
@@ -2116,6 +2245,19 @@ cryptoErrToSyncState = \case
RATCHET_SKIPPED _ -> RSRequired
RATCHET_SYNC -> RSRequired
$(J.deriveJSON defaultJSON ''DRInvitation)
-- JRConnReq is identical to JOIN before DR support for old/new client compatibility
instance StrEncoding JoinRequest where
strEncode = \case
JRConnReq ntfs cReq pqSup -> strEncode (ntfs, cReq, pqSup)
JRServiceReq cReq pqSup signKey -> strEncode ('S', cReq, pqSup, signKey)
JRInvitationDR dr -> serializeBinary $ LB.toStrict (J'.encode dr)
strP =
(A.char 'S' *> (JRServiceReq <$> _strP <*> _strP <*> _strP))
<|> (JRConnReq <$> strP <*> _strP <*> (_strP <|> pure PQSupportOff))
<|> (JRInvitationDR <$> (J'.eitherDecodeStrict' <$?> (A.take =<< (A.decimal <* "\n"))))
-- | SMP agent command and response parser for commands stored in db (fully parses binary bodies)
dbCommandP :: Parser ACommand
dbCommandP = commandP $ A.take =<< (A.decimal <* "\n")
@@ -2146,10 +2288,11 @@ commandP :: Parser ByteString -> Parser ACommand
commandP binaryP =
strP
>>= \case
NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe))
-- useDR is a trailing field defaulting to False, so NEW persisted before it was added still parses
NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe) <*> (_strP <|> pure False))
LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP))
LGET_ -> s (LGET <$> strP)
JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP)
JOIN_ -> s (JOIN <$> strP_ <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP)
LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP)
ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP))
SWCH_ -> pure SWCH
@@ -2159,16 +2302,14 @@ commandP binaryP =
s p = A.space *> p
pqIKP :: Parser InitialKeys
pqIKP = strP_ <|> pure (IKLinkPQ PQSupportOff)
pqSupP :: Parser PQSupport
pqSupP = strP_ <|> pure PQSupportOff
-- | Serialize SMP agent command.
serializeCommand :: ACommand -> ByteString
serializeCommand = \case
NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode)
NEW ntfs cMode pqIK subMode useDR -> s (NEW_, ntfs, cMode, pqIK, subMode, useDR)
LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_
LGET sl -> s (LGET_, sl)
JOIN ntfs cReq pqSup subMode cInfo -> s (JOIN_, ntfs, cReq, pqSup, subMode, Str $ serializeBinary cInfo)
JOIN joinReq subMode cInfo -> s (JOIN_, joinReq, subMode, Str $ serializeBinary cInfo)
LET confId cInfo -> B.unwords [s LET_, confId, serializeBinary cInfo]
ACK mId rcptInfo_ -> s (ACK_, mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_
SWCH -> s SWCH_
@@ -2200,6 +2341,8 @@ $(J.deriveJSON (sumTypeJSON id) ''ConnectionErrorType)
$(J.deriveJSON (sumTypeJSON id) ''AgentCryptoError)
$(J.deriveJSON (sumTypeJSON $ dropPrefix "ASE") ''AgentServiceError)
$(J.deriveJSON defaultJSON ''DroppedMsg)
$(J.deriveJSON (sumTypeJSON id) ''SMPAgentError)