mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 20:29:53 +00:00
core: webrtc calls api types (#590)
* core: webrtc calls api * call: call state, chat items, update commands/responses * update sequence diagram * remove CRCallInvitationSent, add CISCallError
This commit is contained in:
parent
f78ec3584f
commit
cdb919db96
8 changed files with 357 additions and 4 deletions
67
docs/rfcs/webrtc.mmd
Normal file
67
docs/rfcs/webrtc.mmd
Normal file
|
@ -0,0 +1,67 @@
|
||||||
|
sequenceDiagram
|
||||||
|
participant AW as Alice's<br>web view
|
||||||
|
participant AN as Alice's<br>app native
|
||||||
|
participant AC as Alice's<br>chat core
|
||||||
|
participant BC as Bob's<br>chat core
|
||||||
|
participant BN as Bob's<br>app native
|
||||||
|
participant BW as Bob's<br>web view
|
||||||
|
|
||||||
|
note over AW, AC: Alice's app
|
||||||
|
note over BC, BW: Bob's app
|
||||||
|
|
||||||
|
note over AW, BW: 1. Establishing call
|
||||||
|
|
||||||
|
note over AN: user: start call
|
||||||
|
AN ->> AW: WCCapabilities
|
||||||
|
AW ->> AN: WRCapabilities (e2e?)
|
||||||
|
|
||||||
|
AN ->> AC: APISendCallInvitation
|
||||||
|
AC -->> BC: XCallInv
|
||||||
|
AC ->> AN: CRCmdOk
|
||||||
|
|
||||||
|
BC ->> BN: CRCallInvitation
|
||||||
|
note over BN: show: accept call?
|
||||||
|
|
||||||
|
alt user accepted?
|
||||||
|
BN ->> BC: no: APIRejectCall<br>(sender not notified)
|
||||||
|
BC ->> BN: CRCmdOk
|
||||||
|
else
|
||||||
|
BN ->> BW: yes: WCStartCall
|
||||||
|
BW ->> BN: WCallOffer
|
||||||
|
end
|
||||||
|
|
||||||
|
BN ->> BC: APISendCallOffer
|
||||||
|
BC -->> AC: XCallOffer
|
||||||
|
BC ->> BN: CRCmdOk
|
||||||
|
AC ->> AN: CRCallOffer
|
||||||
|
note over AN: show if no e2e: continue call?
|
||||||
|
|
||||||
|
AN ->> AW: WCallOffer
|
||||||
|
AW ->> AN: WCallAnswer
|
||||||
|
AN ->> AC: APISendCallAnswer
|
||||||
|
AC -->> BC: XCallAnswer
|
||||||
|
AC ->> AN: CRCmdOk
|
||||||
|
BC ->> BN: CRCallAnswer
|
||||||
|
BN ->> BW: WCallAnswer
|
||||||
|
|
||||||
|
note over AW, BW: call can be established at this point
|
||||||
|
|
||||||
|
note over AW, BW: 2. Sending additional ice candidates<br>(optional, same for another side):
|
||||||
|
|
||||||
|
BW ->> BN: WCallICE
|
||||||
|
BN ->> BC: APISendCallExtraInfo
|
||||||
|
BC -->> AC: XCallExtra
|
||||||
|
BC ->> BN: CRCmdOk
|
||||||
|
AC ->> AN: CRCallExtraInfo
|
||||||
|
AN ->> AW: WCallICE
|
||||||
|
|
||||||
|
note over AW, BW: 3. Call termination (same for another party):
|
||||||
|
|
||||||
|
note over AN: user: end call
|
||||||
|
AN ->> AW: WEndCall
|
||||||
|
AN ->> AC: APIEndCall
|
||||||
|
AC -->> BC: XCallEnd
|
||||||
|
AC ->> AN: CRCmdOk
|
||||||
|
BC ->> BN: CRCallEnded
|
||||||
|
note over BN: show: call ended
|
||||||
|
BN ->> BW: WEndCall
|
|
@ -21,6 +21,7 @@ library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Simplex.Chat
|
Simplex.Chat
|
||||||
Simplex.Chat.Bot
|
Simplex.Chat.Bot
|
||||||
|
Simplex.Chat.Call
|
||||||
Simplex.Chat.Controller
|
Simplex.Chat.Controller
|
||||||
Simplex.Chat.Core
|
Simplex.Chat.Core
|
||||||
Simplex.Chat.Help
|
Simplex.Chat.Help
|
||||||
|
|
|
@ -123,8 +123,9 @@ newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize} Ch
|
||||||
chatLock <- newTMVarIO ()
|
chatLock <- newTMVarIO ()
|
||||||
sndFiles <- newTVarIO M.empty
|
sndFiles <- newTVarIO M.empty
|
||||||
rcvFiles <- newTVarIO M.empty
|
rcvFiles <- newTVarIO M.empty
|
||||||
|
currentCall <- newTVarIO Nothing
|
||||||
filesFolder <- newTVarIO Nothing
|
filesFolder <- newTVarIO Nothing
|
||||||
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, config, sendNotification, filesFolder}
|
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCall, config, sendNotification, filesFolder}
|
||||||
where
|
where
|
||||||
resolveServers :: IO (NonEmpty SMPServer)
|
resolveServers :: IO (NonEmpty SMPServer)
|
||||||
resolveServers = case user of
|
resolveServers = case user of
|
||||||
|
@ -388,6 +389,12 @@ processChatCommand = \case
|
||||||
`E.finally` deleteContactRequest st userId connReqId
|
`E.finally` deleteContactRequest st userId connReqId
|
||||||
withAgent $ \a -> rejectContact a connId invId
|
withAgent $ \a -> rejectContact a connId invId
|
||||||
pure $ CRContactRequestRejected cReq
|
pure $ CRContactRequestRejected cReq
|
||||||
|
APISendCallInvitation _contactId _callType -> pure $ chatCmdError "not implemented"
|
||||||
|
APIRejectCall _contactId -> pure $ chatCmdError "not implemented"
|
||||||
|
APISendCallOffer _contactId _wCallOffer -> pure $ chatCmdError "not implemented"
|
||||||
|
APISendCallAnswer _contactId _rtcSession -> pure $ chatCmdError "not implemented"
|
||||||
|
APISendCallExtraInfo _contactId _rtcExtraInfo -> pure $ chatCmdError "not implemented"
|
||||||
|
APIEndCall _contactId -> pure $ chatCmdError "not implemented"
|
||||||
APIUpdateProfile profile -> withUser (`updateProfile` profile)
|
APIUpdateProfile profile -> withUser (`updateProfile` profile)
|
||||||
APIParseMarkdown text -> pure . CRApiParsedMarkdown $ parseMaybeMarkdownList text
|
APIParseMarkdown text -> pure . CRApiParsedMarkdown $ parseMaybeMarkdownList text
|
||||||
APIRegisterToken token -> CRNtfTokenStatus <$> withUser (\_ -> withAgent (`registerNtfToken` token))
|
APIRegisterToken token -> CRNtfTokenStatus <$> withUser (\_ -> withAgent (`registerNtfToken` token))
|
||||||
|
@ -1881,6 +1888,12 @@ chatCommandP =
|
||||||
<|> "/_delete " *> (APIDeleteChat <$> chatRefP)
|
<|> "/_delete " *> (APIDeleteChat <$> chatRefP)
|
||||||
<|> "/_accept " *> (APIAcceptContact <$> A.decimal)
|
<|> "/_accept " *> (APIAcceptContact <$> A.decimal)
|
||||||
<|> "/_reject " *> (APIRejectContact <$> A.decimal)
|
<|> "/_reject " *> (APIRejectContact <$> A.decimal)
|
||||||
|
<|> "/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP)
|
||||||
|
<|> "/_call reject @" *> (APIRejectCall <$> A.decimal)
|
||||||
|
<|> "/_call offer @" *> (APISendCallOffer <$> A.decimal <* A.space <*> jsonP)
|
||||||
|
<|> "/_call answer @" *> (APISendCallAnswer <$> A.decimal <* A.space <*> jsonP)
|
||||||
|
<|> "/_call extra @" *> (APISendCallExtraInfo <$> A.decimal <* A.space <*> jsonP)
|
||||||
|
<|> "/_call end @" *> (APIEndCall <$> A.decimal)
|
||||||
<|> "/_profile " *> (APIUpdateProfile <$> jsonP)
|
<|> "/_profile " *> (APIUpdateProfile <$> jsonP)
|
||||||
<|> "/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString)
|
<|> "/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString)
|
||||||
<|> "/_ntf register " *> (APIRegisterToken <$> tokenP)
|
<|> "/_ntf register " *> (APIRegisterToken <$> tokenP)
|
||||||
|
|
170
src/Simplex/Chat/Call.hs
Normal file
170
src/Simplex/Chat/Call.hs
Normal file
|
@ -0,0 +1,170 @@
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE DeriveAnyClass #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Simplex.Chat.Call where
|
||||||
|
|
||||||
|
import Data.Aeson (FromJSON, ToJSON)
|
||||||
|
import qualified Data.Aeson as J
|
||||||
|
import Data.ByteString.Char8 (ByteString)
|
||||||
|
import Data.Int (Int64)
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import qualified Simplex.Messaging.Crypto as C
|
||||||
|
import Simplex.Messaging.Encoding.String
|
||||||
|
import Simplex.Messaging.Parsers (dropPrefix, enumJSON)
|
||||||
|
|
||||||
|
data Call = Call
|
||||||
|
{ contactId :: Int64,
|
||||||
|
callId :: CallId,
|
||||||
|
chatItemId :: Int64,
|
||||||
|
callState :: CallState
|
||||||
|
}
|
||||||
|
|
||||||
|
data CallState
|
||||||
|
= CallInvitationSent
|
||||||
|
{ localCallType :: CallType,
|
||||||
|
localDhPrivKey :: Maybe C.PrivateKeyX25519
|
||||||
|
}
|
||||||
|
| CallInvitationReceived
|
||||||
|
{ peerCallType :: CallType,
|
||||||
|
localDhPubKey :: Maybe C.PublicKeyX25519,
|
||||||
|
sharedKey :: Maybe C.Key
|
||||||
|
}
|
||||||
|
| CallOfferSent
|
||||||
|
{ localCallType :: CallType,
|
||||||
|
peerCallType :: CallType,
|
||||||
|
localCallSession :: WebRTCSession,
|
||||||
|
sharedKey :: Maybe C.Key
|
||||||
|
}
|
||||||
|
| CallOfferReceived
|
||||||
|
{ localCallType :: CallType,
|
||||||
|
peerCallType :: CallType,
|
||||||
|
peerCallSession :: WebRTCSession,
|
||||||
|
sharedKey :: Maybe C.Key
|
||||||
|
}
|
||||||
|
| CallNegotiated
|
||||||
|
{ localCallType :: CallType,
|
||||||
|
peerCallType :: CallType,
|
||||||
|
localCallSession :: WebRTCSession,
|
||||||
|
peerCallSession :: WebRTCSession,
|
||||||
|
sharedKey :: Maybe C.Key
|
||||||
|
}
|
||||||
|
|
||||||
|
newtype CallId = CallId ByteString
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance StrEncoding CallId where
|
||||||
|
strEncode (CallId m) = strEncode m
|
||||||
|
strDecode s = CallId <$> strDecode s
|
||||||
|
strP = CallId <$> strP
|
||||||
|
|
||||||
|
instance FromJSON CallId where
|
||||||
|
parseJSON = strParseJSON "CallId"
|
||||||
|
|
||||||
|
instance ToJSON CallId where
|
||||||
|
toJSON = strToJSON
|
||||||
|
toEncoding = strToJEncoding
|
||||||
|
|
||||||
|
data CallType = CallType
|
||||||
|
{ media :: CallMedia,
|
||||||
|
capabilities :: CallCapabilities
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic, FromJSON)
|
||||||
|
|
||||||
|
instance ToJSON CallType where toEncoding = J.genericToEncoding J.defaultOptions
|
||||||
|
|
||||||
|
-- | * Types for chat protocol
|
||||||
|
data CallInvitation = CallInvitation
|
||||||
|
{ callType :: CallType,
|
||||||
|
callDhPubKey :: Maybe C.PublicKeyX25519
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
instance FromJSON CallInvitation where
|
||||||
|
parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
|
||||||
|
|
||||||
|
instance ToJSON CallInvitation where
|
||||||
|
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||||
|
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||||
|
|
||||||
|
data CallMedia = CMAudio | CMVideo
|
||||||
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
instance FromJSON CallMedia where
|
||||||
|
parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CM"
|
||||||
|
|
||||||
|
instance ToJSON CallMedia where
|
||||||
|
toJSON = J.genericToJSON . enumJSON $ dropPrefix "CM"
|
||||||
|
toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CM"
|
||||||
|
|
||||||
|
data CallCapabilities = CallCapabilities
|
||||||
|
{ encryption :: Bool
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic, FromJSON)
|
||||||
|
|
||||||
|
instance ToJSON CallCapabilities where
|
||||||
|
toJSON = J.genericToJSON J.defaultOptions
|
||||||
|
toEncoding = J.genericToEncoding J.defaultOptions
|
||||||
|
|
||||||
|
data CallOffer = CallOffer
|
||||||
|
{ callType :: CallType,
|
||||||
|
rtcSession :: WebRTCSession,
|
||||||
|
callDhPubKey :: Maybe C.PublicKeyX25519
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
instance FromJSON CallOffer where
|
||||||
|
parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
|
||||||
|
|
||||||
|
instance ToJSON CallOffer where
|
||||||
|
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||||
|
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||||
|
|
||||||
|
data WebRTCCallOffer = WebRTCCallOffer
|
||||||
|
{ callType :: CallType,
|
||||||
|
rtcSession :: WebRTCSession
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
instance FromJSON WebRTCCallOffer where
|
||||||
|
parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
|
||||||
|
|
||||||
|
data CallAnswer = CallAnswer
|
||||||
|
{ rtcSession :: WebRTCSession
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic, FromJSON)
|
||||||
|
|
||||||
|
instance ToJSON CallAnswer where
|
||||||
|
toJSON = J.genericToJSON J.defaultOptions
|
||||||
|
toEncoding = J.genericToEncoding J.defaultOptions
|
||||||
|
|
||||||
|
data CallExtraInfo = CallExtraInfo
|
||||||
|
{ rtcExtraInfo :: WebRTCExtraInfo
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic, FromJSON)
|
||||||
|
|
||||||
|
instance ToJSON CallExtraInfo where
|
||||||
|
toJSON = J.genericToJSON J.defaultOptions
|
||||||
|
toEncoding = J.genericToEncoding J.defaultOptions
|
||||||
|
|
||||||
|
data WebRTCSession = WebRTCSession
|
||||||
|
{ rtcSession :: J.Value,
|
||||||
|
rtcIceCandidates :: [J.Value]
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic, FromJSON)
|
||||||
|
|
||||||
|
instance ToJSON WebRTCSession where
|
||||||
|
toJSON = J.genericToJSON J.defaultOptions
|
||||||
|
toEncoding = J.genericToEncoding J.defaultOptions
|
||||||
|
|
||||||
|
data WebRTCExtraInfo = WebRTCExtraInfo
|
||||||
|
{ rtcIceCandidates :: [J.Value]
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic, FromJSON)
|
||||||
|
|
||||||
|
instance ToJSON WebRTCExtraInfo where
|
||||||
|
toJSON = J.genericToJSON J.defaultOptions
|
||||||
|
toEncoding = J.genericToEncoding J.defaultOptions
|
|
@ -26,6 +26,7 @@ import Data.Word (Word16)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Numeric.Natural
|
import Numeric.Natural
|
||||||
import qualified Paths_simplex_chat as SC
|
import qualified Paths_simplex_chat as SC
|
||||||
|
import Simplex.Chat.Call
|
||||||
import Simplex.Chat.Markdown (MarkdownList)
|
import Simplex.Chat.Markdown (MarkdownList)
|
||||||
import Simplex.Chat.Messages
|
import Simplex.Chat.Messages
|
||||||
import Simplex.Chat.Protocol
|
import Simplex.Chat.Protocol
|
||||||
|
@ -80,6 +81,7 @@ data ChatController = ChatController
|
||||||
chatLock :: TMVar (),
|
chatLock :: TMVar (),
|
||||||
sndFiles :: TVar (Map Int64 Handle),
|
sndFiles :: TVar (Map Int64 Handle),
|
||||||
rcvFiles :: TVar (Map Int64 Handle),
|
rcvFiles :: TVar (Map Int64 Handle),
|
||||||
|
currentCall :: TVar (Maybe Call),
|
||||||
config :: ChatConfig,
|
config :: ChatConfig,
|
||||||
filesFolder :: TVar (Maybe FilePath) -- path to files folder for mobile apps
|
filesFolder :: TVar (Maybe FilePath) -- path to files folder for mobile apps
|
||||||
}
|
}
|
||||||
|
@ -108,6 +110,12 @@ data ChatCommand
|
||||||
| APIDeleteChat ChatRef
|
| APIDeleteChat ChatRef
|
||||||
| APIAcceptContact Int64
|
| APIAcceptContact Int64
|
||||||
| APIRejectContact Int64
|
| APIRejectContact Int64
|
||||||
|
| APISendCallInvitation Int64 CallType
|
||||||
|
| APIRejectCall Int64
|
||||||
|
| APISendCallOffer Int64 WebRTCCallOffer
|
||||||
|
| APISendCallAnswer Int64 WebRTCSession
|
||||||
|
| APISendCallExtraInfo Int64 WebRTCExtraInfo
|
||||||
|
| APIEndCall Int64
|
||||||
| APIUpdateProfile Profile
|
| APIUpdateProfile Profile
|
||||||
| APIParseMarkdown Text
|
| APIParseMarkdown Text
|
||||||
| APIRegisterToken DeviceToken
|
| APIRegisterToken DeviceToken
|
||||||
|
@ -240,6 +248,11 @@ data ChatResponse
|
||||||
| CRPendingSubSummary {pendingSubStatus :: [PendingSubStatus]}
|
| CRPendingSubSummary {pendingSubStatus :: [PendingSubStatus]}
|
||||||
| CRSndFileSubError {sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
|
| CRSndFileSubError {sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
|
||||||
| CRRcvFileSubError {rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
|
| CRRcvFileSubError {rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
|
||||||
|
| CRCallInvitation {contact :: Contact, callType :: CallType, encryptionKey :: Maybe C.Key}
|
||||||
|
| CRCallOffer {contact :: Contact, callType :: CallType, offer :: WebRTCSession, encryptionKey :: Maybe C.Key, askConfirmation :: Bool}
|
||||||
|
| CRCallAnswer {contact :: Contact, answer :: WebRTCSession}
|
||||||
|
| CRCallExtraInfo {contact :: Contact, extraInfo :: WebRTCExtraInfo}
|
||||||
|
| CRCallEnded {contact :: Contact}
|
||||||
| CRUserContactLinkSubscribed
|
| CRUserContactLinkSubscribed
|
||||||
| CRUserContactLinkSubError {chatError :: ChatError}
|
| CRUserContactLinkSubError {chatError :: ChatError}
|
||||||
| CRNtfTokenStatus {status :: NtfTknStatus}
|
| CRNtfTokenStatus {status :: NtfTknStatus}
|
||||||
|
|
|
@ -20,6 +20,7 @@ import qualified Data.ByteString.Base64 as B64
|
||||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||||
import Data.Int (Int64)
|
import Data.Int (Int64)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text as T
|
||||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||||
import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay)
|
import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay)
|
||||||
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime)
|
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime)
|
||||||
|
@ -439,6 +440,8 @@ data CIContent (d :: MsgDirection) where
|
||||||
CIRcvMsgContent :: MsgContent -> CIContent 'MDRcv
|
CIRcvMsgContent :: MsgContent -> CIContent 'MDRcv
|
||||||
CISndDeleted :: CIDeleteMode -> CIContent 'MDSnd
|
CISndDeleted :: CIDeleteMode -> CIContent 'MDSnd
|
||||||
CIRcvDeleted :: CIDeleteMode -> CIContent 'MDRcv
|
CIRcvDeleted :: CIDeleteMode -> CIContent 'MDRcv
|
||||||
|
CISndCall :: CICallStatus -> Int -> CIContent 'MDSnd
|
||||||
|
CIRcvCall :: CICallStatus -> Int -> CIContent 'MDRcv
|
||||||
|
|
||||||
deriving instance Show (CIContent d)
|
deriving instance Show (CIContent d)
|
||||||
|
|
||||||
|
@ -448,6 +451,8 @@ ciContentToText = \case
|
||||||
CIRcvMsgContent mc -> msgContentText mc
|
CIRcvMsgContent mc -> msgContentText mc
|
||||||
CISndDeleted cidm -> ciDeleteModeToText cidm
|
CISndDeleted cidm -> ciDeleteModeToText cidm
|
||||||
CIRcvDeleted cidm -> ciDeleteModeToText cidm
|
CIRcvDeleted cidm -> ciDeleteModeToText cidm
|
||||||
|
CISndCall status duration -> "outgoing call: " <> ciCallInfoText status duration
|
||||||
|
CIRcvCall status duration -> "incoming call: " <> ciCallInfoText status duration
|
||||||
|
|
||||||
msgDirToDeletedContent_ :: SMsgDirection d -> CIDeleteMode -> CIContent d
|
msgDirToDeletedContent_ :: SMsgDirection d -> CIDeleteMode -> CIContent d
|
||||||
msgDirToDeletedContent_ msgDir mode = case msgDir of
|
msgDirToDeletedContent_ msgDir mode = case msgDir of
|
||||||
|
@ -480,6 +485,8 @@ data JSONCIContent
|
||||||
| JCIRcvMsgContent {msgContent :: MsgContent}
|
| JCIRcvMsgContent {msgContent :: MsgContent}
|
||||||
| JCISndDeleted {deleteMode :: CIDeleteMode}
|
| JCISndDeleted {deleteMode :: CIDeleteMode}
|
||||||
| JCIRcvDeleted {deleteMode :: CIDeleteMode}
|
| JCIRcvDeleted {deleteMode :: CIDeleteMode}
|
||||||
|
| JCISndCall {status :: CICallStatus, duration :: Int} -- duration in seconds
|
||||||
|
| JCIRcvCall {status :: CICallStatus, duration :: Int}
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
instance FromJSON JSONCIContent where
|
instance FromJSON JSONCIContent where
|
||||||
|
@ -495,6 +502,8 @@ jsonCIContent = \case
|
||||||
CIRcvMsgContent mc -> JCIRcvMsgContent mc
|
CIRcvMsgContent mc -> JCIRcvMsgContent mc
|
||||||
CISndDeleted cidm -> JCISndDeleted cidm
|
CISndDeleted cidm -> JCISndDeleted cidm
|
||||||
CIRcvDeleted cidm -> JCIRcvDeleted cidm
|
CIRcvDeleted cidm -> JCIRcvDeleted cidm
|
||||||
|
CISndCall status duration -> JCISndCall {status, duration}
|
||||||
|
CIRcvCall status duration -> JCIRcvCall {status, duration}
|
||||||
|
|
||||||
aciContentJSON :: JSONCIContent -> ACIContent
|
aciContentJSON :: JSONCIContent -> ACIContent
|
||||||
aciContentJSON = \case
|
aciContentJSON = \case
|
||||||
|
@ -502,6 +511,8 @@ aciContentJSON = \case
|
||||||
JCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc
|
JCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc
|
||||||
JCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm
|
JCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm
|
||||||
JCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm
|
JCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm
|
||||||
|
JCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration
|
||||||
|
JCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration
|
||||||
|
|
||||||
-- platform independent
|
-- platform independent
|
||||||
data DBJSONCIContent
|
data DBJSONCIContent
|
||||||
|
@ -509,6 +520,8 @@ data DBJSONCIContent
|
||||||
| DBJCIRcvMsgContent {msgContent :: MsgContent}
|
| DBJCIRcvMsgContent {msgContent :: MsgContent}
|
||||||
| DBJCISndDeleted {deleteMode :: CIDeleteMode}
|
| DBJCISndDeleted {deleteMode :: CIDeleteMode}
|
||||||
| DBJCIRcvDeleted {deleteMode :: CIDeleteMode}
|
| DBJCIRcvDeleted {deleteMode :: CIDeleteMode}
|
||||||
|
| DBJCISndCall {status :: CICallStatus, duration :: Int}
|
||||||
|
| DBJCIRcvCall {status :: CICallStatus, duration :: Int}
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
instance FromJSON DBJSONCIContent where
|
instance FromJSON DBJSONCIContent where
|
||||||
|
@ -524,6 +537,8 @@ dbJsonCIContent = \case
|
||||||
CIRcvMsgContent mc -> DBJCIRcvMsgContent mc
|
CIRcvMsgContent mc -> DBJCIRcvMsgContent mc
|
||||||
CISndDeleted cidm -> DBJCISndDeleted cidm
|
CISndDeleted cidm -> DBJCISndDeleted cidm
|
||||||
CIRcvDeleted cidm -> DBJCIRcvDeleted cidm
|
CIRcvDeleted cidm -> DBJCIRcvDeleted cidm
|
||||||
|
CISndCall status duration -> DBJCISndCall {status, duration}
|
||||||
|
CIRcvCall status duration -> DBJCIRcvCall {status, duration}
|
||||||
|
|
||||||
aciContentDBJSON :: DBJSONCIContent -> ACIContent
|
aciContentDBJSON :: DBJSONCIContent -> ACIContent
|
||||||
aciContentDBJSON = \case
|
aciContentDBJSON = \case
|
||||||
|
@ -531,6 +546,35 @@ aciContentDBJSON = \case
|
||||||
DBJCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc
|
DBJCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc
|
||||||
DBJCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm
|
DBJCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm
|
||||||
DBJCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm
|
DBJCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm
|
||||||
|
DBJCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration
|
||||||
|
DBJCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration
|
||||||
|
|
||||||
|
data CICallStatus
|
||||||
|
= CISCallPending
|
||||||
|
| CISCallMissed
|
||||||
|
| CISCallRejected -- only possible for received calls, not on type level
|
||||||
|
| CISCallProgress
|
||||||
|
| CISCallEnded
|
||||||
|
| CISCallError
|
||||||
|
deriving (Show, Generic)
|
||||||
|
|
||||||
|
instance FromJSON CICallStatus where
|
||||||
|
parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CISCall"
|
||||||
|
|
||||||
|
instance ToJSON CICallStatus where
|
||||||
|
toJSON = J.genericToJSON . enumJSON $ dropPrefix "CISCall"
|
||||||
|
toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CISCall"
|
||||||
|
|
||||||
|
ciCallInfoText :: CICallStatus -> Int -> Text
|
||||||
|
ciCallInfoText status duration = case status of
|
||||||
|
CISCallPending -> "calling..."
|
||||||
|
CISCallMissed -> "missed"
|
||||||
|
CISCallRejected -> "rejected"
|
||||||
|
CISCallProgress -> "in progress " <> d
|
||||||
|
CISCallEnded -> "ended " <> d
|
||||||
|
CISCallError -> "error"
|
||||||
|
where
|
||||||
|
d = let (mins, secs) = duration `divMod` 60 in T.pack $ "(" <> show mins <> ":" <> show secs <> ")"
|
||||||
|
|
||||||
data SChatType (c :: ChatType) where
|
data SChatType (c :: ChatType) where
|
||||||
SCTDirect :: SChatType 'CTDirect
|
SCTDirect :: SChatType 'CTDirect
|
||||||
|
@ -548,11 +592,11 @@ instance TestEquality SChatType where
|
||||||
testEquality _ _ = Nothing
|
testEquality _ _ = Nothing
|
||||||
|
|
||||||
class ChatTypeI (c :: ChatType) where
|
class ChatTypeI (c :: ChatType) where
|
||||||
chatType :: SChatType c
|
chatTypeI :: SChatType c
|
||||||
|
|
||||||
instance ChatTypeI 'CTDirect where chatType = SCTDirect
|
instance ChatTypeI 'CTDirect where chatTypeI = SCTDirect
|
||||||
|
|
||||||
instance ChatTypeI 'CTGroup where chatType = SCTGroup
|
instance ChatTypeI 'CTGroup where chatTypeI = SCTGroup
|
||||||
|
|
||||||
data NewMessage = NewMessage
|
data NewMessage = NewMessage
|
||||||
{ chatMsgEvent :: ChatMsgEvent,
|
{ chatMsgEvent :: ChatMsgEvent,
|
||||||
|
|
|
@ -29,6 +29,7 @@ import Data.Time.Clock (UTCTime)
|
||||||
import Database.SQLite.Simple.FromField (FromField (..))
|
import Database.SQLite.Simple.FromField (FromField (..))
|
||||||
import Database.SQLite.Simple.ToField (ToField (..))
|
import Database.SQLite.Simple.ToField (ToField (..))
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
|
import Simplex.Chat.Call
|
||||||
import Simplex.Chat.Types
|
import Simplex.Chat.Types
|
||||||
import Simplex.Chat.Util (eitherToMaybe, safeDecodeUtf8)
|
import Simplex.Chat.Util (eitherToMaybe, safeDecodeUtf8)
|
||||||
import Simplex.Messaging.Encoding.String
|
import Simplex.Messaging.Encoding.String
|
||||||
|
@ -132,6 +133,11 @@ data ChatMsgEvent
|
||||||
| XInfoProbe Probe
|
| XInfoProbe Probe
|
||||||
| XInfoProbeCheck ProbeHash
|
| XInfoProbeCheck ProbeHash
|
||||||
| XInfoProbeOk Probe
|
| XInfoProbeOk Probe
|
||||||
|
| XCallInv CallId CallInvitation
|
||||||
|
| XCallOffer CallId CallOffer
|
||||||
|
| XCallAnswer CallId CallAnswer
|
||||||
|
| XCallExtra CallId CallExtraInfo
|
||||||
|
| XCallEnd CallId
|
||||||
| XOk
|
| XOk
|
||||||
| XUnknown {event :: Text, params :: J.Object}
|
| XUnknown {event :: Text, params :: J.Object}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
@ -306,6 +312,11 @@ data CMEventTag
|
||||||
| XInfoProbe_
|
| XInfoProbe_
|
||||||
| XInfoProbeCheck_
|
| XInfoProbeCheck_
|
||||||
| XInfoProbeOk_
|
| XInfoProbeOk_
|
||||||
|
| XCallInv_
|
||||||
|
| XCallOffer_
|
||||||
|
| XCallAnswer_
|
||||||
|
| XCallExtra_
|
||||||
|
| XCallEnd_
|
||||||
| XOk_
|
| XOk_
|
||||||
| XUnknown_ Text
|
| XUnknown_ Text
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
@ -336,6 +347,11 @@ instance StrEncoding CMEventTag where
|
||||||
XInfoProbe_ -> "x.info.probe"
|
XInfoProbe_ -> "x.info.probe"
|
||||||
XInfoProbeCheck_ -> "x.info.probe.check"
|
XInfoProbeCheck_ -> "x.info.probe.check"
|
||||||
XInfoProbeOk_ -> "x.info.probe.ok"
|
XInfoProbeOk_ -> "x.info.probe.ok"
|
||||||
|
XCallInv_ -> "x.call.inv"
|
||||||
|
XCallOffer_ -> "x.call.offer"
|
||||||
|
XCallAnswer_ -> "x.call.answer"
|
||||||
|
XCallExtra_ -> "x.call.extra"
|
||||||
|
XCallEnd_ -> "x.call.end"
|
||||||
XOk_ -> "x.ok"
|
XOk_ -> "x.ok"
|
||||||
XUnknown_ t -> encodeUtf8 t
|
XUnknown_ t -> encodeUtf8 t
|
||||||
strDecode = \case
|
strDecode = \case
|
||||||
|
@ -363,6 +379,11 @@ instance StrEncoding CMEventTag where
|
||||||
"x.info.probe" -> Right XInfoProbe_
|
"x.info.probe" -> Right XInfoProbe_
|
||||||
"x.info.probe.check" -> Right XInfoProbeCheck_
|
"x.info.probe.check" -> Right XInfoProbeCheck_
|
||||||
"x.info.probe.ok" -> Right XInfoProbeOk_
|
"x.info.probe.ok" -> Right XInfoProbeOk_
|
||||||
|
"x.call.inv" -> Right XCallInv_
|
||||||
|
"x.call.offer" -> Right XCallOffer_
|
||||||
|
"x.call.answer" -> Right XCallAnswer_
|
||||||
|
"x.call.extra" -> Right XCallExtra_
|
||||||
|
"x.call.end" -> Right XCallEnd_
|
||||||
"x.ok" -> Right XOk_
|
"x.ok" -> Right XOk_
|
||||||
t -> Right . XUnknown_ $ safeDecodeUtf8 t
|
t -> Right . XUnknown_ $ safeDecodeUtf8 t
|
||||||
strP = strDecode <$?> A.takeTill (== ' ')
|
strP = strDecode <$?> A.takeTill (== ' ')
|
||||||
|
@ -393,6 +414,11 @@ toCMEventTag = \case
|
||||||
XInfoProbe _ -> XInfoProbe_
|
XInfoProbe _ -> XInfoProbe_
|
||||||
XInfoProbeCheck _ -> XInfoProbeCheck_
|
XInfoProbeCheck _ -> XInfoProbeCheck_
|
||||||
XInfoProbeOk _ -> XInfoProbeOk_
|
XInfoProbeOk _ -> XInfoProbeOk_
|
||||||
|
XCallInv _ _ -> XCallInv_
|
||||||
|
XCallOffer _ _ -> XCallOffer_
|
||||||
|
XCallAnswer _ _ -> XCallAnswer_
|
||||||
|
XCallExtra _ _ -> XCallExtra_
|
||||||
|
XCallEnd _ -> XCallEnd_
|
||||||
XOk -> XOk_
|
XOk -> XOk_
|
||||||
XUnknown t _ -> XUnknown_ t
|
XUnknown t _ -> XUnknown_ t
|
||||||
|
|
||||||
|
@ -441,6 +467,11 @@ appToChatMessage AppMessage {msgId, event, params} = do
|
||||||
XInfoProbe_ -> XInfoProbe <$> p "probe"
|
XInfoProbe_ -> XInfoProbe <$> p "probe"
|
||||||
XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash"
|
XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash"
|
||||||
XInfoProbeOk_ -> XInfoProbeOk <$> p "probe"
|
XInfoProbeOk_ -> XInfoProbeOk <$> p "probe"
|
||||||
|
XCallInv_ -> XCallInv <$> p "callId" <*> p "invitation"
|
||||||
|
XCallOffer_ -> XCallOffer <$> p "callId" <*> p "offer"
|
||||||
|
XCallAnswer_ -> XCallAnswer <$> p "callId" <*> p "answer"
|
||||||
|
XCallExtra_ -> XCallExtra <$> p "callId" <*> p "extra"
|
||||||
|
XCallEnd_ -> XCallEnd <$> p "callId"
|
||||||
XOk_ -> pure XOk
|
XOk_ -> pure XOk
|
||||||
XUnknown_ t -> pure $ XUnknown t params
|
XUnknown_ t -> pure $ XUnknown t params
|
||||||
|
|
||||||
|
@ -476,6 +507,11 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = AppMessage {msgId, event, p
|
||||||
XInfoProbe probe -> o ["probe" .= probe]
|
XInfoProbe probe -> o ["probe" .= probe]
|
||||||
XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash]
|
XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash]
|
||||||
XInfoProbeOk probe -> o ["probe" .= probe]
|
XInfoProbeOk probe -> o ["probe" .= probe]
|
||||||
|
XCallInv callId inv -> o ["callId" .= callId, "invitation" .= inv]
|
||||||
|
XCallOffer callId offer -> o ["callId" .= callId, "offer" .= offer]
|
||||||
|
XCallAnswer callId answer -> o ["callId" .= callId, "answer" .= answer]
|
||||||
|
XCallExtra callId extra -> o ["callId" .= callId, "extra" .= extra]
|
||||||
|
XCallEnd callId -> o ["callId" .= callId]
|
||||||
XOk -> JM.empty
|
XOk -> JM.empty
|
||||||
XUnknown _ ps -> ps
|
XUnknown _ ps -> ps
|
||||||
|
|
||||||
|
|
|
@ -139,6 +139,11 @@ responseToView testView = \case
|
||||||
["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
|
["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
|
||||||
CRRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
|
CRRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
|
||||||
["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
|
["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
|
||||||
|
CRCallInvitation {} -> []
|
||||||
|
CRCallOffer {} -> []
|
||||||
|
CRCallAnswer {} -> []
|
||||||
|
CRCallExtraInfo {} -> []
|
||||||
|
CRCallEnded {} -> []
|
||||||
CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"]
|
CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"]
|
||||||
CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"]
|
CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"]
|
||||||
CRNewContactConnection _ -> []
|
CRNewContactConnection _ -> []
|
||||||
|
@ -185,11 +190,13 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha
|
||||||
CIDirectSnd -> case content of
|
CIDirectSnd -> case content of
|
||||||
CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
|
CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
|
||||||
CISndDeleted _ -> []
|
CISndDeleted _ -> []
|
||||||
|
CISndCall {} -> []
|
||||||
where
|
where
|
||||||
to = ttyToContact' c
|
to = ttyToContact' c
|
||||||
CIDirectRcv -> case content of
|
CIDirectRcv -> case content of
|
||||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||||
CIRcvDeleted _ -> []
|
CIRcvDeleted _ -> []
|
||||||
|
CIRcvCall {} -> []
|
||||||
where
|
where
|
||||||
from = ttyFromContact' c
|
from = ttyFromContact' c
|
||||||
where
|
where
|
||||||
|
@ -198,11 +205,13 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha
|
||||||
CIGroupSnd -> case content of
|
CIGroupSnd -> case content of
|
||||||
CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
|
CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
|
||||||
CISndDeleted _ -> []
|
CISndDeleted _ -> []
|
||||||
|
CISndCall {} -> []
|
||||||
where
|
where
|
||||||
to = ttyToGroup g
|
to = ttyToGroup g
|
||||||
CIGroupRcv m -> case content of
|
CIGroupRcv m -> case content of
|
||||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||||
CIRcvDeleted _ -> []
|
CIRcvDeleted _ -> []
|
||||||
|
CIRcvCall {} -> []
|
||||||
where
|
where
|
||||||
from = ttyFromGroup' g m
|
from = ttyFromGroup' g m
|
||||||
where
|
where
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue