From f2657f9c0b954f952aaf381bb9b55ac34ea59ed7 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Wed, 5 Jul 2023 18:14:51 +0400 Subject: [PATCH] add crypto error to RSYNC event (#794) --- src/Simplex/Messaging/Agent.hs | 8 ++++---- src/Simplex/Messaging/Agent/Protocol.hs | 20 +++++++++++++++++--- tests/AgentTests/FunctionalAPITests.hs | 4 ++-- 3 files changed, 23 insertions(+), 9 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 623fcc1f1..7c0419e0a 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1872,7 +1872,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s | rss `notElem` ([RSOk, RSStarted] :: [RatchetSyncState]) = do let cData'' = (toConnData conn') {ratchetSyncState = RSOk} :: ConnData conn'' = updateConnection cData'' conn' - notify . RSYNC RSOk $ connectionStats conn'' + notify . RSYNC RSOk Nothing $ connectionStats conn'' withStore' c $ \db -> setConnRatchetSync db connId RSOk pure conn'' | otherwise = pure conn' @@ -1896,10 +1896,10 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s notifySync :: m () notifySync = qDuplex conn' "AGENT A_CRYPTO error" $ \connDuplex -> do let rss' = cryptoErrToSyncState e - when (rss == RSOk || (rss == RSAllowed && rss' == RSRequired)) $ do + when (rss `elem` ([RSOk, RSAllowed, RSRequired] :: [RatchetSyncState])) $ do let cData'' = (toConnData conn') {ratchetSyncState = rss'} :: ConnData conn'' = updateConnection cData'' connDuplex - notify . RSYNC rss' $ connectionStats conn'' + notify . RSYNC rss' (Just e) $ connectionStats conn'' withStore' c $ \db -> setConnRatchetSync db connId rss' Left e -> checkDuplicateHash e encryptedMsgHash >> ack where @@ -2210,7 +2210,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s notifyAgreed = do let cData'' = cData' {ratchetSyncState = RSAgreed} :: ConnData conn'' = updateConnection cData'' conn' - notify . RSYNC RSAgreed $ connectionStats conn'' + notify . RSYNC RSAgreed Nothing $ connectionStats conn'' recreateRatchet :: CR.Ratchet 'C.X448 -> m () recreateRatchet rc = withStore' c $ \db -> do setConnRatchetSync db connId RSAgreed diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index b8241d4af..5ab875757 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -326,7 +326,7 @@ data ACommand (p :: AParty) (e :: AEntity) where DOWN :: SMPServer -> [ConnId] -> ACommand Agent AENone UP :: SMPServer -> [ConnId] -> ACommand Agent AENone SWITCH :: QueueDirection -> SwitchPhase -> ConnectionStats -> ACommand Agent AEConn - RSYNC :: RatchetSyncState -> ConnectionStats -> ACommand Agent AEConn + RSYNC :: RatchetSyncState -> Maybe AgentCryptoError -> ConnectionStats -> ACommand Agent AEConn SEND :: MsgFlags -> MsgBody -> ACommand Client AEConn MID :: AgentMsgId -> ACommand Agent AEConn SENT :: AgentMsgId -> ACommand Agent AEConn @@ -1449,6 +1449,20 @@ instance ToJSON AgentCryptoError where toJSON = J.genericToJSON $ sumTypeJSON id toEncoding = J.genericToEncoding $ sumTypeJSON id +instance StrEncoding AgentCryptoError where + strP = + "DECRYPT_AES" $> DECRYPT_AES + <|> "DECRYPT_CB" $> DECRYPT_CB + <|> "RATCHET_HEADER" $> RATCHET_HEADER + <|> "RATCHET_EARLIER " *> (RATCHET_EARLIER <$> strP) + <|> "RATCHET_SKIPPED " *> (RATCHET_SKIPPED <$> strP) + strEncode = \case + DECRYPT_AES -> "DECRYPT_AES" + DECRYPT_CB -> "DECRYPT_CB" + RATCHET_HEADER -> "RATCHET_HEADER" + RATCHET_EARLIER n -> "RATCHET_EARLIER " <> strEncode n + RATCHET_SKIPPED n -> "RATCHET_SKIPPED " <> strEncode n + instance ToJSON SMPAgentError where toJSON = J.genericToJSON $ sumTypeJSON id toEncoding = J.genericToEncoding $ sumTypeJSON id @@ -1658,7 +1672,7 @@ commandP binaryP = DOWN_ -> s (DOWN <$> strP_ <*> connections) UP_ -> s (UP <$> strP_ <*> connections) SWITCH_ -> s (SWITCH <$> strP_ <*> strP_ <*> strP) - RSYNC_ -> s (RSYNC <$> strP_ <*> strP) + RSYNC_ -> s (RSYNC <$> strP_ <*> strP <*> strP) MID_ -> s (MID <$> A.decimal) SENT_ -> s (SENT <$> A.decimal) MERR_ -> s (MERR <$> A.decimal <* A.space <*> strP) @@ -1717,7 +1731,7 @@ serializeCommand = \case DOWN srv conns -> B.unwords [s DOWN_, s srv, connections conns] UP srv conns -> B.unwords [s UP_, s srv, connections conns] SWITCH dir phase srvs -> s (SWITCH_, dir, phase, srvs) - RSYNC rrState cstats -> s (RSYNC_, rrState, cstats) + RSYNC rrState cryptoErr cstats -> s (RSYNC_, rrState, cryptoErr, cstats) SEND msgFlags msgBody -> B.unwords [s SEND_, smpEncode msgFlags, serializeBinary msgBody] MID mId -> s (MID_, Str $ bshow mId) SENT mId -> s (SENT_, Str $ bshow mId) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index f16961222..9aac75b63 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -849,13 +849,13 @@ setupDesynchronizedRatchet alice bob = do ratchetSyncP :: ConnId -> RatchetSyncState -> AEntityTransmission 'AEConn -> Bool ratchetSyncP cId rss = \case - (_, cId', RSYNC rss' ConnectionStats {ratchetSyncState}) -> + (_, cId', RSYNC rss' _ ConnectionStats {ratchetSyncState}) -> cId' == cId && rss' == rss && ratchetSyncState == rss _ -> False ratchetSyncP' :: ConnId -> RatchetSyncState -> ATransmission 'Agent -> Bool ratchetSyncP' cId rss = \case - (_, cId', APC SAEConn (RSYNC rss' ConnectionStats {ratchetSyncState})) -> + (_, cId', APC SAEConn (RSYNC rss' _ ConnectionStats {ratchetSyncState})) -> cId' == cId && rss' == rss && ratchetSyncState == rss _ -> False