core: fix operator conditions query (#5420)

* logs

* logs2

* logs3

* logs4

* logs5

* fix

* update schema

* migration

* fix migration

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

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;
+|]

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,

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)
 

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

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 =

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