agent: send CON to user when the 1st party responds HELLO; fix REPLY vulnerability (#130)

* agent: send CON to user when the 1st party responds HELLO; fix REPLY vulnerability

* test for getRcvConn

* add commented OK response to JOIN command

* store: use Only newtype to select one field

src/Simplex/Messaging/Agent.hs

@@ -165,7 +165,8 @@ processCommand c@AgentClient {sndQ} st (corrId, connAlias, cmd) =
       withStore $ createSndConn st sq
       connectToSendQueue c st sq senderKey verifyKey
       when (replyMode == On) $ createReplyQueue sq
-      respond CON
+    -- TODO this response is disabled to avoid two responses in terminal client (OK + CON),
+    -- respond OK
 
     subscribeConnection :: ConnAlias -> m ()
     subscribeConnection cAlias =
@@ -257,15 +258,44 @@ subscriber c@AgentClient {msgQ} st = forever $ do
 
 processSMPTransmission :: forall m. AgentMonad m => AgentClient -> SQLiteStore -> SMPServerTransmission -> m ()
 processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
-  rq@RcvQueue {connAlias, status} <- withStore $ getRcvQueue st srv rId
-  case cmd of
-    SMP.MSG srvMsgId srvTs msgBody -> do
-      -- TODO deduplicate with previously received
-      msg <- decryptAndVerify rq msgBody
-      let msgHash = C.sha256Hash msg
-      agentMsg <- liftEither $ parseSMPMessage msg
-      case agentMsg of
-        SMPConfirmation senderKey -> do
+  withStore (getRcvConn st srv rId) >>= \case
+    SomeConn SCDuplex (DuplexConnection _ rq _) -> processSMP SCDuplex rq
+    SomeConn SCRcv (RcvConnection _ rq) -> processSMP SCRcv rq
+    _ -> atomically $ writeTBQueue sndQ ("", "", ERR $ CONN SIMPLEX)
+  where
+    processSMP :: SConnType c -> RcvQueue -> m ()
+    processSMP cType rq@RcvQueue {connAlias, status} =
+      case cmd of
+        SMP.MSG srvMsgId srvTs msgBody -> do
+          -- TODO deduplicate with previously received
+          msg <- decryptAndVerify rq msgBody
+          let msgHash = C.sha256Hash msg
+          agentMsg <- liftEither $ parseSMPMessage msg
+          case agentMsg of
+            SMPConfirmation senderKey -> smpConfirmation senderKey
+            SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} ->
+              case agentMessage of
+                HELLO verifyKey _ -> helloMsg verifyKey msgBody
+                REPLY qInfo -> replyMsg qInfo
+                A_MSG body -> agentClientMsg previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash
+          sendAck c rq
+          return ()
+        SMP.END -> do
+          removeSubscription c connAlias
+          logServer "<--" c srv rId "END"
+          notify END
+        _ -> do
+          logServer "<--" c srv rId $ "unexpected: " <> bshow cmd
+          notify . ERR $ BROKER UNEXPECTED
+      where
+        notify :: ACommand 'Agent -> m ()
+        notify msg = atomically $ writeTBQueue sndQ ("", connAlias, msg)
+
+        prohibited :: m ()
+        prohibited = notify . ERR $ AGENT A_PROHIBITED
+
+        smpConfirmation :: SenderPublicKey -> m ()
+        smpConfirmation senderKey = do
           logServer "<--" c srv rId "MSG <KEY>"
           case status of
             New -> do
@@ -275,68 +305,64 @@ processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
               -- TODO update sender key in the store?
               secureQueue c rq senderKey
               withStore $ setRcvQueueStatus st rq Secured
-            _ -> notify connAlias . ERR $ AGENT A_PROHIBITED
-        SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} ->
-          case agentMessage of
-            HELLO verifyKey _ -> do
-              logServer "<--" c srv rId "MSG <HELLO>"
-              case status of
-                Active -> notify connAlias . ERR $ AGENT A_PROHIBITED
-                _ -> do
-                  void $ verifyMessage (Just verifyKey) msgBody
-                  withStore $ setRcvQueueActive st rq verifyKey
-            REPLY qInfo -> do
-              logServer "<--" c srv rId "MSG <REPLY>"
+            _ -> prohibited
+
+        helloMsg :: SenderPublicKey -> ByteString -> m ()
+        helloMsg verifyKey msgBody = do
+          logServer "<--" c srv rId "MSG <HELLO>"
+          case status of
+            Active -> prohibited
+            _ -> do
+              void $ verifyMessage (Just verifyKey) msgBody
+              withStore $ setRcvQueueActive st rq verifyKey
+              case cType of
+                SCDuplex -> notify CON
+                _ -> pure ()
+
+        replyMsg :: SMPQueueInfo -> m ()
+        replyMsg qInfo = do
+          logServer "<--" c srv rId "MSG <REPLY>"
+          case cType of
+            SCRcv -> do
               (sq, senderKey, verifyKey) <- newSendQueue qInfo connAlias
               withStore $ upgradeRcvConnToDuplex st connAlias sq
               connectToSendQueue c st sq senderKey verifyKey
-              notify connAlias CON
-            A_MSG body -> agentClientMsg rq previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash
-      sendAck c rq
-      return ()
-    SMP.END -> do
-      removeSubscription c connAlias
-      logServer "<--" c srv rId "END"
-      notify connAlias END
-    _ -> do
-      logServer "<--" c srv rId $ "unexpected: " <> bshow cmd
-      notify connAlias . ERR $ BROKER UNEXPECTED
-  where
-    notify :: ConnAlias -> ACommand 'Agent -> m ()
-    notify connAlias msg = atomically $ writeTBQueue sndQ ("", connAlias, msg)
-    agentClientMsg :: RcvQueue -> PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m ()
-    agentClientMsg rq@RcvQueue {connAlias, status} receivedPrevMsgHash senderMeta brokerMeta msgBody msgHash = do
-      logServer "<--" c srv rId "MSG <MSG>"
-      case status of
-        Active -> do
-          internalTs <- liftIO getCurrentTime
-          (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore $ updateRcvIds st rq
-          let msgIntegrity = checkMsgIntegrity prevExtSndId (fst senderMeta) prevRcvMsgHash
-          withStore $
-            createRcvMsg st rq $
-              RcvMsgData
-                { internalId,
-                  internalRcvId,
-                  internalTs,
-                  senderMeta,
-                  brokerMeta,
-                  msgBody,
-                  internalHash = msgHash,
-                  externalPrevSndHash = receivedPrevMsgHash,
-                  msgIntegrity
-                }
-          notify connAlias $
-            MSG
-              { recipientMeta = (unId internalId, internalTs),
-                senderMeta,
-                brokerMeta,
-                msgBody,
-                msgIntegrity
-              }
-        _ -> notify connAlias . ERR $ AGENT A_PROHIBITED
-      where
-        checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> MsgIntegrity
-        checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash
+              notify CON
+            _ -> prohibited
+
+        agentClientMsg :: PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m ()
+        agentClientMsg receivedPrevMsgHash senderMeta brokerMeta msgBody msgHash = do
+          logServer "<--" c srv rId "MSG <MSG>"
+          case status of
+            Active -> do
+              internalTs <- liftIO getCurrentTime
+              (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore $ updateRcvIds st rq
+              let msgIntegrity = checkMsgIntegrity prevExtSndId (fst senderMeta) prevRcvMsgHash receivedPrevMsgHash
+              withStore $
+                createRcvMsg st rq $
+                  RcvMsgData
+                    { internalId,
+                      internalRcvId,
+                      internalTs,
+                      senderMeta,
+                      brokerMeta,
+                      msgBody,
+                      internalHash = msgHash,
+                      externalPrevSndHash = receivedPrevMsgHash,
+                      msgIntegrity
+                    }
+              notify
+                MSG
+                  { recipientMeta = (unId internalId, internalTs),
+                    senderMeta,
+                    brokerMeta,
+                    msgBody,
+                    msgIntegrity
+                  }
+            _ -> prohibited
+
+        checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity
+        checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash receivedPrevMsgHash
           | extSndId == prevExtSndId + 1 && internalPrevMsgHash == receivedPrevMsgHash = MsgOk
           | extSndId < prevExtSndId = MsgError $ MsgBadId extSndId
           | extSndId == prevExtSndId = MsgError MsgDuplicate -- ? deduplicate

src/Simplex/Messaging/Agent/Store.hs

@@ -34,7 +34,7 @@ class Monad m => MonadAgentStore s m where
   createSndConn :: s -> SndQueue -> m ()
   getConn :: s -> ConnAlias -> m SomeConn
   getAllConnAliases :: s -> m [ConnAlias] -- TODO remove - hack for subscribing to all
-  getRcvQueue :: s -> SMPServer -> SMP.RecipientId -> m RcvQueue
+  getRcvConn :: s -> SMPServer -> SMP.RecipientId -> m SomeConn
   deleteConn :: s -> ConnAlias -> m ()
   upgradeRcvConnToDuplex :: s -> ConnAlias -> SndQueue -> m ()
   upgradeSndConnToDuplex :: s -> ConnAlias -> RcvQueue -> m ()
@@ -148,6 +148,7 @@ type PrevRcvMsgHash = MsgHash
 type PrevSndMsgHash = MsgHash
 
 -- ? merge/replace these with RcvMsg and SndMsg
+
 -- * Message data containers - used on Msg creation to reduce number of parameters
 
 data RcvMsgData = RcvMsgData

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

@@ -29,7 +29,7 @@ import Data.Maybe (fromMaybe)
 import Data.Text (isPrefixOf)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8)
-import Database.SQLite.Simple (FromRow, NamedParam (..), SQLData (..), SQLError, field)
+import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLData (..), SQLError, field)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.FromField
 import Database.SQLite.Simple.Internal (Field (..))
@@ -115,26 +115,20 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
       r <- DB.query_ dbConn "SELECT conn_alias FROM connections;" :: IO [[ConnAlias]]
       return (concat r)
 
-  getRcvQueue :: SQLiteStore -> SMPServer -> SMP.RecipientId -> m RcvQueue
-  getRcvQueue SQLiteStore {dbConn} SMPServer {host, port} rcvId = do
-    r <-
-      liftIO $
-        DB.queryNamed
-          dbConn
-          [sql|
-            SELECT
-              s.key_hash, q.host, q.port, q.rcv_id, q.conn_alias, q.rcv_private_key,
-              q.snd_id, q.snd_key, q.decrypt_key, q.verify_key, q.status
-            FROM rcv_queues q
-            INNER JOIN servers s ON q.host = s.host AND q.port = s.port
-            WHERE q.host = :host AND q.port = :port AND q.rcv_id = :rcv_id;
-          |]
-          [":host" := host, ":port" := serializePort_ port, ":rcv_id" := rcvId]
-    case r of
-      [(keyHash, hst, prt, rId, connAlias, rcvPrivateKey, sndId, sndKey, decryptKey, verifyKey, status)] ->
-        let srv = SMPServer hst (deserializePort_ prt) keyHash
-         in pure $ RcvQueue srv rId connAlias rcvPrivateKey sndId sndKey decryptKey verifyKey status
-      _ -> throwError SEConnNotFound
+  getRcvConn :: SQLiteStore -> SMPServer -> SMP.RecipientId -> m SomeConn
+  getRcvConn SQLiteStore {dbConn} SMPServer {host, port} rcvId =
+    liftIOEither . DB.withTransaction dbConn $
+      DB.queryNamed
+        dbConn
+        [sql|
+          SELECT q.conn_alias
+          FROM rcv_queues q
+          WHERE q.host = :host AND q.port = :port AND q.rcv_id = :rcv_id;
+        |]
+        [":host" := host, ":port" := serializePort_ port, ":rcv_id" := rcvId]
+        >>= \case
+          [Only connAlias] -> getConn_ dbConn connAlias
+          _ -> pure $ Left SEConnNotFound
 
   deleteConn :: SQLiteStore -> ConnAlias -> m ()
   deleteConn SQLiteStore {dbConn} connAlias =

tests/AgentTests.hs

@@ -87,7 +87,7 @@ testDuplexConnection :: Handle -> Handle -> IO ()
 testDuplexConnection alice bob = do
   ("1", "bob", Right (INV qInfo)) <- alice #: ("1", "bob", "NEW")
   let qInfo' = serializeSmpQueueInfo qInfo
-  bob #: ("11", "alice", "JOIN " <> qInfo') #> ("11", "alice", CON)
+  bob #: ("11", "alice", "JOIN " <> qInfo') #> ("", "alice", CON)
   alice <# ("", "bob", CON)
   alice #: ("2", "bob", "SEND :hello") =#> \case ("2", "bob", SENT 1) -> True; _ -> False
   alice #: ("3", "bob", "SEND :how are you?") =#> \case ("3", "bob", SENT 2) -> True; _ -> False
@@ -106,7 +106,7 @@ testSubscription :: Handle -> Handle -> Handle -> IO ()
 testSubscription alice1 alice2 bob = do
   ("1", "bob", Right (INV qInfo)) <- alice1 #: ("1", "bob", "NEW")
   let qInfo' = serializeSmpQueueInfo qInfo
-  bob #: ("11", "alice", "JOIN " <> qInfo') #> ("11", "alice", CON)
+  bob #: ("11", "alice", "JOIN " <> qInfo') #> ("", "alice", CON)
   bob #: ("12", "alice", "SEND 5\nhello") =#> \case ("12", "alice", SENT _) -> True; _ -> False
   bob #: ("13", "alice", "SEND 11\nhello again") =#> \case ("13", "alice", SENT _) -> True; _ -> False
   alice1 <# ("", "bob", CON)

tests/AgentTests/SQLiteTests.hs

@@ -64,7 +64,7 @@ storeTests = withStore do
         testCreateSndConn
         testCreateSndConnDuplicate
       describe "getAllConnAliases" testGetAllConnAliases
-      describe "getRcvQueue" testGetRcvQueue
+      describe "getRcvConn" testGetRcvConn
       describe "deleteConn" do
         testDeleteRcvConn
         testDeleteSndConn
@@ -178,14 +178,14 @@ testGetAllConnAliases = do
     getAllConnAliases store
       `returnsResult` ["conn1" :: ConnAlias, "conn2" :: ConnAlias]
 
-testGetRcvQueue :: SpecWith SQLiteStore
-testGetRcvQueue = do
-  it "should get RcvQueue" $ \store -> do
+testGetRcvConn :: SpecWith SQLiteStore
+testGetRcvConn = do
+  it "should get connection using rcv queue id and server" $ \store -> do
     let smpServer = SMPServer "smp.simplex.im" (Just "5223") testKeyHash
     let recipientId = "1234"
     _ <- runExceptT $ createRcvConn store rcvQueue1
-    getRcvQueue store smpServer recipientId
-      `returnsResult` rcvQueue1
+    getRcvConn store smpServer recipientId
+      `returnsResult` SomeConn SCRcv (RcvConnection (connAlias (rcvQueue1 :: RcvQueue)) rcvQueue1)
 
 testDeleteRcvConn :: SpecWith SQLiteStore
 testDeleteRcvConn = do