store: clearer usage for /issue and /bulk

apps/simplex-store-service/README.md

@@ -1253,11 +1253,13 @@ console, is in [Refunding a name balance](#refunding-a-name-balance).
 ### From the group
 
 With `[group]` in `store_service.ini`, the service manages one group and serves three commands in
-it: `/issue <type> [months <M>] [uses <N>]` and `/bulk <type> [months <M>] count <B>` for moderators
-and above, `/revoke <code>` for admins and owners. `months` is 1 to 255, `uses` 1 to 1000 and
-`count` 1 to 100; a value outside these gets the usage reply. The name forms are
-`/issue name <length> [years <Y>]` and `/bulk name <length> [years <Y>] count <B>`, with the
-bounds of `//issue name`; a name code issued in the group is single-use and `free`. `/revoke`
+it: `/issue` and `/bulk` for moderators and above, `/revoke <code>` for admins and owners. The name
+forms are `/issue name <length> [years <Y>]` and `/bulk name <length> [years <Y>] count <N>`, with
+the bounds of `//issue name`; a name code issued in the group is single-use and `free`. The badge
+forms are `/issue <badge> [months <M>] [uses <N>]` and `/bulk <badge> [months <M>] count <N>`, where
+`<badge>` is `supporter`, `legend` or `investor`. `months` is 1 to 255, `uses` 1 to 1000 and `count`
+1 to 100; a value outside these gets the usage reply, which lists both forms with an example. The
+group's command menu fills in the name form. `/revoke`
 takes badge codes only: withdraw a name code with `//revoke` in `--run-cli` mode. 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

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

@@ -23,6 +23,8 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isSpace)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -70,7 +72,14 @@ cmdActionP = A.choice (map cmdP [minBound .. maxBound])
     fullArgsP tag = A.char ' ' *> cmdArgsP tag <* A.endOfInput
     -- Without the space check "/issued" would get a usage reply.
     usageEndP = void A.space <|> A.endOfInput
-    usage tag = "Usage: /" <> cmdName tag <> " " <> cmdParams tag
+    usage tag = case cmdForms tag of
+      form :| [] -> "Usage: " <> formLine tag form
+      forms -> T.intercalate "\n" ("Usage:" : map (formLine tag) (L.toList forms))
+
+formLine :: CmdTag -> (Text, Maybe Text) -> Text
+formLine tag (args, example) = cmd args <> maybe "" (("  e.g. " <>) . cmd) example
+  where
+    cmd ps = "/" <> cmdName tag <> " " <> ps
 
 cmdArgsP :: CmdTag -> A.Parser GroupCmd
 cmdArgsP = \case
@@ -102,7 +111,7 @@ nameLengthP =
 groupCommands :: [ChatBotCommand]
 groupCommands = map command [minBound .. maxBound]
   where
-    command tag = CBCCommand (cmdName tag) (cmdLabel tag) (Just (cmdParams tag))
+    command tag = CBCCommand (cmdName tag) (cmdLabel tag) (Just (fst (L.head (cmdForms tag))))
 
 codeP :: A.Parser BadgeCode
 codeP = A.takeWhile1 (not . isSpace) >>= maybe (fail "not a badge code") pure . parseBadgeCode . safeDecodeUtf8
@@ -139,16 +148,20 @@ cmdName = \case
 
 cmdLabel :: CmdTag -> Text
 cmdLabel = \case
-  CTIssue -> "Generate a badge or name code"
+  CTIssue -> "Generate a name or badge code"
   CTBulk -> "Generate many single-use codes"
   CTRevoke -> "Revoke a code"
 
--- | The parameters are quoted in the usage reply and advertised to the group, so the two cannot drift apart.
-cmdParams :: CmdTag -> Text
-cmdParams = \case
-  CTIssue -> "<type> [months <M>] [uses <N>], or name <length> [years <Y>]"
-  CTBulk -> "<type> [months <M>] count <B>, or name <length> [years <Y>] count <B>"
-  CTRevoke -> "<code>"
+-- | The usage reply quotes every form and the advertised menu inserts the first one, so the two cannot drift apart.
+cmdForms :: CmdTag -> NonEmpty (Text, Maybe Text)
+cmdForms = \case
+  CTIssue ->
+    ("name <length> [years <Y>]", Just "name 6 years 5")
+      :| [("<badge> [months <M>] [uses <N>]", Just "supporter months 12")]
+  CTBulk ->
+    ("name <length> [years <Y>] count <N>", Just "name 6 count 100")
+      :| [("<badge> [months <M>] count <N>", Just "supporter months 12 count 10")]
+  CTRevoke -> ("<code>", Nothing) :| []
 
 cmdMinRole :: CmdTag -> GroupMemberRole
 cmdMinRole = \case

tests/Bots/StoreService/GroupIntegrationTests.hs

@@ -306,7 +306,7 @@ testGroupNameCodes ps = do
     bulk <- mapM (prepaidIn . Just) . T.lines =<< replyTo cc alice "/bulk name 6 count 3"
     length bulk `shouldBe` 3
     forM_ bulk $ \code -> (namePrepaidCodeLength code,) <$> prepaidTerms cc code `shouldReturn` (6, Just (6, 2, CPSFree))
-    replyTo cc alice "/issue name 8 years 1" `shouldReturn` "Usage: /issue <type> [months <M>] [uses <N>], or name <length> [years <Y>]"
+    replyTo cc alice "/issue name 8 years 1" `shouldReturn` issueUsage
     countRows cc "sx_badge_service_name_prepaid_codes" `shouldReturn` 4
 
 testOperatorNameCodes :: HasCallStack => TestParams -> IO ()
@@ -924,7 +924,7 @@ testRoleGatedIssue ps = do
         let announced name = "#" <> groupName <> ": " <> botName <> " added " <> name
             preMember name = "#" <> groupName <> ": member " <> name
             newMember name = "#" <> groupName <> ": new member " <> name <> " is connected"
-            usageReply = "#" <> groupName <> " " <> botName <> "> Usage: /issue <type>"
+            usageReply = "#" <> groupName <> " " <> botName <> "> Usage:"
         joinGroup cc bob
         waitMemberRole cc gid "bob" "member"
         -- cath joins only after alice sees bob announced, or cath's console shows a different line.
@@ -945,7 +945,7 @@ testRoleGatedIssue ps = do
         waitStoredItem cc "/issue legend"
         ownerIssuesNext cc alice 2
         sendGroupCmd alice "/issue supporter uses 0"
-        waitStoredItem cc "Usage: /issue <type> [months <M>] [uses <N>], or name <length> [years <Y>]"
+        waitStoredItem cc issueUsage
         codeCount cc `shouldReturn` 2
         drainUntil alice [usageReply, newMember "bob", newMember "cath"]
         drainUntil bob [usageReply, preMember "alice", newMember "cath"]
@@ -1572,11 +1572,14 @@ singleRow sql = \case
   [r] -> Just r
   _ -> error $ "more than one row from: " <> sql
 
+issueUsage :: Text
+issueUsage = "Usage:\n/issue name <length> [years <Y>]  e.g. /issue name 6 years 5\n/issue <badge> [months <M>] [uses <N>]  e.g. /issue supporter months 12"
+
 -- The list is spelled out rather than taken from the service, so a change there fails here.
 expectedCommands :: [ChatBotCommand]
 expectedCommands =
-  [ CBCCommand "issue" "Generate a badge or name code" (Just "<type> [months <M>] [uses <N>], or name <length> [years <Y>]"),
-    CBCCommand "bulk" "Generate many single-use codes" (Just "<type> [months <M>] count <B>, or name <length> [years <Y>] count <B>"),
+  [ CBCCommand "issue" "Generate a name or badge code" (Just "name <length> [years <Y>]"),
+    CBCCommand "bulk" "Generate many single-use codes" (Just "name <length> [years <Y>] count <N>"),
     CBCCommand "revoke" "Revoke a code" (Just "<code>")
   ]
 

tests/Bots/StoreService/GroupTests.hs

@@ -22,8 +22,8 @@ import Test.Hspec
 badgeGroupTests :: Spec
 badgeGroupTests = describe "badge group" $ do
   let p = groupCmdAction GROwner
-      issueUsage = ReplyText "Usage: /issue <type> [months <M>] [uses <N>], or name <length> [years <Y>]"
-      bulkUsage = ReplyText "Usage: /bulk <type> [months <M>] count <B>, or name <length> [years <Y>] count <B>"
+      issueUsage = ReplyText "Usage:\n/issue name <length> [years <Y>]  e.g. /issue name 6 years 5\n/issue <badge> [months <M>] [uses <N>]  e.g. /issue supporter months 12"
+      bulkUsage = ReplyText "Usage:\n/bulk name <length> [years <Y>] count <N>  e.g. /bulk name 6 count 100\n/bulk <badge> [months <M>] count <N>  e.g. /bulk supporter months 12 count 10"
       revokeUsage = ReplyText "Usage: /revoke <code>"
   it "issue defaults" $ p "/issue supporter" `shouldBe` RunCmd (GCIssue BTSupporter 1 1)
   it "issue with months and uses" $ p "/issue legend months 6 uses 50" `shouldBe` RunCmd (GCIssue BTLegend 6 50)

tests/Bots/StoreService/NamesCodesTests.hs

@@ -364,8 +364,8 @@ testGroupNameCommands = do
 testGroupNameCommandsRefused :: IO ()
 testGroupNameCommandsRefused = do
   let p = groupCmdAction GRModerator
-      issueUsage = ReplyText "Usage: /issue <type> [months <M>] [uses <N>], or name <length> [years <Y>]"
-      bulkUsage = ReplyText "Usage: /bulk <type> [months <M>] count <B>, or name <length> [years <Y>] count <B>"
+      issueUsage = ReplyText "Usage:\n/issue name <length> [years <Y>]  e.g. /issue name 6 years 5\n/issue <badge> [months <M>] [uses <N>]  e.g. /issue supporter months 12"
+      bulkUsage = ReplyText "Usage:\n/bulk name <length> [years <Y>] count <N>  e.g. /bulk name 6 count 100\n/bulk <badge> [months <M>] count <N>  e.g. /bulk supporter months 12 count 10"
   forM_ ["name", "name 5", "name 64", "name 06", "name 8 years 1", "name 8 years 0", "name 8 years 11", "name 8 uses 2", "name 8 months 2", "name 8 paid", "name 8 years 18446744073709551618"] $ \args ->
     (args, p ("/issue " <> args)) `shouldBe` (args, issueUsage)
   forM_ ["name 8", "name 8 count 0", "name 8 count 101", "name 8 years 1 count 2", "name 5 count 2", "name 08 count 2"] $ \args ->