diff --git a/apps/simplex-store-service/src/StoreService/Names/Codes.hs b/apps/simplex-store-service/src/StoreService/Names/Codes.hs index bacd833beb..d94458a7dc 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Codes.hs +++ b/apps/simplex-store-service/src/StoreService/Names/Codes.hs @@ -26,12 +26,14 @@ import Data.Int (Int64) import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) import Data.Time.Clock (UTCTime, getCurrentTime) -import Simplex.Chat.Badges.Code (NamePrepaidCode, namePrepaidCodeHash, randomNamePrepaidCode) +import Simplex.Chat.Badges.Code (NamePrepaidCode, maxNameLength, minNameLength, namePrepaidCodeHash, randomNamePrepaidCode) import Simplex.Chat.Badges.Types (BadgeCodePaymentStatus (..)) import Simplex.Chat.Bot.Store (withDB') import Simplex.Chat.Controller (ChatController (..)) import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction) import qualified Simplex.Messaging.Agent.Store.DB as DB +import StoreService.Config (minNameYears) +import StoreService.Group.Command (maxNameYears) import StoreService.Names.Phases (RegistrationId) import StoreService.Names.Store (CodeHashTaken (..), NewPrepaidCode (..), PrepaidCode (..), getPrepaidCode, getPrepaidCodeById, insertPrepaidCode, releasePrepaidCode, reservePrepaidCode, revokePrepaidCode, spendPrepaidCode) import StoreService.Names.Turns (Turns, withCodeTurn) @@ -128,16 +130,19 @@ afterWrite turns st codeId change write = do let run = withTransaction st $ \db -> write db >>= traverse (\a -> (a,) <$> change db) maybe run (\codeHash -> withCodeTurn turns codeHash run) codeHash_ --- | The code table keeps only the hash, so the caller must deliver the code. The length and years are checked by the command's parser. +-- | The code table keeps only the hash, so the caller must deliver the code. issueNameCode :: ChatController -> Int -> Int -> BadgeCodePaymentStatus -> IO (Either String NamePrepaidCode) -issueNameCode cc len years paymentStatus = do - code <- randomNamePrepaidCode (random cc) len - now <- getCurrentTime - let new = NewPrepaidCode {npcCodeHash = namePrepaidCodeHash code, npcMinLength = len, npcYears = years, npcPaymentStatus = paymentStatus, npcExpiresAt = Nothing} - withDB' "issueNameCode" cc (\db -> insertPrepaidCode db new now) <&> \case - Right (Right _) -> Right code - Right (Left CodeHashTaken) -> Left "prepaid code hash taken" - Left e -> Left e +issueNameCode cc len years paymentStatus + | len < minNameLength || len > maxNameLength = pure $ Left $ "name code length " <> show len <> " is outside " <> show minNameLength <> "-" <> show maxNameLength + | years < minNameYears || years > maxNameYears = pure $ Left $ "name code years " <> show years <> " is outside " <> show minNameYears <> "-" <> show maxNameYears + | otherwise = do + code <- randomNamePrepaidCode (random cc) len + now <- getCurrentTime + let new = NewPrepaidCode {npcCodeHash = namePrepaidCodeHash code, npcMinLength = len, npcYears = years, npcPaymentStatus = paymentStatus, npcExpiresAt = Nothing} + withDB' "issueNameCode" cc (\db -> insertPrepaidCode db new now) <&> \case + Right (Right _) -> Right code + Right (Left CodeHashTaken) -> Left "prepaid code hash taken" + Left e -> Left e -- | Left is a refusal or a failure; both sides are the text to show the operator. revokeNameCode :: Turns -> ChatController -> NamePrepaidCode -> IO (Either Text Text) diff --git a/tests/Bots/StoreService/GroupIntegrationTests.hs b/tests/Bots/StoreService/GroupIntegrationTests.hs index d36fc84142..1cb6d4c190 100644 --- a/tests/Bots/StoreService/GroupIntegrationTests.hs +++ b/tests/Bots/StoreService/GroupIntegrationTests.hs @@ -13,7 +13,7 @@ module Bots.StoreService.GroupIntegrationTests (badgeGroupIntegrationTests, name import StoreService.Config (BadgeIssuerKey (..), GroupConfig (..)) import StoreService.Group (GroupAction (..), GroupEvent (..), codeInTracker, ensureManagedGroup) import StoreService.Group.Command (maxUses) -import StoreService.Names.Codes (reserveCode, revokeNameCode) +import StoreService.Names.Codes (issueNameCode, reserveCode, revokeNameCode) import StoreService.Names.Phases (RegistrationId (..)) import StoreService.Names.Store (PrepaidCode (..), getPrepaidCode, spendPrepaidCode) import StoreService.Names.Turns (newTurns, withCodeTurn) @@ -33,7 +33,7 @@ import Control.Concurrent.STM (TQueue, atomically, newTQueueIO, orElse, readTMVa import Control.Exception (IOException, bracket, catch, finally, throwIO, try) import Control.Monad (forM_, guard, mfilter, replicateM_, unless, void, when) import qualified Data.Aeson as J -import Data.Either (isRight) +import Data.Either (isLeft, isRight) import Data.Int (Int64) import Data.List (isInfixOf) import Data.List.NonEmpty (NonEmpty (..)) @@ -172,6 +172,8 @@ testOperatorNameCodes ps = do pollUntilTrue (listening port) forM_ ["name", "name 5", "name 64", "name 07", "name 7 years 1", "name 7 years 11", "name 7 gratis"] $ \args -> (args,) <$> issueRaw cc args `shouldReturn` (args, Left badgeCmdUsage) + forM_ [(5, 2), (64, 2), (7, 1), (7, 11)] $ \(len, years) -> + ((len, years),) . isLeft <$> issueNameCode cc len years CPSFree `shouldReturn` ((len, years), True) countRows cc "sx_badge_service_name_prepaid_codes" `shouldReturn` 0 paid <- issueNameRaw cc "name 7 years 3 paid" unpaid <- issueNameRaw cc "name 6 unpaid"