smp-server: reject corrId nonces of wrong size

tests/SMPProxyTests.hs

@@ -26,7 +26,7 @@ import qualified Data.List.NonEmpty as L
 import Data.Time.Clock (getCurrentTime)
 import SMPAgentClient
 import SMPClient
-import ServerTests (decryptMsgV3, sendRecv)
+import ServerTests (decryptMsgV3, sendRecv, wrongSizeCorrIds)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import qualified Simplex.Messaging.Agent as A
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..))
@@ -36,11 +36,13 @@ import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
+import Simplex.Messaging.Encoding (smpEncode)
 import Simplex.Messaging.Protocol (EncRcvMsgBody (..), MsgBody, QueueReqData (..), RcvMessage (..), SubscriptionMode (..), maxMessageLength, noMsgFlags)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (AStoreType (..), ServerConfig (..))
 import Simplex.Messaging.Server.MsgStore.Types (SQSType (..))
 import Simplex.Messaging.Transport
+import qualified Simplex.Messaging.Transport.Client as TC
 import Simplex.Messaging.Util (bshow, tshow)
 import Simplex.Messaging.Version (mkVersionRange)
 import System.FilePath (splitExtensions)
@@ -58,6 +60,9 @@ smpProxyTests = do
   describe "server configuration" $ do
     it "refuses proxy handshake unless enabled" testNoProxy
     it "checks basic auth in proxy requests" testProxyAuth
+  describe "corrId used as nonce" $ do
+    it "proxy rejects PFWD with corrId of wrong size" testPFWDCorrIdSize
+    it "relay rejects RFWD with corrId of wrong size" testRFWDCorrIdSize
   describe "relay reconnection" $ do
     it "recovers when unresponsive relay restarts (control, no disconnect)" $ \_ ->
       testProxyRecoversWithoutDisconnect
@@ -441,6 +446,48 @@ testProxyAuth msType = do
   where
     proxyCfgAuth = updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {newQueueBasicAuth = Just "correct"}
 
+testPFWDCorrIdSize :: AStoreType -> IO ()
+testPFWDCorrIdSize msType =
+  withSmpServerConfigOn (transport @TLS) (proxyCfgMS msType) testPort $ \_ ->
+    testSMPClient_ "127.0.0.1" testPort supportedServerSMPRelayVRange Nothing $ \(th@THandle {params} :: THandleSMP TLS 'TClient) -> do
+      g <- C.newRandom
+      (cmdKey, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      let pfwd corrId = do
+            (_, _, reply) <- sendRecv th (Nothing, corrId, SMP.EntityId "unknown session", SMP.PFWD (thVersion params) cmdKey $ SMP.EncTransmission "invalid")
+            pure reply
+      corrId <- atomically $ C.randomBytes 24 g
+      pfwd corrId `shouldReturn` Right (SMP.ERR $ SMP.PROXY SMP.NO_SESSION)
+      forM_ (wrongSizeCorrIds corrId) $ \badCorrId ->
+        pfwd badCorrId `shouldReturn` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX)
+
+testRFWDCorrIdSize :: AStoreType -> IO ()
+testRFWDCorrIdSize msType =
+  withSmpServerConfigOn (transport @TLS) (cfgMS msType) testPort2 $ \_ ->
+    testProxyModeClient $ \th@THandle {params = THandleParams {thVersion, thAuth}} -> do
+      Just THAuthClient {sessSecret = Just sessSecret} <- pure thAuth
+      g <- C.newRandom
+      (fwdKey, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      let rfwd corrId fwdCorrId = do
+            let fwdT = SMP.FwdTransmission {fwdCorrId = SMP.CorrId fwdCorrId, fwdVersion = thVersion, fwdKey, fwdTransmission = SMP.EncTransmission "invalid"}
+                eft = SMP.EncFwdTransmission $ C.cbEncryptNoPad sessSecret (C.cbNonce corrId) (smpEncode fwdT)
+            (_, _, reply) <- sendRecv th (Nothing, corrId, NoEntity, SMP.RFWD eft)
+            pure reply
+      corrId <- atomically $ C.randomBytes 24 g
+      fwdCorrId <- atomically $ C.randomBytes 24 g
+      rfwd corrId fwdCorrId `shouldReturn` Right (SMP.ERR SMP.CRYPTO)
+      forM_ (wrongSizeCorrIds corrId) $ \badCorrId -> do
+        rfwd badCorrId fwdCorrId `shouldReturn` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX)
+        rfwd corrId badCorrId `shouldReturn` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX)
+
+-- Connect to the relay on testPort2 the same way the proxy does, with the session secret.
+testProxyModeClient :: (THandleSMP TLS 'TClient -> IO a) -> IO a
+testProxyModeClient client = do
+  g <- C.newRandom
+  ks <- atomically $ C.generateKeyPair g
+  let tcConfig = TC.defaultTransportClientConfig {TC.clientALPN = Just alpnSupportedSMPHandshakes}
+  TC.runTransportClient tcConfig Nothing "127.0.0.1" testPort2 (Just testKeyHash) $ \h ->
+    runExceptT (smpClientHandshake h (Just ks) testKeyHash supportedClientSMPRelayVRange True Nothing) >>= either (fail . show) client
+
 -- Connect a sender client to the proxy and request a relay session to testSMPServer2 (PRXY).
 -- On success the reply is PKEY; otherwise it is the proxy error for the relay connection.
 requestRelaySession :: IO (Either SMP.ErrorType SMP.BrokerMsg)

tests/ServerTests.hs

@@ -97,6 +97,7 @@ serverTests = do
   describe "Restore messages (old / v2)" testRestoreExpireMessages
   describe "Save prometheus metrics" testPrometheusMetrics
   describe "Timing of AUTH error" testTiming
+  describe "Authenticator nonce" testAuthenticatorCorrIdSize
   describe "Message notifications" $ do
     testMessageNotifications
     testMessageServiceNotifications
@@ -1302,9 +1303,9 @@ testTiming =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" NoEntity (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", NoEntity, New rPub dhPub)
+      Resp "abcdabcdabcdabcdabcdabcd" NoEntity (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcdabcdabcdabcdabcdabcd", NoEntity, New rPub dhPub)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
-      Resp "cdab" _ resp <- signSendRecv rh rKey ("cdab", rId, SUB)
+      Resp "cdabcdabcdabcdabcdabcdab" _ resp <- signSendRecv rh rKey ("cdabcdabcdabcdabcdabcdab", rId, SUB)
       case resp of
         OK -> pure ()
         SOK Nothing -> pure ()
@@ -1314,9 +1315,9 @@ testTiming =
       runTimingTest rh badKey rId SUB
 
       (sPub, sKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
-      Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, KEY sPub)
+      Resp "dabcdabcdabcdabcdabcdabc" _ OK <- signSendRecv rh rKey ("dabcdabcdabcdabcdabcdabc", rId, KEY sPub)
 
-      Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, _SEND "hello")
+      Resp "bcdabcdabcdabcdabcdabcda" _ OK <- signSendRecv sh sKey ("bcdabcdabcdabcdabcdabcda", sId, _SEND "hello")
       Resp "" _ (Msg mId msg) <- tGet1 rh
       (dec mId msg, Right "hello") #== "delivered from queue"
 
@@ -1327,15 +1328,15 @@ testTiming =
           threadDelay 100000
           _ <- timeRepeat n $ do
             -- "warm up" the server
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd)
+            Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd)
             return ()
           threadDelay 100000
           timeWrongKey <- timeRepeat n $ do
-            Resp "cdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdab", qId, cmd)
+            Resp "cdabcdabcdabcdabcdabcdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdabcdabcdabcdabcdabcdab", qId, cmd)
             return ()
           threadDelay 100000
           timeNoQueue <- timeRepeat n $ do
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd)
+            Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd)
             return ()
           let ok = similarTime timeNoQueue timeWrongKey msType
           unless ok . putStrLn . unwords $
@@ -1347,6 +1348,35 @@ testTiming =
             ]
           ok `shouldBe` True
 
+testAuthenticatorCorrIdSize :: SpecWith (ASrvTransport, AStoreType)
+testAuthenticatorCorrIdSize =
+  it "should reject X25519 authenticator unless corrId is 24 bytes" $ \(ATransport t, msType) ->
+    smpTest2 t msType $ \r s -> do
+      g <- C.newRandom
+      let newCorrId = atomically $ C.randomBytes 24 g
+          rejected cId entId = (CorrId cId, entId, Right (ERR $ CMD SYNTAX))
+      badCorrIds <- wrongSizeCorrIds <$> newCorrId
+      (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SX25519 g
+      (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      forM_ badCorrIds $ \cId ->
+        signSendRecv r rKey (cId, NoEntity, New rPub dhPub) `shouldReturn` rejected cId NoEntity
+      corrId1 <- newCorrId
+      Resp _ NoEntity (Ids rId sId srvDh) <- signSendRecv r rKey (corrId1, NoEntity, New rPub dhPub)
+      (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      corrId2 <- newCorrId
+      Resp _ _ OK <- signSendRecv r rKey (corrId2, rId, KEY sPub)
+      Resp "bcda" _ OK <- signSendRecv s sKey ("bcda", sId, _SEND "hello")
+      Resp "" _ (Msg mId msg) <- tGet1 r
+      (decryptMsgV3 (C.dh' srvDh dhPriv) mId msg, Right "hello") #== "delivered from queue"
+      forM_ badCorrIds $ \cId ->
+        signSendRecv r rKey (cId, rId, ACK mId) `shouldReturn` rejected cId rId
+      corrId3 <- newCorrId
+      Resp _ _ OK <- signSendRecv r rKey (corrId3, rId, ACK mId)
+      pure ()
+
+wrongSizeCorrIds :: ByteString -> [ByteString]
+wrongSizeCorrIds corrId = ["", B.take 4 corrId, corrId <> "x"]
+
 testMessageNotifications :: SpecWith (ASrvTransport, AStoreType)
 testMessageNotifications =
   it "should create simplex connection, subscribe notifier and deliver notifications" $ \(ATransport t, msType) -> do