Merge branch 'master' into ep/dir-contacts

apps/simplex-directory-service/Main.hs

@@ -5,23 +5,11 @@ module Main where
 
 import Directory.Options
 import Directory.Service
-import Directory.Store
-import Directory.Store.Migrate
 import Simplex.Chat.Terminal (terminalChatConfig)
 
 main :: IO ()
 main = do
-  opts@DirectoryOpts {directoryLog, migrateDirectoryLog, runCLI} <- welcomeGetOpts
-  case migrateDirectoryLog of
-    Just cmd -> migrate cmd opts terminalChatConfig
-    Nothing -> do
-      st <- openDirectoryLog directoryLog
-      if runCLI
-        then directoryServiceCLI st opts
-        else directoryService st opts terminalChatConfig
-  where
-    migrate = \case
-      MLCheck -> checkDirectoryLog
-      MLImport -> importDirectoryLogToDB
-      MLExport -> exportDBToDirectoryLog
-      MLListing -> saveGroupListingFiles
+  opts@DirectoryOpts {runCLI} <- welcomeGetOpts
+  if runCLI
+    then directoryServiceCLI opts
+    else directoryService opts terminalChatConfig

apps/simplex-directory-service/src/Directory/Options.hs

@@ -14,14 +14,11 @@ module Directory.Options
   )
 where
 
-import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
 import Options.Applicative
 import Simplex.Chat.Bot.KnownContacts
 import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
 import Simplex.Chat.Options (ChatCmdLog (..), ChatOpts (..), CoreChatOpts, CreateBotOpts (..), coreChatOptsP)
-import Simplex.Messaging.Parsers (parseAll)
 
 data DirectoryOpts = DirectoryOpts
   { coreOptions :: CoreChatOpts,
@@ -36,8 +33,6 @@ data DirectoryOpts = DirectoryOpts
     profileNameLimit :: Int,
     captchaGenerator :: Maybe FilePath,
     voiceCaptchaGenerator :: Maybe FilePath,
-    directoryLog :: Maybe FilePath,
-    migrateDirectoryLog :: Maybe MigrateLog,
     serviceName :: T.Text,
     clientService :: Bool,
     runCLI :: Bool,
@@ -133,21 +128,6 @@ directoryOpts appDir defaultDbName = do
             <> metavar "VOICE_CAPTCHA_GENERATOR"
             <> help "Executable to generate voice captcha, accepts text as parameter, writes audio file, outputs file_path and duration_seconds to stdout"
         )
-  directoryLog <-
-    optional $
-      strOption
-        ( long "directory-file"
-            <> metavar "DIRECTORY_FILE"
-            <> help "Append only log for directory state"
-        )
-  migrateDirectoryLog <-
-    optional $
-      option
-        parseMigrateLog
-        ( long "migrate-directory-file"
-            <> metavar "MIGRATE_COMMAND"
-            <> help "Command to import/export directory log file"
-        )
   serviceName <-
     strOption
       ( long "service-name"
@@ -209,8 +189,6 @@ directoryOpts appDir defaultDbName = do
         profileNameLimit,
         captchaGenerator,
         voiceCaptchaGenerator,
-        directoryLog,
-        migrateDirectoryLog,
         serviceName = T.pack serviceName,
         clientService,
         runCLI,
@@ -254,14 +232,3 @@ mkChatOpts DirectoryOpts {coreOptions, serviceName, clientService} =
       userDisplayName = Nothing,
       userImageFile = Nothing
     }
-
-parseMigrateLog :: ReadM MigrateLog
-parseMigrateLog = eitherReader $ parseAll mlP . encodeUtf8 . T.pack
-  where
-    mlP =
-      A.takeTill (== ' ') >>= \case
-        "check" -> pure MLCheck
-        "import" -> pure MLImport
-        "export" -> pure MLExport
-        "listing" -> pure MLListing
-        _ -> fail "bad MigrateLog"

apps/simplex-directory-service/src/Directory/Service.hs

@@ -157,8 +157,8 @@ welcomeGetOpts = do
     knownContact KnownContact {contactId, localDisplayName = n} = knownName contactId n
     knownName i n = show i <> ":" <> T.unpack (viewName n)
 
-directoryServiceCLI :: DirectoryLog -> DirectoryOpts -> IO ()
-directoryServiceCLI st opts = do
+directoryServiceCLI :: DirectoryOpts -> IO ()
+directoryServiceCLI opts = do
   env@ServiceState {eventQ} <- newServiceState opts
   let eventHook _cc resp = atomically $ resp <$ mapM_ (writeTQueue eventQ) (crDirectoryEvent resp)
       chatHooks =
@@ -181,7 +181,7 @@ directoryServiceCLI st opts = do
       forM_ u_ $ \user ->
         forever $ do
           event <- atomically $ readTQueue eventQ
-          directoryServiceEvent st opts env user cc event
+          directoryServiceEvent opts env user cc event
 
 updateListingDelay :: Int
 updateListingDelay = 5 * 60 * 1000000 -- update every 5 minutes
@@ -257,8 +257,8 @@ directoryCommands =
   where
     idParam = Just "<ID>"
 
-directoryService :: DirectoryLog -> DirectoryOpts -> ChatConfig -> IO ()
-directoryService st opts cfg = do
+directoryService :: DirectoryOpts -> ChatConfig -> IO ()
+directoryService opts cfg = do
   env@ServiceState {eventQ} <- newServiceState opts
   let chatHooks =
         defaultChatHooks
@@ -273,7 +273,7 @@ directoryService st opts cfg = do
           mapM_ (atomically . writeTQueue eventQ) $ crDirectoryEvent resp,
         forever $ do
           event <- atomically $ readTQueue eventQ
-          directoryServiceEvent st opts env user cc event
+          directoryServiceEvent opts env user cc event
       ]
         <> maybeToList (updateListingsThread_ opts env)
         <> maybeToList (linkCheckThread_ opts env)
@@ -325,8 +325,8 @@ readBlockedWordsConfig DirectoryOpts {blockedFragmentsFile, blockedWordsFile, na
   unless testing $ putStrLn $ "Blocked fragments: " <> show (length blockedFragments) <> ", blocked words: " <> show (length blockedWords) <> ", spelling rules: " <> show (M.size spelling)
   pure BlockedWordsConfig {blockedFragments, blockedWords, extensionRules, spelling}
 
-directoryServiceEvent :: DirectoryLog -> DirectoryOpts -> ServiceState -> User -> ChatController -> DirectoryEvent -> IO ()
-directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults, prohibitedToObserver, alwaysCaptcha} env@ServiceState {searchRequests} user@User {userId} cc = \case
+directoryServiceEvent :: DirectoryOpts -> ServiceState -> User -> ChatController -> DirectoryEvent -> IO ()
+directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults, prohibitedToObserver, alwaysCaptcha} env@ServiceState {searchRequests} user@User {userId} cc = \case
     DEContactConnected ct -> deContactConnected ct
     DEGroupInvitation {contact = ct, groupInfo = g, fromMemberRole, memberRole} -> deGroupInvitation ct g fromMemberRole memberRole
     DEServiceJoinedGroup ctId g owner -> deServiceJoinedGroup ctId g owner
@@ -430,8 +430,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
 
     processInvitation :: Contact -> GroupInfo -> Maybe GroupReg -> IO ()
     processInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = \case
-      Nothing -> addGroupReg notifyAdminUsers st cc user ct g GRSProposed joinGroup
-      Just _gr -> setGroupStatus notifyAdminUsers st env cc groupId GRSProposed joinGroup
+      Nothing -> addGroupReg notifyAdminUsers cc user ct g GRSProposed joinGroup
+      Just _gr -> setGroupStatus notifyAdminUsers env cc groupId GRSProposed joinGroup
       where
         joinGroup _ = do
           r <- sendChatCmd cc $ APIJoinGroup groupId MFNone
@@ -462,7 +462,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             Left e -> sendMessage cc ct $ "Error: getDuplicateGroup. Please notify the developers.\n" <> T.pack e
       where
         askConfirmation =
-          addGroupReg notifyAdminUsers st cc user ct g GRSPendingConfirmation $ \GroupReg {userGroupRegId} -> do
+          addGroupReg notifyAdminUsers cc user ct g GRSPendingConfirmation $ \GroupReg {userGroupRegId} -> do
             sendMessage cc ct $ "The group " <> groupNameDescr p <> " is already submitted to the directory.\nTo confirm the registration, please send:"
             sendMessage cc ct $ "/confirm " <> tshow userGroupRegId <> ":" <> viewName displayName
 
@@ -503,11 +503,10 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
               logError msg
               notifyOwner gr msg
             Right () -> do
-              logGUpdateOwner st groupId $ groupMemberId' owner
               notifyOwner gr $ "Joined the group " <> displayName <> ", creating the link…"
               sendChatCmd cc (APICreateGroupLink groupId GRMember) >>= \case
                 Right CRGroupLinkCreated {groupLink = GroupLink {connLinkContact = gLink}} ->
-                  setGroupStatus notifyAdminUsers st env cc groupId GRSPendingUpdate $ \gr' -> do
+                  setGroupStatus notifyAdminUsers env cc groupId GRSPendingUpdate $ \gr' -> do
                     notifyOwner
                       gr'
                       "Created the public link to join the group via this directory service that is always online.\n\n\
@@ -586,19 +585,19 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                   withDB "getGroupMember" cc (\db -> withExceptT show $ getGroupMember db (storeCxt cc) user groupId ownerGMId) >>= \case
                     Right ownerMember
                       | let GroupMember {memberRole = role} = ownerMember, role >= GROwner ->
-                          setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n') (`updatedNotification` g')
+                          setGroupStatus notifyAdminUsers env cc groupId (GRSPendingApproval n') (`updatedNotification` g')
                       | otherwise -> do
-                          setGroupStatus notifyAdminUsers st env cc groupId GRSSuspendedBadRoles $ \_ -> pure ()
+                          setGroupStatus notifyAdminUsers env cc groupId GRSSuspendedBadRoles $ \_ -> pure ()
                           notifyOwner gr $ "The registration owner is no longer an owner. Registration suspended."
                     Left _ -> logError $ "could not find owner member for " <> groupRef
                 Nothing -> logError $ "no owner member set for " <> groupRef
             _ ->
-              setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n') (`updatedNotification` toGroup)
+              setGroupStatus notifyAdminUsers env cc groupId (GRSPendingApproval n') (`updatedNotification` toGroup)
         groupLinkAdded gr byMember =
           getDuplicateGroup toGroup >>= \case
             Left e -> notifyOwner gr $ "Error: getDuplicateGroup. Please notify the developers.\n" <> T.pack e
             Right DGReserved -> notifyOwner gr $ groupAlreadyListed toGroup
-            _ -> setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval gaId) $ \gr' -> do
+            _ -> setGroupStatus notifyAdminUsers env cc groupId (GRSPendingApproval gaId) $ \gr' -> do
               notifyOwner gr' $
                 ("Thank you! The group link for " <> userGroupReference gr' toGroup <> " is added to the welcome message" <> byMember)
                   <> ".\nYou will be notified once the group is added to the directory - it may take up to 48 hours."
@@ -609,16 +608,16 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
           let userGroupRef = userGroupReference gr toGroup
               groupRef = groupReference toGroup
           groupProfileUpdate >>= \case
-            GPNoServiceLink -> setGroupStatus notifyAdminUsers st env cc groupId GRSPendingUpdate $ \gr' -> do
+            GPNoServiceLink -> setGroupStatus notifyAdminUsers env cc groupId GRSPendingUpdate $ \gr' -> do
               notifyOwner gr' $
                 ("The group profile is updated for " <> userGroupRef <> byMember <> ", but no link is added to the welcome message.\n\n")
                   <> "The group will remain hidden from the directory until the group link is added and the group is re-approved."
-            GPServiceLinkRemoved -> setGroupStatus notifyAdminUsers st env cc groupId GRSPendingUpdate $ \gr' -> do
+            GPServiceLinkRemoved -> setGroupStatus notifyAdminUsers env cc groupId GRSPendingUpdate $ \gr' -> do
               notifyOwner gr' $
                 ("The group link for " <> userGroupRef <> " is removed from the welcome message" <> byMember)
                   <> ".\n\nThe group is hidden from the directory until the group link is added and the group is re-approved."
               notifyAdminUsers $ "The group link is removed from " <> groupRef <> ", de-listed."
-            GPServiceLinkAdded _ -> setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n') $ \gr' -> do
+            GPServiceLinkAdded _ -> setGroupStatus notifyAdminUsers env cc groupId (GRSPendingApproval n') $ \gr' -> do
               notifyOwner gr' $
                 ("The group link is added to " <> userGroupRef <> byMember)
                   <> "!\nIt is hidden from the directory until approved."
@@ -630,7 +629,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                     ("The group " <> userGroupRef <> " is updated" <> byMember)
                       <> "!\nThe group is listed in directory."
                   notifyAdminUsers $ "The group " <> groupRef <> " is updated" <> byMember <> " - only link or whitespace changes.\nThe group remained listed in directory."
-              | otherwise -> setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n') $ \gr' -> do
+              | otherwise -> setGroupStatus notifyAdminUsers env cc groupId (GRSPendingApproval n') $ \gr' -> do
                   notifyOwner gr' $
                     ("The group " <> userGroupRef <> " is updated" <> byMember)
                       <> "!\nIt is hidden from the directory until approved."
@@ -849,7 +848,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                   when groupUpdated $ reapprove pg gr groupRegStatus g''
                   when (groupUpdated || summary /= groupSummary g'' || groupDomainVerified g'' /= groupDomainVerified gInfo) $ listingsUpdated env
               Left (ChatErrorAgent {agentError = SMP _ err}) | linkDeleted err ->
-                setGroupStatus logError st env cc groupId GRSRemoved $ \gr' ->
+                setGroupStatus logError env cc groupId GRSRemoved $ \gr' ->
                   notifyOwner gr' "The channel link is no longer valid.\nThe channel is removed from the directory."
               _ -> pure ()
       where
@@ -862,7 +861,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             withDB "checkGroupLink" cc (\db -> withExceptT show $ getGroupMember db (storeCxt cc) user groupId ownerGMId) >>= \case
               Right GroupMember {memberId, memberPubKey}
                 | any (\GroupLinkOwner {memberId = mId, memberKey} -> memberId == mId && memberPubKey == Just memberKey) owners -> onValid
-              _ -> setGroupStatus logError st env cc groupId GRSSuspendedBadRoles $ \gr' ->
+              _ -> setGroupStatus logError env cc groupId GRSSuspendedBadRoles $ \gr' ->
                 notifyOwner gr' "The registration owner is no longer a channel owner.\nThe channel is no longer listed in the directory."
           Nothing -> onValid
         reapprove pg gr groupRegStatus g' = do
@@ -871,7 +870,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
           notifyAdminUsers $ "The " <> gt <> " " <> groupRef <> " profile changed."
           case groupRegStatus of
             GRSActive ->
-              setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval 1) $ \gr' -> do
+              setGroupStatus notifyAdminUsers env cc groupId (GRSPendingApproval 1) $ \gr' -> do
                 notifyOwner gr' $ "The " <> gt <> " profile has changed.\nIt is hidden from the directory until approved."
                 sendToApprove g' gr' 1
             GRSPendingApproval n ->
@@ -887,14 +886,14 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
         when (ctId `isOwner` gr) $
           case groupRegStatus of
             GRSSuspendedBadRoles | rStatus == GRSOk ->
-              setGroupStatus notifyAdminUsers st env cc groupId GRSActive $ \gr' -> do
+              setGroupStatus notifyAdminUsers env cc groupId GRSActive $ \gr' -> do
                 notifyOwner gr' $ uCtRole <> ".\n\nThe group is listed in the directory again."
                 notifyAdminUsers $ "The group " <> groupRef <> " is listed " <> suCtRole
             GRSPendingApproval gaId | rStatus == GRSOk -> do
               verifyAndSendToApprove g gr gaId
               notifyOwner gr $ uCtRole <> ".\n\nThe group is submitted for approval."
             GRSActive | rStatus /= GRSOk ->
-              setGroupStatus notifyAdminUsers st env cc groupId GRSSuspendedBadRoles $ \gr' -> do
+              setGroupStatus notifyAdminUsers env cc groupId GRSSuspendedBadRoles $ \gr' -> do
                 notifyOwner gr' $ uCtRole <> ".\n\nThe group is no longer listed in the directory."
                 notifyAdminUsers $ "The group " <> groupRef <> " is de-listed " <> suCtRole
             _ -> pure ()
@@ -913,7 +912,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
         case groupRegStatus of
           GRSSuspendedBadRoles | serviceRole == GRAdmin ->
             whenContactIsOwner gr $
-              setGroupStatus notifyAdminUsers st env cc groupId GRSActive $ \gr' -> do
+              setGroupStatus notifyAdminUsers env cc groupId GRSActive $ \gr' -> do
                 notifyOwner gr' $ uSrvRole <> ".\n\nThe group is listed in the directory again."
                 notifyAdminUsers $ "The group " <> groupRef <> " is listed " <> suSrvRole
           GRSPendingApproval gaId | serviceRole == GRAdmin ->
@@ -921,7 +920,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
               verifyAndSendToApprove g gr gaId
               notifyOwner gr $ uSrvRole <> ".\n\nThe group is submitted for approval."
           GRSActive | serviceRole /= GRAdmin ->
-            setGroupStatus notifyAdminUsers st env cc groupId GRSSuspendedBadRoles $ \gr' -> do
+            setGroupStatus notifyAdminUsers env cc groupId GRSSuspendedBadRoles $ \gr' -> do
               notifyOwner gr' $ uSrvRole <> ".\n\nThe group is no longer listed in the directory."
               notifyAdminUsers $ "The group " <> groupRef <> " is de-listed " <> suSrvRole
           _ -> pure ()
@@ -939,7 +938,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
       logInfo $ "contact ID " <> tshow ctId <> " removed from group " <> viewGroupName g
       withGroupReg g "contact removed" $ \gr ->
         when (ctId `isOwner` gr) $
-          setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr' -> do
+          setGroupStatus notifyAdminUsers env cc groupId GRSRemoved $ \gr' -> do
             notifyOwner gr' $ "You are removed from the " <> gt <> " " <> userGroupReference gr' g <> ".\n\nThe " <> gt <> " is no longer listed in the directory."
             notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (" <> gt <> " owner is removed)."
             when (isJust pg_) $ leavePublicGroup g
@@ -950,7 +949,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
       logInfo $ "contact ID " <> tshow ctId <> " left group " <> viewGroupName g
       withGroupReg g "contact left" $ \gr ->
         when (ctId `isOwner` gr) $
-          setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr' -> do
+          setGroupStatus notifyAdminUsers env cc groupId GRSRemoved $ \gr' -> do
             notifyOwner gr' $ "You left the " <> gt <> " " <> userGroupReference gr' g <> ".\n\nThe " <> gt <> " is no longer listed in the directory."
             notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (" <> gt <> " owner left)."
             when (isJust pg_) $ leavePublicGroup g
@@ -959,7 +958,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
     deServiceRemovedFromGroup g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} = do
       let gt = maybe "group" groupTypeStr' pg_
       logInfo $ "service removed from group " <> viewGroupName g
-      setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr -> do
+      setGroupStatus notifyAdminUsers env cc groupId GRSRemoved $ \gr -> do
         notifyOwner gr $ serviceName <> " is removed from the " <> gt <> " " <> userGroupReference gr g <> ".\n\nThe " <> gt <> " is no longer listed in the directory."
         notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (directory service is removed)."
 
@@ -967,7 +966,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
     deGroupDeleted g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} = do
       let gt = maybe "group" groupTypeStr' pg_
       logInfo $ "group removed " <> viewGroupName g
-      setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr -> do
+      setGroupStatus notifyAdminUsers env cc groupId GRSRemoved $ \gr -> do
         notifyOwner gr $ "The " <> gt <> " " <> userGroupReference gr g <> " is deleted.\n\nThe " <> gt <> " is no longer listed in the directory."
         notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (" <> gt <> " is deleted)."
 
@@ -1159,7 +1158,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
       sendChatCmd cc (APIPrepareGroup userId ccLink False Nothing groupSLinkData) >>= \case
         Right (CRNewPreparedChat _ (AChat SCTGroup (Chat (GroupChat gInfo _) _ _))) -> do
           let gId = groupId' gInfo
-          addGroupReg notifyAdminUsers st cc user ct gInfo GRSProposed $ \_ -> pure ()
+          addGroupReg notifyAdminUsers cc user ct gInfo GRSProposed $ \_ -> pure ()
           sendChatCmd cc (APIConnectPreparedGroup gId False (Just ownerContact) Nothing) >>= \case
             Right CRStartedConnectionToGroup {groupInfo = gInfo'} ->
               withDB "getGroupMember" cc (\db -> withExceptT show $ getGroupMemberByMemberId db (storeCxt cc) user gInfo' mId) >>= \case
@@ -1184,7 +1183,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                     | contactId' ct `isOwner` gr -> sameOwnerReregistration gr gt
                     | otherwise -> sendMessage cc ct $ "This " <> gt <> " is registered by another owner."
                   Left _ ->
-                    addGroupReg notifyAdminUsers st cc user ct g (GRSPendingApproval 1) $ \gr -> do
+                    addGroupReg notifyAdminUsers cc user ct g (GRSPendingApproval 1) $ \gr -> do
                       void $ setGroupRegOwner cc groupId ownerMember
                       verifyAndSendToApprove g gr 1
             | role < GROwner -> sendMessage cc ct $ "You must be the " <> gt <> " owner to register it."
@@ -1206,7 +1205,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
           GRSRemoved -> pendingApprovalTransition gr gt 1
         pendingApprovalTransition gr gt n = do
           let userGroupRef = userGroupReference gr g
-          setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n) $ \gr' -> do
+          setGroupStatus notifyAdminUsers env cc groupId (GRSPendingApproval n) $ \gr' -> do
             notifyOwner gr' $
               "The " <> gt <> " " <> userGroupRef <> " is submitted for approval.\nIt is hidden from the directory until approved."
             verifyAndSendToApprove g gr' n
@@ -1220,12 +1219,12 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
           let GroupMember {memberRole = role} = toMember
               gt = maybe "group" groupTypeStr' publicGroup
            in if role >= GROwner
-                then setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval 1) $ \gr' -> do
+                then setGroupStatus notifyAdminUsers env cc groupId (GRSPendingApproval 1) $ \gr' -> do
                   notifyOwner gr' $ "Joined the " <> gt <> " " <> displayName <> ". Registration is pending approval — it may take up to 48 hours."
                   notifyOwner gr' $ recommendedSettingsNotice (userGroupRegId gr')
                   verifyAndSendToApprove g gr' 1
                 else do
-                  setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \_ -> pure ()
+                  setGroupStatus notifyAdminUsers env cc groupId GRSRemoved $ \_ -> pure ()
                   sendMessage' cc (dbContactId gr) "The signing key does not belong to a current owner. Registration cancelled."
 
     deUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRUser -> IO ()
@@ -1316,7 +1315,6 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
           let gt = maybe "group" groupTypeStr' pg_
           delGroupReg cc dbGroupId >>= \case
             Right () -> do
-              logGDelete st dbGroupId
               sendReply $ (if isAdmin then "The " <> gt <> " " else "Your " <> gt <> " ") <> displayName <> " is deleted from the directory"
               when (isJust pg_) $ leavePublicGroup g
             Left e -> sendReply $ "Error deleting " <> gt <> " " <> displayName <> ": " <> T.pack e
@@ -1525,7 +1523,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                               let grPromoted'
                                     | promoted || knownCt `elem` superUsers = fromMaybe promoted promote
                                     | otherwise = False
-                              setGroupStatusPromo sendReply st env cc gr GRSActive grPromoted' $ do
+                              setGroupStatusPromo sendReply env cc gr GRSActive grPromoted' $ do
                                 let approved = "The " <> gt <> " " <> userGroupReference' gr n <> " is approved"
                                 let commands
                                       | isPublicGroup_ = ""
@@ -1574,7 +1572,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             let groupRef = groupReference' groupId gName
             withGroupAndReg sendReply groupId gName $ \_ gr ->
               case groupRegStatus gr of
-                GRSActive -> setGroupStatus sendReply st env cc groupId GRSSuspended $ \gr' -> do
+                GRSActive -> setGroupStatus sendReply env cc groupId GRSSuspended $ \gr' -> do
                   let suspended = "The group " <> userGroupReference' gr gName <> " is suspended"
                   notifyOwner gr' $ suspended <> " and hidden from directory. Please contact the administrators."
                   sendReply "Group suspended!"
@@ -1584,7 +1582,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             let groupRef = groupReference' groupId gName
             withGroupAndReg sendReply groupId gName $ \_ gr ->
               case groupRegStatus gr of
-                GRSSuspended -> setGroupStatus sendReply st env cc groupId GRSActive $ \gr' -> do
+                GRSSuspended -> setGroupStatus sendReply env cc groupId GRSActive $ \gr' -> do
                   let groupStr = "The group " <> userGroupReference' gr gName
                   notifyOwner gr' $ groupStr <> " is listed in the directory again!"
                   sendReply "Group listing resumed!"
@@ -1671,7 +1669,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             withGroupAndReg sendReply groupId gName $ \_ gr@GroupReg {groupRegStatus, promoted} -> do
               let notify = sendReply $ "Group promotion " <> (if promote' then "enabled" <> (if groupRegStatus == GRSActive then "." else ", but the group is not listed.") else "disabled.")
               if promote' /= promoted
-                then setGroupPromoted sendReply st env cc gr promote' notify
+                then setGroupPromoted sendReply env cc gr promote' notify
                 else notify
           DCPromoteContact contactId _n promote' ->
             getContactReg cc user contactId >>= \case
@@ -1742,48 +1740,43 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
               msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
            in (Nothing, msg)
 
-setGroupStatusPromo :: (Text -> IO ()) -> DirectoryLog -> ServiceState -> ChatController -> GroupReg -> GroupRegStatus -> Bool -> IO () -> IO ()
-setGroupStatusPromo sendReply st env cc GroupReg {dbGroupId = gId} grStatus' grPromoted' continue = do
+setGroupStatusPromo :: (Text -> IO ()) -> ServiceState -> ChatController -> GroupReg -> GroupRegStatus -> Bool -> IO () -> IO ()
+setGroupStatusPromo sendReply env cc GroupReg {dbGroupId = gId} grStatus' grPromoted' continue = do
   let status' = grDirectoryStatus grStatus'
   setGroupStatusPromoStore cc gId grStatus' grPromoted' >>= \case
     Left e -> sendReply $ "Error updating group " <> tshow gId <> " status: " <> T.pack e
     Right (status, grPromoted) -> do
       when ((status == DSListed || status' == DSListed) && (status /= status' || grPromoted /= grPromoted')) $
         listingsUpdated env
-      logGUpdateStatus st gId grStatus'
-      logGUpdatePromotion st gId grPromoted'
       continue
 
-addGroupReg :: (Text -> IO ()) -> DirectoryLog -> ChatController -> User -> Contact -> GroupInfo -> GroupRegStatus -> (GroupReg -> IO ()) -> IO ()
-addGroupReg sendMsg st cc user ct g@GroupInfo {groupId} grStatus continue =
+addGroupReg :: (Text -> IO ()) -> ChatController -> User -> Contact -> GroupInfo -> GroupRegStatus -> (GroupReg -> IO ()) -> IO ()
+addGroupReg sendMsg cc user ct g@GroupInfo {groupId} grStatus continue =
   addGroupRegStore cc ct g grStatus >>= \case
     Left e -> sendMsg $ "Error creating group registation for group " <> tshow groupId <> ": " <> T.pack e
     Right gr -> do
-      logGCreate st gr
       let d = toCustomData $ DirectoryGroupData newGroupJoinFilter
       withDB' "setGroupCustomData" cc (\db -> setGroupCustomData db user g $ Just d) >>= \case
         Right () -> pure ()
         Left e -> sendMsg $ "Error setting default captcha for group " <> tshow groupId <> ": " <> T.pack e
       continue gr
 
-setGroupStatus :: (Text -> IO ()) -> DirectoryLog -> ServiceState -> ChatController -> GroupId -> GroupRegStatus -> (GroupReg -> IO ()) -> IO ()
-setGroupStatus sendMsg st env cc gId grStatus' continue = do
+setGroupStatus :: (Text -> IO ()) -> ServiceState -> ChatController -> GroupId -> GroupRegStatus -> (GroupReg -> IO ()) -> IO ()
+setGroupStatus sendMsg env cc gId grStatus' continue = do
   let status' = grDirectoryStatus grStatus'
   setGroupStatusStore cc gId grStatus' >>= \case
     Left e -> sendMsg $ "Error updating group " <> tshow gId <> " status: " <> T.pack e
     Right (grStatus, gr) -> do
       let status = grDirectoryStatus grStatus
       when ((status == DSListed || status' == DSListed) && status /= status') $ listingsUpdated env
-      logGUpdateStatus st gId grStatus'
       continue gr
 
-setGroupPromoted :: (Text -> IO ()) -> DirectoryLog -> ServiceState -> ChatController -> GroupReg -> Bool -> IO () -> IO ()
-setGroupPromoted sendReply st env cc GroupReg {dbGroupId = gId} grPromoted' continue =
+setGroupPromoted :: (Text -> IO ()) -> ServiceState -> ChatController -> GroupReg -> Bool -> IO () -> IO ()
+setGroupPromoted sendReply env cc GroupReg {dbGroupId = gId} grPromoted' continue =
   setGroupPromotedStore cc gId grPromoted' >>= \case
     Left e -> sendReply $ "Error updating group " <> tshow gId <> " status: " <> T.pack e
     Right (status, grPromoted) -> do
       when (status == DSListed && grPromoted' /= grPromoted) $ listingsUpdated env
-      logGUpdatePromotion st gId grPromoted'
       continue
 
 updateGroupListingFiles :: ChatController -> User -> FilePath -> IO ()

apps/simplex-directory-service/src/Directory/Store.hs

@@ -11,8 +11,7 @@
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Directory.Store
-  ( DirectoryLog (..),
-    GroupReg (..),
+  ( GroupReg (..),
     GroupRegStatus (..),
     UserGroupRegId,
     GroupApprovalId,
@@ -20,9 +19,6 @@ module Directory.Store
     DirectoryMemberAcceptance (..),
     DirectoryStatus (..),
     ProfileCondition (..),
-    DirectoryLogRecord (..),
-    openDirectoryLog,
-    readDirectoryLogData,
     addGroupRegStore,
     insertGroupReg,
     delGroupReg,
@@ -67,15 +63,9 @@ module Directory.Store
     strongJoinFilter,
     newGroupJoinFilter,
     groupDBError,
-    logGCreate,
-    logGDelete,
-    logGUpdateOwner,
-    logGUpdateStatus,
-    logGUpdatePromotion,
   )
 where
 
-import Control.Applicative ((<|>))
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
@@ -84,18 +74,12 @@ import qualified Data.Aeson.KeyMap as JM
 import qualified Data.Aeson.TH as JQ
 import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
-import Data.List (sortOn)
-import Data.Map (Map)
-import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes, fromMaybe, isJust)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
-import Data.Time.Clock.System (systemEpochDay)
 import Directory.Search
 import Directory.Util
 import Simplex.Chat.Controller
@@ -112,7 +96,6 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
 import Simplex.Messaging.Util (eitherToMaybe, firstRow, maybeFirstRow', safeDecodeUtf8)
-import System.IO (BufferMode (..), Handle, IOMode (..), hSetBuffering, openFile)
 
 #if defined(dbPostgres)
 import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
@@ -122,10 +105,6 @@ import Database.SQLite.Simple (Only (..), Query, (:.) (..))
 import Database.SQLite.Simple.QQ (sql)
 #endif
 
-data DirectoryLog = DirectoryLog
-  { directoryLogFile :: Maybe Handle
-  }
-
 data GroupReg = GroupReg
   { dbGroupId :: GroupId,
     userGroupRegId :: UserGroupRegId,
@@ -626,89 +605,6 @@ groupReqQuery = groupInfoQueryFields <> groupRegFields <> groupInfoQueryFrom <>
     groupRegFields = ", r.group_id, r.user_group_reg_id, r.contact_id, r.owner_member_id, r.group_reg_status, r.group_promoted, r.created_at "
     groupRegFromCond = " JOIN sx_directory_group_regs r ON r.group_id = g.group_id WHERE g.user_id = ? AND mu.contact_id = ? "
 
-data DirectoryLogRecord
-  = GRCreate GroupReg
-  | GRDelete GroupId
-  | GRUpdateStatus GroupId GroupRegStatus
-  | GRUpdatePromotion GroupId Bool
-  | GRUpdateOwner GroupId GroupMemberId
-
-data DLRTag
-  = GRCreate_
-  | GRDelete_
-  | GRUpdateStatus_
-  | GRUpdatePromotion_
-  | GRUpdateOwner_
-
-logDLR :: DirectoryLog -> DirectoryLogRecord -> IO ()
-logDLR st r = forM_ (directoryLogFile st) $ \h -> B.hPutStrLn h (strEncode r)
-
-logGCreate :: DirectoryLog -> GroupReg -> IO ()
-logGCreate st = logDLR st . GRCreate
-
-logGDelete :: DirectoryLog -> GroupId -> IO ()
-logGDelete st = logDLR st . GRDelete
-
-logGUpdateStatus :: DirectoryLog -> GroupId -> GroupRegStatus -> IO ()
-logGUpdateStatus st gId = logDLR st . GRUpdateStatus gId
-
-logGUpdatePromotion :: DirectoryLog -> GroupId -> Bool -> IO ()
-logGUpdatePromotion st gId = logDLR st . GRUpdatePromotion gId
-
-logGUpdateOwner :: DirectoryLog -> GroupId -> GroupMemberId -> IO ()
-logGUpdateOwner st gId = logDLR st . GRUpdateOwner gId
-
-instance StrEncoding DLRTag where
-  strEncode = \case
-    GRCreate_ -> "GCREATE"
-    GRDelete_ -> "GDELETE"
-    GRUpdateStatus_ -> "GSTATUS"
-    GRUpdatePromotion_ -> "GPROMOTE"
-    GRUpdateOwner_ -> "GOWNER"
-  strP =
-    A.takeTill (== ' ') >>= \case
-      "GCREATE" -> pure GRCreate_
-      "GDELETE" -> pure GRDelete_
-      "GSTATUS" -> pure GRUpdateStatus_
-      "GPROMOTE" -> pure GRUpdatePromotion_
-      "GOWNER" -> pure GRUpdateOwner_
-      _ -> fail "invalid DLRTag"
-
-instance StrEncoding DirectoryLogRecord where
-  strEncode = \case
-    GRCreate gr -> strEncode (GRCreate_, gr)
-    GRDelete gId -> strEncode (GRDelete_, gId)
-    GRUpdateStatus gId grStatus -> strEncode (GRUpdateStatus_, gId, grStatus)
-    GRUpdatePromotion gId promoted -> strEncode (GRUpdatePromotion_, gId, promoted)
-    GRUpdateOwner gId grOwnerId -> strEncode (GRUpdateOwner_, gId, grOwnerId)
-  strP =
-    strP_ >>= \case
-      GRCreate_ -> GRCreate <$> strP
-      GRDelete_ -> GRDelete <$> strP
-      GRUpdateStatus_ -> GRUpdateStatus <$> A.decimal <*> _strP
-      GRUpdatePromotion_ -> GRUpdatePromotion <$> A.decimal <*> _strP
-      GRUpdateOwner_ -> GRUpdateOwner <$> A.decimal <* A.space <*> A.decimal
-
-instance StrEncoding GroupReg where
-  strEncode GroupReg {dbGroupId, userGroupRegId, dbContactId, dbOwnerMemberId, groupRegStatus, promoted} =
-    B.unwords $
-      [ "group_id=" <> strEncode dbGroupId,
-        "user_group_id=" <> strEncode userGroupRegId,
-        "contact_id=" <> strEncode dbContactId,
-        "owner_member_id=" <> strEncode dbOwnerMemberId,
-        "status=" <> strEncode groupRegStatus
-      ]
-        <> ["promoted=" <> strEncode promoted | promoted]
-  strP = do
-    dbGroupId <- "group_id=" *> strP_
-    userGroupRegId <- "user_group_id=" *> strP_
-    dbContactId <- "contact_id=" *> strP_
-    dbOwnerMemberId <- "owner_member_id=" *> strP_
-    groupRegStatus <- "status=" *> strP
-    promoted <- (" promoted=" *> strP) <|> pure False
-    let createdAt = UTCTime systemEpochDay 0
-    pure GroupReg {dbGroupId, userGroupRegId, dbContactId, dbOwnerMemberId, groupRegStatus, promoted, createdAt}
-
 instance StrEncoding GroupRegStatus where
   strEncode = \case
     GRSPendingConfirmation -> "pending_confirmation"
@@ -734,40 +630,3 @@ instance StrEncoding GroupRegStatus where
 instance ToField GroupRegStatus where toField = toField . safeDecodeUtf8 . strEncode
 
 instance FromField GroupRegStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
-
-openDirectoryLog :: Maybe FilePath -> IO DirectoryLog
-openDirectoryLog = \case
-  Just f -> DirectoryLog . Just <$> openLogFile f
-  Nothing -> pure $ DirectoryLog Nothing
-  where
-    openLogFile f = do
-      h <- openFile f AppendMode
-      hSetBuffering h LineBuffering
-      pure h
-
-readDirectoryLogData :: FilePath -> IO [GroupReg]
-readDirectoryLogData f =
-  sortOn dbGroupId . M.elems
-    <$> (foldM processDLR M.empty . B.lines =<< B.readFile f)
-  where
-    processDLR :: Map GroupId GroupReg -> ByteString -> IO (Map GroupId GroupReg)
-    processDLR m l = case strDecode l of
-      Left e -> m <$ putStrLn ("Error parsing log record: " <> e <> ", " <> B.unpack (B.take 80 l))
-      Right r -> case r of
-        GRCreate gr@GroupReg {dbGroupId = gId} -> do
-          when (isJust $ M.lookup gId m) $
-            putStrLn $
-              "Warning: duplicate group with ID " <> show gId <> ", group replaced."
-          pure $ M.insert gId gr m
-        GRDelete gId -> case M.lookup gId m of
-          Just _ -> pure $ M.delete gId m
-          Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <> ", deletion ignored.")
-        GRUpdateStatus gId groupRegStatus -> case M.lookup gId m of
-          Just gr -> pure $ M.insert gId gr {groupRegStatus} m
-          Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <> ", status update ignored.")
-        GRUpdatePromotion gId promoted -> case M.lookup gId m of
-          Just gr -> pure $ M.insert gId gr {promoted} m
-          Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <> ", promotion update ignored.")
-        GRUpdateOwner gId grOwnerId -> case M.lookup gId m of
-          Just gr -> pure $ M.insert gId gr {dbOwnerMemberId = Just grOwnerId} m
-          Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <> ", owner update ignored.")

apps/simplex-directory-service/src/Directory/Store/Migrate.hs

@@ -7,18 +7,15 @@
 
 module Directory.Store.Migrate where
 
-import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Except
 import qualified Data.ByteString.Char8 as B
 import Data.List (find)
-import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
-import Directory.Listing
 import Directory.Options
 import Directory.Store
 import Simplex.Chat (createChatDatabase)
-import Simplex.Chat.Controller (ChatConfig (..), ChatDatabase (..), mkStoreCxt)
+import Simplex.Chat.Controller (ChatConfig (..), ChatDatabase (..))
 import Simplex.Chat.Options (CoreChatOpts (..))
 import Simplex.Chat.Options.DB
 import Simplex.Chat.Store.Groups (getHostMember)
@@ -30,11 +27,7 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.Interface (closeDBStore, migrateDBSchema)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationConfirmation (..))
 import Simplex.Messaging.Encoding.String
-import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (whenM)
-import System.Directory (doesFileExist, renamePath)
 import System.Exit (exitFailure)
-import System.IO (IOMode (..), withFile)
 
 #if defined(dbPostgres)
 import Directory.Store.Postgres.Migrations
@@ -55,66 +48,9 @@ runDirectoryMigrations opts ChatConfig {confirmMigrations} chatStore =
     DirectoryOpts {coreOptions = CoreChatOpts {dbOptions, yesToUpMigrations}} = opts
     confirm = if confirmMigrations == MCConsole && yesToUpMigrations then MCYesUp else confirmMigrations
 
-checkDirectoryLog :: DirectoryOpts -> ChatConfig -> IO ()
-checkDirectoryLog opts cfg =
-  withDirectoryLog opts $ \logFile -> withChatStore opts $ \st -> do
-    runDirectoryMigrations opts cfg st
-    gs <- readDirectoryLogData logFile
-    withActiveUser st $ \user -> withTransaction st $ \db -> do
-      mapM_ (verifyGroupRegistration (mkStoreCxt cfg) db user) gs
-    putStrLn $ show (length gs) <> " group registrations OK"
-
-importDirectoryLogToDB :: DirectoryOpts -> ChatConfig -> IO ()
-importDirectoryLogToDB opts cfg = do
-  withDirectoryLog opts $ \logFile -> withChatStore opts $ \st -> do
-    runDirectoryMigrations opts cfg st
-    gs <- readDirectoryLogData logFile
-    ctRegs <- TM.emptyIO
-    withActiveUser st $ \user -> withTransaction st $ \db -> do
-      forM_ gs $ \gr ->
-        whenM (verifyGroupRegistration (mkStoreCxt cfg) db user gr) $ do
-          putStrLn $ "importing group " <> show (dbGroupId gr)
-          insertGroupReg db =<< fixUserGroupRegId ctRegs gr
-      renamePath logFile (logFile ++ ".bak")
-    putStrLn $ show (length gs) <> " group registrations imported"
-  where
-    fixUserGroupRegId ctRegs gr@GroupReg {dbGroupId, dbContactId} = do
-      ugIds <- fromMaybe [] <$> TM.lookupIO dbContactId ctRegs
-      gr' <-
-        if userGroupRegId gr `elem` ugIds
-          then do
-            let ugId = maximum ugIds + 1
-            putStrLn $ "Warning: updating userGroupRegId for group " <> show dbGroupId <> ", contact " <> show dbContactId
-            pure gr {userGroupRegId = ugId}
-          else pure gr
-      atomically $ TM.insert dbContactId (userGroupRegId gr' : ugIds) ctRegs
-      pure gr'
-
 exit :: String -> IO a
 exit err = putStrLn ("Error: " <> err) >> exitFailure
 
-exportDBToDirectoryLog :: DirectoryOpts -> ChatConfig -> IO ()
-exportDBToDirectoryLog opts cfg =
-  withDirectoryLog opts $ \logFile -> withChatStore opts $ \st -> do
-    whenM (doesFileExist logFile) $ exit $ "directory log file " ++ logFile ++ " already exists"
-    runDirectoryMigrations opts cfg st
-    withActiveUser st $ \user -> do
-      gs <- withFile logFile WriteMode $ \h -> withTransaction st $ \db -> do
-        gs <- getAllGroupRegs_ db (mkStoreCxt cfg) user
-        forM_ gs $ \(_, gr) ->
-          whenM (verifyGroupRegistration (mkStoreCxt cfg) db user gr) $
-            B.hPutStrLn h $ strEncode $ GRCreate gr
-        pure gs
-      putStrLn $ show (length gs) <> " group registrations exported"
-
-saveGroupListingFiles :: DirectoryOpts -> ChatConfig -> IO ()
-saveGroupListingFiles opts cfg = case webFolder opts of
-  Nothing -> exit "use --web-folder to generate listings"
-  Just dir ->
-    withChatStore opts $ \st -> withActiveUser st $ \user ->
-      withTransaction st $ \db ->
-        getAllListedGroups_ db (mkStoreCxt cfg) user >>= \gs -> generateListing dir gs []
-
 verifyGroupRegistration :: StoreCxt -> DB.Connection -> User -> GroupReg -> IO Bool
 verifyGroupRegistration cxt db user GroupReg {dbGroupId = gId, dbContactId = ctId, dbOwnerMemberId, groupRegStatus} =
   runExceptT (getGroupInfo db cxt user gId) >>= \case
@@ -129,10 +65,6 @@ verifyGroupRegistration cxt db user GroupReg {dbGroupId = gId, dbContactId = ctI
             | mId /= mId' -> False <$ putStrLn ("Error: different host member ID of " <> groupRef <> " (skipping): " <> show mId')
             | otherwise -> True <$ unless (Just ctId == ctId') (putStrLn $ "Warning: bad group " <> groupRef <> " contact ID: " <> show ctId')
 
-withDirectoryLog :: DirectoryOpts -> (FilePath -> IO ()) -> IO ()
-withDirectoryLog DirectoryOpts {directoryLog} action =
-  maybe (exit "directory log file not specified") action directoryLog
-
 withChatStore :: DirectoryOpts -> (DBStore -> IO ()) -> IO ()
 withChatStore DirectoryOpts {coreOptions = CoreChatOpts {dbOptions, yesToUpMigrations, migrationBackupPath}} action =
   createChatDatabase dbOptions migrationConfig >>= \case

bots/api/COMMANDS.md

@@ -15,6 +15,8 @@ This file is generated automatically.
 - [APIDeleteChatItem](#apideletechatitem)
 - [APIDeleteMemberChatItem](#apideletememberchatitem)
 - [APIChatItemReaction](#apichatitemreaction)
+- [APIShareMyAddress](#apisharemyaddress)
+- [APIShareChatMsgContent](#apisharechatmsgcontent)
 
 [File commands](#file-commands)
 - [ReceiveFile](#receivefile)
@@ -35,6 +37,7 @@ This file is generated automatically.
 - [APIAddGroupRelays](#apiaddgrouprelays)
 - [APIAllowRelayGroup](#apiallowrelaygroup)
 - [APIUpdateGroupProfile](#apiupdategroupprofile)
+- [APIVerifyGroupDomain](#apiverifygroupdomain)
 
 [Group link commands](#group-link-commands)
 - [APICreateGroupLink](#apicreategrouplink)
@@ -489,6 +492,73 @@ ChatCmdError: Command error (only used in WebSockets API).
 ---
 
 
+### APIShareMyAddress
+
+Share user address card
+
+*Network usage*: no.
+
+**Parameters**:
+- toSendRef: [ChatRef](./TYPES.md#chatref)
+
+**Syntax**:
+
+```
+/_share address<str(toSendRef)>
+```
+
+```javascript
+'/_share address' + ChatRef.cmdString(toSendRef) // JavaScript
+```
+
+```python
+'/_share address' + ChatRef_cmd_string(toSendRef) # Python
+```
+
+**Response**:
+
+ChatMsgContent: Chat card content that can be sent.
+- type: "chatMsgContent"
+- user: [User](./TYPES.md#user)
+- msgContent: [MsgContent](./TYPES.md#msgcontent)
+
+---
+
+
+### APIShareChatMsgContent
+
+Share channel address
+
+*Network usage*: no.
+
+**Parameters**:
+- shareChatRef: [ChatRef](./TYPES.md#chatref)
+- toSendRef: [ChatRef](./TYPES.md#chatref)
+
+**Syntax**:
+
+```
+/_share chat content <str(shareChatRef)> <str(toSendRef)>
+```
+
+```javascript
+'/_share chat content ' + ChatRef.cmdString(shareChatRef) + ' ' + ChatRef.cmdString(toSendRef) // JavaScript
+```
+
+```python
+'/_share chat content ' + ChatRef_cmd_string(shareChatRef) + ' ' + ChatRef_cmd_string(toSendRef) # Python
+```
+
+**Response**:
+
+ChatMsgContent: Chat card content that can be sent.
+- type: "chatMsgContent"
+- user: [User](./TYPES.md#user)
+- msgContent: [MsgContent](./TYPES.md#msgcontent)
+
+---
+
+
 ## File commands
 
 Commands to receive and to cancel files. Files are sent as part of the message, there are no separate commands to send files.
@@ -1165,6 +1235,40 @@ ChatCmdError: Command error (only used in WebSockets API).
 ---
 
 
+### APIVerifyGroupDomain
+
+Verify group domain
+
+*Network usage*: interactive.
+
+**Parameters**:
+- groupId: int64
+
+**Syntax**:
+
+```
+/_verify domain #<groupId>
+```
+
+```javascript
+'/_verify domain #' + groupId // JavaScript
+```
+
+```python
+'/_verify domain #' + str(groupId) # Python
+```
+
+**Response**:
+
+GroupDomainVerified: Group domain verified.
+- type: "groupDomainVerified"
+- user: [User](./TYPES.md#user)
+- groupInfo: [GroupInfo](./TYPES.md#groupinfo)
+- verificationFailure: string?
+
+---
+
+
 ## Group link commands
 
 These commands can be used by bots that manage multiple public groups

bots/api/TYPES.md

@@ -1448,6 +1448,7 @@ Search:
 **Enum type**:
 - "human"
 - "bot"
+- "business"
 
 
 ---

bots/src/API/Docs/Commands.hs

@@ -97,7 +97,9 @@ chatCommandsDocsData =
         ),
         ("APIDeleteChatItem", [], "Delete message.", ["CRChatItemsDeleted", "CRChatCmdError"], [], Just UNBackground, "/_delete item " <> Param "chatRef" <> " " <> Join ',' "chatItemIds" <> " " <> Param "deleteMode"),
         ("APIDeleteMemberChatItem", [], "Moderate message. Requires Moderator role (and higher than message author's).", ["CRChatItemsDeleted", "CRChatCmdError"], [], Just UNBackground, "/_delete member item #" <> Param "groupId" <> " " <> Join ',' "chatItemIds"),
-        ("APIChatItemReaction", [], "Add/remove message reaction.", ["CRChatItemReaction", "CRChatCmdError"], [], Just UNBackground, "/_reaction " <> Param "chatRef" <> " " <> Param "chatItemId" <> " " <> OnOff "add" <> " " <> Json "reaction")
+        ("APIChatItemReaction", [], "Add/remove message reaction.", ["CRChatItemReaction", "CRChatCmdError"], [], Just UNBackground, "/_reaction " <> Param "chatRef" <> " " <> Param "chatItemId" <> " " <> OnOff "add" <> " " <> Json "reaction"),
+        ("APIShareMyAddress", [], "Share user address card", ["CRChatMsgContent"], [], Nothing, "/_share address" <> Param "toSendRef"),
+        ("APIShareChatMsgContent", [], "Share channel address", ["CRChatMsgContent"], [], Nothing, "/_share chat content " <> Param "shareChatRef" <> " " <> Param "toSendRef")
       ]
     ),
     ( "File commands",
@@ -121,7 +123,8 @@ chatCommandsDocsData =
         ("APIGetGroupRelays", [], "Get group relays.", ["CRGroupRelays", "CRChatCmdError"], [], Nothing, "/_get relays #" <> Param "groupId"),
         ("APIAddGroupRelays", [], "Add relays to group.", ["CRGroupRelaysAdded", "CRGroupRelaysAddFailed", "CRChatCmdError"], [], Just UNInteractive, "/_add relays #" <> Param "groupId" <> " " <> Join ',' "relayIds"),
         ("APIAllowRelayGroup", [], "Clear relay rejection for a channel (relay operator).", ["CRRelayGroupAllowed", "CRChatCmdError"], [], Just UNBackground, "/_relay allow #" <> Param "groupId"),
-        ("APIUpdateGroupProfile", [], "Update group profile.", ["CRGroupUpdated", "CRChatCmdError"], [], Just UNBackground, "/_group_profile #" <> Param "groupId" <> " " <> Json "groupProfile")
+        ("APIUpdateGroupProfile", [], "Update group profile.", ["CRGroupUpdated", "CRChatCmdError"], [], Just UNBackground, "/_group_profile #" <> Param "groupId" <> " " <> Json "groupProfile"),
+        ("APIVerifyGroupDomain", [], "Verify group domain", ["CRGroupDomainVerified"], [], Just UNInteractive, "/_verify domain #" <> Param "groupId")
       ]
     ),
     ( "Group link commands",
@@ -426,8 +429,6 @@ undocumentedCommands =
     "APISetUserDomain",
     "APISetUserServers",
     "APISetUserUIThemes",
-    "APIShareChatMsgContent",
-    "APIShareMyAddress",
     "APIStandaloneFileInfo",
     "APIStorageEncryption",
     "APISuspendChat",
@@ -446,7 +447,6 @@ undocumentedCommands =
     "APIVerifyContact",
     "APIVerifyContactDomain",
     "APIVerifyGroupMember",
-    "APIVerifyGroupDomain",
     "APIVerifyToken",
     "CheckChatRunning",
     "ConfirmRemoteCtrl",

bots/src/API/Docs/Responses.hs

@@ -51,6 +51,7 @@ chatResponsesDocsData =
     ("CRChatItemReaction", "Message reaction"),
     ("CRChatItemUpdated", "Message updated"),
     ("CRChatItemsDeleted", "Messages deleted"),
+    ("CRChatMsgContent", "Chat card content that can be sent"),
     ("CRChatRunning", ""),
     ("CRChatStarted", ""),
     ("CRChatStopped", ""),
@@ -77,6 +78,7 @@ chatResponsesDocsData =
     ("CRGroupMembers", ""),
     ("CRGroupUpdated", ""),
     ("CRGroupsList", "Groups"),
+    ("CRGroupDomainVerified", ""),
     ("CRInvitation", "One-time invitation"),
     ("CRLeftMemberUser", "User left group"),
     ("CRMemberAccepted", "Member accepted to group"),
@@ -136,7 +138,6 @@ undocumentedResponses =
     "CRChatItemInfo",
     "CRChatItems",
     "CRChatItemTTL",
-    "CRChatMsgContent",
     "CRChatRelayTestResult",
     "CRChats",
     "CRConnectionsDiff",
@@ -169,7 +170,6 @@ undocumentedResponses =
     "CRGroupMemberRatchetSyncStarted",
     "CRGroupMemberSwitchAborted",
     "CRGroupMemberSwitchStarted",
-    "CRGroupDomainVerified",
     "CRGroupProfile",
     "CRGroupUserChanged",
     "CRItemsReadForChat",

bots/src/API/Docs/Types.hs

@@ -226,7 +226,7 @@ chatTypesDocsData =
     (sti @BadgeType, STEnum, "BT", ["BTUnknown"], "", ""),
     (sti @ChatFeature, STEnum, "CF", [], "", ""),
     (sti @ChatItemDeletion, STRecord, "", [], "", "Message deletion result."),
-    (sti @ChatPeerType, STEnum, "CPT", [], "", ""),
+    (sti @ChatPeerType, STEnum, "CPT", ["CPTUnknown"], "", ""),
     (sti @ChatRef, STRecord, "", [], Param "chatType" <> Param "chatId" <> Optional "" (Param "$0") "chatScope", "Used in API commands. Chat scope can only be passed with groups."),
     (sti @ChatSettings, STRecord, "", [], "", ""),
     (sti @ChatStats, STRecord, "", [], "", ""),

packages/simplex-chat-client/types/typescript/src/commands.ts

@@ -168,6 +168,35 @@ export namespace APIChatItemReaction {
   }
 }
 
+// Share user address card
+// Network usage: no.
+export interface APIShareMyAddress {
+  toSendRef: T.ChatRef
+}
+
+export namespace APIShareMyAddress {
+  export type Response = CR.ChatMsgContent
+
+  export function cmdString(self: APIShareMyAddress): string {
+    return '/_share address' + T.ChatRef.cmdString(self.toSendRef)
+  }
+}
+
+// Share channel address
+// Network usage: no.
+export interface APIShareChatMsgContent {
+  shareChatRef: T.ChatRef
+  toSendRef: T.ChatRef
+}
+
+export namespace APIShareChatMsgContent {
+  export type Response = CR.ChatMsgContent
+
+  export function cmdString(self: APIShareChatMsgContent): string {
+    return '/_share chat content ' + T.ChatRef.cmdString(self.shareChatRef) + ' ' + T.ChatRef.cmdString(self.toSendRef)
+  }
+}
+
 // File commands
 // Commands to receive and to cancel files. Files are sent as part of the message, there are no separate commands to send files.
 
@@ -419,6 +448,20 @@ export namespace APIUpdateGroupProfile {
   }
 }
 
+// Verify group domain
+// Network usage: interactive.
+export interface APIVerifyGroupDomain {
+  groupId: number // int64
+}
+
+export namespace APIVerifyGroupDomain {
+  export type Response = CR.GroupDomainVerified
+
+  export function cmdString(self: APIVerifyGroupDomain): string {
+    return '/_verify domain #' + self.groupId
+  }
+}
+
 // Group link commands
 // These commands can be used by bots that manage multiple public groups
 

packages/simplex-chat-client/types/typescript/src/responses.ts

@@ -10,6 +10,7 @@ export type ChatResponse =
   | CR.ChatItemReaction
   | CR.ChatItemUpdated
   | CR.ChatItemsDeleted
+  | CR.ChatMsgContent
   | CR.ChatRunning
   | CR.ChatStarted
   | CR.ChatStopped
@@ -36,6 +37,7 @@ export type ChatResponse =
   | CR.GroupMembers
   | CR.GroupUpdated
   | CR.GroupsList
+  | CR.GroupDomainVerified
   | CR.Invitation
   | CR.LeftMemberUser
   | CR.MemberAccepted
@@ -69,6 +71,7 @@ export namespace CR {
     | "chatItemReaction"
     | "chatItemUpdated"
     | "chatItemsDeleted"
+    | "chatMsgContent"
     | "chatRunning"
     | "chatStarted"
     | "chatStopped"
@@ -95,6 +98,7 @@ export namespace CR {
     | "groupMembers"
     | "groupUpdated"
     | "groupsList"
+    | "groupDomainVerified"
     | "invitation"
     | "leftMemberUser"
     | "memberAccepted"
@@ -162,6 +166,12 @@ export namespace CR {
     timed: boolean
   }
 
+  export interface ChatMsgContent extends Interface {
+    type: "chatMsgContent"
+    user: T.User
+    msgContent: T.MsgContent
+  }
+
   export interface ChatRunning extends Interface {
     type: "chatRunning"
   }
@@ -326,6 +336,13 @@ export namespace CR {
     groups: T.GroupInfo[]
   }
 
+  export interface GroupDomainVerified extends Interface {
+    type: "groupDomainVerified"
+    user: T.User
+    groupInfo: T.GroupInfo
+    verificationFailure?: string
+  }
+
   export interface Invitation extends Interface {
     type: "invitation"
     user: T.User

packages/simplex-chat-client/types/typescript/src/types.ts

@@ -1680,6 +1680,7 @@ export namespace ChatListQuery {
 export enum ChatPeerType {
   Human = "human",
   Bot = "bot",
+  Business = "business",
 }
 // Used in API commands. Chat scope can only be passed with groups.
 

packages/simplex-chat-python/src/simplex_chat/types/_commands.py

@@ -149,6 +149,31 @@ def APIChatItemReaction_cmd_string(self: APIChatItemReaction) -> str:
 APIChatItemReaction_Response = CR.ChatItemReaction | CR.ChatCmdError
 
 
+# Share user address card
+# Network usage: no.
+class APIShareMyAddress(TypedDict):
+    toSendRef: "T.ChatRef"
+
+
+def APIShareMyAddress_cmd_string(self: APIShareMyAddress) -> str:
+    return '/_share address' + T.ChatRef_cmd_string(self['toSendRef'])
+
+APIShareMyAddress_Response = CR.ChatMsgContent
+
+
+# Share channel address
+# Network usage: no.
+class APIShareChatMsgContent(TypedDict):
+    shareChatRef: "T.ChatRef"
+    toSendRef: "T.ChatRef"
+
+
+def APIShareChatMsgContent_cmd_string(self: APIShareChatMsgContent) -> str:
+    return '/_share chat content ' + T.ChatRef_cmd_string(self['shareChatRef']) + ' ' + T.ChatRef_cmd_string(self['toSendRef'])
+
+APIShareChatMsgContent_Response = CR.ChatMsgContent
+
+
 # File commands
 # Commands to receive and to cancel files. Files are sent as part of the message, there are no separate commands to send files.
 
@@ -368,6 +393,18 @@ def APIUpdateGroupProfile_cmd_string(self: APIUpdateGroupProfile) -> str:
 APIUpdateGroupProfile_Response = CR.GroupUpdated | CR.ChatCmdError
 
 
+# Verify group domain
+# Network usage: interactive.
+class APIVerifyGroupDomain(TypedDict):
+    groupId: int  # int64
+
+
+def APIVerifyGroupDomain_cmd_string(self: APIVerifyGroupDomain) -> str:
+    return '/_verify domain #' + str(self['groupId'])
+
+APIVerifyGroupDomain_Response = CR.GroupDomainVerified
+
+
 # Group link commands
 # These commands can be used by bots that manage multiple public groups
 

packages/simplex-chat-python/src/simplex_chat/types/_responses.py

@@ -36,6 +36,11 @@ class ChatItemsDeleted(TypedDict):
     byUser: bool
     timed: bool
 
+class ChatMsgContent(TypedDict):
+    type: Literal["chatMsgContent"]
+    user: "T.User"
+    msgContent: "T.MsgContent"
+
 class ChatRunning(TypedDict):
     type: Literal["chatRunning"]
 
@@ -174,6 +179,12 @@ class GroupsList(TypedDict):
     user: "T.User"
     groups: list["T.GroupInfo"]
 
+class GroupDomainVerified(TypedDict):
+    type: Literal["groupDomainVerified"]
+    user: "T.User"
+    groupInfo: "T.GroupInfo"
+    verificationFailure: NotRequired[str]
+
 class Invitation(TypedDict):
     type: Literal["invitation"]
     user: "T.User"
@@ -319,6 +330,7 @@ ChatResponse = (
     | ChatItemReaction
     | ChatItemUpdated
     | ChatItemsDeleted
+    | ChatMsgContent
     | ChatRunning
     | ChatStarted
     | ChatStopped
@@ -345,6 +357,7 @@ ChatResponse = (
     | GroupMembers
     | GroupUpdated
     | GroupsList
+    | GroupDomainVerified
     | Invitation
     | LeftMemberUser
     | MemberAccepted
@@ -371,4 +384,4 @@ ChatResponse = (
     | ApiChats
 )
 
-ChatResponse_Tag = Literal["acceptingContactRequest", "activeUser", "chatItemNotChanged", "chatItemReaction", "chatItemUpdated", "chatItemsDeleted", "chatRunning", "chatStarted", "chatStopped", "cmdOk", "chatCmdError", "connectionPlan", "contactAlreadyExists", "contactConnectionDeleted", "contactDeleted", "contactPrefsUpdated", "contactRequestRejected", "contactsList", "groupDeletedUser", "groupLink", "groupLinkCreated", "groupLinkDeleted", "groupCreated", "publicGroupCreated", "publicGroupCreationFailed", "groupRelays", "groupRelaysAdded", "groupRelaysAddFailed", "relayGroupAllowed", "groupMembers", "groupUpdated", "groupsList", "invitation", "leftMemberUser", "memberAccepted", "membersBlockedForAllUser", "membersRoleUser", "newChatItems", "rcvFileAccepted", "rcvFileAcceptedSndCancelled", "rcvFileCancelled", "sentConfirmation", "sentGroupInvitation", "sentInvitation", "serviceReplyAccepted", "sndFileCancelled", "userAcceptedGroupSent", "userContactLink", "userContactLinkCreated", "userContactLinkDeleted", "userContactLinkUpdated", "userDeletedMembers", "userProfileUpdated", "userProfileNoChange", "usersList", "apiChats"]
+ChatResponse_Tag = Literal["acceptingContactRequest", "activeUser", "chatItemNotChanged", "chatItemReaction", "chatItemUpdated", "chatItemsDeleted", "chatMsgContent", "chatRunning", "chatStarted", "chatStopped", "cmdOk", "chatCmdError", "connectionPlan", "contactAlreadyExists", "contactConnectionDeleted", "contactDeleted", "contactPrefsUpdated", "contactRequestRejected", "contactsList", "groupDeletedUser", "groupLink", "groupLinkCreated", "groupLinkDeleted", "groupCreated", "publicGroupCreated", "publicGroupCreationFailed", "groupRelays", "groupRelaysAdded", "groupRelaysAddFailed", "relayGroupAllowed", "groupMembers", "groupUpdated", "groupsList", "groupDomainVerified", "invitation", "leftMemberUser", "memberAccepted", "membersBlockedForAllUser", "membersRoleUser", "newChatItems", "rcvFileAccepted", "rcvFileAcceptedSndCancelled", "rcvFileCancelled", "sentConfirmation", "sentGroupInvitation", "sentInvitation", "serviceReplyAccepted", "sndFileCancelled", "userAcceptedGroupSent", "userContactLink", "userContactLinkCreated", "userContactLinkDeleted", "userContactLinkUpdated", "userDeletedMembers", "userProfileUpdated", "userProfileNoChange", "usersList", "apiChats"]

packages/simplex-chat-python/src/simplex_chat/types/_types.py

@@ -1175,7 +1175,7 @@ ChatListQuery = ChatListQuery_filters | ChatListQuery_search
 
 ChatListQuery_Tag = Literal["filters", "search"]
 
-ChatPeerType = Literal["human", "bot"]
+ChatPeerType = Literal["human", "bot", "business"]
 
 # Used in API commands. Chat scope can only be passed with groups.
 

src/Simplex/Chat/Library/Internal.hs

@@ -1538,7 +1538,7 @@ updateKnownContactFromLink :: User -> Contact -> CM (Contact, Bool)
 updateKnownContactFromLink user ct@Contact {profile = LocalProfile {contactLink}} =
   case contactLink of
     Just (CLShort sl) -> do
-      (_, cData) <- getShortLinkConnReq' NRMBackground user sl
+      (_, cData, _) <- getShortLinkConnReq' NRMBackground user sl
       liftIO (decodeLinkUserData cData) >>= \case
         Just csld -> do
           ContactShortLinkData {profile = linkProfile} <- linkDataBadge csld

tests/Bots/DirectoryTests.hs

@@ -19,9 +19,7 @@ import Directory.Captcha
 import Directory.Listing
 import Directory.Options
 import Directory.Service
-import Directory.Store
 import System.Directory (emptyPermissions, setOwnerExecutable, setOwnerReadable, setOwnerWritable, setPermissions)
-import System.IO (hClose)
 import Simplex.Chat.Bot.KnownContacts
 import Simplex.Chat.Controller (ChatConfig (..))
 import qualified Simplex.Chat.Markdown as MD
@@ -137,8 +135,6 @@ mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup webFolder =
       profileNameLimit = maxBound,
       captchaGenerator = Nothing,
       voiceCaptchaGenerator = Nothing,
-      directoryLog = Just $ ps </> "directory_service.log",
-      migrateDirectoryLog = Nothing,
       serviceName = "SimpleX Directory",
       clientService = True,
       runCLI = False,
@@ -1802,11 +1798,10 @@ withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup webFolder test = do
       test superUser dsLink
 
 runDirectory :: ChatConfig -> DirectoryOpts -> IO () -> IO ()
-runDirectory cfg opts@DirectoryOpts {directoryLog} action = do
-  st <- openDirectoryLog directoryLog
-  t <- forkIO $ directoryService st opts cfg
+runDirectory cfg opts action = do
+  t <- forkIO $ directoryService opts cfg
   threadDelay 500000
-  action `finally` (mapM_ hClose (directoryLogFile st) >> killThread t)
+  action `finally` killThread t
 
 registerGroup :: TestCC -> TestCC -> String -> String -> IO ()
 registerGroup su u n fn = registerGroupId su u n fn 1 1