From 2427eb7f0c65f625bb4f7fdead193275e580f463 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Wed, 21 Oct 2026 22:06:27 +0000
Subject: [PATCH] store: add the name label rule

---
 .../src/StoreService/Names/Label.hs           | 33 +++++++++++++++++++
 simplex-chat.cabal                            |  2 ++
 tests/Bots/StoreService/NamesLabelTests.hs    | 27 +++++++++++++++
 tests/Test.hs                                 |  2 ++
 4 files changed, 64 insertions(+)
 create mode 100644 apps/simplex-store-service/src/StoreService/Names/Label.hs
 create mode 100644 tests/Bots/StoreService/NamesLabelTests.hs

diff --git a/apps/simplex-store-service/src/StoreService/Names/Label.hs b/apps/simplex-store-service/src/StoreService/Names/Label.hs
new file mode 100644
index 0000000000..cfaf0d2c9a
--- /dev/null
+++ b/apps/simplex-store-service/src/StoreService/Names/Label.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module StoreService.Names.Label
+  ( LabelError (..),
+    validLabel,
+  )
+where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
+import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexTLD)
+
+data LabelError = LELength | LEChars
+  deriving (Eq, Show)
+
+minLabelLength :: Int
+minLabelLength = 6
+
+maxLabelLength :: Int
+maxLabelLength = 63
+
+validLabel :: SimplexTLD -> Text -> Either LabelError Text
+validLabel tld label
+  | len < minLabelLength || len > maxLabelLength = Left LELength
+  | T.toLower label /= label = Left LEChars
+  | otherwise = case strDecode (encodeUtf8 $ label <> decodeLatin1 (strEncode tld)) of
+      Right SimplexDomain {domain, subDomain = []} | domain == label -> Right label
+      _ -> Left LEChars
+  where
+    len = T.length label
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index a4ae682f6b..902666fea0 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -738,6 +738,7 @@ test-suite simplex-chat-test
       Bots.StoreService.GroupIntegrationTests
       Bots.StoreService.GroupTests
       Bots.StoreService.NameRegistrationTests
+      Bots.StoreService.NamesLabelTests
       Bots.StoreService.StripeTests
       Bots.StoreService.WaitersTests
       Bots.StoreService.WebTests
@@ -760,6 +761,7 @@ test-suite simplex-chat-test
       StoreService.Group.Command
       StoreService.Log
       StoreService.Names.Chain
+      StoreService.Names.Label
       StoreService.Names.Registration
       StoreService.Options
       StoreService.Orders
diff --git a/tests/Bots/StoreService/NamesLabelTests.hs b/tests/Bots/StoreService/NamesLabelTests.hs
new file mode 100644
index 0000000000..f55948a15b
--- /dev/null
+++ b/tests/Bots/StoreService/NamesLabelTests.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Bots.StoreService.NamesLabelTests (storeNamesLabelTests) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Simplex.Messaging.SimplexName (SimplexTLD (..))
+import StoreService.Names.Label
+import Test.Hspec
+
+storeNamesLabelTests :: Spec
+storeNamesLabelTests = describe "StoreService names: label" $ do
+  describe "accepts" $ do
+    mapM_ accepted ["bakery", "bak-ery-2", "a-b-c-d-e-f", "123456", T.replicate 63 "a"]
+  describe "refuses as characters" $ do
+    mapM_ (refused LEChars) ["bak--ery", "--bakery", "bakery--", "-bakery", "bakery-", "Bakery", "bak.ery", "bäkery", "bak ery", "bak_ery", "bakery.simplex", "бакеry1"]
+  describe "refuses as length" $ do
+    mapM_ (refused LELength) ["", "abcde", "a.b", T.replicate 64 "a", T.replicate 100 "-"]
+  it "applies the same rule under the testing TLD" $ do
+    validLabel TLDTesting "bakery" `shouldBe` Right "bakery"
+    validLabel TLDTesting "bak--ery" `shouldBe` Left LEChars
+  it "has no bare web names" $
+    validLabel TLDWeb "bakery" `shouldBe` Left LEChars
+  where
+    accepted l = it ("accepts " <> show l) $ validLabel TLDSimplex l `shouldBe` Right l
+    refused :: LabelError -> Text -> Spec
+    refused e l = it ("refuses " <> show l) $ validLabel TLDSimplex l `shouldBe` Left e
diff --git a/tests/Test.hs b/tests/Test.hs
index 1a1fcab74a..3d1034e121 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -10,6 +10,7 @@ import Bots.StoreService.ConfigTests
 import Bots.StoreService.GroupIntegrationTests
 import Bots.StoreService.GroupTests
 import Bots.StoreService.NameRegistrationTests
+import Bots.StoreService.NamesLabelTests
 import Bots.StoreService.StripeTests
 import Bots.StoreService.WaitersTests
 import Bots.StoreService.WebTests
@@ -86,6 +87,7 @@ main = do
         badgeBTCPayTests
         badgeStripeTests
         badgeNameRegistrationTests
+        storeNamesLabelTests
       describe "SimpleX chat markdown" markdownTests
       describe "JSON Tests" jsonTests
       describe "Member relations" memberRelationsTests