add crypto error to RSYNC event (#794)

This commit is contained in:
spaced4ndy
2023-07-05 18:14:51 +04:00
committed by GitHub
parent fe22d9b299
commit f2657f9c0b
3 changed files with 23 additions and 9 deletions
+4 -4
View File
@@ -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
+17 -3
View File
@@ -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)
+2 -2
View File
@@ -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