core, iOS: support for self-destruct password (#2412)

* core, iOS: support for self-destruct password

* disable test logging

* core: fix tests, iOS: remove notifications on removal

* change alerts

src/Simplex/Chat.hs

@@ -83,6 +83,7 @@ import Simplex.Messaging.Util
 import System.Exit (exitFailure, exitSuccess)
 import System.FilePath (combine, splitExtensions, takeFileName, (</>))
 import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout)
+import System.Random (randomRIO)
 import Text.Read (readMaybe)
 import UnliftIO.Async
 import UnliftIO.Concurrent (forkFinally, forkIO, mkWeakThreadId, threadDelay)
@@ -318,7 +319,8 @@ toView event = do
 processChatCommand :: forall m. ChatMonad m => ChatCommand -> m ChatResponse
 processChatCommand = \case
   ShowActiveUser -> withUser' $ pure . CRActiveUser
-  CreateActiveUser p@Profile {displayName} sameServers -> do
+  CreateActiveUser NewUser {profile, sameServers, pastTimestamp} -> do
+    p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile
     u <- asks currentUser
     (smp, smpServers) <- chooseServers SPSMP
     (xftp, xftpServers) <- chooseServers SPXFTP
@@ -329,7 +331,8 @@ processChatCommand = \case
           when (any (\User {localDisplayName = n} -> n == displayName) users) $
             throwChatError $ CEUserExists displayName
           withAgent (\a -> createUser a smp xftp)
-    user <- withStore $ \db -> createUserRecord db (AgentUserId auId) p True
+    ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure
+    user <- withStore $ \db -> createUserRecordAt db (AgentUserId auId) p True ts
     storeServers user smpServers
     storeServers user xftpServers
     setActive ActiveNone
@@ -351,6 +354,8 @@ processChatCommand = \case
       storeServers user servers =
         unless (null servers) $
           withStore $ \db -> overwriteProtocolServers db user servers
+      coupleDaysAgo t = (`addUTCTime` t) . fromInteger . (+ (2 * day)) <$> randomRIO (0, day)
+      day = 86400
   ListUsers -> CRUsersList <$> withStore' getUsersInfo
   APISetActiveUser userId' viewPwd_ -> withUser $ \user -> do
     user' <- privateGetUser userId'
@@ -4584,12 +4589,8 @@ chatCommandP =
   choice
     [ "/mute " *> ((`ShowMessages` False) <$> chatNameP),
       "/unmute " *> ((`ShowMessages` True) <$> chatNameP),
-      "/create user"
-        *> ( do
-               sameSmp <- (A.space *> "same_smp=" *> onOffP) <|> pure False
-               uProfile <- A.space *> userProfile
-               pure $ CreateActiveUser uProfile sameSmp
-           ),
+      "/_create user " *> (CreateActiveUser <$> jsonP),
+      "/create user " *> (CreateActiveUser <$> newUserP),
       "/users" $> ListUsers,
       "/_user " *> (APISetActiveUser <$> A.decimal <*> optional (A.space *> jsonP)),
       ("/user " <|> "/u ") *> (SetActiveUser <$> displayName <*> optional (A.space *> pwdP)),
@@ -4784,7 +4785,7 @@ chatCommandP =
       ("/welcome" <|> "/w") $> Welcome,
       "/profile_image " *> (UpdateProfileImage . Just . ImageData <$> imageP),
       "/profile_image" $> UpdateProfileImage Nothing,
-      ("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> userNames),
+      ("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> profileNames),
       ("/profile" <|> "/p") $> ShowProfile,
       "/set voice #" *> (SetGroupFeature (AGF SGFVoice) <$> displayName <*> (A.space *> strP)),
       "/set voice @" *> (SetContactFeature (ACF SCFVoice) <$> displayName <*> optional (A.space *> strP)),
@@ -4823,23 +4824,19 @@ chatCommandP =
     refChar c = c > ' ' && c /= '#' && c /= '@'
     liveMessageP = " live=" *> onOffP <|> pure False
     onOffP = ("on" $> True) <|> ("off" $> False)
-    userNames = do
-      cName <- displayName
-      fullName <- fullNameP cName
-      pure (cName, fullName)
-    userProfile = do
-      (cName, fullName) <- userNames
-      pure Profile {displayName = cName, fullName, image = Nothing, contactLink = Nothing, preferences = Nothing}
+    profileNames = (,) <$> displayName <*> fullNameP
+    newUserP = do
+      sameServers <- "same_smp=" *> onOffP <* A.space <|> pure False
+      (cName, fullName) <- profileNames
+      let profile = Just Profile {displayName = cName, fullName, image = Nothing, contactLink = Nothing, preferences = Nothing}
+      pure NewUser {profile, sameServers, pastTimestamp = False}
     jsonP :: J.FromJSON a => Parser a
     jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
     groupProfile = do
-      gName <- displayName
-      fullName <- fullNameP gName
+      (gName, fullName) <- profileNames
       let groupPreferences = Just (emptyGroupPrefs :: GroupPreferences) {directMessages = Just DirectMessagesGroupPreference {enable = FEOn}}
       pure GroupProfile {displayName = gName, fullName, description = Nothing, image = Nothing, groupPreferences}
-    fullNameP name = do
-      n <- (A.space *> A.takeByteString) <|> pure ""
-      pure $ if B.null n then name else safeDecodeUtf8 n
+    fullNameP = A.space *> textP <|> pure ""
     textP = safeDecodeUtf8 <$> A.takeByteString
     pwdP = jsonP <|> (UserPwd . safeDecodeUtf8 <$> A.takeTill (== ' '))
     msgTextP = jsonP <|> textP

src/Simplex/Chat/Controller.hs

@@ -180,7 +180,7 @@ instance ToJSON HelpSection where
 
 data ChatCommand
   = ShowActiveUser
-  | CreateActiveUser Profile Bool
+  | CreateActiveUser NewUser
   | ListUsers
   | APISetActiveUser UserId (Maybe UserPwd)
   | SetActiveUser UserName (Maybe UserPwd)

src/Simplex/Chat/Store.hs

@@ -27,6 +27,7 @@ module Simplex.Chat.Store
     chatStoreFile,
     agentStoreFile,
     createUserRecord,
+    createUserRecordAt,
     getUsersInfo,
     getUsers,
     setActiveUser,
@@ -490,9 +491,11 @@ insertedRowId :: DB.Connection -> IO Int64
 insertedRowId db = fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
 
 createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User
-createUserRecord db (AgentUserId auId) Profile {displayName, fullName, image, preferences = userPreferences} activeUser =
+createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime
+
+createUserRecordAt :: DB.Connection -> AgentUserId -> Profile -> Bool -> UTCTime -> ExceptT StoreError IO User
+createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image, preferences = userPreferences} activeUser currentTs =
   checkConstraint SEDuplicateName . liftIO $ do
-    currentTs <- getCurrentTime
     when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
     DB.execute
       db

src/Simplex/Chat/Types.hs

@@ -120,6 +120,13 @@ instance ToJSON User where
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
 
+data NewUser = NewUser
+  { profile :: Maybe Profile,
+    sameServers :: Bool,
+    pastTimestamp :: Bool
+  }
+  deriving (Show, Generic, FromJSON)
+
 newtype B64UrlByteString = B64UrlByteString ByteString
   deriving (Eq, Show)