server: SMP basic auth (#561)

* server: SMP basic auth * update ini default * rfc, types * tests * update INI file * typo Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com> * refactor * update INI options, log new queue creation mode on start (on/off/requires auth) Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>
2026-03-30 14:16:00 +00:00 · 2022-11-12 22:29:36 +00:00
parent d2b88a1baa
commit e281efdcb8
16 changed files with 280 additions and 73 deletions
--- a/apps/smp-server/Main.hs
+++ b/apps/smp-server/Main.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}

 module Main where
@@ -8,6 +7,10 @@ module Main where
 import Control.Logger.Simple
 import Data.Functor (($>))
 import Data.Ini (lookupValue)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.CLI (ServerCLIConfig (..), protocolServerCLI, readStrictIni)
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defaultInactiveClientExpiration, defaultMessageExpiration)
@@ -31,6 +34,11 @@ main = do
    putStrLn $ case inactiveClientExpiration of
      Just ExpirationConfig {ttl, checkInterval} -> "expiring clients inactive for " <> show ttl <> " seconds every " <> show checkInterval <> " seconds"
      _ -> "not expiring inactive clients"
+    putStrLn $
+      "creating new queues "
+        <> if allowNewQueues cfg
+          then maybe "allowed" (const "requires basic auth") $ newQueueBasicAuth cfg
+          else "NOT allowed"
    runSMPServer cfg

 smpServerCLIConfig :: ServerCLIConfig ServerConfig
@@ -62,7 +70,17 @@ smpServerCLIConfig =
              <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
                 \# they are preserved in the .bak file until the next restart.\n"
              <> ("restore_messages: " <> (if enableStoreLog then "on" else "off") <> "\n")
-              <> ("log_stats: off\n\n")
+              <> "log_stats: off\n\n"
+              <> "[AUTH]\n"
+              <> "# Set new_queues option to off to completely prohibit creating new messaging queues.\n"
+              <> "# This can be useful when you want to decommission the server, but not all connections are switched yet.\n"
+              <> "new_queues: on\n\n"
+              <> "# Use create_password option to enable basic auth to create new messaging queues.\n"
+              <> "# The password should be used as part of server address in client configuration:\n"
+              <> "# smp://fingerprint:password@host1,host2\n"
+              <> "# The password will not be shared with the connecting contacts, you must share it only\n"
+              <> "# with the users who you want to allow creating messaging queues on your server.\n"
+              <> "# create_password: password to create new queues (any printable ASCII characters without whitespace, '@', ':' and '/')\n\n"
              <> "[TRANSPORT]\n"
              <> ("port: " <> defaultServerPort <> "\n")
              <> "websockets: off\n\n"
@@ -72,7 +90,12 @@ smpServerCLIConfig =
              <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
              <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n"),
          mkServerConfig = \storeLogFile transports ini ->
-            let settingIsOn section name = if lookupValue section name ini == Right "on" then Just () else Nothing
+            let onOff section name = case lookupValue section name ini of
+                  Right "on" -> Just True
+                  Right "off" -> Just False
+                  Right s -> error . T.unpack $ "invalid INI setting " <> name <> ": " <> s
+                  _ -> Nothing
+                settingIsOn section name = if onOff section name == Just True then Just () else Nothing
                logStats = settingIsOn "STORE_LOG" "log_stats"
             in ServerConfig
                  { transports,
@@ -87,12 +110,16 @@ smpServerCLIConfig =
                    storeLogFile,
                    storeMsgsFile =
                      let messagesPath = combine logPath "smp-server-messages.log"
-                       in case lookupValue "STORE_LOG" "restore_messages" ini of
-                            Right "on" -> Just messagesPath
-                            Right _ -> Nothing
+                       in case onOff "STORE_LOG" "restore_messages" of
+                            Just True -> Just messagesPath
+                            Just False -> Nothing
                            -- if the setting is not set, it is enabled when store log is enabled
                            _ -> storeLogFile $> messagesPath,
-                    allowNewQueues = True,
+                    -- allow creating new queues by default
+                    allowNewQueues = fromMaybe True $ onOff "AUTH" "new_queues",
+                    newQueueBasicAuth = case lookupValue "AUTH" "create_password" ini of
+                      Right auth -> either error Just . strDecode $ encodeUtf8 auth
+                      _ -> Nothing,
                    messageExpiration = Just defaultMessageExpiration,
                    inactiveClientExpiration =
                      settingIsOn "INACTIVE_CLIENTS" "disconnect"
--- a/rfcs/2022-11-11-smp-basic-auth.md
+++ b/rfcs/2022-11-11-smp-basic-auth.md
@@ -0,0 +1,27 @@
+# SMP Basic Auth
+
+## Problem
+
+Users who host their own servers do not want unknown people to be able to create messaging queues on their servers after discovering server address in groups or after making a connection. As the number of self-hosted servers is growing it became more important than it was when we excluded it from the original design.
+
+## Solution
+
+Single access password that can be optionally included in server address that is passed to app configuration. It will not be allowed in the existing contexts (and parsing will fail), to avoid accidentally leaking it. Server address with password will look this way: `smp://fingerprint:password@hosts`
+
+## Implementation plan
+
+1. A separate type to include server and password, so it can only be used where allowed.
+
+2. Server password to create queues will be configured in TRANSPORT section of INI file, as `create_password` parameter.
+
+3. The password will only be required in server configuration/address to create queues only, it won't be required for other receiving queue operations on already existing queues.
+
+4. If new command is attempted in the session that does not allow creating queues, the server will send `ERR AUTH` response
+
+5. Passing password to the server can be done in one of the several ways, we need to decide:
+
+  - as a parameter of NEW command. Pros: a local change, that only needs checking when queue is created. Cons: protocol version change.
+  - as a separate command AUTH. Pros: allows to include additional parameters and potentially be extended beyond basic auth. Cons: more complex to manage server state, can be more difficult syntax in the future, if extended.
+  - as part of handshake (we currently ignore the unparsed part of handshake block, so it can be extended). Pros: probably, the simplest, and independent of the commands protocol – establishes create permission for the current session. Cons: the client won't know about whether it is able to create the queue until it tries (same as in case 1).
+
+  My preference is the last option. As a variant of the last option, we can add a server response/message that includes permission to create queues - it will only be sent to the clients who pass credential in handshake - that might simplify testing server connection (we currently do not do it). It might be unnecessary, as we could simply create and delete queue in case credential is passed as part of testing connection (and even sending a message to it).
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -120,7 +120,7 @@ import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfReg
 import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..))
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
-import Simplex.Messaging.Protocol (BrokerMsg, ErrorType (AUTH), MsgBody, MsgFlags, NtfServer, SMPMsgMeta, SndPublicVerifyKey, sameSrvAddr)
+import Simplex.Messaging.Protocol (BrokerMsg, ErrorType (AUTH), MsgBody, MsgFlags, NtfServer, SMPMsgMeta, SndPublicVerifyKey, sameSrvAddr, sameSrvAddr')
 import qualified Simplex.Messaging.Protocol as SMP
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util
@@ -248,7 +248,7 @@ getConnectionServers :: AgentErrorMonad m => AgentClient -> ConnId -> m Connecti
 getConnectionServers c = withAgentEnv c . getConnectionServers' c

 -- | Change servers to be used for creating new queues
-setSMPServers :: AgentErrorMonad m => AgentClient -> NonEmpty SMPServer -> m ()
+setSMPServers :: AgentErrorMonad m => AgentClient -> NonEmpty SMPServerWithAuth -> m ()
 setSMPServers c = withAgentEnv c . setSMPServers' c

 setNtfServers :: AgentErrorMonad m => AgentClient -> [NtfServer] -> m ()
@@ -430,7 +430,7 @@ newConn :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> SConnectionM
 newConn c connId asyncMode enableNtfs cMode clientData =
  getSMPServer c >>= newConnSrv c connId asyncMode enableNtfs cMode clientData

-newConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> SConnectionMode c -> Maybe CRClientData -> SMPServer -> m (ConnId, ConnectionRequestUri c)
+newConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> SConnectionMode c -> Maybe CRClientData -> SMPServerWithAuth -> m (ConnId, ConnectionRequestUri c)
 newConnSrv c connId asyncMode enableNtfs cMode clientData srv = do
  AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
  (q, qUri) <- newRcvQueue c "" srv smpClientVRange
@@ -464,7 +464,7 @@ joinConn c connId asyncMode enableNtfs cReq cInfo = do
    _ -> getSMPServer c
  joinConnSrv c connId asyncMode enableNtfs cReq cInfo srv

-joinConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> SMPServer -> m ConnId
+joinConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> SMPServerWithAuth -> m ConnId
 joinConnSrv c connId asyncMode enableNtfs (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} e2eRcvParamsUri) cInfo srv = do
  AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
  case ( qUri `compatibleVersion` smpClientVRange,
@@ -516,7 +516,7 @@ joinConnSrv c connId False enableNtfs (CRContactUri ConnReqUriData {crAgentVRang
 joinConnSrv _c _connId True _enableNtfs (CRContactUri _) _cInfo _srv = do
  throwError $ CMD PROHIBITED

-createReplyQueue :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> SMPServer -> m SMPQueueInfo
+createReplyQueue :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> m SMPQueueInfo
 createReplyQueue c ConnData {connId, enableNtfs} SndQueue {smpClientVersion} srv = do
  (rq, qUri) <- newRcvQueue c connId srv $ versionToRange smpClientVersion
  let qInfo = toVersionT qUri smpClientVersion
@@ -880,15 +880,15 @@ runCommandProcessing c@AgentClient {subQ} server_ = do
        internalErr s = cmdError $ INTERNAL $ s <> ": " <> show (agentCommandTag command)
        cmdError e = notify (ERR e) >> withStore' c (`deleteCommand` cmdId)
        notify cmd = atomically $ writeTBQueue subQ (corrId, connId, cmd)
-        withNextSrv :: TVar [SMPServer] -> [SMPServer] -> (SMPServer -> m ()) -> m ()
+        withNextSrv :: TVar [SMPServer] -> [SMPServer] -> (SMPServerWithAuth -> m ()) -> m ()
        withNextSrv usedSrvs initUsed action = do
          used <- readTVarIO usedSrvs
-          srv <- getNextSMPServer c used
+          srvAuth@(ProtoServerWithAuth srv _) <- getNextSMPServer c used
          atomically $ do
            srvs <- readTVar $ smpServers c
            let used' = if length used + 1 >= L.length srvs then initUsed else srv : used
            writeTVar usedSrvs used'
-          action srv
+          action srvAuth
 -- ^ ^ ^ async command processing /

 enqueueMessages :: AgentMonad m => AgentClient -> ConnData -> NonEmpty SndQueue -> MsgFlags -> AMessage -> m AgentMsgId
@@ -1124,8 +1124,8 @@ switchConnection' c connId = withConnLock c connId "switchConnection" $ do
    DuplexConnection cData rqs@(rq@RcvQueue {server, dbQueueId, sndId} :| rqs_) sqs -> do
      clientVRange <- asks $ smpClientVRange . config
      -- try to get the server that is different from all queues, or at least from the primary rcv queue
-      srv <- getNextSMPServer c $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
-      srv' <- if srv == server then getNextSMPServer c [server] else pure srv
+      srvAuth@(ProtoServerWithAuth srv _) <- getNextSMPServer c $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
+      srv' <- if srv == server then getNextSMPServer c [server] else pure srvAuth
      (q, qUri) <- newRcvQueue c connId srv' clientVRange
      let rq' = (q :: RcvQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
      void . withStore c $ \db -> addConnRcvQueue db connId rq'
@@ -1191,7 +1191,7 @@ connectionStats = \case
  NewConnection _ -> ConnectionStats {rcvServers = [], sndServers = []}

 -- | Change servers to be used for creating new queues, in Reader monad
-setSMPServers' :: AgentMonad m => AgentClient -> NonEmpty SMPServer -> m ()
+setSMPServers' :: AgentMonad m => AgentClient -> NonEmpty SMPServerWithAuth -> m ()
 setSMPServers' c = atomically . writeTVar (smpServers c)

 registerNtfToken' :: forall m. AgentMonad m => AgentClient -> DeviceToken -> NotificationsMode -> m NtfTknStatus
@@ -1436,20 +1436,20 @@ debugAgentLocks' AgentClient {connLocks = cs, reconnectLocks = rs} = do
  where
    getLocks ls = atomically $ M.mapKeys (B.unpack . strEncode) . M.mapMaybe id <$> (mapM tryReadTMVar =<< readTVar ls)

-getSMPServer :: AgentMonad m => AgentClient -> m SMPServer
+getSMPServer :: AgentMonad m => AgentClient -> m SMPServerWithAuth
 getSMPServer c = readTVarIO (smpServers c) >>= pickServer

-pickServer :: AgentMonad m => NonEmpty SMPServer -> m SMPServer
+pickServer :: AgentMonad m => NonEmpty SMPServerWithAuth -> m SMPServerWithAuth
 pickServer = \case
  srv :| [] -> pure srv
  servers -> do
    gen <- asks randomServer
    atomically $ (servers L.!!) <$> stateTVar gen (randomR (0, L.length servers - 1))

-getNextSMPServer :: AgentMonad m => AgentClient -> [SMPServer] -> m SMPServer
+getNextSMPServer :: AgentMonad m => AgentClient -> [SMPServer] -> m SMPServerWithAuth
 getNextSMPServer c usedSrvs = do
  srvs <- readTVarIO $ smpServers c
-  case L.nonEmpty $ deleteFirstsBy sameSrvAddr (L.toList srvs) usedSrvs of
+  case L.nonEmpty $ deleteFirstsBy sameSrvAddr' (L.toList srvs) (map noAuthSrv usedSrvs) of
    Just srvs' -> pickServer srvs'
    _ -> pickServer srvs

@@ -1766,7 +1766,7 @@ connectReplyQueues c cData@ConnData {connId} ownConnInfo (qInfo :| _) = do
      dbQueueId <- withStore c $ \db -> upgradeRcvConnToDuplex db connId sq
      enqueueConfirmation c cData sq {dbQueueId} ownConnInfo Nothing

-confirmQueue :: forall m. AgentMonad m => Compatible Version -> AgentClient -> ConnData -> SndQueue -> SMPServer -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
+confirmQueue :: forall m. AgentMonad m => Compatible Version -> AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
 confirmQueue (Compatible agentVersion) c cData@ConnData {connId} sq srv connInfo e2eEncryption = do
  aMessage <- mkAgentMessage agentVersion
  msg <- mkConfirmation aMessage
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -164,7 +164,7 @@ data AgentClient = AgentClient
    rcvQ :: TBQueue (ATransmission 'Client),
    subQ :: TBQueue (ATransmission 'Agent),
    msgQ :: TBQueue (ServerTransmission BrokerMsg),
-    smpServers :: TVar (NonEmpty SMPServer),
+    smpServers :: TVar (NonEmpty SMPServerWithAuth),
    smpClients :: TMap SMPServer SMPClientVar,
    ntfServers :: TVar [NtfServer],
    ntfClients :: TMap NtfServer NtfClientVar,
@@ -515,7 +515,7 @@ protocolClientError protocolError_ = \case
  e@PCESignatureError {} -> INTERNAL $ show e
  e@PCEIOError {} -> INTERNAL $ show e

-newRcvQueue :: AgentMonad m => AgentClient -> ConnId -> SMPServer -> VersionRange -> m (RcvQueue, SMPQueueUri)
+newRcvQueue :: AgentMonad m => AgentClient -> ConnId -> SMPServerWithAuth -> VersionRange -> m (RcvQueue, SMPQueueUri)
 newRcvQueue c connId srv vRange =
  asks (cmdSignAlg . config) >>= \case
    C.SignAlg a -> newRcvQueue_ a c connId srv vRange
@@ -525,16 +525,16 @@ newRcvQueue_ ::
  C.SAlgorithm a ->
  AgentClient ->
  ConnId ->
-  SMPServer ->
+  SMPServerWithAuth ->
  VersionRange ->
  m (RcvQueue, SMPQueueUri)
-newRcvQueue_ a c connId srv vRange = do
+newRcvQueue_ a c connId (ProtoServerWithAuth srv auth) vRange = do
  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
  (dhKey, privDhKey) <- liftIO C.generateKeyPair'
  (e2eDhKey, e2ePrivKey) <- liftIO C.generateKeyPair'
  logServer "-->" c srv "" "NEW"
  QIK {rcvId, sndId, rcvPublicDhKey} <-
-    withClient c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey dhKey
+    withClient c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey dhKey auth
  logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
  let rq =
        RcvQueue
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -59,7 +59,7 @@ import UnliftIO.STM
 type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m)

 data InitialAgentServers = InitialAgentServers
-  { smp :: NonEmpty SMPServer,
+  { smp :: NonEmpty SMPServerWithAuth,
    ntf :: [NtfServer],
    netCfg :: NetworkConfig
  }
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -61,9 +61,12 @@ module Simplex.Messaging.Agent.Protocol
    SndQAddr,
    SMPServer,
    pattern SMPServer,
+    pattern ProtoServerWithAuth,
+    SMPServerWithAuth,
    SrvLoc (..),
    SMPQueue (..),
    sameQAddress,
+    noAuthSrv,
    SMPQueueUri (..),
    SMPQueueInfo (..),
    SMPQueueAddress (..),
@@ -164,12 +167,15 @@ import Simplex.Messaging.Protocol
    NMsgMeta,
    ProtocolServer (..),
    SMPServer,
+    SMPServerWithAuth,
    SndPublicVerifyKey,
    SrvLoc (..),
    legacyEncodeServer,
    legacyServerP,
    legacyStrEncodeServer,
+    noAuthSrv,
    sameSrvAddr,
+    pattern ProtoServerWithAuth,
    pattern SMPServer,
  )
 import qualified Simplex.Messaging.Protocol as SMP
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -361,9 +361,10 @@ createSMPQueue ::
  RcvPrivateSignKey ->
  RcvPublicVerifyKey ->
  RcvPublicDhKey ->
+  Maybe BasicAuth ->
  ExceptT ProtocolClientError IO QueueIdsKeys
-createSMPQueue c rpKey rKey dhKey =
-  sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey) >>= \case
+createSMPQueue c rpKey rKey dhKey auth =
+  sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey auth) >>= \case
    IDS qik -> pure qik
    r -> throwE . PCEUnexpectedResponse $ bshow r

--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -70,8 +70,11 @@ module Simplex.Messaging.Protocol
    ProtoServer,
    SMPServer,
    pattern SMPServer,
+    SMPServerWithAuth,
    NtfServer,
    pattern NtfServer,
+    ProtoServerWithAuth (..),
+    BasicAuth,
    SrvLoc (..),
    CorrId (..),
    QueueId,
@@ -116,6 +119,8 @@ module Simplex.Messaging.Protocol
    legacyServerP,
    legacyStrEncodeServer,
    sameSrvAddr,
+    sameSrvAddr',
+    noAuthSrv,

    -- * TCP transport functions
    tPut,
@@ -135,6 +140,7 @@ import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Char (isPrint, isSpace)
 import Data.Kind
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
@@ -250,7 +256,7 @@ type EntityId = ByteString
 -- | Parameterized type for SMP protocol commands from all clients.
 data Command (p :: Party) where
  -- SMP recipient commands
-  NEW :: RcvPublicVerifyKey -> RcvPublicDhKey -> Command Recipient
+  NEW :: RcvPublicVerifyKey -> RcvPublicDhKey -> Maybe BasicAuth -> Command Recipient
  SUB :: Command Recipient
  KEY :: SndPublicVerifyKey -> Command Recipient
  NKEY :: NtfPublicVerifyKey -> RcvNtfPublicDhKey -> Command Recipient
@@ -566,6 +572,8 @@ pattern SMPServer host port keyHash = ProtocolServer SPSMP host port keyHash

 {-# COMPLETE SMPServer #-}

+type SMPServerWithAuth = ProtoServerWithAuth 'PSMP
+
 type NtfServer = ProtocolServer 'PNTF

 pattern NtfServer :: NonEmpty TransportHost -> ServiceName -> C.KeyHash -> ProtocolServer 'PNTF
@@ -573,6 +581,10 @@ pattern NtfServer host port keyHash = ProtocolServer SPNTF host port keyHash

 {-# COMPLETE NtfServer #-}

+sameSrvAddr' :: ProtoServerWithAuth p -> ProtoServerWithAuth p -> Bool
+sameSrvAddr' (ProtoServerWithAuth srv _) (ProtoServerWithAuth srv' _) = sameSrvAddr srv srv'
+{-# INLINE sameSrvAddr' #-}
+
 sameSrvAddr :: ProtocolServer p -> ProtocolServer p -> Bool
 sameSrvAddr ProtocolServer {host, port} ProtocolServer {host = h', port = p'} = host == h' && port == p'
 {-# INLINE sameSrvAddr #-}
@@ -667,20 +679,54 @@ instance ProtocolTypeI p => Encoding (ProtocolServer p) where

 instance ProtocolTypeI p => StrEncoding (ProtocolServer p) where
  strEncode ProtocolServer {scheme, host, port, keyHash} =
-    strEncodeServer scheme (strEncode host) port keyHash
-  strP = do
-    scheme <- strP <* "://"
-    keyHash <- strP <* A.char '@'
-    TransportHosts host <- strP
-    port <- portP <|> pure ""
-    pure ProtocolServer {scheme, host, port, keyHash}
-    where
-      portP = show <$> (A.char ':' *> (A.decimal :: Parser Int))
+    strEncodeServer scheme (strEncode host) port keyHash Nothing
+  strP =
+    serverStrP >>= \case
+      (srv, Nothing) -> pure srv
+      _ -> fail "ProtocolServer with basic auth not allowed"

 instance ProtocolTypeI p => ToJSON (ProtocolServer p) where
  toJSON = strToJSON
  toEncoding = strToJEncoding

+newtype BasicAuth = BasicAuth ByteString
+  deriving (Eq, Show)
+
+instance IsString BasicAuth where fromString = BasicAuth . B.pack
+
+instance Encoding BasicAuth where
+  smpEncode (BasicAuth s) = smpEncode s
+  smpP = basicAuth <$?> smpP
+
+instance StrEncoding BasicAuth where
+  strEncode (BasicAuth s) = s
+  strP = basicAuth <$?> A.takeWhile1 (/= '@')
+
+basicAuth :: ByteString -> Either String BasicAuth
+basicAuth s
+  | B.all valid s = Right $ BasicAuth s
+  | otherwise = Left "invalid character in BasicAuth"
+  where
+    valid c = isPrint c && not (isSpace c) && c /= '@' && c /= ':' && c /= '/'
+
+data ProtoServerWithAuth p = ProtoServerWithAuth (ProtocolServer p) (Maybe BasicAuth)
+  deriving (Show)
+
+instance ProtocolTypeI p => IsString (ProtoServerWithAuth p) where
+  fromString = parseString strDecode
+
+instance ProtocolTypeI p => StrEncoding (ProtoServerWithAuth p) where
+  strEncode (ProtoServerWithAuth ProtocolServer {scheme, host, port, keyHash} auth_) =
+    strEncodeServer scheme (strEncode host) port keyHash auth_
+  strP = uncurry ProtoServerWithAuth <$> serverStrP
+
+instance ProtocolTypeI p => ToJSON (ProtoServerWithAuth p) where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+noAuthSrv :: ProtocolServer p -> ProtoServerWithAuth p
+noAuthSrv srv = ProtoServerWithAuth srv Nothing
+
 legacyEncodeServer :: ProtocolServer p -> ByteString
 legacyEncodeServer ProtocolServer {host, port, keyHash} =
  smpEncode (L.head host, port, keyHash)
@@ -692,14 +738,25 @@ legacyServerP = do

 legacyStrEncodeServer :: ProtocolTypeI p => ProtocolServer p -> ByteString
 legacyStrEncodeServer ProtocolServer {scheme, host, port, keyHash} =
-  strEncodeServer scheme (strEncode $ L.head host) port keyHash
+  strEncodeServer scheme (strEncode $ L.head host) port keyHash Nothing

-strEncodeServer :: ProtocolTypeI p => SProtocolType p -> ByteString -> ServiceName -> C.KeyHash -> ByteString
-strEncodeServer scheme host port keyHash =
-  strEncode scheme <> "://" <> strEncode keyHash <> "@" <> host <> portStr
+strEncodeServer :: ProtocolTypeI p => SProtocolType p -> ByteString -> ServiceName -> C.KeyHash -> Maybe BasicAuth -> ByteString
+strEncodeServer scheme host port keyHash auth_ =
+  strEncode scheme <> "://" <> strEncode keyHash <> maybe "" ((":" <>) . strEncode) auth_ <> "@" <> host <> portStr
  where
    portStr = B.pack $ if null port then "" else ':' : port

+serverStrP :: ProtocolTypeI p => Parser (ProtocolServer p, Maybe BasicAuth)
+serverStrP = do
+  scheme <- strP <* "://"
+  keyHash <- strP
+  auth_ <- optional $ A.char ':' *> strP
+  TransportHosts host <- A.char '@' *> strP
+  port <- portP <|> pure ""
+  pure (ProtocolServer {scheme, host, port, keyHash}, auth_)
+  where
+    portP = show <$> (A.char ':' *> (A.decimal :: Parser Int))
+
 data SrvLoc = SrvLoc HostName ServiceName
  deriving (Eq, Ord, Show)

@@ -870,7 +927,13 @@ class ProtocolMsgTag (Tag msg) => ProtocolEncoding msg where
 instance PartyI p => ProtocolEncoding (Command p) where
  type Tag (Command p) = CommandTag p
  encodeProtocol v = \case
-    NEW rKey dhKey -> e (NEW_, ' ', rKey, dhKey)
+    NEW rKey dhKey auth_ -> case auth_ of
+      Just auth
+        | v >= 5 -> new <> e ('A', auth)
+        | otherwise -> new
+      _ -> new
+      where
+        new = e (NEW_, ' ', rKey, dhKey)
    SUB -> e SUB_
    KEY k -> e (KEY_, ' ', k)
    NKEY k dhKey -> e (NKEY_, ' ', k, dhKey)
@@ -918,7 +981,11 @@ instance ProtocolEncoding Cmd where
  protocolP v = \case
    CT SRecipient tag ->
      Cmd SRecipient <$> case tag of
-        NEW_ -> NEW <$> _smpP <*> smpP
+        NEW_
+          | v >= 5 -> new <*> optional (A.char 'A' *> smpP)
+          | otherwise -> new <*> pure Nothing
+          where
+            new = NEW <$> _smpP <*> smpP
        SUB_ -> pure SUB
        KEY_ -> KEY <$> _smpP
        NKEY_ -> NKEY <$> _smpP <*> smpP
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -280,7 +280,7 @@ data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
 verifyTransmission :: Maybe C.ASignature -> ByteString -> QueueId -> Cmd -> M VerificationResult
 verifyTransmission sig_ signed queueId cmd = do
  case cmd of
-    Cmd SRecipient (NEW k _) -> pure $ Nothing `verified` verifyCmdSignature sig_ signed k
+    Cmd SRecipient (NEW k _ _) -> pure $ Nothing `verified` verifyCmdSignature sig_ signed k
    Cmd SRecipient _ -> verifyCmd SRecipient $ verifyCmdSignature sig_ signed . recipientKey
    Cmd SSender SEND {} -> verifyCmd SSender $ verifyMaybe . senderKey
    Cmd SSender PING -> pure $ VRVerified Nothing
@@ -323,7 +323,7 @@ dummyKeyEd448 :: C.PublicKey 'C.Ed448
 dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"

 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
-client clnt@Client {thVersion, sessionId, subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} =
+client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} =
  forever $
    atomically (readTBQueue rcvQ)
      >>= mapM processCommand
@@ -340,11 +340,15 @@ client clnt@Client {thVersion, sessionId, subscriptions, ntfSubscriptions, rcvQ,
        Cmd SNotifier NSUB -> subscribeNotifications
        Cmd SRecipient command ->
          case command of
-            NEW rKey dhKey ->
+            NEW rKey dhKey auth ->
              ifM
-                (asks $ allowNewQueues . config)
+                allowNew
                (createQueue st rKey dhKey)
                (pure (corrId, queueId, ERR AUTH))
+              where
+                allowNew = do
+                  ServerConfig {allowNewQueues, newQueueBasicAuth} <- asks config
+                  pure $ allowNewQueues && maybe True ((== auth) . Just) newQueueBasicAuth
            SUB -> withQueue (`subscribeQueue` queueId)
            GET -> withQueue getMessage
            ACK msgId -> withQueue (`acknowledgeMsg` msgId)
--- a/src/Simplex/Messaging/Server/CLI.hs
+++ b/src/Simplex/Messaging/Server/CLI.hs
@@ -15,6 +15,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Either (fromRight)
 import Data.Ini (Ini, lookupValue, readIniFile)
 import Data.Maybe (fromMaybe)
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (HostName, ServiceName)
@@ -236,12 +237,12 @@ mkIniOptions ini =
      enableWebsockets = (== "on") $ strictIni "TRANSPORT" "websockets" ini
    }

-strictIni :: String -> String -> Ini -> T.Text
+strictIni :: Text -> Text -> Ini -> Text
 strictIni section key ini =
-  fromRight (error ("no key " <> key <> " in section " <> section)) $
-    lookupValue (T.pack section) (T.pack key) ini
+  fromRight (error . T.unpack $ "no key " <> key <> " in section " <> section) $
+    lookupValue section key ini

-readStrictIni :: Read a => String -> String -> Ini -> a
+readStrictIni :: Read a => Text -> Text -> Ini -> a
 readStrictIni section key = read . T.unpack . strictIni section key

 runServer :: ServerCLIConfig cfg -> (cfg -> IO ()) -> Ini -> IO ()
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -46,6 +46,8 @@ data ServerConfig = ServerConfig
    storeMsgsFile :: Maybe FilePath,
    -- | set to False to prohibit creating new queues
    allowNewQueues :: Bool,
+    -- | simple password that the clients need to pass in handshake to be able to create new queues
+    newQueueBasicAuth :: Maybe BasicAuth,
    -- | time after which the messages can be removed from the queues and check interval, seconds
    messageExpiration :: Maybe ExpirationConfig,
    -- | time after which the socket with inactive client can be disconnected (without any messages or commands, incl. PING),
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -96,7 +96,7 @@ smpBlockSize :: Int
 smpBlockSize = 16384

 supportedSMPServerVRange :: VersionRange
-supportedSMPServerVRange = mkVersionRange 1 4
+supportedSMPServerVRange = mkVersionRange 1 5

 simplexMQVersion :: String
 simplexMQVersion = "3.4.0"
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -23,24 +24,26 @@ where

 import Control.Concurrent (killThread, threadDelay)
 import Control.Monad
-import Control.Monad.Except (ExceptT, runExceptT)
+import Control.Monad.Except (ExceptT, MonadError (throwError), runExceptT)
 import Control.Monad.IO.Unlift
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import qualified Data.Map as M
+import Data.Maybe (isNothing)
 import qualified Data.Set as S
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import SMPAgentClient
 import SMPClient (cfg, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
 import Simplex.Messaging.Agent
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..))
 import Simplex.Messaging.Agent.Protocol
-import Simplex.Messaging.Client (ProtocolClientConfig (..))
-import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
+import Simplex.Messaging.Client (ProtocolClientConfig (..), defaultClientConfig)
+import Simplex.Messaging.Protocol (BasicAuth, ErrorType (..), MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (ATransport (..))
+import Simplex.Messaging.Util (tryError)
 import Simplex.Messaging.Version
 import Test.Hspec
 import UnliftIO
@@ -127,6 +130,47 @@ functionalAPITests t = do
      testServerMatrix2 t testSwitchAsync
    describe "should delete connection during rotation" $
      testServerMatrix2 t testSwitchDelete
+  describe "SMP basic auth" $ do
+    describe "with server auth" $ do
+      --                                       allow NEW | server auth, v | clnt1 auth, v  | clnt2 auth, v    |  2 - success, 1 - JOIN fail, 0 - NEW fail
+      it "success                " $ testBasicAuth t True (Just "abcd", 5) (Just "abcd", 5) (Just "abcd", 5) `shouldReturn` 2
+      it "disabled               " $ testBasicAuth t False (Just "abcd", 5) (Just "abcd", 5) (Just "abcd", 5) `shouldReturn` 0
+      it "NEW fail, no auth      " $ testBasicAuth t True (Just "abcd", 5) (Nothing, 5) (Just "abcd", 5) `shouldReturn` 0
+      it "NEW fail, bad auth     " $ testBasicAuth t True (Just "abcd", 5) (Just "wrong", 5) (Just "abcd", 5) `shouldReturn` 0
+      it "NEW fail, version      " $ testBasicAuth t True (Just "abcd", 5) (Just "abcd", 4) (Just "abcd", 5) `shouldReturn` 0
+      it "JOIN fail, no auth     " $ testBasicAuth t True (Just "abcd", 5) (Just "abcd", 5) (Nothing, 5) `shouldReturn` 1
+      it "JOIN fail, bad auth    " $ testBasicAuth t True (Just "abcd", 5) (Just "abcd", 5) (Just "wrong", 5) `shouldReturn` 1
+      it "JOIN fail, version     " $ testBasicAuth t True (Just "abcd", 5) (Just "abcd", 5) (Just "abcd", 4) `shouldReturn` 1
+    describe "no server auth" $ do
+      it "success     " $ testBasicAuth t True (Nothing, 5) (Nothing, 5) (Nothing, 5) `shouldReturn` 2
+      it "srv disabled" $ testBasicAuth t False (Nothing, 5) (Nothing, 5) (Nothing, 5) `shouldReturn` 0
+      it "version srv " $ testBasicAuth t True (Nothing, 4) (Nothing, 5) (Nothing, 5) `shouldReturn` 2
+      it "version fst " $ testBasicAuth t True (Nothing, 5) (Nothing, 4) (Nothing, 5) `shouldReturn` 2
+      it "version snd " $ testBasicAuth t True (Nothing, 5) (Nothing, 5) (Nothing, 4) `shouldReturn` 2
+      it "version both" $ testBasicAuth t True (Nothing, 5) (Nothing, 4) (Nothing, 4) `shouldReturn` 2
+      it "version all " $ testBasicAuth t True (Nothing, 4) (Nothing, 4) (Nothing, 4) `shouldReturn` 2
+      it "auth fst    " $ testBasicAuth t True (Nothing, 5) (Just "abcd", 5) (Nothing, 5) `shouldReturn` 2
+      it "auth fst 2  " $ testBasicAuth t True (Nothing, 4) (Just "abcd", 5) (Nothing, 5) `shouldReturn` 2
+      it "auth snd    " $ testBasicAuth t True (Nothing, 5) (Nothing, 5) (Just "abcd", 5) `shouldReturn` 2
+      it "auth both   " $ testBasicAuth t True (Nothing, 5) (Just "abcd", 5) (Just "abcd", 5) `shouldReturn` 2
+      it "auth, disabled" $ testBasicAuth t False (Nothing, 5) (Just "abcd", 5) (Just "abcd", 5) `shouldReturn` 0
+
+testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> IO Int
+testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 = do
+  let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = mkVersionRange 4 srvVersion}
+      canCreate1 = canCreateQueue allowNewQueues srv clnt1
+      canCreate2 = canCreateQueue allowNewQueues srv clnt2
+      expected
+        | canCreate1 && canCreate2 = 2
+        | canCreate1 = 1
+        | otherwise = 0
+  created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth clnt1 clnt2
+  created `shouldBe` expected
+  pure created
+
+canCreateQueue :: Bool -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> Bool
+canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
+  allowNew && (isNothing srvAuth || (srvVersion == 5 && clntVersion == 5 && srvAuth == clntAuth))

 testMatrix2 :: ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 t runTest = do
@@ -741,6 +785,33 @@ testSwitchDelete servers = do
    liftIO $ bId `shouldBe` bId'
  pure ()

+testCreateQueueAuth :: (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> IO Int
+testCreateQueueAuth clnt1 clnt2 = do
+  a <- getClient clnt1
+  b <- getClient clnt2
+  Right created <- runExceptT $ do
+    tryError (createConnection a True SCMInvitation Nothing) >>= \case
+      Left (SMP AUTH) -> pure 0
+      Left e -> throwError e
+      Right (bId, qInfo) ->
+        tryError (joinConnection b True qInfo "bob's connInfo") >>= \case
+          Left (SMP AUTH) -> pure 1
+          Left e -> throwError e
+          Right aId -> do
+            ("", _, CONF confId _ "bob's connInfo") <- get a
+            allowConnection a bId confId "alice's connInfo"
+            get a ##> ("", bId, CON)
+            get b ##> ("", aId, INFO "alice's connInfo")
+            get b ##> ("", aId, CON)
+            exchangeGreetings a bId b aId
+            pure 2
+  pure created
+  where
+    getClient (clntAuth, clntVersion) =
+      let servers = initAgentServers {smp = [ProtoServerWithAuth testSMPServer clntAuth]}
+          smpCfg = (defaultClientConfig :: ProtocolClientConfig) {smpServerVRange = mkVersionRange 4 clntVersion}
+       in getSMPAgentClient agentCfg {smpCfg} servers
+
 exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetings = exchangeGreetingsMsgId 4

--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -174,13 +174,13 @@ testSMPServer2 = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5
 initAgentServers :: InitialAgentServers
 initAgentServers =
  InitialAgentServers
-    { smp = L.fromList [testSMPServer],
+    { smp = L.fromList [noAuthSrv testSMPServer],
      ntf = ["ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"],
      netCfg = defaultNetworkConfig {tcpTimeout = 500_000}
    }

 initAgentServers2 :: InitialAgentServers
-initAgentServers2 = initAgentServers {smp = L.fromList [testSMPServer, testSMPServer2]}
+initAgentServers2 = initAgentServers {smp = L.fromList [noAuthSrv testSMPServer, noAuthSrv testSMPServer2]}

 agentCfg :: AgentConfig
 agentCfg =
@@ -210,7 +210,7 @@ agentCfg =
 withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, AgentDatabase) -> m () -> (ThreadId -> m a) -> m a
 withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess =
  let cfg' = agentCfg {tcpPort = port', database = db'}
-      initServers' = initAgentServers {smp = L.fromList [SMPServer "localhost" smpPort' testKeyHash]}
+      initServers' = initAgentServers {smp = L.fromList [ProtoServerWithAuth (SMPServer "localhost" smpPort' testKeyHash) Nothing]}
   in serverBracket
        (\started -> runSMPAgentBlocking t started cfg' initServers')
        afterProcess
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -78,6 +78,7 @@ cfg =
      storeLogFile = Nothing,
      storeMsgsFile = Nothing,
      allowNewQueues = True,
+      newQueueBasicAuth = Nothing,
      messageExpiration = Just defaultMessageExpiration,
      inactiveClientExpiration = Just defaultInactiveClientExpiration,
      logStatsInterval = Nothing,
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -114,7 +114,7 @@ testCreateSecureV2 _ =
    withSmpServerConfigOn (transport @c) cfgV2 testPort $ \_ -> testSMPClient @c $ \h -> do
      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing)
      let dec = decryptMsgV2 $ C.dh' srvDh dhPriv
      (rId1, "") #== "creates queue"

@@ -178,7 +178,7 @@ testCreateSecure (ATransport t) =
    smpTest t $ \h -> do
      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing)
      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
      (rId1, "") #== "creates queue"

@@ -242,7 +242,7 @@ testCreateDelete (ATransport t) =
    smpTest2 t $ \rh sh -> do
      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd25519
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub)
+      Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing)
      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
      (rId1, "") #== "creates queue"

@@ -313,7 +313,7 @@ stressTest (ATransport t) =
      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd25519
      (dhPub, _ :: C.PrivateKeyX25519) <- C.generateKeyPair'
      rIds <- forM ([1 .. 50] :: [Int]) . const $ do
-        Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub)
+        Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub Nothing)
        pure rId
      let subscribeQueues h = forM_ rIds $ \rId -> do
            Resp "" rId' OK <- signSendRecv h rKey ("", rId, SUB)
@@ -330,7 +330,7 @@ testAllowNewQueues t =
      testSMPClient @c $ \h -> do
        (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
        (dhPub, _ :: C.PrivateKeyX25519) <- C.generateKeyPair'
-        Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
+        Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing)
        pure ()

 testDuplex :: ATransport -> Spec
@@ -339,7 +339,7 @@ testDuplex (ATransport t) =
    smpTest2 t $ \alice bob -> do
      (arPub, arKey) <- C.generateSignatureKeyPair C.SEd448
      (aDhPub, aDhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub)
+      Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub Nothing)
      let aDec = decryptMsgV3 $ C.dh' aSrvDh aDhPriv
      -- aSnd ID is passed to Bob out-of-band

@@ -355,7 +355,7 @@ testDuplex (ATransport t) =

      (brPub, brKey) <- C.generateSignatureKeyPair C.SEd448
      (bDhPub, bDhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub)
+      Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub Nothing)
      let bDec = decryptMsgV3 $ C.dh' bSrvDh bDhPriv
      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> encode bSnd)
      -- "reply_id ..." is ad-hoc, not a part of SMP protocol
@@ -393,7 +393,7 @@ testSwitchSub (ATransport t) =
    smpTest3 t $ \rh1 rh2 sh -> do
      (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub)
+      Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub Nothing)
      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
      Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, _SEND "test1")
      (ok1, OK) #== "sent test message 1"
@@ -716,7 +716,7 @@ createAndSecureQueue :: Transport c => THandle c -> SndPublicVerifyKey -> IO (Se
 createAndSecureQueue h sPub = do
  (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
  (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-  Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
+  Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing)
  let dhShared = C.dh' srvDh dhPriv
  Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, KEY sPub)
  (rId', rId) #== "same queue ID"
@@ -741,7 +741,7 @@ testTiming (ATransport t) =
    testSameTiming rh sh (goodKeySize, badKeySize, n) = do
      (rPub, rKey) <- generateKeys goodKeySize
      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair'
-      Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub)
+      Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing)
      let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
      Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, SUB)