rfc: client certificates for servers using SMP protocol as clients (opertors' chat relays, notification servers, service bots) (#1534)

* rfc: client certificates for high volume clients (opertors' chat relays, notification servers, service bots)

* client certificates types (WIP)

* parameterize Transport

* protocol/schema/api changes

* agent API

* rename command

* agent subscriptions return local ClientServiceId to chat

* verify transmissions

* fix receiving client certificates, refactor

* ntf server: remove shared queue for all notification subscriptions (#1543)

* ntf server: remove shared queue for all notification subscriptions

* wait for subscriber with timeout

* safer

* refactor

* log

* remove unused

* WIP service subscriptions and associations, refactor

* process service subscriptions

* rename

* simplify switching subscriptions

* SMP service handshake with additional server handshake response

* notification delivery and STM persistence for services

* smp server: database storage, store log, fix encoding for STORE error, replace String with Text in locks and error

* stats

* more stats

* rename SMP commands

* service subscriptions in ntf server agent (tests fail)

* fix

* refactor

* exports

* subscribe ntf server as service for associated queues

* test ntf service connection, fix SOKS response, fix service associations not removed in STM storage

* INI option to support services

* ntf server: downgrade subscriptions when service is no longer supported, track counts of subscribed queues

* smp protocol: include service certificate fingerprint in the string signed over with entity key (TODO two tests fail)

* fix test

* ntf server prometheus stats, use Int64 in SOKS/ENDS responses (to avoid conversions), additional error status for ntf subscription

* update RFC

* refactor useServiceAuth to avoid ad hoc decisions about which commands use service signatures, and to prohibit service signatures on other commands

* remove duplicate service signature syntax check from checkCredentials, it is checked in verifyTransmission

* service errors, todos

* fix checkCredentials in ntf server, service errors

* refactor service auth

* refactor

* service agent: store returned queue count instead of expected

* refactor serverThread

* refactor serviceSig

* rename

* refactor, rename, test repeat NSUB service association

* respond with error to SUBS

* smp server: export/import service records between database and store log

* comment

* comments

* ghc 8.10.7

src/Simplex/Messaging/Server/QueueStore.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
@@ -10,13 +11,18 @@
 
 module Simplex.Messaging.Server.QueueStore where
 
-import Control.Applicative ((<|>))
+import Control.Applicative (optional, (<|>))
+import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
+import qualified Data.X509 as X
+import qualified Data.X509.Validation as XV
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
+import Simplex.Messaging.Transport (SMPServiceRole)
 #if defined(dbServerPostgres)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Database.PostgreSQL.Simple.FromField (FromField (..))
@@ -34,22 +40,55 @@ data QueueRec = QueueRec
     queueData :: Maybe (LinkId, QueueLinkData),
     notifier :: Maybe NtfCreds,
     status :: ServerEntityStatus,
-    updatedAt :: Maybe RoundedSystemTime
+    updatedAt :: Maybe RoundedSystemTime,
+    rcvServiceId :: Maybe ServiceId
   }
   deriving (Show)
 
 data NtfCreds = NtfCreds
-  { notifierId :: !NotifierId,
-    notifierKey :: !NtfPublicAuthKey,
-    rcvNtfDhSecret :: !RcvNtfDhSecret
+  { notifierId :: NotifierId,
+    notifierKey :: NtfPublicAuthKey,
+    rcvNtfDhSecret :: RcvNtfDhSecret,
+    ntfServiceId :: Maybe ServiceId
   }
   deriving (Show)
 
 instance StrEncoding NtfCreds where
-  strEncode NtfCreds {notifierId, notifierKey, rcvNtfDhSecret} = strEncode (notifierId, notifierKey, rcvNtfDhSecret)
+  strEncode NtfCreds {notifierId, notifierKey, rcvNtfDhSecret, ntfServiceId} =
+    strEncode (notifierId, notifierKey, rcvNtfDhSecret)
+      <> maybe "" ((" nsrv=" <>) . strEncode) ntfServiceId
   strP = do
     (notifierId, notifierKey, rcvNtfDhSecret) <- strP
-    pure NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}
+    ntfServiceId <- optional $ " nsrv=" *> strP
+    pure NtfCreds {notifierId, notifierKey, rcvNtfDhSecret, ntfServiceId}
+
+data ServiceRec = ServiceRec
+  { serviceId :: ServiceId,
+    serviceRole :: SMPServiceRole,
+    serviceCert :: X.CertificateChain,
+    serviceCertHash :: XV.Fingerprint, -- SHA512 hash of long-term service client certificate. See comment for ClientHandshake.
+    serviceCreatedAt :: RoundedSystemTime
+  }
+  deriving (Show)
+
+type CertFingerprint = B.ByteString
+
+instance StrEncoding ServiceRec where
+  strEncode ServiceRec {serviceId, serviceRole, serviceCert, serviceCertHash, serviceCreatedAt} =
+    B.unwords
+      [ "service_id=" <> strEncode serviceId,
+        "role=" <> smpEncode serviceRole,
+        "cert=" <> strEncode serviceCert,
+        "cert_hash=" <> strEncode serviceCertHash,
+        "created_at=" <> strEncode serviceCreatedAt
+      ]
+  strP = do
+    serviceId <- "service_id=" *> strP
+    serviceRole <- " role=" *> smpP
+    serviceCert <- " cert=" *> strP
+    serviceCertHash <- " cert_hash=" *> strP
+    serviceCreatedAt <- " created_at=" *> strP
+    pure ServiceRec {serviceId, serviceRole, serviceCert, serviceCertHash, serviceCreatedAt}
 
 data ServerEntityStatus
   = EntityActive