store: refuse group name codes while names are off

apps/simplex-store-service/README.md

@@ -1268,7 +1268,9 @@ group is single-use and `free`. A badge takes `months`, 1 to 255 and 1 by defaul
 also `uses`, 1 to 1000. `count` is 1 to 100. A value outside these bounds, a length for a badge, or
 the other kind's unit gets the usage reply, which lists the form, each kind's bounds and an example
 of each. The group's command menu shows every kind in each command's hint and fills the hint into
-the message box. `/revoke` takes badge and name codes. The group has no `/refund`. A member's role
+the message box. Without `[names]`, `/issue name` and `/bulk name` get a reply that names are not
+enabled, and issue nothing. `/revoke` takes badge and name codes, so a name code issued before names
+were turned off can still be withdrawn. The group has no `/refund`. A member's role
 is checked as the service last saw it, so a command sent by a moderator just demoted or removed can still run if it
 reaches the service first; revoke any code the service posts for them after the change. `uses`
 above 1 makes a multi-use code, tracked by a group message showing its remaining uses and the time

apps/simplex-store-service/src/StoreService/Group.hs

@@ -198,8 +198,8 @@ coalesceTrackerRefreshes = snd . foldr keepLast (S.empty, [])
 logUncaught :: HasCallStack => IO () -> IO ()
 logUncaught a = a `catchOwn'` withFrozenCallStack (logError . tshow)
 
-handleGroupEvent :: ChatController -> Turns -> GroupId -> GroupEvent -> IO ()
-handleGroupEvent cc turns groupId ev = logUncaught (handle ev)
+handleGroupEvent :: ChatController -> Turns -> Bool -> GroupId -> GroupEvent -> IO ()
+handleGroupEvent cc turns namesOn groupId ev = logUncaught (handle ev)
   where
     handle = \case
       GEInGroup gid action
@@ -207,7 +207,7 @@ handleGroupEvent cc turns groupId ev = logUncaught (handle ev)
         | otherwise -> case action of
             GAJoined -> promoteOwner cc groupId
             GACommand role t -> case groupCmdAction role t of
-              RunCmd cmd -> runGroupCmd cc turns groupId cmd
+              RunCmd cmd -> runGroupCmd cc turns namesOn groupId cmd
               ReplyText txt -> void $ sendGroupText cc groupId "command reply" txt
               IgnoreMsg -> pure ()
       GETracker badgeCodeId code -> updateTracker cc groupId badgeCodeId code
@@ -224,15 +224,15 @@ promoteFirstOwner cc g@GroupInfo {groupId} member =
     _ -> pure ()
 
 -- Nothing is a group that is not served, so its events are drained.
-runGroupLane :: ChatController -> Turns -> TQueue GroupEvent -> Maybe GroupId -> IO ()
-runGroupLane cc turns q groupId_ = case groupId_ of
+runGroupLane :: ChatController -> Turns -> Bool -> TQueue GroupEvent -> Maybe GroupId -> IO ()
+runGroupLane cc turns namesOn q groupId_ = case groupId_ of
   Just groupId -> do
     promoteOwner cc groupId
     -- Reconciling precedes the first batch, so queued events write after the correction.
     reconcileTrackers cc groupId
     forever $ do
       evs <- atomically $ (:) <$> readTQueue q <*> flushTQueue q
-      mapM_ (handleGroupEvent cc turns groupId) (coalesceTrackerRefreshes evs)
+      mapM_ (handleGroupEvent cc turns namesOn groupId) (coalesceTrackerRefreshes evs)
   Nothing -> forever $ void $ atomically (readTQueue q)
 
 -- The earliest joined member is promoted, not the one who just joined, so a join the lane never handled
@@ -259,8 +259,8 @@ promoteOwner cc groupId =
 noOwnerHint :: GroupName -> Text
 noOwnerHint gName = "the badge group has no member owner, make one with /mr #" <> viewName gName <> " <member> owner in --run-cli mode"
 
-runGroupCmd :: ChatController -> Turns -> GroupId -> GroupCmd -> IO ()
-runGroupCmd cc turns groupId = \case
+runGroupCmd :: ChatController -> Turns -> Bool -> GroupId -> GroupCmd -> IO ()
+runGroupCmd cc turns namesOn groupId = \case
   GCIssue bt months uses ->
     issueOneCode cc bt months CPSFree uses >>= \case
       Left _ -> reply issueFailedText
@@ -271,6 +271,8 @@ runGroupCmd cc turns groupId = \case
             sendGroupText cc groupId ("tracker, code " <> tshow badgeCodeId <> " is lost") (initialTrackerBody code uses)
               >>= mapM_ (\iid -> withDB' "setCodeGroupItem" cc $ \db -> setCodeGroupItem db badgeCodeId iid now)
   GCBulk bt months count -> issueMany count (fmap (formatBadgeCode . fst) <$> issueOneCode cc bt months CPSFree singleUse)
+  GCIssueName {} | not namesOn -> reply namesOffText
+  GCBulkName {} | not namesOn -> reply namesOffText
   GCIssueName len years ->
     issueNameCode cc len years CPSFree >>= reply . either (const issueFailedText) (("Code: " <>) . formatNameCode . NCPrepaid)
   GCBulkName len years count -> issueMany count (fmap (formatNameCode . NCPrepaid) <$> issueNameCode cc len years CPSFree)
@@ -289,6 +291,9 @@ runGroupCmd cc turns groupId = \case
         [] -> issued
         _ : _ -> issued <> ["Issued " <> tshow (length issued) <> " of " <> tshow count <> " codes. The remaining codes could not be issued."]
 
+namesOffText :: Text
+namesOffText = "Names are not enabled on this service, so name codes cannot be issued."
+
 -- The label says what is lost when the send fails, since the log line is its only trace.
 sendGroupText :: HasCallStack => ChatController -> GroupId -> Text -> Text -> IO (Maybe ChatItemId)
 sendGroupText cc groupId label txt =

apps/simplex-store-service/src/StoreService/Service.hs

@@ -256,6 +256,7 @@ storeService opts@StoreServiceOpts {serviceConfigFile} baseCfg env = do
   requestEnv <- configureStoreVerifier serviceCfg env
   let groupCfg = serviceCfg >>= \ServiceConfig {group} -> group
       trackerQ_ = groupEventQ env <$ groupCfg
+      namesOn = isJust (serviceCfg >>= names)
       readEvents cc =
         forever $
           atomically (readTBQueue $ outputQ cc) >>= \case
@@ -267,7 +268,7 @@ storeService opts@StoreServiceOpts {serviceConfigFile} baseCfg env = do
       startLanes cc = do
         lanes <- maybe (pure []) (serviceLanes waiters turns cc) serviceCfg
         -- The group is resolved before the other lanes start, so a failed lookup exits at once rather than waiting for them to end.
-        groupLane_ <- forM groupCfg $ \gc -> runGroupLane cc turns (groupEventQ env) <$> ensureManagedGroup cc gc
+        groupLane_ <- forM groupCfg $ \gc -> runGroupLane cc turns namesOn (groupEventQ env) <$> ensureManagedGroup cc gc
         raceAny_ $ processQueuedRequests key trackerQ_ requestEnv : maybeToList groupLane_ <> lanes
       chatHooks =
         defaultChatHooks

tests/Bots/StoreService/GroupIntegrationTests.hs

@@ -132,6 +132,7 @@ badgeGroupIntegrationTests = do
   it "publishes nothing when a code whose tracker was deleted is used up" testDeletedTrackerUsedUp
   it "revokes a code whose tracker an owner deleted for everyone without reposting it" testModeratedTrackerNotRepostedOnRevoke
   it "revokes a code on /revoke, answers a repeat as already revoked and an unknown code as no such code" testGroupRevoke
+  it "refuses /issue name and /bulk name while names are off, still revoking name codes" testGroupNameCodesNamesOff
   it "retires the tracker message when a multi-use code is revoked" testRevokeRetiresTracker
   it "retires the tracker message when the service command revokes the code" testServiceRevokeRetiresTracker
   it "retires a tracker left behind when the code is revoked again" testGroupRevokeRepairsTracker
@@ -1294,6 +1295,17 @@ testGroupRevoke ps =
     unissued <- formatBadgeCode <$> randomBadgeCode (random cc)
     revokeInGroup cc alice unissued "No such code."
 
+testGroupNameCodesNamesOff :: HasCallStack => TestParams -> IO ()
+testGroupNameCodesNamesOff ps =
+  withGroupOwner ps $ \_ cc _ alice -> do
+    replyTo cc alice "/issue name 8" `shouldReturn` namesOffReply
+    replyTo cc alice "/bulk name 6 count 2" `shouldReturn` namesOffReply
+    countRows cc "sx_badge_service_name_prepaid_codes" `shouldReturn` 0
+    unissued <- formatNameCode . NCPrepaid <$> randomNamePrepaidCode (random cc) 8
+    revokeInGroup cc alice unissued "No such code."
+  where
+    namesOffReply = "Names are not enabled on this service, so name codes cannot be issued."
+
 testGroupRevokeRepairsTracker :: HasCallStack => TestParams -> IO ()
 testGroupRevokeRepairsTracker ps =
   withGroupOwner ps $ \_ cc _ alice -> do