core, tests: web order, invoice and provider event store

src/Simplex/Chat/PaymentService/Types.hs

@@ -198,6 +198,35 @@ instance ToField PaymentStatus where toField = toField . textEncode
 -- that a compile error instead of a silent loss. 'InvoiceStatus' keeps its 'FromField' because
 -- its three constructors are nullary and its decode is lossless.
 
+-- | DB column spelling for @invoices.provider@, @payments.provider@ and
+-- @provider_events.provider@. 'PaymentProvider' does not cross the wire (the RPC names a
+-- provider through 'ServicePaymentMethod'), so this spelling is only ever read back from a
+-- column it was written to -- the same arrangement 'InvoiceStatus' and 'PaymentStatus' document
+-- above. It replaces the two @codePaymentProviderText = "code"@ literals that the client and
+-- the service each carried while no codec existed (plan §9, B1\/C1): the badge service now writes
+-- a second provider ('PPStripe' and 'PPCrypto', from D0's 'BadgeService.Store.createOrder'), which
+-- is the condition both notes named for adding this.
+instance TextEncoding PaymentProvider where
+  textEncode = \case
+    PPApple -> "apple"
+    PPGoogle -> "google"
+    PPStripe -> "stripe"
+    PPCrypto -> "crypto"
+    PPCode -> "code"
+    PPReceipt -> "receipt"
+  textDecode = \case
+    "apple" -> Just PPApple
+    "google" -> Just PPGoogle
+    "stripe" -> Just PPStripe
+    "crypto" -> Just PPCrypto
+    "code" -> Just PPCode
+    "receipt" -> Just PPReceipt
+    _ -> Nothing
+
+instance ToField PaymentProvider where toField = toField . textEncode
+
+instance FromField PaymentProvider where fromField = fromTextField_ textDecode
+
 -- JSON
 
 -- CardProvider has a single nullary constructor; tagSingleConstructors is needed so it still

src/Simplex/Chat/Store/Badges.hs

@@ -83,7 +83,7 @@ import Simplex.Chat.Badges.Types
     LedgerDebitType (..),
     LedgerEntryType (..),
   )
-import Simplex.Chat.PaymentService.Types (PaymentStatus (..))
+import Simplex.Chat.PaymentService.Types (PaymentProvider (..), PaymentStatus (..))
 import Simplex.Chat.Store.Shared (StoreError (..))
 import Simplex.Messaging.Agent.Protocol (UserId)
 import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
@@ -142,13 +142,6 @@ badgeSlot = \case
   BTInvestor -> BSInvestor
   BTUnknown tag -> BSOther tag
 
--- | @payments.provider@ has no column codec yet: 'Simplex.Chat.PaymentService.Types.PaymentProvider'
--- has no 'TextEncoding' instance, and adding one is D0\/E2\/F1's, once a second provider needs
--- writing. Until then this literal is the client twin of
--- 'BadgeService.Store.codePaymentProviderText' and must keep the same spelling.
-codePaymentProviderText :: Text
-codePaymentProviderText = "code"
-
 -- | The @payments@ row of a code redemption: a caller-minted UUID (the column is
 -- @TEXT NOT NULL PRIMARY KEY@ with no default), @provider = 'code'@, no invoice — a code
 -- payment never has one — and @settled@, because a redeemed code is paid for by definition.
@@ -166,7 +159,7 @@ createCodePayment db now = do
       INSERT INTO payments (payment_id, invoice_id, provider, status, created_at, updated_at)
       VALUES (?,?,?,?,?,?)
     |]
-    (paymentId, Nothing :: Maybe Text, codePaymentProviderText, PSSettled, now, now)
+    (paymentId, Nothing :: Maybe Text, PPCode, PSSettled, now, now)
   pure paymentId
 
 -- | The purchase row of a code redemption, written on success only: a code redemption does not