dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-07-09 10:11:42 +00:00
Code Issues Packages Projects Releases Wiki Activity

update types

Browse Source
This commit is contained in:
Evgeny @ SimpleX Chat
2026-05-31 08:05:25 +00:00
parent 9927123786
commit a8762e576f
2 changed files with 116 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
plans/2026-05-30-service-framework.md
+45 -57
View File
@@ -33,7 +33,7 @@ Send errors: `sendDirectContactMessage` can throw synchronous errors (contact no
### Badge service: custom APIs with persistence
Badge does NOT use `APICallService`. It has its own commands (`APIIssueBadge`, `APIRenewBadge`, `APIRedeemBadge`, `APIBadgeStripeLink`) that use the same underlying plumbing (send message to service contact, receive reply via Subscriber) but add persistence:
Badge does NOT use `APICallService`. It has its own commands (`APIIssueBadge`, `APIRedeemBadge`, `APIBadgeStripeLink`) that use the same underlying plumbing (send message to service contact, receive reply via Subscriber) but add persistence:
- Before sending, persist `(ms, receipt, status=pending)` in DB
- If response arrives after timeout or restart, Subscriber matches it to pending request, stores credential, notifies UI via event
@@ -45,36 +45,32 @@ Badge does NOT use `APICallService`. It has its own commands (`APIIssueBadge`, `
### Haskell
Per-service types are plain ADTs in their own modules:
Per-service command and response types are plain ADTs:
```haskell
-- Simplex.Chat.Service.Badge
data BadgeCommand
= BCIssue ByteString ByteString -- ms receipt (Apple/Google)
| BCRenew ByteString ByteString -- ms receipt
| BCRedeem Text -- redemption code
| BCStripeLink ByteString -- ms -> returns checkout URL
= BCIssue Text Text -- ms receipt (Apple/Google/Stripe)
| BCRedeem Text -- redemption code
| BCStripeLink Text -- ms, returns checkout URL
data BadgeResponse
= BRCredential ByteString UTCTime Int -- signature expiry level
| BRStripeLink Text -- checkout URL
= BRCredential Text UTCTime Int -- signature expiry level
| BRStripeLink Text -- checkout URL
| BRError Text
-- Simplex.Chat.Service.Directory
data DirectoryCommand = DCSearch Text
data DirectoryResponse = DRResult [GroupInfo]
data DirectoryResponse = DRResult [Text]
-- Simplex.Chat.Service.Names
data NamesCommand = NCResolve SimplexNameInfo
data NamesCommand = NCResolve Text
data NamesResponse
= NRResolved AConnectionLink
= NRResolved Text
| NRNotFound
| NRError Text
```
Top-level GADT wraps per-service types with the type tag:
GADT wraps per-service types with the type tag:
```haskell
data ServiceCommand (s :: ServiceType) where
@@ -89,62 +85,42 @@ data ServiceResponse (s :: ServiceType) where
data AServiceCommand = forall s. ServiceTypeI s => ASC (SServiceType s) (ServiceCommand s)
data AServiceResponse = forall s. ServiceTypeI s => ASR (SServiceType s) (ServiceResponse s)
```
-- ChatCommand (Controller.hs ~line 480)
Chat API:
```haskell
-- ChatCommand
| APICallService UserId AServiceCommand
-- ChatResponse (Controller.hs ~line 764)
-- ChatResponse
| CRServiceResponse User AServiceResponse
```
### Kotlin
### Serialization
```kotlin
// sealed class CC (SimpleXAPI.kt:3643)
class APICallService(val userId: Long, val serviceType: ServiceType, val command: ServiceCmd): CC()
Two JSON representations for per-service response types:
// ServiceType enum
enum class ServiceType { BADGE, DIRECTORY, NAMES }
// ServiceCmd sealed per service type
sealed class ServiceCmd {
sealed class Badge : ServiceCmd() {
class Issue(val ms: String, val receipt: String) : Badge()
class Renew(val ms: String, val receipt: String) : Badge()
class Redeem(val code: String) : Badge()
class StripeLink(val ms: String) : Badge()
}
sealed class Names : ServiceCmd() {
class Resolve(val nameInfo: SimplexNameInfo) : Names()
}
}
// sealed class CR (SimpleXAPI.kt:6347)
@Serializable @SerialName("serviceResponse")
class CRServiceResponse(val user: UserLike, val serviceType: ServiceType, val response: ServiceResp): CR()
```
### Command string format
`/_service badge /issue <base64_ms> <base64_receipt>`
Parser in Commands.hs extracts service type, dispatches to per-service parser:
**Platform-specific** (chat API, `CRServiceResponse` → Kotlin/Swift): uses `sumTypeJSON` which is `TaggedObject` on Kotlin (`{"type": "credential", ...}`) and `ObjectWithSingleField` + `_owsf` tag on iOS. Derived via TH:
```haskell
"/_service " *> do
serviceType_ <* A.space >>= \case
SSTBadge -> ASC SSTBadge <$> badgeCommandP
SSTDirectory -> ASC SSTDirectory <$> directoryCommandP
SSTNames -> ASC SSTNames <$> namesCommandP
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "BR") ''BadgeResponse)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "DR") ''DirectoryResponse)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "NR") ''NamesResponse)
```
where `serviceType_` parses `"badge"` / `"directory"` / `"names"` into the singleton.
**Platform-independent** (wire YAML, messages between app and service bot): uses `singleFieldJSON` (`ObjectWithSingleField`, no `_owsf` tag). Single-key discriminated union. Via `ServiceJSON` newtype:
### Wire format (messages between app and service bot)
```haskell
newtype ServiceJSON a = ServiceJSON {serviceJSON :: a}
Commands sent as text: `/<command> [args...]`
-- TH helper generates ToJSON/FromJSON for ServiceJSON a using singleFieldJSON
$(deriveServiceJSON (dropPrefix "BR") ''BadgeResponse)
$(deriveServiceJSON (dropPrefix "DR") ''DirectoryResponse)
$(deriveServiceJSON (dropPrefix "NR") ''NamesResponse)
```
Responses as YAML discriminated union (top-level key is the tag):
Wire YAML examples:
```yaml
credential:
@@ -164,7 +140,19 @@ error:
message: This receipt has already been redeemed
```
Correlation: service responds with reply-to referencing the command message.
`AServiceResponse` has manual `ToJSON`/`FromJSON` instances for the chat API (wrapping the service type tag + platform-specific response JSON).
Commands are parsed from strings (attoparsec), not JSON. No JSON instances for command types.
### Command string format
`/_service badge /issue <base64_ms> <base64_receipt>`
Parser dispatches on service type, then to per-service command parser.
### Correlation
Service responds with reply-to referencing the command message (`quotedSharedMsgId`).
## Service contacts
src/Simplex/Chat/Service.hs
+71 -55
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
@@ -13,11 +13,13 @@ module Simplex.Chat.Service where
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson as J
import qualified Data.Aeson.TH as JQ
import qualified Data.Aeson.Types as JT
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Type.Equality
import Simplex.Messaging.Agent.Protocol (AConnectionLink)
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, sumTypeJSON)
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, singleFieldJSON, sumTypeJSON)
-- Service type
data ServiceType = STBadge | STDirectory | STNames
deriving (Eq, Ord, Show)
@@ -45,7 +47,21 @@ instance ServiceTypeI 'STDirectory where sServiceType = SSTDirectory
instance ServiceTypeI 'STNames where sServiceType = SSTNames
-- Badge
toServiceType :: SServiceType s -> ServiceType
toServiceType = \case
SSTBadge -> STBadge
SSTDirectory -> STDirectory
SSTNames -> STNames
aServiceType :: ServiceType -> AServiceType
aServiceType = \case
STBadge -> AST SSTBadge
STDirectory -> AST SSTDirectory
STNames -> AST SSTNames
data AServiceType = forall s. ServiceTypeI s => AST (SServiceType s)
-- Per-service command types
data BadgeCommand
= BCIssue Text Text
@@ -53,27 +69,25 @@ data BadgeCommand
| BCStripeLink Text
deriving (Show)
data DirectoryCommand = DCSearch Text
deriving (Show)
data NamesCommand = NCResolve Text
deriving (Show)
-- Per-service response types
data BadgeResponse
= BRCredential Text UTCTime Int
| BRStripeLink Text
| BRError Text
deriving (Show)
-- Directory
data DirectoryCommand = DCSearch Text
deriving (Show)
data DirectoryResponse = DRResult [Text]
deriving (Show)
-- Names
data NamesCommand = NCResolve Text
deriving (Show)
data NamesResponse
= NRResolved AConnectionLink
= NRResolved Text
| NRNotFound
| NRError Text
deriving (Show)
@@ -104,56 +118,58 @@ data AServiceResponse = forall s. ServiceTypeI s => ASR (SServiceType s) (Servic
deriving instance Show AServiceResponse
-- Platform JSON for per-service response types (for chat API -> Kotlin/Swift)
$(JQ.deriveJSON (enumJSON $ dropPrefix "ST") ''ServiceType)
instance ToJSON (SServiceType s) where
toJSON = toJSON . serviceType
where
serviceType :: SServiceType s -> ServiceType
serviceType SSTBadge = STBadge
serviceType SSTDirectory = STDirectory
serviceType SSTNames = STNames
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "BC") ''BadgeCommand)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "BR") ''BadgeResponse)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "DC") ''DirectoryCommand)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "DR") ''DirectoryResponse)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "NC") ''NamesCommand)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "NR") ''NamesResponse)
instance ToJSON AServiceCommand where
toJSON (ASC sst cmd) = J.object ["serviceType" J..= sst, "command" J..= cmdJSON sst cmd]
where
cmdJSON :: SServiceType s -> ServiceCommand s -> J.Value
cmdJSON SSTBadge (SCBadge c) = toJSON c
cmdJSON SSTDirectory (SCDirectory c) = toJSON c
cmdJSON SSTNames (SCNames c) = toJSON c
instance ToJSON (SServiceType s) where
toJSON = J.toJSON . toServiceType
toEncoding = J.toEncoding . toServiceType
instance ToJSON AServiceResponse where
toJSON (ASR sst resp) = J.object ["serviceType" J..= sst, "response" J..= respJSON sst resp]
where
respJSON :: SServiceType s -> ServiceResponse s -> J.Value
respJSON SSTBadge (SRBadge r) = toJSON r
respJSON SSTDirectory (SRDirectory r) = toJSON r
respJSON SSTNames (SRNames r) = toJSON r
instance FromJSON AServiceCommand where
parseJSON = J.withObject "AServiceCommand" $ \o -> do
sType <- o J..: "serviceType"
case (sType :: ServiceType) of
STBadge -> ASC SSTBadge . SCBadge <$> o J..: "command"
STDirectory -> ASC SSTDirectory . SCDirectory <$> o J..: "command"
STNames -> ASC SSTNames . SCNames <$> o J..: "command"
toJSON (ASR sst resp) = J.object ["type" J..= sst, "response" J..= respJSON sst resp]
toEncoding (ASR sst resp) = J.pairs ("type" J..= sst <> "response" J..= respJSON sst resp)
instance FromJSON AServiceResponse where
parseJSON = J.withObject "AServiceResponse" $ \o -> do
sType <- o J..: "serviceType"
case (sType :: ServiceType) of
STBadge -> ASR SSTBadge . SRBadge <$> o J..: "response"
STDirectory -> ASR SSTDirectory . SRDirectory <$> o J..: "response"
STNames -> ASR SSTNames . SRNames <$> o J..: "response"
sType <- o J..: "type"
case aServiceType sType of
AST SSTBadge -> ASR SSTBadge . SRBadge <$> o J..: "response"
AST SSTDirectory -> ASR SSTDirectory . SRDirectory <$> o J..: "response"
AST SSTNames -> ASR SSTNames . SRNames <$> o J..: "response"
respJSON :: SServiceType s -> ServiceResponse s -> J.Value
respJSON SSTBadge (SRBadge r) = toJSON r
respJSON SSTDirectory (SRDirectory r) = toJSON r
respJSON SSTNames (SRNames r) = toJSON r
-- Wire YAML for service bot messages (platform-independent, singleFieldJSON)
newtype ServiceJSON a = ServiceJSON {serviceJSON :: a}
instance ToJSON (ServiceJSON BadgeResponse) where
toJSON (ServiceJSON r) = $(JQ.mkToJSON (singleFieldJSON $ dropPrefix "BR") ''BadgeResponse) r
toEncoding (ServiceJSON r) = $(JQ.mkToEncoding (singleFieldJSON $ dropPrefix "BR") ''BadgeResponse) r
instance FromJSON (ServiceJSON BadgeResponse) where
parseJSON v = ServiceJSON <$> $(JQ.mkParseJSON (singleFieldJSON $ dropPrefix "BR") ''BadgeResponse) v
instance ToJSON (ServiceJSON DirectoryResponse) where
toJSON (ServiceJSON r) = $(JQ.mkToJSON (singleFieldJSON $ dropPrefix "DR") ''DirectoryResponse) r
toEncoding (ServiceJSON r) = $(JQ.mkToEncoding (singleFieldJSON $ dropPrefix "DR") ''DirectoryResponse) r
instance FromJSON (ServiceJSON DirectoryResponse) where
parseJSON v = ServiceJSON <$> $(JQ.mkParseJSON (singleFieldJSON $ dropPrefix "DR") ''DirectoryResponse) v
instance ToJSON (ServiceJSON NamesResponse) where
toJSON (ServiceJSON r) = $(JQ.mkToJSON (singleFieldJSON $ dropPrefix "NR") ''NamesResponse) r
toEncoding (ServiceJSON r) = $(JQ.mkToEncoding (singleFieldJSON $ dropPrefix "NR") ''NamesResponse) r
instance FromJSON (ServiceJSON NamesResponse) where
parseJSON v = ServiceJSON <$> $(JQ.mkParseJSON (singleFieldJSON $ dropPrefix "NR") ''NamesResponse) v