update

plans/2026-07-31-badges-core-implementation.md

@@ -79,7 +79,7 @@ The protocol entry (`StatementEntry`, §4): `entryId`, `changeMonths`, `balanceM
 
 ## 3. Client types
 
-Domain types — `src/Simplex/Chat/Badges/Store.hs`. Records:
+Domain types — `src/Simplex/Chat/Badges/Types.hs`. Records:
 
 - `BadgePurchase`
 - `BadgePayment`

simplex-chat.cabal

@@ -41,7 +41,7 @@ library
       Simplex.Chat.Badges
       Simplex.Chat.Badges.CLI
       Simplex.Chat.Badges.Service
-      Simplex.Chat.Badges.Store
+      Simplex.Chat.Badges.Types
       Simplex.Chat.Names
       Simplex.Chat.Call
       Simplex.Chat.Controller
@@ -65,6 +65,8 @@ library
       Simplex.Chat.Operators.Presets
       Simplex.Chat.Options
       Simplex.Chat.Options.DB
+      Simplex.Chat.PaymentService
+      Simplex.Chat.PaymentService.Types
       Simplex.Chat.ProfileGenerator
       Simplex.Chat.Protocol
       Simplex.Chat.Remote

src/Simplex/Chat/Badges/Service.hs

@@ -10,15 +10,8 @@ module Simplex.Chat.Badges.Service
     BadgeServiceVersion,
     VersionBadgeService,
     pattern VersionBadgeService,
-    ServicePaymentMethod (..),
-    CardProvider (..),
-    CryptoCurrency (..),
-    CurrencyAmount (..),
-    ServicePayment (..),
     BadgeUpgrade (..),
     BadgeServiceResponse (..),
-    ServiceInvoice (..),
-    ServicePaymentDestination (..),
     BadgeServiceErrorCode (..),
     BadgeCatalog (..),
     BadgePrice (..),
@@ -38,7 +31,8 @@ import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Data.Word (Word8, Word16, Word32)
 import Simplex.Chat.Badges
-import Simplex.Chat.Badges.Store
+import Simplex.Chat.Badges.Types
+import Simplex.Chat.PaymentService
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Version (VersionScope)
@@ -84,29 +78,6 @@ data BadgeServiceCommand
       }
   | BSCPauseBadge
 
-data ServicePaymentMethod
-  = SPMCard {provider :: CardProvider}
-  | SPMCrypto {currency :: CryptoCurrency}
-  deriving (Eq, Show)
-
-data CardProvider = CPStripe
-  deriving (Eq, Show)
-
-data CryptoCurrency = CCBtc | CCXmr
-  deriving (Eq, Show)
-
--- USD etc. are in minor units, following Stripe etc. convention
-newtype CurrencyAmount = CurrencyAmount Word32
-  deriving (Eq, Show)
-
-data ServicePayment
-  = SPApple {jws :: Text}
-  | SPGoogle {token :: Text}
-  | SPInvoice {invoiceId :: InvoiceId}
-  | SPCode {code :: Text}
-  | SPReceipt {receipt :: Text} -- transfer of unissued months
-  deriving (Show)
-
 data BadgeUpgrade = BadgeUpgrade
   { fromPurchaseKey :: C.PublicKeyEd25519,
     receipt :: Text,
@@ -135,30 +106,6 @@ data BadgeServiceResponse
         retryAfter :: Maybe Word32
       }
 
-data ServiceInvoice = ServiceInvoice
-  { invoiceId :: InvoiceId,
-    price :: CurrencyAmount,
-    discount :: Maybe CurrencyAmount, -- discount amount from the price
-    credit :: Maybe CurrencyAmount, -- credit for upgrade
-    amount :: CurrencyAmount, -- price - discount - credit
-    currency :: Text,
-    expiresAt :: UTCTime,
-    paymentTo :: ServicePaymentDestination
-  }
-  deriving (Show)
-
-data ServicePaymentDestination
-  = SPDCard
-      { provider :: CardProvider,
-        url :: Text
-      }
-  | SPDCrypto
-      { currency :: CryptoCurrency,
-        address :: Text,
-        cryptoAmount :: Text
-      }
-  deriving (Show)
-
 data BadgeCatalog = BadgeCatalog
   { prices :: [BadgePrice],
     offers :: [BadgeOffer]

src/Simplex/Chat/Badges/Types.hs

@@ -2,14 +2,12 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
-module Simplex.Chat.Badges.Store
+module Simplex.Chat.Badges.Types
   ( BadgePriceId (..),
     BadgeOfferId (..),
-    InvoiceId (..),
     BadgePlan (..),
     BadgeItemStatus (..),
     OfferDiscount (..),
-    PaymentProvider (..),
     BadgePaymentStatus (..),
     BadgePurchaseStatus (..),
     LedgerEntryType (..),
@@ -32,6 +30,7 @@ import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Data.Word (Word8)
 import Simplex.Chat.Badges hiding (BadgePurchase (..))
+import Simplex.Chat.PaymentService.Types (InvoiceId, PaymentProvider)
 import Simplex.Messaging.Agent.Protocol (UserId)
 import qualified Simplex.Messaging.Crypto as C
 
@@ -43,10 +42,6 @@ newtype BadgePriceId = BadgePriceId Text
 newtype BadgeOfferId = BadgeOfferId Text
   deriving newtype (Eq, Show)
 
--- to review
-newtype InvoiceId = InvoiceId Text
-  deriving newtype (Eq, Show)
-
 -- unconfirmed draft
 data BadgePlan = BPOneTime | BPMonthly | BPAnnual
   deriving (Eq, Show)
@@ -61,10 +56,6 @@ data OfferDiscount
   | ODDiscount {discount :: Word8} -- percent
   deriving (Eq, Show)
 
--- unconfirmed draft
-data PaymentProvider = PPApple | PPGoogle | PPStripe | PPCrypto | PPCode | PPReceipt
-  deriving (Eq, Show)
-
 -- unconfirmed draft
 data BadgePaymentStatus = BPSNew | BPSInvoiced | BPSPending | BPSSettled | BPSFailed | BPSExpired
   deriving (Eq, Show)

src/Simplex/Chat/PaymentService.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Simplex.Chat.PaymentService
+  ( ServiceInvoice (..),
+    ServicePayment (..),
+    module Simplex.Chat.PaymentService.Types,
+  ) where
+
+import Data.Text (Text)
+import Data.Time.Clock (UTCTime)
+import Simplex.Chat.PaymentService.Types
+
+data ServiceInvoice = ServiceInvoice
+  { invoiceId :: InvoiceId,
+    price :: CurrencyAmount,
+    discount :: Maybe CurrencyAmount, -- discount amount from the price
+    credit :: Maybe CurrencyAmount, -- credit for upgrade
+    amount :: CurrencyAmount, -- price - discount - credit
+    currency :: Text,
+    expiresAt :: UTCTime,
+    paymentTo :: ServicePaymentDestination
+  }
+  deriving (Show)
+
+data ServicePayment
+  = SPApple {jws :: Text}
+  | SPGoogle {token :: Text}
+  | SPInvoice {invoiceId :: InvoiceId}
+  | SPCode {code :: Text}
+  | SPReceipt {receipt :: Text} -- transfer of unissued months
+  deriving (Show)

src/Simplex/Chat/PaymentService/Types.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Simplex.Chat.PaymentService.Types
+  ( CurrencyAmount (..),
+    InvoiceId (..),
+    PaymentProvider (..),
+    CardProvider (..),
+    CryptoCurrency (..),
+    ServicePaymentMethod (..),
+    ServicePaymentDestination (..),
+    InvoiceStatus (..),
+    StoredInvoice (..),
+  ) where
+
+import Data.Text (Text)
+import Data.Time.Clock (UTCTime)
+import Data.Word (Word32)
+
+-- USD etc. are in minor units, following Stripe etc. convention
+newtype CurrencyAmount = CurrencyAmount Word32
+  deriving (Eq, Show)
+
+-- confirmed
+newtype InvoiceId = InvoiceId Text
+  deriving newtype (Eq, Show)
+
+-- confirmed
+data PaymentProvider = PPApple | PPGoogle | PPStripe | PPCrypto | PPCode | PPReceipt
+  deriving (Eq, Show)
+
+data CardProvider = CPStripe
+  deriving (Eq, Show)
+
+data CryptoCurrency = CCBtc | CCXmr
+  deriving (Eq, Show)
+
+data ServicePaymentMethod
+  = SPMCard {provider :: CardProvider}
+  | SPMCrypto {currency :: CryptoCurrency}
+  deriving (Eq, Show)
+
+data ServicePaymentDestination
+  = SPDCard
+      { provider :: CardProvider,
+        url :: Text
+      }
+  | SPDCrypto
+      { currency :: CryptoCurrency,
+        address :: Text,
+        cryptoAmount :: Text
+      }
+  deriving (Show)
+
+-- confirmed
+data InvoiceStatus = ISOpen | ISPaid | ISExpired
+  deriving (Eq, Show)
+
+-- confirmed
+data StoredInvoice = StoredInvoice
+  { invoiceId :: InvoiceId,
+    price :: CurrencyAmount,
+    discountAmount :: CurrencyAmount,
+    creditAmount :: CurrencyAmount,
+    amount :: CurrencyAmount, -- price - discount - credit
+    currency :: Text,
+    paymentTo :: ServicePaymentDestination,
+    expiresAt :: UTCTime,
+    status :: InvoiceStatus,
+    createdAt :: UTCTime,
+    updatedAt :: UTCTime
+  }
+  deriving (Show)