simple per-queue e2e encryption with NaCl crypto_box (#242)

* simple per-queue e2e encryption with NaCl crypto_box

* add e2e keys and DH secrets to schema

* agree and save shared DH secret per queue (not used yet)

* protocol changes for uniform padding and message part lengths

* correct message structure diagrams

* make per-queue E2E encryption non-optional

* refactor crypto keys

* use NaCl crypto_box for per-queue E2E encryption, remove RSA keys from queues

* remove RSA support

* merge migration with E2E DH keys

* clean up

* remove unused methods

* parsing/serializing agent messages

* remove sender timestamp from DB and code

* clean up

* slean up

* s/SMPConfMsg/SMPConfirmation/

* serializeAgentMessage = serializeClientMessage . agentToClientMsg

* simplify error handling

* update protocol docs

src/Simplex/Messaging/Agent.hs

@@ -62,7 +62,7 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
-import Data.Bifunctor (first, second)
+import Data.Bifunctor (second)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:), (.:.))
@@ -83,7 +83,8 @@ import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
 import Simplex.Messaging.Client (SMPServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (MsgBody, SndPublicVerifyKey)
+import Simplex.Messaging.Parsers (parse)
+import Simplex.Messaging.Protocol (MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), currentSMPVersionStr, loadTLSServerParams, runTransportServer)
 import Simplex.Messaging.Util (bshow, tryError, unlessM)
@@ -265,50 +266,50 @@ processCommand c (connId, cmd) = case cmd of
 newConn :: AgentMonad m => AgentClient -> ConnId -> SConnectionMode c -> m (ConnId, ConnectionRequest c)
 newConn c connId cMode = do
   srv <- getSMPServer
-  (rq, qUri, encryptKey) <- newRcvQueue c srv
+  (rq, qUri) <- newRcvQueue c srv
   g <- asks idsDrg
   let cData = ConnData {connId}
   connId' <- withStore $ \st -> createRcvConn st g cData rq cMode
   addSubscription c rq connId'
-  let crData = ConnReqData simplexChat [qUri] encryptKey
+  let crData = ConnReqData simplexChat [qUri] ConnectionEncryption
   pure . (connId',) $ case cMode of
     SCMInvitation -> CRInvitation crData
     SCMContact -> CRContact crData
 
 joinConn :: AgentMonad m => AgentClient -> ConnId -> ConnectionRequest c -> ConnInfo -> m ConnId
-joinConn c connId (CRInvitation (ConnReqData _ (qUri :| _) encryptKey)) cInfo = do
-  (sq, senderKey, verifyKey) <- newSndQueue qUri encryptKey
+joinConn c connId (CRInvitation (ConnReqData _ (qUri :| _) _)) cInfo = do
+  (sq, smpConf) <- newSndQueue qUri cInfo
   g <- asks idsDrg
   cfg <- asks config
   let cData = ConnData {connId}
   connId' <- withStore $ \st -> createSndConn st g cData sq
-  confirmQueue c sq senderKey cInfo
-  activateQueueJoining c connId' sq verifyKey $ retryInterval cfg
+  confirmQueue c sq smpConf
+  activateQueueJoining c connId' sq $ retryInterval cfg
   pure connId'
-joinConn c connId (CRContact (ConnReqData _ (qUri :| _) encryptKey)) cInfo = do
+joinConn c connId (CRContact (ConnReqData _ (qUri :| _) _)) cInfo = do
   (connId', cReq) <- newConn c connId SCMInvitation
-  sendInvitation c qUri encryptKey cReq cInfo
+  sendInvitation c qUri cReq cInfo
   pure connId'
 
-activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m ()
-activateQueueJoining c connId sq verifyKey retryInterval =
-  activateQueue c connId sq verifyKey retryInterval createReplyQueue
+activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> RetryInterval -> m ()
+activateQueueJoining c connId sq retryInterval =
+  activateQueue c connId sq retryInterval createReplyQueue
   where
     createReplyQueue :: m ()
     createReplyQueue = do
       srv <- getSMPServer
-      (rq, qUri', encryptKey) <- newRcvQueue c srv
+      (rq, qUri') <- newRcvQueue c srv
       addSubscription c rq connId
       withStore $ \st -> upgradeSndConnToDuplex st connId rq
-      sendControlMessage c sq . REPLY $ CRInvitation $ ConnReqData CRSSimplex [qUri'] encryptKey
+      sendControlMessage c sq . REPLY $ CRInvitation $ ConnReqData CRSSimplex [qUri'] ConnectionEncryption
 
 -- | Approve confirmation (LET command) in Reader monad
 allowConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
 allowConnection' c connId confId ownConnInfo = do
   withStore (`getConn` connId) >>= \case
     SomeConn _ (RcvConnection _ rq) -> do
-      AcceptedConfirmation {senderKey} <- withStore $ \st -> acceptConfirmation st confId ownConnInfo
-      processConfirmation c rq senderKey
+      AcceptedConfirmation {senderConf} <- withStore $ \st -> acceptConfirmation st confId ownConnInfo
+      processConfirmation c rq senderConf
     _ -> throwError $ CMD PROHIBITED
 
 -- | Accept contact (ACPT command) in Reader monad
@@ -326,10 +327,11 @@ rejectContact' :: AgentMonad m => AgentClient -> ConnId -> InvitationId -> m ()
 rejectContact' _ contactConnId invId =
   withStore $ \st -> deleteInvitation st contactConnId invId
 
-processConfirmation :: AgentMonad m => AgentClient -> RcvQueue -> SndPublicVerifyKey -> m ()
-processConfirmation c rq sndKey = do
-  withStore $ \st -> setRcvQueueStatus st rq Confirmed
-  secureQueue c rq sndKey
+processConfirmation :: AgentMonad m => AgentClient -> RcvQueue -> SMPConfirmation -> m ()
+processConfirmation c rq@RcvQueue {e2ePrivKey} SMPConfirmation {senderKey, e2ePubKey} = do
+  let dhSecret = C.dh' e2ePubKey e2ePrivKey
+  withStore $ \st -> setRcvQueueConfirmedE2E st rq e2ePubKey dhSecret
+  secureQueue c rq senderKey
   withStore $ \st -> setRcvQueueStatus st rq Secured
 
 -- | Subscribe to receive connection messages (SUB command) in Reader monad
@@ -340,8 +342,9 @@ subscribeConnection' c connId =
       resumeMsgDelivery c connId sq
       case status (sq :: SndQueue) of
         Confirmed -> do
-          conf <- withStore (`getAcceptedConfirmation` connId)
-          secureQueue c rq $ senderKey (conf :: AcceptedConfirmation)
+          AcceptedConfirmation {senderConf = SMPConfirmation {senderKey}} <-
+            withStore (`getAcceptedConfirmation` connId)
+          secureQueue c rq senderKey
           withStore $ \st -> setRcvQueueStatus st rq Secured
           activateSecuredQueue rq sq
         Secured -> activateSecuredQueue rq sq
@@ -350,17 +353,15 @@ subscribeConnection' c connId =
     SomeConn _ (SndConnection _ sq) -> do
       resumeMsgDelivery c connId sq
       case status (sq :: SndQueue) of
-        Confirmed -> activateQueueJoining c connId sq (verifyKey sq) =<< resumeInterval
+        Confirmed -> activateQueueJoining c connId sq =<< resumeInterval
         Active -> throwError $ CONN SIMPLEX
         _ -> throwError $ INTERNAL "unexpected queue status"
     SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId
     SomeConn _ (ContactConnection _ rq) -> subscribeQueue c rq connId
   where
-    verifyKey :: SndQueue -> C.APublicVerifyKey
-    verifyKey = C.publicKey . signKey
     activateSecuredQueue :: RcvQueue -> SndQueue -> m ()
     activateSecuredQueue rq sq = do
-      activateQueueInitiating c connId sq (verifyKey sq) =<< resumeInterval
+      activateQueueInitiating c connId sq =<< resumeInterval
       subscribeQueue c rq connId
     resumeInterval :: m RetryInterval
     resumeInterval = do
@@ -386,15 +387,10 @@ sendMessage' c connId msg =
         storeSentMsg = do
           internalTs <- liftIO getCurrentTime
           withStore $ \st -> do
-            (internalId, internalSndId, previousMsgHash) <- updateSndIds st connId
+            (internalId, internalSndId, prevMsgHash) <- updateSndIds st connId
             let msgBody =
-                  serializeSMPMessage
-                    SMPMessage
-                      { senderMsgId = unSndId internalSndId,
-                        senderTimestamp = internalTs,
-                        previousMsgHash,
-                        agentMessage = A_MSG msg
-                      }
+                  serializeAgentMessage $
+                    AgentMessage (AHeader (unSndId internalSndId) prevMsgHash) (A_MSG msg)
                 internalHash = C.sha256Hash msgBody
                 msgData = SndMsgData {..}
             createSndMsg st connId msgData
@@ -505,14 +501,8 @@ getSMPServer =
 
 sendControlMessage :: AgentMonad m => AgentClient -> SndQueue -> AMessage -> m ()
 sendControlMessage c sq agentMessage = do
-  senderTimestamp <- liftIO getCurrentTime
-  sendAgentMessage c sq . serializeSMPMessage $
-    SMPMessage
-      { senderMsgId = 0,
-        senderTimestamp,
-        previousMsgHash = "",
-        agentMessage
-      }
+  sendAgentMessage c sq . serializeAgentMessage $
+    AgentMessage (AHeader 0 "") agentMessage
 
 subscriber :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
 subscriber c@AgentClient {msgQ} = forever $ do
@@ -530,22 +520,39 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
     _ -> atomically $ writeTBQueue subQ ("", "", ERR $ CONN NOT_FOUND)
   where
     processSMP :: SConnType c -> ConnData -> RcvQueue -> m ()
-    processSMP cType ConnData {connId} rq@RcvQueue {rcvDhSecret, status} =
+    processSMP cType ConnData {connId} rq@RcvQueue {rcvDhSecret, e2ePrivKey, e2eShared, status} =
       case cmd of
-        SMP.MSG srvMsgId srvTs msgBody' -> do
+        SMP.MSG srvMsgId srvTs msgBody' -> handleNotifyAck $ do
           -- TODO deduplicate with previously received
-          msgBody <- liftEither . first cryptoError $ C.cbDecrypt rcvDhSecret (C.cbNonce srvMsgId) msgBody'
-          msg <- decryptAndVerify rq msgBody
-          let msgHash = C.sha256Hash msg
-          case parseSMPMessage msg of
-            Left e -> notify (ERR e) >> sendAck c rq
-            Right (SMPConfirmation senderKey cInfo) -> smpConfirmation senderKey cInfo >> sendAck c rq
-            Right SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} ->
+          msgBody <- agentCbDecrypt rcvDhSecret (C.cbNonce srvMsgId) msgBody'
+          encMessage@SMP.EncMessage {emHeader = SMP.PubHeader v e2ePubKey} <-
+            liftEither $ parse SMP.encMessageP (AGENT A_MESSAGE) msgBody
+          case e2eShared of
+            Nothing -> do
+              let e2eDhSecret = C.dh' e2ePubKey e2ePrivKey
+              (_, agentMessage) <-
+                decryptAgentMessage e2eDhSecret encMessage
               case agentMessage of
-                HELLO verifyKey _ -> helloMsg verifyKey msgBody >> sendAck c rq
-                REPLY cReq -> replyMsg cReq >> sendAck c rq
-                A_MSG body -> agentClientMsg previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash
-                A_INV cReq cInfo -> smpInvitation cReq cInfo >> sendAck c rq
+                AgentConfirmation senderKey connInfo -> do
+                  smpConfirmation SMPConfirmation {senderKey, e2ePubKey, connInfo}
+                  ack
+                AgentInvitation cReq cInfo -> smpInvitation cReq cInfo >> ack
+                _ -> prohibited >> ack
+            Just (e2eSndPubKey, e2eDhSecret)
+              | e2eSndPubKey /= e2ePubKey -> prohibited >> ack
+              | otherwise -> do
+                (msg, agentMessage) <-
+                  decryptAgentMessage e2eDhSecret encMessage
+                case agentMessage of
+                  AgentMessage AHeader {sndMsgId, prevMsgHash} aMsg -> case aMsg of
+                    HELLO -> helloMsg >> ack
+                    REPLY cReq -> replyMsg cReq >> ack
+                    A_MSG body -> do
+                      -- note that there is no ACK sent here, it is sent with agent's user ACK command
+                      -- TODO add hash to other messages
+                      let msgHash = C.sha256Hash msg
+                      agentClientMsg prevMsgHash sndMsgId (srvMsgId, srvTs) body msgHash
+                  _ -> prohibited >> ack
         SMP.END -> do
           removeSubscription c connId
           logServer "<--" c srv rId "END"
@@ -557,60 +564,72 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
         notify :: ACommand 'Agent -> m ()
         notify msg = atomically $ writeTBQueue subQ ("", connId, msg)
 
+        handleNotifyAck :: m () -> m ()
+        handleNotifyAck m = m `catchError` \e -> notify (ERR e) >> ack
+
         prohibited :: m ()
         prohibited = notify . ERR $ AGENT A_PROHIBITED
 
-        smpConfirmation :: SndPublicVerifyKey -> ConnInfo -> m ()
-        smpConfirmation senderKey cInfo = do
+        ack :: m ()
+        ack = sendAck c rq
+
+        decryptAgentMessage :: C.DhSecretX25519 -> SMP.EncMessage -> m (ByteString, AgentMessage)
+        decryptAgentMessage e2eDhSecret SMP.EncMessage {emNonce, emBody} = do
+          msg <- agentCbDecrypt e2eDhSecret emNonce emBody
+          agentMessage <-
+            liftEither $ clientToAgentMsg =<< parse SMP.clientMessageP (AGENT A_MESSAGE) msg
+          pure (msg, agentMessage)
+
+        smpConfirmation :: SMPConfirmation -> m ()
+        smpConfirmation senderConf@SMPConfirmation {connInfo} = do
           logServer "<--" c srv rId "MSG <KEY>"
           case status of
             New -> case cType of
               SCRcv -> do
                 g <- asks idsDrg
-                let newConfirmation = NewConfirmation {connId, senderKey, senderConnInfo = cInfo}
+                let newConfirmation = NewConfirmation {connId, senderConf}
                 confId <- withStore $ \st -> createConfirmation st g newConfirmation
-                notify $ CONF confId cInfo
+                notify $ CONF confId connInfo
               SCDuplex -> do
-                notify $ INFO cInfo
-                processConfirmation c rq senderKey
+                notify $ INFO connInfo
+                processConfirmation c rq senderConf
               _ -> prohibited
             _ -> prohibited
 
-        helloMsg :: SndPublicVerifyKey -> ByteString -> m ()
-        helloMsg verifyKey msgBody = do
+        helloMsg :: m ()
+        helloMsg = do
           logServer "<--" c srv rId "MSG <HELLO>"
           case status of
             Active -> prohibited
             _ -> do
-              void $ verifyMessage (Just verifyKey) msgBody
-              withStore $ \st -> setRcvQueueActive st rq verifyKey
+              withStore $ \st -> setRcvQueueStatus st rq Active
               case cType of
                 SCDuplex -> notifyConnected c connId
                 _ -> pure ()
 
         replyMsg :: ConnectionRequest 'CMInvitation -> m ()
-        replyMsg (CRInvitation (ConnReqData _ (qUri :| _) encryptKey)) = do
+        replyMsg (CRInvitation (ConnReqData _ (qUri :| _) _)) = do
           logServer "<--" c srv rId "MSG <REPLY>"
           case cType of
             SCRcv -> do
               AcceptedConfirmation {ownConnInfo} <- withStore (`getAcceptedConfirmation` connId)
-              (sq, senderKey, verifyKey) <- newSndQueue qUri encryptKey
+              (sq, smpConf) <- newSndQueue qUri ownConnInfo
               withStore $ \st -> upgradeRcvConnToDuplex st connId sq
-              confirmQueue c sq senderKey ownConnInfo
+              confirmQueue c sq smpConf
               withStore (`removeConfirmations` connId)
               cfg <- asks config
-              activateQueueInitiating c connId sq verifyKey $ retryInterval cfg
+              activateQueueInitiating c connId sq $ retryInterval cfg
             _ -> prohibited
 
-        agentClientMsg :: PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m ()
-        agentClientMsg externalPrevSndHash sender broker msgBody internalHash = do
+        agentClientMsg :: PrevRcvMsgHash -> ExternalSndId -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m ()
+        agentClientMsg externalPrevSndHash sndMsgId broker msgBody internalHash = do
           logServer "<--" c srv rId "MSG <MSG>"
           internalTs <- liftIO getCurrentTime
           (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore (`updateRcvIds` connId)
-          let integrity = checkMsgIntegrity prevExtSndId (fst sender) prevRcvMsgHash externalPrevSndHash
+          let integrity = checkMsgIntegrity prevExtSndId sndMsgId prevRcvMsgHash externalPrevSndHash
               recipient = (unId internalId, internalTs)
-              msgMeta = MsgMeta {integrity, recipient, sender, broker}
-              rcvMsg = RcvMsgData {..}
+              msgMeta = MsgMeta {integrity, recipient, broker, sndMsgId}
+              rcvMsg = RcvMsgData {msgMeta, msgBody, internalRcvId, internalHash, externalPrevSndHash}
           withStore $ \st -> createRcvMsg st connId rcvMsg
           notify $ MSG msgMeta msgBody
 
@@ -634,24 +653,24 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
           | internalPrevMsgHash /= receivedPrevMsgHash = MsgError MsgBadHash
           | otherwise = MsgError MsgDuplicate -- this case is not possible
 
-confirmQueue :: AgentMonad m => AgentClient -> SndQueue -> SndPublicVerifyKey -> ConnInfo -> m ()
-confirmQueue c sq senderKey cInfo = do
-  sendConfirmation c sq senderKey cInfo
+confirmQueue :: AgentMonad m => AgentClient -> SndQueue -> SMPConfirmation -> m ()
+confirmQueue c sq smpConf = do
+  sendConfirmation c sq smpConf
   withStore $ \st -> setSndQueueStatus st sq Confirmed
 
-activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m ()
-activateQueueInitiating c connId sq verifyKey retryInterval =
-  activateQueue c connId sq verifyKey retryInterval $ notifyConnected c connId
+activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> RetryInterval -> m ()
+activateQueueInitiating c connId sq retryInterval =
+  activateQueue c connId sq retryInterval $ notifyConnected c connId
 
-activateQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m () -> m ()
-activateQueue c connId sq verifyKey retryInterval afterActivation =
+activateQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> RetryInterval -> m () -> m ()
+activateQueue c connId sq retryInterval afterActivation =
   getActivation c connId >>= \case
     Nothing -> async runActivation >>= addActivation c connId
     Just _ -> pure ()
   where
     runActivation :: m ()
     runActivation = do
-      sendHello c sq verifyKey retryInterval
+      sendHello c sq retryInterval
       withStore $ \st -> setSndQueueStatus st sq Active
       removeActivation c connId
       afterActivation
@@ -659,29 +678,27 @@ activateQueue c connId sq verifyKey retryInterval afterActivation =
 notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m ()
 notifyConnected c connId = atomically $ writeTBQueue (subQ c) ("", connId, CON)
 
-newSndQueue ::
-  (MonadUnliftIO m, MonadReader Env m) => SMPQueueUri -> C.APublicEncryptKey -> m (SndQueue, SndPublicVerifyKey, C.APublicVerifyKey)
-newSndQueue qUri encryptKey =
+newSndQueue :: (MonadUnliftIO m, MonadReader Env m) => SMPQueueUri -> ConnInfo -> m (SndQueue, SMPConfirmation)
+newSndQueue qUri cInfo =
   asks (cmdSignAlg . config) >>= \case
-    C.SignAlg a -> newSndQueue_ a qUri encryptKey
+    C.SignAlg a -> newSndQueue_ a qUri cInfo
 
 newSndQueue_ ::
-  (C.SignatureAlgorithm a, C.AlgorithmI a, MonadUnliftIO m, MonadReader Env m) =>
+  (C.SignatureAlgorithm a, C.AlgorithmI a, MonadUnliftIO m) =>
   C.SAlgorithm a ->
   SMPQueueUri ->
-  C.APublicEncryptKey ->
-  m (SndQueue, SndPublicVerifyKey, C.APublicVerifyKey)
-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
+  ConnInfo ->
+  m (SndQueue, SMPConfirmation)
+newSndQueue_ a (SMPQueueUri smpServer senderId rcvE2ePubDhKey) cInfo = do
+  (senderKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
+  (e2ePubKey, e2ePrivKey) <- liftIO C.generateKeyPair'
   let sndQueue =
         SndQueue
           { server = smpServer,
             sndId = senderId,
             sndPrivateKey,
-            encryptKey,
-            signKey,
+            e2ePubKey,
+            e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
             status = New
           }
-  return (sndQueue, senderKey, verifyKey)
+  pure (sndQueue, SMPConfirmation senderKey e2ePubKey cInfo)

src/Simplex/Messaging/Agent/Client.hs

@@ -22,14 +22,12 @@ module Simplex.Messaging.Agent.Client
     sendHello,
     secureQueue,
     sendAgentMessage,
-    decryptAndVerify,
-    verifyMessage,
+    agentCbDecrypt,
     sendAck,
     suspendQueue,
     deleteQueue,
     logServer,
     removeSubscription,
-    cryptoError,
     addActivation,
     getActivation,
     removeActivation,
@@ -43,6 +41,7 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Control.Monad.Trans.Except
+import Data.Bifunctor (first)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -52,7 +51,6 @@ import Data.Maybe (isNothing)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text.Encoding
-import Data.Time.Clock
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
@@ -60,6 +58,7 @@ import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgBody, QueueId, QueueIdsKeys (..), SndPublicVerifyKey)
+import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Util (bshow, liftEitherError, liftError)
 import UnliftIO.Exception (IOException)
 import qualified UnliftIO.Exception as E
@@ -224,7 +223,7 @@ smpClientError = \case
   SMPTransportError e -> BROKER $ TRANSPORT e
   e -> INTERNAL $ show e
 
-newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri, C.APublicEncryptKey)
+newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri)
 newRcvQueue c srv =
   asks (cmdSignAlg . config) >>= \case
     C.SignAlg a -> newRcvQueue_ a c srv
@@ -234,28 +233,27 @@ newRcvQueue_ ::
   C.SAlgorithm a ->
   AgentClient ->
   SMPServer ->
-  m (RcvQueue, SMPQueueUri, C.APublicEncryptKey)
+  m (RcvQueue, SMPQueueUri)
 newRcvQueue_ a c srv = do
-  size <- asks $ rsaKeySize . config
-  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair size a
-  (dhKey, privDhKey) <- liftIO $ C.generateKeyPair' 0
+  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
+  (dhKey, privDhKey) <- liftIO C.generateKeyPair'
+  (e2eDhKey, e2ePrivKey) <- liftIO C.generateKeyPair'
   logServer "-->" c srv "" "NEW"
-  QIK {rcvId, sndId, rcvPublicDHKey} <-
+  QIK {rcvId, sndId, rcvPublicDhKey} <-
     withSMP c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey dhKey
   logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
-  (encryptKey, decryptKey) <- liftIO $ C.generateEncryptionKeyPair size C.SRSA
   let rq =
         RcvQueue
           { server = srv,
             rcvId,
             rcvPrivateKey,
-            rcvDhSecret = C.dh' rcvPublicDHKey privDhKey,
+            rcvDhSecret = C.dh' rcvPublicDhKey privDhKey,
+            e2ePrivKey,
+            e2eShared = Nothing,
             sndId = Just sndId,
-            decryptKey,
-            verifyKey = Nothing,
             status = New
           }
-  pure (rq, SMPQueueUri srv sndId, encryptKey)
+  pure (rq, SMPQueueUri srv sndId e2eDhKey)
 
 subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
 subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do
@@ -304,51 +302,41 @@ showServer srv = B.pack $ host srv <> maybe "" (":" <>) (port srv)
 logSecret :: ByteString -> ByteString
 logSecret bs = encode $ B.take 3 bs
 
-sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> SndPublicVerifyKey -> ConnInfo -> m ()
-sendConfirmation c sq@SndQueue {server, sndId} senderKey cInfo =
+sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> SMPConfirmation -> m ()
+sendConfirmation c sq@SndQueue {server, sndId} SMPConfirmation {senderKey, connInfo} =
   withLogSMP_ c server sndId "SEND <KEY>" $ \smp -> do
-    msg <- mkConfirmation smp
+    msg <- mkConfirmation
     liftSMP $ sendSMPMessage smp Nothing sndId msg
   where
-    mkConfirmation :: SMPClient -> m MsgBody
-    mkConfirmation smp = encryptAndSign smp sq . serializeSMPMessage $ SMPConfirmation senderKey cInfo
+    mkConfirmation :: m MsgBody
+    mkConfirmation =
+      agentCbEncrypt sq . serializeAgentMessage $
+        AgentConfirmation senderKey connInfo
 
-sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m ()
-sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey ri =
+sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> RetryInterval -> m ()
+sendHello c sq@SndQueue {server, sndId, sndPrivateKey} ri =
   withLogSMP_ c server sndId "SEND <HELLO> (retrying)" $ \smp -> do
-    msg <- mkHello smp $ AckMode On
+    msg <- mkHello
     liftSMP . withRetryInterval ri $ \loop ->
       sendSMPMessage smp (Just sndPrivateKey) sndId msg `catchE` \case
         SMPServerError AUTH -> loop
         e -> throwE e
   where
-    mkHello :: SMPClient -> AckMode -> m ByteString
-    mkHello smp ackMode = do
-      senderTimestamp <- liftIO getCurrentTime
-      encryptAndSign smp sq . serializeSMPMessage $
-        SMPMessage
-          { senderMsgId = 0,
-            senderTimestamp,
-            previousMsgHash = "",
-            agentMessage = HELLO verifyKey ackMode
-          }
+    mkHello :: m ByteString
+    mkHello = do
+      agentCbEncrypt sq . serializeAgentMessage $
+        AgentMessage (AHeader 0 "") HELLO
 
-sendInvitation :: forall m. AgentMonad m => AgentClient -> SMPQueueUri -> C.APublicEncryptKey -> ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
-sendInvitation c SMPQueueUri {smpServer, senderId} encryptKey cReq connInfo = do
+sendInvitation :: forall m. AgentMonad m => AgentClient -> SMPQueueUri -> ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
+sendInvitation c SMPQueueUri {smpServer, senderId, dhPublicKey} cReq connInfo = do
   withLogSMP_ c smpServer senderId "SEND <INV>" $ \smp -> do
-    msg <- mkInvitation smp
+    msg <- mkInvitation
     liftSMP $ sendSMPMessage smp Nothing senderId msg
   where
-    mkInvitation :: SMPClient -> m ByteString
-    mkInvitation smp = do
-      senderTimestamp <- liftIO getCurrentTime
-      encryptUnsigned smp encryptKey . serializeSMPMessage $
-        SMPMessage
-          { senderMsgId = 0,
-            senderTimestamp,
-            previousMsgHash = "",
-            agentMessage = A_INV cReq connInfo
-          }
+    mkInvitation :: m ByteString
+    mkInvitation =
+      agentCbEncryptOnce dhPublicKey . serializeAgentMessage $
+        AgentInvitation cReq connInfo
 
 secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SndPublicVerifyKey -> m ()
 secureQueue c RcvQueue {server, rcvId, rcvPrivateKey} senderKey =
@@ -373,49 +361,40 @@ deleteQueue c RcvQueue {server, rcvId, rcvPrivateKey} =
 sendAgentMessage :: AgentMonad m => AgentClient -> SndQueue -> ByteString -> m ()
 sendAgentMessage c sq@SndQueue {server, sndId, sndPrivateKey} msg =
   withLogSMP_ c server sndId "SEND <message>" $ \smp -> do
-    msg' <- encryptAndSign smp sq msg
+    msg' <- agentCbEncrypt sq msg
     liftSMP $ sendSMPMessage smp (Just sndPrivateKey) sndId msg'
 
-encryptAndSign :: AgentMonad m => SMPClient -> SndQueue -> ByteString -> m ByteString
-encryptAndSign smp SndQueue {encryptKey, signKey} msg = do
-  paddedSize <- asks $ (blockSize smp -) . reservedMsgSize
-  liftError cryptoError $ do
-    enc <- C.encrypt encryptKey paddedSize msg
-    sig <- C.sign signKey enc
-    pure $ C.signatureBytes sig <> enc
+agentCbEncrypt :: AgentMonad m => SndQueue -> ByteString -> m ByteString
+agentCbEncrypt SndQueue {e2ePubKey, e2eDhSecret} msg = do
+  emNonce <- liftIO C.randomCbNonce
+  emBody <-
+    liftEither . first cryptoError $
+      C.cbEncrypt e2eDhSecret emNonce msg SMP.e2eEncMessageLength
+  -- TODO per-queue client version
+  let emHeader = SMP.PubHeader SMP.clientVersion e2ePubKey
+  pure $ SMP.serializeEncMessage SMP.EncMessage {emHeader, emNonce, emBody}
 
-decryptAndVerify :: AgentMonad m => RcvQueue -> MsgBody -> m ByteString
-decryptAndVerify RcvQueue {decryptKey, verifyKey} msg =
-  verifyMessage verifyKey msg
-    >>= liftError cryptoError . C.decrypt decryptKey
+agentCbEncryptOnce :: AgentMonad m => C.PublicKeyX25519 -> ByteString -> m ByteString
+agentCbEncryptOnce dhRcvPubKey msg = do
+  (dhSndPubKey, dhSndPrivKey) <- liftIO C.generateKeyPair'
+  let e2eDhSecret = C.dh' dhRcvPubKey dhSndPrivKey
+  emNonce <- liftIO C.randomCbNonce
+  emBody <-
+    liftEither . first cryptoError $
+      C.cbEncrypt e2eDhSecret emNonce msg SMP.e2eEncMessageLength
+  -- TODO per-queue client version
+  let emHeader = SMP.PubHeader SMP.clientVersion dhSndPubKey
+  pure $ SMP.serializeEncMessage SMP.EncMessage {emHeader, emNonce, emBody}
 
-encryptUnsigned :: AgentMonad m => SMPClient -> C.APublicEncryptKey -> ByteString -> m ByteString
-encryptUnsigned smp encryptKey msg = do
-  paddedSize <- asks $ (blockSize smp -) . reservedMsgSize
-  size <- asks $ rsaKeySize . config
-  liftError cryptoError $ do
-    enc <- C.encrypt encryptKey paddedSize msg
-    let sig = B.replicate size ' '
-    pure $ sig <> enc
-
-verifyMessage :: AgentMonad m => Maybe C.APublicVerifyKey -> ByteString -> m ByteString
-verifyMessage verifyKey msg = do
-  sigSize <- asks $ rsaKeySize . config
-  let (s, enc) = B.splitAt sigSize msg
-  case verifyKey of
-    Nothing -> pure enc
-    Just k ->
-      case C.decodeSignature $ B.take (C.signatureSize k) s of
-        Left _ -> throwError $ AGENT A_SIGNATURE
-        Right sig ->
-          if C.verify k sig enc
-            then pure enc
-            else throwError $ AGENT A_SIGNATURE
+agentCbDecrypt :: AgentMonad m => C.DhSecretX25519 -> C.CbNonce -> ByteString -> m ByteString
+agentCbDecrypt dhSecret nonce msg =
+  liftEither . first cryptoError $
+    C.cbDecrypt dhSecret nonce msg
 
 cryptoError :: C.CryptoError -> AgentErrorType
 cryptoError = \case
   C.CryptoLargeMsgError -> CMD LARGE
-  C.RSADecryptError _ -> AGENT A_ENCRYPTION
   C.CryptoHeaderError _ -> AGENT A_ENCRYPTION
   C.AESDecryptError -> AGENT A_ENCRYPTION
+  C.CBDecryptError -> AGENT A_ENCRYPTION
   e -> INTERNAL $ show e

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

@@ -23,7 +23,6 @@ import UnliftIO.STM
 data AgentConfig = AgentConfig
   { tcpPort :: ServiceName,
     smpServers :: NonEmpty SMPServer,
-    rsaKeySize :: Int,
     cmdSignAlg :: C.SignAlg,
     connIdBytes :: Int,
     tbqSize :: Natural,
@@ -45,7 +44,6 @@ defaultAgentConfig =
   AgentConfig
     { tcpPort = "5224",
       smpServers = undefined,
-      rsaKeySize = 2048 `div` 8,
       cmdSignAlg = C.SignAlg C.SEd448,
       connIdBytes = 12,
       tbqSize = 16,
@@ -75,7 +73,6 @@ data Env = Env
     store :: SQLiteStore,
     idsDrg :: TVar ChaChaDRG,
     clientCounter :: TVar Int,
-    reservedMsgSize :: Int,
     randomServer :: TVar StdGen
   }
 
@@ -85,10 +82,4 @@ newSMPAgentEnv cfg = do
   store <- liftIO $ createSQLiteStore (dbFile cfg) (dbPoolSize cfg) Migrations.app
   clientCounter <- newTVarIO 0
   randomServer <- newTVarIO =<< liftIO newStdGen
-  return Env {config = cfg, store, idsDrg, clientCounter, reservedMsgSize, randomServer}
-  where
-    -- 1st rsaKeySize is used by the RSA signature in each command,
-    -- 2nd - by encrypted message body header
-    -- 3rd - by message signature
-    -- smpCommandSize - is the estimated max size for SMP command, queueId, corrId
-    reservedMsgSize = 3 * rsaKeySize cfg + smpCommandSize (smpCfg cfg)
+  return Env {config = cfg, store, idsDrg, clientCounter, randomServer}

src/Simplex/Messaging/Agent/Protocol.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -35,7 +36,9 @@ module Simplex.Messaging.Agent.Protocol
     SAParty (..),
     MsgHash,
     MsgMeta (..),
-    SMPMessage (..),
+    SMPConfirmation (..),
+    AgentMessage (..),
+    AHeader (..),
     AMessage (..),
     SMPServer (..),
     SMPQueueUri (..),
@@ -49,6 +52,7 @@ module Simplex.Messaging.Agent.Protocol
     AConnectionRequest (..),
     ConnReqData (..),
     ConnReqScheme (..),
+    ConnectionEncryption (..),
     simplexChat,
     AgentErrorType (..),
     CommandErrorType (..),
@@ -61,8 +65,6 @@ module Simplex.Messaging.Agent.Protocol
     ConnId,
     ConfirmationId,
     InvitationId,
-    AckMode (..),
-    OnOff (..),
     MsgIntegrity (..),
     MsgErrorType (..),
     QueueStatus (..),
@@ -71,11 +73,10 @@ module Simplex.Messaging.Agent.Protocol
 
     -- * Parse and serialize
     serializeCommand,
-    serializeSMPMessage,
+    clientToAgentMsg,
+    serializeAgentMessage,
     serializeMsgIntegrity,
-    serializeServer,
     serializeSMPQueueUri,
-    reservedServerKey, -- TODO remove
     serializeConnMode,
     serializeConnMode',
     connMode,
@@ -84,7 +85,6 @@ module Simplex.Messaging.Agent.Protocol
     serializeConnReq',
     serializeAgentError,
     commandP,
-    parseSMPMessage,
     smpServerP,
     smpQueueUriP,
     connModeT,
@@ -92,7 +92,6 @@ module Simplex.Messaging.Agent.Protocol
     connReqP',
     msgIntegrityP,
     agentErrorTypeP,
-    agentMessageP,
 
     -- * TCP transport functions
     tPut,
@@ -104,7 +103,6 @@ where
 
 import Control.Applicative (optional, (<|>))
 import Control.Monad.IO.Class
-import qualified Crypto.PubKey.RSA as R
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Base64
@@ -130,10 +128,13 @@ import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol
-  ( ErrorType,
+  ( ClientMessage (..),
+    ErrorType,
     MsgBody,
     MsgId,
+    PrivHeader (..),
     SndPublicVerifyKey,
+    serializeClientMessage,
   )
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTransportError, transportErrorP)
@@ -261,93 +262,87 @@ data MsgMeta = MsgMeta
   { integrity :: MsgIntegrity,
     recipient :: (AgentMsgId, UTCTime),
     broker :: (MsgId, UTCTime),
-    sender :: (AgentMsgId, UTCTime)
+    sndMsgId :: AgentMsgId
   }
   deriving (Eq, Show)
 
--- | SMP message formats.
-data SMPMessage
-  = -- | SMP confirmation
-    -- (see <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message SMP protocol>)
-    SMPConfirmation
-      { -- | sender's public key to use for authentication of sender's commands at the recepient's server
-        senderKey :: SndPublicVerifyKey,
-        -- | sender's information to be associated with the connection, e.g. sender's profile information
-        connInfo :: ConnInfo
-      }
-  | -- | Agent message header and envelope for client messages
-    -- (see <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents SMP agent protocol>)
-    SMPMessage
-      { -- | sequential ID assigned by the sending agent
-        senderMsgId :: AgentMsgId,
-        -- | timestamp from the sending agent
-        senderTimestamp :: SenderTimestamp,
-        -- | digest of the previous message
-        previousMsgHash :: MsgHash,
-        -- | messages sent between agents once queue is secured
-        agentMessage :: AMessage
-      }
+data SMPConfirmation = SMPConfirmation
+  { -- | sender's public key to use for authentication of sender's commands at the recepient's server
+    senderKey :: SndPublicVerifyKey,
+    -- | sender's DH public key for simple per-queue e2e encryption
+    e2ePubKey :: C.PublicKeyX25519,
+    -- | sender's information to be associated with the connection, e.g. sender's profile information
+    connInfo :: ConnInfo
+  }
   deriving (Show)
 
+-- SMP agent message formats
+data AgentMessage
+  = AgentConfirmation C.APublicVerifyKey ConnInfo -- TODO add double ratchet E2E settings
+  | AgentInvitation (ConnectionRequest CMInvitation) ConnInfo
+  | AgentMessage AHeader AMessage
+
+data AHeader = AHeader
+  { -- | sequential ID assigned by the sending agent
+    sndMsgId :: AgentMsgId,
+    -- | digest of the previous message
+    prevMsgHash :: MsgHash
+  }
+
+serializeAHeader :: AHeader -> ByteString
+serializeAHeader AHeader {sndMsgId, prevMsgHash} =
+  bshow sndMsgId <> " " <> encode prevMsgHash <> "\n"
+
+emptyAHeader :: ByteString
+emptyAHeader = "\n"
+
+aHeaderP :: Parser AHeader
+aHeaderP = AHeader <$> A.decimal <* A.space <*> (base64P <|> pure "") <* A.endOfLine
+
+emptyAHeaderP :: Parser ()
+emptyAHeaderP = A.endOfLine $> ()
+
 -- | Messages sent between SMP agents once SMP queue is secured.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents
-data AMessage where
-  -- | the first message in the queue to validate it is secured
-  HELLO :: C.APublicVerifyKey -> AckMode -> AMessage
-  -- | reply queue information
-  REPLY :: ConnectionRequest CMInvitation -> AMessage
-  -- | agent envelope for the client message
-  A_MSG :: MsgBody -> AMessage
-  -- | connection request with the invitation to connect
-  A_INV :: ConnectionRequest CMInvitation -> ConnInfo -> AMessage
+data AMessage
+  = -- | the first message in the queue to validate it is secured
+    HELLO
+  | -- | reply queue information
+    REPLY (ConnectionRequest CMInvitation)
+  | -- | agent envelope for the client message
+    A_MSG MsgBody
   deriving (Show)
 
--- | Parse SMP message.
-parseSMPMessage :: ByteString -> Either AgentErrorType SMPMessage
-parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
+serializeAgentMessage :: AgentMessage -> ByteString
+serializeAgentMessage = serializeClientMessage . agentToClientMsg
+
+agentToClientMsg :: AgentMessage -> ClientMessage
+agentToClientMsg = \case
+  AgentConfirmation senderKey cInfo ->
+    ClientMessage (PHConfirmation senderKey) $ emptyAHeader <> cInfo
+  AgentInvitation cReq cInfo ->
+    ClientMessage PHEmpty $ emptyAHeader <> serializeConnReq' cReq <> "\n" <> cInfo
+  AgentMessage header aMsg ->
+    ClientMessage PHEmpty $ serializeAHeader header <> serializeAMessage aMsg
+
+clientToAgentMsg :: ClientMessage -> Either AgentErrorType AgentMessage
+clientToAgentMsg (ClientMessage header body) = parse parser (AGENT A_MESSAGE) body
   where
-    smpMessageP :: Parser SMPMessage
-    smpMessageP = A.endOfLine *> smpClientMessageP <|> smpConfirmationP
+    parser = case header of
+      PHConfirmation senderKey -> AgentConfirmation senderKey <$> (emptyAHeaderP *> A.takeByteString)
+      PHEmpty -> invitationP <|> messageP
+    invitationP = AgentInvitation <$> (emptyAHeaderP *> connReqP' <* A.endOfLine) <*> A.takeByteString
+    messageP = AgentMessage <$> aHeaderP <*> aMessageP
 
-    smpConfirmationP :: Parser SMPMessage
-    smpConfirmationP = "KEY " *> (SMPConfirmation <$> C.strKeyP <* A.endOfLine <* A.endOfLine <*> binaryBodyP <* A.endOfLine)
-
-    smpClientMessageP :: Parser SMPMessage
-    smpClientMessageP =
-      SMPMessage
-        <$> A.decimal <* A.space
-        <*> tsISO8601P <* A.space
-        -- TODO previous message hash should become mandatory when we support HELLO and REPLY
-        -- (for HELLO it would be the hash of SMPConfirmation)
-        <*> (base64P <|> pure "") <* A.endOfLine
-        <*> agentMessageP
-
--- | Serialize SMP message.
-serializeSMPMessage :: SMPMessage -> ByteString
-serializeSMPMessage = \case
-  SMPConfirmation sKey cInfo -> smpMessage ("KEY " <> C.serializeKey sKey) "" (serializeBinary cInfo) <> "\n"
-  SMPMessage {senderMsgId, senderTimestamp, previousMsgHash, agentMessage} ->
-    let header = messageHeader senderMsgId senderTimestamp previousMsgHash
-        body = serializeAgentMessage agentMessage
-     in smpMessage "" header body
-  where
-    messageHeader msgId ts prevMsgHash =
-      B.unwords [bshow msgId, B.pack $ formatISO8601Millis ts, encode prevMsgHash]
-    smpMessage smpHeader aHeader aBody = B.intercalate "\n" [smpHeader, aHeader, aBody, ""]
-
-agentMessageP :: Parser AMessage
-agentMessageP =
-  "HELLO " *> hello
+aMessageP :: Parser AMessage
+aMessageP =
+  "HELLO" $> HELLO
     <|> "REPLY " *> reply
     <|> "MSG " *> a_msg
-    <|> "INV " *> a_inv
   where
-    hello = HELLO <$> C.strKeyP <*> ackMode
     reply = REPLY <$> connReqP'
-    a_msg = A_MSG <$> binaryBodyP <* A.endOfLine
-    a_inv = A_INV <$> connReqP' <* A.space <*> binaryBodyP <* A.endOfLine
-    ackMode = AckMode <$> (" NO_ACK" $> Off <|> pure On)
+    a_msg = A_MSG <$> A.takeByteString
 
 -- | SMP server location parser.
 smpServerP :: Parser SMPServer
@@ -357,25 +352,21 @@ smpServerP = SMPServer <$> server <*> optional port <*> kHash
     port = A.char ':' *> (B.unpack <$> A.takeWhile1 A.isDigit)
     kHash = Just . C.KeyHash <$> (A.char '#' *> base64P)
 
-serializeAgentMessage :: AMessage -> ByteString
-serializeAgentMessage = \case
-  HELLO verifyKey ackMode -> "HELLO " <> C.serializeKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else ""
+serializeAMessage :: AMessage -> ByteString
+serializeAMessage = \case
+  HELLO -> "HELLO"
   REPLY cReq -> "REPLY " <> serializeConnReq' cReq
-  A_MSG body -> "MSG " <> serializeBinary body <> "\n"
-  A_INV cReq cInfo -> B.unwords ["INV", serializeConnReq' cReq, serializeBinary cInfo] <> "\n"
+  A_MSG body -> "MSG " <> body
 
 -- | Serialize SMP queue information that is sent out-of-band.
 serializeSMPQueueUri :: SMPQueueUri -> ByteString
-serializeSMPQueueUri (SMPQueueUri srv qId) =
-  serializeServerUri srv <> "/" <> U.encode qId <> "#"
+serializeSMPQueueUri (SMPQueueUri srv qId dhKey) =
+  serializeServerUri srv <> "/" <> U.encode qId <> "#" <> C.serializePubKeyUri' dhKey
 
 -- | SMP queue information parser.
 smpQueueUriP :: Parser SMPQueueUri
 smpQueueUriP =
-  SMPQueueUri <$> smpServerUriP <* "/" <*> base64UriP <* optional "#"
-
-reservedServerKey :: C.APublicVerifyKey
-reservedServerKey = C.APublicVerifyKey C.SRSA (C.PublicKeyRSA $ R.PublicKey 1 0 0)
+  SMPQueueUri <$> smpServerUriP <* A.char '/' <*> base64UriP <* A.char '#' <*> C.strPubKeyUriP
 
 serializeConnReq :: AConnectionRequest -> ByteString
 serializeConnReq (ACR _ cr) = serializeConnReq' cr
@@ -385,7 +376,7 @@ serializeConnReq' = \case
   CRInvitation crData -> serialize CMInvitation crData
   CRContact crData -> serialize CMContact crData
   where
-    serialize crMode ConnReqData {crScheme, crSmpQueues, crEncryptKey} =
+    serialize crMode ConnReqData {crScheme, crSmpQueues, crEncryption = _} =
       sch <> "/" <> m <> "#/" <> queryStr
       where
         sch = case crScheme of
@@ -394,9 +385,8 @@ serializeConnReq' = \case
         m = case crMode of
           CMInvitation -> "invitation"
           CMContact -> "contact"
-        queryStr = renderSimpleQuery True [("smp", queues), ("e2e", key)]
+        queryStr = renderSimpleQuery True [("smp", queues), ("e2e", "")]
         queues = B.intercalate "," . map serializeSMPQueueUri $ L.toList crSmpQueues
-        key = C.serializeKeyUri crEncryptKey
 
 connReqP' :: forall m. ConnectionModeI m => Parser (ConnectionRequest m)
 connReqP' = do
@@ -411,8 +401,8 @@ connReqP = do
   crMode <- "/" *> mode <* "#/?"
   query <- parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
   crSmpQueues <- paramP "smp" smpQueues query
-  crEncryptKey <- paramP "e2e" C.strKeyUriP query
-  let cReq = ConnReqData {crScheme, crSmpQueues, crEncryptKey}
+  let crEncryption = ConnectionEncryption
+      cReq = ConnReqData {crScheme, crSmpQueues, crEncryption}
   pure $ case crMode of
     CMInvitation -> ACR SCMInvitation $ CRInvitation cReq
     CMContact -> ACR SCMContact $ CRContact cReq
@@ -429,11 +419,7 @@ connReqP = do
         =<< (smpQueue `A.sepBy1'` A.char ',')
     smpQueue = parseAll smpQueueUriP <$?> A.takeTill (== ',')
 
--- | Serialize SMP server location.
-serializeServer :: SMPServer -> ByteString
-serializeServer SMPServer {host, port, keyHash} =
-  B.pack $ host <> maybe "" (':' :) port <> maybe "" (('#' :) . B.unpack . encode . C.unKeyHash) keyHash
-
+-- | Serialize SMP server URI.
 serializeServerUri :: SMPServer -> ByteString
 serializeServerUri SMPServer {host, port, keyHash} = "smp://" <> kh <> B.pack host <> p
   where
@@ -486,18 +472,13 @@ type ConfirmationId = ByteString
 
 type InvitationId = ByteString
 
--- | Connection modes.
-data OnOff = On | Off deriving (Eq, Show, Read)
-
--- | Message acknowledgement mode of the connection.
-newtype AckMode = AckMode OnOff deriving (Eq, Show)
-
 -- | SMP queue information sent out-of-band.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#out-of-band-messages
 data SMPQueueUri = SMPQueueUri
   { smpServer :: SMPServer,
-    senderId :: SMP.SenderId
+    senderId :: SMP.SenderId,
+    dhPublicKey :: C.PublicKeyX25519
   }
   deriving (Eq, Show)
 
@@ -521,13 +502,17 @@ deriving instance Show AConnectionRequest
 data ConnReqData = ConnReqData
   { crScheme :: ConnReqScheme,
     crSmpQueues :: L.NonEmpty SMPQueueUri,
-    crEncryptKey :: C.APublicEncryptKey
+    crEncryption :: ConnectionEncryption
   }
   deriving (Eq, Show)
 
 data ConnReqScheme = CRSSimplex | CRSAppServer HostName (Maybe ServiceName)
   deriving (Eq, Show)
 
+-- TODO this is a stub for double ratchet E2E encryption parameters (2 public DH keys)
+data ConnectionEncryption = ConnectionEncryption
+  deriving (Eq, Show)
+
 simplexChat :: ConnReqScheme
 simplexChat = CRSAppServer "simplex.chat" Nothing
 
@@ -549,8 +534,6 @@ data QueueStatus
 
 type AgentMsgId = Int64
 
-type SenderTimestamp = UTCTime
-
 -- | Result of received message integrity validation.
 data MsgIntegrity = MsgOk | MsgError MsgErrorType
   deriving (Eq, Show)
@@ -615,14 +598,12 @@ data BrokerErrorType
 
 -- | Errors of another SMP agent.
 data SMPAgentError
-  = -- | possibly should include bytestring that failed to parse
+  = -- | client or agent message that failed to parse
     A_MESSAGE
-  | -- | possibly should include the prohibited SMP/agent message
+  | -- | prohibited SMP/agent message
     A_PROHIBITED
-  | -- | cannot RSA/AES-decrypt or parse decrypted header
+  | -- | cannot decrypt message
     A_ENCRYPTION
-  | -- | invalid signature
-    A_SIGNATURE
   deriving (Eq, Generic, Read, Show, Exception)
 
 instance Arbitrary AgentErrorType where arbitrary = genericArbitraryU
@@ -682,8 +663,8 @@ commandP =
       integrity <- msgIntegrityP
       recipient <- " R=" *> partyMeta A.decimal
       broker <- " B=" *> partyMeta base64P
-      sender <- " S=" *> partyMeta A.decimal
-      pure MsgMeta {integrity, recipient, broker, sender}
+      sndMsgId <- " S=" *> A.decimal
+      pure MsgMeta {integrity, recipient, broker, sndMsgId}
     partyMeta idParser = (,) <$> idParser <* "," <*> tsISO8601P
     agentError = ACmd SAgent . ERR <$> agentErrorTypeP
 
@@ -731,12 +712,12 @@ serializeCommand = \case
     showTs :: UTCTime -> ByteString
     showTs = B.pack . formatISO8601Millis
     serializeMsgMeta :: MsgMeta -> ByteString
-    serializeMsgMeta MsgMeta {integrity, recipient = (rmId, rTs), broker = (bmId, bTs), sender = (smId, sTs)} =
+    serializeMsgMeta MsgMeta {integrity, recipient = (rmId, rTs), broker = (bmId, bTs), sndMsgId} =
       B.unwords
         [ serializeMsgIntegrity integrity,
           "R=" <> bshow rmId <> "," <> showTs rTs,
           "B=" <> encode bmId <> "," <> showTs bTs,
-          "S=" <> bshow smId <> "," <> showTs sTs
+          "S=" <> bshow sndMsgId
         ]
 
 -- | Serialize message integrity validation result.
@@ -768,11 +749,6 @@ serializeAgentError = \case
   BROKER (TRANSPORT e) -> "BROKER TRANSPORT " <> serializeTransportError e
   e -> bshow e
 
-binaryBodyP :: Parser ByteString
-binaryBodyP = do
-  size :: Int <- A.decimal <* A.endOfLine
-  A.take size
-
 serializeBinary :: ByteString -> ByteString
 serializeBinary body = bshow (B.length body) <> "\n" <> body
 

src/Simplex/Messaging/Agent/Store.hs

@@ -25,7 +25,6 @@ import Simplex.Messaging.Protocol
     RcvDhSecret,
     RcvPrivateSignKey,
     SndPrivateSignKey,
-    SndPublicVerifyKey,
   )
 import qualified Simplex.Messaging.Protocol as SMP
 
@@ -43,7 +42,7 @@ class Monad m => MonadAgentStore s m where
   upgradeRcvConnToDuplex :: s -> ConnId -> SndQueue -> m ()
   upgradeSndConnToDuplex :: s -> ConnId -> RcvQueue -> m ()
   setRcvQueueStatus :: s -> RcvQueue -> QueueStatus -> m ()
-  setRcvQueueActive :: s -> RcvQueue -> C.APublicVerifyKey -> m ()
+  setRcvQueueConfirmedE2E :: s -> RcvQueue -> C.PublicKeyX25519 -> C.DhSecretX25519 -> m ()
   setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m ()
 
   -- Confirmations
@@ -81,11 +80,13 @@ data RcvQueue = RcvQueue
     rcvPrivateKey :: RcvPrivateSignKey,
     -- | shared DH secret used to encrypt/decrypt message bodies from server to recipient
     rcvDhSecret :: RcvDhSecret,
+    -- | private DH key related to public sent to sender out-of-band (to agree simple per-queue e2e)
+    e2ePrivKey :: C.PrivateKeyX25519,
+    -- | public sender's DH key and agreed shared DH secret for simple per-queue e2e
+    e2eShared :: Maybe (C.PublicKeyX25519, C.DhSecretX25519),
     -- | sender queue ID
     sndId :: Maybe SMP.SenderId,
-    -- | TODO keys used for E2E encryption - these will change with double ratchet
-    decryptKey :: C.APrivateDecryptKey,
-    verifyKey :: Maybe C.APublicVerifyKey,
+    -- | queue status
     status :: QueueStatus
   }
   deriving (Eq, Show)
@@ -93,10 +94,15 @@ data RcvQueue = RcvQueue
 -- | A send queue. SMP queue through which the agent sends messages to a recipient.
 data SndQueue = SndQueue
   { server :: SMPServer,
+    -- | sender queue ID
     sndId :: SMP.SenderId,
+    -- | key used by the sender to sign transmissions
     sndPrivateKey :: SndPrivateSignKey,
-    encryptKey :: C.APublicEncryptKey,
-    signKey :: C.APrivateSignKey,
+    -- | public DH key that was (or needs to be) sent to the recipient in SMP confirmation (to agree simple per-queue e2e)
+    e2ePubKey :: C.PublicKeyX25519,
+    -- | shared DH secret agreed for simple per-queue e2e encryption
+    e2eDhSecret :: C.DhSecretX25519,
+    -- | queue status
     status :: QueueStatus
   }
   deriving (Eq, Show)
@@ -167,15 +173,13 @@ newtype ConnData = ConnData {connId :: ConnId}
 
 data NewConfirmation = NewConfirmation
   { connId :: ConnId,
-    senderKey :: SndPublicVerifyKey,
-    senderConnInfo :: ConnInfo
+    senderConf :: SMPConfirmation
   }
 
 data AcceptedConfirmation = AcceptedConfirmation
   { confirmationId :: ConfirmationId,
     connId :: ConnId,
-    senderKey :: SndPublicVerifyKey,
-    senderConnInfo :: ConnInfo,
+    senderConf :: SMPConfirmation,
     ownConnInfo :: ConnInfo
   }
 
@@ -225,7 +229,7 @@ data SndMsgData = SndMsgData
     internalTs :: InternalTs,
     msgBody :: MsgBody,
     internalHash :: MsgHash,
-    previousMsgHash :: MsgHash
+    prevMsgHash :: MsgHash
   }
 
 data PendingMsg = PendingMsg
@@ -234,10 +238,6 @@ data PendingMsg = PendingMsg
   }
   deriving (Show)
 
--- * Broadcast types
-
-type BroadcastId = ByteString
-
 -- * Message types
 
 -- | A message in either direction that is stored by the agent.

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

@@ -250,19 +250,21 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         |]
         [":status" := status, ":host" := host, ":port" := serializePort_ port, ":rcv_id" := rcvId]
 
-  setRcvQueueActive :: SQLiteStore -> RcvQueue -> C.APublicVerifyKey -> m ()
-  setRcvQueueActive st RcvQueue {rcvId, server = SMPServer {host, port}} verifyKey =
-    -- ? throw error if queue does not exist?
+  setRcvQueueConfirmedE2E :: SQLiteStore -> RcvQueue -> C.PublicKeyX25519 -> C.DhSecretX25519 -> m ()
+  setRcvQueueConfirmedE2E st RcvQueue {rcvId, server = SMPServer {host, port}} e2eSndPubKey e2eDhSecret =
     liftIO . withTransaction st $ \db ->
       DB.executeNamed
         db
         [sql|
           UPDATE rcv_queues
-          SET verify_key = :verify_key, status = :status
-          WHERE host = :host AND port = :port AND rcv_id = :rcv_id;
+          SET e2e_snd_pub_key = :e2e_snd_pub_key,
+              e2e_dh_secret = :e2e_dh_secret,
+              status = :status
+          WHERE host = :host AND port = :port AND rcv_id = :rcv_id
         |]
-        [ ":verify_key" := Just verifyKey,
-          ":status" := Active,
+        [ ":status" := Confirmed,
+          ":e2e_snd_pub_key" := e2eSndPubKey,
+          ":e2e_dh_secret" := e2eDhSecret,
           ":host" := host,
           ":port" := serializePort_ port,
           ":rcv_id" := rcvId
@@ -282,16 +284,16 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         [":status" := status, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId]
 
   createConfirmation :: SQLiteStore -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
-  createConfirmation st gVar NewConfirmation {connId, senderKey, senderConnInfo} =
+  createConfirmation st gVar NewConfirmation {connId, senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo}} =
     liftIOEither . withTransaction st $ \db ->
       createWithRandomId gVar $ \confirmationId ->
         DB.execute
           db
           [sql|
             INSERT INTO conn_confirmations
-            (confirmation_id, conn_alias, sender_key, sender_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
+            (confirmation_id, conn_alias, sender_key, e2e_snd_pub_key, sender_conn_info, accepted) VALUES (?, ?, ?, ?, ?, 0);
           |]
-          (confirmationId, connId, senderKey, senderConnInfo)
+          (confirmationId, connId, senderKey, e2ePubKey, connInfo)
 
   acceptConfirmation :: SQLiteStore -> ConfirmationId -> ConnInfo -> m AcceptedConfirmation
   acceptConfirmation st confirmationId ownConnInfo =
@@ -311,14 +313,20 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         <$> DB.query
           db
           [sql|
-            SELECT conn_alias, sender_key, sender_conn_info
+            SELECT conn_alias, sender_key, e2e_snd_pub_key, sender_conn_info
             FROM conn_confirmations
             WHERE confirmation_id = ?;
           |]
           (Only confirmationId)
     where
-      confirmation [(connId, senderKey, senderConnInfo)] =
-        Right $ AcceptedConfirmation {confirmationId, connId, senderKey, senderConnInfo, ownConnInfo}
+      confirmation [(connId, senderKey, e2ePubKey, connInfo)] =
+        Right
+          AcceptedConfirmation
+            { confirmationId,
+              connId,
+              senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo},
+              ownConnInfo
+            }
       confirmation _ = Left SEConfirmationNotFound
 
   getAcceptedConfirmation :: SQLiteStore -> ConnId -> m AcceptedConfirmation
@@ -328,14 +336,20 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         <$> DB.query
           db
           [sql|
-            SELECT confirmation_id, sender_key, sender_conn_info, own_conn_info
+            SELECT confirmation_id, sender_key, e2e_snd_pub_key, sender_conn_info, own_conn_info
             FROM conn_confirmations
             WHERE conn_alias = ? AND accepted = 1;
           |]
           (Only connId)
     where
-      confirmation [(confirmationId, senderKey, senderConnInfo, ownConnInfo)] =
-        Right $ AcceptedConfirmation {confirmationId, connId, senderKey, senderConnInfo, ownConnInfo}
+      confirmation [(confirmationId, senderKey, e2ePubKey, connInfo, ownConnInfo)] =
+        Right
+          AcceptedConfirmation
+            { confirmationId,
+              connId,
+              senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo},
+              ownConnInfo
+            }
       confirmation _ = Left SEConfirmationNotFound
 
   removeConfirmations :: SQLiteStore -> ConnId -> m ()
@@ -598,6 +612,7 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
     [ toField a, toField b, toField c, toField d, toField e, toField f,
       toField g, toField h, toField i, toField j, toField k, toField l
     ]
+
 {- ORMOLU_ENABLE -}
 
 -- * Server upsert helper
@@ -621,13 +636,15 @@ upsertServer_ dbConn SMPServer {host, port, keyHash} = do
 insertRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO ()
 insertRcvQueue_ dbConn connId RcvQueue {..} = do
   let port_ = serializePort_ $ port server
+      e2eSndPubKey = fst <$> e2eShared :: Maybe C.PublicKeyX25519
+      e2eDhSecret = snd <$> e2eShared :: Maybe C.DhSecretX25519
   DB.executeNamed
     dbConn
     [sql|
       INSERT INTO rcv_queues
-        ( host, port, rcv_id, conn_alias, rcv_private_key, rcv_dh_secret, snd_id, decrypt_key, verify_key, status)
+        ( host, port, rcv_id, conn_alias, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_snd_pub_key, e2e_dh_secret, snd_id, status)
       VALUES
-        (:host,:port,:rcv_id,:conn_alias,:rcv_private_key,:rcv_dh_secret,:snd_id,:decrypt_key,:verify_key,:status);
+        (:host,:port,:rcv_id,:conn_alias,:rcv_private_key,:rcv_dh_secret,:e2e_priv_key,:e2e_snd_pub_key,:e2e_dh_secret,:snd_id,:status);
     |]
     [ ":host" := host server,
       ":port" := port_,
@@ -635,9 +652,10 @@ insertRcvQueue_ dbConn connId RcvQueue {..} = do
       ":conn_alias" := connId,
       ":rcv_private_key" := rcvPrivateKey,
       ":rcv_dh_secret" := rcvDhSecret,
+      ":e2e_priv_key" := e2ePrivKey,
+      ":e2e_snd_pub_key" := e2eSndPubKey,
+      ":e2e_dh_secret" := e2eDhSecret,
       ":snd_id" := sndId,
-      ":decrypt_key" := decryptKey,
-      ":verify_key" := verifyKey,
       ":status" := status
     ]
 
@@ -670,17 +688,17 @@ insertSndQueue_ dbConn connId SndQueue {..} = do
     dbConn
     [sql|
       INSERT INTO snd_queues
-        ( host, port, snd_id, conn_alias, snd_private_key, encrypt_key, sign_key, status)
+        ( host, port, snd_id, conn_alias, snd_private_key, e2e_pub_key, e2e_dh_secret, status)
       VALUES
-        (:host,:port,:snd_id,:conn_alias,:snd_private_key,:encrypt_key,:sign_key,:status);
+        (:host,:port,:snd_id,:conn_alias,:snd_private_key,:e2e_pub_key,:e2e_dh_secret,:status);
     |]
     [ ":host" := host server,
       ":port" := port_,
       ":snd_id" := sndId,
       ":conn_alias" := connId,
       ":snd_private_key" := sndPrivateKey,
-      ":encrypt_key" := encryptKey,
-      ":sign_key" := signKey,
+      ":e2e_pub_key" := e2ePubKey,
+      ":e2e_dh_secret" := e2eDhSecret,
       ":status" := status
     ]
 
@@ -732,26 +750,17 @@ getRcvQueueByConnAlias_ dbConn connId =
       dbConn
       [sql|
         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
+          q.e2e_priv_key, q.e2e_snd_pub_key, q.e2e_dh_secret, q.snd_id, 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, rcvDhSecret, sndId, decryptKey, verifyKey, status)] =
+    rcvQueue [(keyHash, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eSndPubKey, e2eDhSecret, sndId, status)] =
       let server = SMPServer host (deserializePort_ port) keyHash
-       in Just $
-            RcvQueue
-              { server,
-                rcvId,
-                rcvPrivateKey,
-                rcvDhSecret,
-                sndId,
-                decryptKey,
-                verifyKey,
-                status
-              }
+          e2eShared = (,) <$> e2eSndPubKey <*> e2eDhSecret
+       in Just RcvQueue {server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eShared, sndId, status}
     rcvQueue _ = Nothing
 
 getSndQueueByConnAlias_ :: DB.Connection -> ConnId -> IO (Maybe SndQueue)
@@ -760,16 +769,17 @@ getSndQueueByConnAlias_ dbConn connId =
     <$> DB.query
       dbConn
       [sql|
-        SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_private_key, q.encrypt_key, q.sign_key, q.status
+        SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_private_key,
+          q.e2e_pub_key, q.e2e_dh_secret, q.status
         FROM snd_queues q
         INNER JOIN servers s ON q.host = s.host AND q.port = s.port
         WHERE q.conn_alias = ?;
       |]
       (Only connId)
   where
-    sndQueue [(keyHash, host, port, sndId, sndPrivateKey, encryptKey, signKey, status)] =
+    sndQueue [(keyHash, host, port, sndId, sndPrivateKey, e2ePubKey, e2eDhSecret, status)] =
       let server = SMPServer host (deserializePort_ port) keyHash
-       in Just $ SndQueue {server, sndId, sndPrivateKey, encryptKey, signKey, status}
+       in Just SndQueue {server, sndId, sndPrivateKey, e2ePubKey, e2eDhSecret, status}
     sndQueue _ = Nothing
 
 -- * upgradeRcvConnToDuplex helpers
@@ -852,24 +862,23 @@ insertRcvMsgBase_ dbConn connId RcvMsgData {msgMeta, msgBody, internalRcvId} = d
 
 insertRcvMsgDetails_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
 insertRcvMsgDetails_ dbConn connId RcvMsgData {msgMeta, internalRcvId, internalHash, externalPrevSndHash} = do
-  let MsgMeta {integrity, recipient, sender, broker} = msgMeta
+  let MsgMeta {integrity, recipient, broker, sndMsgId} = msgMeta
   DB.executeNamed
     dbConn
     [sql|
       INSERT INTO rcv_messages
-        ( conn_alias, internal_rcv_id, internal_id, external_snd_id, external_snd_ts,
+        ( conn_alias, internal_rcv_id, internal_id, external_snd_id,
           broker_id, broker_ts, rcv_status, ack_brocker_ts, ack_sender_ts,
           internal_hash, external_prev_snd_hash, integrity)
       VALUES
-        (:conn_alias,:internal_rcv_id,:internal_id,:external_snd_id,:external_snd_ts,
+        (:conn_alias,:internal_rcv_id,:internal_id,:external_snd_id,
          :broker_id,:broker_ts,:rcv_status,           NULL,          NULL,
          :internal_hash,:external_prev_snd_hash,:integrity);
     |]
     [ ":conn_alias" := connId,
       ":internal_rcv_id" := internalRcvId,
       ":internal_id" := fst recipient,
-      ":external_snd_id" := fst sender,
-      ":external_snd_ts" := snd sender,
+      ":external_snd_id" := sndMsgId,
       ":broker_id" := fst broker,
       ":broker_ts" := snd broker,
       ":rcv_status" := Received,
@@ -890,7 +899,7 @@ updateHashRcv_ dbConn connId RcvMsgData {msgMeta, internalHash, internalRcvId} =
       WHERE conn_alias = :conn_alias
         AND last_internal_rcv_msg_id = :last_internal_rcv_msg_id;
     |]
-    [ ":last_external_snd_msg_id" := fst (sender msgMeta),
+    [ ":last_external_snd_msg_id" := sndMsgId (msgMeta :: MsgMeta),
       ":last_rcv_msg_hash" := internalHash,
       ":conn_alias" := connId,
       ":last_internal_rcv_msg_id" := internalRcvId
@@ -960,7 +969,7 @@ insertSndMsgDetails_ dbConn connId SndMsgData {..} =
       ":internal_id" := internalId,
       ":snd_status" := SndMsgCreated,
       ":internal_hash" := internalHash,
-      ":previous_msg_hash" := previousMsgHash
+      ":previous_msg_hash" := prevMsgHash
     ]
 
 updateHashSnd_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()

src/Simplex/Messaging/Client.hs

@@ -23,7 +23,7 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Client
   ( -- * Connect (disconnect) client to (from) SMP server
-    SMPClient (blockSize),
+    SMPClient,
     getSMPClient,
     closeSMPClient,
 
@@ -85,8 +85,7 @@ data SMPClient = SMPClient
     sentCommands :: TVar (Map CorrId Request),
     sndQ :: TBQueue SentRawTransmission,
     rcvQ :: TBQueue (SignedTransmission (Command 'Broker)),
-    msgQ :: TBQueue SMPServerTransmission,
-    blockSize :: Int
+    msgQ :: TBQueue SMPServerTransmission
   }
 
 -- | Type synonym for transmission from some SPM server queue.
@@ -101,12 +100,7 @@ data SMPClientConfig = SMPClientConfig
     -- | timeout of TCP commands (microseconds)
     tcpTimeout :: Int,
     -- | period for SMP ping commands (microseconds)
-    smpPing :: Int,
-    -- | SMP transport block size
-    smpBlockSize :: Int,
-    -- | estimated maximum size of SMP command excluding message body,
-    -- determines the maximum allowed message size
-    smpCommandSize :: Int
+    smpPing :: Int
   }
 
 -- | Default SMP client configuration.
@@ -116,9 +110,7 @@ smpDefaultConfig =
     { qSize = 16,
       defaultTransport = ("5223", transport @TLS),
       tcpTimeout = 4_000_000,
-      smpPing = 30_000_000,
-      smpBlockSize = 16 * 1024, -- TODO move to Protocol
-      smpCommandSize = 256
+      smpPing = 30_000_000
     }
 
 data Request = Request
@@ -134,7 +126,7 @@ type Response = Either SMPClientError (Command 'Broker)
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
 getSMPClient :: SMPServer -> SMPClientConfig -> TBQueue SMPServerTransmission -> IO () -> IO (Either SMPClientError SMPClient)
-getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlockSize} msgQ disconnected =
+getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing} msgQ disconnected =
   atomically mkSMPClient >>= runClient useTransport
   where
     mkSMPClient :: STM SMPClient
@@ -148,7 +140,6 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock
         SMPClient
           { action = undefined,
             sessionId = undefined,
-            blockSize = undefined,
             connected,
             smpServer,
             tcpTimeout,
@@ -168,8 +159,7 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock
             `finally` atomically (putTMVar thVar $ Left SMPNetworkError)
       th_ <- tcpTimeout `timeout` atomically (takeTMVar thVar)
       pure $ case th_ of
-        Just (Right THandle {sessionId, blockSize}) ->
-          Right c {action, sessionId, blockSize}
+        Just (Right THandle {sessionId}) -> Right c {action, sessionId}
         Just (Left e) -> Left e
         Nothing -> Left SMPNetworkError
 
@@ -181,13 +171,13 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock
 
     client :: forall c. Transport c => TProxy c -> SMPClient -> TMVar (Either SMPClientError (THandle c)) -> c -> IO ()
     client _ c thVar h =
-      runExceptT (clientHandshake h smpBlockSize) >>= \case
+      runExceptT (clientHandshake h) >>= \case
         Left e -> atomically . putTMVar thVar . Left $ SMPTransportError e
-        Right th@THandle {sessionId, blockSize} -> do
+        Right th@THandle {sessionId} -> do
           atomically $ do
             writeTVar (connected c) True
             putTMVar thVar $ Right th
-          let c' = c {sessionId, blockSize} :: SMPClient
+          let c' = c {sessionId} :: SMPClient
           raceAny_ [send c' th, process c', receive c' th, ping c']
             `finally` disconnected
 

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -22,11 +22,11 @@ import qualified Data.ByteString.Char8 as B
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe)
-import Data.Word (Word16, Word32)
-import Network.Transport.Internal (decodeWord16, decodeWord32, encodeWord16, encodeWord32)
+import Data.Word (Word32)
+import Network.Transport.Internal (encodeWord16, encodeWord32)
 import Simplex.Messaging.Crypto
-import Simplex.Messaging.Parsers (parseAll, parseE, parseE')
-import Simplex.Messaging.Util (tryE, (<$?>))
+import Simplex.Messaging.Parsers (parseE, parseE', word16P, word32P)
+import Simplex.Messaging.Util (tryE)
 
 data Ratchet a = Ratchet
   { -- current ratchet version
@@ -77,7 +77,7 @@ newtype RatchetKey = RatchetKey ByteString
 initSndRatchet' ::
   forall a. (AlgorithmI a, DhAlgorithm a) => PublicKey a -> PrivateKey a -> ByteString -> ByteString -> IO (Ratchet a)
 initSndRatchet' rcDHRr sPKey salt rcAD = do
-  rcDHRs@(_, pk) <- generateKeyPair' @a 0
+  rcDHRs@(_, pk) <- generateKeyPair' @a
   let (sk, rcHKs, rcNHKr) = initKdf salt rcDHRr sPKey
       -- state.RK, state.CKs, state.NHKs = KDF_RK_HE(SK, DH(state.DHRs, state.DHRr))
       (rcRK, rcCKs, rcNHKs) = rootKdf sk rcDHRr pk
@@ -128,8 +128,7 @@ data MsgHeader a = MsgHeader
     msgLatestVersion :: E2EEncryptionVersion,
     msgDHRs :: PublicKey a,
     msgPN :: Word32,
-    msgNs :: Word32,
-    msgLen :: Word16
+    msgNs :: Word32
   }
   deriving (Eq, Show)
 
@@ -145,30 +144,21 @@ fullHeaderLen :: Int
 fullHeaderLen = paddedHeaderLen + authTagSize + ivSize @AES256
 
 serializeMsgHeader' :: AlgorithmI a => MsgHeader a -> ByteString
-serializeMsgHeader' MsgHeader {msgVersion, msgLatestVersion, msgDHRs, msgPN, msgNs, msgLen} =
+serializeMsgHeader' MsgHeader {msgVersion, msgLatestVersion, msgDHRs, msgPN, msgNs} =
   encodeWord16 msgVersion
     <> encodeWord16 msgLatestVersion
-    <> encodeWord16 (fromIntegral $ B.length key)
-    <> key
+    <> encodeLenKey msgDHRs
     <> encodeWord32 msgPN
     <> encodeWord32 msgNs
-    <> encodeWord16 msgLen
-  where
-    key = encodeKey msgDHRs
 
 msgHeaderP' :: AlgorithmI a => Parser (MsgHeader a)
 msgHeaderP' = do
-  msgVersion <- word16
-  msgLatestVersion <- word16
-  keyLen <- fromIntegral <$> word16
-  msgDHRs <- parseAll binaryKeyP <$?> A.take keyLen
-  msgPN <- word32
-  msgNs <- word32
-  msgLen <- word16
-  pure MsgHeader {msgVersion, msgLatestVersion, msgDHRs, msgPN, msgNs, msgLen}
-  where
-    word16 = decodeWord16 <$> A.take 2
-    word32 = decodeWord32 <$> A.take 4
+  msgVersion <- word16P
+  msgLatestVersion <- word16P
+  msgDHRs <- binaryLenKeyP
+  msgPN <- word32P
+  msgNs <- word32P
+  pure MsgHeader {msgVersion, msgLatestVersion, msgDHRs, msgPN, msgNs}
 
 data EncHeader = EncHeader
   { ehBody :: ByteString,
@@ -229,8 +219,7 @@ rcEncrypt' rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcNs, rcAD} pa
             msgLatestVersion = currentE2EVersion,
             msgDHRs = fst $ rcDHRs rc,
             msgPN = rcPN rc,
-            msgNs = rcNs,
-            msgLen = fromIntegral $ B.length msg
+            msgNs = rcNs
           }
 
 data SkippedMessage a
@@ -267,7 +256,7 @@ rcDecrypt' rc@Ratchet {rcRcv, rcMKSkipped, rcAD} msg' = do
     SMMessage msg rc' -> pure (msg, rc')
   where
     decryptRcMessage :: RatchetStep -> MsgHeader a -> EncMessage -> ExceptT CryptoError IO (DecryptResult a)
-    decryptRcMessage rcStep hdr@MsgHeader {msgDHRs, msgPN, msgNs} encMsg = do
+    decryptRcMessage rcStep MsgHeader {msgDHRs, msgPN, msgNs} encMsg = do
       -- if dh_ratchet:
       rc' <- ratchetStep rcStep
       case skipMessageKeys msgNs rc' of
@@ -276,7 +265,7 @@ rcDecrypt' rc@Ratchet {rcRcv, rcMKSkipped, rcAD} msg' = do
           -- state.CKr, mk = KDF_CK(state.CKr)
           let (rcCKr', mk, iv, _) = chainKdf rcCKr
           -- return DECRYPT (mk, ciphertext, CONCAT (AD, enc_header))
-          msg <- decryptMessage (MessageKey mk iv) hdr encMsg
+          msg <- decryptMessage (MessageKey mk iv) encMsg
           -- state . Nr += 1
           pure (msg, rc'' {rcRcv = Just rr {rcCKr = rcCKr'}, rcNr = rcNr + 1})
         Right rc'' -> pure (Left CERatchetState, rc'')
@@ -289,7 +278,7 @@ rcDecrypt' rc@Ratchet {rcRcv, rcMKSkipped, rcAD} msg' = do
             Left e -> throwE e
             Right rc'@Ratchet {rcDHRs, rcRK, rcNHKs, rcNHKr} -> do
               -- DHRatchetHE(state, header)
-              rcDHRs' <- liftIO $ generateKeyPair' @a 0
+              rcDHRs' <- liftIO $ generateKeyPair' @a
               -- state.RK, state.CKr, state.NHKr = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr))
               let (rcRK', rcCKr', rcNHKr') = rootKdf rcRK msgDHRs (snd rcDHRs)
                   -- state.RK, state.CKs, state.NHKs = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr))
@@ -349,7 +338,7 @@ rcDecrypt' rc@Ratchet {rcRcv, rcMKSkipped, rcAD} msg' = do
                         | M.null mks' = M.delete hk rcMKSkipped
                         | otherwise = M.insert hk mks' rcMKSkipped
                       rc' = rc {rcMKSkipped = mksSkipped}
-                  msg <- decryptMessage mk hdr encMsg
+                  msg <- decryptMessage mk encMsg
                   pure $ SMMessage msg rc'
         tryDecryptSkipped r _ = pure r
     decryptRcHeader :: Maybe RcvRatchet -> EncHeader -> ExceptT CryptoError IO (RatchetStep, MsgHeader a)
@@ -364,11 +353,11 @@ rcDecrypt' rc@Ratchet {rcRcv, rcMKSkipped, rcAD} msg' = do
     decryptHeader k EncHeader {ehBody, ehAuthTag, ehIV} = do
       header <- decryptAEAD k ehIV rcAD ehBody ehAuthTag `catchE` \_ -> throwE CERatchetHeader
       parseE' CryptoHeaderError msgHeaderP' header
-    decryptMessage :: MessageKey -> MsgHeader a -> EncMessage -> ExceptT CryptoError IO (Either CryptoError ByteString)
-    decryptMessage (MessageKey mk iv) MsgHeader {msgLen} EncMessage {emHeader, emBody, emAuthTag} =
+    decryptMessage :: MessageKey -> EncMessage -> ExceptT CryptoError IO (Either CryptoError ByteString)
+    decryptMessage (MessageKey mk iv) EncMessage {emHeader, emBody, emAuthTag} =
       -- DECRYPT(mk, ciphertext, CONCAT(AD, enc_header))
       -- TODO add associated data
-      tryE (B.take (fromIntegral msgLen) <$> decryptAEAD mk iv (rcAD <> emHeader) emBody emAuthTag)
+      tryE $ decryptAEAD mk iv (rcAD <> emHeader) emBody emAuthTag
 
 initKdf :: (AlgorithmI a, DhAlgorithm a) => ByteString -> PublicKey a -> PrivateKey a -> (RatchetKey, Key, Key)
 initKdf salt k pk =

src/Simplex/Messaging/Parsers.hs

@@ -15,10 +15,12 @@ import Data.Char (isAlphaNum)
 import Data.Time.Clock (UTCTime)
 import Data.Time.ISO8601 (parseISO8601)
 import Data.Typeable (Typeable)
+import Data.Word (Word16, Word32)
 import Database.SQLite.Simple (ResultError (..), SQLData (..))
 import Database.SQLite.Simple.FromField (FieldParser, returnError)
 import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
+import Network.Transport.Internal (decodeWord16, decodeWord32)
 import Simplex.Messaging.Util ((<$?>))
 import Text.Read (readMaybe)
 
@@ -48,6 +50,12 @@ rawBase64UriP = A.takeWhile1 (\c -> isAlphaNum c || c == '-' || c == '_')
 tsISO8601P :: Parser UTCTime
 tsISO8601P = maybe (fail "timestamp") pure . parseISO8601 . B.unpack =<< A.takeTill wordEnd
 
+word16P :: Parser Word16
+word16P = decodeWord16 <$> A.take 2
+
+word32P :: Parser Word32
+word32P = decodeWord32 <$> A.take 4
+
 parse :: Parser a -> e -> (ByteString -> Either e a)
 parse parser err = first (const err) . parseAll parser
 

src/Simplex/Messaging/Protocol.hs

@@ -27,7 +27,12 @@
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Protocol
-  ( -- * SMP protocol types
+  ( -- * SMP protocol parameters
+    clientVersion,
+    maxMessageLength,
+    e2eEncMessageLength,
+
+    -- * SMP protocol types
     Command (..),
     CommandI (..),
     Party (..),
@@ -43,6 +48,10 @@ module Simplex.Messaging.Protocol
     SignedTransmission,
     SentRawTransmission,
     SignedRawTransmission,
+    EncMessage (..),
+    PubHeader (..),
+    ClientMessage (..),
+    PrivHeader (..),
     CorrId (..),
     QueueId,
     RecipientId,
@@ -65,6 +74,10 @@ module Simplex.Messaging.Protocol
     serializeErrorType,
     transmissionP,
     errorTypeP,
+    serializeEncMessage,
+    encMessageP,
+    serializeClientMessage,
+    clientMessageP,
 
     -- * TCP transport functions
     tPut,
@@ -91,15 +104,26 @@ import Data.String
 import Data.Time.Clock
 import Data.Time.ISO8601
 import Data.Type.Equality
+import Data.Word (Word16)
 import GHC.Generics (Generic)
 import GHC.TypeLits (ErrorMessage (..), TypeError)
 import Generic.Random (genericArbitraryU)
+import Network.Transport.Internal (encodeWord16)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Transport (THandle (..), Transport, TransportError (..), tGetBlock, tPutBlock)
 import Simplex.Messaging.Util
 import Test.QuickCheck (Arbitrary (..))
 
+clientVersion :: Word16
+clientVersion = 1
+
+maxMessageLength :: Int
+maxMessageLength = 15968
+
+e2eEncMessageLength :: Int
+e2eEncMessageLength = 15842
+
 -- | SMP protocol participants.
 data Party = Broker | Recipient | Sender | Notifier
   deriving (Show)
@@ -227,6 +251,59 @@ isClient = \case
   SNotifier -> Just Dict
   _ -> Nothing
 
+-- | SMP message body format
+data EncMessage = EncMessage
+  { emHeader :: PubHeader,
+    emNonce :: C.CbNonce,
+    emBody :: ByteString
+  }
+
+data PubHeader = PubHeader
+  { phVersion :: Word16,
+    phE2ePubDhKey :: C.PublicKeyX25519
+  }
+
+serializePubHeader :: PubHeader -> ByteString
+serializePubHeader (PubHeader v k) = encodeWord16 v <> C.encodeLenKey' k
+
+pubHeaderP :: Parser PubHeader
+pubHeaderP = PubHeader <$> word16P <*> C.binaryLenKeyP
+
+serializeEncMessage :: EncMessage -> ByteString
+serializeEncMessage EncMessage {emHeader, emNonce, emBody} =
+  serializePubHeader emHeader <> C.unCbNonce emNonce <> emBody
+
+encMessageP :: Parser EncMessage
+encMessageP = do
+  emHeader <- pubHeaderP
+  emNonce <- C.cbNonceP
+  emBody <- A.takeByteString
+  pure EncMessage {emHeader, emNonce, emBody}
+
+data ClientMessage = ClientMessage PrivHeader ByteString
+
+data PrivHeader
+  = PHConfirmation C.APublicVerifyKey
+  | PHEmpty
+
+serializePrivHeader :: PrivHeader -> ByteString
+serializePrivHeader = \case
+  PHConfirmation k -> "K" <> C.encodeLenKey k
+  PHEmpty -> " "
+
+privHeaderP :: Parser PrivHeader
+privHeaderP =
+  A.anyChar >>= \case
+    'K' -> PHConfirmation <$> C.binaryLenKeyP
+    ' ' -> pure PHEmpty
+    _ -> fail "invalid PrivHeader"
+
+serializeClientMessage :: ClientMessage -> ByteString
+serializeClientMessage (ClientMessage h msg) = serializePrivHeader h <> msg
+
+clientMessageP :: Parser ClientMessage
+clientMessageP = ClientMessage <$> privHeaderP <*> A.takeByteString
+
 -- | Base-64 encoded string.
 type Encoded = ByteString
 
@@ -240,7 +317,7 @@ instance IsString CorrId where
 data QueueIdsKeys = QIK
   { rcvId :: RecipientId,
     sndId :: SenderId,
-    rcvPublicDHKey :: RcvPublicDhKey
+    rcvPublicDhKey :: RcvPublicDhKey
   }
   deriving (Eq, Show)
 
@@ -253,10 +330,10 @@ type RcvPrivateSignKey = C.APrivateSignKey
 type RcvPublicVerifyKey = C.APublicVerifyKey
 
 -- | Public key used for DH exchange to encrypt message bodies from server to recipient
-type RcvPublicDhKey = C.PublicKey C.X25519
+type RcvPublicDhKey = C.PublicKeyX25519
 
 -- | DH Secret used to encrypt message bodies from server to recipient
-type RcvDhSecret = C.DhSecret C.X25519
+type RcvDhSecret = C.DhSecretX25519
 
 -- | Sender's private key used by the recipient to authorize (sign) SMP commands.
 --
@@ -292,6 +369,8 @@ data ErrorType
     QUOTA
   | -- | ACK command is sent without message to be acknowledged
     NO_MSG
+  | -- | sent message is too large (> maxMessageLength = 15968 bytes)
+    LARGE_MSG
   | -- | internal server error
     INTERNAL
   | -- | used internally, never returned by the server (to be removed)
@@ -302,8 +381,6 @@ data ErrorType
 data CommandError
   = -- | server response sent from client or vice versa
     PROHIBITED
-  | -- | bad RSA key size in NEW or KEY commands (only 1024, 2048 and 4096 bits keys are allowed)
-    KEY_SIZE
   | -- | error parsing command
     SYNTAX
   | -- | transmission has no required credentials (signature or queue ID)
@@ -322,8 +399,7 @@ instance Arbitrary CommandError where arbitrary = genericArbitraryU
 transmissionP :: Parser RawTransmission
 transmissionP = do
   signature <- segment
-  len <- A.decimal <* A.space
-  signed <- A.take len <* A.space
+  signed <- A.takeByteString
   either fail pure $ parseAll (trn signature signed) signed
   where
     segment = A.takeTill (== ' ') <* A.space
@@ -356,20 +432,17 @@ instance CommandI Cmd where
       <|> "ERR " *> serverError
       <|> "PONG" $> Cmd SBroker PONG
     where
-      newCmd = Cmd SRecipient <$> (NEW <$> C.strKeyP <* A.space <*> C.strKeyP)
+      newCmd = Cmd SRecipient <$> (NEW <$> C.strPubKeyP <* A.space <*> C.strPubKeyP)
       idsResp = Cmd SBroker . IDS <$> qik
-      qik = QIK <$> base64P <* A.space <*> base64P <* A.space <*> C.strKeyP
+      qik = QIK <$> base64P <* A.space <*> base64P <* A.space <*> C.strPubKeyP
       nIdsResp = Cmd SBroker . NID <$> base64P
-      keyCmd = Cmd SRecipient . KEY <$> C.strKeyP
-      nKeyCmd = Cmd SRecipient . NKEY <$> C.strKeyP
-      sendCmd = do
-        size <- A.decimal <* A.space
-        Cmd SSender . SEND <$> A.take size <* A.space
+      keyCmd = Cmd SRecipient . KEY <$> C.strPubKeyP
+      nKeyCmd = Cmd SRecipient . NKEY <$> C.strPubKeyP
+      sendCmd = Cmd SSender . SEND <$> A.takeByteString
       message = do
         msgId <- base64P <* A.space
         ts <- tsISO8601P <* A.space
-        size <- A.decimal <* A.space
-        Cmd SBroker . MSG msgId ts <$> A.take size <* A.space
+        Cmd SBroker . MSG msgId ts <$> A.takeByteString
       serverError = Cmd SBroker . ERR <$> errorTypeP
 
 instance CommandI ClientCmd where
@@ -393,20 +466,20 @@ instance PartyI p => CommandI (Command p) where
         Just Refl -> Right cmd
         _ -> Left "bad command party"
   serializeCommand = \case
-    NEW rKey dhKey -> B.unwords ["NEW", C.serializeKey rKey, C.serializeKey dhKey]
-    KEY sKey -> "KEY " <> C.serializeKey sKey
-    NKEY nKey -> "NKEY " <> C.serializeKey nKey
+    NEW rKey dhKey -> B.unwords ["NEW", C.serializePubKey rKey, C.serializePubKey' dhKey]
+    KEY sKey -> "KEY " <> C.serializePubKey sKey
+    NKEY nKey -> "NKEY " <> C.serializePubKey nKey
     SUB -> "SUB"
     ACK -> "ACK"
     OFF -> "OFF"
     DEL -> "DEL"
-    SEND msgBody -> "SEND " <> serializeBody msgBody
+    SEND msgBody -> "SEND " <> msgBody
     PING -> "PING"
     NSUB -> "NSUB"
     MSG msgId ts msgBody ->
-      B.unwords ["MSG", encode msgId, B.pack $ formatISO8601Millis ts, serializeBody msgBody]
+      B.unwords ["MSG", encode msgId, B.pack $ formatISO8601Millis ts, msgBody]
     IDS (QIK rcvId sndId srvDh) ->
-      B.unwords ["IDS", encode rcvId, encode sndId, C.serializeKey srvDh]
+      B.unwords ["IDS", encode rcvId, encode sndId, C.serializePubKey' srvDh]
     NID nId -> "NID " <> encode nId
     ERR err -> "ERR " <> serializeErrorType err
     NMSG -> "NMSG"
@@ -414,9 +487,6 @@ instance PartyI p => CommandI (Command p) where
     OK -> "OK"
     PONG -> "PONG"
 
-serializeBody :: ByteString -> ByteString
-serializeBody s = bshow (B.length s) <> " " <> s <> " "
-
 -- | SMP error parser.
 errorTypeP :: Parser ErrorType
 errorTypeP = "CMD " *> (CMD <$> parseRead1) <|> parseRead1
@@ -427,7 +497,7 @@ serializeErrorType = bshow
 
 -- | Send signed SMP transmission to TCP transport.
 tPut :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
-tPut th (sig, t) = tPutBlock th $ C.serializeSignature sig <> " " <> serializeBody t
+tPut th (sig, t) = tPutBlock th $ C.serializeSignature sig <> " " <> t
 
 serializeTransmission :: CommandI c => ByteString -> Transmission c -> ByteString
 serializeTransmission sessionId (CorrId corrId, queueId, command) =
@@ -447,7 +517,9 @@ fromServer = \case
 
 -- | Receive and parse transmission from the TCP transport (ignoring any trailing padding).
 tGetParse :: Transport c => THandle c -> IO (Either TransportError RawTransmission)
-tGetParse th = first (const TEBadBlock) . A.parseOnly transmissionP <$> tGetBlock th
+tGetParse th = (parseTransmission =<<) <$> tGetBlock th
+  where
+    parseTransmission = first (const TEBadBlock) . A.parseOnly transmissionP
 
 -- | Receive client and server transmissions.
 --

src/Simplex/Messaging/Server.hs

@@ -118,9 +118,8 @@ runSMPServerBlocking started cfg@ServerConfig {transports} = do
           atomically . stateTVar (clientSubs c) $ \ss -> (M.lookup qId ss, M.delete qId ss)
 
 runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m ()
-runClient _ h = do
-  ServerConfig {blockSize} <- asks config
-  liftIO (runExceptT $ serverHandshake h blockSize) >>= \case
+runClient _ h =
+  liftIO (runExceptT $ serverHandshake h) >>= \case
     Right th -> runClientTransport th
     Left _ -> pure ()
 
@@ -202,12 +201,6 @@ verifyTransmission sig_ signed queueId cmd = do
 -- by having the same time of the response whether a queue exists or nor, for all valid key/signature sizes
 dummyPublicKey :: C.Signature a -> C.PublicKey a
 dummyPublicKey = \case
-  C.SignatureRSA s' -> case B.length s' of
-    128 -> dummyKey128
-    256 -> dummyKey256
-    384 -> dummyKey384
-    512 -> dummyKey512
-    _ -> dummyKey256
   C.SignatureEd25519 _ -> dummyKeyEd25519
   C.SignatureEd448 _ -> dummyKeyEd448
 
@@ -217,18 +210,6 @@ dummyKeyEd25519 = "MCowBQYDK2VwAyEA139Oqs4QgpqbAmB0o7rZf6T19ryl7E65k4AYe0kE3Qs="
 dummyKeyEd448 :: C.PublicKey 'C.Ed448
 dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"
 
-dummyKey128 :: C.PublicKey 'C.RSA
-dummyKey128 = "MIIBIDANBgkqhkiG9w0BAQEFAAOCAQ0AMIIBCAKBgQC2oeA7s4roXN5K2N6022I1/2CTeMKjWH0m00bSZWa4N8LDKeFcShh8YUxZea5giAveViTRNOOVLgcuXbKvR3u24szN04xP0+KnYUuUUIIoT3YSjX0IlomhDhhSyup4BmA0gAZ+D1OaIKZFX6J8yQ1Lr/JGLEfSRsBjw8l+4hs9OwKBgQDKA+YlZvGb3BcpDwKmatiCXN7ZRDWkjXbj8VAW5zV95tSRCCVN48hrFM1H4Ju2QMMUc6kPUVX+eW4ZjdCl5blIqIHMcTmsdcmsDDCg3PjUNrwc6bv/1TcirbAKcmnKt9iurIt6eerxSO7TZUXXMUVsi7eRwb/RUNhpCrpJ/hpIOw=="
-
-dummyKey256 :: C.PublicKey 'C.RSA
-dummyKey256 = "MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAxwmTvaqmdTbkfUGNi8Yu0L/T4cxuOlQlx3zGZ9X9Qx0+oZjknWK+QHrdWTcpS+zH4Hi7fP6kanOQoQ90Hj6Ghl57VU1GEdUPywSw4i1/7t0Wv9uT9Q2ktHp2rqVo3xkC9IVIpL7EZAxdRviIN2OsOB3g4a/F1ZpjxcAaZeOMUugiAX1+GtkLuE0Xn4neYjCaOghLxQTdhybN70VtnkiQLx/X9NjkDIl/spYGm3tQFMyYKkP6IWoEpj0926hJ0fmlmhy8tAOhlZsb/baW5cgkEZ3E9jVVrySCgQzoLQgma610FIISRpRJbSyv26jU7MkMxiyuBiDaFOORkXFttoKbtQKBgEbDS9II2brsz+vfI7uP8atFcawkE52cx4M1UWQhqb1H3tBiRl+qO+dMq1pPQF2bW7dlZAWYzS4W/367bTAuALHBDGB8xi1P4Njhh9vaOgTvuqrHG9NJQ85BLy0qGw8rjIWSIXVmVpfrXFJ8po5l04UE258Ll2yocv3QRQmddQW9"
-
-dummyKey384 :: C.PublicKey 'C.RSA
-dummyKey384 = "MIICITANBgkqhkiG9w0BAQEFAAOCAg4AMIICCQKCAYEAthExp77lSFBMB0RedjgKIU+oNH5lMGdMqDCG0E5Ly7X49rFpfDMMN08GDIgvzg9kcwV3ScbPcjUE19wmAShX9f9k3w38KM3wmIBKSiuCREQl0V3xAYp1SYwiAkMNSSwxuIkDEeSOR56WdEcZvqbB4lY9MQlUv70KriPDxZaqKCTKslUezXHQuYPQX6eMnGFK7hxz5Kl5MajV52d+5iXsa8CA+m/e1KVnbelCO+xhN89xG8ALt0CJ9k5Wwo3myLgXi4dmNankCmg8jkh+7y2ywkzxMwH1JydDtV/FLzkbZsbPR2w93TNrTq1RJOuqMyh0VtdBSpxNW/Ft988TkkX2BAWzx82INw7W6/QbHGNtHNB995R4sgeYy8QbEpNGBhQnfQh7yRWygLTVXWKApQzzfCeIoDDWUS7dMv/zXoasAnpDBj+6UhHv3BHrps7kBvRyZQ2d/nUuAqiGd43ljJ++n6vNyFLgZoiV7HLia/FOGMkdt7j92CNmFHxiT6Xl7kRHAoGBAPNoWny2O7LBxzAKMLmQVHBAiKp6RMx+7URvtQDHDHPaZ7F3MvtvmYWwGzund3cQFAaV1EkJoYeI3YRuj6xdXgMyMaP54On++btArb6jUtZuvlC98qE8dEEHQNh+7TsCiMU+ivbeKFxS9A/B7OVedoMnPoJWhatbA9zB/6L1GNPh"
-
-dummyKey512 :: C.PublicKey 'C.RSA
-dummyKey512 = "MIICoDANBgkqhkiG9w0BAQEFAAOCAo0AMIICiAKCAgEArkCY9DuverJ4mmzDektv9aZMFyeRV46WZK9NsOBKEc+1ncqMs+LhLti9asKNgUBRbNzmbOe0NYYftrUpwnATaenggkTFxxbJ4JGJuGYbsEdFWkXSvrbWGtM8YUmn5RkAGme12xQ89bSM4VoJAGnrYPHwmcQd+KYCPZvTUsxaxgrJTX65ejHN9BsAn8XtGViOtHTDJO9yUMD2WrJvd7wnNa+0ugEteDLzMU++xS98VC+uA1vfauUqi3yXVchdfrLdVUuM+JE0gUEXCgzjuHkaoHiaGNiGhdPYoAJJdOKQOIHAKdk7Th6OPhirPhc9XYNB4O8JDthKhNtfokvFIFlC4QBRzJhpLIENaEBDt08WmgpOnecZB/CuxkqqOrNa8j5K5jNrtXAI67W46VEC2jeQy/gZwb64Zit2A4D00xXzGbQTPGj4ehcEMhLx5LSCygViEf0w0tN3c3TEyUcgPzvECd2ZVpQLr9Z4a07Ebr+YSuxcHhjg4Rg1VyJyOTTvaCBGm5X2B3+tI4NUttmikIHOYpBnsLmHY2BgfH2KcrIsDyAhInXmTFr/L2+erFarUnlfATd2L8Ti43TNHDedO6k6jI5Gyi62yPwjqPLEIIK8l+pIeNfHJ3pPmjhHBfzFcQLMMMXffHWNK8kWklrQXK+4j4HiPcTBvlO1FEtG9nEIZhUCgYA4a6WtI2k5YNli1C89GY5rGUY7RP71T6RWri/D3Lz9T7GvU+FemAyYmsvCQwqijUOur0uLvwSP8VdxpSUcrjJJSWur2hrPWzWlu0XbNaeizxpFeKbQP+zSrWJ1z8RwfAeUjShxt8q1TuqGqY10wQyp3nyiTGvS+KwZVj5h5qx8NQ=="
-
 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
 client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} =
   forever $
@@ -256,10 +237,10 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
             DEL -> delQueueAndMsgs st
       where
         createQueue :: QueueStore -> RcvPublicVerifyKey -> RcvPublicDhKey -> m BrokerTransmission
-        createQueue st recipientKey dhKey = checkKeySize recipientKey $ do
-          (rcvPublicDHKey, privDhKey) <- liftIO $ C.generateKeyPair' 0
+        createQueue st recipientKey dhKey = do
+          (rcvPublicDhKey, privDhKey) <- liftIO C.generateKeyPair'
           let rcvDhSecret = C.dh' dhKey privDhKey
-              qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDHKey}
+              qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey}
               qRec (recipientId, senderId) =
                 QueueRec
                   { recipientId,
@@ -270,7 +251,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
                     notifier = Nothing,
                     status = QueueActive
                   }
-          addQueueRetry 3 qik qRec
+          (corrId,queueId,) <$> addQueueRetry 3 qik qRec
           where
             addQueueRetry ::
               Int -> ((RecipientId, SenderId) -> QueueIdsKeys) -> ((RecipientId, SenderId) -> QueueRec) -> m (Command 'Broker)
@@ -299,10 +280,10 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
         secureQueue_ :: QueueStore -> SndPublicVerifyKey -> m BrokerTransmission
         secureQueue_ st sKey = do
           withLog $ \s -> logSecureQueue s queueId sKey
-          atomically . checkKeySize sKey $ either ERR (const OK) <$> secureQueue st queueId sKey
+          atomically $ (corrId,queueId,) . either ERR (const OK) <$> secureQueue st queueId sKey
 
         addQueueNotifier_ :: QueueStore -> NtfPublicVerifyKey -> m BrokerTransmission
-        addQueueNotifier_ st nKey = checkKeySize nKey $ addNotifierRetry 3
+        addQueueNotifier_ st nKey = (corrId,queueId,) <$> addNotifierRetry 3
           where
             addNotifierRetry :: Int -> m (Command 'Broker)
             addNotifierRetry 0 = pure $ ERR INTERNAL
@@ -315,13 +296,6 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
                   withLog $ \s -> logAddNotifier s queueId nId nKey
                   pure $ NID nId
 
-        checkKeySize :: Monad m' => C.APublicVerifyKey -> m' (Command 'Broker) -> m' BrokerTransmission
-        checkKeySize key action =
-          (corrId,queueId,)
-            <$> if C.validKeySize key
-              then action
-              else pure . ERR $ CMD KEY_SIZE
-
         suspendQueue_ :: QueueStore -> m BrokerTransmission
         suspendQueue_ st = do
           withLog (`logDeleteQueue` queueId)
@@ -361,30 +335,34 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
         withSub rId f = readTVar subscriptions >>= mapM f . M.lookup rId
 
         sendMessage :: QueueStore -> MsgBody -> m BrokerTransmission
-        sendMessage st msgBody = do
-          qr <- atomically $ getQueue st (CP SSender) queueId
-          either (return . err) storeMessage qr
+        sendMessage st msgBody
+          | B.length msgBody > maxMessageLength = pure $ err LARGE_MSG
+          | otherwise = do
+            qr <- atomically $ getQueue st (CP SSender) queueId
+            either (return . err) storeMessage qr
           where
             storeMessage :: QueueRec -> m BrokerTransmission
             storeMessage qr = case status qr of
               QueueOff -> return $ err AUTH
-              QueueActive -> do
-                ms <- asks msgStore
-                msg <- mkMessage
-                quota <- asks $ msgQueueQuota . config
-                atomically $ do
-                  q <- getMsgQueue ms (recipientId qr) quota
-                  ifM (isFull q) (pure $ err QUOTA) $ do
-                    trySendNotification
-                    writeMsg q msg
-                    pure ok
+              QueueActive ->
+                mkMessage >>= \case
+                  Left _ -> pure $ err LARGE_MSG
+                  Right msg -> do
+                    ms <- asks msgStore
+                    quota <- asks $ msgQueueQuota . config
+                    atomically $ do
+                      q <- getMsgQueue ms (recipientId qr) quota
+                      ifM (isFull q) (pure $ err QUOTA) $ do
+                        trySendNotification
+                        writeMsg q msg
+                        pure ok
               where
-                mkMessage :: m Message
+                mkMessage :: m (Either C.CryptoError Message)
                 mkMessage = do
                   msgId <- randomId =<< asks (msgIdBytes . config)
                   ts <- liftIO getCurrentTime
-                  let c = C.cbEncrypt (rcvDhSecret qr) (C.cbNonce msgId) msgBody
-                  return $ Message {msgId, ts, msgBody = c}
+                  let c = C.cbEncrypt (rcvDhSecret qr) (C.cbNonce msgId) msgBody (maxMessageLength + 2)
+                  pure $ Message msgId ts <$> c
 
                 trySendNotification :: STM ()
                 trySendNotification =

src/Simplex/Messaging/Server/Env/STM.hs

@@ -31,7 +31,6 @@ data ServerConfig = ServerConfig
     queueIdBytes :: Int,
     msgIdBytes :: Int,
     storeLog :: Maybe (StoreLog 'ReadMode),
-    blockSize :: Int,
     caCertificateFile :: FilePath,
     serverPrivateKeyFile :: FilePath,
     serverCertificateFile :: FilePath

src/Simplex/Messaging/Server/StoreLog.hs

@@ -62,36 +62,36 @@ storeLogRecordP =
     <|> "DELETE " *> (DeleteQueue <$> base64P)
   where
     createQueueP = CreateQueue <$> queueRecP
-    secureQueueP = SecureQueue <$> base64P <* A.space <*> C.strKeyP
+    secureQueueP = SecureQueue <$> base64P <* A.space <*> C.strPubKeyP
     addNotifierP =
-      AddNotifier <$> base64P <* A.space <*> base64P <* A.space <*> C.strKeyP
+      AddNotifier <$> base64P <* A.space <*> base64P <* A.space <*> C.strPubKeyP
     queueRecP = do
       recipientId <- "rid=" *> base64P
-      recipientKey <- " rk=" *> C.strKeyP
+      recipientKey <- " rk=" *> C.strPubKeyP
       rcvDhSecret <- " rdh=" *> C.strDhSecretP
       senderId <- " sid=" *> base64P
-      senderKey <- " sk=" *> optional C.strKeyP
-      notifier <- optional $ (,) <$> (" nid=" *> base64P) <*> (" nk=" *> C.strKeyP)
+      senderKey <- " sk=" *> optional C.strPubKeyP
+      notifier <- optional $ (,) <$> (" nid=" *> base64P) <*> (" nk=" *> C.strPubKeyP)
       pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier, status = QueueActive}
 
 serializeStoreLogRecord :: StoreLogRecord -> ByteString
 serializeStoreLogRecord = \case
   CreateQueue q -> "CREATE " <> serializeQueue q
-  SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializeKey sKey
-  AddNotifier rId nId nKey -> B.unwords ["NOTIFIER", encode rId, encode nId, C.serializeKey nKey]
+  SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializePubKey sKey
+  AddNotifier rId nId nKey -> B.unwords ["NOTIFIER", encode rId, encode nId, C.serializePubKey nKey]
   DeleteQueue rId -> "DELETE " <> encode rId
   where
     serializeQueue
       QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier} =
         B.unwords
           [ "rid=" <> encode recipientId,
-            "rk=" <> C.serializeKey recipientKey,
+            "rk=" <> C.serializePubKey recipientKey,
             "rdh=" <> C.serializeDhSecret rcvDhSecret,
             "sid=" <> encode senderId,
-            "sk=" <> maybe "" C.serializeKey senderKey
+            "sk=" <> maybe "" C.serializePubKey senderKey
           ]
           <> maybe "" serializeNotifier notifier
-    serializeNotifier (nId, nKey) = " nid=" <> encode nId <> " nk=" <> C.serializeKey nKey
+    serializeNotifier (nId, nKey) = " nid=" <> encode nId <> " nk=" <> C.serializePubKey nKey
 
 openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode)
 openWriteStoreLog f = WriteStoreLog f <$> openFile f WriteMode

src/Simplex/Messaging/Transport.hs

@@ -25,7 +25,10 @@
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
 module Simplex.Messaging.Transport
-  ( -- * Transport connection class
+  ( -- * SMP transport parameters
+    smpBlockSize,
+
+    -- * Transport connection class
     Transport (..),
     TProxy (..),
     ATransport (..),
@@ -67,6 +70,7 @@ import qualified Crypto.Store.X509 as SX
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
+import Data.Bitraversable (bimapM)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -97,6 +101,9 @@ import UnliftIO.Exception (Exception, IOException)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
+smpBlockSize :: Int
+smpBlockSize = 16384
+
 -- * Transport connection class
 
 class Transport c where
@@ -395,8 +402,7 @@ smpVersionP =
 -- | The handle for SMP encrypted transport connection over Transport .
 data THandle c = THandle
   { connection :: c,
-    sessionId :: ByteString,
-    blockSize :: Int
+    sessionId :: ByteString
   }
 
 data Handshake = Handshake
@@ -453,25 +459,23 @@ serializeTransportError = \case
 
 -- | Pad and send block to SMP transport.
 tPutBlock :: Transport c => THandle c -> ByteString -> IO (Either TransportError ())
-tPutBlock THandle {connection = c, blockSize} block
-  | len > blockSize = pure $ Left TELargeMsg
-  | otherwise = Right <$> cPut c (block <> B.replicate (blockSize - len) '#')
-  where
-    len = B.length block
+tPutBlock THandle {connection = c} block =
+  bimapM (const $ pure TELargeMsg) (cPut c) $
+    C.pad block smpBlockSize
 
 -- | Receive block from SMP transport.
-tGetBlock :: Transport c => THandle c -> IO ByteString
-tGetBlock THandle {connection = c, blockSize} =
-  cGet c blockSize >>= \case
+tGetBlock :: Transport c => THandle c -> IO (Either TransportError ByteString)
+tGetBlock THandle {connection = c} =
+  cGet c smpBlockSize >>= \case
     "" -> ioe_EOF
-    msg -> pure msg
+    msg -> pure . first (const TELargeMsg) $ C.unPad msg
 
 -- | Server SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-serverHandshake :: Transport c => c -> Int -> ExceptT TransportError IO (THandle c)
-serverHandshake c blockSize = do
-  let th@THandle {sessionId} = tHandle c blockSize
+serverHandshake :: Transport c => c -> ExceptT TransportError IO (THandle c)
+serverHandshake c = do
+  let th@THandle {sessionId} = tHandle c
   _ <- getPeerHello th
   sendHelloToPeer th sessionId
   pure th
@@ -479,9 +483,9 @@ serverHandshake c blockSize = do
 -- | Client SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-clientHandshake :: forall c. Transport c => c -> Int -> ExceptT TransportError IO (THandle c)
-clientHandshake c blockSize = do
-  let th@THandle {sessionId} = tHandle c blockSize
+clientHandshake :: forall c. Transport c => c -> ExceptT TransportError IO (THandle c)
+clientHandshake c = do
+  let th@THandle {sessionId} = tHandle c
   sendHelloToPeer th ""
   Handshake {sessionId = sessId} <- getPeerHello th
   if sessionId == sessId
@@ -494,11 +498,11 @@ sendHelloToPeer th sessionId =
    in ExceptT . tPutBlock th $ serializeHandshake handshake
 
 getPeerHello :: Transport c => THandle c -> ExceptT TransportError IO Handshake
-getPeerHello th = ExceptT $ parseHandshake <$> tGetBlock th
+getPeerHello th = ExceptT $ (parseHandshake =<<) <$> tGetBlock th
   where
     parseHandshake :: ByteString -> Either TransportError Handshake
     parseHandshake = first (const $ TEHandshake PARSE) . A.parseOnly handshakeP
 
-tHandle :: Transport c => c -> Int -> THandle c
-tHandle c blockSize =
-  THandle {connection = c, sessionId = encode $ tlsUnique c, blockSize}
+tHandle :: Transport c => c -> THandle c
+tHandle c =
+  THandle {connection = c, sessionId = encode $ tlsUnique c}