7.0.0.6

Service subscription counters (totalServiceSubs, serviceSubsCount,
ntfServiceSubsCount) are TVar (Int64, IdsHash). modifyTVar' only forces
the pair to WHNF, so `n +/- n'` and `idsHash <> idsHash'` stay
unevaluated and accumulate an unbounded thunk chain under subscription
and delivery churn (the IdsHash chain also retains a bytestring per
update) - a space leak proportional to the number of updates.

Force both components in addServiceSubs/subtractServiceSubs. Verified
with the load bench: svc churn drops from +5.4 KiB/iter (linear) to flat.

simplexmq.cabal

@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name:           simplexmq
-version:        7.0.0.3
+version:        7.0.0.6
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

src/Simplex/Messaging/Agent.hs

@@ -49,6 +49,7 @@ module Simplex.Messaging.Agent
     deleteUser,
     setUserService,
     connRequestPQSupport,
+    prepareConnectionToCreate,
     createConnectionAsync,
     setConnShortLinkAsync,
     getConnShortLinkAsync,
@@ -358,9 +359,14 @@ setUserService :: AgentClient -> UserId -> Bool -> AE ()
 setUserService c = withAgentEnv c .: setUserService' c
 {-# INLINE setUserService #-}
 
--- | Create SMP agent connection (NEW command) asynchronously, synchronous response is new connection id
-createConnectionAsync :: ConnectionModeI c => AgentClient -> UserId -> ACorrId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AE ConnId
-createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAsync c userId aCorrId enableNtfs
+-- | Create SMP agent connection without queue (to be used with createConnectionAsync).
+prepareConnectionToCreate :: AgentClient -> UserId -> Bool -> SConnectionMode c -> PQSupport -> AE ConnId
+prepareConnectionToCreate c userId enableNtfs = withAgentEnv c .: newConnNoQueues c userId enableNtfs
+{-# INLINE prepareConnectionToCreate #-}
+
+-- | Enqueue NEW command for a prepared connection.
+createConnectionAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AE ()
+createConnectionAsync c aCorrId connId enableNtfs = withAgentEnv c .:. newConnAsync c aCorrId connId enableNtfs
 {-# INLINE createConnectionAsync #-}
 
 -- | Create or update user's contact connection short link (LSET command) asynchronously, no synchronous response
@@ -373,10 +379,9 @@ getConnShortLinkAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Con
 getConnShortLinkAsync c = withAgentEnv c .:: getConnShortLinkAsync' c
 {-# INLINE getConnShortLinkAsync #-}
 
--- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id.
--- If connId is provided (for contact URIs), it updates the existing connection record created by getConnShortLinkAsync.
-joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
-joinConnectionAsync c userId aCorrId connId_ enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId connId_ enableNtfs
+-- | Enqueue JOIN command for a prepared connection.
+joinConnectionAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ()
+joinConnectionAsync c aCorrId updateConn connId enableNtfs = withAgentEnv c .:: joinConnAsync c aCorrId updateConn connId enableNtfs
 {-# INLINE joinConnectionAsync #-}
 
 -- | Allow connection to continue after CONF notification (LET command), no synchronous response
@@ -384,9 +389,9 @@ allowConnectionAsync :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> Co
 allowConnectionAsync c = withAgentEnv c .:: allowConnectionAsync' c
 {-# INLINE allowConnectionAsync #-}
 
--- | Accept contact after REQ notification (ACPT command) asynchronously, synchronous response is new connection id
-acceptContactAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
-acceptContactAsync c userId aCorrId enableNtfs = withAgentEnv c .:: acceptContactAsync' c userId aCorrId enableNtfs
+-- | Accept contact after REQ notification (ACPT command) asynchronously, for a prepared connection.
+acceptContactAsync :: AgentClient -> ACorrId -> ConnId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ()
+acceptContactAsync c aCorrId connId enableNtfs = withAgentEnv c .:: acceptContactAsync' c aCorrId connId enableNtfs
 {-# INLINE acceptContactAsync #-}
 
 -- | Acknowledge message (ACK command) asynchronously, no synchronous response
@@ -418,8 +423,9 @@ createConnection c nm userId enableNtfs checkNotices = withAgentEnv c .::. newCo
 -- Caller provides root signing key pair and link entity ID.
 -- Returns the created link and internal params.
 -- The link address is fully determined at this point.
-prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> AE (CreatedConnLink 'CMContact, PreparedLinkParams)
-prepareConnectionLink c userId rootKey linkEntityId checkNotices = withAgentEnv c . prepareConnectionLink' c userId rootKey linkEntityId checkNotices
+prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams)
+prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData srv_ =
+  withAgentEnv c $ prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData srv_
 {-# INLINE prepareConnectionLink #-}
 
 -- | Create connection for prepared link (single network call).
@@ -445,7 +451,7 @@ getConnShortLink c = withAgentEnv c .:. getConnShortLink' c
 -- | Resolve a SimpleX name (PFWD RSLV). The agent owns server selection: it
 -- picks a names-capable server (ServerRoles.names) from the user's nameSrvs, so
 -- chat clients just pass the parsed domain.
-resolveSimplexName :: AgentClient -> NetworkRequestMode -> UserId -> SimplexNameDomain -> AE NameRecord
+resolveSimplexName :: AgentClient -> NetworkRequestMode -> UserId -> SimplexDomain -> AE NameRecord
 resolveSimplexName c nm userId domain = withAgentEnv c $ resolveSimplexName' c nm userId domain
 {-# INLINE resolveSimplexName #-}
 
@@ -846,11 +852,10 @@ setUserService' c userId enable = do
   unless ok $ throwE $ CMD PROHIBITED "setUserService"
   when (changed && not enable) $ withStore' c (`deleteClientServices` userId)
 
-newConnAsync :: ConnectionModeI c => AgentClient -> UserId -> ACorrId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AM ConnId
-newConnAsync c userId corrId enableNtfs cMode pqInitKeys subMode = do
-  connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys)
+newConnAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AM ()
+newConnAsync c corrId connId enableNtfs cMode pqInitKeys subMode =
   enqueueCommand c corrId connId Nothing $ AClientCommand $ NEW enableNtfs (ACM cMode) pqInitKeys subMode
-  pure connId
+{-# INLINE newConnAsync #-}
 
 newConnNoQueues :: AgentClient -> UserId -> Bool -> SConnectionMode c -> PQSupport -> AM ConnId
 newConnNoQueues c userId enableNtfs cMode pqSupport = do
@@ -861,34 +866,21 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do
 
 -- TODO [short links] TBC, but probably we will need async join for contact addresses as the contact will be created after user confirming the connection,
 -- and join should retry, the same as 1-time invitation joins.
-joinConnAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
-joinConnAsync c userId corrId connId_ enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
-  when (isJust connId_) $ throwE $ CMD PROHIBITED "joinConnAsync: connId not allowed for invitation URI"
-  withInvLock c (strEncode cReqUri) "joinConnAsync" $ do
+joinConnAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ()
+joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
+  when updateConn $ throwE $ CMD PROHIBITED "joinConnAsync: updateConn not allowed for invitation URI"
+  withInvLock c (strEncode cReqUri) "joinConnAsync" $
     lift (compatibleInvitationUri cReqUri) >>= \case
       Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
-        g <- asks random
         let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v)
-            cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
-        connId <- withStore c $ \db -> createNewConn db g cData SCMInvitation
         enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
-        pure connId
       Nothing -> throwE $ AGENT A_VERSION
-joinConnAsync c userId corrId connId_ enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode = do
+joinConnAsync c corrId updateConn connId enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode =
   lift (compatibleContactUri cReqUri) >>= \case
     Just (_, Compatible connAgentVersion) -> do
       let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing
-      connId <- case connId_ of
-        Just cId -> do
-          -- update connection record created by getConnShortLinkAsync
-          withStore' c $ \db -> updateNewConnJoin db cId connAgentVersion pqSupport enableNtfs
-          pure cId
-        Nothing -> do
-          g <- asks random
-          let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
-          withStore c $ \db -> createNewConn db g cData SCMInvitation
+      when updateConn $ withStore' c $ \db -> updateNewConnJoin db connId connAgentVersion pqSupport enableNtfs
       enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
-      pure connId
     Nothing -> throwE $ AGENT A_VERSION
 
 allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
@@ -904,11 +896,11 @@ allowConnectionAsync' c corrId connId confId ownConnInfo =
 -- and also it can't be triggered by user concurrently several times in a row. It could be improved similarly to
 -- `acceptContact` by creating a new map for invitation locks and taking lock here, and removing `unacceptInvitation`
 -- while marking invitation as accepted inside "lock level transaction" after successful `joinConnAsync`.
-acceptContactAsync' :: AgentClient -> UserId -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
-acceptContactAsync' c userId corrId enableNtfs invId ownConnInfo pqSupport subMode = do
+acceptContactAsync' :: AgentClient -> ACorrId -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ()
+acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMode = do
   Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId
   withStore' c $ \db -> acceptInvitation db invId ownConnInfo
-  joinConnAsync c userId corrId Nothing enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do
+  joinConnAsync c corrId False connId enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do
     withStore' c (`unacceptInvitation` invId)
     throwE err
 
@@ -974,10 +966,10 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey
 
 -- | Prepare connection link for contact mode (no network, no database).
 -- Caller provides root signing key pair and link entity ID.
-prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> AM (CreatedConnLink 'CMContact, PreparedLinkParams)
-prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData = do
+prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams)
+prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData srv_ = do
   g <- asks random
-  plpSrvWithAuth@(ProtoServerWithAuth srv _) <- getSMPServer c userId
+  plpSrvWithAuth@(ProtoServerWithAuth srv _) <- maybe (getSMPServer c userId) pure srv_
   when checkNotices $ checkClientNotices c plpSrvWithAuth
   AgentConfig {smpClientVRange, smpAgentVRange} <- asks config
   plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
@@ -1191,7 +1183,7 @@ getConnShortLink' c nm userId = \case
 deleteLocalInvShortLink' :: AgentClient -> ConnShortLink 'CMInvitation -> AM ()
 deleteLocalInvShortLink' c (CSLInvitation _ srv linkId _) = withStore' c $ \db -> deleteInvShortLink db srv linkId
 
-resolveSimplexName' :: AgentClient -> NetworkRequestMode -> UserId -> SimplexNameDomain -> AM NameRecord
+resolveSimplexName' :: AgentClient -> NetworkRequestMode -> UserId -> SimplexDomain -> AM NameRecord
 resolveSimplexName' c nm userId domain = do
   resolverSrv <- getNextNameServer c userId
   resolveName c nm userId resolverSrv domain
@@ -1233,8 +1225,8 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
         SCMInvitation -> do
           g <- asks random
           let pqEnc = CR.initialPQEncryption (isJust userLinkData_) pqInitKeys
-          (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc
-          withStore' c $ \db -> createRatchetX3dhKeys db connId pk1 pk2 pKem
+          (pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc
+          withStore' c $ \db -> createRatchetX3dhKeys db connId pks
           pure $ CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange
     prepareLinkData :: UserConnLinkData c -> C.PublicKeyX25519 -> AM (C.CbNonce, SMPQueueUri, ConnectionRequestUri c, ClntQueueReqData)
     prepareLinkData userLinkData e2eDhKey = do
@@ -1355,9 +1347,9 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
     Nothing -> throwE $ AGENT A_VERSION
   where
     createRatchet_ db g maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do
-      (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport)
+      (pks, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport)
       (_, rcDHRs) <- atomically $ C.generateKeyPair g
-      rcParams <- liftEitherWith (SEAgentError . cryptoError) $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams
+      rcParams <- liftEitherWith (SEAgentError . cryptoError) $ CR.pqX3dhSnd pks e2eRcvParams
       let rcVs = CR.RatchetVersions {current = v, maxSupported}
           rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams
       liftIO $ createSndRatchet db connId rc e2eSndParams
@@ -1434,8 +1426,8 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup su
               Left e -> do
                 nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no rcv ratchet " <> show e))
                 let pqEnc = CR.initialPQEncryption False pqInitKeys
-                (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqEnc
-                createRatchetX3dhKeys db connId pk1 pk2 pKem
+                (pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqEnc
+                createRatchetX3dhKeys db connId pks
                 pure e2eRcvParams
           let cReq = CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eVR
           pure $ CCLink cReq Nothing
@@ -2483,11 +2475,11 @@ synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchroni
           let cData' = cData {pqSupport = pqSupport'} :: ConnData
           AgentConfig {e2eEncryptVRange} <- asks config
           g <- asks random
-          (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqSupport'
+          (pks, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqSupport'
           enqueueRatchetKeyMsgs c sqs e2eParams
           withStore' c $ \db -> do
             setConnRatchetSync db connId RSStarted
-            setRatchetX3dhKeys db connId pk1 pk2 pKem
+            setRatchetX3dhKeys db connId pks
           let cData'' = cData' {ratchetSyncState = RSStarted} :: ConnData
               conn' = DuplexConnection cData'' rqs sqs
           connectionStats c conn'
@@ -3418,8 +3410,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                 -- party initiating connection
                 (RcvConnection _ _, Just (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _))) -> do
                   unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION)
-                  (pk1, rcDHRs, pKem) <- withStore c (`getRatchetX3dhKeys` connId)
-                  rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 rcDHRs pKem e2eSndParams
+                  pks@(_, rcDHRs, _) <- withStore c (`getRatchetX3dhKeys` connId)
+                  rcParams <- liftError cryptoError $ CR.pqX3dhRcv pks e2eSndParams
                   let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange}
                       pqSupport' = pqSupport `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion)
                       rc = CR.initRcvRatchet rcVs rcDHRs rcParams pqSupport'
@@ -3660,7 +3652,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                 exists <- checkRatchetKeyHashExists db connId rkHashRcv
                 unless exists $ addProcessedRatchetKeyHash db connId rkHashRcv
                 pure exists
-              getSendRatchetKeys :: AM (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)
+              getSendRatchetKeys :: AM (CR.RcvE2EPrivRatchetParams 'C.X448)
               getSendRatchetKeys = case rss of
                 RSOk -> sendReplyKey -- receiving client
                 RSAllowed -> sendReplyKey
@@ -3676,9 +3668,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                 where
                   sendReplyKey = do
                     g <- asks random
-                    (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g e2eVersion pqSupport
+                    (pks, e2eParams) <- liftIO $ CR.generateRcvE2EParams g e2eVersion pqSupport
                     enqueueRatchetKeyMsgs c sqs e2eParams
-                    pure (pk1, pk2, pKem)
+                    pure pks
                   notifyRatchetSyncError = do
                     let cData'' = cData' {ratchetSyncState = RSRequired} :: ConnData
                         conn'' = updateConnection cData'' conn'
@@ -3697,14 +3689,14 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                 createRatchet db connId rc
               -- compare public keys `k1` in AgentRatchetKey messages sent by self and other party
               -- to determine ratchet initilization ordering
-              initRatchet :: CR.RatchetVersions -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> AM ()
+              initRatchet :: CR.RatchetVersions -> CR.RcvE2EPrivRatchetParams 'C.X448 -> AM ()
               initRatchet rcVs (pk1, pk2, pKem)
                 | rkHash (C.publicKey pk1) (C.publicKey pk2) <= rkHashRcv = do
-                    rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eOtherPartyParams
+                    rcParams <- liftError cryptoError $ CR.pqX3dhRcv (pk1, pk2, pKem) e2eOtherPartyParams
                     recreateRatchet $ CR.initRcvRatchet rcVs pk2 rcParams pqSupport
                 | otherwise = do
                     (_, rcDHRs) <- atomically . C.generateKeyPair =<< asks random
-                    rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 (CR.APRKP CR.SRKSProposed <$> pKem) e2eOtherPartyParams
+                    rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd (pk1, pk2, CR.APRKP CR.SRKSProposed <$> pKem) e2eOtherPartyParams
                     recreateRatchet $ CR.initSndRatchet rcVs k2Rcv rcDHRs rcParams
                     void . enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} $ EREADY lastExternalSndId
 

src/Simplex/Messaging/Agent/Client.hs

@@ -1986,7 +1986,7 @@ getQueueLink c nm userId server lnkId =
 -- resolver) and falls back to a direct send when the proxy is unavailable
 -- (faster but exposes the client IP). Mode selection is delegated to
 -- `sendOrProxySMPCommand`, which honours the network config (SPMNever etc.).
-resolveName :: AgentClient -> NetworkRequestMode -> UserId -> SMPServer -> SimplexNameDomain -> AM NameRecord
+resolveName :: AgentClient -> NetworkRequestMode -> UserId -> SMPServer -> SimplexDomain -> AM NameRecord
 resolveName c nm userId server domain =
   snd <$> sendOrProxySMPCommand c nm userId server "" "RSLV" NoEntity resolveViaProxy resolveDirectly
   where

src/Simplex/Messaging/Agent/Protocol.hs

@@ -123,7 +123,7 @@ module Simplex.Messaging.Agent.Protocol
     ConnectionLink (..),
     AConnectionLink (..),
     SimplexNameInfo (..),
-    SimplexNameDomain (..),
+    SimplexDomain (..),
     SimplexTLD (..),
     SimplexNameType (..),
     ConnShortLink (..),
@@ -238,7 +238,7 @@ import Simplex.Messaging.Crypto.Ratchet
   )
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.SimplexName (SimplexNameDomain (..), SimplexNameInfo (..), SimplexNameType (..), SimplexTLD (..), fullDomainName, shortNameInfoStr)
+import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexNameInfo (..), SimplexNameType (..), SimplexTLD (..), fullDomainName, shortNameInfoStr)
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol
   ( AProtocolType,
@@ -1691,6 +1691,10 @@ ctTypeChar = \case
   CCTRelay -> 'R'
 {-# INLINE ctTypeChar #-}
 
+instance StrEncoding ContactConnType where
+  strEncode = B.singleton . ctTypeChar
+  strP = A.anyChar >>= ctTypeP
+
 -- the servers passed to this function should be all preset servers, not servers configured by the user.
 shortenShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
 shortenShortLink presetSrvs = \case

src/Simplex/Messaging/Agent/Store/AgentStore.hs

@@ -1359,11 +1359,11 @@ deleteSndMsgsExpired db ttl limit = do
     |]
     (cutoffTs, limit)
 
-createRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO ()
-createRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem =
+createRatchetX3dhKeys :: DB.Connection -> ConnId -> CR.RcvE2EPrivRatchetParams 'C.X448 -> IO ()
+createRatchetX3dhKeys db connId (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) =
   DB.execute db "INSERT INTO ratchets (conn_id, x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem) VALUES (?, ?, ?, ?)" (connId, x3dhPrivKey1, x3dhPrivKey2, pqPrivKem)
 
-getRatchetX3dhKeys :: DB.Connection -> ConnId -> IO (Either StoreError (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams))
+getRatchetX3dhKeys :: DB.Connection -> ConnId -> IO (Either StoreError (CR.RcvE2EPrivRatchetParams 'C.X448))
 getRatchetX3dhKeys db connId =
   firstRow' keys SEX3dhKeysNotFound $
     DB.query db "SELECT x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem FROM ratchets WHERE conn_id = ?" (Only connId)
@@ -1373,8 +1373,8 @@ getRatchetX3dhKeys db connId =
       _ -> Left SEX3dhKeysNotFound
 
 -- used to remember new keys when starting ratchet re-synchronization
-setRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO ()
-setRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem =
+setRatchetX3dhKeys :: DB.Connection -> ConnId -> CR.RcvE2EPrivRatchetParams 'C.X448 -> IO ()
+setRatchetX3dhKeys db connId (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) =
   DB.execute
     db
     [sql|

src/Simplex/Messaging/Client.hs

@@ -166,7 +166,7 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Protocol.Types
 import Simplex.Messaging.Server.QueueStore.QueueInfo
-import Simplex.Messaging.SimplexName (SimplexNameDomain)
+import Simplex.Messaging.SimplexName (SimplexDomain)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
@@ -1054,7 +1054,7 @@ proxySMPMessage c nm proxiedRelay spKey sId flags msg = proxyOKSMPCommand c nm p
 -- through `proxySMPCommand` and pattern-matches the expected RNAME response.
 -- Version-gated on the destination relay (mirrors `connectSMPProxiedRelay`):
 -- the client never sends RSLV to a relay that predates names support.
-proxyResolveName :: SMPClient -> NetworkRequestMode -> ProxiedRelay -> SimplexNameDomain -> ExceptT SMPClientError IO (Either ProxyClientError NameRecord)
+proxyResolveName :: SMPClient -> NetworkRequestMode -> ProxiedRelay -> SimplexDomain -> ExceptT SMPClientError IO (Either ProxyClientError NameRecord)
 proxyResolveName c nm proxiedRelay name
   | prVersion proxiedRelay >= namesSMPVersion =
       proxySMPCommand c nm proxiedRelay Nothing NoEntity (RSLV name) >>= \case
@@ -1068,7 +1068,7 @@ proxyResolveName c nm proxiedRelay name
 -- proxy fallback in the agent. RSLV requires no entity ID or authorization
 -- (see `noAuthCmd` in Protocol.hs). Version-gated on the session here, not the
 -- encoder, so an old server never receives RSLV.
-directResolveName :: SMPClient -> NetworkRequestMode -> SimplexNameDomain -> ExceptT SMPClientError IO NameRecord
+directResolveName :: SMPClient -> NetworkRequestMode -> SimplexDomain -> ExceptT SMPClientError IO NameRecord
 directResolveName c nm name
   | thVersion (thParams c) >= namesSMPVersion =
       sendProtocolCommand c nm Nothing NoEntity (Cmd SResolver (RSLV name)) >>= \case

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -45,6 +45,7 @@ module Simplex.Messaging.Crypto.Ratchet
     AE2ERatchetParams (..),
     E2ERatchetParamsUri (..),
     E2ERatchetParams (..),
+    RcvE2EPrivRatchetParams,
     VersionE2E,
     VersionRangeE2E,
     pattern VersionE2E,
@@ -403,24 +404,30 @@ instance RatchetKEMStateI s => ToField (PrivRKEMParams s) where toField = toFiel
 
 instance (Typeable s, RatchetKEMStateI s) => FromField (PrivRKEMParams s) where fromField = blobFieldDecoder smpDecode
 
+type E2EPrivRatchetParams s a = (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams s))\
+
+type RcvE2EPrivRatchetParams a = E2EPrivRatchetParams 'RKSProposed a
+
+type AE2EPrivRatchetParams a = (PrivateKey a, PrivateKey a, Maybe APrivRKEMParams)
+
 data UseKEM (s :: RatchetKEMState) where
   ProposeKEM :: UseKEM 'RKSProposed
   AcceptKEM :: KEMPublicKey -> UseKEM 'RKSAccepted
 
 data AUseKEM = forall s. RatchetKEMStateI s => AUseKEM (SRatchetKEMState s) (UseKEM s)
 
-mkRcvE2ERatchetParams :: VersionE2E -> (PrivateKey a, PrivateKey a, Maybe RcvPrivRKEMParams) -> RcvE2ERatchetParams a
+mkRcvE2ERatchetParams :: VersionE2E -> RcvE2EPrivRatchetParams a -> RcvE2ERatchetParams a
 mkRcvE2ERatchetParams v (pk1, pk2, pKem) = E2ERatchetParams v (publicKey pk1) (publicKey pk2) (mkKem <$> pKem)
   where
     mkKem :: RcvPrivRKEMParams -> RcvRKEMParams
     mkKem (PrivateRKParamsProposed (k, _)) = RKParamsProposed k
 
-generateE2EParams :: forall s a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe (UseKEM s) -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams s), E2ERatchetParams s a)
+generateE2EParams :: forall s a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe (UseKEM s) -> IO (E2EPrivRatchetParams s a, E2ERatchetParams s a)
 generateE2EParams g v useKEM_ = do
   (k1, pk1) <- atomically $ generateKeyPair g
   (k2, pk2) <- atomically $ generateKeyPair g
   kems <- kemParams
-  pure (pk1, pk2, snd <$> kems, E2ERatchetParams v k1 k2 (fst <$> kems))
+  pure ((pk1, pk2, snd <$> kems), E2ERatchetParams v k1 k2 (fst <$> kems))
   where
     kemParams :: IO (Maybe (RKEMParams s, PrivRKEMParams s))
     kemParams = case useKEM_ of
@@ -436,7 +443,7 @@ generateE2EParams g v useKEM_ = do
       _ -> pure Nothing
 
 -- used by party initiating connection, Bob in double-ratchet spec
-generateRcvE2EParams :: (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> PQSupport -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams 'RKSProposed), E2ERatchetParams 'RKSProposed a)
+generateRcvE2EParams :: (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> PQSupport -> IO (RcvE2EPrivRatchetParams a, RcvE2ERatchetParams a)
 generateRcvE2EParams g v = generateE2EParams g v . proposeKEM_
   where
     proposeKEM_ :: PQSupport -> Maybe (UseKEM 'RKSProposed)
@@ -445,14 +452,14 @@ generateRcvE2EParams g v = generateE2EParams g v . proposeKEM_
       PQSupportOff -> Nothing
 
 -- used by party accepting connection, Alice in double-ratchet spec
-generateSndE2EParams :: forall a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe AUseKEM -> IO (PrivateKey a, PrivateKey a, Maybe APrivRKEMParams, AE2ERatchetParams a)
+generateSndE2EParams :: forall a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe AUseKEM -> IO (AE2EPrivRatchetParams a, AE2ERatchetParams a)
 generateSndE2EParams g v = \case
   Nothing -> do
-    (pk1, pk2, _, e2eParams) <- generateE2EParams g v Nothing
-    pure (pk1, pk2, Nothing, AE2ERatchetParams SRKSProposed e2eParams)
+    ((pk1, pk2, _), e2eParams) <- generateE2EParams g v Nothing
+    pure ((pk1, pk2, Nothing), AE2ERatchetParams SRKSProposed e2eParams)
   Just (AUseKEM s useKEM) -> do
-    (pk1, pk2, pKem, e2eParams) <- generateE2EParams g v (Just useKEM)
-    pure (pk1, pk2, APRKP s <$> pKem, AE2ERatchetParams s e2eParams)
+    ((pk1, pk2, pKem), e2eParams) <- generateE2EParams g v (Just useKEM)
+    pure ((pk1, pk2, APRKP s <$> pKem), AE2ERatchetParams s e2eParams)
 
 data RatchetInitParams = RatchetInitParams
   { assocData :: Str,
@@ -464,9 +471,9 @@ data RatchetInitParams = RatchetInitParams
   deriving (Show)
 
 -- this is used by the peer joining the connection
-pqX3dhSnd :: DhAlgorithm a => PrivateKey a -> PrivateKey a -> Maybe APrivRKEMParams -> E2ERatchetParams 'RKSProposed a -> Either CryptoError (RatchetInitParams, Maybe KEMKeyPair)
+pqX3dhSnd :: DhAlgorithm a => AE2EPrivRatchetParams a -> E2ERatchetParams 'RKSProposed a -> Either CryptoError (RatchetInitParams, Maybe KEMKeyPair)
 --        3. replied       2. received
-pqX3dhSnd spk1 spk2 spKem_ (E2ERatchetParams v rk1 rk2 rKem_) = do
+pqX3dhSnd (spk1, spk2, spKem_) (E2ERatchetParams v rk1 rk2 rKem_) = do
   (ks_, kem_) <- sndPq
   let initParams = pqX3dh (publicKey spk1, rk1) (dh' rk1 spk2) (dh' rk2 spk1) (dh' rk2 spk2) kem_
   pure (initParams, ks_)
@@ -480,9 +487,9 @@ pqX3dhSnd spk1 spk2 spKem_ (E2ERatchetParams v rk1 rk2 rKem_) = do
       _ -> Right (Nothing, Nothing)
 
 -- this is used by the peer that created new connection, after receiving the reply
-pqX3dhRcv :: forall s a. (RatchetKEMStateI s, DhAlgorithm a) => PrivateKey a -> PrivateKey a -> Maybe (PrivRKEMParams 'RKSProposed) -> E2ERatchetParams s a -> ExceptT CryptoError IO (RatchetInitParams, Maybe KEMKeyPair)
+pqX3dhRcv :: forall s a. (RatchetKEMStateI s, DhAlgorithm a) => RcvE2EPrivRatchetParams a -> E2ERatchetParams s a -> ExceptT CryptoError IO (RatchetInitParams, Maybe KEMKeyPair)
 --        1. sent          4. received in reply
-pqX3dhRcv rpk1 rpk2 rpKem_ (E2ERatchetParams v sk1 sk2 sKem_) = do
+pqX3dhRcv (rpk1, rpk2, rpKem_) (E2ERatchetParams v sk1 sk2 sKem_) = do
   kem_ <- rcvPq
   let initParams = pqX3dh (sk1, publicKey rpk1) (dh' sk2 rpk1) (dh' sk1 rpk2) (dh' sk2 rpk2) (snd <$> kem_)
   pure (initParams, fst <$> kem_)

src/Simplex/Messaging/Protocol.hs

@@ -270,7 +270,7 @@ import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol.Types
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.ServiceScheme
-import Simplex.Messaging.SimplexName (SimplexNameDomain)
+import Simplex.Messaging.SimplexName (SimplexDomain)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts (..))
 import Simplex.Messaging.Util (bshow, eitherToMaybe, safeDecodeUtf8, (<$?>))
@@ -608,7 +608,7 @@ data Command (p :: Party) where
   -- - corrId: unique correlation ID between proxy and relay, also used as a nonce to encrypt forwarded transmission
   RFWD :: EncFwdTransmission -> Command ProxyService -- use CorrId as CbNonce, proxy to relay
   -- Resolve SimpleX name.
-  RSLV :: SimplexNameDomain -> Command Resolver
+  RSLV :: SimplexDomain -> Command Resolver
 
 deriving instance Show (Command p)
 
@@ -1546,11 +1546,14 @@ queueIdHash = IdsHash . C.md5Hash . unEntityId
 {-# INLINE queueIdHash #-}
 
 addServiceSubs :: (Int64, IdsHash) -> (Int64, IdsHash) -> (Int64, IdsHash)
-addServiceSubs (n', idsHash') (n, idsHash) = (n + n', idsHash <> idsHash')
+addServiceSubs (n', idsHash') (n, idsHash) =
+  let !n'' = n + n'
+      !h = idsHash <> idsHash'
+   in (n'', h)
 
 subtractServiceSubs :: (Int64, IdsHash) -> (Int64, IdsHash) -> (Int64, IdsHash)
 subtractServiceSubs (n', idsHash') (n, idsHash)
-  | n > n' = (n - n', idsHash <> idsHash') -- concat is a reversible xor: (x `xor` y) `xor` y == x
+  | n > n' = let !n'' = n - n'; !h = idsHash <> idsHash' in (n'', h) -- concat is a reversible xor: (x `xor` y) `xor` y == x
   | otherwise = (0, mempty)
 
 data ProtocolErrorType = PECmdSyntax | PECmdUnknown | PESession | PEBlock

src/Simplex/Messaging/Server.hs

@@ -103,7 +103,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.SimplexName (SimplexNameDomain)
+import Simplex.Messaging.SimplexName (SimplexDomain)
 import Simplex.Messaging.Server.Control
 import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
@@ -1497,7 +1497,7 @@ client
         Just nenv -> pure (Just nenv)
     -- Runs on a forked thread so RSLV does not block other commands;
     -- concurrency is limited by serverResolverConcurrency in forkCmd.
-    resolveNameMsg :: NamesEnv -> SimplexNameDomain -> M s BrokerMsg
+    resolveNameMsg :: NamesEnv -> SimplexDomain -> M s BrokerMsg
     resolveNameMsg nenv d = do
       st <- asks (rslvStats . serverStats)
       (selector, msg) <-

src/Simplex/Messaging/Server/Names.hs

@@ -30,7 +30,7 @@ import Simplex.Messaging.Server.Names.HttpResolver
     newResolverEnv,
     resolveHttp,
   )
-import Simplex.Messaging.SimplexName (SimplexNameDomain, fullDomainName)
+import Simplex.Messaging.SimplexName (SimplexDomain, fullDomainName)
 import System.Timeout (timeout)
 
 data NamesConfig = NamesConfig
@@ -58,7 +58,7 @@ pingEndpoint :: NamesEnv -> IO (Either ResolverError ())
 pingEndpoint NamesEnv {resolverEnv, config} =
   fromMaybe (Left ResolverTimeout) <$> timeout (resolverTimeoutMs config * 1000) (healthHttp resolverEnv)
 
-resolveName :: NamesEnv -> SimplexNameDomain -> IO (Either NameErrorType NameRecord)
+resolveName :: NamesEnv -> SimplexDomain -> IO (Either NameErrorType NameRecord)
 resolveName env d = do
   r <- E.try (timeout (resolverTimeoutMs (config env) * 1000) (fetch env d))
   case r of
@@ -69,7 +69,7 @@ resolveName env d = do
           logError $ "[NAMES] resolver fetch raised " <> T.pack (E.displayException e)
           pure (Left (RESOLVER "resolver error"))
 
-fetch :: NamesEnv -> SimplexNameDomain -> IO (Either NameErrorType NameRecord)
+fetch :: NamesEnv -> SimplexDomain -> IO (Either NameErrorType NameRecord)
 fetch NamesEnv {resolverEnv} d =
   first mapResolverError <$> resolveHttp resolverEnv (fullDomainName d)
 

src/Simplex/Messaging/SimplexName.hs

@@ -6,7 +6,7 @@
 
 module Simplex.Messaging.SimplexName
   ( SimplexNameInfo (..),
-    SimplexNameDomain (..),
+    SimplexDomain (..),
     SimplexTLD (..),
     SimplexNameType (..),
     fullDomainName,
@@ -33,11 +33,11 @@ import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
 
 data SimplexNameInfo = SimplexNameInfo
   { nameType :: SimplexNameType,
-    nameDomain :: SimplexNameDomain
+    nameDomain :: SimplexDomain
   }
   deriving (Eq, Show)
 
-data SimplexNameDomain = SimplexNameDomain
+data SimplexDomain = SimplexDomain
   { nameTLD :: SimplexTLD,
     domain :: Text,
     subDomain :: [Text] -- parent to child: ["b", "a"] for a.b.domain.simplex
@@ -87,9 +87,9 @@ instance StrEncoding SimplexNameInfo where
       infoP NTPublicGroup = SimplexNameInfo NTPublicGroup <$> (strP <|> bareName)
       infoP NTContact = SimplexNameInfo NTContact <$> strP
       bareName = parseBare . safeDecodeUtf8 <$?> boundedNonSpace
-      parseBare s = (\name -> SimplexNameDomain TLDSimplex (T.toLower name) []) <$> AT.parseOnly (nameLabelP <* AT.endOfInput) s
+      parseBare s = (\name -> SimplexDomain TLDSimplex (T.toLower name) []) <$> AT.parseOnly (nameLabelP <* AT.endOfInput) s
 
-instance StrEncoding SimplexNameDomain where
+instance StrEncoding SimplexDomain where
   strEncode = encodeUtf8 . fullDomainName
   strP = parseDomain . safeDecodeUtf8 <$?> boundedNonSpace
     where
@@ -97,18 +97,18 @@ instance StrEncoding SimplexNameDomain where
       mkDomain labels = case reverse lowered of
         [] -> Left "empty name"
         [_] -> Left "domain requires TLD"
-        "simplex" : name : sub -> Right (SimplexNameDomain TLDSimplex name sub)
-        "testing" : name : sub -> Right (SimplexNameDomain TLDTesting name sub)
-        _ -> Right (SimplexNameDomain TLDWeb (T.intercalate "." lowered) [])
+        "simplex" : name : sub -> Right (SimplexDomain TLDSimplex name sub)
+        "testing" : name : sub -> Right (SimplexDomain TLDTesting name sub)
+        _ -> Right (SimplexDomain TLDWeb (T.intercalate "." lowered) [])
         where
           lowered = map T.toLower labels
 
-instance Encoding SimplexNameDomain where
+instance Encoding SimplexDomain where
   smpEncode = strEncode
   smpP = strP
 
-fullDomainName :: SimplexNameDomain -> Text
-fullDomainName SimplexNameDomain {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain ++ [domain] ++ tld')
+fullDomainName :: SimplexDomain -> Text
+fullDomainName SimplexDomain {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain ++ [domain] ++ tld')
   where
     tld' = case nameTLD of
       TLDSimplex -> ["simplex"]
@@ -117,21 +117,21 @@ fullDomainName SimplexNameDomain {nameTLD, domain, subDomain} = T.intercalate ".
 
 shortNameInfoStr :: SimplexNameInfo -> Text
 shortNameInfoStr = \case
-  SimplexNameInfo {nameType = NTPublicGroup, nameDomain = SimplexNameDomain {nameTLD = TLDSimplex, domain, subDomain = []}} -> "#" <> domain
+  SimplexNameInfo {nameType = NTPublicGroup, nameDomain = SimplexDomain {nameTLD = TLDSimplex, domain, subDomain = []}} -> "#" <> domain
   info -> pfx <> fullDomainName (nameDomain info)
     where
       pfx = case nameType info of
         NTPublicGroup -> "#"
         NTContact -> "@"
 
-instance ToField SimplexNameInfo where toField = toField . decodeLatin1 . strEncode
+instance ToField SimplexDomain where toField = toField . decodeLatin1 . strEncode
 
-instance FromField SimplexNameInfo where fromField = fromTextField_ (eitherToMaybe . strDecode . encodeUtf8)
+instance FromField SimplexDomain where fromField = fromTextField_ (eitherToMaybe . strDecode . encodeUtf8)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "TLD") ''SimplexTLD)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "NT") ''SimplexNameType)
 
-$(J.deriveJSON defaultJSON ''SimplexNameDomain)
+$(J.deriveJSON defaultJSON ''SimplexDomain)
 
 $(J.deriveJSON defaultJSON ''SimplexNameInfo)

tests/AgentTests/DoubleRatchetTests.hs

@@ -381,19 +381,19 @@ testX3dh :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
 testX3dh _ = do
   g <- C.newRandom
   let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
-  (pkBob1, pkBob2, Nothing, AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v Nothing
-  (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff
-  let paramsBob = pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
-  paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
+  (pksBob@(_, _, Nothing), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v Nothing
+  (pksAlice@(_, _, Nothing), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff
+  let paramsBob = pqX3dhSnd pksBob e2eAlice
+  paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
   paramsAlice `shouldBe` paramsBob
 
 testX3dhV1 :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
 testX3dhV1 _ = do
   g <- C.newRandom
-  (pkBob1, pkBob2, Nothing, AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g (VersionE2E 1) Nothing
-  (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g (VersionE2E 1) PQSupportOff
-  let paramsBob = pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
-  paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
+  (pksBob@(_, _, Nothing), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g (VersionE2E 1) Nothing
+  (pksAlice@(_, _, Nothing), e2eAlice) <- liftIO $ generateRcvE2EParams @a g (VersionE2E 1) PQSupportOff
+  let paramsBob = pqX3dhSnd pksBob e2eAlice
+  paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
   paramsAlice `shouldBe` paramsBob
 
 testPqX3dhProposeInReply :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
@@ -401,11 +401,11 @@ testPqX3dhProposeInReply _ = do
   g <- C.newRandom
   let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
   -- initiate (no KEM)
-  (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff
+  (pksAlice@(_, _, Nothing), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff
   -- propose KEM in reply
-  (pkBob1, pkBob2, pKemBob_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSProposed ProposeKEM)
-  Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemBob_ e2eAlice
-  Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
+  (pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSProposed ProposeKEM)
+  Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
+  Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
   paramsAlice `compatibleRatchets` paramsBob
 
 testPqX3dhProposeAccept :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
@@ -413,12 +413,12 @@ testPqX3dhProposeAccept _ = do
   g <- C.newRandom
   let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
   -- initiate (propose KEM)
-  (pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
+  (pksAlice@(_, _, Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
   E2ERatchetParams _ _ _ (Just (RKParamsProposed aliceKem)) <- pure e2eAlice
   -- accept KEM
-  (pkBob1, pkBob2, pKemBob_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSAccepted $ AcceptKEM aliceKem)
-  Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemBob_ e2eAlice
-  Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKemAlice_ e2eBob
+  (pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSAccepted $ AcceptKEM aliceKem)
+  Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
+  Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
   paramsAlice `compatibleRatchets` paramsBob
 
 testPqX3dhProposeReject :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
@@ -426,12 +426,12 @@ testPqX3dhProposeReject _ = do
   g <- C.newRandom
   let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
   -- initiate (propose KEM)
-  (pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
+  (pksAlice@(_, _, Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
   E2ERatchetParams _ _ _ (Just (RKParamsProposed _)) <- pure e2eAlice
   -- reject KEM
-  (pkBob1, pkBob2, Nothing, AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v Nothing
-  Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
-  Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKemAlice_ e2eBob
+  (pksBob@(_, _, Nothing), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v Nothing
+  Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
+  Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
   paramsAlice `compatibleRatchets` paramsBob
 
 testPqX3dhAcceptWithoutProposalError :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
@@ -439,26 +439,26 @@ testPqX3dhAcceptWithoutProposalError _ = do
   g <- C.newRandom
   let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
   -- initiate (no KEM)
-  (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff
+  (pksAlice@(_, _, Nothing), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff
   E2ERatchetParams _ _ _ Nothing <- pure e2eAlice
   -- incorrectly accept KEM
   -- we don't have key in proposal, so we just generate it
   (k, _) <- sntrup761Keypair g
-  (pkBob1, pkBob2, pKemBob_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSAccepted $ AcceptKEM k)
-  pqX3dhSnd pkBob1 pkBob2 pKemBob_ e2eAlice `shouldBe` Left C.CERatchetKEMState
-  runExceptT (pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob) `shouldReturn` Left C.CERatchetKEMState
+  (pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSAccepted $ AcceptKEM k)
+  pqX3dhSnd pksBob e2eAlice `shouldBe` Left C.CERatchetKEMState
+  runExceptT (pqX3dhRcv pksAlice e2eBob) `shouldReturn` Left C.CERatchetKEMState
 
 testPqX3dhProposeAgain :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
 testPqX3dhProposeAgain _ = do
   g <- C.newRandom
   let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
   -- initiate (propose KEM)
-  (pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
+  (pksAlice@(_, _, Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
   E2ERatchetParams _ _ _ (Just (RKParamsProposed _)) <- pure e2eAlice
   -- propose KEM again in reply - this is not an error
-  (pkBob1, pkBob2, pKemBob_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSProposed ProposeKEM)
-  Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemBob_ e2eAlice
-  Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKemAlice_ e2eBob
+  (pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSProposed ProposeKEM)
+  Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
+  Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
   paramsAlice `compatibleRatchets` paramsBob
 
 compatibleRatchets :: (RatchetInitParams, x) -> (RatchetInitParams, x) -> Expectation
@@ -515,10 +515,10 @@ initRatchets :: (AlgorithmI a, DhAlgorithm a) => IO (Ratchet a, Ratchet a, Encry
 initRatchets = do
   g <- C.newRandom
   let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
-  (pkBob1, pkBob2, _pKemParams@Nothing, AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v Nothing
-  (pkAlice1, pkAlice2, _pKem@Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOff
-  Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
-  Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
+  (pksBob@(_, _, Nothing), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v Nothing
+  (pksAlice@(_, pkAlice2, Nothing), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOff
+  Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
+  Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
   (_, pkBob3) <- atomically $ C.generateKeyPair g
   let vs = testRatchetVersions
       bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
@@ -530,12 +530,12 @@ initRatchetsKEMProposed = do
   g <- C.newRandom
   let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
   -- initiate (no KEM)
-  (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOff
+  (pksAlice@(_, pkAlice2, Nothing), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOff
   -- propose KEM in reply
   let useKem = AUseKEM SRKSProposed ProposeKEM
-  (pkBob1, pkBob2, pKemParams_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
-  Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice
-  Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
+  (pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
+  Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
+  Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
   (_, pkBob3) <- atomically $ C.generateKeyPair g
   let vs = testRatchetVersions
       bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
@@ -547,13 +547,13 @@ initRatchetsKEMAccepted = do
   g <- C.newRandom
   let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
   -- initiate (propose)
-  (pkAlice1, pkAlice2, pKem_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOn
+  (pksAlice@(_, pkAlice2, Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOn
   E2ERatchetParams _ _ _ (Just (RKParamsProposed aliceKem)) <- pure e2eAlice
   -- accept
   let useKem = AUseKEM SRKSAccepted (AcceptKEM aliceKem)
-  (pkBob1, pkBob2, pKemParams_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
-  Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice
-  Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKem_ e2eBob
+  (pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
+  Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
+  Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
   (_, pkBob3) <- atomically $ C.generateKeyPair g
   let vs = testRatchetVersions
       bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
@@ -565,12 +565,12 @@ initRatchetsKEMProposedAgain = do
   g <- C.newRandom
   let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
   -- initiate (propose KEM)
-  (pkAlice1, pkAlice2, pKem_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOn
+  (pksAlice@(_, pkAlice2, Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOn
   -- propose KEM again in reply
   let useKem = AUseKEM SRKSProposed ProposeKEM
-  (pkBob1, pkBob2, pKemParams_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
-  Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice
-  Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKem_ e2eBob
+  (pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
+  Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
+  Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
   (_, pkBob3) <- atomically $ C.generateKeyPair g
   let vs = testRatchetVersions
       bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob

tests/AgentTests/FunctionalAPITests.hs

@@ -1425,7 +1425,8 @@ testInvitationShortLinkAsync viaProxy a b = do
   connReq' `shouldBe` connReq
   linkUserData connData' `shouldBe` userData
   runRight $ do
-    aId <- A.joinConnectionAsync b 1 "123" Nothing True connReq "bob's connInfo" PQSupportOn SMSubscribe
+    aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn
+    A.joinConnectionAsync b "123" False aId True connReq "bob's connInfo" PQSupportOn SMSubscribe
     get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False
     ("", _, CONF confId _ "bob's connInfo") <- get a
     allowConnection a bId confId "alice's connInfo"
@@ -1662,7 +1663,7 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b
   linkEntId <- atomically $ C.randomBytes 32 g
   runRight $ do
     (ccLink@(CCLink connReq (Just shortLink)), preparedParams) <-
-      A.prepareConnectionLink a 1 rootKey linkEntId True Nothing
+      A.prepareConnectionLink a 1 rootKey linkEntId True Nothing Nothing
     liftIO $ strDecode (strEncode shortLink) `shouldBe` Right shortLink
     _ <- A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams userLinkData CR.IKPQOn SMSubscribe
     (FixedLinkData {linkConnReq = connReq', linkEntityId}, ContactLinkData _ userCtData') <- getConnShortLink b 1 shortLink
@@ -2685,10 +2686,12 @@ receiveMsg c cId msgId msg = do
 testAsyncCommands :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 testAsyncCommands sqSecured alice bob baseId =
   runRight_ $ do
-    bobId <- createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe
+    bobId <- prepareConnectionToCreate alice 1 True SCMInvitation PQSupportOn
+    createConnectionAsync alice "1" bobId True SCMInvitation IKPQOn SMSubscribe
     ("1", bobId', INV (ACR _ qInfo)) <- get alice
     liftIO $ bobId' `shouldBe` bobId
-    aliceId <- joinConnectionAsync bob 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+    aliceId <- prepareConnectionToJoin bob 1 True qInfo PQSupportOn
+    joinConnectionAsync bob "2" False aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
     ("2", aliceId', JOINED sqSecured') <- get bob
     liftIO $ do
       aliceId' `shouldBe` aliceId
@@ -2779,8 +2782,8 @@ testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
     liftIO $ qInfo' `shouldBe` qInfo
     liftIO $ userCtData' `shouldBe` userCtData
     -- join connection async using connId from getConnShortLinkAsync
-    aliceId <- joinConnectionAsync bob 1 "2" (Just newId) True qInfo' "bob's connInfo" PQSupportOn SMSubscribe
-    liftIO $ aliceId `shouldBe` newId
+    joinConnectionAsync bob "2" True newId True qInfo' "bob's connInfo" PQSupportOn SMSubscribe
+    let aliceId = newId
     ("2", aliceId', JOINED False) <- get bob
     liftIO $ aliceId' `shouldBe` aliceId
     -- complete connection
@@ -2796,7 +2799,10 @@ testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
 testAsyncCommandsRestore :: (ASrvTransport, AStoreType) -> IO ()
 testAsyncCommandsRestore ps = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
-  bobId <- runRight $ createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe
+  bobId <- runRight $ do
+    connId <- prepareConnectionToCreate alice 1 True SCMInvitation PQSupportOn
+    createConnectionAsync alice "1" connId True SCMInvitation IKPQOn SMSubscribe
+    pure connId
   liftIO $ noMessages alice "alice doesn't receive INV because server is down"
   disposeAgentClient alice
   withAgent 2 agentCfg initAgentServers testDB $ \alice' ->
@@ -2812,7 +2818,8 @@ testAcceptContactAsync sqSecured alice bob baseId =
     (aliceId, sqSecuredJoin) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
     liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
     ("", _, REQ invId _ "bob's connInfo") <- get alice
-    bobId <- acceptContactAsync alice 1 "1" True invId "alice's connInfo" PQSupportOn SMSubscribe
+    bobId <- prepareConnectionToAccept alice 1 True invId PQSupportOn
+    acceptContactAsync alice "1" bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
     get alice =##> \case ("1", c, JOINED sqSecured') -> c == bobId && sqSecured' == sqSecured; _ -> False
     ("", _, CONF confId _ "alice's connInfo") <- get bob
     allowConnection bob aliceId confId "bob's connInfo"
@@ -3083,10 +3090,12 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do
   withAgent 1 cfg' initAgentServers testDB $ \a ->
     withAgent 2 cfg' initAgentServersSrv2 testDB2 $ \b -> do
       (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
-        bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe
+        bId <- prepareConnectionToCreate a 1 True SCMInvitation PQSupportOn
+        createConnectionAsync a "1" bId True SCMInvitation IKPQOn SMSubscribe
         ("1", bId', INV (ACR _ qInfo)) <- get a
         liftIO $ bId' `shouldBe` bId
-        aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+        aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn
+        joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
         liftIO $ threadDelay 500000
         ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
         pure (aId, bId)
@@ -3128,10 +3137,12 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
   withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withAgent 2 agentCfg initAgentServersSrv2 testDB2 $ \b -> do
       (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
-        bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe
+        bId <- prepareConnectionToCreate a 1 True SCMInvitation PQSupportOn
+        createConnectionAsync a "1" bId True SCMInvitation IKPQOn SMSubscribe
         ("1", bId', INV (ACR _ qInfo)) <- get a
         liftIO $ bId' `shouldBe` bId
-        aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+        aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn
+        joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
         liftIO $ threadDelay 500000
         ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
         pure (aId, bId)

tests/AgentTests/ResolveNameTests.hs

@@ -30,7 +30,7 @@ import Simplex.Messaging.Agent.Protocol (AgentErrorType (..))
 import Simplex.Messaging.Client (SMPProxyFallback (..), SMPProxyMode (..), pattern NRMInteractive)
 import Simplex.Messaging.Protocol (SMPServer)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.SimplexName (SimplexNameDomain (..), SimplexTLD (..))
+import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexTLD (..))
 import Simplex.Messaging.Transport
 import Test.Hspec hiding (fit, it)
 import Util (it)
@@ -90,7 +90,7 @@ resolveNameTests = do
 testDirectNotFound :: HasCallStack => IO ()
 testDirectNotFound =
   withDirectResolver (status404, "{}") $ \c -> do
-    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexNameDomain TLDSimplex "alice" [])
+    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
     case r of
       Left (SMP _ (SMP.NAME SMP.NOT_FOUND)) -> pure ()
       _ -> expectationFailure $ "expected Left (SMP _ (NAME NOT_FOUND)), got: " <> show r
@@ -98,7 +98,7 @@ testDirectNotFound =
 testProxyNotFound :: HasCallStack => IO ()
 testProxyNotFound =
   withProxyAndResolver (status404, "{}") $ \c -> do
-    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexNameDomain TLDSimplex "alice" [])
+    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
     case r of
       Left (SMP host (SMP.NAME SMP.NOT_FOUND)) | testPort `isInfixOf` host -> pure ()
       _ -> expectationFailure $ "expected Left (SMP <proxyHost:" <> testPort <> "> (NAME NOT_FOUND)), got: " <> show r
@@ -106,7 +106,7 @@ testProxyNotFound =
 testTestingTldNotFound :: HasCallStack => IO ()
 testTestingTldNotFound =
   withDirectResolver (status404, "{}") $ \c -> do
-    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexNameDomain TLDTesting "bob" [])
+    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDTesting "bob" [])
     case r of
       Left (SMP _ (SMP.NAME SMP.NOT_FOUND)) -> pure ()
       _ -> expectationFailure $ "expected Left (SMP _ (NAME NOT_FOUND)), got: " <> show r
@@ -114,7 +114,7 @@ testTestingTldNotFound =
 testWebTldNotFound :: HasCallStack => IO ()
 testWebTldNotFound =
   withDirectResolver (status404, "{}") $ \c -> do
-    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexNameDomain TLDWeb "example.com" [])
+    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDWeb "example.com" [])
     case r of
       Left (SMP _ (SMP.NAME SMP.NOT_FOUND)) -> pure ()
       _ -> expectationFailure $ "expected Left (SMP _ (NAME NOT_FOUND)), got: " <> show r
@@ -122,7 +122,7 @@ testWebTldNotFound =
 testNoResolver :: HasCallStack => IO ()
 testNoResolver =
   withNoResolver $ \c -> do
-    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexNameDomain TLDSimplex "alice" [])
+    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
     case r of
       Left (SMP _ (SMP.NAME SMP.NO_RESOLVER)) -> pure ()
       _ -> expectationFailure $ "expected Left (SMP _ (NAME NO_RESOLVER)), got: " <> show r
@@ -130,7 +130,7 @@ testNoResolver =
 testNoNameServers :: HasCallStack => IO ()
 testNoNameServers =
   withNoNameServers $ \c -> do
-    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexNameDomain TLDSimplex "alice" [])
+    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
     case r of
       Left NO_NAME_SERVERS -> pure ()
       _ -> expectationFailure $ "expected Left NO_NAME_SERVERS, got: " <> show r
@@ -138,7 +138,7 @@ testNoNameServers =
 testBackendError :: HasCallStack => IO ()
 testBackendError =
   withDirectResolver (status502, "{}") $ \c -> do
-    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexNameDomain TLDSimplex "alice" [])
+    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
     case r of
       Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
       _ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER ..))), got: " <> show r
@@ -146,7 +146,7 @@ testBackendError =
 testDirectSuccess :: HasCallStack => IO ()
 testDirectSuccess =
   withDirectResolver (status200, J.encode testNameRecord) $ \c -> do
-    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexNameDomain TLDSimplex "alice" [])
+    r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
     case r of
       Right nr -> nr `shouldBe` testNameRecord
       _ -> expectationFailure $ "expected Right NameRecord, got: " <> show r

tests/RSLVTests.hs

@@ -43,13 +43,13 @@ import Simplex.Messaging.Protocol
     tPut,
   )
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.SimplexName (SimplexNameDomain)
+import Simplex.Messaging.SimplexName (SimplexDomain)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Version (mkVersionRange)
 import Test.Hspec hiding (fit, it)
 import Util (it)
 
-domain :: Text -> SimplexNameDomain
+domain :: Text -> SimplexDomain
 domain = either error id . strDecode . encodeUtf8
 
 withResolverServer :: (Status, LB.ByteString) -> IO a -> IO a
@@ -63,7 +63,7 @@ withProxyAndResolver (st, body) runTest =
     withSmpServerConfigOn (transport @TLS) memProxyCfg testPort $ \_ ->
       withSmpServerConfigOn (transport @TLS) (withNames port memCfg2) testPort2 (const runTest)
 
-sendRslv :: Transport c => THandleSMP c 'TClient -> B.ByteString -> SimplexNameDomain -> IO (Transmission (Either ErrorType BrokerMsg))
+sendRslv :: Transport c => THandleSMP c 'TClient -> B.ByteString -> SimplexDomain -> IO (Transmission (Either ErrorType BrokerMsg))
 sendRslv h@THandle {params} corrId d = do
   let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId corrId, NoEntity, Cmd SResolver (RSLV d))
   [Right ()] <- tPut h (Right (Nothing, tToSend) :| [])

tests/SMPNamesTests.hs

@@ -27,7 +27,7 @@ import Simplex.Messaging.Server.Names
     resolveName,
   )
 import Simplex.Messaging.Server.Names.HttpResolver (ResolverError (..))
-import Simplex.Messaging.SimplexName (SimplexNameDomain (..), SimplexTLD (..))
+import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexTLD (..))
 import Test.Hspec
 
 testNameRecord :: NameRecord
@@ -51,7 +51,7 @@ smpNamesTests :: Spec
 smpNamesTests = do
   describe "NameRecord JSON (Protocol)" nameRecordEncodingSpec
   describe "ErrorType NAME wire encoding" errorWireSpec
-  describe "Name parsing (SimplexNameDomain)" parseNameSpec
+  describe "Name parsing (SimplexDomain)" parseNameSpec
   describe "HTTP resolver" resolverSpec
   describe "Resolver health probe" healthSpec
   describe "resolver_endpoint validation" validateUrlSpec
@@ -136,7 +136,7 @@ parseNameSpec = do
   it "accepts a label of exactly 63 bytes" $
     parseN (T.replicate 63 "a" <> ".simplex") `shouldSatisfy` isRight
   where
-    parseN :: T.Text -> Either String SimplexNameDomain
+    parseN :: T.Text -> Either String SimplexDomain
     parseN = strDecode . encodeUtf8
 
 resolverSpec :: Spec
@@ -195,7 +195,7 @@ resolverSpec = do
       readIORef reqs `shouldReturn` [["resolve", "alice.simplex"]]
 
   where
-    aliceDomain = SimplexNameDomain {nameTLD = TLDSimplex, domain = "alice", subDomain = []}
+    aliceDomain = SimplexDomain {nameTLD = TLDSimplex, domain = "alice", subDomain = []}
 
 healthSpec :: Spec
 healthSpec = do

tests/XFTPClient.hs

@@ -9,7 +9,6 @@
 module XFTPClient where
 
 import Control.Concurrent (ThreadId, threadDelay)
-import Control.Monad (void)
 import Data.String (fromString)
 import Data.Time.Clock (getCurrentTime)
 import Network.Socket (ServiceName)
@@ -25,6 +24,7 @@ import Simplex.Messaging.Transport.HTTP2 (httpALPN)
 import Simplex.Messaging.Transport.Server
 import Test.Hspec hiding (fit, it)
 #if defined(dbServerPostgres)
+import Control.Monad (void)
 import qualified Database.PostgreSQL.Simple as PSQL
 import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo)
 import Simplex.FileTransfer.Server.Store.Postgres.Config (PostgresFileStoreCfg (..), defaultXFTPDBOpts)