diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 29e748c4e8..a345fe5716 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -155,6 +155,7 @@ library Simplex.Chat.Migrations.M20241125_indexes Simplex.Chat.Migrations.M20241128_business_chats Simplex.Chat.Migrations.M20241205_business_chat_members + Simplex.Chat.Migrations.M20241222_operator_conditions Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat/Migrations/M20241222_operator_conditions.hs b/src/Simplex/Chat/Migrations/M20241222_operator_conditions.hs new file mode 100644 index 0000000000..c0c4304313 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20241222_operator_conditions.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20241222_operator_conditions where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20241222_operator_conditions :: Query +m20241222_operator_conditions = + [sql| +ALTER TABLE operator_usage_conditions ADD COLUMN auto_accepted INTEGER DEFAULT 0; +|] + +down_m20241222_operator_conditions :: Query +down_m20241222_operator_conditions = + [sql| +ALTER TABLE operator_usage_conditions DROP COLUMN auto_accepted; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 94ccc65b7f..0a6a581cbe 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -622,6 +622,8 @@ CREATE TABLE operator_usage_conditions( conditions_commit TEXT NOT NULL, accepted_at TEXT, created_at TEXT NOT NULL DEFAULT(datetime('now')) + , + auto_accepted INTEGER DEFAULT 0 ); CREATE INDEX contact_profiles_index ON contact_profiles( display_name, diff --git a/src/Simplex/Chat/Operators.hs b/src/Simplex/Chat/Operators.hs index e14e95211a..9eda85aaf3 100644 --- a/src/Simplex/Chat/Operators.hs +++ b/src/Simplex/Chat/Operators.hs @@ -167,7 +167,7 @@ conditionsRequiredOrDeadline createdAt notifiedAtOrNow = conditionsDeadline = addUTCTime (31 * nominalDay) data ConditionsAcceptance - = CAAccepted {acceptedAt :: Maybe UTCTime} + = CAAccepted {acceptedAt :: Maybe UTCTime, autoAccepted :: Bool} | CARequired {deadline :: Maybe UTCTime} deriving (Show) diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 65fe8223fe..7d4d96dff2 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -119,6 +119,7 @@ import Simplex.Chat.Migrations.M20241027_server_operators import Simplex.Chat.Migrations.M20241125_indexes import Simplex.Chat.Migrations.M20241128_business_chats import Simplex.Chat.Migrations.M20241205_business_chat_members +import Simplex.Chat.Migrations.M20241222_operator_conditions import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -237,7 +238,8 @@ schemaMigrations = ("20241027_server_operators", m20241027_server_operators, Just down_m20241027_server_operators), ("20241125_indexes", m20241125_indexes, Just down_m20241125_indexes), ("20241128_business_chats", m20241128_business_chats, Just down_m20241128_business_chats), - ("20241205_business_chat_members", m20241205_business_chat_members, Just down_m20241205_business_chat_members) + ("20241205_business_chat_members", m20241205_business_chat_members, Just down_m20241205_business_chat_members), + ("20241222_operator_conditions", m20241222_operator_conditions, Just down_m20241222_operator_conditions) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index e88cf39feb..013075841e 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -627,13 +627,13 @@ getUpdateServerOperators db presetOps newUser = do DBNewEntity -> do op' <- insertOperator op case (operatorTag op', acceptForSimplex_) of - (Just OTSimplex, Just cond) -> autoAcceptConditions op' cond + (Just OTSimplex, Just cond) -> autoAcceptConditions op' cond now _ -> pure op' DBEntityId _ -> do updateOperator op getOperatorConditions_ db op currentConds latestAcceptedConds_ now >>= \case - CARequired Nothing | operatorTag op == Just OTSimplex -> autoAcceptConditions op currentConds - CARequired (Just ts) | ts < now -> autoAcceptConditions op currentConds + CARequired Nothing | operatorTag op == Just OTSimplex -> autoAcceptConditions op currentConds now + CARequired (Just ts) | ts < now -> autoAcceptConditions op currentConds now ca -> pure op {conditionsAcceptance = ca} where insertConditions UsageConditions {conditionsId, conditionsCommit, notifiedAt, createdAt} = @@ -667,9 +667,9 @@ getUpdateServerOperators db presetOps newUser = do (operatorTag, tradeName, legalName, T.intercalate "," serverDomains, enabled, storage smpRoles, proxy smpRoles, storage xftpRoles, proxy xftpRoles) opId <- insertedRowId db pure op {operatorId = DBEntityId opId} - autoAcceptConditions op UsageConditions {conditionsCommit} = - acceptConditions_ db op conditionsCommit Nothing - $> op {conditionsAcceptance = CAAccepted Nothing} + autoAcceptConditions op UsageConditions {conditionsCommit} now = + acceptConditions_ db op conditionsCommit now True + $> op {conditionsAcceptance = CAAccepted (Just now) True} serverOperatorQuery :: Query serverOperatorQuery = @@ -708,7 +708,7 @@ getOperatorConditions_ db ServerOperator {operatorId} UsageConditions {condition DB.query db [sql| - SELECT conditions_commit, accepted_at + SELECT conditions_commit, accepted_at, auto_accepted FROM operator_usage_conditions WHERE server_operator_id = ? ORDER BY operator_usage_conditions_id DESC @@ -716,10 +716,10 @@ getOperatorConditions_ db ServerOperator {operatorId} UsageConditions {condition |] (Only operatorId) pure $ case operatorAcceptedConds_ of - Just (operatorCommit, acceptedAt_) + Just (operatorCommit, acceptedAt_, autoAccept) | operatorCommit /= latestAcceptedCommit -> CARequired Nothing -- TODO should we consider this operator disabled? | currentCommit /= latestAcceptedCommit -> CARequired $ conditionsRequiredOrDeadline createdAt (fromMaybe now notifiedAt) - | otherwise -> CAAccepted acceptedAt_ + | otherwise -> CAAccepted acceptedAt_ autoAccept _ -> CARequired Nothing -- no conditions were accepted for this operator getCurrentUsageConditions :: DB.Connection -> ExceptT StoreError IO UsageConditions @@ -763,24 +763,39 @@ acceptConditions :: DB.Connection -> Int64 -> NonEmpty Int64 -> UTCTime -> Excep acceptConditions db condId opIds acceptedAt = do UsageConditions {conditionsCommit} <- getUsageConditionsById_ db condId operators <- mapM getServerOperator_ opIds - let ts = Just acceptedAt - liftIO $ forM_ operators $ \op -> acceptConditions_ db op conditionsCommit ts + liftIO $ forM_ operators $ \op -> acceptConditions_ db op conditionsCommit acceptedAt False where getServerOperator_ opId = ExceptT $ firstRow toServerOperator (SEOperatorNotFound opId) $ DB.query db (serverOperatorQuery <> " WHERE server_operator_id = ?") (Only opId) -acceptConditions_ :: DB.Connection -> ServerOperator -> Text -> Maybe UTCTime -> IO () -acceptConditions_ db ServerOperator {operatorId, operatorTag} conditionsCommit acceptedAt = - DB.execute - db - [sql| - INSERT INTO operator_usage_conditions - (server_operator_id, server_operator_tag, conditions_commit, accepted_at) - VALUES (?,?,?,?) - |] - (operatorId, operatorTag, conditionsCommit, acceptedAt) +acceptConditions_ :: DB.Connection -> ServerOperator -> Text -> UTCTime -> Bool -> IO () +acceptConditions_ db ServerOperator {operatorId, operatorTag} conditionsCommit acceptedAt autoAccepted = do + acceptedAt_ :: Maybe (Maybe UTCTime) <- maybeFirstRow fromOnly $ DB.query db "SELECT accepted_at FROM operator_usage_conditions WHERE server_operator_id = ? AND conditions_commit == ?" (operatorId, conditionsCommit) + case acceptedAt_ of + Just Nothing -> + DB.execute + db + (q <> "ON CONFLICT (server_operator_id, conditions_commit) DO UPDATE SET accepted_at = ?, auto_accepted = ?") + (operatorId, operatorTag, conditionsCommit, acceptedAt, autoAccepted, acceptedAt, autoAccepted) + Just (Just _) -> + DB.execute + db + (q <> "ON CONFLICT (server_operator_id, conditions_commit) DO NOTHING") + (operatorId, operatorTag, conditionsCommit, acceptedAt, autoAccepted) + Nothing -> + DB.execute + db + q + (operatorId, operatorTag, conditionsCommit, acceptedAt, autoAccepted) + where + q = + [sql| + INSERT INTO operator_usage_conditions + (server_operator_id, server_operator_tag, conditions_commit, accepted_at, auto_accepted) + VALUES (?,?,?,?,?) + |] getUsageConditionsById_ :: DB.Connection -> Int64 -> ExceptT StoreError IO UsageConditions getUsageConditionsById_ db conditionsId = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 8b6a545637..49fd73ecc4 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1311,7 +1311,7 @@ viewOpIdTag ServerOperator {operatorId, operatorTag} = case operatorId of viewOpConditions :: ConditionsAcceptance -> Text viewOpConditions = \case - CAAccepted ts -> viewCond "accepted" ts + CAAccepted ts _ -> viewCond "accepted" ts CARequired ts -> viewCond "required" ts where viewCond w ts = w <> maybe "" (parens . tshow) ts