encrypt recipient message bodies with crypto_box

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 (second)
+import Data.Bifunctor (first, second)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:), (.:.))
@@ -526,10 +526,11 @@ 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 {status} =
+    processSMP cType ConnData {connId} rq@RcvQueue {rcvDhSecret, status} =
       case cmd of
-        SMP.MSG srvMsgId srvTs msgBody -> do
+        SMP.MSG srvMsgId srvTs msgBody' -> 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

src/Simplex/Messaging/Agent/Client.hs

@@ -387,7 +387,7 @@ encryptAndSign smp SndQueue {encryptKey, signKey} msg = do
     sig <- C.sign signKey enc
     pure $ C.signatureBytes sig <> enc
 
-decryptAndVerify :: AgentMonad m => RcvQueue -> ByteString -> m ByteString
+decryptAndVerify :: AgentMonad m => RcvQueue -> MsgBody -> m ByteString
 decryptAndVerify RcvQueue {decryptKey, verifyKey} msg =
   verifyMessage verifyKey msg
     >>= liftError cryptoError . C.decrypt decryptKey

src/Simplex/Messaging/Agent/Store.hs

@@ -22,7 +22,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
   ( MsgBody,
     MsgId,
-    RcvDHSecret,
+    RcvDhSecret,
     RcvPrivateSignKey,
     RcvPublicVerifyKey,
     SndPrivateSignKey,
@@ -83,7 +83,7 @@ data RcvQueue = RcvQueue
     -- | key used by the recipient to verify server transmissions
     rcvSrvVerifyKey :: RcvPublicVerifyKey,
     -- | shared DH secret used to encrypt/decrypt message bodies from server to recipient
-    rcvDhSecret :: RcvDHSecret,
+    rcvDhSecret :: RcvDhSecret,
     -- | sender queue ID
     sndId :: Maybe SMP.SenderId,
     -- | key used by the sender to sign transmissions

src/Simplex/Messaging/Client.hs

@@ -261,7 +261,7 @@ createSMPQueue ::
   SMPClient ->
   RcvPrivateSignKey ->
   RcvPublicVerifyKey ->
-  RcvPublicDHKey ->
+  RcvPublicDhKey ->
   ExceptT SMPClientError IO QueueIdsKeys
 createSMPQueue c rpKey rKey dhKey =
   -- TODO add signing this request too - requires changes in the server

src/Simplex/Messaging/Crypto.hs

@@ -96,6 +96,7 @@ module Simplex.Messaging.Crypto
     -- * NaCl crypto_box
     cbEncrypt,
     cbDecrypt,
+    cbNonce,
 
     -- * Encoding of RSA keys
     publicKeyHash,
@@ -1010,6 +1011,14 @@ cbDecrypt secret nonce packet
     (rs, msg) = xSalsa20 secret nonce c
     tag = Poly1305.auth rs c
 
+cbNonce :: ByteString -> ByteString
+cbNonce s
+  | len == 24 = s
+  | len > 24 = fst $ B.splitAt 24 s
+  | otherwise = s <> B.replicate (24 - len) (toEnum 0)
+  where
+    len = B.length s
+
 xSalsa20 :: DhSecret X25519 -> ByteString -> ByteString -> (ByteString, ByteString)
 xSalsa20 (DhSecretX25519 shared) nonce msg = (rs, msg')
   where

src/Simplex/Messaging/Protocol.hs

@@ -45,8 +45,8 @@ module Simplex.Messaging.Protocol
     NotifierId,
     RcvPrivateSignKey,
     RcvPublicVerifyKey,
-    RcvPublicDHKey,
-    RcvDHSecret,
+    RcvPublicDhKey,
+    RcvDhSecret,
     SndPrivateSignKey,
     SndPublicVerifyKey,
     NtfPrivateSignKey,
@@ -146,7 +146,7 @@ type QueueId = Encoded
 -- | Parameterized type for SMP protocol commands from all participants.
 data Command (a :: Party) where
   -- SMP recipient commands
-  NEW :: RcvPublicVerifyKey -> RcvPublicDHKey -> Command Recipient
+  NEW :: RcvPublicVerifyKey -> RcvPublicDhKey -> Command Recipient
   SUB :: Command Recipient
   KEY :: SndPublicVerifyKey -> Command Recipient
   NKEY :: NtfPublicVerifyKey -> Command Recipient
@@ -187,7 +187,7 @@ instance IsString CorrId where
 data QueueIdsKeys = QIK
   { rcvId :: RecipientId,
     rcvSrvVerifyKey :: RcvPublicVerifyKey,
-    rcvPublicDHKey :: RcvPublicDHKey,
+    rcvPublicDHKey :: RcvPublicDhKey,
     sndId :: SenderId,
     sndSrvVerifyKey :: SndPublicVerifyKey
   }
@@ -202,10 +202,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.PublicKey C.X25519
 
 -- | DH Secret used to encrypt message bodies from server to recipient
-type RcvDHSecret = C.DhSecret C.X25519
+type RcvDhSecret = C.DhSecret C.X25519
 
 -- | Sender's private key used by the recipient to authorize (sign) SMP commands.
 --

src/Simplex/Messaging/Server.hs

@@ -243,7 +243,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server
           OFF -> suspendQueue_ st
           DEL -> delQueueAndMsgs st
       where
-        createQueue :: QueueStore -> RcvPublicVerifyKey -> RcvPublicDHKey -> m Transmission
+        createQueue :: QueueStore -> RcvPublicVerifyKey -> RcvPublicDhKey -> m Transmission
         createQueue st recipientKey dhKey = checkKeySize recipientKey $ do
           C.SignAlg a <- asks $ trnSignAlg . config
           (rcvPublicDHKey, privDhKey) <- liftIO $ C.generateKeyPair' 0
@@ -358,12 +358,6 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server
           qr <- atomically $ getQueue st SSender queueId
           either (return . err) storeMessage qr
           where
-            mkMessage :: m Message
-            mkMessage = do
-              msgId <- asks (msgIdBytes . config) >>= randomId
-              ts <- liftIO getCurrentTime
-              return $ Message {msgId, ts, msgBody}
-
             storeMessage :: QueueRec -> m Transmission
             storeMessage qr = case status qr of
               QueueOff -> return $ err AUTH
@@ -378,6 +372,13 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server
                     writeMsg q msg
                     pure ok
               where
+                mkMessage :: m 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}
+
                 trySendNotification :: STM ()
                 trySendNotification =
                   forM_ (notifier qr) $ \(nId, _) ->
@@ -420,6 +421,9 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server
             setDelivered :: STM (Maybe Bool)
             setDelivered = withSub rId $ \s -> tryPutTMVar (delivered s) ()
 
+            msgCmd :: Message -> Command 'Broker
+            msgCmd Message {msgId, ts, msgBody} = MSG msgId ts msgBody
+
         delQueueAndMsgs :: QueueStore -> m Transmission
         delQueueAndMsgs st = do
           withLog (`logDeleteQueue` queueId)
@@ -438,9 +442,6 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server
         okResp :: Either ErrorType () -> Transmission
         okResp = either err $ const ok
 
-        msgCmd :: Message -> Command 'Broker
-        msgCmd Message {msgId, ts, msgBody} = MSG msgId ts msgBody
-
 withLog :: (MonadUnliftIO m, MonadReader Env m) => (StoreLog 'WriteMode -> IO a) -> m ()
 withLog action = do
   env <- ask

src/Simplex/Messaging/Server/QueueStore.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Messaging.Server.QueueStore where
 
@@ -12,7 +11,7 @@ data QueueRec = QueueRec
     senderId :: SenderId,
     recipientKey :: RcvPublicVerifyKey,
     rcvSrvSignKey :: RcvPrivateSignKey,
-    rcvDhSecret :: RcvDHSecret,
+    rcvDhSecret :: RcvDhSecret,
     senderKey :: Maybe SndPublicVerifyKey,
     sndSrvSignKey :: SndPrivateSignKey,
     notifier :: Maybe (NotifierId, NtfPublicVerifyKey),