operators: debug decoding

src/Simplex/Chat.hs

@@ -1584,6 +1584,32 @@ processChatCommand' vr = \case
     lift $ CRServerTestResult user srv <$> withAgent' (\a -> testProtocolServer a (aUserId user) server)
   TestProtoServer srv -> withUser $ \User {userId} ->
     processChatCommand $ APITestProtoServer userId srv
+  APITestServerOperator -> do
+    let serverOperator = ServerOperator {
+      operatorId = DBEntityId 1,
+      operatorTag = Just OTSimplex,
+      tradeName = "Simplex",
+      legalName = Just "Simplex",
+      serverDomains = ["simplex.im"],
+      conditionsAcceptance = CAAccepted Nothing,
+      enabled = True,
+      roles = ServerRoles {storage = True, proxy = True}
+    }
+    pure $ CRTestOperator serverOperator
+  APITestUsageConditionsAction -> do
+    ts <- liftIO getCurrentTime
+    let conditionsAction = Just $ UCAReview {
+      operators = [],
+      deadline = Just ts,
+      showNotice = True
+    }
+    pure $ CRTestUsageConditionsAction conditionsAction
+  APITestConditionsAcceptance -> do
+    let acceptance = CAAccepted Nothing
+    pure $ CRTestConditionsAcceptance acceptance
+  APITestServerRoles -> do
+    let serverRoles = ServerRoles {storage = True, proxy = True}
+    pure $ CRTestServerRoles serverRoles
   APIGetServerOperators -> uncurry CRServerOperators <$> withFastStore getServerOperators
   APISetServerOperators operatorsEnabled -> withFastStore $ \db -> do
     liftIO $ setServerOperators db operatorsEnabled
@@ -8204,6 +8230,10 @@ chatCommandP =
       "/smp test " *> (TestProtoServer . AProtoServerWithAuth SPSMP <$> strP),
       "/xftp test " *> (TestProtoServer . AProtoServerWithAuth SPXFTP <$> strP),
       "/ntf test " *> (TestProtoServer . AProtoServerWithAuth SPNTF <$> strP),
+      "/_dec_operator" $> APITestServerOperator,
+      "/_dec_conditions_action" $> APITestUsageConditionsAction,
+      "/_dec_acceptance" $> APITestConditionsAcceptance,
+      "/_dec_roles" $> APITestServerRoles,
       "/smp " *> (SetUserProtoServers (AProtocolType SPSMP) . map (AProtoServerWithAuth SPSMP) <$> protocolServersP),
       "/smp default" $> SetUserProtoServers (AProtocolType SPSMP) [],
       "/xftp " *> (SetUserProtoServers (AProtocolType SPXFTP) . map (AProtoServerWithAuth SPXFTP) <$> protocolServersP),

src/Simplex/Chat/Controller.hs

@@ -70,7 +70,7 @@ import Simplex.Chat.Util (liftIOEither)
 import Simplex.FileTransfer.Description (FileDescriptionURI)
 import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
 import Simplex.Messaging.Agent.Client (AgentLocks, AgentQueuesInfo (..), AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, SMPServerSubs, ServerQueueInfo, UserNetworkInfo)
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig, ServerRoles)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration, withTransaction, withTransactionPriority)
@@ -353,6 +353,10 @@ data ChatCommand
   | SetUserProtoServers AProtocolType [AProtoServerWithAuth]
   | APITestProtoServer UserId AProtoServerWithAuth
   | TestProtoServer AProtoServerWithAuth
+  | APITestServerOperator
+  | APITestUsageConditionsAction
+  | APITestConditionsAcceptance
+  | APITestServerRoles
   | APIGetServerOperators
   | APISetServerOperators (NonEmpty ServerOperator)
   | APIGetUserServers UserId
@@ -587,6 +591,10 @@ data ChatResponse
   | CRChatItemId User (Maybe ChatItemId)
   | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
   | CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure}
+  | CRTestOperator {operator :: ServerOperator}
+  | CRTestUsageConditionsAction {conditionsAction :: Maybe UsageConditionsAction}
+  | CRTestConditionsAcceptance {acceptance :: ConditionsAcceptance}
+  | CRTestServerRoles {roles :: ServerRoles}
   | CRServerOperators {operators :: [ServerOperator], conditionsAction :: Maybe UsageConditionsAction}
   | CRUserServers {user :: User, userServers :: [UserOperatorServers]}
   | CRUserServersValidation {serverErrors :: [UserServersError]}

src/Simplex/Chat/View.hs

@@ -97,6 +97,10 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRApiParsedMarkdown ft -> [viewJSON ft]
   -- CRUserProtoServers u userServers operators  -> ttyUser u $ viewUserServers userServers operators testView
   CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
+  CRTestOperator _ -> []
+  CRTestUsageConditionsAction _ -> []
+  CRTestConditionsAcceptance _ -> []
+  CRTestServerRoles _ -> []
   CRServerOperators {} -> []
   CRUserServers {} -> []
   CRUserServersValidation _ -> []