remove service association from agent API, add per-user flag to use the service

Author: epoberezkin

simplexmq.cabal

@@ -210,6 +210,7 @@ library
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250815_service_certs
   if flag(client_postgres) || flag(server_postgres)
       exposed-modules:
           Simplex.Messaging.Agent.Store.Postgres

src/Simplex/Messaging/Agent.hs

@@ -284,7 +284,7 @@ import Simplex.Messaging.Session
 import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (SMPVersion, SessionId, THandleParams (sessionId, thVersion), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
+import Simplex.Messaging.Transport (SMPVersion, ServiceCredentials, SessionId, THandleParams (sessionId, thVersion), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
@@ -321,6 +321,7 @@ data AgentClient = AgentClient
     msgQ :: TBQueue (ServerTransmissionBatch SMPVersion ErrorType BrokerMsg),
     smpServers :: TMap UserId (UserServers 'PSMP),
     smpClients :: TMap SMPTransportSession SMPClientVar,
+    smpServiceCreds :: TMap UserId (Maybe (TMap SMPServer ServiceCredentials)), -- Nothing means not to use certificates for this user record
     -- smpProxiedRelays:
     -- SMPTransportSession defines connection from proxy to relay,
     -- SMPServerWithAuth defines client connected to SMP proxy (with the same userId and entityId in TransportSession)
@@ -493,6 +494,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg, presetDomai
   msgQ <- newTBQueueIO qSize
   smpServers <- newTVarIO $ M.map mkUserServers smp
   smpClients <- TM.emptyIO
+  smpServiceCreds <- TM.emptyIO
   smpProxiedRelays <- TM.emptyIO
   ntfServers <- newTVarIO ntf
   ntfClients <- TM.emptyIO
@@ -531,6 +533,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg, presetDomai
         msgQ,
         smpServers,
         smpClients,
+        smpServiceCreds,
         smpProxiedRelays,
         ntfServers,
         ntfClients,
@@ -1352,7 +1355,7 @@ getSessionMode :: MonadIO m => AgentClient -> m TransportSessionMode
 getSessionMode = fmap sessionMode . getNetworkConfig
 {-# INLINE getSessionMode #-}
 
-newRcvQueue :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SConnectionMode c -> Bool -> SubscriptionMode -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
+newRcvQueue :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SConnectionMode c -> Bool -> SubscriptionMode -> AM (NewRcvQueue, SMPQueueUri, Maybe ServiceId, SMPTransportSession, SessionId)
 newRcvQueue c nm userId connId srv vRange cMode enableNtfs subMode = do
   let qrd = case cMode of SCMInvitation -> CQRMessaging Nothing; SCMContact -> CQRContact Nothing
   e2eKeys <- atomically . C.generateKeyPair =<< asks random
@@ -1373,7 +1376,7 @@ queueReqData = \case
   CQRMessaging d -> QRMessaging $ srvReq <$> d
   CQRContact d -> QRContact $ srvReq <$> d
 
-newRcvQueue_ :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> ClntQueueReqData -> Bool -> SubscriptionMode -> Maybe C.CbNonce -> C.KeyPairX25519 -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
+newRcvQueue_ :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> ClntQueueReqData -> Bool -> SubscriptionMode -> Maybe C.CbNonce -> C.KeyPairX25519 -> AM (NewRcvQueue, SMPQueueUri, Maybe ServiceId, SMPTransportSession, SessionId)
 newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enableNtfs subMode nonce_ (e2eDhKey, e2ePrivKey) = do
   C.AuthAlg a <- asks (rcvAuthAlg . config)
   g <- asks random
@@ -1401,7 +1404,7 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl
             sndId,
             queueMode,
             shortLink,
-            clientService = ClientService DBNewEntity <$> serviceId,
+            rcvServiceAssoc = isJust serviceId,
             status = New,
             dbQueueId = DBNewEntity,
             primary = True,
@@ -1412,7 +1415,7 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl
             deleteErrors = 0
           }
       qUri = SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey queueMode
-  pure (rq, qUri, tSess, sessionId thParams')
+  pure (rq, qUri, serviceId, tSess, sessionId thParams')
   where
     mkNtfCreds :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> TVar ChaChaDRG -> SMPClient -> IO (Maybe (C.AAuthKeyPair, C.PrivateKeyX25519), Maybe NewNtfCreds)
     mkNtfCreds a g smp

src/Simplex/Messaging/Agent/Client.hs

@@ -97,6 +97,7 @@ data InitialAgentServers = InitialAgentServers
     ntf :: [NtfServer],
     xftp :: Map UserId (NonEmpty (ServerCfg 'PXFTP)),
     netCfg :: NetworkConfig,
+    service :: Map UserId Bool, -- whether to use service certificates for a given user profile
     presetDomains :: [HostName]
   }
 

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

@@ -123,9 +123,6 @@ module Simplex.Messaging.Agent.Protocol
     ContactConnType (..),
     ShortLinkScheme (..),
     LinkKey (..),
-    StoredClientService (..),
-    ClientService,
-    ClientServiceId,
     sameConnReqContact,
     sameShortLinkContact,
     simplexChat,
@@ -207,7 +204,6 @@ import Simplex.FileTransfer.Transport (XFTPErrorType)
 import Simplex.FileTransfer.Types (FileErrorType)
 import Simplex.Messaging.Agent.QueryString
 import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_)
-import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.Client (ProxyClientError)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet
@@ -376,7 +372,7 @@ type SndQueueSecured = Bool
 
 -- | Parameterized type for SMP agent events
 data AEvent (e :: AEntity) where
-  INV :: AConnectionRequestUri -> Maybe ClientServiceId -> AEvent AEConn
+  INV :: AConnectionRequestUri -> 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
   INFO :: PQSupport -> ConnInfo -> AEvent AEConn
@@ -402,7 +398,7 @@ data AEvent (e :: AEntity) where
   DEL_USER :: Int64 -> AEvent AENone
   STAT :: ConnectionStats -> AEvent AEConn
   OK :: AEvent AEConn
-  JOINED :: SndQueueSecured -> Maybe ClientServiceId -> AEvent AEConn
+  JOINED :: SndQueueSecured -> AEvent AEConn
   ERR :: AgentErrorType -> AEvent AEConn
   ERRS :: [(ConnId, AgentErrorType)] -> AEvent AENone
   SUSPENDED :: AEvent AENone
@@ -1760,16 +1756,6 @@ instance Encoding UserLinkData where
   smpP = UserLinkData <$> ((A.char '\255' *> (unLarge <$> smpP)) <|> smpP)
   {-# INLINE smpP #-}
 
-data StoredClientService (s :: DBStored) = ClientService
-  { dbServiceId :: DBEntityId' s,
-    serviceId :: SMP.ServiceId
-  }
-  deriving (Eq, Show)
-
-type ClientService = StoredClientService 'DBStored
-
-type ClientServiceId = DBEntityId
-
 -- | SMP queue status.
 data QueueStatus
   = -- | queue is created

src/Simplex/Messaging/Agent/Protocol.hs

@@ -85,7 +85,7 @@ data StoredRcvQueue (q :: DBStored) = RcvQueue
     -- | short link ID and credentials
     shortLink :: Maybe ShortLinkCreds,
     -- | associated client service
-    clientService :: Maybe (StoredClientService q),
+    rcvServiceAssoc :: ServiceAssoc,
     -- | queue status
     status :: QueueStatus,
     -- | database queue ID (within connection)
@@ -111,9 +111,7 @@ data ShortLinkCreds = ShortLinkCreds
   }
   deriving (Show)
 
-clientServiceId :: RcvQueue -> Maybe ClientServiceId
-clientServiceId = fmap dbServiceId . clientService
-{-# INLINE clientServiceId #-}
+type ServiceAssoc = Bool
 
 rcvQueueInfo :: RcvQueue -> RcvQueueInfo
 rcvQueueInfo rq@RcvQueue {server, rcvSwchStatus} =

src/Simplex/Messaging/Agent/Store.hs

@@ -1979,7 +1979,7 @@ insertRcvQueue_ db connId' rq@RcvQueue {..} serverKeyHash_ = do
         :. ntfCredsFields
     )
   -- TODO [certs rcv] save client service
-  pure (rq :: NewRcvQueue) {connId = connId', dbQueueId = qId, clientService = Nothing}
+  pure (rq :: NewRcvQueue) {connId = connId', dbQueueId = qId, rcvServiceAssoc = False}
   where
     ntfCredsFields = case clientNtfCreds of
       Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret} ->
@@ -2179,7 +2179,7 @@ toRcvQueue
         (Just shortLinkId, Just shortLinkKey, Just linkPrivSigKey, Just linkEncFixedData) -> Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData}
         _ -> Nothing
       -- TODO [certs rcv] read client service
-   in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, queueMode, shortLink, clientService = Nothing, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}
+   in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, queueMode, shortLink, rcvServiceAssoc = False, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}
 
 getRcvQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError RcvQueue)
 getRcvQueueById db connId dbRcvId =

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

@@ -44,6 +44,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250815_service_certs
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -87,7 +88,8 @@ schemaMigrations =
     ("m20241224_ratchet_e2e_snd_params", m20241224_ratchet_e2e_snd_params, Just down_m20241224_ratchet_e2e_snd_params),
     ("m20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies),
     ("m20250322_short_links", m20250322_short_links, Just down_m20250322_short_links),
-    ("m20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete)
+    ("m20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete),
+    ("m20250815_service_certs", m20250815_service_certs, Just down_m20250815_service_certs)
   ]
 
 -- | The list of migrations in ascending order by date

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

@@ -1,13 +1,13 @@
 {-# LANGUAGE QuasiQuotes #-}
 
-module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250517_service_certs where
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250815_service_certs where
 
 import Database.SQLite.Simple (Query)
 import Database.SQLite.Simple.QQ (sql)
 
 -- TODO move date forward, create migration for postgres
-m20250517_service_certs :: Query
-m20250517_service_certs =
+m20250815_service_certs :: Query
+m20250815_service_certs =
   [sql|
 CREATE TABLE server_certs(
   server_cert_id INTEGER PRIMARY KEY AUTOINCREMENT,
@@ -24,13 +24,13 @@ CREATE UNIQUE INDEX idx_server_certs_user_id_host_port ON server_certs(user_id,
 
 CREATE INDEX idx_server_certs_host_port ON server_certs(host, port);
 
-ALTER TABLE rcv_queues ADD COLUMN rcv_service_id BLOB;
+ALTER TABLE rcv_queues ADD COLUMN rcv_service_assoc INTEGER NOT NULL DEFAULT 0;
   |]
 
-down_m20250517_service_certs :: Query
-down_m20250517_service_certs =
+down_m20250815_service_certs :: Query
+down_m20250815_service_certs =
   [sql|
-ALTER TABLE rcv_queues DROP COLUMN rcv_service_id;
+ALTER TABLE rcv_queues DROP COLUMN rcv_service_assoc;
 
 DROP INDEX idx_server_certs_host_port;
 

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20250517_service_certs.hs renamed to src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20250815_service_certs.hs

@@ -14,7 +14,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Int (Int64)
 import Data.Maybe (isJust)
 import Data.Text (Text)
-import Simplex.Messaging.Agent.Protocol (ConnectionLink, ConnectionMode (..), ConnectionRequestUri)
+import Simplex.Messaging.Agent.Protocol (ConnectionLink, ConnectionMode (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)