diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index fe9925a362..37cfe94664 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/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 = []} diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index e8350fd381..7f69070c69 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/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