core: ratchet synchronization (#2653)

src/Simplex/Chat/Controller.hs

@@ -287,6 +287,8 @@ data ChatCommand
   | APISwitchGroupMember GroupId GroupMemberId
   | APIAbortSwitchContact ContactId
   | APIAbortSwitchGroupMember GroupId GroupMemberId
+  | APISyncContactRatchet ContactId Bool
+  | APISyncGroupMemberRatchet GroupId GroupMemberId Bool
   | APIGetContactCode ContactId
   | APIGetGroupMemberCode GroupId GroupMemberId
   | APIVerifyContact ContactId (Maybe Text)
@@ -300,6 +302,8 @@ data ChatCommand
   | SwitchGroupMember GroupName ContactName
   | AbortSwitchContact ContactName
   | AbortSwitchGroupMember GroupName ContactName
+  | SyncContactRatchet ContactName Bool
+  | SyncGroupMemberRatchet GroupName ContactName Bool
   | GetContactCode ContactName
   | GetGroupMemberCode GroupName ContactName
   | VerifyContact ContactName (Maybe Text)
@@ -415,6 +419,12 @@ data ChatResponse
   | CRGroupMemberSwitchAborted {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats :: ConnectionStats}
   | CRContactSwitch {user :: User, contact :: Contact, switchProgress :: SwitchProgress}
   | CRGroupMemberSwitch {user :: User, groupInfo :: GroupInfo, member :: GroupMember, switchProgress :: SwitchProgress}
+  | CRContactRatchetSyncStarted {user :: User, contact :: Contact, connectionStats :: ConnectionStats}
+  | CRGroupMemberRatchetSyncStarted {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats :: ConnectionStats}
+  | CRContactRatchetSync {user :: User, contact :: Contact, ratchetSyncProgress :: RatchetSyncProgress}
+  | CRGroupMemberRatchetSync {user :: User, groupInfo :: GroupInfo, member :: GroupMember, ratchetSyncProgress :: RatchetSyncProgress}
+  | CRContactVerificationReset {user :: User, contact :: Contact}
+  | CRGroupMemberVerificationReset {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
   | CRContactCode {user :: User, contact :: Contact, connectionCode :: Text}
   | CRGroupMemberCode {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionCode :: Text}
   | CRConnectionVerified {user :: User, verified :: Bool, expectedCode :: Text}
@@ -719,6 +729,14 @@ data SwitchProgress = SwitchProgress
 
 instance ToJSON SwitchProgress where toEncoding = J.genericToEncoding J.defaultOptions
 
+data RatchetSyncProgress = RatchetSyncProgress
+  { ratchetSyncStatus :: RatchetSyncState,
+    connectionStats :: ConnectionStats
+  }
+  deriving (Show, Generic)
+
+instance ToJSON RatchetSyncProgress where toEncoding = J.genericToEncoding J.defaultOptions
+
 data ParsedServerAddress = ParsedServerAddress
   { serverAddress :: Maybe ServerAddress,
     parseError :: String

src/Simplex/Chat/Messages/CIContent.hs

@@ -29,7 +29,7 @@ import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics (Generic)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
-import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), SwitchPhase (..))
+import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), RatchetSyncState (..), SwitchPhase (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON)
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
@@ -157,7 +157,7 @@ ciMsgContent = \case
   CIRcvMsgContent mc -> Just mc
   _ -> Nothing
 
-data MsgDecryptError = MDERatchetHeader | MDETooManySkipped
+data MsgDecryptError = MDERatchetHeader | MDETooManySkipped | MDERatchetEarlier | MDEOther
   deriving (Eq, Show, Generic)
 
 instance ToJSON MsgDecryptError where
@@ -253,10 +253,15 @@ instance ToJSON DBSndGroupEvent where
   toJSON (SGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SGE") v
   toEncoding (SGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SGE") v
 
-data RcvConnEvent = RCESwitchQueue {phase :: SwitchPhase}
+data RcvConnEvent
+  = RCESwitchQueue {phase :: SwitchPhase}
+  | RCERatchetSync {syncStatus :: RatchetSyncState}
+  | RCEVerificationCodeReset
   deriving (Show, Generic)
 
-data SndConnEvent = SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef}
+data SndConnEvent
+  = SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef}
+  | SCERatchetSync {syncStatus :: RatchetSyncState, member :: Maybe GroupMemberRef}
   deriving (Show, Generic)
 
 instance FromJSON RcvConnEvent where
@@ -387,6 +392,16 @@ rcvConnEventToText = \case
     SPConfirmed -> "confirmed changing address for you..."
     SPSecured -> "secured new address for you..."
     SPCompleted -> "changed address for you"
+  RCERatchetSync syncStatus -> ratchetSyncStatusToText syncStatus
+  RCEVerificationCodeReset -> "security code changed"
+
+ratchetSyncStatusToText :: RatchetSyncState -> Text
+ratchetSyncStatusToText = \case
+  RSOk -> "connection synchronized"
+  RSAllowed -> "decryption error (connection may be out of sync), synchronization allowed"
+  RSRequired -> "decryption error (connection out of sync), synchronization required"
+  RSStarted -> "connection synchronization started"
+  RSAgreed -> "connection synchronization agreed"
 
 sndConnEventToText :: SndConnEvent -> Text
 sndConnEventToText = \case
@@ -395,6 +410,7 @@ sndConnEventToText = \case
     SPConfirmed -> "confirmed changing address" <> forMember m <> "..."
     SPSecured -> "secured new address" <> forMember m <> "..."
     SPCompleted -> "you changed address" <> forMember m
+  SCERatchetSync syncStatus m -> ratchetSyncStatusToText syncStatus <> forMember m
   where
     forMember member_ =
       maybe "" (\GroupMemberRef {profile = Profile {displayName}} -> " for " <> displayName) member_
@@ -413,11 +429,16 @@ msgIntegrityError = \case
 
 msgDecryptErrorText :: MsgDecryptError -> Word32 -> Text
 msgDecryptErrorText err n =
-  "decryption error, possibly due to the device change (" <> errName <> if n == 1 then ")" else ", " <> tshow n <> " messages)"
+  "decryption error, possibly due to the device change"
+    <> maybe "" (\ed -> " (" <> ed <> ")") errDesc
   where
-    errName = case err of
-      MDERatchetHeader -> "header"
-      MDETooManySkipped -> "too many skipped messages"
+    errDesc = case err of
+      MDERatchetHeader -> Just $ "header" <> counter
+      MDETooManySkipped -> Just $ "too many skipped messages" <> counter
+      MDERatchetEarlier -> Just $ "earlier message" <> counter
+      MDEOther -> counter_
+    counter_ = if n == 1 then Nothing else Just $ tshow n <> " messages"
+    counter = maybe "" (", " <>) counter_
 
 msgDirToModeratedContent_ :: SMsgDirection d -> CIContent d
 msgDirToModeratedContent_ = \case

src/Simplex/Chat/Store/Direct.hs

@@ -627,9 +627,6 @@ getContactConnections db userId Contact {contactId} =
     connections [] = throwError $ SEContactNotFound contactId
     connections rows = pure $ map toConnection rows
 
-
-
-
 getConnectionById :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Connection
 getConnectionById db User {userId} connId = ExceptT $ do
   firstRow toConnection (SEConnectionNotFoundById connId) $

src/Simplex/Chat/View.hs

@@ -28,7 +28,6 @@ import Data.Time (LocalTime (..), TimeOfDay (..), TimeZone (..), utcToLocalTime)
 import Data.Time.Calendar (addDays)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
-import Data.Word (Word32)
 import GHC.Generics (Generic)
 import qualified Network.HTTP.Types as Q
 import Numeric (showFFloat)
@@ -86,6 +85,12 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts
   CRGroupMemberSwitchAborted {} -> ["switch aborted"]
   CRContactSwitch u ct progress -> ttyUser u $ viewContactSwitch ct progress
   CRGroupMemberSwitch u g m progress -> ttyUser u $ viewGroupMemberSwitch g m progress
+  CRContactRatchetSyncStarted {} -> ["connection synchronization started"]
+  CRGroupMemberRatchetSyncStarted {} -> ["connection synchronization started"]
+  CRContactRatchetSync u ct progress -> ttyUser u $ viewContactRatchetSync ct progress
+  CRGroupMemberRatchetSync u g m progress -> ttyUser u $ viewGroupMemberRatchetSync g m progress
+  CRContactVerificationReset u ct -> ttyUser u $ viewContactVerificationReset ct
+  CRGroupMemberVerificationReset u g m -> ttyUser u $ viewGroupMemberVerificationReset g m
   CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
   CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView
   CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
@@ -385,7 +390,6 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
       CIDirectRcv -> case content of
         CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
         CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
-        CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts tz meta
         CIRcvGroupEvent {} -> showRcvItemProhibited from
         _ -> showRcvItem from
         where
@@ -402,7 +406,6 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
       CIGroupRcv m -> case content of
         CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
         CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
-        CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts tz meta
         CIRcvGroupInvitation {} -> showRcvItemProhibited from
         CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
         _ -> showRcvItem from
@@ -587,9 +590,6 @@ msgPreview = msgPlain . preview . msgContentText
 viewRcvIntegrityError :: StyledString -> MsgErrorType -> CurrentTime -> TimeZone -> CIMeta c 'MDRcv -> [StyledString]
 viewRcvIntegrityError from msgErr ts tz meta = receivedWithTime_ ts tz from [] meta (viewMsgIntegrityError msgErr) False
 
-viewRcvDecryptionError :: StyledString -> MsgDecryptError -> Word32 -> CurrentTime -> TimeZone -> CIMeta c 'MDRcv -> [StyledString]
-viewRcvDecryptionError from err n ts tz meta = receivedWithTime_ ts tz from [] meta [ttyError $ msgDecryptErrorText err n] False
-
 viewMsgIntegrityError :: MsgErrorType -> [StyledString]
 viewMsgIntegrityError err = [ttyError $ msgIntegrityError err]
 
@@ -968,6 +968,28 @@ viewGroupMemberSwitch g m (SwitchProgress qd phase _) = case qd of
   QDRcv -> [ttyGroup' g <> ": you " <> viewSwitchPhase phase <> " for " <> ttyMember m]
   QDSnd -> [ttyGroup' g <> ": " <> ttyMember m <> " " <> viewSwitchPhase phase <> " for you"]
 
+viewContactRatchetSync :: Contact -> RatchetSyncProgress -> [StyledString]
+viewContactRatchetSync ct@Contact {localDisplayName = c} RatchetSyncProgress {ratchetSyncStatus = rss} =
+  [ttyContact' ct <> ": " <> (plain . ratchetSyncStatusToText) rss]
+    <> help
+  where
+    help = ["use " <> highlight ("/sync " <> c) <> " to synchronize" | rss `elem` [RSAllowed, RSRequired]]
+
+viewGroupMemberRatchetSync :: GroupInfo -> GroupMember -> RatchetSyncProgress -> [StyledString]
+viewGroupMemberRatchetSync g m@GroupMember {localDisplayName = n} RatchetSyncProgress {ratchetSyncStatus = rss} =
+  [ttyGroup' g <> " " <> ttyMember m <> ": " <> (plain . ratchetSyncStatusToText) rss]
+    <> help
+  where
+    help = ["use " <> highlight ("/sync #" <> groupName' g <> " " <> n) <> " to synchronize" | rss `elem` [RSAllowed, RSRequired]]
+
+viewContactVerificationReset :: Contact -> [StyledString]
+viewContactVerificationReset ct =
+  [ttyContact' ct <> ": security code changed"]
+
+viewGroupMemberVerificationReset :: GroupInfo -> GroupMember -> [StyledString]
+viewGroupMemberVerificationReset g m =
+  [ttyGroup' g <> " " <> ttyMember m <> ": security code changed"]
+
 viewContactCode :: Contact -> Text -> Bool -> [StyledString]
 viewContactCode ct@Contact {localDisplayName = c} = viewSecurityCode (ttyContact' ct) ("/verify " <> c <> " <code from your contact>")