ui: redeem code (#7482)

src/Simplex/Chat/Badges/Types.hs

@@ -36,6 +36,7 @@ import Data.Time.Clock (UTCTime)
 import Data.Word (Word8)
 import Simplex.Chat.Badges hiding (BadgePurchase (..))
 import Simplex.Chat.PaymentService.Types (InvoiceId, PaymentId, StoredPayment)
+import Simplex.Chat.Types (BoolDef (..))
 import Simplex.Messaging.Agent.Protocol (UserId)
 import Simplex.Messaging.Agent.Store.DB (fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
@@ -212,6 +213,7 @@ data BadgeAlert = BadgeAlert
 data BadgeState = BadgeState
   { badgePurchaseId :: Int64,
     badgeType :: BadgeType,
+    shown :: BoolDef,
     monthsLeft :: Int,
     paidThrough :: UTCTime,
     -- payments returns here with the payment types, which this slice neither writes nor encodes

src/Simplex/Chat/Library/Commands.hs

@@ -3563,7 +3563,7 @@ processChatCommand cxt nm = \case
   ShowProfile -> withUser $ \user@User {profile} -> pure $ CRUserProfile user (fromLocalProfile profile)
   AddBadge cred -> withUser $ \user -> addUserBadge user cred >> ok user
   APIRedeemBadgeCode userId codeText -> withUserId userId $ \user -> redeemBadgeCode nm user codeText
-  APIGetBadgeState userId -> withUserId userId $ \user -> do
+  APIGetBadgeState userId -> withUserId' userId $ \user -> do
     -- the read also signals the worker, whose results follow as CEvtBadgeChanged
     lift $ startBadgeWork user
     CRBadgeState user <$> getUserBadgeState user
@@ -5407,10 +5407,11 @@ getUserBadgeState user = do
     Just p@UserBadgePurchase {badgePurchaseId} ->
       fmap (badgeStateOf now p) <$> withStore' (`getBadgeLedgerLastEntry` badgePurchaseId)
   where
-    badgeStateOf now p@UserBadgePurchase {badgePurchaseId, badgeType} balance =
+    badgeStateOf now p@UserBadgePurchase {badgePurchaseId, badgeType, shown} balance =
       BadgeState
         { badgePurchaseId,
           badgeType,
+          shown = BoolDef shown,
           monthsLeft = balanceMonths balance,
           paidThrough = L.paidThrough balance,
           renewsAt = Nothing,

src/Simplex/Chat/Mobile.hs

@@ -27,6 +27,7 @@ import Data.List (find)
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word8)
 import Foreign.C.String
 import Foreign.C.Types (CInt (..))
@@ -35,6 +36,7 @@ import Foreign.StablePtr
 import Foreign.Storable (poke)
 import GHC.IO.Encoding (setFileSystemEncoding, setForeignEncoding, setLocaleEncoding)
 import Simplex.Chat
+import Simplex.Chat.Badges.Code (badgeCodeText, parseBadgeCode)
 import Simplex.Chat.Controller
 import Simplex.Chat.Library.Commands
 import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList, parseUri, sanitizeUri)
@@ -137,6 +139,8 @@ foreign export ccall "chat_password_hash" cChatPasswordHash :: CString -> CStrin
 
 foreign export ccall "chat_valid_name" cChatValidName :: CString -> IO CString
 
+foreign export ccall "chat_parse_badge_code" cChatParseBadgeCode :: CString -> IO CString
+
 foreign export ccall "chat_json_length" cChatJsonLength :: CString -> IO CInt
 
 foreign export ccall "chat_badge_keygen" cChatBadgeKeygen :: IO CJSONString
@@ -240,6 +244,12 @@ cChatPasswordHash cPwd cSalt = do
 cChatValidName :: CString -> IO CString
 cChatValidName cName = newCString . mkValidName =<< peekCString cName
 
+-- | canonical form of a code that passes its check character, empty string if it does not parse
+cChatParseBadgeCode :: CString -> IO CString
+cChatParseBadgeCode cCode = do
+  code <- safeDecodeUtf8 <$> B.packCString cCode
+  newCStringFromBS $ maybe "" (encodeUtf8 . badgeCodeText) $ parseBadgeCode code
+
 -- | returns length of JSON encoded string
 cChatJsonLength :: CString -> IO CInt
 cChatJsonLength s = fromIntegral . subtract 2 . LB.length . J.encode . safeDecodeUtf8 <$> B.packCString s