minimal name actions api

src/Simplex/Chat/Badges/Service.hs

@@ -27,6 +27,9 @@ module Simplex.Chat.Badges.Service
     StatementEntryType (..),
     StatementCreditType (..),
     StatementDebitType (..),
+    NameCredit (..),
+    NameReveal (..),
+    SignedNameLinks (..),
   ) where
 
 import Control.Applicative ((<|>))
@@ -44,6 +47,8 @@ import Simplex.Chat.PaymentService
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, taggedObjectJSON)
+import Simplex.Messaging.Protocol (NameResponse)
+import Simplex.Messaging.SimplexName (SimplexDomain)
 import Simplex.Messaging.Version (VersionRange, VersionScope, mkVersionRange)
 import Simplex.Messaging.Version.Internal (Version (..))
 
@@ -61,8 +66,11 @@ type VersionRangeBadgeService = VersionRange BadgeServiceVersion
 initialBadgeServiceVersion :: VersionBadgeService
 initialBadgeServiceVersion = VersionBadgeService 1
 
+namesBadgeServiceVersion :: VersionBadgeService
+namesBadgeServiceVersion = VersionBadgeService 2
+
 currentBadgeServiceVersion :: VersionBadgeService
-currentBadgeServiceVersion = VersionBadgeService 1
+currentBadgeServiceVersion = namesBadgeServiceVersion
 
 -- the service is deployed ahead of app releases, so it answers within the client's version
 supportedBadgeServiceVRange :: VersionRangeBadgeService
@@ -101,6 +109,24 @@ data BadgeServiceCommand
       { balance :: BadgeBalance -- no badgeRequest: the service holds the key, the tier and the expiry
       }
   | BSCPauseBadge
+  | BSCPurchaseName
+      { payment :: ServicePayment -- credits the purchase key with one name
+      }
+  | BSCRedeemNameCode
+      { code :: Text
+      }
+  | BSCCommitName
+      { commitment :: Text -- 0x keccak of the label, owner and secret, so the name stays unknown until revealed
+      }
+  | BSCRevealName
+      { nameReveal :: NameReveal
+      }
+  | BSCRenewName
+      { domain :: SimplexDomain
+      }
+  | BSCSetNameLinks
+      { nameLinks :: SignedNameLinks
+      }
 
 data BadgeUpgrade = BadgeUpgrade
   { fromPurchaseKey :: C.PublicKeyEd25519,
@@ -124,6 +150,15 @@ data BadgeServiceResponse
         receipt :: Maybe Text, -- not provided for lifetime badges
         statement :: BadgeStatement
       }
+  | BSPNameCredit
+      { credit :: NameCredit -- what a payment or code covers, before it is spent
+      }
+  | BSPNameCommitted
+      { revealAfter :: UTCTime
+      }
+  | BSPName
+      { registration :: NameResponse -- as the service wrote it
+      }
   | BSPError
       { code :: BadgeServiceErrorCode,
         message :: Maybe Text,
@@ -223,9 +258,39 @@ data BadgeServiceErrorCode
   | BSEReceiptInvalid
   | BSEReceiptUsed
   | BSEInternal
+  | BSENameTaken
+  | BSENameNotCovered -- the credit covers longer names only
   | BSEUnknown Text -- forwards-compatible: service is deployed ahead of clients
   deriving (Eq, Show)
 
+-- what one name purchase covers
+data NameCredit = NameCredit
+  { minLength :: Int,
+    years :: Word8,
+    expiresAt :: Maybe UTCTime -- a code's own expiry, absent for a store payment
+  }
+  deriving (Show)
+
+-- sent once the commitment is old enough; the owner and secret bind the name to the client
+data NameReveal = NameReveal
+  { label :: Text,
+    owner :: Text, -- 0x address of the name's key
+    secret :: Text, -- 0x
+    simplexContact :: [Text], -- the records the name is registered with, as NameRecord has them
+    simplexChannel :: [Text]
+  }
+  deriving (Show)
+
+-- new records for a name, signed by its key (EIP-712)
+data SignedNameLinks = SignedNameLinks
+  { domain :: SimplexDomain,
+    simplexContact :: [Text],
+    simplexChannel :: [Text],
+    nonce :: Word32,
+    signature :: Text -- 0x
+  }
+  deriving (Show)
+
 instance TextEncoding BadgeServiceErrorCode where
   textEncode = \case
     BSEBadRequest -> "bad_request"
@@ -245,6 +310,8 @@ instance TextEncoding BadgeServiceErrorCode where
     BSEReceiptInvalid -> "receipt_invalid"
     BSEReceiptUsed -> "receipt_used"
     BSEInternal -> "internal"
+    BSENameTaken -> "name_taken"
+    BSENameNotCovered -> "name_not_covered"
     BSEUnknown t -> t
   textDecode s = Just $ case s of
     "bad_request" -> BSEBadRequest
@@ -264,6 +331,8 @@ instance TextEncoding BadgeServiceErrorCode where
     "receipt_invalid" -> BSEReceiptInvalid
     "receipt_used" -> BSEReceiptUsed
     "internal" -> BSEInternal
+    "name_taken" -> BSENameTaken
+    "name_not_covered" -> BSENameNotCovered
     t -> BSEUnknown t
 
 instance ToJSON BadgeServiceErrorCode where
@@ -315,6 +384,12 @@ $(JQ.deriveJSON defaultJSON ''BadgeBalance)
 
 $(JQ.deriveJSON defaultJSON ''BadgeUpgrade)
 
+$(JQ.deriveJSON defaultJSON ''NameCredit)
+
+$(JQ.deriveJSON defaultJSON ''NameReveal)
+
+$(JQ.deriveJSON defaultJSON ''SignedNameLinks)
+
 $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "BSC") ''BadgeServiceCommand)
 
 $(JQ.deriveJSON defaultJSON ''BadgeServiceRequest)

src/Simplex/Chat/Controller.hs

@@ -84,8 +84,9 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Client (HostMode (..), SMPProxyFallback (..), SMPProxyMode (..), SMPWebPortServers (..), SocksMode (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Chat.Badges (BadgeCredential, FileSizeLimits, LocalBadge)
-import Simplex.Chat.Badges.Service (BadgeServiceErrorCode)
+import Simplex.Chat.Badges.Service (BadgeServiceErrorCode, NameCredit)
 import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeAlertKind, BadgeState (..))
+import Simplex.Chat.PaymentService (ServicePayment)
 import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import qualified Simplex.Messaging.Crypto.File as CF
@@ -93,7 +94,7 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), MsgId, NMsgMeta (..), NameRegistration, NtfServer, ProtocolType (..), QueueId, SMPMsgMeta (..), SubscriptionMode (..), XFTPServer)
+import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), MsgId, NMsgMeta (..), NameRegistration, NameResponse, NtfServer, ProtocolType (..), QueueId, SMPMsgMeta (..), SubscriptionMode (..), XFTPServer)
 import Simplex.Messaging.Session (SessionVar)
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (TLS, TransportPeer (..), simplexMQVersion)
@@ -663,6 +664,14 @@ data ChatCommand
   -- episode is last because it is free text: it is the value that makes one occurrence of an
   -- alert distinct from the next, and the app returns whatever it was given
   | APIAckBadgeAlert {userId :: UserId, badgePurchaseId :: Int64, alertKind :: BadgeAlertKind, snooze :: Bool, episode :: Text}
+  | APIPurchaseName {userId :: UserId, domain :: SimplexDomain, nameLinks :: NameLinks, payment :: ServicePayment} -- register a name paid in the app store; progress follows as CEvtNameChanged
+  | APIRedeemNameCode {userId :: UserId, domain :: SimplexDomain, nameLinks :: NameLinks, code :: Text} -- register a name with a code
+  | APICheckNameCode {userId :: UserId, code :: Text} -- what a code covers, checked on the device without spending it
+  | APIGetNameState {userId :: UserId} -- the user's names, and registrations in progress
+  | APIRetryName {userId :: UserId, namePurchaseId :: Int64, domain_ :: Maybe SimplexDomain} -- the payment is kept after a failure: the same name again, or another one when it was taken
+  | APISetNameLinks {userId :: UserId, namePurchaseId :: Int64, nameLinks :: NameLinks}
+  | APIRenewName {userId :: UserId, namePurchaseId :: Int64, payment :: ServicePayment}
+  | APIRenewNameCode {userId :: UserId, namePurchaseId :: Int64, code :: Text}
   | ShowProfileImage
   | SetUserFeature AChatFeature FeatureAllowed -- UserId (not used in UI)
   | SetContactFeature AChatFeature ContactName (Maybe FeatureAllowed)
@@ -871,6 +880,8 @@ data ChatResponse
   | CRServiceReplyAccepted {user :: User, connectionId :: AgentConnId}
   | CRBadgeRedeemed {user :: User, redeemedBadge :: LocalBadge, newBadge :: Bool, badgeState :: Maybe BadgeState}
   | CRBadgeState {user :: User, badgeState :: Maybe BadgeState}
+  | CRNameState {user :: User, nameState :: [NameState]}
+  | CRNameCode {user :: User, credit :: NameCredit}
   | CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
   | CRUserDeletedMembers {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], withMessages :: Bool, msgSigned :: Bool}
   | CRGroupsList {user :: User, groups :: [GroupInfo]}
@@ -990,6 +1001,7 @@ data ChatEvent
   | CEvtServiceReplySent {connectionId :: AgentConnId}
   | CEvtBadgeChanged {user :: User, badgeState :: Maybe BadgeState} -- badge state changed, including a renewal that arrived without a command
   | CEvtBadgeAlert {user :: User, badgeAlert :: BadgeAlert}
+  | CEvtNameChanged {user :: User, nameState :: NameState} -- a registration moved on, including results that arrive without a command
   | CEvtContactRequestRejected {user :: User, contact :: Contact, rejectionReason :: Maybe ContactRejectionReason}
   | CEvtAcceptingContactRequest {user :: User, contact :: Contact} -- there is the same command response
   | CEvtAcceptingBusinessRequest {user :: User, groupInfo :: GroupInfo}
@@ -1491,6 +1503,39 @@ data BadgeRedeemError
   | BRECredentialNotVerified
   deriving (Eq, Show)
 
+-- where a name leads: one profile's contact address and one channel, each optional
+data NameLinks = NameLinks
+  { contactUserId :: Maybe UserId, -- the profile's address is created if it has none
+    channelGroupId :: Maybe GroupId
+  }
+  deriving (Show)
+
+-- a name as the names surfaces render it; its keys stay in core, as BadgeState's do
+data NameState = NameState
+  { namePurchaseId :: Int64,
+    domain :: SimplexDomain,
+    nameLinks :: NameLinks,
+    status :: NamePurchaseStatus,
+    registration :: Maybe NameResponse -- as the service last wrote it
+  }
+  deriving (Show)
+
+data NamePurchaseStatus
+  = NPSCommitting
+  | NPSWaiting {revealAfter :: UTCTime}
+  | NPSRevealing
+  | NPSRegistered
+  | NPSTaken -- registered by someone else first; the payment is kept for another name
+  | NPSFailed -- not registered; the payment is kept
+  deriving (Show)
+
+data NameError
+  = NEInvalidCode -- not a names code, or its signature does not verify
+  | NEServiceNotConfigured
+  | NEServiceError {serviceError :: BadgeServiceErrorCode}
+  | NEInvalidResponse {message :: String}
+  deriving (Eq, Show)
+
 data ChatErrorType
   = CENoActiveUser
   | CENoConnectionUser {agentConnId :: AgentConnId}
@@ -1564,6 +1609,7 @@ data ChatErrorType
   | CEAgentNoSubResult {agentConnId :: AgentConnId}
   | CECommandError {message :: String}
   | CEBadgeRedeemError {badgeRedeemError :: BadgeRedeemError}
+  | CENameError {nameError :: NameError}
   | CEServerProtocol {serverProtocol :: AProtocolType}
   | CEAgentCommandError {message :: String}
   | CEInvalidFileDescription {message :: String}
@@ -1850,6 +1896,14 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "SDE") ''SimplexDomainError)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "BRE") ''BadgeRedeemError)
 
+$(JQ.deriveJSON defaultJSON ''NameLinks)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "NPS") ''NamePurchaseStatus)
+
+$(JQ.deriveJSON defaultJSON ''NameState)
+
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "NE") ''NameError)
+
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CE") ''ChatErrorType)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RHE") ''RemoteHostError)