diff --git a/apps/simplex-store-service/README.md b/apps/simplex-store-service/README.md index 752ddfb5b9..69f36c0f0d 100644 --- a/apps/simplex-store-service/README.md +++ b/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 [months ] [uses ]` and `/bulk [months ] count ` for moderators -and above, `/revoke ` 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 [years ]` and `/bulk name [years ] count `, 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 ` for admins and owners. The name +forms are `/issue name [years ]` and `/bulk name [years ] count `, with +the bounds of `//issue name`; a name code issued in the group is single-use and `free`. The badge +forms are `/issue [months ] [uses ]` and `/bulk [months ] count `, where +`` 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 diff --git a/apps/simplex-store-service/src/StoreService/Group/Command.hs b/apps/simplex-store-service/src/StoreService/Group/Command.hs index f7f9f7a047..32854c78c0 100644 --- a/apps/simplex-store-service/src/StoreService/Group/Command.hs +++ b/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 -> " [months ] [uses ], or name [years ]" - CTBulk -> " [months ] count , or name [years ] count " - CTRevoke -> "" +-- | 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 [years ]", Just "name 6 years 5") + :| [(" [months ] [uses ]", Just "supporter months 12")] + CTBulk -> + ("name [years ] count ", Just "name 6 count 100") + :| [(" [months ] count ", Just "supporter months 12 count 10")] + CTRevoke -> ("", Nothing) :| [] cmdMinRole :: CmdTag -> GroupMemberRole cmdMinRole = \case diff --git a/tests/Bots/StoreService/GroupIntegrationTests.hs b/tests/Bots/StoreService/GroupIntegrationTests.hs index c7c52a796c..6da6ba5a17 100644 --- a/tests/Bots/StoreService/GroupIntegrationTests.hs +++ b/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 [months ] [uses ], or name [years ]" + 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 " + 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 [months ] [uses ], or name [years ]" + 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 [years ] e.g. /issue name 6 years 5\n/issue [months ] [uses ] 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 " [months ] [uses ], or name [years ]"), - CBCCommand "bulk" "Generate many single-use codes" (Just " [months ] count , or name [years ] count "), + [ CBCCommand "issue" "Generate a name or badge code" (Just "name [years ]"), + CBCCommand "bulk" "Generate many single-use codes" (Just "name [years ] count "), CBCCommand "revoke" "Revoke a code" (Just "") ] diff --git a/tests/Bots/StoreService/GroupTests.hs b/tests/Bots/StoreService/GroupTests.hs index daa5d0ef58..07694e1469 100644 --- a/tests/Bots/StoreService/GroupTests.hs +++ b/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 [months ] [uses ], or name [years ]" - bulkUsage = ReplyText "Usage: /bulk [months ] count , or name [years ] count " + issueUsage = ReplyText "Usage:\n/issue name [years ] e.g. /issue name 6 years 5\n/issue [months ] [uses ] e.g. /issue supporter months 12" + bulkUsage = ReplyText "Usage:\n/bulk name [years ] count e.g. /bulk name 6 count 100\n/bulk [months ] count e.g. /bulk supporter months 12 count 10" revokeUsage = ReplyText "Usage: /revoke " 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) diff --git a/tests/Bots/StoreService/NamesCodesTests.hs b/tests/Bots/StoreService/NamesCodesTests.hs index 38dc6b9b27..51ec1aa93f 100644 --- a/tests/Bots/StoreService/NamesCodesTests.hs +++ b/tests/Bots/StoreService/NamesCodesTests.hs @@ -364,8 +364,8 @@ testGroupNameCommands = do testGroupNameCommandsRefused :: IO () testGroupNameCommandsRefused = do let p = groupCmdAction GRModerator - issueUsage = ReplyText "Usage: /issue [months ] [uses ], or name [years ]" - bulkUsage = ReplyText "Usage: /bulk [months ] count , or name [years ] count " + issueUsage = ReplyText "Usage:\n/issue name [years ] e.g. /issue name 6 years 5\n/issue [months ] [uses ] e.g. /issue supporter months 12" + bulkUsage = ReplyText "Usage:\n/bulk name [years ] count e.g. /bulk name 6 count 100\n/bulk [months ] count 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 ->