agent: api to get hash of ratchet associated data for connection verification (#577)

* agent: api to get hash of ratchet associated data for connection verification

* enable all tests

* correction

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

src/Simplex/Messaging/Agent.hs

@@ -62,6 +62,7 @@ module Simplex.Messaging.Agent
     suspendConnection,
     deleteConnection,
     getConnectionServers,
+    getConnectionRatchetAdHash,
     setSMPServers,
     testSMPServerConnection,
     setNtfServers,
@@ -116,7 +117,7 @@ import Simplex.Messaging.Client (ProtocolClient (..), ServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId)
 import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..))
 import Simplex.Messaging.Notifications.Types
@@ -248,6 +249,10 @@ deleteConnection c = withAgentEnv c . deleteConnection' c
 getConnectionServers :: AgentErrorMonad m => AgentClient -> ConnId -> m ConnectionStats
 getConnectionServers c = withAgentEnv c . getConnectionServers' c
 
+-- | get connection ratchet associated data hash for verification (should match peer AD hash)
+getConnectionRatchetAdHash :: AgentErrorMonad m => AgentClient -> ConnId -> m ByteString
+getConnectionRatchetAdHash c = withAgentEnv c . getConnectionRatchetAdHash' c
+
 -- | Change servers to be used for creating new queues
 setSMPServers :: AgentErrorMonad m => AgentClient -> NonEmpty SMPServerWithAuth -> m ()
 setSMPServers c = withAgentEnv c . setSMPServers' c
@@ -1187,6 +1192,11 @@ getConnectionServers' c connId = do
   SomeConn _ conn <- withStore c (`getConn` connId)
   pure $ connectionStats conn
 
+getConnectionRatchetAdHash' :: AgentMonad m => AgentClient -> ConnId -> m ByteString
+getConnectionRatchetAdHash' c connId = do
+  CR.Ratchet {rcAD = Str rcAD} <- withStore c (`getRatchet` connId)
+  pure $ C.sha256Hash rcAD
+
 connectionStats :: Connection c -> ConnectionStats
 connectionStats = \case
   RcvConnection _ rq -> ConnectionStats {rcvServers = [qServer rq], sndServers = []}

tests/AgentTests/FunctionalAPITests.hs

@@ -169,6 +169,9 @@ functionalAPITests t = do
       it "should pass with correct password" $ testSMPServerConnectionTest t auth (srv auth) `shouldReturn` Nothing
       it "should fail without password" $ testSMPServerConnectionTest t auth (srv Nothing) `shouldReturn` authErr
       it "should fail with incorrect password" $ testSMPServerConnectionTest t auth (srv $ Just "wrong") `shouldReturn` authErr
+  describe "getRatchetAdHash" $
+    it "should return the same data for both peers" $
+      withSmpServer t testRatchetAdHash
 
 testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> IO Int
 testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 = do
@@ -834,6 +837,17 @@ testSMPServerConnectionTest t newQueueBasicAuth srv =
     Right r <- runExceptT $ testSMPServerConnection a srv
     pure r
 
+testRatchetAdHash :: IO ()
+testRatchetAdHash = do
+  a <- getSMPAgentClient agentCfg initAgentServers
+  b <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers
+  Right () <- runExceptT $ do
+    (aId, bId) <- makeConnection a b
+    ad1 <- getConnectionRatchetAdHash a bId
+    ad2 <- getConnectionRatchetAdHash b aId
+    liftIO $ ad1 `shouldBe` ad2
+  pure ()
+
 exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetings = exchangeGreetingsMsgId 4