From 323fb1f03ce4f1c3518e9215ce3d6f206b830ef3 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Thu, 16 Dec 2021 07:15:45 +0000 Subject: [PATCH] remove SMP server signing responses (#226) * remove SMP server signing responses * keep only one session ID --- apps/smp-server/Main.hs | 1 - migrations/20210101_initial.sql | 3 - migrations/20211215_rcv_dh_secret.sql | 1 + protocol/simplex-messaging.md | 11 +--- simplexmq.cabal | 1 + src/Simplex/Messaging/Agent.hs | 2 +- src/Simplex/Messaging/Agent/Client.hs | 9 +-- src/Simplex/Messaging/Agent/Protocol.hs | 7 +- src/Simplex/Messaging/Agent/Store.hs | 5 -- src/Simplex/Messaging/Agent/Store/SQLite.hs | 14 ++-- src/Simplex/Messaging/Client.hs | 16 ++--- src/Simplex/Messaging/Protocol.hs | 30 ++++----- src/Simplex/Messaging/Server.hs | 64 ++++++------------- src/Simplex/Messaging/Server/Env/STM.hs | 16 ++--- src/Simplex/Messaging/Server/QueueStore.hs | 10 ++- .../Messaging/Server/QueueStore/STM.hs | 12 ++-- src/Simplex/Messaging/Server/StoreLog.hs | 10 +-- src/Simplex/Messaging/Transport.hs | 12 +--- tests/AgentTests/ConnectionRequestTests.hs | 3 +- tests/AgentTests/SQLiteTests.hs | 7 -- tests/SMPClient.hs | 5 +- tests/ServerTests.hs | 9 +-- 22 files changed, 86 insertions(+), 162 deletions(-) create mode 100644 migrations/20211215_rcv_dh_secret.sql diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs index 9c04afed8..ecf7800ac 100644 --- a/apps/smp-server/Main.hs +++ b/apps/smp-server/Main.hs @@ -45,7 +45,6 @@ serverConfig = msgQueueQuota = 256, queueIdBytes = 24, msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20 - trnSignAlg = C.SignAlg C.SEd448, -- below parameters are set based on ini file /etc/opt/simplex/smp-server.ini transports = undefined, storeLog = undefined, diff --git a/migrations/20210101_initial.sql b/migrations/20210101_initial.sql index 1c89060cf..eb70363d0 100644 --- a/migrations/20210101_initial.sql +++ b/migrations/20210101_initial.sql @@ -11,11 +11,8 @@ CREATE TABLE IF NOT EXISTS rcv_queues( rcv_id BLOB NOT NULL, conn_alias BLOB NOT NULL, rcv_private_key BLOB NOT NULL, - rcv_srv_verify_key BLOB NOT NULL, - rcv_dh_secret BLOB NOT NULL, snd_id BLOB NOT NULL, snd_key BLOB, - snd_srv_verify_key BLOB NOT NULL, decrypt_key BLOB NOT NULL, verify_key BLOB, status TEXT NOT NULL, diff --git a/migrations/20211215_rcv_dh_secret.sql b/migrations/20211215_rcv_dh_secret.sql new file mode 100644 index 000000000..41cc6269c --- /dev/null +++ b/migrations/20211215_rcv_dh_secret.sql @@ -0,0 +1 @@ +ALTER TABLE rcv_queues ADD rcv_dh_secret BLOB; diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md index d4ea09208..70475d2cd 100644 --- a/protocol/simplex-messaging.md +++ b/protocol/simplex-messaging.md @@ -116,8 +116,7 @@ The SMP queue URIs MUST include server identity, queue hostname, an optional por The [ABNF][8] syntax of the queue URI is: ```abnf -queueURI = %s"smp://" smpServer "/" queueId "#" serverSignaturePublicKey -; serverSignaturePublicKey syntax is defined below +queueURI = %s"smp://" smpServer "/" queueId ["#"] smpServer = serverIdentity "@" srvHost [":" port] srvHost = ; RFC1123, RFC5891 port = 1*DIGIT @@ -426,11 +425,7 @@ x509encoded = If the queue is created successfully, the server must send `queueIds` response with the recipient's and sender's queue IDs and public keys to sign all responses and messages and to encrypt delivered message bodies: ```abnf -queueIds = %s"IDS" SP recipientId SP srvRcvPublicVerifyKey SP srvDhPublicKey - SP senderId SP srvSndPublicVerifyKey -srvRcvPublicVerifyKey = signatureKey -srvSndPublicVerifyKey = signatureKey -; the server's public keys to verify responses and messages for this queue +queueIds = %s"IDS" SP recipientId SP senderId SP srvDhPublicKey serverDhPublicKey = dhPublicKey ; the server's key for DH exchange to derive the secret ; that the server will use to encrypt delivered message bodies to the recipient @@ -442,7 +437,7 @@ Once the queue is created, the recipient gets automatically subscribed to receiv `NEW` transmission MUST be signed using the private part of the `recipientSignaturePublicKey` – this verifies that the client has the private key that will be used to sign subsequent commands for this queue. -`IDS` response transmission MUST be sent signed with `serverSignaturePublicKey` – this verifies that the server has the private key that will be used to sign subsequent responses and messages for this queue. This response should be sent with empty queue ID (the third part of the transmission). +`IDS` response transmission MUST be sent with empty queue ID (the third part of the transmission). #### Subscribe to queue diff --git a/simplexmq.cabal b/simplexmq.cabal index 4904f11b3..7b179f44f 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -30,6 +30,7 @@ extra-source-files: migrations/20210624_confirmations.sql migrations/20210809_snd_messages.sql migrations/20211202_connection_mode.sql + migrations/20211215_rcv_dh_secret.sql migrations/README.md library diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 7020d5517..4fb662da8 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -671,7 +671,7 @@ newSndQueue_ :: SMPQueueUri -> C.APublicEncryptKey -> m (SndQueue, SndPublicVerifyKey, C.APublicVerifyKey) -newSndQueue_ a (SMPQueueUri smpServer senderId _) encryptKey = do +newSndQueue_ a (SMPQueueUri smpServer senderId) encryptKey = do size <- asks $ rsaKeySize . config (senderKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair size a (verifyKey, signKey) <- liftIO $ C.generateSignatureKeyPair size C.SRSA diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 35434ef83..8e19be712 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -240,9 +240,8 @@ newRcvQueue_ a c srv = do (recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair size a (dhKey, privDhKey) <- liftIO $ C.generateKeyPair' 0 logServer "-->" c srv "" "NEW" - QIK {rcvId, rcvSrvVerifyKey, rcvPublicDHKey, sndId, sndSrvVerifyKey} <- + QIK {rcvId, sndId, rcvPublicDHKey} <- withSMP c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey dhKey - let rcvDhSecret = C.dh' rcvPublicDHKey privDhKey logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId] (encryptKey, decryptKey) <- liftIO $ C.generateEncryptionKeyPair size C.SRSA let rq = @@ -250,15 +249,13 @@ newRcvQueue_ a c srv = do { server = srv, rcvId, rcvPrivateKey, - rcvSrvVerifyKey, - rcvDhSecret, + rcvDhSecret = C.dh' rcvPublicDHKey privDhKey, sndId = Just sndId, - sndSrvVerifyKey, decryptKey, verifyKey = Nothing, status = New } - pure (rq, SMPQueueUri srv sndId sndSrvVerifyKey, encryptKey) + pure (rq, SMPQueueUri srv sndId, encryptKey) subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m () subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 10977ea19..7faef0f34 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -366,13 +366,13 @@ serializeAgentMessage = \case -- | Serialize SMP queue information that is sent out-of-band. serializeSMPQueueUri :: SMPQueueUri -> ByteString -serializeSMPQueueUri (SMPQueueUri srv qId _) = +serializeSMPQueueUri (SMPQueueUri srv qId) = serializeServerUri srv <> "/" <> U.encode qId <> "#" -- | SMP queue information parser. smpQueueUriP :: Parser SMPQueueUri smpQueueUriP = - SMPQueueUri <$> smpServerUriP <* "/" <*> base64UriP <* "#" <*> pure reservedServerKey + SMPQueueUri <$> smpServerUriP <* "/" <*> base64UriP <* optional "#" reservedServerKey :: C.APublicVerifyKey reservedServerKey = C.APublicVerifyKey C.SRSA (C.PublicKeyRSA $ R.PublicKey 1 0 0) @@ -497,8 +497,7 @@ newtype AckMode = AckMode OnOff deriving (Eq, Show) -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#out-of-band-messages data SMPQueueUri = SMPQueueUri { smpServer :: SMPServer, - senderId :: SMP.SenderId, - serverVerifyKey :: C.APublicVerifyKey + senderId :: SMP.SenderId } deriving (Eq, Show) diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index af6f4a379..b4bb62592 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -24,7 +24,6 @@ import Simplex.Messaging.Protocol MsgId, RcvDhSecret, RcvPrivateSignKey, - RcvPublicVerifyKey, SndPrivateSignKey, SndPublicVerifyKey, ) @@ -80,14 +79,10 @@ data RcvQueue = RcvQueue rcvId :: SMP.RecipientId, -- | key used by the recipient to sign transmissions rcvPrivateKey :: RcvPrivateSignKey, - -- | key used by the recipient to verify server transmissions - rcvSrvVerifyKey :: RcvPublicVerifyKey, -- | shared DH secret used to encrypt/decrypt message bodies from server to recipient rcvDhSecret :: RcvDhSecret, -- | sender queue ID sndId :: Maybe SMP.SenderId, - -- | key used by the sender to sign transmissions - sndSrvVerifyKey :: SndPublicVerifyKey, -- | TODO keys used for E2E encryption - these will change with double ratchet decryptKey :: C.APrivateDecryptKey, verifyKey :: Maybe C.APublicVerifyKey, diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 306bf8059..aab4111b6 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -625,19 +625,17 @@ insertRcvQueue_ dbConn connId RcvQueue {..} = do dbConn [sql| INSERT INTO rcv_queues - ( host, port, rcv_id, conn_alias, rcv_private_key, rcv_srv_verify_key, rcv_dh_secret, snd_id, snd_srv_verify_key, decrypt_key, verify_key, status) + ( host, port, rcv_id, conn_alias, rcv_private_key, rcv_dh_secret, snd_id, decrypt_key, verify_key, status) VALUES - (:host,:port,:rcv_id,:conn_alias,:rcv_private_key,:rcv_srv_verify_key,:rcv_dh_secret,:snd_id,:snd_srv_verify_key,:decrypt_key,:verify_key,:status); + (:host,:port,:rcv_id,:conn_alias,:rcv_private_key,:rcv_dh_secret,:snd_id,:decrypt_key,:verify_key,:status); |] [ ":host" := host server, ":port" := port_, ":rcv_id" := rcvId, ":conn_alias" := connId, ":rcv_private_key" := rcvPrivateKey, - ":rcv_srv_verify_key" := rcvSrvVerifyKey, ":rcv_dh_secret" := rcvDhSecret, ":snd_id" := sndId, - ":snd_srv_verify_key" := sndSrvVerifyKey, ":decrypt_key" := decryptKey, ":verify_key" := verifyKey, ":status" := status @@ -733,25 +731,23 @@ getRcvQueueByConnAlias_ dbConn connId = <$> DB.query dbConn [sql| - SELECT s.key_hash, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_srv_verify_key, q.rcv_dh_secret, - q.snd_id, q.snd_srv_verify_key, q.decrypt_key, q.verify_key, q.status + SELECT s.key_hash, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_dh_secret, + q.snd_id, q.decrypt_key, q.verify_key, q.status FROM rcv_queues q INNER JOIN servers s ON q.host = s.host AND q.port = s.port WHERE q.conn_alias = ?; |] (Only connId) where - rcvQueue [(keyHash, host, port, rcvId, rcvPrivateKey, rcvSrvVerifyKey, rcvDhSecret, sndId, sndSrvVerifyKey, decryptKey, verifyKey, status)] = + rcvQueue [(keyHash, host, port, rcvId, rcvPrivateKey, rcvDhSecret, sndId, decryptKey, verifyKey, status)] = let server = SMPServer host (deserializePort_ port) keyHash in Just $ RcvQueue { server, rcvId, rcvPrivateKey, - rcvSrvVerifyKey, rcvDhSecret, sndId, - sndSrvVerifyKey, decryptKey, verifyKey, status diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 81aae8d9a..ede7df968 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -64,7 +64,7 @@ import Numeric.Natural import Simplex.Messaging.Agent.Protocol (SMPServer (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Protocol -import Simplex.Messaging.Transport (ATransport (..), SessionId (..), THandle (..), TLS, TProxy, Transport (..), TransportError, clientHandshake, runTransportClient) +import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError, clientHandshake, runTransportClient) import Simplex.Messaging.Transport.WebSockets (WS) import Simplex.Messaging.Util (bshow, liftError, raceAny_) import System.Timeout (timeout) @@ -78,8 +78,7 @@ import System.Timeout (timeout) data SMPClient = SMPClient { action :: Async (), connected :: TVar Bool, - sndSessionId :: SessionId, - rcvSessionId :: SessionId, + sessionId :: ByteString, smpServer :: SMPServer, tcpTimeout :: Int, clientCorrId :: TVar Natural, @@ -149,8 +148,7 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock return SMPClient { action = undefined, - sndSessionId = undefined, - rcvSessionId = undefined, + sessionId = undefined, blockSize = undefined, connected, smpServer, @@ -171,8 +169,8 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock `finally` atomically (putTMVar thVar $ Left SMPNetworkError) bSize <- tcpTimeout `timeout` atomically (takeTMVar thVar) pure $ case bSize of - Just (Right THandle {sndSessionId, rcvSessionId, blockSize}) -> - Right c {action, sndSessionId, rcvSessionId, blockSize} + Just (Right THandle {sessionId, blockSize}) -> + Right c {action, sessionId, blockSize} Just (Left e) -> Left e Nothing -> Left SMPNetworkError @@ -347,9 +345,9 @@ okSMPCommand cmd c pKey qId = -- | Send any SMP command ('ClientCmd' type). sendSMPCommand :: SMPClient -> Maybe C.APrivateSignKey -> QueueId -> ClientCmd -> ExceptT SMPClientError IO (Command 'Broker) -sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, sndSessionId, tcpTimeout} pKey qId cmd = do +sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, sessionId, tcpTimeout} pKey qId cmd = do corrId <- lift_ getNextCorrId - t <- signTransmission $ serializeTransmission sndSessionId (corrId, qId, cmd) + t <- signTransmission $ serializeTransmission sessionId (corrId, qId, cmd) ExceptT $ sendRecv corrId t where lift_ :: STM a -> ExceptT SMPClientError IO a diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 5191987ac..aaa3accf2 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -96,7 +96,7 @@ import GHC.TypeLits (ErrorMessage (..), TypeError) import Generic.Random (genericArbitraryU) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Parsers -import Simplex.Messaging.Transport (SessionId (..), THandle (..), Transport, TransportError (..), tGetEncrypted, tPutEncrypted) +import Simplex.Messaging.Transport (THandle (..), Transport, TransportError (..), tGetEncrypted, tPutEncrypted) import Simplex.Messaging.Util import Test.QuickCheck (Arbitrary (..)) @@ -132,6 +132,8 @@ instance PartyI Notifier where sParty = SNotifier data ClientParty = forall p. IsClient p => CP (SParty p) +deriving instance Show ClientParty + -- | Type for command or response of any participant. data Cmd = forall p. PartyI p => Cmd (SParty p) (Command p) @@ -237,10 +239,8 @@ instance IsString CorrId where -- | Queue IDs and keys data QueueIdsKeys = QIK { rcvId :: RecipientId, - rcvSrvVerifyKey :: RcvPublicVerifyKey, - rcvPublicDHKey :: RcvPublicDhKey, sndId :: SenderId, - sndSrvVerifyKey :: SndPublicVerifyKey + rcvPublicDHKey :: RcvPublicDhKey } deriving (Eq, Show) @@ -358,13 +358,7 @@ instance CommandI Cmd where where newCmd = Cmd SRecipient <$> (NEW <$> C.strKeyP <* A.space <*> C.strKeyP) idsResp = Cmd SBroker . IDS <$> qik - qik = do - rcvId <- base64P <* A.space - rcvSrvVerifyKey <- C.strKeyP <* A.space - rcvPublicDHKey <- C.strKeyP <* A.space - sndId <- base64P <* A.space - sndSrvVerifyKey <- C.strKeyP - pure QIK {rcvId, rcvSrvVerifyKey, rcvPublicDHKey, sndId, sndSrvVerifyKey} + qik = QIK <$> base64P <* A.space <*> base64P <* A.space <*> C.strKeyP nIdsResp = Cmd SBroker . NID <$> base64P keyCmd = Cmd SRecipient . KEY <$> C.strKeyP nKeyCmd = Cmd SRecipient . NKEY <$> C.strKeyP @@ -411,8 +405,8 @@ instance PartyI p => CommandI (Command p) where NSUB -> "NSUB" MSG msgId ts msgBody -> B.unwords ["MSG", encode msgId, B.pack $ formatISO8601Millis ts, serializeBody msgBody] - IDS QIK {rcvId, rcvSrvVerifyKey = rsKey, rcvPublicDHKey = dhKey, sndId, sndSrvVerifyKey = ssKey} -> - B.unwords ["IDS", encode rcvId, C.serializeKey rsKey, C.serializeKey dhKey, encode sndId, C.serializeKey ssKey] + IDS (QIK rcvId sndId srvDh) -> + B.unwords ["IDS", encode rcvId, encode sndId, C.serializeKey srvDh] NID nId -> "NID " <> encode nId ERR err -> "ERR " <> serializeErrorType err NMSG -> "NMSG" @@ -435,9 +429,9 @@ serializeErrorType = bshow tPut :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ()) tPut th (sig, t) = tPutEncrypted th $ C.serializeSignature sig <> " " <> serializeBody t -serializeTransmission :: CommandI c => SessionId -> Transmission c -> ByteString -serializeTransmission (SessionId sessId) (CorrId corrId, queueId, command) = - B.unwords [sessId, corrId, encode queueId, serializeCommand command] +serializeTransmission :: CommandI c => ByteString -> Transmission c -> ByteString +serializeTransmission sessionId (CorrId corrId, queueId, command) = + B.unwords [sessionId, corrId, encode queueId, serializeCommand command] -- | Validate that it is an SMP client command, used with 'tGet' by 'Simplex.Messaging.Server'. fromClient :: Cmd -> Either ErrorType ClientCmd @@ -460,12 +454,12 @@ tGetParse th = (first (const TEBadBlock) . A.parseOnly transmissionP =<<) <$> tG -- The first argument is used to limit allowed senders. -- 'fromClient' or 'fromServer' should be used here. tGet :: forall c m cmd. (Transport c, MonadIO m) => (Cmd -> Either ErrorType cmd) -> THandle c -> m (SignedTransmission cmd) -tGet fromParty th@THandle {rcvSessionId} = liftIO (tGetParse th) >>= decodeParseValidate +tGet fromParty th@THandle {sessionId} = liftIO (tGetParse th) >>= decodeParseValidate where decodeParseValidate :: Either TransportError RawTransmission -> m (SignedTransmission cmd) decodeParseValidate = \case Right RawTransmission {signature, signed, sessId, corrId, queueId, command} - | SessionId sessId == rcvSessionId -> + | sessId == sessionId -> let decodedTransmission = liftM2 (,corrId,,command) (C.decodeSignature =<< decode signature) (decode queueId) in either (const $ tError corrId) (tParseValidate signed) decodedTransmission | otherwise -> pure (Nothing, "", (CorrId corrId, "", Left SESSION)) diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 815bb12ac..d922a5f15 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -106,7 +106,7 @@ runSMPServerBlocking started cfg@ServerConfig {transports} = do join <$> mapM (endPreviousSubscriptions qId) (M.lookup qId serverSubs) endPreviousSubscriptions :: QueueId -> Client -> STM (Maybe s) endPreviousSubscriptions qId c = do - writeTBQueue (sndQ c) (Just $ CP SRecipient, (CorrId "", qId, END)) + writeTBQueue (sndQ c) (CorrId "", qId, END) stateTVar (clientSubs c) $ \ss -> (M.lookup qId ss, M.delete qId ss) runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m () @@ -118,9 +118,9 @@ runClient _ h = do Left _ -> pure () runClientTransport :: (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> m () -runClientTransport th@THandle {sndSessionId} = do +runClientTransport th@THandle {sessionId} = do q <- asks $ tbqSize . config - c <- atomically $ newClient q sndSessionId + c <- atomically $ newClient q sessionId s <- asks server raceAny_ [send th c, client c s, receive th c] `finally` cancelSubscribers c @@ -138,41 +138,19 @@ receive :: (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> Cli receive th Client {rcvQ, sndQ} = forever $ do (sig, signed, (corrId, queueId, cmdOrError)) <- tGet fromClient th case cmdOrError of - Left e -> write sndQ (Nothing, (corrId, queueId, ERR e)) + Left e -> write sndQ (corrId, queueId, ERR e) Right cmd -> do verified <- verifyTransmission sig signed queueId cmd if verified then write rcvQ (corrId, queueId, cmd) - else write sndQ (Nothing, (corrId, queueId, ERR AUTH)) + else write sndQ (corrId, queueId, ERR AUTH) where write q t = atomically $ writeTBQueue q t -send :: (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> Client -> m () -send h Client {sndQ, sndSessionId} = forever $ do - atomically (readTBQueue sndQ) - >>= signTransmission sndSessionId - >>= liftIO . tPut h - -signTransmission :: - forall m. (MonadUnliftIO m, MonadReader Env m) => SessionId -> (Maybe ClientParty, BrokerTransmission) -> m SentRawTransmission -signTransmission sndSessionId (party_, t@(_, queueId, cmd)) = - case party_ of - Nothing -> unsigned - Just (CP SNotifier) -> unsigned - Just party -> - case cmd of - ERR QUOTA -> signed party - ERR _ -> unsigned - PONG -> unsigned - _ -> signed party - where - s = serializeTransmission sndSessionId t - unsigned = pure (Nothing, s) - signed :: ClientParty -> m SentRawTransmission - signed party = do - st <- asks queueStore - q <- atomically $ getQueue st party queueId - pure (Nothing, s) +send :: (Transport c, MonadUnliftIO m) => THandle c -> Client -> m () +send h Client {sndQ, sessionId} = forever $ do + t <- atomically $ readTBQueue sndQ + liftIO $ tPut h (Nothing, serializeTransmission sessionId t) verifyTransmission :: forall m. (MonadUnliftIO m, MonadReader Env m) => Maybe C.ASignature -> ByteString -> QueueId -> ClientCmd -> m Bool @@ -239,16 +217,17 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri >>= processCommand >>= atomically . writeTBQueue sndQ where - processCommand :: Transmission ClientCmd -> m (Maybe ClientParty, BrokerTransmission) + processCommand :: Transmission ClientCmd -> m BrokerTransmission processCommand (corrId, queueId, cmd) = do st <- asks queueStore case cmd of - ClientCmd SSender command -> case command of - SEND msgBody -> (Just $ CP SSender,) <$> sendMessage st msgBody - PING -> pure (Nothing, (corrId, queueId, PONG)) - ClientCmd SNotifier NSUB -> (Just $ CP SNotifier,) <$> subscribeNotifications + ClientCmd SSender command -> + case command of + SEND msgBody -> sendMessage st msgBody + PING -> pure (corrId, "", PONG) + ClientCmd SNotifier NSUB -> subscribeNotifications ClientCmd SRecipient command -> - (Just $ CP SRecipient,) <$> case command of + case command of NEW rKey dhKey -> createQueue st rKey dhKey SUB -> subscribeQueue queueId ACK -> acknowledgeMsg @@ -259,21 +238,16 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri where createQueue :: QueueStore -> RcvPublicVerifyKey -> RcvPublicDhKey -> m BrokerTransmission createQueue st recipientKey dhKey = checkKeySize recipientKey $ do - C.SignAlg a <- asks $ trnSignAlg . config (rcvPublicDHKey, privDhKey) <- liftIO $ C.generateKeyPair' 0 - (rcvSrvVerifyKey, rcvSrvSignKey) <- liftIO $ C.generateSignatureKeyPair 0 a - (sndSrvVerifyKey, sndSrvSignKey) <- liftIO $ C.generateSignatureKeyPair 0 a let rcvDhSecret = C.dh' dhKey privDhKey - qik (rcvId, sndId) = QIK {rcvId, rcvSrvVerifyKey, rcvPublicDHKey, sndId, sndSrvVerifyKey} + qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDHKey} qRec (recipientId, senderId) = QueueRec { recipientId, senderId, recipientKey, - rcvSrvSignKey, rcvDhSecret, senderKey = Nothing, - sndSrvSignKey, notifier = Nothing, status = QueueActive } @@ -401,7 +375,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri writeNtf :: NotifierId -> Client -> STM () writeNtf nId Client {sndQ = q} = unlessM (isFullTBQueue sndQ) $ - writeTBQueue q (Just $ CP SNotifier, (CorrId "", nId, NMSG)) + writeTBQueue q (CorrId "", nId, NMSG) deliverMessage :: (MsgQueue -> STM (Maybe Message)) -> RecipientId -> Sub -> m BrokerTransmission deliverMessage tryPeek rId = \case @@ -425,7 +399,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri subscriber :: MsgQueue -> m () subscriber q = atomically $ do msg <- peekMsg q - writeTBQueue sndQ (Just $ CP SRecipient, (CorrId "", rId, msgCmd msg)) + writeTBQueue sndQ (CorrId "", rId, msgCmd msg) setSub (\s -> s {subThread = NoSub}) void setDelivered diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index ff23c91ea..0783c88ca 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -8,6 +8,7 @@ module Simplex.Messaging.Server.Env.STM where import Control.Concurrent (ThreadId) import Control.Monad.IO.Unlift import Crypto.Random +import Data.ByteString.Char8 (ByteString) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Network.Socket (ServiceName) @@ -19,7 +20,7 @@ import Simplex.Messaging.Server.MsgStore.STM import Simplex.Messaging.Server.QueueStore (QueueRec (..)) import Simplex.Messaging.Server.QueueStore.STM import Simplex.Messaging.Server.StoreLog -import Simplex.Messaging.Transport (ATransport, SessionId, loadTLSServerParams) +import Simplex.Messaging.Transport (ATransport, loadTLSServerParams) import System.IO (IOMode (..)) import UnliftIO.STM @@ -33,8 +34,7 @@ data ServerConfig = ServerConfig blockSize :: Int, serverPrivateKey :: C.PrivateKey 'C.RSA, -- TODO delete serverPrivateKeyFile :: FilePath, - serverCertificateFile :: FilePath, - trnSignAlg :: C.SignAlg + serverCertificateFile :: FilePath } data Env = Env @@ -59,8 +59,8 @@ data Client = Client { subscriptions :: TVar (Map RecipientId Sub), ntfSubscriptions :: TVar (Map NotifierId ()), rcvQ :: TBQueue (Transmission ClientCmd), - sndQ :: TBQueue (Maybe ClientParty, BrokerTransmission), - sndSessionId :: SessionId + sndQ :: TBQueue BrokerTransmission, + sessionId :: ByteString } data SubscriptionThread = NoSub | SubPending | SubThread ThreadId @@ -78,13 +78,13 @@ newServer qSize = do notifiers <- newTVar M.empty return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers} -newClient :: Natural -> SessionId -> STM Client -newClient qSize sndSessionId = do +newClient :: Natural -> ByteString -> STM Client +newClient qSize sessionId = do subscriptions <- newTVar M.empty ntfSubscriptions <- newTVar M.empty rcvQ <- newTBQueue qSize sndQ <- newTBQueue qSize - return Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sndSessionId} + return Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} newSubscription :: STM Sub newSubscription = do diff --git a/src/Simplex/Messaging/Server/QueueStore.hs b/src/Simplex/Messaging/Server/QueueStore.hs index c93d52ed5..d95b0c430 100644 --- a/src/Simplex/Messaging/Server/QueueStore.hs +++ b/src/Simplex/Messaging/Server/QueueStore.hs @@ -8,22 +8,20 @@ import Simplex.Messaging.Protocol data QueueRec = QueueRec { recipientId :: RecipientId, - senderId :: SenderId, recipientKey :: RcvPublicVerifyKey, - rcvSrvSignKey :: RcvPrivateSignKey, rcvDhSecret :: RcvDhSecret, + senderId :: SenderId, senderKey :: Maybe SndPublicVerifyKey, - sndSrvSignKey :: SndPrivateSignKey, notifier :: Maybe (NotifierId, NtfPublicVerifyKey), status :: QueueStatus } -data QueueStatus = QueueActive | QueueOff deriving (Eq) +data QueueStatus = QueueActive | QueueOff deriving (Eq, Show) class MonadQueueStore s m where addQueue :: s -> QueueRec -> m (Either ErrorType ()) getQueue :: s -> ClientParty -> QueueId -> m (Either ErrorType QueueRec) - secureQueue :: s -> RecipientId -> SndPublicVerifyKey -> m (Either ErrorType ()) - addQueueNotifier :: s -> RecipientId -> NotifierId -> NtfPublicVerifyKey -> m (Either ErrorType ()) + secureQueue :: s -> RecipientId -> SndPublicVerifyKey -> m (Either ErrorType QueueRec) + addQueueNotifier :: s -> RecipientId -> NotifierId -> NtfPublicVerifyKey -> m (Either ErrorType QueueRec) suspendQueue :: s -> RecipientId -> m (Either ErrorType ()) deleteQueue :: s -> RecipientId -> m (Either ErrorType ()) diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs index d4d23aeef..d0d52b3fc 100644 --- a/src/Simplex/Messaging/Server/QueueStore/STM.hs +++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs @@ -59,14 +59,14 @@ instance MonadQueueStore QueueStore STM where Just rId -> getRcpQueue cs rId Nothing -> Left AUTH - secureQueue :: QueueStore -> RecipientId -> SndPublicVerifyKey -> STM (Either ErrorType ()) + secureQueue :: QueueStore -> RecipientId -> SndPublicVerifyKey -> STM (Either ErrorType QueueRec) secureQueue store rId sKey = updateQueues store rId $ \cs c -> case senderKey c of Just _ -> (Left AUTH, cs) - _ -> (Right (), cs {queues = M.insert rId c {senderKey = Just sKey} (queues cs)}) + _ -> (Right c, cs {queues = M.insert rId c {senderKey = Just sKey} (queues cs)}) - addQueueNotifier :: QueueStore -> RecipientId -> NotifierId -> NtfPublicVerifyKey -> STM (Either ErrorType ()) + addQueueNotifier :: QueueStore -> RecipientId -> NotifierId -> NtfPublicVerifyKey -> STM (Either ErrorType QueueRec) addQueueNotifier store rId nId nKey = do cs@QueueStoreData {queues, notifiers} <- readTVar store if M.member nId notifiers @@ -81,7 +81,7 @@ instance MonadQueueStore QueueStore STM where { queues = M.insert rId q {notifier = Just (nId, nKey)} queues, notifiers = M.insert nId rId notifiers } - pure $ Right () + pure $ Right q suspendQueue :: QueueStore -> RecipientId -> STM (Either ErrorType ()) suspendQueue store rId = @@ -101,8 +101,8 @@ instance MonadQueueStore QueueStore STM where updateQueues :: QueueStore -> RecipientId -> - (QueueStoreData -> QueueRec -> (Either ErrorType (), QueueStoreData)) -> - STM (Either ErrorType ()) + (QueueStoreData -> QueueRec -> (Either ErrorType a, QueueStoreData)) -> + STM (Either ErrorType a) updateQueues store rId update = do cs <- readTVar store let conn = getRcpQueue cs rId diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs index ecf16f726..05cb2be50 100644 --- a/src/Simplex/Messaging/Server/StoreLog.hs +++ b/src/Simplex/Messaging/Server/StoreLog.hs @@ -68,13 +68,11 @@ storeLogRecordP = queueRecP = do recipientId <- "rid=" *> base64P recipientKey <- " rk=" *> C.strKeyP - rcvSrvSignKey <- " rsk=" *> C.strKeyP rcvDhSecret <- " rdh=" *> C.strDhSecretP senderId <- " sid=" *> base64P senderKey <- " sk=" *> optional C.strKeyP - sndSrvSignKey <- " ssk=" *> C.strKeyP notifier <- optional $ (,) <$> (" nid=" *> base64P) <*> (" nk=" *> C.strKeyP) - pure QueueRec {recipientId, recipientKey, rcvSrvSignKey, rcvDhSecret, senderId, senderKey, sndSrvSignKey, notifier, status = QueueActive} + pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier, status = QueueActive} serializeStoreLogRecord :: StoreLogRecord -> ByteString serializeStoreLogRecord = \case @@ -84,15 +82,13 @@ serializeStoreLogRecord = \case DeleteQueue rId -> "DELETE " <> encode rId where serializeQueue - QueueRec {recipientId, recipientKey, rcvSrvSignKey, rcvDhSecret, senderId, senderKey, sndSrvSignKey, notifier} = + QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier} = B.unwords [ "rid=" <> encode recipientId, "rk=" <> C.serializeKey recipientKey, - "rsk=" <> C.serializeKey rcvSrvSignKey, "rdh=" <> C.serializeDhSecret rcvDhSecret, "sid=" <> encode senderId, - "sk=" <> maybe "" C.serializeKey senderKey, - "ssk=" <> C.serializeKey sndSrvSignKey + "sk=" <> maybe "" C.serializeKey senderKey ] <> maybe "" serializeNotifier notifier serializeNotifier (nId, nKey) = " nid=" <> encode nId <> " nk=" <> C.serializeKey nKey diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index 6d1b4067a..95ded7962 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -41,7 +41,6 @@ module Simplex.Messaging.Transport -- * SMP encrypted transport THandle (..), - SessionId (..), TransportError (..), serverHandshake, clientHandshake, @@ -328,16 +327,10 @@ smpVersionP = let ver = A.decimal <* A.char '.' in SMPVersion <$> ver <*> ver <*> ver <*> A.decimal --- | Session identifier (base64 encoded here, to avoid encoding every time it is sent) --- It should be set from TLS finished and passed in the initial handshake -newtype SessionId = SessionId {unSessionId :: ByteString} - deriving (Eq, Show) - -- | The handle for SMP encrypted transport connection over Transport . data THandle c = THandle { connection :: c, - sndSessionId :: SessionId, - rcvSessionId :: SessionId, + sessionId :: ByteString, sndKey :: SessionKey, rcvKey :: SessionKey, blockSize :: Int @@ -596,8 +589,7 @@ transportHandle c sk rk blockSize = do pure THandle { connection = c, - sndSessionId = SessionId "", - rcvSessionId = SessionId "", + sessionId = "", sndKey = sk {counter = sndCounter}, rcvKey = rk {counter = rcvCounter}, blockSize diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 82d9db2eb..53a7c58e5 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -24,8 +24,7 @@ queue :: SMPQueueUri queue = SMPQueueUri { smpServer = srv, - senderId = "\215m\248\251", - serverVerifyKey = reservedServerKey + senderId = "\215m\248\251" } appServer :: ConnReqScheme diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 4b4c8cf5c..f3969932b 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -152,9 +152,6 @@ cData1 = ConnData {connId = "conn1"} testPrivateSignKey :: C.APrivateSignKey testPrivateSignKey = C.APrivateSignKey C.SRSA testPrivateKey -testPublicVerifyKey :: C.APublicVerifyKey -testPublicVerifyKey = C.APublicVerifyKey C.SRSA testPublicKey - testPrivateDecryptKey :: C.APrivateDecryptKey testPrivateDecryptKey = C.APrivateDecryptKey C.SRSA testPrivateKey @@ -191,10 +188,8 @@ rcvQueue1 = { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, rcvId = "1234", rcvPrivateKey = testPrivateSignKey, - rcvSrvVerifyKey = testPublicVerifyKey, rcvDhSecret = testDhSecret, sndId = Just "2345", - sndSrvVerifyKey = testPublicVerifyKey, decryptKey = testPrivateDecryptKey, verifyKey = Nothing, status = New @@ -366,10 +361,8 @@ testUpgradeSndConnToDuplex = { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, rcvId = "3456", rcvPrivateKey = testPrivateSignKey, - rcvSrvVerifyKey = testPublicVerifyKey, rcvDhSecret = testDhSecret, sndId = Just "4567", - sndSrvVerifyKey = testPublicVerifyKey, decryptKey = testPrivateDecryptKey, verifyKey = Nothing, status = New diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index 1fe634227..9b4221c86 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -64,7 +64,6 @@ cfg = msgQueueQuota = 4, queueIdBytes = 24, msgIdBytes = 24, - trnSignAlg = C.SignAlg C.SEd448, storeLog = Nothing, blockSize = 8192, serverPrivateKey = @@ -172,8 +171,8 @@ smpTest4 _ test' = smpTestN 4 _test _test _ = error "expected 4 handles" tPutRaw :: Transport c => THandle c -> SignedRawTransmission -> IO () -tPutRaw h@THandle {sndSessionId = SessionId sessId} (sig, corrId, queueId, command) = do - let t = B.unwords [sessId, corrId, queueId, command] +tPutRaw h@THandle {sessionId} (sig, corrId, queueId, command) = do + let t = B.unwords [sessionId, corrId, queueId, command] void $ tPut h (sig, t) tGetRaw :: Transport c => THandle c -> IO SignedRawTransmission diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 120e575cb..5131757c2 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -41,18 +42,18 @@ serverTests t = do describe "Message notifications" $ testMessageNotifications t pattern Resp :: CorrId -> QueueId -> Command 'Broker -> SignedTransmission (Command 'Broker) -pattern Resp corrId queueId command <- ("", _, (corrId, queueId, Right command)) +pattern Resp corrId queueId command <- (_, _, (corrId, queueId, Right command)) pattern Ids :: RecipientId -> SenderId -> RcvPublicDhKey -> Command 'Broker -pattern Ids rId sId srvDh <- IDS (QIK rId _ srvDh sId _) +pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh) sendRecv :: Transport c => THandle c -> (Maybe C.ASignature, ByteString, ByteString, ByteString) -> IO (SignedTransmission (Command 'Broker)) sendRecv h (sgn, corrId, qId, cmd) = tPutRaw h (sgn, corrId, encode qId, cmd) >> tGet fromServer h signSendRecv :: Transport c => THandle c -> C.APrivateSignKey -> (ByteString, ByteString, ByteString) -> IO (SignedTransmission (Command 'Broker)) -signSendRecv h@THandle {sndSessionId = SessionId sessId} pk (corrId, qId, cmd) = do - let t = B.intercalate " " [sessId, corrId, encode qId, cmd] +signSendRecv h@THandle {sessionId} pk (corrId, qId, cmd) = do + let t = B.intercalate " " [sessionId, corrId, encode qId, cmd] Right sig <- runExceptT $ C.sign pk t _ <- tPut h (Just sig, t) tGet fromServer h