{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module Simplex.Chat.Protocol where

import Control.Applicative ((<|>))
import Control.Monad ((<=<))
import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))
import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import qualified Data.Aeson.KeyMap as JM
import qualified Data.Aeson.TH as JQ
import qualified Data.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Either (fromRight)
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime)
import Data.Type.Equality
import Data.Typeable (Typeable)
import Data.Word (Word32)
import Simplex.Chat.Call
import Simplex.Chat.Options.DB (FromField (..), ToField (..))
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Agent.Protocol (VersionSMPA, pqdrSMPAgentVersion)
import Simplex.Messaging.Agent.Store.DB (blobFieldDecoder, fromTextField_)
import Simplex.Messaging.Compression (Compressed, compress1, decompress1)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
import Simplex.Messaging.Protocol (MsgBody)
import Simplex.Messaging.Util (decodeJSON, eitherToMaybe, encodeJSON, safeDecodeUtf8, (<$?>))
import Simplex.Messaging.Version hiding (version)

-- Chat version history:
-- 1 - support chat versions in connections (9/1/2023)
-- 2 - create contacts for group members only via x.grp.direct.inv (9/16/2023)
-- 3 - faster joining via group links without creating contact (10/30/2023)
-- 4 - group message forwarding (11/18/2023)
-- 5 - batch sending messages (12/23/2023)
-- 6 - send group welcome message after history (12/29/2023)
-- 7 - update member profiles (1/15/2024)
-- 8 - compress messages and PQ e2e encryption (2024-03-08)
-- 9 - batch sending in direct connections (2024-07-24)
-- 10 - business chats (2024-11-29)
-- 11 - fix profile update in business chats (2024-12-05)
-- 12 - support sending and receiving content reports (2025-01-03)
-- 14 - support sending and receiving group join rejection (2025-02-24)
-- 15 - support specifying message scopes for group messages (2025-03-12)
-- 16 - support short link data (2025-06-10)

-- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
-- This indirection is needed for backward/forward compatibility testing.
-- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code.
currentChatVersion :: VersionChat
currentChatVersion :: VersionChat
currentChatVersion = Word16 -> VersionChat
VersionChat Word16
16

-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
supportedChatVRange :: VersionRangeChat
supportedChatVRange :: VersionRangeChat
supportedChatVRange = VersionChat -> VersionChat -> VersionRangeChat
forall v. Version v -> Version v -> VersionRange v
mkVersionRange VersionChat
initialChatVersion VersionChat
currentChatVersion
{-# INLINE supportedChatVRange #-}

-- version range that supports skipping establishing direct connections in a group and establishing direct connection via x.grp.direct.inv
groupDirectInvVersion :: VersionChat
groupDirectInvVersion :: VersionChat
groupDirectInvVersion = Word16 -> VersionChat
VersionChat Word16
2

-- version range that supports joining group via group link without creating direct contact
groupFastLinkJoinVersion :: VersionChat
groupFastLinkJoinVersion :: VersionChat
groupFastLinkJoinVersion = Word16 -> VersionChat
VersionChat Word16
3

-- version range that supports group forwarding
groupForwardVersion :: VersionChat
groupForwardVersion :: VersionChat
groupForwardVersion = Word16 -> VersionChat
VersionChat Word16
4

-- version range that supports batch sending in groups
batchSendVersion :: VersionChat
batchSendVersion :: VersionChat
batchSendVersion = Word16 -> VersionChat
VersionChat Word16
5

-- version range that supports sending group welcome message in group history
groupHistoryIncludeWelcomeVersion :: VersionChat
groupHistoryIncludeWelcomeVersion :: VersionChat
groupHistoryIncludeWelcomeVersion = Word16 -> VersionChat
VersionChat Word16
6

-- version range that supports sending member profile updates to groups
memberProfileUpdateVersion :: VersionChat
memberProfileUpdateVersion :: VersionChat
memberProfileUpdateVersion = Word16 -> VersionChat
VersionChat Word16
7

-- version range that supports compressing messages and PQ e2e encryption
pqEncryptionCompressionVersion :: VersionChat
pqEncryptionCompressionVersion :: VersionChat
pqEncryptionCompressionVersion = Word16 -> VersionChat
VersionChat Word16
8

-- version range that supports batch sending in direct connections, and forwarding batched messages in groups
batchSend2Version :: VersionChat
batchSend2Version :: VersionChat
batchSend2Version = Word16 -> VersionChat
VersionChat Word16
9

-- supports differentiating business chats when joining contact addresses
businessChatsVersion :: VersionChat
businessChatsVersion :: VersionChat
businessChatsVersion = Word16 -> VersionChat
VersionChat Word16
10

-- support updating preferences in business chats (XGrpPrefs message)
businessChatPrefsVersion :: VersionChat
businessChatPrefsVersion :: VersionChat
businessChatPrefsVersion = Word16 -> VersionChat
VersionChat Word16
11

-- support sending and receiving content reports (MCReport message content)
contentReportsVersion :: VersionChat
contentReportsVersion :: VersionChat
contentReportsVersion = Word16 -> VersionChat
VersionChat Word16
12

-- support sending and receiving group join rejection (XGrpLinkReject)
groupJoinRejectVersion :: VersionChat
groupJoinRejectVersion :: VersionChat
groupJoinRejectVersion = Word16 -> VersionChat
VersionChat Word16
14

-- support group knocking (MsgScope)
groupKnockingVersion :: VersionChat
groupKnockingVersion :: VersionChat
groupKnockingVersion = Word16 -> VersionChat
VersionChat Word16
15

-- support short link data in invitation, contact and group links
shortLinkDataVersion :: VersionChat
shortLinkDataVersion :: VersionChat
shortLinkDataVersion = Word16 -> VersionChat
VersionChat Word16
16

agentToChatVersion :: VersionSMPA -> VersionChat
agentToChatVersion :: VersionSMPA -> VersionChat
agentToChatVersion VersionSMPA
v
  | VersionSMPA
v VersionSMPA -> VersionSMPA -> Bool
forall a. Ord a => a -> a -> Bool
< VersionSMPA
pqdrSMPAgentVersion = VersionChat
initialChatVersion
  | Bool
otherwise = VersionChat
pqEncryptionCompressionVersion

data ConnectionEntity
  = RcvDirectMsgConnection {ConnectionEntity -> Connection
entityConnection :: Connection, ConnectionEntity -> Maybe Contact
contact :: Maybe Contact}
  | RcvGroupMsgConnection {entityConnection :: Connection, ConnectionEntity -> GroupInfo
groupInfo :: GroupInfo, ConnectionEntity -> GroupMember
groupMember :: GroupMember}
  | UserContactConnection {entityConnection :: Connection, ConnectionEntity -> UserContact
userContact :: UserContact}
  deriving (ConnectionEntity -> ConnectionEntity -> Bool
(ConnectionEntity -> ConnectionEntity -> Bool)
-> (ConnectionEntity -> ConnectionEntity -> Bool)
-> Eq ConnectionEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionEntity -> ConnectionEntity -> Bool
== :: ConnectionEntity -> ConnectionEntity -> Bool
$c/= :: ConnectionEntity -> ConnectionEntity -> Bool
/= :: ConnectionEntity -> ConnectionEntity -> Bool
Eq, Int -> ConnectionEntity -> ShowS
[ConnectionEntity] -> ShowS
ConnectionEntity -> String
(Int -> ConnectionEntity -> ShowS)
-> (ConnectionEntity -> String)
-> ([ConnectionEntity] -> ShowS)
-> Show ConnectionEntity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionEntity -> ShowS
showsPrec :: Int -> ConnectionEntity -> ShowS
$cshow :: ConnectionEntity -> String
show :: ConnectionEntity -> String
$cshowList :: [ConnectionEntity] -> ShowS
showList :: [ConnectionEntity] -> ShowS
Show)

$(JQ.deriveJSON (sumTypeJSON fstToLower) ''ConnectionEntity)

connEntityInfo :: ConnectionEntity -> String
connEntityInfo :: ConnectionEntity -> String
connEntityInfo = \case
  RcvDirectMsgConnection Connection
c Maybe Contact
ct_ -> Maybe Contact -> String
ctInfo Maybe Contact
ct_ String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", status: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ConnStatus -> String
forall a. Show a => a -> String
show (Connection -> ConnStatus
connStatus Connection
c)
  RcvGroupMsgConnection Connection
c GroupInfo
g GroupMember
m -> GroupInfo -> GroupMember -> String
mInfo GroupInfo
g GroupMember
m String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", status: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ConnStatus -> String
forall a. Show a => a -> String
show (Connection -> ConnStatus
connStatus Connection
c)
  UserContactConnection Connection
c UserContact
_uc -> String
"user address, status: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ConnStatus -> String
forall a. Show a => a -> String
show (Connection -> ConnStatus
connStatus Connection
c)
  where
    ctInfo :: Maybe Contact -> String
ctInfo = String -> (Contact -> String) -> Maybe Contact -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"connection" ((Contact -> String) -> Maybe Contact -> String)
-> (Contact -> String) -> Maybe Contact -> String
forall a b. (a -> b) -> a -> b
$ \Contact {ContactId
contactId :: ContactId
contactId :: Contact -> ContactId
contactId} -> String
"contact " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ContactId -> String
forall a. Show a => a -> String
show ContactId
contactId
    mInfo :: GroupInfo -> GroupMember -> String
mInfo GroupInfo {ContactId
groupId :: ContactId
groupId :: GroupInfo -> ContactId
groupId} GroupMember {ContactId
groupMemberId :: ContactId
groupMemberId :: GroupMember -> ContactId
groupMemberId} = String
"group " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ContactId -> String
forall a. Show a => a -> String
show ContactId
groupId String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", member " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ContactId -> String
forall a. Show a => a -> String
show ContactId
groupMemberId

updateEntityConnStatus :: ConnectionEntity -> ConnStatus -> ConnectionEntity
updateEntityConnStatus :: ConnectionEntity -> ConnStatus -> ConnectionEntity
updateEntityConnStatus ConnectionEntity
connEntity ConnStatus
connStatus = case ConnectionEntity
connEntity of
  RcvDirectMsgConnection Connection
c Maybe Contact
ct_ -> Connection -> Maybe Contact -> ConnectionEntity
RcvDirectMsgConnection (Connection -> Connection
st Connection
c) ((\Contact
ct -> (Contact
ct :: Contact) {activeConn = Just $ st c}) (Contact -> Contact) -> Maybe Contact -> Maybe Contact
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Contact
ct_)
  RcvGroupMsgConnection Connection
c GroupInfo
gInfo m :: GroupMember
m@GroupMember {activeConn :: GroupMember -> Maybe Connection
activeConn = Maybe Connection
c'} -> Connection -> GroupInfo -> GroupMember -> ConnectionEntity
RcvGroupMsgConnection (Connection -> Connection
st Connection
c) GroupInfo
gInfo GroupMember
m {activeConn = st <$> c'}
  UserContactConnection Connection
c UserContact
uc -> Connection -> UserContact -> ConnectionEntity
UserContactConnection (Connection -> Connection
st Connection
c) UserContact
uc
  where
    st :: Connection -> Connection
st Connection
c = Connection
c {connStatus}

data MsgEncoding = Binary | Json

data SMsgEncoding (e :: MsgEncoding) where
  SBinary :: SMsgEncoding 'Binary
  SJson :: SMsgEncoding 'Json

deriving instance Show (SMsgEncoding e)

class MsgEncodingI (e :: MsgEncoding) where
  encoding :: SMsgEncoding e

instance MsgEncodingI 'Binary where encoding :: SMsgEncoding 'Binary
encoding = SMsgEncoding 'Binary
SBinary

instance MsgEncodingI 'Json where encoding :: SMsgEncoding 'Json
encoding = SMsgEncoding 'Json
SJson

instance TestEquality SMsgEncoding where
  testEquality :: forall (a :: MsgEncoding) (b :: MsgEncoding).
SMsgEncoding a -> SMsgEncoding b -> Maybe (a :~: b)
testEquality SMsgEncoding a
SBinary SMsgEncoding b
SBinary = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SMsgEncoding a
SJson SMsgEncoding b
SJson = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SMsgEncoding a
_ SMsgEncoding b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

checkEncoding :: forall t e e'. (MsgEncodingI e, MsgEncodingI e') => t e' -> Either String (t e)
checkEncoding :: forall (t :: MsgEncoding -> *) (e :: MsgEncoding)
       (e' :: MsgEncoding).
(MsgEncodingI e, MsgEncodingI e') =>
t e' -> Either String (t e)
checkEncoding t e'
x = case SMsgEncoding e -> SMsgEncoding e' -> Maybe (e :~: e')
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: MsgEncoding) (b :: MsgEncoding).
SMsgEncoding a -> SMsgEncoding b -> Maybe (a :~: b)
testEquality (forall (e :: MsgEncoding). MsgEncodingI e => SMsgEncoding e
encoding @e) (forall (e :: MsgEncoding). MsgEncodingI e => SMsgEncoding e
encoding @e') of
  Just e :~: e'
Refl -> t e -> Either String (t e)
forall a b. b -> Either a b
Right t e
t e'
x
  Maybe (e :~: e')
Nothing -> String -> Either String (t e)
forall a b. a -> Either a b
Left String
"bad encoding"

data AppMessage (e :: MsgEncoding) where
  AMJson :: AppMessageJson -> AppMessage 'Json
  AMBinary :: AppMessageBinary -> AppMessage 'Binary

-- chat message is sent as JSON with these properties
data AppMessageJson = AppMessageJson
  { AppMessageJson -> Maybe ChatVersionRange
v :: Maybe ChatVersionRange,
    AppMessageJson -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId,
    AppMessageJson -> MemberName
event :: Text,
    AppMessageJson -> Object
params :: J.Object
  }

data AppMessageBinary = AppMessageBinary
  { AppMessageBinary -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId,
    AppMessageBinary -> Char
tag :: Char,
    AppMessageBinary -> ByteString
body :: ByteString
  }

instance StrEncoding AppMessageBinary where
  strEncode :: AppMessageBinary -> ByteString
strEncode AppMessageBinary {Char
tag :: AppMessageBinary -> Char
tag :: Char
tag, Maybe SharedMsgId
msgId :: AppMessageBinary -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, ByteString
body :: AppMessageBinary -> ByteString
body :: ByteString
body} = (Char, ByteString, Tail) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (Char
tag, ByteString
msgId', ByteString -> Tail
Tail ByteString
body)
    where
      msgId' :: ByteString
msgId' = ByteString
-> (SharedMsgId -> ByteString) -> Maybe SharedMsgId -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
B.empty (\(SharedMsgId ByteString
mId') -> ByteString
mId') Maybe SharedMsgId
msgId
  strP :: Parser AppMessageBinary
strP = do
    (Char
tag, ByteString
msgId', Tail ByteString
body) <- Parser (Char, ByteString, Tail)
forall a. Encoding a => Parser a
smpP
    let msgId :: Maybe SharedMsgId
msgId = if ByteString -> Bool
B.null ByteString
msgId' then Maybe SharedMsgId
forall a. Maybe a
Nothing else SharedMsgId -> Maybe SharedMsgId
forall a. a -> Maybe a
Just (ByteString -> SharedMsgId
SharedMsgId ByteString
msgId')
    AppMessageBinary -> Parser AppMessageBinary
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppMessageBinary {Char
tag :: Char
tag :: Char
tag, Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, ByteString
body :: ByteString
body :: ByteString
body}

data MsgScope
  = MSMember {MsgScope -> MemberId
memberId :: MemberId} -- Admins can use any member id; members can use only their own id
  deriving (MsgScope -> MsgScope -> Bool
(MsgScope -> MsgScope -> Bool)
-> (MsgScope -> MsgScope -> Bool) -> Eq MsgScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgScope -> MsgScope -> Bool
== :: MsgScope -> MsgScope -> Bool
$c/= :: MsgScope -> MsgScope -> Bool
/= :: MsgScope -> MsgScope -> Bool
Eq, Int -> MsgScope -> ShowS
[MsgScope] -> ShowS
MsgScope -> String
(Int -> MsgScope -> ShowS)
-> (MsgScope -> String) -> ([MsgScope] -> ShowS) -> Show MsgScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgScope -> ShowS
showsPrec :: Int -> MsgScope -> ShowS
$cshow :: MsgScope -> String
show :: MsgScope -> String
$cshowList :: [MsgScope] -> ShowS
showList :: [MsgScope] -> ShowS
Show)

$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "MS") ''MsgScope)

$(JQ.deriveJSON defaultJSON ''AppMessageJson)

data MsgRef = MsgRef
  { MsgRef -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId,
    MsgRef -> UTCTime
sentAt :: UTCTime,
    MsgRef -> Bool
sent :: Bool,
    MsgRef -> Maybe MemberId
memberId :: Maybe MemberId -- must be present in all group message references, both referencing sent and received
  }
  deriving (MsgRef -> MsgRef -> Bool
(MsgRef -> MsgRef -> Bool)
-> (MsgRef -> MsgRef -> Bool) -> Eq MsgRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgRef -> MsgRef -> Bool
== :: MsgRef -> MsgRef -> Bool
$c/= :: MsgRef -> MsgRef -> Bool
/= :: MsgRef -> MsgRef -> Bool
Eq, Int -> MsgRef -> ShowS
[MsgRef] -> ShowS
MsgRef -> String
(Int -> MsgRef -> ShowS)
-> (MsgRef -> String) -> ([MsgRef] -> ShowS) -> Show MsgRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgRef -> ShowS
showsPrec :: Int -> MsgRef -> ShowS
$cshow :: MsgRef -> String
show :: MsgRef -> String
$cshowList :: [MsgRef] -> ShowS
showList :: [MsgRef] -> ShowS
Show)

$(JQ.deriveJSON defaultJSON ''MsgRef)

data LinkPreview = LinkPreview {LinkPreview -> MemberName
uri :: Text, LinkPreview -> MemberName
title :: Text, LinkPreview -> MemberName
description :: Text, LinkPreview -> ImageData
image :: ImageData, LinkPreview -> Maybe LinkContent
content :: Maybe LinkContent}
  deriving (LinkPreview -> LinkPreview -> Bool
(LinkPreview -> LinkPreview -> Bool)
-> (LinkPreview -> LinkPreview -> Bool) -> Eq LinkPreview
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkPreview -> LinkPreview -> Bool
== :: LinkPreview -> LinkPreview -> Bool
$c/= :: LinkPreview -> LinkPreview -> Bool
/= :: LinkPreview -> LinkPreview -> Bool
Eq, Int -> LinkPreview -> ShowS
[LinkPreview] -> ShowS
LinkPreview -> String
(Int -> LinkPreview -> ShowS)
-> (LinkPreview -> String)
-> ([LinkPreview] -> ShowS)
-> Show LinkPreview
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkPreview -> ShowS
showsPrec :: Int -> LinkPreview -> ShowS
$cshow :: LinkPreview -> String
show :: LinkPreview -> String
$cshowList :: [LinkPreview] -> ShowS
showList :: [LinkPreview] -> ShowS
Show)

data LinkContent = LCPage | LCImage | LCVideo {LinkContent -> Maybe Int
duration :: Maybe Int} | LCUnknown {LinkContent -> MemberName
tag :: Text, LinkContent -> Object
json :: J.Object}
  deriving (LinkContent -> LinkContent -> Bool
(LinkContent -> LinkContent -> Bool)
-> (LinkContent -> LinkContent -> Bool) -> Eq LinkContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkContent -> LinkContent -> Bool
== :: LinkContent -> LinkContent -> Bool
$c/= :: LinkContent -> LinkContent -> Bool
/= :: LinkContent -> LinkContent -> Bool
Eq, Int -> LinkContent -> ShowS
[LinkContent] -> ShowS
LinkContent -> String
(Int -> LinkContent -> ShowS)
-> (LinkContent -> String)
-> ([LinkContent] -> ShowS)
-> Show LinkContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkContent -> ShowS
showsPrec :: Int -> LinkContent -> ShowS
$cshow :: LinkContent -> String
show :: LinkContent -> String
$cshowList :: [LinkContent] -> ShowS
showList :: [LinkContent] -> ShowS
Show)

data ReportReason = RRSpam | RRContent | RRCommunity | RRProfile | RROther | RRUnknown Text
  deriving (ReportReason -> ReportReason -> Bool
(ReportReason -> ReportReason -> Bool)
-> (ReportReason -> ReportReason -> Bool) -> Eq ReportReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportReason -> ReportReason -> Bool
== :: ReportReason -> ReportReason -> Bool
$c/= :: ReportReason -> ReportReason -> Bool
/= :: ReportReason -> ReportReason -> Bool
Eq, Int -> ReportReason -> ShowS
[ReportReason] -> ShowS
ReportReason -> String
(Int -> ReportReason -> ShowS)
-> (ReportReason -> String)
-> ([ReportReason] -> ShowS)
-> Show ReportReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportReason -> ShowS
showsPrec :: Int -> ReportReason -> ShowS
$cshow :: ReportReason -> String
show :: ReportReason -> String
$cshowList :: [ReportReason] -> ShowS
showList :: [ReportReason] -> ShowS
Show)

$(pure [])

instance FromJSON LinkContent where
  parseJSON :: Value -> Parser LinkContent
parseJSON v :: Value
v@(J.Object Object
j) =
    $(JQ.mkParseJSON (taggedObjectJSON $ dropPrefix "LC") ''LinkContent) Value
v
      Parser LinkContent -> Parser LinkContent -> Parser LinkContent
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MemberName -> Object -> LinkContent
LCUnknown (MemberName -> Object -> LinkContent)
-> Parser MemberName -> Parser (Object -> LinkContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
j Object -> Key -> Parser MemberName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" Parser (Object -> LinkContent)
-> Parser Object -> Parser LinkContent
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser Object
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
j
  parseJSON Value
invalid =
    String -> Parser LinkContent -> Parser LinkContent
forall a. String -> Parser a -> Parser a
JT.prependFailure String
"bad LinkContent, " (String -> Value -> Parser LinkContent
forall a. String -> Value -> Parser a
JT.typeMismatch String
"Object" Value
invalid)

instance ToJSON LinkContent where
  toJSON :: LinkContent -> Value
toJSON = \case
    LCUnknown MemberName
_ Object
j -> Object -> Value
J.Object Object
j
    LinkContent
v -> $(JQ.mkToJSON (taggedObjectJSON $ dropPrefix "LC") ''LinkContent) LinkContent
v
  toEncoding :: LinkContent -> Encoding
toEncoding = \case
    LCUnknown MemberName
_ Object
j -> Value -> Encoding
JE.value (Value -> Encoding) -> Value -> Encoding
forall a b. (a -> b) -> a -> b
$ Object -> Value
J.Object Object
j
    LinkContent
v -> $(JQ.mkToEncoding (taggedObjectJSON $ dropPrefix "LC") ''LinkContent) LinkContent
v

$(JQ.deriveJSON defaultJSON ''LinkPreview)

instance StrEncoding ReportReason where
  strEncode :: ReportReason -> ByteString
strEncode = \case
    ReportReason
RRSpam -> ByteString
"spam"
    ReportReason
RRContent -> ByteString
"content"
    ReportReason
RRCommunity -> ByteString
"community"
    ReportReason
RRProfile -> ByteString
"profile"
    ReportReason
RROther -> ByteString
"other"
    RRUnknown MemberName
t -> MemberName -> ByteString
encodeUtf8 MemberName
t
  strP :: Parser ReportReason
strP =
    (Char -> Bool) -> Parser ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString
-> (ByteString -> Parser ReportReason) -> Parser ReportReason
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ByteString
"spam" -> ReportReason -> Parser ReportReason
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportReason
RRSpam
      ByteString
"content" -> ReportReason -> Parser ReportReason
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportReason
RRContent
      ByteString
"community" -> ReportReason -> Parser ReportReason
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportReason
RRCommunity
      ByteString
"profile" -> ReportReason -> Parser ReportReason
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportReason
RRProfile
      ByteString
"other" -> ReportReason -> Parser ReportReason
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportReason
RROther
      ByteString
t -> ReportReason -> Parser ReportReason
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReportReason -> Parser ReportReason)
-> ReportReason -> Parser ReportReason
forall a b. (a -> b) -> a -> b
$ MemberName -> ReportReason
RRUnknown (MemberName -> ReportReason) -> MemberName -> ReportReason
forall a b. (a -> b) -> a -> b
$ ByteString -> MemberName
safeDecodeUtf8 ByteString
t

instance FromJSON ReportReason where
  parseJSON :: Value -> Parser ReportReason
parseJSON = String -> Value -> Parser ReportReason
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"ReportReason"

instance ToJSON ReportReason where
  toJSON :: ReportReason -> Value
toJSON = ReportReason -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: ReportReason -> Encoding
toEncoding = ReportReason -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

data ChatMessage e = ChatMessage
  { forall (e :: MsgEncoding). ChatMessage e -> VersionRangeChat
chatVRange :: VersionRangeChat,
    forall (e :: MsgEncoding). ChatMessage e -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId,
    forall (e :: MsgEncoding). ChatMessage e -> ChatMsgEvent e
chatMsgEvent :: ChatMsgEvent e
  }
  deriving (ChatMessage e -> ChatMessage e -> Bool
(ChatMessage e -> ChatMessage e -> Bool)
-> (ChatMessage e -> ChatMessage e -> Bool) -> Eq (ChatMessage e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (e :: MsgEncoding). ChatMessage e -> ChatMessage e -> Bool
$c== :: forall (e :: MsgEncoding). ChatMessage e -> ChatMessage e -> Bool
== :: ChatMessage e -> ChatMessage e -> Bool
$c/= :: forall (e :: MsgEncoding). ChatMessage e -> ChatMessage e -> Bool
/= :: ChatMessage e -> ChatMessage e -> Bool
Eq, Int -> ChatMessage e -> ShowS
[ChatMessage e] -> ShowS
ChatMessage e -> String
(Int -> ChatMessage e -> ShowS)
-> (ChatMessage e -> String)
-> ([ChatMessage e] -> ShowS)
-> Show (ChatMessage e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (e :: MsgEncoding). Int -> ChatMessage e -> ShowS
forall (e :: MsgEncoding). [ChatMessage e] -> ShowS
forall (e :: MsgEncoding). ChatMessage e -> String
$cshowsPrec :: forall (e :: MsgEncoding). Int -> ChatMessage e -> ShowS
showsPrec :: Int -> ChatMessage e -> ShowS
$cshow :: forall (e :: MsgEncoding). ChatMessage e -> String
show :: ChatMessage e -> String
$cshowList :: forall (e :: MsgEncoding). [ChatMessage e] -> ShowS
showList :: [ChatMessage e] -> ShowS
Show)

data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMessage e)

type MessageFromChannel = Bool

data ChatMsgEvent (e :: MsgEncoding) where
  XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
  XMsgFileDescr :: {ChatMsgEvent 'Json -> SharedMsgId
msgId :: SharedMsgId, ChatMsgEvent 'Json -> FileDescr
fileDescr :: FileDescr} -> ChatMsgEvent 'Json
  XMsgUpdate :: {msgId :: SharedMsgId, ChatMsgEvent 'Json -> MsgContent
content :: MsgContent, ChatMsgEvent 'Json -> Map MemberName MsgMention
mentions :: Map MemberName MsgMention, ChatMsgEvent 'Json -> Maybe Int
ttl :: Maybe Int, ChatMsgEvent 'Json -> Maybe Bool
live :: Maybe Bool, ChatMsgEvent 'Json -> Maybe MsgScope
scope :: Maybe MsgScope} -> ChatMsgEvent 'Json
  XMsgDel :: {msgId :: SharedMsgId, ChatMsgEvent 'Json -> Maybe MemberId
memberId :: Maybe MemberId, scope :: Maybe MsgScope} -> ChatMsgEvent 'Json
  XMsgDeleted :: ChatMsgEvent 'Json
  XMsgReact :: {msgId :: SharedMsgId, memberId :: Maybe MemberId, scope :: Maybe MsgScope, ChatMsgEvent 'Json -> MsgReaction
reaction :: MsgReaction, ChatMsgEvent 'Json -> Bool
add :: Bool} -> ChatMsgEvent 'Json
  XFile :: FileInvitation -> ChatMsgEvent 'Json -- TODO discontinue
  XFileAcpt :: String -> ChatMsgEvent 'Json -- direct file protocol
  XFileAcptInv :: SharedMsgId -> Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json
  XFileCancel :: SharedMsgId -> ChatMsgEvent 'Json
  XInfo :: Profile -> ChatMsgEvent 'Json
  XContact :: {ChatMsgEvent 'Json -> Profile
profile :: Profile, ChatMsgEvent 'Json -> Maybe XContactId
contactReqId :: Maybe XContactId, ChatMsgEvent 'Json -> Maybe SharedMsgId
welcomeMsgId :: Maybe SharedMsgId, ChatMsgEvent 'Json -> Maybe (SharedMsgId, MsgContent)
requestMsg :: Maybe (SharedMsgId, MsgContent)} -> ChatMsgEvent 'Json
  XDirectDel :: ChatMsgEvent 'Json
  XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
  XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
  XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
  XGrpLinkReject :: GroupLinkRejection -> ChatMsgEvent 'Json
  XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
  XGrpLinkAcpt :: GroupAcceptance -> GroupMemberRole -> MemberId -> ChatMsgEvent 'Json
  XGrpMemNew :: MemberInfo -> Maybe MsgScope -> ChatMsgEvent 'Json
  XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json
  XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
  XGrpMemFwd :: MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json
  XGrpMemInfo :: MemberId -> Profile -> ChatMsgEvent 'Json
  XGrpMemRole :: MemberId -> GroupMemberRole -> ChatMsgEvent 'Json
  XGrpMemRestrict :: MemberId -> MemberRestrictions -> ChatMsgEvent 'Json
  XGrpMemCon :: MemberId -> ChatMsgEvent 'Json
  XGrpMemConAll :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented
  XGrpMemDel :: MemberId -> Bool -> ChatMsgEvent 'Json
  XGrpLeave :: ChatMsgEvent 'Json
  XGrpDel :: ChatMsgEvent 'Json
  XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json
  XGrpPrefs :: GroupPreferences -> ChatMsgEvent 'Json
  XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json
  XGrpMsgForward :: MemberId -> Maybe ContactName -> ChatMessage 'Json -> UTCTime -> ChatMsgEvent 'Json
  XInfoProbe :: Probe -> ChatMsgEvent 'Json
  XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json
  XInfoProbeOk :: Probe -> ChatMsgEvent 'Json
  XCallInv :: CallId -> CallInvitation -> ChatMsgEvent 'Json
  XCallOffer :: CallId -> CallOffer -> ChatMsgEvent 'Json
  XCallAnswer :: CallId -> CallAnswer -> ChatMsgEvent 'Json
  XCallExtra :: CallId -> CallExtraInfo -> ChatMsgEvent 'Json
  XCallEnd :: CallId -> ChatMsgEvent 'Json
  XOk :: ChatMsgEvent 'Json
  XUnknown :: {ChatMsgEvent 'Json -> MemberName
event :: Text, ChatMsgEvent 'Json -> Object
params :: J.Object} -> ChatMsgEvent 'Json
  BFileChunk :: SharedMsgId -> FileChunk -> ChatMsgEvent 'Binary

deriving instance Eq (ChatMsgEvent e)

deriving instance Show (ChatMsgEvent e)

data AChatMsgEvent = forall e. MsgEncodingI e => ACME (SMsgEncoding e) (ChatMsgEvent e)

deriving instance Show AChatMsgEvent

-- when sending, used for deciding whether message will be forwarded by host or not (memberSendAction);
-- actual filtering on forwarding is done in processEvent
isForwardedGroupMsg :: ChatMsgEvent e -> Bool
isForwardedGroupMsg :: forall (e :: MsgEncoding). ChatMsgEvent e -> Bool
isForwardedGroupMsg ChatMsgEvent e
ev = case ChatMsgEvent e
ev of
  XMsgNew MsgContainer
mc -> case MsgContainer -> ExtMsgContent
mcExtMsgContent MsgContainer
mc of
    ExtMsgContent {file :: ExtMsgContent -> Maybe FileInvitation
file = Just FileInvitation {fileInline :: FileInvitation -> Maybe InlineFileMode
fileInline = Just InlineFileMode
_}} -> Bool
False
    ExtMsgContent
_ -> Bool
True
  XMsgFileDescr SharedMsgId
_ FileDescr
_ -> Bool
True
  XMsgUpdate {} -> Bool
True
  XMsgDel {} -> Bool
True
  XMsgReact {} -> Bool
True
  XFileCancel SharedMsgId
_ -> Bool
True
  XInfo Profile
_ -> Bool
True
  XGrpMemNew {} -> Bool
True
  XGrpMemRole {} -> Bool
True
  XGrpMemRestrict {} -> Bool
True
  XGrpMemDel {} -> Bool
True
  ChatMsgEvent e
XGrpLeave -> Bool
True
  ChatMsgEvent e
XGrpDel -> Bool
True
  XGrpInfo GroupProfile
_ -> Bool
True
  XGrpPrefs GroupPreferences
_ -> Bool
True
  ChatMsgEvent e
_ -> Bool
False

data MsgReaction = MREmoji {MsgReaction -> MREmojiChar
emoji :: MREmojiChar} | MRUnknown {MsgReaction -> MemberName
tag :: Text, MsgReaction -> Object
json :: J.Object}
  deriving (MsgReaction -> MsgReaction -> Bool
(MsgReaction -> MsgReaction -> Bool)
-> (MsgReaction -> MsgReaction -> Bool) -> Eq MsgReaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgReaction -> MsgReaction -> Bool
== :: MsgReaction -> MsgReaction -> Bool
$c/= :: MsgReaction -> MsgReaction -> Bool
/= :: MsgReaction -> MsgReaction -> Bool
Eq, Int -> MsgReaction -> ShowS
[MsgReaction] -> ShowS
MsgReaction -> String
(Int -> MsgReaction -> ShowS)
-> (MsgReaction -> String)
-> ([MsgReaction] -> ShowS)
-> Show MsgReaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgReaction -> ShowS
showsPrec :: Int -> MsgReaction -> ShowS
$cshow :: MsgReaction -> String
show :: MsgReaction -> String
$cshowList :: [MsgReaction] -> ShowS
showList :: [MsgReaction] -> ShowS
Show)

emojiTag :: IsString a => a
emojiTag :: forall a. IsString a => a
emojiTag = a
"emoji"

knownReaction :: MsgReaction -> Either String MsgReaction
knownReaction :: MsgReaction -> Either String MsgReaction
knownReaction = \case
  r :: MsgReaction
r@MREmoji {} -> MsgReaction -> Either String MsgReaction
forall a b. b -> Either a b
Right MsgReaction
r
  MRUnknown {} -> String -> Either String MsgReaction
forall a b. a -> Either a b
Left String
"unknown MsgReaction"

-- parseJSON for MsgReaction parses unknown emoji reactions as MRUnknown with type "emoji",
-- allowing to add new emojis in a backwards compatible way - UI shows them as ?
instance FromJSON MsgReaction where
  parseJSON :: Value -> Parser MsgReaction
parseJSON (J.Object Object
v) = do
    MemberName
tag <- Object
v Object -> Key -> Parser MemberName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    if MemberName
tag MemberName -> MemberName -> Bool
forall a. Eq a => a -> a -> Bool
== MemberName
forall a. IsString a => a
emojiTag
      then (MREmojiChar -> MsgReaction
MREmoji (MREmojiChar -> MsgReaction)
-> Parser MREmojiChar -> Parser MsgReaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser MREmojiChar
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
forall a. IsString a => a
emojiTag) Parser MsgReaction -> Parser MsgReaction -> Parser MsgReaction
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MsgReaction -> Parser MsgReaction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemberName -> Object -> MsgReaction
MRUnknown MemberName
tag Object
v)
      else MsgReaction -> Parser MsgReaction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MsgReaction -> Parser MsgReaction)
-> MsgReaction -> Parser MsgReaction
forall a b. (a -> b) -> a -> b
$ MemberName -> Object -> MsgReaction
MRUnknown MemberName
tag Object
v
  parseJSON Value
invalid =
    String -> Parser MsgReaction -> Parser MsgReaction
forall a. String -> Parser a -> Parser a
JT.prependFailure String
"bad MsgContent, " (String -> Value -> Parser MsgReaction
forall a. String -> Value -> Parser a
JT.typeMismatch String
"Object" Value
invalid)

instance ToJSON MsgReaction where
  toJSON :: MsgReaction -> Value
toJSON = \case
    MRUnknown {Object
json :: MsgReaction -> Object
json :: Object
json} -> Object -> Value
J.Object Object
json
    MREmoji MREmojiChar
emoji -> [(Key, Value)] -> Value
J.object [Key
"type" Key -> MemberName -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (MemberName
forall a. IsString a => a
emojiTag :: Text), Key
forall a. IsString a => a
emojiTag Key -> MREmojiChar -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MREmojiChar
emoji]
  toEncoding :: MsgReaction -> Encoding
toEncoding = \case
    MRUnknown {Object
json :: MsgReaction -> Object
json :: Object
json} -> Value -> Encoding
JE.value (Value -> Encoding) -> Value -> Encoding
forall a b. (a -> b) -> a -> b
$ Object -> Value
J.Object Object
json
    MREmoji MREmojiChar
emoji -> Series -> Encoding
J.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> MemberName -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (MemberName
forall a. IsString a => a
emojiTag :: Text) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
forall a. IsString a => a
emojiTag Key -> MREmojiChar -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MREmojiChar
emoji

instance ToField MsgReaction where
  toField :: MsgReaction -> SQLData
toField = MemberName -> SQLData
forall a. ToField a => a -> SQLData
toField (MemberName -> SQLData)
-> (MsgReaction -> MemberName) -> MsgReaction -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgReaction -> MemberName
forall a. ToJSON a => a -> MemberName
encodeJSON

instance FromField MsgReaction where
  fromField :: FieldParser MsgReaction
fromField = (MemberName -> Maybe MsgReaction) -> FieldParser MsgReaction
forall a. Typeable a => (MemberName -> Maybe a) -> Field -> Ok a
fromTextField_ MemberName -> Maybe MsgReaction
forall a. FromJSON a => MemberName -> Maybe a
decodeJSON

newtype MREmojiChar = MREmojiChar Char
  deriving (MREmojiChar -> MREmojiChar -> Bool
(MREmojiChar -> MREmojiChar -> Bool)
-> (MREmojiChar -> MREmojiChar -> Bool) -> Eq MREmojiChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MREmojiChar -> MREmojiChar -> Bool
== :: MREmojiChar -> MREmojiChar -> Bool
$c/= :: MREmojiChar -> MREmojiChar -> Bool
/= :: MREmojiChar -> MREmojiChar -> Bool
Eq, Int -> MREmojiChar -> ShowS
[MREmojiChar] -> ShowS
MREmojiChar -> String
(Int -> MREmojiChar -> ShowS)
-> (MREmojiChar -> String)
-> ([MREmojiChar] -> ShowS)
-> Show MREmojiChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MREmojiChar -> ShowS
showsPrec :: Int -> MREmojiChar -> ShowS
$cshow :: MREmojiChar -> String
show :: MREmojiChar -> String
$cshowList :: [MREmojiChar] -> ShowS
showList :: [MREmojiChar] -> ShowS
Show)

instance ToJSON MREmojiChar where
  toEncoding :: MREmojiChar -> Encoding
toEncoding (MREmojiChar Char
c) = Char -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding Char
c
  toJSON :: MREmojiChar -> Value
toJSON (MREmojiChar Char
c) = Char -> Value
forall a. ToJSON a => a -> Value
J.toJSON Char
c

instance FromJSON MREmojiChar where
  parseJSON :: Value -> Parser MREmojiChar
parseJSON Value
v = Char -> Either String MREmojiChar
mrEmojiChar (Char -> Either String MREmojiChar)
-> Parser Char -> Parser MREmojiChar
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Value -> Parser Char
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

mrEmojiChar :: Char -> Either String MREmojiChar
mrEmojiChar :: Char -> Either String MREmojiChar
mrEmojiChar Char
c
  | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"👍👎😀😂😢❤️🚀✅" :: String) = MREmojiChar -> Either String MREmojiChar
forall a b. b -> Either a b
Right (MREmojiChar -> Either String MREmojiChar)
-> MREmojiChar -> Either String MREmojiChar
forall a b. (a -> b) -> a -> b
$ Char -> MREmojiChar
MREmojiChar Char
c
  | Bool
otherwise = String -> Either String MREmojiChar
forall a b. a -> Either a b
Left String
"bad emoji"

data FileChunk = FileChunk {FileChunk -> Integer
chunkNo :: Integer, FileChunk -> ByteString
chunkBytes :: ByteString} | FileChunkCancel
  deriving (FileChunk -> FileChunk -> Bool
(FileChunk -> FileChunk -> Bool)
-> (FileChunk -> FileChunk -> Bool) -> Eq FileChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileChunk -> FileChunk -> Bool
== :: FileChunk -> FileChunk -> Bool
$c/= :: FileChunk -> FileChunk -> Bool
/= :: FileChunk -> FileChunk -> Bool
Eq, Int -> FileChunk -> ShowS
[FileChunk] -> ShowS
FileChunk -> String
(Int -> FileChunk -> ShowS)
-> (FileChunk -> String)
-> ([FileChunk] -> ShowS)
-> Show FileChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileChunk -> ShowS
showsPrec :: Int -> FileChunk -> ShowS
$cshow :: FileChunk -> String
show :: FileChunk -> String
$cshowList :: [FileChunk] -> ShowS
showList :: [FileChunk] -> ShowS
Show)

instance Encoding FileChunk where
  smpEncode :: FileChunk -> ByteString
smpEncode = \case
    FileChunk {Integer
chunkNo :: FileChunk -> Integer
chunkNo :: Integer
chunkNo, ByteString
chunkBytes :: FileChunk -> ByteString
chunkBytes :: ByteString
chunkBytes} -> (Char, Word32, Tail) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (Char
'F', Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
chunkNo :: Word32, ByteString -> Tail
Tail ByteString
chunkBytes)
    FileChunk
FileChunkCancel -> Char -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode Char
'C'
  smpP :: Parser FileChunk
smpP =
    Parser Char
forall a. Encoding a => Parser a
smpP Parser Char -> (Char -> Parser FileChunk) -> Parser FileChunk
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Char
'F' -> do
        Integer
chunkNo <- Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer)
-> Parser ByteString Word32 -> Parser ByteString Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Encoding a => Parser a
smpP @Word32
        Tail ByteString
chunkBytes <- Parser Tail
forall a. Encoding a => Parser a
smpP
        FileChunk -> Parser FileChunk
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileChunk {Integer
chunkNo :: Integer
chunkNo :: Integer
chunkNo, ByteString
chunkBytes :: ByteString
chunkBytes :: ByteString
chunkBytes}
      Char
'C' -> FileChunk -> Parser FileChunk
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileChunk
FileChunkCancel
      Char
_ -> String -> Parser FileChunk
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad FileChunk"

newtype InlineFileChunk = IFC {InlineFileChunk -> FileChunk
unIFC :: FileChunk}

instance Encoding InlineFileChunk where
  smpEncode :: InlineFileChunk -> ByteString
smpEncode (IFC FileChunk
chunk) = case FileChunk
chunk of
    FileChunk {Integer
chunkNo :: FileChunk -> Integer
chunkNo :: Integer
chunkNo, ByteString
chunkBytes :: FileChunk -> ByteString
chunkBytes :: ByteString
chunkBytes} -> (Char, Tail) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (Word8 -> Char
w2c (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
chunkNo, ByteString -> Tail
Tail ByteString
chunkBytes)
    FileChunk
FileChunkCancel -> Char -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode Char
'\NUL'
  smpP :: Parser InlineFileChunk
smpP = do
    Char
c <- Parser Char
A.anyChar
    FileChunk -> InlineFileChunk
IFC (FileChunk -> InlineFileChunk)
-> Parser FileChunk -> Parser InlineFileChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Char
c of
      Char
'\NUL' -> FileChunk -> Parser FileChunk
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileChunk
FileChunkCancel
      Char
_ -> do
        Tail ByteString
chunkBytes <- Parser Tail
forall a. Encoding a => Parser a
smpP
        FileChunk -> Parser FileChunk
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileChunk {chunkNo :: Integer
chunkNo = Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Integer) -> Word8 -> Integer
forall a b. (a -> b) -> a -> b
$ Char -> Word8
c2w Char
c, ByteString
chunkBytes :: ByteString
chunkBytes :: ByteString
chunkBytes}

data QuotedMsg = QuotedMsg {QuotedMsg -> MsgRef
msgRef :: MsgRef, QuotedMsg -> MsgContent
content :: MsgContent}
  deriving (QuotedMsg -> QuotedMsg -> Bool
(QuotedMsg -> QuotedMsg -> Bool)
-> (QuotedMsg -> QuotedMsg -> Bool) -> Eq QuotedMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QuotedMsg -> QuotedMsg -> Bool
== :: QuotedMsg -> QuotedMsg -> Bool
$c/= :: QuotedMsg -> QuotedMsg -> Bool
/= :: QuotedMsg -> QuotedMsg -> Bool
Eq, Int -> QuotedMsg -> ShowS
[QuotedMsg] -> ShowS
QuotedMsg -> String
(Int -> QuotedMsg -> ShowS)
-> (QuotedMsg -> String)
-> ([QuotedMsg] -> ShowS)
-> Show QuotedMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QuotedMsg -> ShowS
showsPrec :: Int -> QuotedMsg -> ShowS
$cshow :: QuotedMsg -> String
show :: QuotedMsg -> String
$cshowList :: [QuotedMsg] -> ShowS
showList :: [QuotedMsg] -> ShowS
Show)

cmToQuotedMsg :: AChatMsgEvent -> Maybe QuotedMsg
cmToQuotedMsg :: AChatMsgEvent -> Maybe QuotedMsg
cmToQuotedMsg = \case
  ACME SMsgEncoding e
_ (XMsgNew (MCQuote QuotedMsg
quotedMsg ExtMsgContent
_)) -> QuotedMsg -> Maybe QuotedMsg
forall a. a -> Maybe a
Just QuotedMsg
quotedMsg
  AChatMsgEvent
_ -> Maybe QuotedMsg
forall a. Maybe a
Nothing

data MsgContentTag
  = MCText_
  | MCLink_
  | MCImage_
  | MCVideo_
  | MCVoice_
  | MCFile_
  | MCReport_
  | MCChat_
  | MCUnknown_ Text
  deriving (MsgContentTag -> MsgContentTag -> Bool
(MsgContentTag -> MsgContentTag -> Bool)
-> (MsgContentTag -> MsgContentTag -> Bool) -> Eq MsgContentTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgContentTag -> MsgContentTag -> Bool
== :: MsgContentTag -> MsgContentTag -> Bool
$c/= :: MsgContentTag -> MsgContentTag -> Bool
/= :: MsgContentTag -> MsgContentTag -> Bool
Eq, Int -> MsgContentTag -> ShowS
[MsgContentTag] -> ShowS
MsgContentTag -> String
(Int -> MsgContentTag -> ShowS)
-> (MsgContentTag -> String)
-> ([MsgContentTag] -> ShowS)
-> Show MsgContentTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgContentTag -> ShowS
showsPrec :: Int -> MsgContentTag -> ShowS
$cshow :: MsgContentTag -> String
show :: MsgContentTag -> String
$cshowList :: [MsgContentTag] -> ShowS
showList :: [MsgContentTag] -> ShowS
Show)

instance StrEncoding MsgContentTag where
  strEncode :: MsgContentTag -> ByteString
strEncode = \case
    MsgContentTag
MCText_ -> ByteString
"text"
    MsgContentTag
MCLink_ -> ByteString
"link"
    MsgContentTag
MCImage_ -> ByteString
"image"
    MsgContentTag
MCVideo_ -> ByteString
"video"
    MsgContentTag
MCFile_ -> ByteString
"file"
    MsgContentTag
MCVoice_ -> ByteString
"voice"
    MsgContentTag
MCReport_ -> ByteString
"report"
    MsgContentTag
MCChat_ -> ByteString
"chat"
    MCUnknown_ MemberName
t -> MemberName -> ByteString
encodeUtf8 MemberName
t
  strDecode :: ByteString -> Either String MsgContentTag
strDecode = \case
    ByteString
"text" -> MsgContentTag -> Either String MsgContentTag
forall a b. b -> Either a b
Right MsgContentTag
MCText_
    ByteString
"link" -> MsgContentTag -> Either String MsgContentTag
forall a b. b -> Either a b
Right MsgContentTag
MCLink_
    ByteString
"image" -> MsgContentTag -> Either String MsgContentTag
forall a b. b -> Either a b
Right MsgContentTag
MCImage_
    ByteString
"video" -> MsgContentTag -> Either String MsgContentTag
forall a b. b -> Either a b
Right MsgContentTag
MCVideo_
    ByteString
"voice" -> MsgContentTag -> Either String MsgContentTag
forall a b. b -> Either a b
Right MsgContentTag
MCVoice_
    ByteString
"file" -> MsgContentTag -> Either String MsgContentTag
forall a b. b -> Either a b
Right MsgContentTag
MCFile_
    ByteString
"report" -> MsgContentTag -> Either String MsgContentTag
forall a b. b -> Either a b
Right MsgContentTag
MCReport_
    ByteString
"chat" -> MsgContentTag -> Either String MsgContentTag
forall a b. b -> Either a b
Right MsgContentTag
MCChat_
    ByteString
t -> MsgContentTag -> Either String MsgContentTag
forall a b. b -> Either a b
Right (MsgContentTag -> Either String MsgContentTag)
-> (MemberName -> MsgContentTag)
-> MemberName
-> Either String MsgContentTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemberName -> MsgContentTag
MCUnknown_ (MemberName -> Either String MsgContentTag)
-> MemberName -> Either String MsgContentTag
forall a b. (a -> b) -> a -> b
$ ByteString -> MemberName
safeDecodeUtf8 ByteString
t
  strP :: Parser MsgContentTag
strP = ByteString -> Either String MsgContentTag
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String MsgContentTag)
-> Parser ByteString -> Parser MsgContentTag
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Char -> Bool) -> Parser ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')

instance FromJSON MsgContentTag where
  parseJSON :: Value -> Parser MsgContentTag
parseJSON = String -> Value -> Parser MsgContentTag
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"MsgContentType"

instance ToJSON MsgContentTag where
  toJSON :: MsgContentTag -> Value
toJSON = MsgContentTag -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: MsgContentTag -> Encoding
toEncoding = MsgContentTag -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

instance ToField MsgContentTag where toField :: MsgContentTag -> SQLData
toField = MemberName -> SQLData
forall a. ToField a => a -> SQLData
toField (MemberName -> SQLData)
-> (MsgContentTag -> MemberName) -> MsgContentTag -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> MemberName
safeDecodeUtf8 (ByteString -> MemberName)
-> (MsgContentTag -> ByteString) -> MsgContentTag -> MemberName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgContentTag -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode

data MsgContainer
  = MCSimple ExtMsgContent
  | MCQuote QuotedMsg ExtMsgContent
  | MCComment MsgRef ExtMsgContent
  | MCForward ExtMsgContent
  deriving (MsgContainer -> MsgContainer -> Bool
(MsgContainer -> MsgContainer -> Bool)
-> (MsgContainer -> MsgContainer -> Bool) -> Eq MsgContainer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgContainer -> MsgContainer -> Bool
== :: MsgContainer -> MsgContainer -> Bool
$c/= :: MsgContainer -> MsgContainer -> Bool
/= :: MsgContainer -> MsgContainer -> Bool
Eq, Int -> MsgContainer -> ShowS
[MsgContainer] -> ShowS
MsgContainer -> String
(Int -> MsgContainer -> ShowS)
-> (MsgContainer -> String)
-> ([MsgContainer] -> ShowS)
-> Show MsgContainer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgContainer -> ShowS
showsPrec :: Int -> MsgContainer -> ShowS
$cshow :: MsgContainer -> String
show :: MsgContainer -> String
$cshowList :: [MsgContainer] -> ShowS
showList :: [MsgContainer] -> ShowS
Show)

mcExtMsgContent :: MsgContainer -> ExtMsgContent
mcExtMsgContent :: MsgContainer -> ExtMsgContent
mcExtMsgContent = \case
  MCSimple ExtMsgContent
c -> ExtMsgContent
c
  MCQuote QuotedMsg
_ ExtMsgContent
c -> ExtMsgContent
c
  MCComment MsgRef
_ ExtMsgContent
c -> ExtMsgContent
c
  MCForward ExtMsgContent
c -> ExtMsgContent
c

isMCForward :: MsgContainer -> Bool
isMCForward :: MsgContainer -> Bool
isMCForward = \case
  MCForward ExtMsgContent
_ -> Bool
True
  MsgContainer
_ -> Bool
False

data MsgContent
  = MCText {MsgContent -> MemberName
text :: Text}
  | MCLink {text :: Text, MsgContent -> LinkPreview
preview :: LinkPreview}
  | MCImage {text :: Text, MsgContent -> ImageData
image :: ImageData}
  | MCVideo {text :: Text, image :: ImageData, MsgContent -> Int
duration :: Int}
  | MCVoice {text :: Text, duration :: Int}
  | MCFile {text :: Text}
  | MCReport {text :: Text, MsgContent -> ReportReason
reason :: ReportReason}
  | MCChat {text :: Text, MsgContent -> MsgChatLink
chatLink :: MsgChatLink}
  | MCUnknown {MsgContent -> MemberName
tag :: Text, text :: Text, MsgContent -> Object
json :: J.Object}
  deriving (MsgContent -> MsgContent -> Bool
(MsgContent -> MsgContent -> Bool)
-> (MsgContent -> MsgContent -> Bool) -> Eq MsgContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgContent -> MsgContent -> Bool
== :: MsgContent -> MsgContent -> Bool
$c/= :: MsgContent -> MsgContent -> Bool
/= :: MsgContent -> MsgContent -> Bool
Eq, Int -> MsgContent -> ShowS
[MsgContent] -> ShowS
MsgContent -> String
(Int -> MsgContent -> ShowS)
-> (MsgContent -> String)
-> ([MsgContent] -> ShowS)
-> Show MsgContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgContent -> ShowS
showsPrec :: Int -> MsgContent -> ShowS
$cshow :: MsgContent -> String
show :: MsgContent -> String
$cshowList :: [MsgContent] -> ShowS
showList :: [MsgContent] -> ShowS
Show)

data MsgChatLink
  = MCLContact {MsgChatLink -> ShortLinkContact
connLink :: ShortLinkContact, MsgChatLink -> Profile
profile :: Profile, MsgChatLink -> Bool
business :: Bool}
  | MCLInvitation {MsgChatLink -> ShortLinkInvitation
invLink :: ShortLinkInvitation, profile :: Profile}
  | MCLGroup {connLink :: ShortLinkContact, MsgChatLink -> GroupProfile
groupProfile :: GroupProfile}
  deriving (MsgChatLink -> MsgChatLink -> Bool
(MsgChatLink -> MsgChatLink -> Bool)
-> (MsgChatLink -> MsgChatLink -> Bool) -> Eq MsgChatLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgChatLink -> MsgChatLink -> Bool
== :: MsgChatLink -> MsgChatLink -> Bool
$c/= :: MsgChatLink -> MsgChatLink -> Bool
/= :: MsgChatLink -> MsgChatLink -> Bool
Eq, Int -> MsgChatLink -> ShowS
[MsgChatLink] -> ShowS
MsgChatLink -> String
(Int -> MsgChatLink -> ShowS)
-> (MsgChatLink -> String)
-> ([MsgChatLink] -> ShowS)
-> Show MsgChatLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgChatLink -> ShowS
showsPrec :: Int -> MsgChatLink -> ShowS
$cshow :: MsgChatLink -> String
show :: MsgChatLink -> String
$cshowList :: [MsgChatLink] -> ShowS
showList :: [MsgChatLink] -> ShowS
Show)

msgContentText :: MsgContent -> Text
msgContentText :: MsgContent -> MemberName
msgContentText = \case
  MCText MemberName
t -> MemberName
t
  MCLink {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text} -> MemberName
text
  MCImage {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text} -> MemberName
text
  MCVideo {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text} -> MemberName
text
  MCVoice {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, Int
duration :: MsgContent -> Int
duration :: Int
duration} ->
    if MemberName -> Bool
T.null MemberName
text then MemberName
msg else MemberName
msg MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
"; " MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
text
    where
      msg :: MemberName
msg = MemberName
"voice message " MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> Int -> MemberName
durationText Int
duration
  MCFile MemberName
t -> MemberName
t
  MCReport {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, ReportReason
reason :: MsgContent -> ReportReason
reason :: ReportReason
reason} ->
    if MemberName -> Bool
T.null MemberName
text then MemberName
msg else MemberName
msg MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
": " MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
text
    where
      msg :: MemberName
msg = MemberName
"report " MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> ByteString -> MemberName
safeDecodeUtf8 (ReportReason -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ReportReason
reason)
  MCChat {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text} -> MemberName
text
  MCUnknown {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text} -> MemberName
text

durationText :: Int -> Text
durationText :: Int -> MemberName
durationText Int
duration =
  let (Int
mins, Int
secs) = Int
duration Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60 in String -> MemberName
T.pack (String -> MemberName) -> String -> MemberName
forall a b. (a -> b) -> a -> b
$ String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall {a}. (Ord a, Num a, Show a) => a -> String
with0 Int
mins String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall {a}. (Ord a, Num a, Show a) => a -> String
with0 Int
secs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  where
    with0 :: a -> String
with0 a
n
      | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9 = Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: a -> String
forall a. Show a => a -> String
show a
n
      | Bool
otherwise = a -> String
forall a. Show a => a -> String
show a
n

msgContentHasText :: MsgContent -> Bool
msgContentHasText :: MsgContent -> Bool
msgContentHasText =
  Bool -> Bool
not (Bool -> Bool) -> (MsgContent -> Bool) -> MsgContent -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemberName -> Bool
T.null (MemberName -> Bool)
-> (MsgContent -> MemberName) -> MsgContent -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    MCVoice {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text} -> MemberName
text
    MsgContent
mc -> MsgContent -> MemberName
msgContentText MsgContent
mc

isVoice :: MsgContent -> Bool
isVoice :: MsgContent -> Bool
isVoice = \case
  MCVoice {} -> Bool
True
  MsgContent
_ -> Bool
False

isReport :: MsgContent -> Bool
isReport :: MsgContent -> Bool
isReport = \case
  MCReport {} -> Bool
True
  MsgContent
_ -> Bool
False

msgContentTag :: MsgContent -> MsgContentTag
msgContentTag :: MsgContent -> MsgContentTag
msgContentTag = \case
  MCText MemberName
_ -> MsgContentTag
MCText_
  MCLink {} -> MsgContentTag
MCLink_
  MCImage {} -> MsgContentTag
MCImage_
  MCVideo {} -> MsgContentTag
MCVideo_
  MCVoice {} -> MsgContentTag
MCVoice_
  MCFile {} -> MsgContentTag
MCFile_
  MCReport {} -> MsgContentTag
MCReport_
  MCChat {} -> MsgContentTag
MCChat_
  MCUnknown {MemberName
tag :: MsgContent -> MemberName
tag :: MemberName
tag} -> MemberName -> MsgContentTag
MCUnknown_ MemberName
tag

data ExtMsgContent = ExtMsgContent
  { ExtMsgContent -> MsgContent
content :: MsgContent,
    -- the key used in mentions is a locally (per message) unique display name of member.
    -- Suffixes _1, _2 should be appended to make names locally unique.
    -- It should be done in the UI, as they will be part of the text, and validated in the API.
    ExtMsgContent -> Map MemberName MsgMention
mentions :: Map MemberName MsgMention,
    ExtMsgContent -> Maybe FileInvitation
file :: Maybe FileInvitation,
    ExtMsgContent -> Maybe Int
ttl :: Maybe Int,
    ExtMsgContent -> Maybe Bool
live :: Maybe Bool,
    ExtMsgContent -> Maybe MsgScope
scope :: Maybe MsgScope
  }
  deriving (ExtMsgContent -> ExtMsgContent -> Bool
(ExtMsgContent -> ExtMsgContent -> Bool)
-> (ExtMsgContent -> ExtMsgContent -> Bool) -> Eq ExtMsgContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtMsgContent -> ExtMsgContent -> Bool
== :: ExtMsgContent -> ExtMsgContent -> Bool
$c/= :: ExtMsgContent -> ExtMsgContent -> Bool
/= :: ExtMsgContent -> ExtMsgContent -> Bool
Eq, Int -> ExtMsgContent -> ShowS
[ExtMsgContent] -> ShowS
ExtMsgContent -> String
(Int -> ExtMsgContent -> ShowS)
-> (ExtMsgContent -> String)
-> ([ExtMsgContent] -> ShowS)
-> Show ExtMsgContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtMsgContent -> ShowS
showsPrec :: Int -> ExtMsgContent -> ShowS
$cshow :: ExtMsgContent -> String
show :: ExtMsgContent -> String
$cshowList :: [ExtMsgContent] -> ShowS
showList :: [ExtMsgContent] -> ShowS
Show)

data MsgMention = MsgMention {MsgMention -> MemberId
memberId :: MemberId}
  deriving (MsgMention -> MsgMention -> Bool
(MsgMention -> MsgMention -> Bool)
-> (MsgMention -> MsgMention -> Bool) -> Eq MsgMention
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgMention -> MsgMention -> Bool
== :: MsgMention -> MsgMention -> Bool
$c/= :: MsgMention -> MsgMention -> Bool
/= :: MsgMention -> MsgMention -> Bool
Eq, Int -> MsgMention -> ShowS
[MsgMention] -> ShowS
MsgMention -> String
(Int -> MsgMention -> ShowS)
-> (MsgMention -> String)
-> ([MsgMention] -> ShowS)
-> Show MsgMention
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgMention -> ShowS
showsPrec :: Int -> MsgMention -> ShowS
$cshow :: MsgMention -> String
show :: MsgMention -> String
$cshowList :: [MsgMention] -> ShowS
showList :: [MsgMention] -> ShowS
Show)

$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "MCL") ''MsgChatLink)

$(JQ.deriveJSON defaultJSON ''MsgMention)

$(JQ.deriveJSON defaultJSON ''QuotedMsg)

-- this limit reserves space for metadata in forwarded messages
-- 15780 (limit used for fileChunkSize) - 161 (x.grp.msg.forward overhead) = 15619, - 16 for block encryption ("rounded" to 15602)
maxEncodedMsgLength :: Int
maxEncodedMsgLength :: Int
maxEncodedMsgLength = Int
15602

-- maxEncodedMsgLength - 2222, see e2eEncUserMsgLength in agent
maxCompressedMsgLength :: Int
maxCompressedMsgLength :: Int
maxCompressedMsgLength = Int
13380

-- maxEncodedMsgLength - delta between MSG and INFO + 100 (returned for forward overhead)
-- delta between MSG and INFO = e2eEncUserMsgLength (no PQ) - e2eEncConnInfoLength (no PQ) = 1008
maxEncodedInfoLength :: Int
maxEncodedInfoLength :: Int
maxEncodedInfoLength = Int
14694

maxCompressedInfoLength :: Int
maxCompressedInfoLength :: Int
maxCompressedInfoLength = Int
10968 -- maxEncodedInfoLength - 3726, see e2eEncConnInfoLength in agent

data EncodedChatMessage = ECMEncoded ByteString | ECMLarge

encodeChatMessage :: MsgEncodingI e => Int -> ChatMessage e -> EncodedChatMessage
encodeChatMessage :: forall (e :: MsgEncoding).
MsgEncodingI e =>
Int -> ChatMessage e -> EncodedChatMessage
encodeChatMessage Int
maxSize ChatMessage e
msg = do
  case ChatMessage e -> AppMessage e
forall (e :: MsgEncoding).
MsgEncodingI e =>
ChatMessage e -> AppMessage e
chatToAppMessage ChatMessage e
msg of
    AMJson AppMessageJson
m -> do
      let body :: ByteString
body = LazyByteString -> ByteString
LB.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ AppMessageJson -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
J.encode AppMessageJson
m
      if ByteString -> Int
B.length ByteString
body Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxSize
        then EncodedChatMessage
ECMLarge
        else ByteString -> EncodedChatMessage
ECMEncoded ByteString
body
    AMBinary AppMessageBinary
m -> ByteString -> EncodedChatMessage
ECMEncoded (ByteString -> EncodedChatMessage)
-> ByteString -> EncodedChatMessage
forall a b. (a -> b) -> a -> b
$ AppMessageBinary -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode AppMessageBinary
m

parseChatMessages :: ByteString -> [Either String AChatMessage]
parseChatMessages :: ByteString -> [Either String AChatMessage]
parseChatMessages ByteString
"" = [String -> Either String AChatMessage
forall a b. a -> Either a b
Left String
"empty string"]
parseChatMessages ByteString
s = case ByteString -> Char
B.head ByteString
s of
  Char
'{' -> [SMsgEncoding 'Json -> ChatMessage 'Json -> AChatMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
SMsgEncoding e -> ChatMessage e -> AChatMessage
ACMsg SMsgEncoding 'Json
SJson (ChatMessage 'Json -> AChatMessage)
-> Either String (ChatMessage 'Json) -> Either String AChatMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String (ChatMessage 'Json)
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict' ByteString
s]
  Char
'[' -> case ByteString -> Either String [Value]
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict' ByteString
s of
    Right [Value]
v -> (Value -> Either String AChatMessage)
-> [Value] -> [Either String AChatMessage]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Either String AChatMessage
parseItem [Value]
v
    Left String
e -> [String -> Either String AChatMessage
forall a b. a -> Either a b
Left String
e]
  Char
'X' -> ByteString -> [Either String AChatMessage]
decodeCompressed (Int -> ByteString -> ByteString
B.drop Int
1 ByteString
s)
  Char
_ -> [SMsgEncoding 'Binary -> ChatMessage 'Binary -> AChatMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
SMsgEncoding e -> ChatMessage e -> AChatMessage
ACMsg SMsgEncoding 'Binary
SBinary (ChatMessage 'Binary -> AChatMessage)
-> Either String (ChatMessage 'Binary)
-> Either String AChatMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AppMessageBinary -> Either String (ChatMessage 'Binary)
appBinaryToCM (AppMessageBinary -> Either String (ChatMessage 'Binary))
-> Either String AppMessageBinary
-> Either String (ChatMessage 'Binary)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Either String AppMessageBinary
forall a. StrEncoding a => ByteString -> Either String a
strDecode ByteString
s)]
  where
    parseItem :: J.Value -> Either String AChatMessage
    parseItem :: Value -> Either String AChatMessage
parseItem Value
v = SMsgEncoding 'Json -> ChatMessage 'Json -> AChatMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
SMsgEncoding e -> ChatMessage e -> AChatMessage
ACMsg SMsgEncoding 'Json
SJson (ChatMessage 'Json -> AChatMessage)
-> Either String (ChatMessage 'Json) -> Either String AChatMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (ChatMessage 'Json))
-> Value -> Either String (ChatMessage 'Json)
forall a b. (a -> Parser b) -> a -> Either String b
JT.parseEither Value -> Parser (ChatMessage 'Json)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    decodeCompressed :: ByteString -> [Either String AChatMessage]
    decodeCompressed :: ByteString -> [Either String AChatMessage]
decodeCompressed ByteString
s' = case ByteString -> Either String (NonEmpty Compressed)
forall a. Encoding a => ByteString -> Either String a
smpDecode ByteString
s' of
      Left String
e -> [String -> Either String AChatMessage
forall a b. a -> Either a b
Left String
e]
      Right (NonEmpty Compressed
compressed :: L.NonEmpty Compressed) -> (Compressed -> [Either String AChatMessage])
-> NonEmpty Compressed -> [Either String AChatMessage]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> [Either String AChatMessage])
-> (ByteString -> [Either String AChatMessage])
-> Either String ByteString
-> [Either String AChatMessage]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either String AChatMessage -> [Either String AChatMessage]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String AChatMessage -> [Either String AChatMessage])
-> (String -> Either String AChatMessage)
-> String
-> [Either String AChatMessage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String AChatMessage
forall a b. a -> Either a b
Left) ByteString -> [Either String AChatMessage]
parseChatMessages (Either String ByteString -> [Either String AChatMessage])
-> (Compressed -> Either String ByteString)
-> Compressed
-> [Either String AChatMessage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compressed -> Either String ByteString
decompress1) NonEmpty Compressed
compressed

compressedBatchMsgBody_ :: MsgBody -> ByteString
compressedBatchMsgBody_ :: ByteString -> ByteString
compressedBatchMsgBody_ = ByteString -> ByteString
markCompressedBatch (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Compressed -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (NonEmpty Compressed -> ByteString)
-> (ByteString -> NonEmpty Compressed) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Compressed -> [Compressed] -> NonEmpty Compressed
forall a. a -> [a] -> NonEmpty a
L.:| []) (Compressed -> NonEmpty Compressed)
-> (ByteString -> Compressed) -> ByteString -> NonEmpty Compressed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Compressed
compress1

markCompressedBatch :: ByteString -> ByteString
markCompressedBatch :: ByteString -> ByteString
markCompressedBatch = Char -> ByteString -> ByteString
B.cons Char
'X'
{-# INLINE markCompressedBatch #-}

parseMsgContainer :: J.Object -> JT.Parser MsgContainer
parseMsgContainer :: Object -> Parser MsgContainer
parseMsgContainer Object
v =
  QuotedMsg -> ExtMsgContent -> MsgContainer
MCQuote (QuotedMsg -> ExtMsgContent -> MsgContainer)
-> Parser QuotedMsg -> Parser (ExtMsgContent -> MsgContainer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser QuotedMsg
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"quote" Parser (ExtMsgContent -> MsgContainer)
-> Parser ExtMsgContent -> Parser MsgContainer
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExtMsgContent
mc
    Parser MsgContainer -> Parser MsgContainer -> Parser MsgContainer
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MsgRef -> ExtMsgContent -> MsgContainer
MCComment (MsgRef -> ExtMsgContent -> MsgContainer)
-> Parser MsgRef -> Parser (ExtMsgContent -> MsgContainer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser MsgRef
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"parent" Parser (ExtMsgContent -> MsgContainer)
-> Parser ExtMsgContent -> Parser MsgContainer
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExtMsgContent
mc
    Parser MsgContainer -> Parser MsgContainer -> Parser MsgContainer
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"forward" Parser Bool -> (Bool -> Parser MsgContainer) -> Parser MsgContainer
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
f -> (if Bool
f then ExtMsgContent -> MsgContainer
MCForward else ExtMsgContent -> MsgContainer
MCSimple) (ExtMsgContent -> MsgContainer)
-> Parser ExtMsgContent -> Parser MsgContainer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ExtMsgContent
mc)
    -- The support for arbitrary object in "forward" property is added to allow
    -- forward compatibility with forwards that include public group links.
    Parser MsgContainer -> Parser MsgContainer -> Parser MsgContainer
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ExtMsgContent -> MsgContainer
MCForward (ExtMsgContent -> MsgContainer)
-> Parser ExtMsgContent -> Parser MsgContainer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"forward" :: JT.Parser J.Object) Parser Object -> Parser ExtMsgContent -> Parser ExtMsgContent
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ExtMsgContent
mc))
    Parser MsgContainer -> Parser MsgContainer -> Parser MsgContainer
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ExtMsgContent -> MsgContainer
MCSimple (ExtMsgContent -> MsgContainer)
-> Parser ExtMsgContent -> Parser MsgContainer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ExtMsgContent
mc
  where
    mc :: Parser ExtMsgContent
mc = do
      MsgContent
content <- Object
v Object -> Key -> Parser MsgContent
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"content"
      Maybe FileInvitation
file <- Object
v Object -> Key -> Parser (Maybe FileInvitation)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"file"
      Maybe Int
ttl <- Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ttl"
      Maybe Bool
live <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"live"
      Map MemberName MsgMention
mentions <- Map MemberName MsgMention
-> Maybe (Map MemberName MsgMention) -> Map MemberName MsgMention
forall a. a -> Maybe a -> a
fromMaybe Map MemberName MsgMention
forall k a. Map k a
M.empty (Maybe (Map MemberName MsgMention) -> Map MemberName MsgMention)
-> Parser (Maybe (Map MemberName MsgMention))
-> Parser (Map MemberName MsgMention)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Key -> Parser (Maybe (Map MemberName MsgMention))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mentions")
      Maybe MsgScope
scope <- Object
v Object -> Key -> Parser (Maybe MsgScope)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scope"
      ExtMsgContent -> Parser ExtMsgContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtMsgContent {MsgContent
content :: MsgContent
content :: MsgContent
content, Map MemberName MsgMention
mentions :: Map MemberName MsgMention
mentions :: Map MemberName MsgMention
mentions, Maybe FileInvitation
file :: Maybe FileInvitation
file :: Maybe FileInvitation
file, Maybe Int
ttl :: Maybe Int
ttl :: Maybe Int
ttl, Maybe Bool
live :: Maybe Bool
live :: Maybe Bool
live, Maybe MsgScope
scope :: Maybe MsgScope
scope :: Maybe MsgScope
scope}

extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent
extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent
extMsgContent MsgContent
mc Maybe FileInvitation
file = MsgContent
-> Map MemberName MsgMention
-> Maybe FileInvitation
-> Maybe Int
-> Maybe Bool
-> Maybe MsgScope
-> ExtMsgContent
ExtMsgContent MsgContent
mc Map MemberName MsgMention
forall k a. Map k a
M.empty Maybe FileInvitation
file Maybe Int
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe MsgScope
forall a. Maybe a
Nothing

justTrue :: Bool -> Maybe Bool
justTrue :: Bool -> Maybe Bool
justTrue Bool
True = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
justTrue Bool
False = Maybe Bool
forall a. Maybe a
Nothing

instance FromJSON MsgContent where
  parseJSON :: Value -> Parser MsgContent
parseJSON (J.Object Object
v) =
    Object
v Object -> Key -> Parser MsgContentTag
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" Parser MsgContentTag
-> (MsgContentTag -> Parser MsgContent) -> Parser MsgContent
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      MsgContentTag
MCText_ -> MemberName -> MsgContent
MCText (MemberName -> MsgContent)
-> Parser MemberName -> Parser MsgContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser MemberName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
      MsgContentTag
MCLink_ -> do
        MemberName
text <- Object
v Object -> Key -> Parser MemberName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
        LinkPreview
preview <- Object
v Object -> Key -> Parser LinkPreview
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"preview"
        MsgContent -> Parser MsgContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MCLink {MemberName
text :: MemberName
text :: MemberName
text, LinkPreview
preview :: LinkPreview
preview :: LinkPreview
preview}
      MsgContentTag
MCImage_ -> do
        MemberName
text <- Object
v Object -> Key -> Parser MemberName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
        ImageData
image <- Object
v Object -> Key -> Parser ImageData
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"image"
        MsgContent -> Parser MsgContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MCImage {MemberName
text :: MemberName
text :: MemberName
text, ImageData
image :: ImageData
image :: ImageData
image}
      MsgContentTag
MCVideo_ -> do
        MemberName
text <- Object
v Object -> Key -> Parser MemberName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
        ImageData
image <- Object
v Object -> Key -> Parser ImageData
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"image"
        Int
duration <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"duration"
        MsgContent -> Parser MsgContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MCVideo {MemberName
text :: MemberName
text :: MemberName
text, ImageData
image :: ImageData
image :: ImageData
image, Int
duration :: Int
duration :: Int
duration}
      MsgContentTag
MCVoice_ -> do
        MemberName
text <- Object
v Object -> Key -> Parser MemberName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
        Int
duration <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"duration"
        MsgContent -> Parser MsgContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MCVoice {MemberName
text :: MemberName
text :: MemberName
text, Int
duration :: Int
duration :: Int
duration}
      MsgContentTag
MCFile_ -> MemberName -> MsgContent
MCFile (MemberName -> MsgContent)
-> Parser MemberName -> Parser MsgContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser MemberName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
      MsgContentTag
MCReport_ -> do
        MemberName
text <- Object
v Object -> Key -> Parser MemberName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
        ReportReason
reason <- Object
v Object -> Key -> Parser ReportReason
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reason"
        MsgContent -> Parser MsgContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MCReport {MemberName
text :: MemberName
text :: MemberName
text, ReportReason
reason :: ReportReason
reason :: ReportReason
reason}
      MsgContentTag
MCChat_ -> do
        MemberName
text <- Object
v Object -> Key -> Parser MemberName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
        MsgChatLink
chatLink <- Object
v Object -> Key -> Parser MsgChatLink
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chatLink"
        MsgContent -> Parser MsgContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MCChat {MemberName
text :: MemberName
text :: MemberName
text, MsgChatLink
chatLink :: MsgChatLink
chatLink :: MsgChatLink
chatLink}
      MCUnknown_ MemberName
tag -> do
        MemberName
text <- MemberName -> Maybe MemberName -> MemberName
forall a. a -> Maybe a -> a
fromMaybe MemberName
unknownMsgType (Maybe MemberName -> MemberName)
-> Parser (Maybe MemberName) -> Parser MemberName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe MemberName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"text"
        MsgContent -> Parser MsgContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MCUnknown {MemberName
tag :: MemberName
tag :: MemberName
tag, MemberName
text :: MemberName
text :: MemberName
text, json :: Object
json = Object
v}
  parseJSON Value
invalid =
    String -> Parser MsgContent -> Parser MsgContent
forall a. String -> Parser a -> Parser a
JT.prependFailure String
"bad MsgContent, " (String -> Value -> Parser MsgContent
forall a. String -> Value -> Parser a
JT.typeMismatch String
"Object" Value
invalid)

unknownMsgType :: Text
unknownMsgType :: MemberName
unknownMsgType = MemberName
"unknown message type"

msgContainerJSON :: MsgContainer -> J.Object
msgContainerJSON :: MsgContainer -> Object
msgContainerJSON = \case
  MCQuote QuotedMsg
qm ExtMsgContent
mc -> [(Key, Value)] -> Object
forall {v}. [(Key, v)] -> KeyMap v
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"quote" Key -> QuotedMsg -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= QuotedMsg
qm) (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: ExtMsgContent -> [(Key, Value)]
msgContent ExtMsgContent
mc
  MCComment MsgRef
ref ExtMsgContent
mc -> [(Key, Value)] -> Object
forall {v}. [(Key, v)] -> KeyMap v
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"parent" Key -> MsgRef -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgRef
ref) (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: ExtMsgContent -> [(Key, Value)]
msgContent ExtMsgContent
mc
  MCForward ExtMsgContent
mc -> [(Key, Value)] -> Object
forall {v}. [(Key, v)] -> KeyMap v
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"forward" Key -> Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True) (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: ExtMsgContent -> [(Key, Value)]
msgContent ExtMsgContent
mc
  MCSimple ExtMsgContent
mc -> [(Key, Value)] -> Object
forall {v}. [(Key, v)] -> KeyMap v
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ ExtMsgContent -> [(Key, Value)]
msgContent ExtMsgContent
mc
  where
    o :: [(Key, v)] -> KeyMap v
o = [(Key, v)] -> KeyMap v
forall {v}. [(Key, v)] -> KeyMap v
JM.fromList
    msgContent :: ExtMsgContent -> [(Key, Value)]
msgContent ExtMsgContent {MsgContent
content :: ExtMsgContent -> MsgContent
content :: MsgContent
content, Map MemberName MsgMention
mentions :: ExtMsgContent -> Map MemberName MsgMention
mentions :: Map MemberName MsgMention
mentions, Maybe FileInvitation
file :: ExtMsgContent -> Maybe FileInvitation
file :: Maybe FileInvitation
file, Maybe Int
ttl :: ExtMsgContent -> Maybe Int
ttl :: Maybe Int
ttl, Maybe Bool
live :: ExtMsgContent -> Maybe Bool
live :: Maybe Bool
live, Maybe MsgScope
scope :: ExtMsgContent -> Maybe MsgScope
scope :: Maybe MsgScope
scope} =
      (Key
"file" Key -> Maybe FileInvitation -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe FileInvitation
file) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"ttl" Key -> Maybe Int -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe Int
ttl) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"live" Key -> Maybe Bool -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe Bool
live) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"mentions" Key
-> Maybe (Map MemberName MsgMention)
-> [(Key, Value)]
-> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Map MemberName MsgMention -> Maybe (Map MemberName MsgMention)
forall k v. Map k v -> Maybe (Map k v)
nonEmptyMap Map MemberName MsgMention
mentions) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MsgScope
scope) [Key
"content" Key -> MsgContent -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContent
content]

nonEmptyMap :: Map k v -> Maybe (Map k v)
nonEmptyMap :: forall k v. Map k v -> Maybe (Map k v)
nonEmptyMap Map k v
m = if Map k v -> Bool
forall k a. Map k a -> Bool
M.null Map k v
m then Maybe (Map k v)
forall a. Maybe a
Nothing else Map k v -> Maybe (Map k v)
forall a. a -> Maybe a
Just Map k v
m
{-# INLINE nonEmptyMap #-}

instance ToJSON MsgContent where
  toJSON :: MsgContent -> Value
toJSON = \case
    MCUnknown {Object
json :: MsgContent -> Object
json :: Object
json} -> Object -> Value
J.Object Object
json
    MCText MemberName
t -> [(Key, Value)] -> Value
J.object [Key
"type" Key -> MsgContentTag -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCText_, Key
"text" Key -> MemberName -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
t]
    MCLink {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, LinkPreview
preview :: MsgContent -> LinkPreview
preview :: LinkPreview
preview} -> [(Key, Value)] -> Value
J.object [Key
"type" Key -> MsgContentTag -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCLink_, Key
"text" Key -> MemberName -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text, Key
"preview" Key -> LinkPreview -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LinkPreview
preview]
    MCImage {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, ImageData
image :: MsgContent -> ImageData
image :: ImageData
image} -> [(Key, Value)] -> Value
J.object [Key
"type" Key -> MsgContentTag -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCImage_, Key
"text" Key -> MemberName -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text, Key
"image" Key -> ImageData -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ImageData
image]
    MCVideo {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, ImageData
image :: MsgContent -> ImageData
image :: ImageData
image, Int
duration :: MsgContent -> Int
duration :: Int
duration} -> [(Key, Value)] -> Value
J.object [Key
"type" Key -> MsgContentTag -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCVideo_, Key
"text" Key -> MemberName -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text, Key
"image" Key -> ImageData -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ImageData
image, Key
"duration" Key -> Int -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
duration]
    MCVoice {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, Int
duration :: MsgContent -> Int
duration :: Int
duration} -> [(Key, Value)] -> Value
J.object [Key
"type" Key -> MsgContentTag -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCVoice_, Key
"text" Key -> MemberName -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text, Key
"duration" Key -> Int -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
duration]
    MCFile MemberName
t -> [(Key, Value)] -> Value
J.object [Key
"type" Key -> MsgContentTag -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCFile_, Key
"text" Key -> MemberName -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
t]
    MCReport {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, ReportReason
reason :: MsgContent -> ReportReason
reason :: ReportReason
reason} -> [(Key, Value)] -> Value
J.object [Key
"type" Key -> MsgContentTag -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCReport_, Key
"text" Key -> MemberName -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text, Key
"reason" Key -> ReportReason -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReportReason
reason]
    MCChat {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, MsgChatLink
chatLink :: MsgContent -> MsgChatLink
chatLink :: MsgChatLink
chatLink} -> [(Key, Value)] -> Value
J.object [Key
"type" Key -> MsgContentTag -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCChat_, Key
"text" Key -> MemberName -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text, Key
"chatLink" Key -> MsgChatLink -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgChatLink
chatLink]
  toEncoding :: MsgContent -> Encoding
toEncoding = \case
    MCUnknown {Object
json :: MsgContent -> Object
json :: Object
json} -> Value -> Encoding
JE.value (Value -> Encoding) -> Value -> Encoding
forall a b. (a -> b) -> a -> b
$ Object -> Value
J.Object Object
json
    MCText MemberName
t -> Series -> Encoding
J.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> MsgContentTag -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCText_ Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"text" Key -> MemberName -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
t
    MCLink {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, LinkPreview
preview :: MsgContent -> LinkPreview
preview :: LinkPreview
preview} -> Series -> Encoding
J.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> MsgContentTag -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCLink_ Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"text" Key -> MemberName -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"preview" Key -> LinkPreview -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LinkPreview
preview
    MCImage {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, ImageData
image :: MsgContent -> ImageData
image :: ImageData
image} -> Series -> Encoding
J.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> MsgContentTag -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCImage_ Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"text" Key -> MemberName -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"image" Key -> ImageData -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ImageData
image
    MCVideo {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, ImageData
image :: MsgContent -> ImageData
image :: ImageData
image, Int
duration :: MsgContent -> Int
duration :: Int
duration} -> Series -> Encoding
J.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> MsgContentTag -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCVideo_ Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"text" Key -> MemberName -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"image" Key -> ImageData -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ImageData
image Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"duration" Key -> Int -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
duration
    MCVoice {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, Int
duration :: MsgContent -> Int
duration :: Int
duration} -> Series -> Encoding
J.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> MsgContentTag -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCVoice_ Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"text" Key -> MemberName -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"duration" Key -> Int -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
duration
    MCFile MemberName
t -> Series -> Encoding
J.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> MsgContentTag -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCFile_ Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"text" Key -> MemberName -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
t
    MCReport {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, ReportReason
reason :: MsgContent -> ReportReason
reason :: ReportReason
reason} -> Series -> Encoding
J.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> MsgContentTag -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCReport_ Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"text" Key -> MemberName -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"reason" Key -> ReportReason -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReportReason
reason
    MCChat {MemberName
text :: MsgContent -> MemberName
text :: MemberName
text, MsgChatLink
chatLink :: MsgContent -> MsgChatLink
chatLink :: MsgChatLink
chatLink} -> Series -> Encoding
J.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> MsgContentTag -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContentTag
MCChat_ Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"text" Key -> MemberName -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
text Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"chatLink" Key -> MsgChatLink -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgChatLink
chatLink

instance ToField MsgContent where
  toField :: MsgContent -> SQLData
toField = MemberName -> SQLData
forall a. ToField a => a -> SQLData
toField (MemberName -> SQLData)
-> (MsgContent -> MemberName) -> MsgContent -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgContent -> MemberName
forall a. ToJSON a => a -> MemberName
encodeJSON

instance FromField MsgContent where
  fromField :: FieldParser MsgContent
fromField = (MemberName -> Maybe MsgContent) -> FieldParser MsgContent
forall a. Typeable a => (MemberName -> Maybe a) -> Field -> Ok a
fromTextField_ MemberName -> Maybe MsgContent
forall a. FromJSON a => MemberName -> Maybe a
decodeJSON

data ACMEventTag = forall e. MsgEncodingI e => ACMEventTag (SMsgEncoding e) (CMEventTag e)

data CMEventTag (e :: MsgEncoding) where
  XMsgNew_ :: CMEventTag 'Json
  XMsgFileDescr_ :: CMEventTag 'Json
  XMsgUpdate_ :: CMEventTag 'Json
  XMsgDel_ :: CMEventTag 'Json
  XMsgDeleted_ :: CMEventTag 'Json
  XMsgReact_ :: CMEventTag 'Json
  XFile_ :: CMEventTag 'Json
  XFileAcpt_ :: CMEventTag 'Json
  XFileAcptInv_ :: CMEventTag 'Json
  XFileCancel_ :: CMEventTag 'Json
  XInfo_ :: CMEventTag 'Json
  XContact_ :: CMEventTag 'Json
  XDirectDel_ :: CMEventTag 'Json
  XGrpInv_ :: CMEventTag 'Json
  XGrpAcpt_ :: CMEventTag 'Json
  XGrpLinkInv_ :: CMEventTag 'Json
  XGrpLinkReject_ :: CMEventTag 'Json
  XGrpLinkMem_ :: CMEventTag 'Json
  XGrpLinkAcpt_ :: CMEventTag 'Json
  XGrpMemNew_ :: CMEventTag 'Json
  XGrpMemIntro_ :: CMEventTag 'Json
  XGrpMemInv_ :: CMEventTag 'Json
  XGrpMemFwd_ :: CMEventTag 'Json
  XGrpMemInfo_ :: CMEventTag 'Json
  XGrpMemRole_ :: CMEventTag 'Json
  XGrpMemRestrict_ :: CMEventTag 'Json
  XGrpMemCon_ :: CMEventTag 'Json
  XGrpMemConAll_ :: CMEventTag 'Json
  XGrpMemDel_ :: CMEventTag 'Json
  XGrpLeave_ :: CMEventTag 'Json
  XGrpDel_ :: CMEventTag 'Json
  XGrpInfo_ :: CMEventTag 'Json
  XGrpPrefs_ :: CMEventTag 'Json
  XGrpDirectInv_ :: CMEventTag 'Json
  XGrpMsgForward_ :: CMEventTag 'Json
  XInfoProbe_ :: CMEventTag 'Json
  XInfoProbeCheck_ :: CMEventTag 'Json
  XInfoProbeOk_ :: CMEventTag 'Json
  XCallInv_ :: CMEventTag 'Json
  XCallOffer_ :: CMEventTag 'Json
  XCallAnswer_ :: CMEventTag 'Json
  XCallExtra_ :: CMEventTag 'Json
  XCallEnd_ :: CMEventTag 'Json
  XOk_ :: CMEventTag 'Json
  XUnknown_ :: Text -> CMEventTag 'Json
  BFileChunk_ :: CMEventTag 'Binary

deriving instance Show (CMEventTag e)

deriving instance Eq (CMEventTag e)

instance MsgEncodingI e => StrEncoding (CMEventTag e) where
  strEncode :: CMEventTag e -> ByteString
strEncode = \case
    CMEventTag e
XMsgNew_ -> ByteString
"x.msg.new"
    CMEventTag e
XMsgFileDescr_ -> ByteString
"x.msg.file.descr"
    CMEventTag e
XMsgUpdate_ -> ByteString
"x.msg.update"
    CMEventTag e
XMsgDel_ -> ByteString
"x.msg.del"
    CMEventTag e
XMsgDeleted_ -> ByteString
"x.msg.deleted"
    CMEventTag e
XMsgReact_ -> ByteString
"x.msg.react"
    CMEventTag e
XFile_ -> ByteString
"x.file"
    CMEventTag e
XFileAcpt_ -> ByteString
"x.file.acpt"
    CMEventTag e
XFileAcptInv_ -> ByteString
"x.file.acpt.inv"
    CMEventTag e
XFileCancel_ -> ByteString
"x.file.cancel"
    CMEventTag e
XInfo_ -> ByteString
"x.info"
    CMEventTag e
XContact_ -> ByteString
"x.contact"
    CMEventTag e
XDirectDel_ -> ByteString
"x.direct.del"
    CMEventTag e
XGrpInv_ -> ByteString
"x.grp.inv"
    CMEventTag e
XGrpAcpt_ -> ByteString
"x.grp.acpt"
    CMEventTag e
XGrpLinkInv_ -> ByteString
"x.grp.link.inv"
    CMEventTag e
XGrpLinkReject_ -> ByteString
"x.grp.link.reject"
    CMEventTag e
XGrpLinkMem_ -> ByteString
"x.grp.link.mem"
    CMEventTag e
XGrpLinkAcpt_ -> ByteString
"x.grp.link.acpt"
    CMEventTag e
XGrpMemNew_ -> ByteString
"x.grp.mem.new"
    CMEventTag e
XGrpMemIntro_ -> ByteString
"x.grp.mem.intro"
    CMEventTag e
XGrpMemInv_ -> ByteString
"x.grp.mem.inv"
    CMEventTag e
XGrpMemFwd_ -> ByteString
"x.grp.mem.fwd"
    CMEventTag e
XGrpMemInfo_ -> ByteString
"x.grp.mem.info"
    CMEventTag e
XGrpMemRole_ -> ByteString
"x.grp.mem.role"
    CMEventTag e
XGrpMemRestrict_ -> ByteString
"x.grp.mem.restrict"
    CMEventTag e
XGrpMemCon_ -> ByteString
"x.grp.mem.con"
    CMEventTag e
XGrpMemConAll_ -> ByteString
"x.grp.mem.con.all"
    CMEventTag e
XGrpMemDel_ -> ByteString
"x.grp.mem.del"
    CMEventTag e
XGrpLeave_ -> ByteString
"x.grp.leave"
    CMEventTag e
XGrpDel_ -> ByteString
"x.grp.del"
    CMEventTag e
XGrpInfo_ -> ByteString
"x.grp.info"
    CMEventTag e
XGrpPrefs_ -> ByteString
"x.grp.prefs"
    CMEventTag e
XGrpDirectInv_ -> ByteString
"x.grp.direct.inv"
    CMEventTag e
XGrpMsgForward_ -> ByteString
"x.grp.msg.forward"
    CMEventTag e
XInfoProbe_ -> ByteString
"x.info.probe"
    CMEventTag e
XInfoProbeCheck_ -> ByteString
"x.info.probe.check"
    CMEventTag e
XInfoProbeOk_ -> ByteString
"x.info.probe.ok"
    CMEventTag e
XCallInv_ -> ByteString
"x.call.inv"
    CMEventTag e
XCallOffer_ -> ByteString
"x.call.offer"
    CMEventTag e
XCallAnswer_ -> ByteString
"x.call.answer"
    CMEventTag e
XCallExtra_ -> ByteString
"x.call.extra"
    CMEventTag e
XCallEnd_ -> ByteString
"x.call.end"
    CMEventTag e
XOk_ -> ByteString
"x.ok"
    XUnknown_ MemberName
t -> MemberName -> ByteString
encodeUtf8 MemberName
t
    CMEventTag e
BFileChunk_ -> ByteString
"F"
  strDecode :: ByteString -> Either String (CMEventTag e)
strDecode = (\(ACMEventTag SMsgEncoding e
_ CMEventTag e
t) -> CMEventTag e -> Either String (CMEventTag e)
forall (t :: MsgEncoding -> *) (e :: MsgEncoding)
       (e' :: MsgEncoding).
(MsgEncodingI e, MsgEncodingI e') =>
t e' -> Either String (t e)
checkEncoding CMEventTag e
t) (ACMEventTag -> Either String (CMEventTag e))
-> (ByteString -> Either String ACMEventTag)
-> ByteString
-> Either String (CMEventTag e)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Either String ACMEventTag
forall a. StrEncoding a => ByteString -> Either String a
strDecode
  strP :: Parser (CMEventTag e)
strP = ByteString -> Either String (CMEventTag e)
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String (CMEventTag e))
-> Parser ByteString -> Parser (CMEventTag e)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Char -> Bool) -> Parser ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')

instance StrEncoding ACMEventTag where
  strEncode :: ACMEventTag -> ByteString
strEncode (ACMEventTag SMsgEncoding e
_ CMEventTag e
t) = CMEventTag e -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode CMEventTag e
t
  strP :: Parser ACMEventTag
strP =
    ((,) (Char -> ByteString -> (Char, ByteString))
-> Parser Char
-> Parser ByteString (ByteString -> (Char, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
A.peekChar' Parser ByteString (ByteString -> (Char, ByteString))
-> Parser ByteString -> Parser ByteString (Char, ByteString)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')) Parser ByteString (Char, ByteString)
-> ((Char, ByteString) -> Parser ACMEventTag) -> Parser ACMEventTag
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (Char
'x', ByteString
t) -> ACMEventTag -> Parser ACMEventTag
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACMEventTag -> Parser ACMEventTag)
-> (CMEventTag 'Json -> ACMEventTag)
-> CMEventTag 'Json
-> Parser ACMEventTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMsgEncoding 'Json -> CMEventTag 'Json -> ACMEventTag
forall (e :: MsgEncoding).
MsgEncodingI e =>
SMsgEncoding e -> CMEventTag e -> ACMEventTag
ACMEventTag SMsgEncoding 'Json
SJson (CMEventTag 'Json -> Parser ACMEventTag)
-> CMEventTag 'Json -> Parser ACMEventTag
forall a b. (a -> b) -> a -> b
$ case ByteString
t of
        ByteString
"x.msg.new" -> CMEventTag 'Json
XMsgNew_
        ByteString
"x.msg.file.descr" -> CMEventTag 'Json
XMsgFileDescr_
        ByteString
"x.msg.update" -> CMEventTag 'Json
XMsgUpdate_
        ByteString
"x.msg.del" -> CMEventTag 'Json
XMsgDel_
        ByteString
"x.msg.deleted" -> CMEventTag 'Json
XMsgDeleted_
        ByteString
"x.msg.react" -> CMEventTag 'Json
XMsgReact_
        ByteString
"x.file" -> CMEventTag 'Json
XFile_
        ByteString
"x.file.acpt" -> CMEventTag 'Json
XFileAcpt_
        ByteString
"x.file.acpt.inv" -> CMEventTag 'Json
XFileAcptInv_
        ByteString
"x.file.cancel" -> CMEventTag 'Json
XFileCancel_
        ByteString
"x.info" -> CMEventTag 'Json
XInfo_
        ByteString
"x.contact" -> CMEventTag 'Json
XContact_
        ByteString
"x.direct.del" -> CMEventTag 'Json
XDirectDel_
        ByteString
"x.grp.inv" -> CMEventTag 'Json
XGrpInv_
        ByteString
"x.grp.acpt" -> CMEventTag 'Json
XGrpAcpt_
        ByteString
"x.grp.link.inv" -> CMEventTag 'Json
XGrpLinkInv_
        ByteString
"x.grp.link.reject" -> CMEventTag 'Json
XGrpLinkReject_
        ByteString
"x.grp.link.mem" -> CMEventTag 'Json
XGrpLinkMem_
        ByteString
"x.grp.link.acpt" -> CMEventTag 'Json
XGrpLinkAcpt_
        ByteString
"x.grp.mem.new" -> CMEventTag 'Json
XGrpMemNew_
        ByteString
"x.grp.mem.intro" -> CMEventTag 'Json
XGrpMemIntro_
        ByteString
"x.grp.mem.inv" -> CMEventTag 'Json
XGrpMemInv_
        ByteString
"x.grp.mem.fwd" -> CMEventTag 'Json
XGrpMemFwd_
        ByteString
"x.grp.mem.info" -> CMEventTag 'Json
XGrpMemInfo_
        ByteString
"x.grp.mem.role" -> CMEventTag 'Json
XGrpMemRole_
        ByteString
"x.grp.mem.restrict" -> CMEventTag 'Json
XGrpMemRestrict_
        ByteString
"x.grp.mem.con" -> CMEventTag 'Json
XGrpMemCon_
        ByteString
"x.grp.mem.con.all" -> CMEventTag 'Json
XGrpMemConAll_
        ByteString
"x.grp.mem.del" -> CMEventTag 'Json
XGrpMemDel_
        ByteString
"x.grp.leave" -> CMEventTag 'Json
XGrpLeave_
        ByteString
"x.grp.del" -> CMEventTag 'Json
XGrpDel_
        ByteString
"x.grp.info" -> CMEventTag 'Json
XGrpInfo_
        ByteString
"x.grp.prefs" -> CMEventTag 'Json
XGrpPrefs_
        ByteString
"x.grp.direct.inv" -> CMEventTag 'Json
XGrpDirectInv_
        ByteString
"x.grp.msg.forward" -> CMEventTag 'Json
XGrpMsgForward_
        ByteString
"x.info.probe" -> CMEventTag 'Json
XInfoProbe_
        ByteString
"x.info.probe.check" -> CMEventTag 'Json
XInfoProbeCheck_
        ByteString
"x.info.probe.ok" -> CMEventTag 'Json
XInfoProbeOk_
        ByteString
"x.call.inv" -> CMEventTag 'Json
XCallInv_
        ByteString
"x.call.offer" -> CMEventTag 'Json
XCallOffer_
        ByteString
"x.call.answer" -> CMEventTag 'Json
XCallAnswer_
        ByteString
"x.call.extra" -> CMEventTag 'Json
XCallExtra_
        ByteString
"x.call.end" -> CMEventTag 'Json
XCallEnd_
        ByteString
"x.ok" -> CMEventTag 'Json
XOk_
        ByteString
_ -> MemberName -> CMEventTag 'Json
XUnknown_ (MemberName -> CMEventTag 'Json) -> MemberName -> CMEventTag 'Json
forall a b. (a -> b) -> a -> b
$ ByteString -> MemberName
safeDecodeUtf8 ByteString
t
      (Char
_, ByteString
"F") -> ACMEventTag -> Parser ACMEventTag
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACMEventTag -> Parser ACMEventTag)
-> ACMEventTag -> Parser ACMEventTag
forall a b. (a -> b) -> a -> b
$ SMsgEncoding 'Binary -> CMEventTag 'Binary -> ACMEventTag
forall (e :: MsgEncoding).
MsgEncodingI e =>
SMsgEncoding e -> CMEventTag e -> ACMEventTag
ACMEventTag SMsgEncoding 'Binary
SBinary CMEventTag 'Binary
BFileChunk_
      (Char, ByteString)
_ -> String -> Parser ACMEventTag
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad ACMEventTag"

toCMEventTag :: ChatMsgEvent e -> CMEventTag e
toCMEventTag :: forall (e :: MsgEncoding). ChatMsgEvent e -> CMEventTag e
toCMEventTag ChatMsgEvent e
msg = case ChatMsgEvent e
msg of
  XMsgNew MsgContainer
_ -> CMEventTag e
CMEventTag 'Json
XMsgNew_
  XMsgFileDescr SharedMsgId
_ FileDescr
_ -> CMEventTag e
CMEventTag 'Json
XMsgFileDescr_
  XMsgUpdate {} -> CMEventTag e
CMEventTag 'Json
XMsgUpdate_
  XMsgDel {} -> CMEventTag e
CMEventTag 'Json
XMsgDel_
  ChatMsgEvent e
XMsgDeleted -> CMEventTag e
CMEventTag 'Json
XMsgDeleted_
  XMsgReact {} -> CMEventTag e
CMEventTag 'Json
XMsgReact_
  XFile FileInvitation
_ -> CMEventTag e
CMEventTag 'Json
XFile_
  XFileAcpt String
_ -> CMEventTag e
CMEventTag 'Json
XFileAcpt_
  XFileAcptInv {} -> CMEventTag e
CMEventTag 'Json
XFileAcptInv_
  XFileCancel SharedMsgId
_ -> CMEventTag e
CMEventTag 'Json
XFileCancel_
  XInfo Profile
_ -> CMEventTag e
CMEventTag 'Json
XInfo_
  XContact {} -> CMEventTag e
CMEventTag 'Json
XContact_
  ChatMsgEvent e
XDirectDel -> CMEventTag e
CMEventTag 'Json
XDirectDel_
  XGrpInv GroupInvitation
_ -> CMEventTag e
CMEventTag 'Json
XGrpInv_
  XGrpAcpt MemberId
_ -> CMEventTag e
CMEventTag 'Json
XGrpAcpt_
  XGrpLinkInv GroupLinkInvitation
_ -> CMEventTag e
CMEventTag 'Json
XGrpLinkInv_
  XGrpLinkReject GroupLinkRejection
_ -> CMEventTag e
CMEventTag 'Json
XGrpLinkReject_
  XGrpLinkMem Profile
_ -> CMEventTag e
CMEventTag 'Json
XGrpLinkMem_
  XGrpLinkAcpt {} -> CMEventTag e
CMEventTag 'Json
XGrpLinkAcpt_
  XGrpMemNew {} -> CMEventTag e
CMEventTag 'Json
XGrpMemNew_
  XGrpMemIntro MemberInfo
_ Maybe MemberRestrictions
_ -> CMEventTag e
CMEventTag 'Json
XGrpMemIntro_
  XGrpMemInv MemberId
_ IntroInvitation
_ -> CMEventTag e
CMEventTag 'Json
XGrpMemInv_
  XGrpMemFwd MemberInfo
_ IntroInvitation
_ -> CMEventTag e
CMEventTag 'Json
XGrpMemFwd_
  XGrpMemInfo MemberId
_ Profile
_ -> CMEventTag e
CMEventTag 'Json
XGrpMemInfo_
  XGrpMemRole MemberId
_ GroupMemberRole
_ -> CMEventTag e
CMEventTag 'Json
XGrpMemRole_
  XGrpMemRestrict MemberId
_ MemberRestrictions
_ -> CMEventTag e
CMEventTag 'Json
XGrpMemRestrict_
  XGrpMemCon MemberId
_ -> CMEventTag e
CMEventTag 'Json
XGrpMemCon_
  XGrpMemConAll MemberId
_ -> CMEventTag e
CMEventTag 'Json
XGrpMemConAll_
  XGrpMemDel {} -> CMEventTag e
CMEventTag 'Json
XGrpMemDel_
  ChatMsgEvent e
XGrpLeave -> CMEventTag e
CMEventTag 'Json
XGrpLeave_
  ChatMsgEvent e
XGrpDel -> CMEventTag e
CMEventTag 'Json
XGrpDel_
  XGrpInfo GroupProfile
_ -> CMEventTag e
CMEventTag 'Json
XGrpInfo_
  XGrpPrefs GroupPreferences
_ -> CMEventTag e
CMEventTag 'Json
XGrpPrefs_
  XGrpDirectInv {} -> CMEventTag e
CMEventTag 'Json
XGrpDirectInv_
  XGrpMsgForward {} -> CMEventTag e
CMEventTag 'Json
XGrpMsgForward_
  XInfoProbe Probe
_ -> CMEventTag e
CMEventTag 'Json
XInfoProbe_
  XInfoProbeCheck ProbeHash
_ -> CMEventTag e
CMEventTag 'Json
XInfoProbeCheck_
  XInfoProbeOk Probe
_ -> CMEventTag e
CMEventTag 'Json
XInfoProbeOk_
  XCallInv CallId
_ CallInvitation
_ -> CMEventTag e
CMEventTag 'Json
XCallInv_
  XCallOffer CallId
_ CallOffer
_ -> CMEventTag e
CMEventTag 'Json
XCallOffer_
  XCallAnswer CallId
_ CallAnswer
_ -> CMEventTag e
CMEventTag 'Json
XCallAnswer_
  XCallExtra CallId
_ CallExtraInfo
_ -> CMEventTag e
CMEventTag 'Json
XCallExtra_
  XCallEnd CallId
_ -> CMEventTag e
CMEventTag 'Json
XCallEnd_
  ChatMsgEvent e
XOk -> CMEventTag e
CMEventTag 'Json
XOk_
  XUnknown MemberName
t Object
_ -> MemberName -> CMEventTag 'Json
XUnknown_ MemberName
t
  BFileChunk SharedMsgId
_ FileChunk
_ -> CMEventTag e
CMEventTag 'Binary
BFileChunk_

instance MsgEncodingI e => TextEncoding (CMEventTag e) where
  textEncode :: CMEventTag e -> MemberName
textEncode = ByteString -> MemberName
decodeLatin1 (ByteString -> MemberName)
-> (CMEventTag e -> ByteString) -> CMEventTag e -> MemberName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMEventTag e -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode
  textDecode :: MemberName -> Maybe (CMEventTag e)
textDecode = Either String (CMEventTag e) -> Maybe (CMEventTag e)
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String (CMEventTag e) -> Maybe (CMEventTag e))
-> (MemberName -> Either String (CMEventTag e))
-> MemberName
-> Maybe (CMEventTag e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (CMEventTag e)
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String (CMEventTag e))
-> (MemberName -> ByteString)
-> MemberName
-> Either String (CMEventTag e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemberName -> ByteString
encodeUtf8

instance TextEncoding ACMEventTag where
  textEncode :: ACMEventTag -> MemberName
textEncode (ACMEventTag SMsgEncoding e
_ CMEventTag e
t) = CMEventTag e -> MemberName
forall a. TextEncoding a => a -> MemberName
textEncode CMEventTag e
t
  textDecode :: MemberName -> Maybe ACMEventTag
textDecode = Either String ACMEventTag -> Maybe ACMEventTag
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String ACMEventTag -> Maybe ACMEventTag)
-> (MemberName -> Either String ACMEventTag)
-> MemberName
-> Maybe ACMEventTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ACMEventTag
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String ACMEventTag)
-> (MemberName -> ByteString)
-> MemberName
-> Either String ACMEventTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemberName -> ByteString
encodeUtf8

instance (MsgEncodingI e, Typeable e) => FromField (CMEventTag e) where fromField :: FieldParser (CMEventTag e)
fromField = (MemberName -> Maybe (CMEventTag e)) -> FieldParser (CMEventTag e)
forall a. Typeable a => (MemberName -> Maybe a) -> Field -> Ok a
fromTextField_ MemberName -> Maybe (CMEventTag e)
forall a. TextEncoding a => MemberName -> Maybe a
textDecode

instance MsgEncodingI e => ToField (CMEventTag e) where toField :: CMEventTag e -> SQLData
toField = MemberName -> SQLData
forall a. ToField a => a -> SQLData
toField (MemberName -> SQLData)
-> (CMEventTag e -> MemberName) -> CMEventTag e -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMEventTag e -> MemberName
forall a. TextEncoding a => a -> MemberName
textEncode

instance FromField ACMEventTag where fromField :: FieldParser ACMEventTag
fromField = (MemberName -> Maybe ACMEventTag) -> FieldParser ACMEventTag
forall a. Typeable a => (MemberName -> Maybe a) -> Field -> Ok a
fromTextField_ MemberName -> Maybe ACMEventTag
forall a. TextEncoding a => MemberName -> Maybe a
textDecode

instance ToField ACMEventTag where toField :: ACMEventTag -> SQLData
toField = MemberName -> SQLData
forall a. ToField a => a -> SQLData
toField (MemberName -> SQLData)
-> (ACMEventTag -> MemberName) -> ACMEventTag -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ACMEventTag -> MemberName
forall a. TextEncoding a => a -> MemberName
textEncode

hasNotification :: CMEventTag e -> Bool
hasNotification :: forall (e :: MsgEncoding). CMEventTag e -> Bool
hasNotification = \case
  CMEventTag e
XMsgNew_ -> Bool
True
  CMEventTag e
XFile_ -> Bool
True
  CMEventTag e
XContact_ -> Bool
True
  CMEventTag e
XGrpInv_ -> Bool
True
  CMEventTag e
XGrpMemFwd_ -> Bool
True
  CMEventTag e
XGrpDel_ -> Bool
True
  CMEventTag e
XCallInv_ -> Bool
True
  CMEventTag e
_ -> Bool
False

hasDeliveryReceipt :: CMEventTag e -> Bool
hasDeliveryReceipt :: forall (e :: MsgEncoding). CMEventTag e -> Bool
hasDeliveryReceipt = \case
  CMEventTag e
XMsgNew_ -> Bool
True
  CMEventTag e
XGrpInv_ -> Bool
True
  CMEventTag e
XCallInv_ -> Bool
True
  CMEventTag e
_ -> Bool
False

appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary)
appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary)
appBinaryToCM AppMessageBinary {Maybe SharedMsgId
msgId :: AppMessageBinary -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, Char
tag :: AppMessageBinary -> Char
tag :: Char
tag, ByteString
body :: AppMessageBinary -> ByteString
body :: ByteString
body} = do
  CMEventTag 'Binary
eventTag <- ByteString -> Either String (CMEventTag 'Binary)
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String (CMEventTag 'Binary))
-> ByteString -> Either String (CMEventTag 'Binary)
forall a b. (a -> b) -> a -> b
$ Char -> ByteString
B.singleton Char
tag
  ChatMsgEvent 'Binary
chatMsgEvent <- Parser (ChatMsgEvent 'Binary)
-> ByteString -> Either String (ChatMsgEvent 'Binary)
forall a. Parser a -> ByteString -> Either String a
parseAll (CMEventTag 'Binary -> Parser (ChatMsgEvent 'Binary)
msg CMEventTag 'Binary
eventTag) ByteString
body
  ChatMessage 'Binary -> Either String (ChatMessage 'Binary)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatMessage {chatVRange :: VersionRangeChat
chatVRange = VersionRangeChat
chatInitialVRange, Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, ChatMsgEvent 'Binary
chatMsgEvent :: ChatMsgEvent 'Binary
chatMsgEvent :: ChatMsgEvent 'Binary
chatMsgEvent}
  where
    msg :: CMEventTag 'Binary -> A.Parser (ChatMsgEvent 'Binary)
    msg :: CMEventTag 'Binary -> Parser (ChatMsgEvent 'Binary)
msg = \case
      CMEventTag 'Binary
BFileChunk_ -> SharedMsgId -> FileChunk -> ChatMsgEvent 'Binary
BFileChunk (SharedMsgId -> FileChunk -> ChatMsgEvent 'Binary)
-> Parser ByteString SharedMsgId
-> Parser ByteString (FileChunk -> ChatMsgEvent 'Binary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> SharedMsgId
SharedMsgId (ByteString -> SharedMsgId)
-> Parser ByteString -> Parser ByteString SharedMsgId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
forall a. Encoding a => Parser a
smpP) Parser ByteString (FileChunk -> ChatMsgEvent 'Binary)
-> Parser FileChunk -> Parser (ChatMsgEvent 'Binary)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (InlineFileChunk -> FileChunk
unIFC (InlineFileChunk -> FileChunk)
-> Parser InlineFileChunk -> Parser FileChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InlineFileChunk
forall a. Encoding a => Parser a
smpP)

appJsonToCM :: AppMessageJson -> Either String (ChatMessage 'Json)
appJsonToCM :: AppMessageJson -> Either String (ChatMessage 'Json)
appJsonToCM AppMessageJson {Maybe ChatVersionRange
v :: AppMessageJson -> Maybe ChatVersionRange
v :: Maybe ChatVersionRange
v, Maybe SharedMsgId
msgId :: AppMessageJson -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, MemberName
event :: AppMessageJson -> MemberName
event :: MemberName
event, Object
params :: AppMessageJson -> Object
params :: Object
params} = do
  CMEventTag 'Json
eventTag <- ByteString -> Either String (CMEventTag 'Json)
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String (CMEventTag 'Json))
-> ByteString -> Either String (CMEventTag 'Json)
forall a b. (a -> b) -> a -> b
$ MemberName -> ByteString
encodeUtf8 MemberName
event
  ChatMsgEvent 'Json
chatMsgEvent <- CMEventTag 'Json -> Either String (ChatMsgEvent 'Json)
msg CMEventTag 'Json
eventTag
  ChatMessage 'Json -> Either String (ChatMessage 'Json)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatMessage {chatVRange :: VersionRangeChat
chatVRange = VersionRangeChat
-> (ChatVersionRange -> VersionRangeChat)
-> Maybe ChatVersionRange
-> VersionRangeChat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionRangeChat
chatInitialVRange ChatVersionRange -> VersionRangeChat
fromChatVRange Maybe ChatVersionRange
v, Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, ChatMsgEvent 'Json
chatMsgEvent :: ChatMsgEvent 'Json
chatMsgEvent :: ChatMsgEvent 'Json
chatMsgEvent}
  where
    p :: FromJSON a => J.Key -> Either String a
    p :: forall a. FromJSON a => Key -> Either String a
p Key
key = (Object -> Parser a) -> Object -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
JT.parseEither (Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
key) Object
params
    opt :: FromJSON a => J.Key -> Either String (Maybe a)
    opt :: forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
key = (Object -> Parser (Maybe a)) -> Object -> Either String (Maybe a)
forall a b. (a -> Parser b) -> a -> Either String b
JT.parseEither (Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
key) Object
params
    msg :: CMEventTag 'Json -> Either String (ChatMsgEvent 'Json)
    msg :: CMEventTag 'Json -> Either String (ChatMsgEvent 'Json)
msg = \case
      CMEventTag 'Json
XMsgNew_ -> MsgContainer -> ChatMsgEvent 'Json
XMsgNew (MsgContainer -> ChatMsgEvent 'Json)
-> Either String MsgContainer -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object -> Parser MsgContainer)
-> Object -> Either String MsgContainer
forall a b. (a -> Parser b) -> a -> Either String b
JT.parseEither Object -> Parser MsgContainer
parseMsgContainer Object
params
      CMEventTag 'Json
XMsgFileDescr_ -> SharedMsgId -> FileDescr -> ChatMsgEvent 'Json
XMsgFileDescr (SharedMsgId -> FileDescr -> ChatMsgEvent 'Json)
-> Either String SharedMsgId
-> Either String (FileDescr -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String SharedMsgId
forall a. FromJSON a => Key -> Either String a
p Key
"msgId" Either String (FileDescr -> ChatMsgEvent 'Json)
-> Either String FileDescr -> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String FileDescr
forall a. FromJSON a => Key -> Either String a
p Key
"fileDescr"
      CMEventTag 'Json
XMsgUpdate_ -> do
        SharedMsgId
msgId' <- Key -> Either String SharedMsgId
forall a. FromJSON a => Key -> Either String a
p Key
"msgId"
        MsgContent
content <- Key -> Either String MsgContent
forall a. FromJSON a => Key -> Either String a
p Key
"content"
        Map MemberName MsgMention
mentions <- Map MemberName MsgMention
-> Maybe (Map MemberName MsgMention) -> Map MemberName MsgMention
forall a. a -> Maybe a -> a
fromMaybe Map MemberName MsgMention
forall k a. Map k a
M.empty (Maybe (Map MemberName MsgMention) -> Map MemberName MsgMention)
-> Either String (Maybe (Map MemberName MsgMention))
-> Either String (Map MemberName MsgMention)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String (Maybe (Map MemberName MsgMention))
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"mentions"
        Maybe Int
ttl <- Key -> Either String (Maybe Int)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"ttl"
        Maybe Bool
live <- Key -> Either String (Maybe Bool)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"live"
        Maybe MsgScope
scope <- Key -> Either String (Maybe MsgScope)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"scope"
        ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure XMsgUpdate {msgId :: SharedMsgId
msgId = SharedMsgId
msgId', MsgContent
content :: MsgContent
content :: MsgContent
content, Map MemberName MsgMention
mentions :: Map MemberName MsgMention
mentions :: Map MemberName MsgMention
mentions, Maybe Int
ttl :: Maybe Int
ttl :: Maybe Int
ttl, Maybe Bool
live :: Maybe Bool
live :: Maybe Bool
live, Maybe MsgScope
scope :: Maybe MsgScope
scope :: Maybe MsgScope
scope}
      CMEventTag 'Json
XMsgDel_ -> SharedMsgId
-> Maybe MemberId -> Maybe MsgScope -> ChatMsgEvent 'Json
XMsgDel (SharedMsgId
 -> Maybe MemberId -> Maybe MsgScope -> ChatMsgEvent 'Json)
-> Either String SharedMsgId
-> Either
     String (Maybe MemberId -> Maybe MsgScope -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String SharedMsgId
forall a. FromJSON a => Key -> Either String a
p Key
"msgId" Either
  String (Maybe MemberId -> Maybe MsgScope -> ChatMsgEvent 'Json)
-> Either String (Maybe MemberId)
-> Either String (Maybe MsgScope -> ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (Maybe MemberId)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"memberId" Either String (Maybe MsgScope -> ChatMsgEvent 'Json)
-> Either String (Maybe MsgScope)
-> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (Maybe MsgScope)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"scope"
      CMEventTag 'Json
XMsgDeleted_ -> ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatMsgEvent 'Json
XMsgDeleted
      CMEventTag 'Json
XMsgReact_ -> SharedMsgId
-> Maybe MemberId
-> Maybe MsgScope
-> MsgReaction
-> Bool
-> ChatMsgEvent 'Json
XMsgReact (SharedMsgId
 -> Maybe MemberId
 -> Maybe MsgScope
 -> MsgReaction
 -> Bool
 -> ChatMsgEvent 'Json)
-> Either String SharedMsgId
-> Either
     String
     (Maybe MemberId
      -> Maybe MsgScope -> MsgReaction -> Bool -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String SharedMsgId
forall a. FromJSON a => Key -> Either String a
p Key
"msgId" Either
  String
  (Maybe MemberId
   -> Maybe MsgScope -> MsgReaction -> Bool -> ChatMsgEvent 'Json)
-> Either String (Maybe MemberId)
-> Either
     String
     (Maybe MsgScope -> MsgReaction -> Bool -> ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (Maybe MemberId)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"memberId" Either
  String
  (Maybe MsgScope -> MsgReaction -> Bool -> ChatMsgEvent 'Json)
-> Either String (Maybe MsgScope)
-> Either String (MsgReaction -> Bool -> ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (Maybe MsgScope)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"scope" Either String (MsgReaction -> Bool -> ChatMsgEvent 'Json)
-> Either String MsgReaction
-> Either String (Bool -> ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String MsgReaction
forall a. FromJSON a => Key -> Either String a
p Key
"reaction" Either String (Bool -> ChatMsgEvent 'Json)
-> Either String Bool -> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String Bool
forall a. FromJSON a => Key -> Either String a
p Key
"add"
      CMEventTag 'Json
XFile_ -> FileInvitation -> ChatMsgEvent 'Json
XFile (FileInvitation -> ChatMsgEvent 'Json)
-> Either String FileInvitation
-> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String FileInvitation
forall a. FromJSON a => Key -> Either String a
p Key
"file"
      CMEventTag 'Json
XFileAcpt_ -> String -> ChatMsgEvent 'Json
XFileAcpt (String -> ChatMsgEvent 'Json)
-> Either String String -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String String
forall a. FromJSON a => Key -> Either String a
p Key
"fileName"
      CMEventTag 'Json
XFileAcptInv_ -> SharedMsgId
-> Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json
XFileAcptInv (SharedMsgId
 -> Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json)
-> Either String SharedMsgId
-> Either
     String (Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String SharedMsgId
forall a. FromJSON a => Key -> Either String a
p Key
"msgId" Either
  String (Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json)
-> Either String (Maybe ConnReqInvitation)
-> Either String (String -> ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (Maybe ConnReqInvitation)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"fileConnReq" Either String (String -> ChatMsgEvent 'Json)
-> Either String String -> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String String
forall a. FromJSON a => Key -> Either String a
p Key
"fileName"
      CMEventTag 'Json
XFileCancel_ -> SharedMsgId -> ChatMsgEvent 'Json
XFileCancel (SharedMsgId -> ChatMsgEvent 'Json)
-> Either String SharedMsgId -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String SharedMsgId
forall a. FromJSON a => Key -> Either String a
p Key
"msgId"
      CMEventTag 'Json
XInfo_ -> Profile -> ChatMsgEvent 'Json
XInfo (Profile -> ChatMsgEvent 'Json)
-> Either String Profile -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String Profile
forall a. FromJSON a => Key -> Either String a
p Key
"profile"
      CMEventTag 'Json
XContact_ -> do
        Profile
profile <- Key -> Either String Profile
forall a. FromJSON a => Key -> Either String a
p Key
"profile"
        Maybe XContactId
contactReqId <- Key -> Either String (Maybe XContactId)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"contactReqId"
        Maybe SharedMsgId
welcomeMsgId <- Key -> Either String (Maybe SharedMsgId)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"welcomeMsgId"
        Maybe SharedMsgId
reqMsgId <- Key -> Either String (Maybe SharedMsgId)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"msgId"
        Maybe MsgContent
reqContent <- Key -> Either String (Maybe MsgContent)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"content"
        let requestMsg :: Maybe (SharedMsgId, MsgContent)
requestMsg = (,) (SharedMsgId -> MsgContent -> (SharedMsgId, MsgContent))
-> Maybe SharedMsgId
-> Maybe (MsgContent -> (SharedMsgId, MsgContent))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SharedMsgId
reqMsgId Maybe (MsgContent -> (SharedMsgId, MsgContent))
-> Maybe MsgContent -> Maybe (SharedMsgId, MsgContent)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe MsgContent
reqContent
        ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure XContact {Profile
profile :: Profile
profile :: Profile
profile, Maybe XContactId
contactReqId :: Maybe XContactId
contactReqId :: Maybe XContactId
contactReqId, Maybe SharedMsgId
welcomeMsgId :: Maybe SharedMsgId
welcomeMsgId :: Maybe SharedMsgId
welcomeMsgId, Maybe (SharedMsgId, MsgContent)
requestMsg :: Maybe (SharedMsgId, MsgContent)
requestMsg :: Maybe (SharedMsgId, MsgContent)
requestMsg}
      CMEventTag 'Json
XDirectDel_ -> ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatMsgEvent 'Json
XDirectDel
      CMEventTag 'Json
XGrpInv_ -> GroupInvitation -> ChatMsgEvent 'Json
XGrpInv (GroupInvitation -> ChatMsgEvent 'Json)
-> Either String GroupInvitation
-> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String GroupInvitation
forall a. FromJSON a => Key -> Either String a
p Key
"groupInvitation"
      CMEventTag 'Json
XGrpAcpt_ -> MemberId -> ChatMsgEvent 'Json
XGrpAcpt (MemberId -> ChatMsgEvent 'Json)
-> Either String MemberId -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberId
forall a. FromJSON a => Key -> Either String a
p Key
"memberId"
      CMEventTag 'Json
XGrpLinkInv_ -> GroupLinkInvitation -> ChatMsgEvent 'Json
XGrpLinkInv (GroupLinkInvitation -> ChatMsgEvent 'Json)
-> Either String GroupLinkInvitation
-> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String GroupLinkInvitation
forall a. FromJSON a => Key -> Either String a
p Key
"groupLinkInvitation"
      CMEventTag 'Json
XGrpLinkReject_ -> GroupLinkRejection -> ChatMsgEvent 'Json
XGrpLinkReject (GroupLinkRejection -> ChatMsgEvent 'Json)
-> Either String GroupLinkRejection
-> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String GroupLinkRejection
forall a. FromJSON a => Key -> Either String a
p Key
"groupLinkRejection"
      CMEventTag 'Json
XGrpLinkMem_ -> Profile -> ChatMsgEvent 'Json
XGrpLinkMem (Profile -> ChatMsgEvent 'Json)
-> Either String Profile -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String Profile
forall a. FromJSON a => Key -> Either String a
p Key
"profile"
      CMEventTag 'Json
XGrpLinkAcpt_ -> GroupAcceptance
-> GroupMemberRole -> MemberId -> ChatMsgEvent 'Json
XGrpLinkAcpt (GroupAcceptance
 -> GroupMemberRole -> MemberId -> ChatMsgEvent 'Json)
-> Either String GroupAcceptance
-> Either
     String (GroupMemberRole -> MemberId -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String GroupAcceptance
forall a. FromJSON a => Key -> Either String a
p Key
"acceptance" Either String (GroupMemberRole -> MemberId -> ChatMsgEvent 'Json)
-> Either String GroupMemberRole
-> Either String (MemberId -> ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String GroupMemberRole
forall a. FromJSON a => Key -> Either String a
p Key
"role" Either String (MemberId -> ChatMsgEvent 'Json)
-> Either String MemberId -> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String MemberId
forall a. FromJSON a => Key -> Either String a
p Key
"memberId"
      CMEventTag 'Json
XGrpMemNew_ -> MemberInfo -> Maybe MsgScope -> ChatMsgEvent 'Json
XGrpMemNew (MemberInfo -> Maybe MsgScope -> ChatMsgEvent 'Json)
-> Either String MemberInfo
-> Either String (Maybe MsgScope -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberInfo
forall a. FromJSON a => Key -> Either String a
p Key
"memberInfo" Either String (Maybe MsgScope -> ChatMsgEvent 'Json)
-> Either String (Maybe MsgScope)
-> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (Maybe MsgScope)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"scope"
      CMEventTag 'Json
XGrpMemIntro_ -> MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json
XGrpMemIntro (MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json)
-> Either String MemberInfo
-> Either String (Maybe MemberRestrictions -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberInfo
forall a. FromJSON a => Key -> Either String a
p Key
"memberInfo" Either String (Maybe MemberRestrictions -> ChatMsgEvent 'Json)
-> Either String (Maybe MemberRestrictions)
-> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (Maybe MemberRestrictions)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"memberRestrictions"
      CMEventTag 'Json
XGrpMemInv_ -> MemberId -> IntroInvitation -> ChatMsgEvent 'Json
XGrpMemInv (MemberId -> IntroInvitation -> ChatMsgEvent 'Json)
-> Either String MemberId
-> Either String (IntroInvitation -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberId
forall a. FromJSON a => Key -> Either String a
p Key
"memberId" Either String (IntroInvitation -> ChatMsgEvent 'Json)
-> Either String IntroInvitation
-> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String IntroInvitation
forall a. FromJSON a => Key -> Either String a
p Key
"memberIntro"
      CMEventTag 'Json
XGrpMemFwd_ -> MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json
XGrpMemFwd (MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json)
-> Either String MemberInfo
-> Either String (IntroInvitation -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberInfo
forall a. FromJSON a => Key -> Either String a
p Key
"memberInfo" Either String (IntroInvitation -> ChatMsgEvent 'Json)
-> Either String IntroInvitation
-> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String IntroInvitation
forall a. FromJSON a => Key -> Either String a
p Key
"memberIntro"
      CMEventTag 'Json
XGrpMemInfo_ -> MemberId -> Profile -> ChatMsgEvent 'Json
XGrpMemInfo (MemberId -> Profile -> ChatMsgEvent 'Json)
-> Either String MemberId
-> Either String (Profile -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberId
forall a. FromJSON a => Key -> Either String a
p Key
"memberId" Either String (Profile -> ChatMsgEvent 'Json)
-> Either String Profile -> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String Profile
forall a. FromJSON a => Key -> Either String a
p Key
"profile"
      CMEventTag 'Json
XGrpMemRole_ -> MemberId -> GroupMemberRole -> ChatMsgEvent 'Json
XGrpMemRole (MemberId -> GroupMemberRole -> ChatMsgEvent 'Json)
-> Either String MemberId
-> Either String (GroupMemberRole -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberId
forall a. FromJSON a => Key -> Either String a
p Key
"memberId" Either String (GroupMemberRole -> ChatMsgEvent 'Json)
-> Either String GroupMemberRole
-> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String GroupMemberRole
forall a. FromJSON a => Key -> Either String a
p Key
"role"
      CMEventTag 'Json
XGrpMemRestrict_ -> MemberId -> MemberRestrictions -> ChatMsgEvent 'Json
XGrpMemRestrict (MemberId -> MemberRestrictions -> ChatMsgEvent 'Json)
-> Either String MemberId
-> Either String (MemberRestrictions -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberId
forall a. FromJSON a => Key -> Either String a
p Key
"memberId" Either String (MemberRestrictions -> ChatMsgEvent 'Json)
-> Either String MemberRestrictions
-> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String MemberRestrictions
forall a. FromJSON a => Key -> Either String a
p Key
"memberRestrictions"
      CMEventTag 'Json
XGrpMemCon_ -> MemberId -> ChatMsgEvent 'Json
XGrpMemCon (MemberId -> ChatMsgEvent 'Json)
-> Either String MemberId -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberId
forall a. FromJSON a => Key -> Either String a
p Key
"memberId"
      CMEventTag 'Json
XGrpMemConAll_ -> MemberId -> ChatMsgEvent 'Json
XGrpMemConAll (MemberId -> ChatMsgEvent 'Json)
-> Either String MemberId -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberId
forall a. FromJSON a => Key -> Either String a
p Key
"memberId"
      CMEventTag 'Json
XGrpMemDel_ -> MemberId -> Bool -> ChatMsgEvent 'Json
XGrpMemDel (MemberId -> Bool -> ChatMsgEvent 'Json)
-> Either String MemberId
-> Either String (Bool -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberId
forall a. FromJSON a => Key -> Either String a
p Key
"memberId" Either String (Bool -> ChatMsgEvent 'Json)
-> Either String Bool -> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Either String Bool
forall a b. b -> Either a b
Right (Bool -> Either String Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Either String Bool -> Bool) -> Either String Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Key -> Either String Bool
forall a. FromJSON a => Key -> Either String a
p Key
"messages")
      CMEventTag 'Json
XGrpLeave_ -> ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatMsgEvent 'Json
XGrpLeave
      CMEventTag 'Json
XGrpDel_ -> ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatMsgEvent 'Json
XGrpDel
      CMEventTag 'Json
XGrpInfo_ -> GroupProfile -> ChatMsgEvent 'Json
XGrpInfo (GroupProfile -> ChatMsgEvent 'Json)
-> Either String GroupProfile -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String GroupProfile
forall a. FromJSON a => Key -> Either String a
p Key
"groupProfile"
      CMEventTag 'Json
XGrpPrefs_ -> GroupPreferences -> ChatMsgEvent 'Json
XGrpPrefs (GroupPreferences -> ChatMsgEvent 'Json)
-> Either String GroupPreferences
-> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String GroupPreferences
forall a. FromJSON a => Key -> Either String a
p Key
"groupPreferences"
      CMEventTag 'Json
XGrpDirectInv_ -> ConnReqInvitation
-> Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json
XGrpDirectInv (ConnReqInvitation
 -> Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json)
-> Either String ConnReqInvitation
-> Either
     String (Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String ConnReqInvitation
forall a. FromJSON a => Key -> Either String a
p Key
"connReq" Either
  String (Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json)
-> Either String (Maybe MsgContent)
-> Either String (Maybe MsgScope -> ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (Maybe MsgContent)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"content" Either String (Maybe MsgScope -> ChatMsgEvent 'Json)
-> Either String (Maybe MsgScope)
-> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (Maybe MsgScope)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"scope"
      CMEventTag 'Json
XGrpMsgForward_ -> MemberId
-> Maybe MemberName
-> ChatMessage 'Json
-> UTCTime
-> ChatMsgEvent 'Json
XGrpMsgForward (MemberId
 -> Maybe MemberName
 -> ChatMessage 'Json
 -> UTCTime
 -> ChatMsgEvent 'Json)
-> Either String MemberId
-> Either
     String
     (Maybe MemberName
      -> ChatMessage 'Json -> UTCTime -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String MemberId
forall a. FromJSON a => Key -> Either String a
p Key
"memberId" Either
  String
  (Maybe MemberName
   -> ChatMessage 'Json -> UTCTime -> ChatMsgEvent 'Json)
-> Either String (Maybe MemberName)
-> Either
     String (ChatMessage 'Json -> UTCTime -> ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (Maybe MemberName)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"memberName" Either String (ChatMessage 'Json -> UTCTime -> ChatMsgEvent 'Json)
-> Either String (ChatMessage 'Json)
-> Either String (UTCTime -> ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String (ChatMessage 'Json)
forall a. FromJSON a => Key -> Either String a
p Key
"msg" Either String (UTCTime -> ChatMsgEvent 'Json)
-> Either String UTCTime -> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String UTCTime
forall a. FromJSON a => Key -> Either String a
p Key
"msgTs"
      CMEventTag 'Json
XInfoProbe_ -> Probe -> ChatMsgEvent 'Json
XInfoProbe (Probe -> ChatMsgEvent 'Json)
-> Either String Probe -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String Probe
forall a. FromJSON a => Key -> Either String a
p Key
"probe"
      CMEventTag 'Json
XInfoProbeCheck_ -> ProbeHash -> ChatMsgEvent 'Json
XInfoProbeCheck (ProbeHash -> ChatMsgEvent 'Json)
-> Either String ProbeHash -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String ProbeHash
forall a. FromJSON a => Key -> Either String a
p Key
"probeHash"
      CMEventTag 'Json
XInfoProbeOk_ -> Probe -> ChatMsgEvent 'Json
XInfoProbeOk (Probe -> ChatMsgEvent 'Json)
-> Either String Probe -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String Probe
forall a. FromJSON a => Key -> Either String a
p Key
"probe"
      CMEventTag 'Json
XCallInv_ -> CallId -> CallInvitation -> ChatMsgEvent 'Json
XCallInv (CallId -> CallInvitation -> ChatMsgEvent 'Json)
-> Either String CallId
-> Either String (CallInvitation -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String CallId
forall a. FromJSON a => Key -> Either String a
p Key
"callId" Either String (CallInvitation -> ChatMsgEvent 'Json)
-> Either String CallInvitation
-> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String CallInvitation
forall a. FromJSON a => Key -> Either String a
p Key
"invitation"
      CMEventTag 'Json
XCallOffer_ -> CallId -> CallOffer -> ChatMsgEvent 'Json
XCallOffer (CallId -> CallOffer -> ChatMsgEvent 'Json)
-> Either String CallId
-> Either String (CallOffer -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String CallId
forall a. FromJSON a => Key -> Either String a
p Key
"callId" Either String (CallOffer -> ChatMsgEvent 'Json)
-> Either String CallOffer -> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String CallOffer
forall a. FromJSON a => Key -> Either String a
p Key
"offer"
      CMEventTag 'Json
XCallAnswer_ -> CallId -> CallAnswer -> ChatMsgEvent 'Json
XCallAnswer (CallId -> CallAnswer -> ChatMsgEvent 'Json)
-> Either String CallId
-> Either String (CallAnswer -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String CallId
forall a. FromJSON a => Key -> Either String a
p Key
"callId" Either String (CallAnswer -> ChatMsgEvent 'Json)
-> Either String CallAnswer -> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String CallAnswer
forall a. FromJSON a => Key -> Either String a
p Key
"answer"
      CMEventTag 'Json
XCallExtra_ -> CallId -> CallExtraInfo -> ChatMsgEvent 'Json
XCallExtra (CallId -> CallExtraInfo -> ChatMsgEvent 'Json)
-> Either String CallId
-> Either String (CallExtraInfo -> ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String CallId
forall a. FromJSON a => Key -> Either String a
p Key
"callId" Either String (CallExtraInfo -> ChatMsgEvent 'Json)
-> Either String CallExtraInfo
-> Either String (ChatMsgEvent 'Json)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Either String CallExtraInfo
forall a. FromJSON a => Key -> Either String a
p Key
"extra"
      CMEventTag 'Json
XCallEnd_ -> CallId -> ChatMsgEvent 'Json
XCallEnd (CallId -> ChatMsgEvent 'Json)
-> Either String CallId -> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String CallId
forall a. FromJSON a => Key -> Either String a
p Key
"callId"
      CMEventTag 'Json
XOk_ -> ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatMsgEvent 'Json
XOk
      XUnknown_ MemberName
t -> ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json))
-> ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json)
forall a b. (a -> b) -> a -> b
$ MemberName -> Object -> ChatMsgEvent 'Json
XUnknown MemberName
t Object
params

(.=?) :: ToJSON v => JT.Key -> Maybe v -> [(J.Key, J.Value)] -> [(J.Key, J.Value)]
Key
key .=? :: forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe v
value = ([(Key, Value)] -> [(Key, Value)])
-> (v -> [(Key, Value)] -> [(Key, Value)])
-> Maybe v
-> [(Key, Value)]
-> [(Key, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Key, Value)] -> [(Key, Value)]
forall a. a -> a
id ((:) ((Key, Value) -> [(Key, Value)] -> [(Key, Value)])
-> (v -> (Key, Value)) -> v -> [(Key, Value)] -> [(Key, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
key Key -> v -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=)) Maybe v
value

chatToAppMessage :: forall e. MsgEncodingI e => ChatMessage e -> AppMessage e
chatToAppMessage :: forall (e :: MsgEncoding).
MsgEncodingI e =>
ChatMessage e -> AppMessage e
chatToAppMessage chatMsg :: ChatMessage e
chatMsg@ChatMessage {VersionRangeChat
chatVRange :: forall (e :: MsgEncoding). ChatMessage e -> VersionRangeChat
chatVRange :: VersionRangeChat
chatVRange, Maybe SharedMsgId
msgId :: forall (e :: MsgEncoding). ChatMessage e -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, ChatMsgEvent e
chatMsgEvent :: forall (e :: MsgEncoding). ChatMessage e -> ChatMsgEvent e
chatMsgEvent :: ChatMsgEvent e
chatMsgEvent} = case forall (e :: MsgEncoding). MsgEncodingI e => SMsgEncoding e
encoding @e of
  SMsgEncoding e
SBinary -> AppMessageBinary -> AppMessage 'Binary
AMBinary AppMessageBinary {msgId :: Maybe SharedMsgId
msgId = Maybe SharedMsgId
forall a. Maybe a
Nothing, tag :: Char
tag = ByteString -> Char
B.head (ByteString -> Char) -> ByteString -> Char
forall a b. (a -> b) -> a -> b
$ CMEventTag e -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode CMEventTag e
tag, body :: ByteString
body = ChatMessage 'Binary -> ByteString
chatMsgBinaryToBody ChatMessage e
ChatMessage 'Binary
chatMsg}
  SMsgEncoding e
SJson -> AppMessageJson -> AppMessage 'Json
AMJson AppMessageJson {v :: Maybe ChatVersionRange
v = ChatVersionRange -> Maybe ChatVersionRange
forall a. a -> Maybe a
Just (ChatVersionRange -> Maybe ChatVersionRange)
-> ChatVersionRange -> Maybe ChatVersionRange
forall a b. (a -> b) -> a -> b
$ VersionRangeChat -> ChatVersionRange
ChatVersionRange VersionRangeChat
chatVRange, Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, event :: MemberName
event = CMEventTag e -> MemberName
forall a. TextEncoding a => a -> MemberName
textEncode CMEventTag e
tag, params :: Object
params = ChatMsgEvent 'Json -> Object
params ChatMsgEvent e
ChatMsgEvent 'Json
chatMsgEvent}
  where
    tag :: CMEventTag e
tag = ChatMsgEvent e -> CMEventTag e
forall (e :: MsgEncoding). ChatMsgEvent e -> CMEventTag e
toCMEventTag ChatMsgEvent e
chatMsgEvent
    o :: [(J.Key, J.Value)] -> J.Object
    o :: [(Key, Value)] -> Object
o = [(Key, Value)] -> Object
forall {v}. [(Key, v)] -> KeyMap v
JM.fromList
    params :: ChatMsgEvent 'Json -> J.Object
    params :: ChatMsgEvent 'Json -> Object
params = \case
      XMsgNew MsgContainer
container -> MsgContainer -> Object
msgContainerJSON MsgContainer
container
      XMsgFileDescr SharedMsgId
msgId' FileDescr
fileDescr -> [(Key, Value)] -> Object
o [Key
"msgId" Key -> SharedMsgId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
msgId', Key
"fileDescr" Key -> FileDescr -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FileDescr
fileDescr]
      XMsgUpdate {msgId :: ChatMsgEvent 'Json -> SharedMsgId
msgId = SharedMsgId
msgId', MsgContent
content :: ChatMsgEvent 'Json -> MsgContent
content :: MsgContent
content, Map MemberName MsgMention
mentions :: ChatMsgEvent 'Json -> Map MemberName MsgMention
mentions :: Map MemberName MsgMention
mentions, Maybe Int
ttl :: ChatMsgEvent 'Json -> Maybe Int
ttl :: Maybe Int
ttl, Maybe Bool
live :: ChatMsgEvent 'Json -> Maybe Bool
live :: Maybe Bool
live, Maybe MsgScope
scope :: ChatMsgEvent 'Json -> Maybe MsgScope
scope :: Maybe MsgScope
scope} -> [(Key, Value)] -> Object
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"ttl" Key -> Maybe Int -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe Int
ttl) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"live" Key -> Maybe Bool -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe Bool
live) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MsgScope
scope) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"mentions" Key
-> Maybe (Map MemberName MsgMention)
-> [(Key, Value)]
-> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Map MemberName MsgMention -> Maybe (Map MemberName MsgMention)
forall k v. Map k v -> Maybe (Map k v)
nonEmptyMap Map MemberName MsgMention
mentions) [Key
"msgId" Key -> SharedMsgId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
msgId', Key
"content" Key -> MsgContent -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContent
content]
      XMsgDel SharedMsgId
msgId' Maybe MemberId
memberId Maybe MsgScope
scope -> [(Key, Value)] -> Object
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"memberId" Key -> Maybe MemberId -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MemberId
memberId) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MsgScope
scope) [Key
"msgId" Key -> SharedMsgId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
msgId']
      ChatMsgEvent 'Json
XMsgDeleted -> Object
forall v. KeyMap v
JM.empty
      XMsgReact SharedMsgId
msgId' Maybe MemberId
memberId Maybe MsgScope
scope MsgReaction
reaction Bool
add -> [(Key, Value)] -> Object
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"memberId" Key -> Maybe MemberId -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MemberId
memberId) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MsgScope
scope) [Key
"msgId" Key -> SharedMsgId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
msgId', Key
"reaction" Key -> MsgReaction -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgReaction
reaction, Key
"add" Key -> Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
add]
      XFile FileInvitation
fileInv -> [(Key, Value)] -> Object
o [Key
"file" Key -> FileInvitation -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FileInvitation
fileInv]
      XFileAcpt String
fileName -> [(Key, Value)] -> Object
o [Key
"fileName" Key -> String -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
fileName]
      XFileAcptInv SharedMsgId
sharedMsgId Maybe ConnReqInvitation
fileConnReq String
fileName -> [(Key, Value)] -> Object
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"fileConnReq" Key -> Maybe ConnReqInvitation -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe ConnReqInvitation
fileConnReq) [Key
"msgId" Key -> SharedMsgId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
sharedMsgId, Key
"fileName" Key -> String -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
fileName]
      XFileCancel SharedMsgId
sharedMsgId -> [(Key, Value)] -> Object
o [Key
"msgId" Key -> SharedMsgId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
sharedMsgId]
      XInfo Profile
profile -> [(Key, Value)] -> Object
o [Key
"profile" Key -> Profile -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Profile
profile]
      XContact {Profile
profile :: ChatMsgEvent 'Json -> Profile
profile :: Profile
profile, Maybe XContactId
contactReqId :: ChatMsgEvent 'Json -> Maybe XContactId
contactReqId :: Maybe XContactId
contactReqId, Maybe SharedMsgId
welcomeMsgId :: ChatMsgEvent 'Json -> Maybe SharedMsgId
welcomeMsgId :: Maybe SharedMsgId
welcomeMsgId, Maybe (SharedMsgId, MsgContent)
requestMsg :: ChatMsgEvent 'Json -> Maybe (SharedMsgId, MsgContent)
requestMsg :: Maybe (SharedMsgId, MsgContent)
requestMsg} -> [(Key, Value)] -> Object
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"contactReqId" Key -> Maybe XContactId -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe XContactId
contactReqId) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"welcomeMsgId" Key -> Maybe SharedMsgId -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe SharedMsgId
welcomeMsgId) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"msgId" Key -> Maybe SharedMsgId -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? ((SharedMsgId, MsgContent) -> SharedMsgId
forall a b. (a, b) -> a
fst ((SharedMsgId, MsgContent) -> SharedMsgId)
-> Maybe (SharedMsgId, MsgContent) -> Maybe SharedMsgId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SharedMsgId, MsgContent)
requestMsg)) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"content" Key -> Maybe MsgContent -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? ((SharedMsgId, MsgContent) -> MsgContent
forall a b. (a, b) -> b
snd ((SharedMsgId, MsgContent) -> MsgContent)
-> Maybe (SharedMsgId, MsgContent) -> Maybe MsgContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SharedMsgId, MsgContent)
requestMsg)) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ [Key
"profile" Key -> Profile -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Profile
profile]
      ChatMsgEvent 'Json
XDirectDel -> Object
forall v. KeyMap v
JM.empty
      XGrpInv GroupInvitation
groupInv -> [(Key, Value)] -> Object
o [Key
"groupInvitation" Key -> GroupInvitation -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupInvitation
groupInv]
      XGrpAcpt MemberId
memId -> [(Key, Value)] -> Object
o [Key
"memberId" Key -> MemberId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId]
      XGrpLinkInv GroupLinkInvitation
groupLinkInv -> [(Key, Value)] -> Object
o [Key
"groupLinkInvitation" Key -> GroupLinkInvitation -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupLinkInvitation
groupLinkInv]
      XGrpLinkReject GroupLinkRejection
groupLinkRjct -> [(Key, Value)] -> Object
o [Key
"groupLinkRejection" Key -> GroupLinkRejection -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupLinkRejection
groupLinkRjct]
      XGrpLinkMem Profile
profile -> [(Key, Value)] -> Object
o [Key
"profile" Key -> Profile -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Profile
profile]
      XGrpLinkAcpt GroupAcceptance
acceptance GroupMemberRole
role MemberId
memberId -> [(Key, Value)] -> Object
o [Key
"acceptance" Key -> GroupAcceptance -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupAcceptance
acceptance, Key
"role" Key -> GroupMemberRole -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupMemberRole
role, Key
"memberId" Key -> MemberId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memberId]
      XGrpMemNew MemberInfo
memInfo Maybe MsgScope
scope -> [(Key, Value)] -> Object
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MsgScope
scope) [Key
"memberInfo" Key -> MemberInfo -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberInfo
memInfo]
      XGrpMemIntro MemberInfo
memInfo Maybe MemberRestrictions
memRestrictions -> [(Key, Value)] -> Object
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"memberRestrictions" Key -> Maybe MemberRestrictions -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MemberRestrictions
memRestrictions) [Key
"memberInfo" Key -> MemberInfo -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberInfo
memInfo]
      XGrpMemInv MemberId
memId IntroInvitation
memIntro -> [(Key, Value)] -> Object
o [Key
"memberId" Key -> MemberId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId, Key
"memberIntro" Key -> IntroInvitation -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IntroInvitation
memIntro]
      XGrpMemFwd MemberInfo
memInfo IntroInvitation
memIntro -> [(Key, Value)] -> Object
o [Key
"memberInfo" Key -> MemberInfo -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberInfo
memInfo, Key
"memberIntro" Key -> IntroInvitation -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IntroInvitation
memIntro]
      XGrpMemInfo MemberId
memId Profile
profile -> [(Key, Value)] -> Object
o [Key
"memberId" Key -> MemberId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId, Key
"profile" Key -> Profile -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Profile
profile]
      XGrpMemRole MemberId
memId GroupMemberRole
role -> [(Key, Value)] -> Object
o [Key
"memberId" Key -> MemberId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId, Key
"role" Key -> GroupMemberRole -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupMemberRole
role]
      XGrpMemRestrict MemberId
memId MemberRestrictions
memRestrictions -> [(Key, Value)] -> Object
o [Key
"memberId" Key -> MemberId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId, Key
"memberRestrictions" Key -> MemberRestrictions -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberRestrictions
memRestrictions]
      XGrpMemCon MemberId
memId -> [(Key, Value)] -> Object
o [Key
"memberId" Key -> MemberId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId]
      XGrpMemConAll MemberId
memId -> [(Key, Value)] -> Object
o [Key
"memberId" Key -> MemberId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId]
      XGrpMemDel MemberId
memId Bool
messages -> [(Key, Value)] -> Object
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"messages" Key -> Maybe Bool -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? if Bool
messages then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing) [Key
"memberId" Key -> MemberId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId]
      ChatMsgEvent 'Json
XGrpLeave -> Object
forall v. KeyMap v
JM.empty
      ChatMsgEvent 'Json
XGrpDel -> Object
forall v. KeyMap v
JM.empty
      XGrpInfo GroupProfile
p -> [(Key, Value)] -> Object
o [Key
"groupProfile" Key -> GroupProfile -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupProfile
p]
      XGrpPrefs GroupPreferences
p -> [(Key, Value)] -> Object
o [Key
"groupPreferences" Key -> GroupPreferences -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupPreferences
p]
      XGrpDirectInv ConnReqInvitation
connReq Maybe MsgContent
content Maybe MsgScope
scope -> [(Key, Value)] -> Object
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"content" Key -> Maybe MsgContent -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MsgContent
content) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MsgScope
scope) [Key
"connReq" Key -> ConnReqInvitation -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConnReqInvitation
connReq]
      XGrpMsgForward MemberId
memberId Maybe MemberName
memberName ChatMessage 'Json
msg UTCTime
msgTs -> [(Key, Value)] -> Object
o ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"memberName" Key -> Maybe MemberName -> [(Key, Value)] -> [(Key, Value)]
forall v.
ToJSON v =>
Key -> Maybe v -> [(Key, Value)] -> [(Key, Value)]
.=? Maybe MemberName
memberName) [Key
"memberId" Key -> MemberId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memberId, Key
"msg" Key -> ChatMessage 'Json -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ChatMessage 'Json
msg, Key
"msgTs" Key -> UTCTime -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
msgTs]
      XInfoProbe Probe
probe -> [(Key, Value)] -> Object
o [Key
"probe" Key -> Probe -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Probe
probe]
      XInfoProbeCheck ProbeHash
probeHash -> [(Key, Value)] -> Object
o [Key
"probeHash" Key -> ProbeHash -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ProbeHash
probeHash]
      XInfoProbeOk Probe
probe -> [(Key, Value)] -> Object
o [Key
"probe" Key -> Probe -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Probe
probe]
      XCallInv CallId
callId CallInvitation
inv -> [(Key, Value)] -> Object
o [Key
"callId" Key -> CallId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallId
callId, Key
"invitation" Key -> CallInvitation -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallInvitation
inv]
      XCallOffer CallId
callId CallOffer
offer -> [(Key, Value)] -> Object
o [Key
"callId" Key -> CallId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallId
callId, Key
"offer" Key -> CallOffer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallOffer
offer]
      XCallAnswer CallId
callId CallAnswer
answer -> [(Key, Value)] -> Object
o [Key
"callId" Key -> CallId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallId
callId, Key
"answer" Key -> CallAnswer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallAnswer
answer]
      XCallExtra CallId
callId CallExtraInfo
extra -> [(Key, Value)] -> Object
o [Key
"callId" Key -> CallId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallId
callId, Key
"extra" Key -> CallExtraInfo -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallExtraInfo
extra]
      XCallEnd CallId
callId -> [(Key, Value)] -> Object
o [Key
"callId" Key -> CallId -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallId
callId]
      ChatMsgEvent 'Json
XOk -> Object
forall v. KeyMap v
JM.empty
      XUnknown MemberName
_ Object
ps -> Object
ps

chatMsgBinaryToBody :: ChatMessage 'Binary -> ByteString
chatMsgBinaryToBody :: ChatMessage 'Binary -> ByteString
chatMsgBinaryToBody ChatMessage {ChatMsgEvent 'Binary
chatMsgEvent :: forall (e :: MsgEncoding). ChatMessage e -> ChatMsgEvent e
chatMsgEvent :: ChatMsgEvent 'Binary
chatMsgEvent} = case ChatMsgEvent 'Binary
chatMsgEvent of
  BFileChunk (SharedMsgId ByteString
msgId) FileChunk
chunk -> (ByteString, InlineFileChunk) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ByteString
msgId, FileChunk -> InlineFileChunk
IFC FileChunk
chunk)

chatMsgToBody :: forall e. MsgEncodingI e => ChatMessage e -> ByteString
chatMsgToBody :: forall (e :: MsgEncoding).
MsgEncodingI e =>
ChatMessage e -> ByteString
chatMsgToBody ChatMessage e
chatMsg = case forall (e :: MsgEncoding). MsgEncodingI e => SMsgEncoding e
encoding @e of
  SMsgEncoding e
SBinary -> ChatMessage 'Binary -> ByteString
chatMsgBinaryToBody ChatMessage e
ChatMessage 'Binary
chatMsg
  SMsgEncoding e
SJson -> LazyByteString -> ByteString
LB.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ChatMessage e -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
J.encode ChatMessage e
chatMsg

instance ToJSON (ChatMessage 'Json) where
  toJSON :: ChatMessage 'Json -> Value
toJSON = (\(AMJson AppMessageJson
msg) -> AppMessageJson -> Value
forall a. ToJSON a => a -> Value
toJSON AppMessageJson
msg) (AppMessage 'Json -> Value)
-> (ChatMessage 'Json -> AppMessage 'Json)
-> ChatMessage 'Json
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessage 'Json -> AppMessage 'Json
forall (e :: MsgEncoding).
MsgEncodingI e =>
ChatMessage e -> AppMessage e
chatToAppMessage

instance FromJSON (ChatMessage 'Json) where
  parseJSON :: Value -> Parser (ChatMessage 'Json)
parseJSON Value
v = AppMessageJson -> Either String (ChatMessage 'Json)
appJsonToCM (AppMessageJson -> Either String (ChatMessage 'Json))
-> Parser AppMessageJson -> Parser (ChatMessage 'Json)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Value -> Parser AppMessageJson
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance FromField (ChatMessage 'Json) where
  fromField :: FieldParser (ChatMessage 'Json)
fromField = (ByteString -> Either String (ChatMessage 'Json))
-> FieldParser (ChatMessage 'Json)
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String (ChatMessage 'Json)
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict'

data ContactShortLinkData = ContactShortLinkData
  { ContactShortLinkData -> Profile
profile :: Profile,
    ContactShortLinkData -> Maybe MsgContent
message :: Maybe MsgContent,
    ContactShortLinkData -> Bool
business :: Bool
  }
  deriving (Int -> ContactShortLinkData -> ShowS
[ContactShortLinkData] -> ShowS
ContactShortLinkData -> String
(Int -> ContactShortLinkData -> ShowS)
-> (ContactShortLinkData -> String)
-> ([ContactShortLinkData] -> ShowS)
-> Show ContactShortLinkData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContactShortLinkData -> ShowS
showsPrec :: Int -> ContactShortLinkData -> ShowS
$cshow :: ContactShortLinkData -> String
show :: ContactShortLinkData -> String
$cshowList :: [ContactShortLinkData] -> ShowS
showList :: [ContactShortLinkData] -> ShowS
Show)

data GroupShortLinkData = GroupShortLinkData
  { GroupShortLinkData -> GroupProfile
groupProfile :: GroupProfile
  }
  deriving (Int -> GroupShortLinkData -> ShowS
[GroupShortLinkData] -> ShowS
GroupShortLinkData -> String
(Int -> GroupShortLinkData -> ShowS)
-> (GroupShortLinkData -> String)
-> ([GroupShortLinkData] -> ShowS)
-> Show GroupShortLinkData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupShortLinkData -> ShowS
showsPrec :: Int -> GroupShortLinkData -> ShowS
$cshow :: GroupShortLinkData -> String
show :: GroupShortLinkData -> String
$cshowList :: [GroupShortLinkData] -> ShowS
showList :: [GroupShortLinkData] -> ShowS
Show)

$(JQ.deriveJSON defaultJSON ''ContactShortLinkData)

$(JQ.deriveJSON defaultJSON ''GroupShortLinkData)