diff --git a/src/Simplex/Chat/Badges/Service.hs b/src/Simplex/Chat/Badges/Service.hs index d876dbb059..866f5b7762 100644 --- a/src/Simplex/Chat/Badges/Service.hs +++ b/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) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 6b25452aba..e8c9e6bfc4 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/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)