{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLists #-}
{-# 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 (when, (<=<))
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 Data.Int (Int64)
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, isJust, isNothing)
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.Time.Clock.System (systemToUTCTime, utcToSystemTime)
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, decompressedSize)
import qualified Simplex.Messaging.Crypto as C
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)
-- 17 - allow host voice messages during member approval regardless of group voice setting (2026-02-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
17

-- 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

-- support host voice messages during member approval regardless of group voice setting
memberSupportVoiceVersion :: VersionChat
memberSupportVoiceVersion :: VersionChat
memberSupportVoiceVersion = Word16 -> VersionChat
VersionChat Word16
17

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
$sel:contactId:Contact :: 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
$sel:groupId:GroupInfo :: GroupInfo -> ContactId
groupId} GroupMember {ContactId
groupMemberId :: ContactId
$sel:groupMemberId:GroupMember :: 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 {$sel:activeConn:GroupMember :: 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
$sel:tag:AppMessageBinary :: AppMessageBinary -> Char
tag :: Char
tag, Maybe SharedMsgId
$sel:msgId:AppMessageBinary :: AppMessageBinary -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, ByteString
$sel:body:AppMessageBinary :: 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
$sel:tag:AppMessageBinary :: Char
tag :: Char
tag, Maybe SharedMsgId
$sel:msgId:AppMessageBinary :: Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, ByteString
$sel:body:AppMessageBinary :: 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 -- present in group message references, Nothing for channel messages
  }
  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)

-- Can be extended to support profile identity keys (e.g., secp256k1 for Nostr)
data KeyRef = KRMember
  deriving (KeyRef -> KeyRef -> Bool
(KeyRef -> KeyRef -> Bool)
-> (KeyRef -> KeyRef -> Bool) -> Eq KeyRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyRef -> KeyRef -> Bool
== :: KeyRef -> KeyRef -> Bool
$c/= :: KeyRef -> KeyRef -> Bool
/= :: KeyRef -> KeyRef -> Bool
Eq, Int -> KeyRef -> ShowS
[KeyRef] -> ShowS
KeyRef -> String
(Int -> KeyRef -> ShowS)
-> (KeyRef -> String) -> ([KeyRef] -> ShowS) -> Show KeyRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyRef -> ShowS
showsPrec :: Int -> KeyRef -> ShowS
$cshow :: KeyRef -> String
show :: KeyRef -> String
$cshowList :: [KeyRef] -> ShowS
showList :: [KeyRef] -> ShowS
Show)

data ChatBinding = CBGroup | CBDirect | CBChannel
  deriving (ChatBinding -> ChatBinding -> Bool
(ChatBinding -> ChatBinding -> Bool)
-> (ChatBinding -> ChatBinding -> Bool) -> Eq ChatBinding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatBinding -> ChatBinding -> Bool
== :: ChatBinding -> ChatBinding -> Bool
$c/= :: ChatBinding -> ChatBinding -> Bool
/= :: ChatBinding -> ChatBinding -> Bool
Eq, Int -> ChatBinding -> ShowS
[ChatBinding] -> ShowS
ChatBinding -> String
(Int -> ChatBinding -> ShowS)
-> (ChatBinding -> String)
-> ([ChatBinding] -> ShowS)
-> Show ChatBinding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatBinding -> ShowS
showsPrec :: Int -> ChatBinding -> ShowS
$cshow :: ChatBinding -> String
show :: ChatBinding -> String
$cshowList :: [ChatBinding] -> ShowS
showList :: [ChatBinding] -> ShowS
Show)

data MsgSignature = MsgSignature KeyRef C.ASignature
  deriving (Int -> MsgSignature -> ShowS
[MsgSignature] -> ShowS
MsgSignature -> String
(Int -> MsgSignature -> ShowS)
-> (MsgSignature -> String)
-> ([MsgSignature] -> ShowS)
-> Show MsgSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgSignature -> ShowS
showsPrec :: Int -> MsgSignature -> ShowS
$cshow :: MsgSignature -> String
show :: MsgSignature -> String
$cshowList :: [MsgSignature] -> ShowS
showList :: [MsgSignature] -> ShowS
Show)

data SignedMsg = SignedMsg
  { SignedMsg -> ChatBinding
chatBinding :: ChatBinding,
    SignedMsg -> NonEmpty MsgSignature
signatures :: L.NonEmpty MsgSignature,
    SignedMsg -> ByteString
signedBody :: ByteString -- exact bytes that were signed
  }
  deriving (Int -> SignedMsg -> ShowS
[SignedMsg] -> ShowS
SignedMsg -> String
(Int -> SignedMsg -> ShowS)
-> (SignedMsg -> String)
-> ([SignedMsg] -> ShowS)
-> Show SignedMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignedMsg -> ShowS
showsPrec :: Int -> SignedMsg -> ShowS
$cshow :: SignedMsg -> String
show :: SignedMsg -> String
$cshowList :: [SignedMsg] -> ShowS
showList :: [SignedMsg] -> ShowS
Show)

-- | Post-verification message. Encodes the invariant that signature
-- has been checked (or wasn't required). Store and forward functions
-- accept only VerifiedMsg, preventing unverified messages from being persisted.
data VerifiedMsg e
  = VMUnsigned (ChatMessage e)
  | VMSigned MsgSigStatus SignedMsg (ChatMessage e)

data ParsedMsg e = ParsedMsg (Maybe GrpMsgForward) (Maybe SignedMsg) (ChatMessage e)

data AParsedMsg = forall e. MsgEncodingI e => APMsg (SMsgEncoding e) (ParsedMsg e)

data FwdSender
  = FwdMember MemberId ContactName
  | FwdChannel
  deriving (FwdSender -> FwdSender -> Bool
(FwdSender -> FwdSender -> Bool)
-> (FwdSender -> FwdSender -> Bool) -> Eq FwdSender
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FwdSender -> FwdSender -> Bool
== :: FwdSender -> FwdSender -> Bool
$c/= :: FwdSender -> FwdSender -> Bool
/= :: FwdSender -> FwdSender -> Bool
Eq, Int -> FwdSender -> ShowS
[FwdSender] -> ShowS
FwdSender -> String
(Int -> FwdSender -> ShowS)
-> (FwdSender -> String)
-> ([FwdSender] -> ShowS)
-> Show FwdSender
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FwdSender -> ShowS
showsPrec :: Int -> FwdSender -> ShowS
$cshow :: FwdSender -> String
show :: FwdSender -> String
$cshowList :: [FwdSender] -> ShowS
showList :: [FwdSender] -> ShowS
Show)

data GrpMsgForward = GrpMsgForward
  { GrpMsgForward -> FwdSender
fwdSender :: FwdSender,
    GrpMsgForward -> UTCTime
fwdBrokerTs :: UTCTime
  }
  deriving (GrpMsgForward -> GrpMsgForward -> Bool
(GrpMsgForward -> GrpMsgForward -> Bool)
-> (GrpMsgForward -> GrpMsgForward -> Bool) -> Eq GrpMsgForward
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrpMsgForward -> GrpMsgForward -> Bool
== :: GrpMsgForward -> GrpMsgForward -> Bool
$c/= :: GrpMsgForward -> GrpMsgForward -> Bool
/= :: GrpMsgForward -> GrpMsgForward -> Bool
Eq, Int -> GrpMsgForward -> ShowS
[GrpMsgForward] -> ShowS
GrpMsgForward -> String
(Int -> GrpMsgForward -> ShowS)
-> (GrpMsgForward -> String)
-> ([GrpMsgForward] -> ShowS)
-> Show GrpMsgForward
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrpMsgForward -> ShowS
showsPrec :: Int -> GrpMsgForward -> ShowS
$cshow :: GrpMsgForward -> String
show :: GrpMsgForward -> String
$cshowList :: [GrpMsgForward] -> ShowS
showList :: [GrpMsgForward] -> ShowS
Show)


instance Encoding FwdSender where
  smpEncode :: FwdSender -> ByteString
smpEncode = \case
    FwdMember MemberId
memberId MemberName
memberName -> (Char, MemberId, MemberName) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (Char
'M', MemberId
memberId, MemberName
memberName)
    FwdSender
FwdChannel -> ByteString
"C"
  smpP :: Parser FwdSender
smpP =
    Parser Char
A.anyChar Parser Char -> (Char -> Parser FwdSender) -> Parser FwdSender
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
'M' -> (MemberId -> MemberName -> FwdSender)
-> (MemberId, MemberName) -> FwdSender
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MemberId -> MemberName -> FwdSender
FwdMember ((MemberId, MemberName) -> FwdSender)
-> Parser ByteString (MemberId, MemberName) -> Parser FwdSender
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (MemberId, MemberName)
forall a. Encoding a => Parser a
smpP
      Char
'C' -> FwdSender -> Parser FwdSender
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FwdSender
FwdChannel
      Char
c -> String -> Parser FwdSender
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser FwdSender) -> String -> Parser FwdSender
forall a b. (a -> b) -> a -> b
$ String
"invalid FwdSender tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c

instance Encoding GrpMsgForward where
  smpEncode :: GrpMsgForward -> ByteString
smpEncode GrpMsgForward {FwdSender
$sel:fwdSender:GrpMsgForward :: GrpMsgForward -> FwdSender
fwdSender :: FwdSender
fwdSender, UTCTime
$sel:fwdBrokerTs:GrpMsgForward :: GrpMsgForward -> UTCTime
fwdBrokerTs :: UTCTime
fwdBrokerTs} =
    (FwdSender, SystemTime) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (FwdSender
fwdSender, UTCTime -> SystemTime
utcToSystemTime UTCTime
fwdBrokerTs)
  smpP :: Parser GrpMsgForward
smpP = do
    FwdSender
fwdSender <- Parser FwdSender
forall a. Encoding a => Parser a
smpP
    UTCTime
fwdBrokerTs <- SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime)
-> Parser ByteString SystemTime -> Parser ByteString UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SystemTime
forall a. Encoding a => Parser a
smpP
    GrpMsgForward -> Parser GrpMsgForward
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GrpMsgForward {FwdSender
$sel:fwdSender:GrpMsgForward :: FwdSender
fwdSender :: FwdSender
fwdSender, UTCTime
$sel:fwdBrokerTs:GrpMsgForward :: UTCTime
fwdBrokerTs :: UTCTime
fwdBrokerTs}

instance Encoding KeyRef where
  smpEncode :: KeyRef -> ByteString
smpEncode = \case
    KeyRef
KRMember -> ByteString
"M"
  smpP :: Parser KeyRef
smpP =
    Parser Char
A.anyChar Parser Char -> (Char -> Parser KeyRef) -> Parser KeyRef
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
'M' -> KeyRef -> Parser KeyRef
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyRef
KRMember
      Char
c -> String -> Parser KeyRef
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser KeyRef) -> String -> Parser KeyRef
forall a b. (a -> b) -> a -> b
$ String
"invalid KeyRef tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c

instance Encoding ChatBinding where
  smpEncode :: ChatBinding -> ByteString
smpEncode = \case
    ChatBinding
CBGroup -> ByteString
"G"
    ChatBinding
CBDirect -> ByteString
"D"
    ChatBinding
CBChannel -> ByteString
"C"
  smpP :: Parser ChatBinding
smpP =
    Parser Char
A.anyChar Parser Char -> (Char -> Parser ChatBinding) -> Parser ChatBinding
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
'G' -> ChatBinding -> Parser ChatBinding
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatBinding
CBGroup
      Char
'D' -> ChatBinding -> Parser ChatBinding
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatBinding
CBDirect
      Char
'C' -> ChatBinding -> Parser ChatBinding
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatBinding
CBChannel
      Char
c -> String -> Parser ChatBinding
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ChatBinding) -> String -> Parser ChatBinding
forall a b. (a -> b) -> a -> b
$ String
"invalid ChatBinding: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c

instance ToField ChatBinding where toField :: ChatBinding -> SQLData
toField = MemberName -> SQLData
forall a. ToField a => a -> SQLData
toField (MemberName -> SQLData)
-> (ChatBinding -> MemberName) -> ChatBinding -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> MemberName
decodeLatin1 (ByteString -> MemberName)
-> (ChatBinding -> ByteString) -> ChatBinding -> MemberName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatBinding -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode

instance FromField ChatBinding where fromField :: FieldParser ChatBinding
fromField = (MemberName -> Maybe ChatBinding) -> FieldParser ChatBinding
forall a. Typeable a => (MemberName -> Maybe a) -> Field -> Ok a
fromTextField_ ((MemberName -> Maybe ChatBinding) -> FieldParser ChatBinding)
-> (MemberName -> Maybe ChatBinding) -> FieldParser ChatBinding
forall a b. (a -> b) -> a -> b
$ Either String ChatBinding -> Maybe ChatBinding
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String ChatBinding -> Maybe ChatBinding)
-> (MemberName -> Either String ChatBinding)
-> MemberName
-> Maybe ChatBinding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ChatBinding
forall a. Encoding a => ByteString -> Either String a
smpDecode (ByteString -> Either String ChatBinding)
-> (MemberName -> ByteString)
-> MemberName
-> Either String ChatBinding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemberName -> ByteString
encodeUtf8

instance Encoding MsgSignature where
  smpEncode :: MsgSignature -> ByteString
smpEncode (MsgSignature KeyRef
keyRef ASignature
sig) = (KeyRef, ByteString) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (KeyRef
keyRef, ASignature -> ByteString
forall s. CryptoSignature s => s -> ByteString
C.signatureBytes ASignature
sig)
  smpP :: Parser MsgSignature
smpP = KeyRef -> ASignature -> MsgSignature
MsgSignature (KeyRef -> ASignature -> MsgSignature)
-> Parser KeyRef -> Parser ByteString (ASignature -> MsgSignature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser KeyRef
forall a. Encoding a => Parser a
smpP Parser ByteString (ASignature -> MsgSignature)
-> Parser ByteString ASignature -> Parser MsgSignature
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
<*> (ByteString -> Either String ASignature
forall s. CryptoSignature s => ByteString -> Either String s
C.decodeSignature (ByteString -> Either String ASignature)
-> Parser ByteString -> Parser ByteString ASignature
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString
forall a. Encoding a => Parser a
smpP)

-- Wire format: <binding:1> <sigCount:1> (<keyRef><sig:64>)* <body>
instance Encoding SignedMsg where
  smpEncode :: SignedMsg -> ByteString
smpEncode SignedMsg {ChatBinding
$sel:chatBinding:SignedMsg :: SignedMsg -> ChatBinding
chatBinding :: ChatBinding
chatBinding, NonEmpty MsgSignature
$sel:signatures:SignedMsg :: SignedMsg -> NonEmpty MsgSignature
signatures :: NonEmpty MsgSignature
signatures, ByteString
$sel:signedBody:SignedMsg :: SignedMsg -> ByteString
signedBody :: ByteString
signedBody} = (ChatBinding, NonEmpty MsgSignature, Tail) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ChatBinding
chatBinding, NonEmpty MsgSignature
signatures, ByteString -> Tail
Tail ByteString
signedBody)
  smpP :: Parser SignedMsg
smpP = do
    (ChatBinding
chatBinding, NonEmpty MsgSignature
signatures, Tail ByteString
signedBody) <- Parser (ChatBinding, NonEmpty MsgSignature, Tail)
forall a. Encoding a => Parser a
smpP
    SignedMsg -> Parser SignedMsg
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignedMsg {ChatBinding
$sel:chatBinding:SignedMsg :: ChatBinding
chatBinding :: ChatBinding
chatBinding, NonEmpty MsgSignature
$sel:signatures:SignedMsg :: NonEmpty MsgSignature
signatures :: NonEmpty MsgSignature
signatures, ByteString
$sel:signedBody:SignedMsg :: ByteString
signedBody :: ByteString
signedBody}

-- | Generic signing context — data, not function.
-- Callers construct per-event; createSndMessages uses mechanically.
data MsgSigning = MsgSigning
  { MsgSigning -> ChatBinding
bindingTag :: ChatBinding,
    MsgSigning -> ByteString
bindingData :: ByteString,
    MsgSigning -> KeyRef
keyRef :: KeyRef,
    MsgSigning -> PrivateKeyEd25519
privKey :: C.PrivateKeyEd25519
  }

encodeChatBinding :: ChatBinding -> ByteString -> ByteString
encodeChatBinding :: ChatBinding -> ByteString -> ByteString
encodeChatBinding ChatBinding
cb ByteString
bindingData = ChatBinding -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode ChatBinding
cb ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bindingData

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 -> Maybe Bool
asGroup :: Maybe Bool} -> 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
  XMember :: {profile :: Profile, ChatMsgEvent 'Json -> MemberId
newMemberId :: MemberId, ChatMsgEvent 'Json -> MemberKey
newMemberKey :: MemberKey} -> 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
  XGrpRelayInv :: GroupRelayInvitation -> ChatMsgEvent 'Json
  XGrpRelayAcpt :: ShortLinkContact -> ChatMsgEvent 'Json
  XGrpRelayTest :: ByteString -> Maybe ByteString -> 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 :: GrpMsgForward -> ChatMessage 'Json -> 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
mc of
    MsgContainer {$sel:file:MsgContainer :: MsgContainer -> Maybe FileInvitation
file = Just FileInvitation {$sel:fileInline:FileInvitation :: FileInvitation -> Maybe InlineFileMode
fileInline = Just InlineFileMode
_}} -> Bool
False
    MsgContainer
_ -> 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
$sel:json:MREmoji :: MsgReaction -> Object
json :: Object
json} -> Object -> Value
J.Object Object
json
    MREmoji MREmojiChar
emoji -> [Pair] -> Value
J.object [Key
"type" Key -> MemberName -> Pair
forall v. ToJSON v => Key -> v -> Pair
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 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MREmojiChar
emoji]
  toEncoding :: MsgReaction -> Encoding
toEncoding = \case
    MRUnknown {Object
$sel:json:MREmoji :: 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
$sel:chunkNo:FileChunk :: FileChunk -> Integer
chunkNo :: Integer
chunkNo, ByteString
$sel:chunkBytes:FileChunk :: 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
$sel:chunkNo:FileChunk :: Integer
chunkNo :: Integer
chunkNo, ByteString
$sel:chunkBytes:FileChunk :: 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
$sel:chunkNo:FileChunk :: FileChunk -> Integer
chunkNo :: Integer
chunkNo, ByteString
$sel:chunkBytes:FileChunk :: 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 {$sel:chunkNo:FileChunk :: 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
$sel:chunkBytes:FileChunk :: 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 MsgContainer {$sel:quote:MsgContainer :: MsgContainer -> Maybe QuotedMsg
quote = Just QuotedMsg
quotedMsg}) -> 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 FromField MsgContentTag where fromField :: FieldParser MsgContentTag
fromField = (MemberName -> Maybe MsgContentTag) -> FieldParser MsgContentTag
forall a. Typeable a => (MemberName -> Maybe a) -> Field -> Ok a
fromTextField_ ((MemberName -> Maybe MsgContentTag) -> FieldParser MsgContentTag)
-> (MemberName -> Maybe MsgContentTag) -> FieldParser MsgContentTag
forall a b. (a -> b) -> a -> b
$ Either String MsgContentTag -> Maybe MsgContentTag
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String MsgContentTag -> Maybe MsgContentTag)
-> (MemberName -> Either String MsgContentTag)
-> MemberName
-> Maybe MsgContentTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String MsgContentTag
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String MsgContentTag)
-> (MemberName -> ByteString)
-> MemberName
-> Either String MsgContentTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemberName -> ByteString
encodeUtf8

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

-- Wire JSON 1:1 with parsed form. The three discriminator fields `quote`, `parent`,
-- and `forward` are independent and may co-occur (e.g. a comment that quotes another
-- comment carries both `parent` and `quote`). `forward` is `Maybe Bool` for backwards
-- compatibility with the previous wire encoding: the serializer omits the field when
-- `Nothing` and the parser treats absent/false as "not a forward".
data MsgContainer = MsgContainer
  { MsgContainer -> 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.
    MsgContainer -> MsgMentions
mentions :: MsgMentions,
    MsgContainer -> Maybe FileInvitation
file :: Maybe FileInvitation,
    MsgContainer -> Maybe Int
ttl :: Maybe Int,
    MsgContainer -> Maybe Bool
live :: Maybe Bool,
    MsgContainer -> Maybe MsgScope
scope :: Maybe MsgScope,
    MsgContainer -> Maybe Bool
asGroup :: Maybe Bool,
    MsgContainer -> Maybe QuotedMsg
quote :: Maybe QuotedMsg,
    MsgContainer -> Maybe MsgRef
parent :: Maybe MsgRef,
    MsgContainer -> Maybe Bool
forward :: Maybe Bool
  }
  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)

mcSimple :: MsgContent -> MsgContainer
mcSimple :: MsgContent -> MsgContainer
mcSimple MsgContent
content =
  MsgContainer
    { MsgContent
$sel:content:MsgContainer :: MsgContent
content :: MsgContent
content,
      $sel:mentions:MsgContainer :: MsgMentions
mentions = Map MemberName MsgMention -> MsgMentions
MsgMentions Map MemberName MsgMention
forall k a. Map k a
M.empty,
      $sel:file:MsgContainer :: Maybe FileInvitation
file = Maybe FileInvitation
forall a. Maybe a
Nothing,
      $sel:ttl:MsgContainer :: Maybe Int
ttl = Maybe Int
forall a. Maybe a
Nothing,
      $sel:live:MsgContainer :: Maybe Bool
live = Maybe Bool
forall a. Maybe a
Nothing,
      $sel:scope:MsgContainer :: Maybe MsgScope
scope = Maybe MsgScope
forall a. Maybe a
Nothing,
      $sel:asGroup:MsgContainer :: Maybe Bool
asGroup = Maybe Bool
forall a. Maybe a
Nothing,
      $sel:quote:MsgContainer :: Maybe QuotedMsg
quote = Maybe QuotedMsg
forall a. Maybe a
Nothing,
      $sel:parent:MsgContainer :: Maybe MsgRef
parent = Maybe MsgRef
forall a. Maybe a
Nothing,
      $sel:forward:MsgContainer :: Maybe Bool
forward = Maybe Bool
forall a. Maybe a
Nothing
    }

mcQuote :: QuotedMsg -> MsgContent -> MsgContainer
mcQuote :: QuotedMsg -> MsgContent -> MsgContainer
mcQuote QuotedMsg
q MsgContent
c = (MsgContent -> MsgContainer
mcSimple MsgContent
c) {quote = Just q}

mcComment :: MsgRef -> MsgContent -> MsgContainer
mcComment :: MsgRef -> MsgContent -> MsgContainer
mcComment MsgRef
p MsgContent
c = (MsgContent -> MsgContainer
mcSimple MsgContent
c) {parent = Just p}

mcForward :: MsgContent -> MsgContainer
mcForward :: MsgContent -> MsgContainer
mcForward MsgContent
c = (MsgContent -> MsgContainer
mcSimple MsgContent
c) {forward = Just True}

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, MsgContent -> Maybe LinkOwnerSig
ownerSig :: Maybe LinkOwnerSig}
  | 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)

data LinkOwnerSig = LinkOwnerSig
  { LinkOwnerSig -> Maybe B64UrlByteString
ownerId :: Maybe B64UrlByteString,
    LinkOwnerSig -> B64UrlByteString
chatBinding :: B64UrlByteString,
    LinkOwnerSig -> Signature 'Ed25519
ownerSig :: C.Signature 'C.Ed25519
  }
  deriving (LinkOwnerSig -> LinkOwnerSig -> Bool
(LinkOwnerSig -> LinkOwnerSig -> Bool)
-> (LinkOwnerSig -> LinkOwnerSig -> Bool) -> Eq LinkOwnerSig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkOwnerSig -> LinkOwnerSig -> Bool
== :: LinkOwnerSig -> LinkOwnerSig -> Bool
$c/= :: LinkOwnerSig -> LinkOwnerSig -> Bool
/= :: LinkOwnerSig -> LinkOwnerSig -> Bool
Eq, Int -> LinkOwnerSig -> ShowS
[LinkOwnerSig] -> ShowS
LinkOwnerSig -> String
(Int -> LinkOwnerSig -> ShowS)
-> (LinkOwnerSig -> String)
-> ([LinkOwnerSig] -> ShowS)
-> Show LinkOwnerSig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkOwnerSig -> ShowS
showsPrec :: Int -> LinkOwnerSig -> ShowS
$cshow :: LinkOwnerSig -> String
show :: LinkOwnerSig -> String
$cshowList :: [LinkOwnerSig] -> ShowS
showList :: [LinkOwnerSig] -> ShowS
Show)

msgContentText :: MsgContent -> Text
msgContentText :: MsgContent -> MemberName
msgContentText = \case
  MCText MemberName
t -> MemberName
t
  MCLink {MemberName
$sel:text:MCText :: MsgContent -> MemberName
text :: MemberName
text} -> MemberName
text
  MCImage {MemberName
$sel:text:MCText :: MsgContent -> MemberName
text :: MemberName
text} -> MemberName
text
  MCVideo {MemberName
$sel:text:MCText :: MsgContent -> MemberName
text :: MemberName
text} -> MemberName
text
  MCVoice {MemberName
$sel:text:MCText :: MsgContent -> MemberName
text :: MemberName
text, Int
$sel:duration:MCText :: 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
$sel:text:MCText :: MsgContent -> MemberName
text :: MemberName
text, ReportReason
$sel:reason:MCText :: 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
$sel:text:MCText :: MsgContent -> MemberName
text :: MemberName
text} -> MemberName
text
  MCUnknown {MemberName
$sel:text:MCText :: 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
$sel:text:MCText :: 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
$sel:tag:MCText :: MsgContent -> MemberName
tag :: MemberName
tag} -> MemberName -> MsgContentTag
MCUnknown_ MemberName
tag

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)

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

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

$(JQ.deriveJSON defaultJSON ''LinkOwnerSig)

$(JQ.deriveJSON defaultJSON ''MsgMention)

instance FromJSON MsgMentions where
  parseJSON :: Value -> Parser MsgMentions
parseJSON Value
v = Map MemberName MsgMention -> MsgMentions
MsgMentions (Map MemberName MsgMention -> MsgMentions)
-> Parser (Map MemberName MsgMention) -> Parser MsgMentions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map MemberName MsgMention)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  omittedField :: Maybe MsgMentions
omittedField = MsgMentions -> Maybe MsgMentions
forall a. a -> Maybe a
Just (MsgMentions -> Maybe MsgMentions)
-> MsgMentions -> Maybe MsgMentions
forall a b. (a -> b) -> a -> b
$ Map MemberName MsgMention -> MsgMentions
MsgMentions Map MemberName MsgMention
forall k a. Map k a
M.empty

instance ToJSON MsgMentions where
  toJSON :: MsgMentions -> Value
toJSON (MsgMentions Map MemberName MsgMention
m) = Maybe (Map MemberName MsgMention) -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe (Map MemberName MsgMention) -> Value)
-> Maybe (Map MemberName MsgMention) -> Value
forall a b. (a -> b) -> a -> b
$ Map MemberName MsgMention -> Maybe (Map MemberName MsgMention)
forall k v. Map k v -> Maybe (Map k v)
toMaybeMap Map MemberName MsgMention
m
  toEncoding :: MsgMentions -> Encoding
toEncoding (MsgMentions Map MemberName MsgMention
m) = Maybe (Map MemberName MsgMention) -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Maybe (Map MemberName MsgMention) -> Encoding)
-> Maybe (Map MemberName MsgMention) -> Encoding
forall a b. (a -> b) -> a -> b
$ Map MemberName MsgMention -> Maybe (Map MemberName MsgMention)
forall k v. Map k v -> Maybe (Map k v)
toMaybeMap Map MemberName MsgMention
m
  omitField :: MsgMentions -> Bool
omitField (MsgMentions Map MemberName MsgMention
m) = Map MemberName MsgMention -> Bool
forall k a. Map k a -> Bool
M.null Map MemberName MsgMention
m

toMaybeMap :: Map k v -> Maybe (Map k v)
toMaybeMap :: forall k v. Map k v -> Maybe (Map k v)
toMaybeMap 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 toMaybeMap #-}

$(JQ.deriveJSON defaultJSON ''QuotedMsg)

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
$sel:text:MCText :: MemberName
text :: MemberName
text, LinkPreview
$sel:preview:MCText :: 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
$sel:text:MCText :: MemberName
text :: MemberName
text, ImageData
$sel:image:MCText :: 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
$sel:text:MCText :: MemberName
text :: MemberName
text, ImageData
$sel:image:MCText :: ImageData
image :: ImageData
image, Int
$sel:duration:MCText :: 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
$sel:text:MCText :: MemberName
text :: MemberName
text, Int
$sel:duration:MCText :: 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
$sel:text:MCText :: MemberName
text :: MemberName
text, ReportReason
$sel:reason:MCText :: 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"
        Maybe LinkOwnerSig
ownerSig <- Object
v Object -> Key -> Parser (Maybe LinkOwnerSig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ownerSig"
        MsgContent -> Parser MsgContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MCChat {MemberName
$sel:text:MCText :: MemberName
text :: MemberName
text, MsgChatLink
$sel:chatLink:MCText :: MsgChatLink
chatLink :: MsgChatLink
chatLink, Maybe LinkOwnerSig
$sel:ownerSig:MCText :: Maybe LinkOwnerSig
ownerSig :: Maybe LinkOwnerSig
ownerSig}
      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
$sel:tag:MCText :: MemberName
tag :: MemberName
tag, MemberName
$sel:text:MCText :: MemberName
text :: MemberName
text, $sel:json:MCText :: 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"

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

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

$(JQ.deriveJSON defaultJSON ''MsgContainer)

-- 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

maxDecompressedMsgLength :: Int
maxDecompressedMsgLength :: Int
maxDecompressedMsgLength = Int
65536

-- 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 = ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ AppMessageJson -> ByteString
forall a. ToJSON a => a -> ByteString
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 AParsedMsg]
parseChatMessages :: ByteString -> [Either String AParsedMsg]
parseChatMessages ByteString
"" = [String -> Either String AParsedMsg
forall a b. a -> Either a b
Left String
"empty string"]
parseChatMessages ByteString
msg = case ByteString -> Char
B.head ByteString
msg of
  Char
'X' -> ByteString -> [Either String AParsedMsg]
decodeCompressed (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
msg)
  Char
c -> Char -> ByteString -> [Either String AParsedMsg]
parseUncompressed Char
c ByteString
msg
  where
    parseUncompressed :: Char -> ByteString -> [Either String AParsedMsg]
parseUncompressed Char
c ByteString
s = case Char
c of
      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 AParsedMsg)
-> [Value] -> [Either String AParsedMsg]
forall a b. (a -> b) -> [a] -> [b]
map ((AChatMessage -> AParsedMsg)
-> Either String AChatMessage -> Either String AParsedMsg
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AChatMessage -> AParsedMsg
plainMsg (Either String AChatMessage -> Either String AParsedMsg)
-> (Value -> Either String AChatMessage)
-> Value
-> Either String AParsedMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either String AChatMessage
parseItem) [Value]
v
        Left String
e -> [String -> Either String AParsedMsg
forall a b. a -> Either a b
Left String
e]
      Char
'=' -> ByteString -> [Either String AParsedMsg]
decodeBinaryBatch (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
s)
      Char
_ -> [Parser AParsedMsg -> ByteString -> Either String AParsedMsg
forall a. Parser a -> ByteString -> Either String a
parseAll (Maybe GrpMsgForward -> Parser AParsedMsg
elementP Maybe GrpMsgForward
forall a. Maybe a
Nothing) ByteString
s]
    plainMsg :: AChatMessage -> AParsedMsg
plainMsg = Maybe GrpMsgForward
-> Maybe SignedMsg -> AChatMessage -> AParsedMsg
aParsedMsg Maybe GrpMsgForward
forall a. Maybe a
Nothing Maybe SignedMsg
forall a. Maybe a
Nothing
    aParsedMsg :: Maybe GrpMsgForward
-> Maybe SignedMsg -> AChatMessage -> AParsedMsg
aParsedMsg Maybe GrpMsgForward
fwd Maybe SignedMsg
sm (ACMsg SMsgEncoding e
enc ChatMessage e
cm) = SMsgEncoding e -> ParsedMsg e -> AParsedMsg
forall (e :: MsgEncoding).
MsgEncodingI e =>
SMsgEncoding e -> ParsedMsg e -> AParsedMsg
APMsg SMsgEncoding e
enc (Maybe GrpMsgForward
-> Maybe SignedMsg -> ChatMessage e -> ParsedMsg e
forall (e :: MsgEncoding).
Maybe GrpMsgForward
-> Maybe SignedMsg -> ChatMessage e -> ParsedMsg e
ParsedMsg Maybe GrpMsgForward
fwd Maybe SignedMsg
sm ChatMessage e
cm)
    parseMsg :: ByteString -> Either String AChatMessage
parseMsg ByteString
s = 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
    msgP :: A.Parser AChatMessage
    msgP :: Parser AChatMessage
msgP = ByteString -> Either String AChatMessage
parseMsg (ByteString -> Either String AChatMessage)
-> Parser ByteString -> Parser AChatMessage
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString
A.takeByteString
    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 AParsedMsg]
    decodeCompressed :: ByteString -> [Either String AParsedMsg]
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 AParsedMsg
forall a b. a -> Either a b
Left String
e]
      Right (NonEmpty Compressed
compressed :: L.NonEmpty Compressed) -> case (Compressed -> Maybe Int)
-> NonEmpty Compressed -> Maybe (NonEmpty Int)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse Compressed -> Maybe Int
decompressedSize NonEmpty Compressed
compressed of
        Maybe (NonEmpty Int)
Nothing -> [String -> Either String AParsedMsg
forall a b. a -> Either a b
Left String
"compressed size not specified"]
        Just NonEmpty Int
sizes
          | NonEmpty Int -> Int
forall a. Num a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum NonEmpty Int
sizes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxDecompressedMsgLength -> [String -> Either String AParsedMsg
forall a b. a -> Either a b
Left String
"decompressed size exceeds limit"]
          | Bool
otherwise -> (Compressed -> [Either String AParsedMsg])
-> NonEmpty Compressed -> [Either String AParsedMsg]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> [Either String AParsedMsg])
-> (ByteString -> [Either String AParsedMsg])
-> Either String ByteString
-> [Either String AParsedMsg]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
e -> [String -> Either String AParsedMsg
forall a b. a -> Either a b
Left String
e]) ByteString -> [Either String AParsedMsg]
parseUncompressed' (Either String ByteString -> [Either String AParsedMsg])
-> (Compressed -> Either String ByteString)
-> Compressed
-> [Either String AParsedMsg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compressed -> Either String ByteString
decompress1) NonEmpty Compressed
compressed
    parseUncompressed' :: ByteString -> [Either String AParsedMsg]
parseUncompressed' ByteString
"" = [String -> Either String AParsedMsg
forall a b. a -> Either a b
Left String
"empty string"]
    parseUncompressed' ByteString
s = Char -> ByteString -> [Either String AParsedMsg]
parseUncompressed (ByteString -> Char
B.head ByteString
s) ByteString
s
    -- Binary batch format: '=' <count:1> (<len:2> <body>)*
    decodeBinaryBatch :: ByteString -> [Either String AParsedMsg]
    decodeBinaryBatch :: ByteString -> [Either String AParsedMsg]
decodeBinaryBatch ByteString
s = case Parser [Large] -> ByteString -> Either String [Large]
forall a. Parser a -> ByteString -> Either String a
parseAll Parser [Large]
forall a. Encoding a => Parser [a]
smpListP ByteString
s of
      Left String
e -> [String -> Either String AParsedMsg
forall a b. a -> Either a b
Left String
e]
      Right [Large]
msgs -> (Large -> Either String AParsedMsg)
-> [Large] -> [Either String AParsedMsg]
forall a b. (a -> b) -> [a] -> [b]
map Large -> Either String AParsedMsg
parseBatchElement [Large]
msgs
    parseBatchElement :: Large -> Either String AParsedMsg
    parseBatchElement :: Large -> Either String AParsedMsg
parseBatchElement (Large ByteString
s) = Parser AParsedMsg -> ByteString -> Either String AParsedMsg
forall a. Parser a -> ByteString -> Either String a
parseAll (Maybe GrpMsgForward -> Parser AParsedMsg
elementP Maybe GrpMsgForward
forall a. Maybe a
Nothing) ByteString
s
    elementP :: Maybe GrpMsgForward -> A.Parser AParsedMsg
    elementP :: Maybe GrpMsgForward -> Parser AParsedMsg
elementP Maybe GrpMsgForward
fwd = Parser Char
A.peekChar' Parser Char -> (Char -> Parser AParsedMsg) -> Parser AParsedMsg
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
'/' -> Char -> Parser Char
A.char Char
'/' Parser Char -> Parser AParsedMsg -> Parser AParsedMsg
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
        ChatBinding
tag <- Parser ChatBinding
forall a. Encoding a => Parser a
smpP
        NonEmpty MsgSignature
sigs <- Parser (NonEmpty MsgSignature)
forall a. Encoding a => Parser a
smpP
        (ByteString
body, AChatMessage
acm) <- Parser AChatMessage -> Parser (ByteString, AChatMessage)
forall a. Parser a -> Parser (ByteString, a)
A.match Parser AChatMessage
msgP
        AParsedMsg -> Parser AParsedMsg
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AParsedMsg -> Parser AParsedMsg)
-> AParsedMsg -> Parser AParsedMsg
forall a b. (a -> b) -> a -> b
$ Maybe GrpMsgForward
-> Maybe SignedMsg -> AChatMessage -> AParsedMsg
aParsedMsg Maybe GrpMsgForward
fwd (SignedMsg -> Maybe SignedMsg
forall a. a -> Maybe a
Just (SignedMsg -> Maybe SignedMsg) -> SignedMsg -> Maybe SignedMsg
forall a b. (a -> b) -> a -> b
$ ChatBinding -> NonEmpty MsgSignature -> ByteString -> SignedMsg
SignedMsg ChatBinding
tag NonEmpty MsgSignature
sigs ByteString
body) AChatMessage
acm
      Char
'>' -> Char -> Parser Char
A.char Char
'>' Parser Char -> Parser AParsedMsg -> Parser AParsedMsg
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
        Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe GrpMsgForward -> Bool
forall a. Maybe a -> Bool
isJust Maybe GrpMsgForward
fwd) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"nested forward elements not supported"
        Maybe GrpMsgForward -> Parser AParsedMsg
elementP (Maybe GrpMsgForward -> Parser AParsedMsg)
-> (GrpMsgForward -> Maybe GrpMsgForward)
-> GrpMsgForward
-> Parser AParsedMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrpMsgForward -> Maybe GrpMsgForward
forall a. a -> Maybe a
Just (GrpMsgForward -> Parser AParsedMsg)
-> Parser GrpMsgForward -> Parser AParsedMsg
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser GrpMsgForward
forall a. Encoding a => Parser a
smpP
      Char
'{' -> Maybe GrpMsgForward
-> Maybe SignedMsg -> AChatMessage -> AParsedMsg
aParsedMsg Maybe GrpMsgForward
fwd Maybe SignedMsg
forall a. Maybe a
Nothing (AChatMessage -> AParsedMsg)
-> Parser AChatMessage -> Parser AParsedMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AChatMessage
msgP
      -- 'F' must match BFileChunk_ tag encoding
      Char
'F' -> Maybe GrpMsgForward
-> Maybe SignedMsg -> AChatMessage -> AParsedMsg
aParsedMsg Maybe GrpMsgForward
fwd Maybe SignedMsg
forall a. Maybe a
Nothing (AChatMessage -> AParsedMsg)
-> (ChatMessage 'Binary -> AChatMessage)
-> ChatMessage 'Binary
-> AParsedMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMsgEncoding 'Binary -> ChatMessage 'Binary -> AChatMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
SMsgEncoding e -> ChatMessage e -> AChatMessage
ACMsg SMsgEncoding 'Binary
SBinary (ChatMessage 'Binary -> AParsedMsg)
-> Parser ByteString (ChatMessage 'Binary) -> Parser AParsedMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AppMessageBinary -> Either String (ChatMessage 'Binary)
appBinaryToCM (AppMessageBinary -> Either String (ChatMessage 'Binary))
-> Parser AppMessageBinary
-> Parser ByteString (ChatMessage 'Binary)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser AppMessageBinary
forall a. StrEncoding a => Parser a
strP)
      Char
c -> String -> Parser AParsedMsg
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser AParsedMsg) -> String -> Parser AParsedMsg
forall a b. (a -> b) -> a -> b
$ String
"invalid element prefix: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c

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 #-}

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

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 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
  XMember_ :: CMEventTag 'Json
  XDirectDel_ :: CMEventTag 'Json
  XGrpInv_ :: CMEventTag 'Json
  XGrpAcpt_ :: CMEventTag 'Json
  XGrpLinkInv_ :: CMEventTag 'Json
  XGrpLinkReject_ :: CMEventTag 'Json
  XGrpLinkMem_ :: CMEventTag 'Json
  XGrpLinkAcpt_ :: CMEventTag 'Json
  XGrpRelayInv_ :: CMEventTag 'Json
  XGrpRelayAcpt_ :: CMEventTag 'Json
  XGrpRelayTest_ :: 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
XMember_ -> ByteString
"x.member"
    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
XGrpRelayInv_ -> ByteString
"x.grp.relay.inv"
    CMEventTag e
XGrpRelayAcpt_ -> ByteString
"x.grp.relay.acpt"
    CMEventTag e
XGrpRelayTest_ -> ByteString
"x.grp.relay.test"
    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.member" -> CMEventTag 'Json
XMember_
        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.relay.inv" -> CMEventTag 'Json
XGrpRelayInv_
        ByteString
"x.grp.relay.acpt" -> CMEventTag 'Json
XGrpRelayAcpt_
        ByteString
"x.grp.relay.test" -> CMEventTag 'Json
XGrpRelayTest_
        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_
  XMember {} -> CMEventTag e
CMEventTag 'Json
XMember_
  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_
  XGrpRelayInv GroupRelayInvitation
_ -> CMEventTag e
CMEventTag 'Json
XGrpRelayInv_
  XGrpRelayAcpt ShortLinkContact
_ -> CMEventTag e
CMEventTag 'Json
XGrpRelayAcpt_
  XGrpRelayTest {} -> CMEventTag e
CMEventTag 'Json
XGrpRelayTest_
  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

-- | Events that must have a valid signature in relay groups.
requiresSignature :: CMEventTag e -> Bool
requiresSignature :: forall (e :: MsgEncoding). CMEventTag e -> Bool
requiresSignature = \case
  CMEventTag e
XGrpDel_ -> Bool
True
  CMEventTag e
XGrpInfo_ -> Bool
True
  CMEventTag e
XGrpPrefs_ -> Bool
True
  CMEventTag e
XGrpMemDel_ -> Bool
True
  CMEventTag e
XGrpMemRole_ -> Bool
True
  CMEventTag e
XGrpMemRestrict_ -> Bool
True
  CMEventTag e
XGrpLeave_ -> Bool
True
  CMEventTag e
XInfo_ -> Bool
True
  CMEventTag e
_ -> Bool
False

-- TODO [relays] relay: vectors tracking which members received which other member profiles/keys.
-- TODO   - don't forward XGrpLeave/XInfo to members who haven't seen sender's profile/key.
-- TODO   - unverifiedAllowed is a temporary workaround postponing targeted event forwarding.

-- Allow signed but unverified XGrpLeave/XInfo between subscribers when sender's key is unknown.
-- Owner keys are always known, so subscribers are required to verify from owners.
-- Likewise, subscriber keys are always known to owners, so owners are required to verify from subscribers.
unverifiedAllowed :: GroupMember -> GroupMember -> CMEventTag e -> Bool
unverifiedAllowed :: forall (e :: MsgEncoding).
GroupMember -> GroupMember -> CMEventTag e -> Bool
unverifiedAllowed GroupMember
membership GroupMember
member = \case
  CMEventTag e
XGrpLeave_ -> Bool
membersNoKey
  CMEventTag e
XInfo_ -> Bool
membersNoKey
  CMEventTag e
_ -> Bool
False
  where
    membersNoKey :: Bool
membersNoKey =
      GroupMember -> GroupMemberRole
memberRole' GroupMember
membership GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
< GroupMemberRole
GRModerator
        Bool -> Bool -> Bool
&& GroupMember -> GroupMemberRole
memberRole' GroupMember
member GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
< GroupMemberRole
GRModerator
        Bool -> Bool -> Bool
&& Maybe PublicKeyEd25519 -> Bool
forall a. Maybe a -> Bool
isNothing (GroupMember -> Maybe PublicKeyEd25519
memberPubKey GroupMember
member)

appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary)
appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary)
appBinaryToCM AppMessageBinary {Maybe SharedMsgId
$sel:msgId:AppMessageBinary :: AppMessageBinary -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, Char
$sel:tag:AppMessageBinary :: AppMessageBinary -> Char
tag :: Char
tag, ByteString
$sel:body:AppMessageBinary :: 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 {$sel:chatVRange:ChatMessage :: VersionRangeChat
chatVRange = VersionRangeChat
chatInitialVRange, Maybe SharedMsgId
$sel:msgId:ChatMessage :: Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, ChatMsgEvent 'Binary
$sel:chatMsgEvent:ChatMessage :: 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
$sel:v:AppMessageJson :: AppMessageJson -> Maybe ChatVersionRange
v :: Maybe ChatVersionRange
v, Maybe SharedMsgId
$sel:msgId:AppMessageJson :: AppMessageJson -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, MemberName
$sel:event:AppMessageJson :: AppMessageJson -> MemberName
event :: MemberName
event, Object
$sel:params:AppMessageJson :: 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 {$sel:chatVRange:ChatMessage :: 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
$sel:msgId:ChatMessage :: Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, ChatMsgEvent 'Json
$sel:chatMsgEvent:ChatMessage :: 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
<$> (Value -> Parser MsgContainer)
-> Value -> Either String MsgContainer
forall a b. (a -> Parser b) -> a -> Either String b
JT.parseEither Value -> Parser MsgContainer
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
J.Object 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"
        Maybe Bool
asGroup <- Key -> Either String (Maybe Bool)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"asGroup"
        ChatMsgEvent 'Json -> Either String (ChatMsgEvent 'Json)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure XMsgUpdate {$sel:msgId:XMsgNew :: SharedMsgId
msgId = SharedMsgId
msgId', MsgContent
$sel:content:XMsgNew :: MsgContent
content :: MsgContent
content, Map MemberName MsgMention
$sel:mentions:XMsgNew :: Map MemberName MsgMention
mentions :: Map MemberName MsgMention
mentions, Maybe Int
$sel:ttl:XMsgNew :: Maybe Int
ttl :: Maybe Int
ttl, Maybe Bool
$sel:live:XMsgNew :: Maybe Bool
live :: Maybe Bool
live, Maybe MsgScope
$sel:scope:XMsgNew :: Maybe MsgScope
scope :: Maybe MsgScope
scope, Maybe Bool
$sel:asGroup:XMsgNew :: Maybe Bool
asGroup :: Maybe Bool
asGroup}
      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
$sel:profile:XMsgNew :: Profile
profile :: Profile
profile, Maybe XContactId
$sel:contactReqId:XMsgNew :: Maybe XContactId
contactReqId :: Maybe XContactId
contactReqId, Maybe SharedMsgId
$sel:welcomeMsgId:XMsgNew :: Maybe SharedMsgId
welcomeMsgId :: Maybe SharedMsgId
welcomeMsgId, Maybe (SharedMsgId, MsgContent)
$sel:requestMsg:XMsgNew :: Maybe (SharedMsgId, MsgContent)
requestMsg :: Maybe (SharedMsgId, MsgContent)
requestMsg}
      CMEventTag 'Json
XMember_ -> Profile -> MemberId -> MemberKey -> ChatMsgEvent 'Json
XMember (Profile -> MemberId -> MemberKey -> ChatMsgEvent 'Json)
-> Either String Profile
-> Either String (MemberId -> MemberKey -> 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" Either String (MemberId -> MemberKey -> ChatMsgEvent 'Json)
-> Either String MemberId
-> Either String (MemberKey -> 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
"newMemberId" Either String (MemberKey -> ChatMsgEvent 'Json)
-> Either String MemberKey -> 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 MemberKey
forall a. FromJSON a => Key -> Either String a
p Key
"newMemberKey"
      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
XGrpRelayInv_ -> GroupRelayInvitation -> ChatMsgEvent 'Json
XGrpRelayInv (GroupRelayInvitation -> ChatMsgEvent 'Json)
-> Either String GroupRelayInvitation
-> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String GroupRelayInvitation
forall a. FromJSON a => Key -> Either String a
p Key
"groupRelayInvitation"
      CMEventTag 'Json
XGrpRelayAcpt_ -> ShortLinkContact -> ChatMsgEvent 'Json
XGrpRelayAcpt (ShortLinkContact -> ChatMsgEvent 'Json)
-> Either String ShortLinkContact
-> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String ShortLinkContact
forall a. FromJSON a => Key -> Either String a
p Key
"relayLink"
      CMEventTag 'Json
XGrpRelayTest_ -> do
        B64UrlByteString ByteString
challenge <- Key -> Either String B64UrlByteString
forall a. FromJSON a => Key -> Either String a
p Key
"challenge"
        Maybe ByteString
sig_ <- (B64UrlByteString -> ByteString)
-> Maybe B64UrlByteString -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(B64UrlByteString ByteString
s) -> ByteString
s) (Maybe B64UrlByteString -> Maybe ByteString)
-> Either String (Maybe B64UrlByteString)
-> Either String (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String (Maybe B64UrlByteString)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"signature"
        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
$ ByteString -> Maybe ByteString -> ChatMsgEvent 'Json
XGrpRelayTest ByteString
challenge Maybe ByteString
sig_
      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_ -> do
        FwdSender
fwdSender <- Key -> Either String (Maybe MemberId)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"memberId" Either String (Maybe MemberId)
-> (Maybe MemberId -> Either String FwdSender)
-> Either String FwdSender
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just MemberId
memberId -> MemberId -> MemberName -> FwdSender
FwdMember MemberId
memberId (MemberName -> FwdSender)
-> (Maybe MemberName -> MemberName)
-> Maybe MemberName
-> FwdSender
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemberName -> Maybe MemberName -> MemberName
forall a. a -> Maybe a -> a
fromMaybe MemberName
"" (Maybe MemberName -> FwdSender)
-> Either String (Maybe MemberName) -> Either String FwdSender
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String (Maybe MemberName)
forall a. FromJSON a => Key -> Either String (Maybe a)
opt Key
"memberName"
          Maybe MemberId
Nothing -> FwdSender -> Either String FwdSender
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FwdSender
FwdChannel
        UTCTime
fwdBrokerTs <- Key -> Either String UTCTime
forall a. FromJSON a => Key -> Either String a
p Key
"msgTs"
        GrpMsgForward -> ChatMessage 'Json -> ChatMsgEvent 'Json
XGrpMsgForward (GrpMsgForward {FwdSender
$sel:fwdSender:GrpMsgForward :: FwdSender
fwdSender :: FwdSender
fwdSender, UTCTime
$sel:fwdBrokerTs:GrpMsgForward :: UTCTime
fwdBrokerTs :: UTCTime
fwdBrokerTs}) (ChatMessage 'Json -> ChatMsgEvent 'Json)
-> Either String (ChatMessage 'Json)
-> Either String (ChatMsgEvent 'Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Either String (ChatMessage 'Json)
forall a. FromJSON a => Key -> Either String a
p Key
"msg"
      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

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
$sel:chatVRange:ChatMessage :: forall (e :: MsgEncoding). ChatMessage e -> VersionRangeChat
chatVRange :: VersionRangeChat
chatVRange, Maybe SharedMsgId
$sel:msgId:ChatMessage :: forall (e :: MsgEncoding). ChatMessage e -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, ChatMsgEvent e
$sel:chatMsgEvent:ChatMessage :: 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 {$sel:msgId:AppMessageBinary :: Maybe SharedMsgId
msgId = Maybe SharedMsgId
forall a. Maybe a
Nothing, $sel:tag:AppMessageBinary :: 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, $sel:body:AppMessageBinary :: ByteString
body = ChatMessage 'Binary -> ByteString
chatMsgBinaryToBody ChatMessage e
ChatMessage 'Binary
chatMsg}
  SMsgEncoding e
SJson -> AppMessageJson -> AppMessage 'Json
AMJson AppMessageJson {$sel:v:AppMessageJson :: 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
$sel:msgId:AppMessageJson :: Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, $sel:event:AppMessageJson :: MemberName
event = CMEventTag e -> MemberName
forall a. TextEncoding a => a -> MemberName
textEncode CMEventTag e
tag, $sel:params:AppMessageJson :: 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 :: [Pair] -> Object
o = [Pair] -> Object
forall v. [(Key, v)] -> KeyMap v
JM.fromList
    params :: ChatMsgEvent 'Json -> J.Object
    params :: ChatMsgEvent 'Json -> Object
params = \case
      XMsgNew MsgContainer
mc -> case MsgContainer -> Value
forall a. ToJSON a => a -> Value
toJSON MsgContainer
mc of
        J.Object Object
obj -> Object
obj
        Value
_ -> Object
forall v. KeyMap v
JM.empty
      XMsgFileDescr SharedMsgId
msgId' FileDescr
fileDescr -> [Pair] -> Object
o [Key
"msgId" Key -> SharedMsgId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
msgId', Key
"fileDescr" Key -> FileDescr -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FileDescr
fileDescr]
      XMsgUpdate {$sel:msgId:XMsgNew :: ChatMsgEvent 'Json -> SharedMsgId
msgId = SharedMsgId
msgId', MsgContent
$sel:content:XMsgNew :: ChatMsgEvent 'Json -> MsgContent
content :: MsgContent
content, Map MemberName MsgMention
$sel:mentions:XMsgNew :: ChatMsgEvent 'Json -> Map MemberName MsgMention
mentions :: Map MemberName MsgMention
mentions, Maybe Int
$sel:ttl:XMsgNew :: ChatMsgEvent 'Json -> Maybe Int
ttl :: Maybe Int
ttl, Maybe Bool
$sel:live:XMsgNew :: ChatMsgEvent 'Json -> Maybe Bool
live :: Maybe Bool
live, Maybe MsgScope
$sel:scope:XMsgNew :: ChatMsgEvent 'Json -> Maybe MsgScope
scope :: Maybe MsgScope
scope, Maybe Bool
$sel:asGroup:XMsgNew :: ChatMsgEvent 'Json -> Maybe Bool
asGroup :: Maybe Bool
asGroup} -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"asGroup" Key -> Maybe Bool -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe Bool
asGroup) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ (Key
"ttl" Key -> Maybe Int -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe Int
ttl) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ (Key
"live" Key -> Maybe Bool -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe Bool
live) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe MsgScope
scope) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ (Key
"mentions" Key -> Maybe (Map MemberName MsgMention) -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? 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 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
msgId', Key
"content" Key -> MsgContent -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgContent
content]
      XMsgDel SharedMsgId
msgId' Maybe MemberId
memberId Maybe MsgScope
scope -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"memberId" Key -> Maybe MemberId -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe MemberId
memberId) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe MsgScope
scope) [Key
"msgId" Key -> SharedMsgId -> Pair
forall v. ToJSON v => Key -> v -> Pair
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 -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"memberId" Key -> Maybe MemberId -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe MemberId
memberId) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe MsgScope
scope) [Key
"msgId" Key -> SharedMsgId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
msgId', Key
"reaction" Key -> MsgReaction -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MsgReaction
reaction, Key
"add" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
add]
      XFile FileInvitation
fileInv -> [Pair] -> Object
o [Key
"file" Key -> FileInvitation -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FileInvitation
fileInv]
      XFileAcpt String
fileName -> [Pair] -> Object
o [Key
"fileName" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
fileName]
      XFileAcptInv SharedMsgId
sharedMsgId Maybe ConnReqInvitation
fileConnReq String
fileName -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"fileConnReq" Key -> Maybe ConnReqInvitation -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe ConnReqInvitation
fileConnReq) [Key
"msgId" Key -> SharedMsgId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
sharedMsgId, Key
"fileName" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
fileName]
      XFileCancel SharedMsgId
sharedMsgId -> [Pair] -> Object
o [Key
"msgId" Key -> SharedMsgId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SharedMsgId
sharedMsgId]
      XInfo Profile
profile -> [Pair] -> Object
o [Key
"profile" Key -> Profile -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Profile
profile]
      XContact {Profile
$sel:profile:XMsgNew :: ChatMsgEvent 'Json -> Profile
profile :: Profile
profile, Maybe XContactId
$sel:contactReqId:XMsgNew :: ChatMsgEvent 'Json -> Maybe XContactId
contactReqId :: Maybe XContactId
contactReqId, Maybe SharedMsgId
$sel:welcomeMsgId:XMsgNew :: ChatMsgEvent 'Json -> Maybe SharedMsgId
welcomeMsgId :: Maybe SharedMsgId
welcomeMsgId, Maybe (SharedMsgId, MsgContent)
$sel:requestMsg:XMsgNew :: ChatMsgEvent 'Json -> Maybe (SharedMsgId, MsgContent)
requestMsg :: Maybe (SharedMsgId, MsgContent)
requestMsg} -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"contactReqId" Key -> Maybe XContactId -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe XContactId
contactReqId) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ (Key
"welcomeMsgId" Key -> Maybe SharedMsgId -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe SharedMsgId
welcomeMsgId) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ (Key
"msgId" Key -> Maybe SharedMsgId -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? ((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)) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ (Key
"content" Key -> Maybe MsgContent -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? ((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)) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ [Key
"profile" Key -> Profile -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Profile
profile]
      XMember {Profile
$sel:profile:XMsgNew :: ChatMsgEvent 'Json -> Profile
profile :: Profile
profile, MemberId
$sel:newMemberId:XMsgNew :: ChatMsgEvent 'Json -> MemberId
newMemberId :: MemberId
newMemberId, MemberKey
$sel:newMemberKey:XMsgNew :: ChatMsgEvent 'Json -> MemberKey
newMemberKey :: MemberKey
newMemberKey} -> [Pair] -> Object
o [Key
"profile" Key -> Profile -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Profile
profile, Key
"newMemberId" Key -> MemberId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
newMemberId, Key
"newMemberKey" Key -> MemberKey -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberKey
newMemberKey]
      ChatMsgEvent 'Json
XDirectDel -> Object
forall v. KeyMap v
JM.empty
      XGrpInv GroupInvitation
groupInv -> [Pair] -> Object
o [Key
"groupInvitation" Key -> GroupInvitation -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupInvitation
groupInv]
      XGrpAcpt MemberId
memId -> [Pair] -> Object
o [Key
"memberId" Key -> MemberId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId]
      XGrpLinkInv GroupLinkInvitation
groupLinkInv -> [Pair] -> Object
o [Key
"groupLinkInvitation" Key -> GroupLinkInvitation -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupLinkInvitation
groupLinkInv]
      XGrpLinkReject GroupLinkRejection
groupLinkRjct -> [Pair] -> Object
o [Key
"groupLinkRejection" Key -> GroupLinkRejection -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupLinkRejection
groupLinkRjct]
      XGrpLinkMem Profile
profile -> [Pair] -> Object
o [Key
"profile" Key -> Profile -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Profile
profile]
      XGrpLinkAcpt GroupAcceptance
acceptance GroupMemberRole
role MemberId
memberId -> [Pair] -> Object
o [Key
"acceptance" Key -> GroupAcceptance -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupAcceptance
acceptance, Key
"role" Key -> GroupMemberRole -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupMemberRole
role, Key
"memberId" Key -> MemberId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memberId]
      XGrpRelayInv GroupRelayInvitation
groupRelayInv -> [Pair] -> Object
o [Key
"groupRelayInvitation" Key -> GroupRelayInvitation -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupRelayInvitation
groupRelayInv]
      XGrpRelayAcpt ShortLinkContact
relayLink -> [Pair] -> Object
o [Key
"relayLink" Key -> ShortLinkContact -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ShortLinkContact
relayLink]
      XGrpRelayTest ByteString
challenge Maybe ByteString
sig_ -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$
        (Key
"signature" Key -> Maybe B64UrlByteString -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? (ByteString -> B64UrlByteString
B64UrlByteString (ByteString -> B64UrlByteString)
-> Maybe ByteString -> Maybe B64UrlByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
sig_))
        [Key
"challenge" Key -> B64UrlByteString -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> B64UrlByteString
B64UrlByteString ByteString
challenge]
      XGrpMemNew MemberInfo
memInfo Maybe MsgScope
scope -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe MsgScope
scope) [Key
"memberInfo" Key -> MemberInfo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberInfo
memInfo]
      XGrpMemIntro MemberInfo
memInfo Maybe MemberRestrictions
memRestrictions -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"memberRestrictions" Key -> Maybe MemberRestrictions -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe MemberRestrictions
memRestrictions) [Key
"memberInfo" Key -> MemberInfo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberInfo
memInfo]
      XGrpMemInv MemberId
memId IntroInvitation
memIntro -> [Pair] -> Object
o [Key
"memberId" Key -> MemberId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId, Key
"memberIntro" Key -> IntroInvitation -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IntroInvitation
memIntro]
      XGrpMemFwd MemberInfo
memInfo IntroInvitation
memIntro -> [Pair] -> Object
o [Key
"memberInfo" Key -> MemberInfo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberInfo
memInfo, Key
"memberIntro" Key -> IntroInvitation -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IntroInvitation
memIntro]
      XGrpMemInfo MemberId
memId Profile
profile -> [Pair] -> Object
o [Key
"memberId" Key -> MemberId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId, Key
"profile" Key -> Profile -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Profile
profile]
      XGrpMemRole MemberId
memId GroupMemberRole
role -> [Pair] -> Object
o [Key
"memberId" Key -> MemberId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId, Key
"role" Key -> GroupMemberRole -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupMemberRole
role]
      XGrpMemRestrict MemberId
memId MemberRestrictions
memRestrictions -> [Pair] -> Object
o [Key
"memberId" Key -> MemberId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId, Key
"memberRestrictions" Key -> MemberRestrictions -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberRestrictions
memRestrictions]
      XGrpMemCon MemberId
memId -> [Pair] -> Object
o [Key
"memberId" Key -> MemberId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId]
      XGrpMemConAll MemberId
memId -> [Pair] -> Object
o [Key
"memberId" Key -> MemberId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memId]
      XGrpMemDel MemberId
memId Bool
messages -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"messages" Key -> Maybe Bool -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? 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 -> Pair
forall v. ToJSON v => Key -> v -> Pair
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 -> [Pair] -> Object
o [Key
"groupProfile" Key -> GroupProfile -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupProfile
p]
      XGrpPrefs GroupPreferences
p -> [Pair] -> Object
o [Key
"groupPreferences" Key -> GroupPreferences -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GroupPreferences
p]
      XGrpDirectInv ConnReqInvitation
connReq Maybe MsgContent
content Maybe MsgScope
scope -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"content" Key -> Maybe MsgContent -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe MsgContent
content) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$ (Key
"scope" Key -> Maybe MsgScope -> [Pair] -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair] -> [Pair]
.=? Maybe MsgScope
scope) [Key
"connReq" Key -> ConnReqInvitation -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConnReqInvitation
connReq]
      XGrpMsgForward GrpMsgForward {FwdSender
$sel:fwdSender:GrpMsgForward :: GrpMsgForward -> FwdSender
fwdSender :: FwdSender
fwdSender, UTCTime
$sel:fwdBrokerTs:GrpMsgForward :: GrpMsgForward -> UTCTime
fwdBrokerTs :: UTCTime
fwdBrokerTs} ChatMessage 'Json
msg -> [Pair] -> Object
o ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ FwdSender -> [Pair] -> [Pair]
encodeFwdSender FwdSender
fwdSender [Key
"msg" Key -> ChatMessage 'Json -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ChatMessage 'Json
msg, Key
"msgTs" Key -> UTCTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
fwdBrokerTs]
        where
          encodeFwdSender :: FwdSender -> [Pair] -> [Pair]
encodeFwdSender = \case
            FwdMember MemberId
memberId MemberName
memberName -> ([Key
"memberId" Key -> MemberId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberId
memberId, Key
"memberName" Key -> MemberName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MemberName
memberName] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++)
            FwdSender
FwdChannel -> [Pair] -> [Pair]
forall a. a -> a
id
      XInfoProbe Probe
probe -> [Pair] -> Object
o [Key
"probe" Key -> Probe -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Probe
probe]
      XInfoProbeCheck ProbeHash
probeHash -> [Pair] -> Object
o [Key
"probeHash" Key -> ProbeHash -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ProbeHash
probeHash]
      XInfoProbeOk Probe
probe -> [Pair] -> Object
o [Key
"probe" Key -> Probe -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Probe
probe]
      XCallInv CallId
callId CallInvitation
inv -> [Pair] -> Object
o [Key
"callId" Key -> CallId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallId
callId, Key
"invitation" Key -> CallInvitation -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallInvitation
inv]
      XCallOffer CallId
callId CallOffer
offer -> [Pair] -> Object
o [Key
"callId" Key -> CallId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallId
callId, Key
"offer" Key -> CallOffer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallOffer
offer]
      XCallAnswer CallId
callId CallAnswer
answer -> [Pair] -> Object
o [Key
"callId" Key -> CallId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallId
callId, Key
"answer" Key -> CallAnswer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallAnswer
answer]
      XCallExtra CallId
callId CallExtraInfo
extra -> [Pair] -> Object
o [Key
"callId" Key -> CallId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallId
callId, Key
"extra" Key -> CallExtraInfo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallExtraInfo
extra]
      XCallEnd CallId
callId -> [Pair] -> Object
o [Key
"callId" Key -> CallId -> Pair
forall v. ToJSON v => Key -> v -> Pair
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
$sel:chatMsgEvent:ChatMessage :: 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 -> ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ChatMessage e -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode ChatMessage e
chatMsg

verifiedChatMsg :: VerifiedMsg e -> ChatMessage e
verifiedChatMsg :: forall (e :: MsgEncoding). VerifiedMsg e -> ChatMessage e
verifiedChatMsg = \case
  VMUnsigned ChatMessage e
cm -> ChatMessage e
cm
  VMSigned MsgSigStatus
_ SignedMsg
_ ChatMessage e
cm -> ChatMessage e
cm

-- | Canonical bytes to store/forward, with optional signature.
-- Signed: original bytes (re-encoding would invalidate signature).
-- Unsigned: re-encoded from parsed ChatMessage (sanitizes stored content).
verifiedMsgParts :: MsgEncodingI e => VerifiedMsg e -> (Maybe MsgSigStatus, Maybe SignedMsg, ByteString)
verifiedMsgParts :: forall (e :: MsgEncoding).
MsgEncodingI e =>
VerifiedMsg e -> (Maybe MsgSigStatus, Maybe SignedMsg, ByteString)
verifiedMsgParts = \case
  VMUnsigned ChatMessage e
chatMsg -> (Maybe MsgSigStatus
forall a. Maybe a
Nothing, Maybe SignedMsg
forall a. Maybe a
Nothing, ChatMessage e -> ByteString
forall (e :: MsgEncoding).
MsgEncodingI e =>
ChatMessage e -> ByteString
chatMsgToBody ChatMessage e
chatMsg)
  VMSigned MsgSigStatus
s sm :: SignedMsg
sm@SignedMsg {ByteString
$sel:signedBody:SignedMsg :: SignedMsg -> ByteString
signedBody :: ByteString
signedBody} ChatMessage e
_ -> (MsgSigStatus -> Maybe MsgSigStatus
forall a. a -> Maybe a
Just MsgSigStatus
s, SignedMsg -> Maybe SignedMsg
forall a. a -> Maybe a
Just SignedMsg
sm, ByteString
signedBody)


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 PublicGroupData = PublicGroupData
  { PublicGroupData -> ContactId
publicMemberCount :: Int64
  }
  deriving (PublicGroupData -> PublicGroupData -> Bool
(PublicGroupData -> PublicGroupData -> Bool)
-> (PublicGroupData -> PublicGroupData -> Bool)
-> Eq PublicGroupData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicGroupData -> PublicGroupData -> Bool
== :: PublicGroupData -> PublicGroupData -> Bool
$c/= :: PublicGroupData -> PublicGroupData -> Bool
/= :: PublicGroupData -> PublicGroupData -> Bool
Eq, Int -> PublicGroupData -> ShowS
[PublicGroupData] -> ShowS
PublicGroupData -> String
(Int -> PublicGroupData -> ShowS)
-> (PublicGroupData -> String)
-> ([PublicGroupData] -> ShowS)
-> Show PublicGroupData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicGroupData -> ShowS
showsPrec :: Int -> PublicGroupData -> ShowS
$cshow :: PublicGroupData -> String
show :: PublicGroupData -> String
$cshowList :: [PublicGroupData] -> ShowS
showList :: [PublicGroupData] -> ShowS
Show)

data GroupShortLinkData = GroupShortLinkData
  { GroupShortLinkData -> GroupProfile
groupProfile :: GroupProfile,
    GroupShortLinkData -> Maybe PublicGroupData
publicGroupData :: Maybe PublicGroupData
  }
  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 ''PublicGroupData)

$(JQ.deriveJSON defaultJSON ''GroupShortLinkData)

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

$(JQ.deriveJSON defaultJSON ''RelayShortLinkData)

data RelayProfile = RelayProfile
  { RelayProfile -> MemberName
displayName :: ContactName,
    RelayProfile -> MemberName
fullName :: Text,
    RelayProfile -> Maybe MemberName
shortDescr :: Maybe Text,
    RelayProfile -> Maybe ImageData
image :: Maybe ImageData
  }
  deriving (RelayProfile -> RelayProfile -> Bool
(RelayProfile -> RelayProfile -> Bool)
-> (RelayProfile -> RelayProfile -> Bool) -> Eq RelayProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelayProfile -> RelayProfile -> Bool
== :: RelayProfile -> RelayProfile -> Bool
$c/= :: RelayProfile -> RelayProfile -> Bool
/= :: RelayProfile -> RelayProfile -> Bool
Eq, Int -> RelayProfile -> ShowS
[RelayProfile] -> ShowS
RelayProfile -> String
(Int -> RelayProfile -> ShowS)
-> (RelayProfile -> String)
-> ([RelayProfile] -> ShowS)
-> Show RelayProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelayProfile -> ShowS
showsPrec :: Int -> RelayProfile -> ShowS
$cshow :: RelayProfile -> String
show :: RelayProfile -> String
$cshowList :: [RelayProfile] -> ShowS
showList :: [RelayProfile] -> ShowS
Show)

$(JQ.deriveJSON defaultJSON ''RelayProfile)

toRelayProfile :: (ContactName, Text, Maybe Text, Maybe ImageData) -> RelayProfile
toRelayProfile :: (MemberName, MemberName, Maybe MemberName, Maybe ImageData)
-> RelayProfile
toRelayProfile (MemberName
displayName, MemberName
fullName, Maybe MemberName
shortDescr, Maybe ImageData
image) = RelayProfile {MemberName
$sel:displayName:RelayProfile :: MemberName
displayName :: MemberName
displayName, MemberName
$sel:fullName:RelayProfile :: MemberName
fullName :: MemberName
fullName, Maybe MemberName
$sel:shortDescr:RelayProfile :: Maybe MemberName
shortDescr :: Maybe MemberName
shortDescr, Maybe ImageData
$sel:image:RelayProfile :: Maybe ImageData
image :: Maybe ImageData
image}

mkRelayProfile :: ContactName -> Maybe ImageData -> RelayProfile
mkRelayProfile :: MemberName -> Maybe ImageData -> RelayProfile
mkRelayProfile MemberName
displayName Maybe ImageData
image = RelayProfile {MemberName
$sel:displayName:RelayProfile :: MemberName
displayName :: MemberName
displayName, $sel:fullName:RelayProfile :: MemberName
fullName = MemberName
"", $sel:shortDescr:RelayProfile :: Maybe MemberName
shortDescr = Maybe MemberName
forall a. Maybe a
Nothing, Maybe ImageData
$sel:image:RelayProfile :: Maybe ImageData
image :: Maybe ImageData
image}

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

$(JQ.deriveJSON defaultJSON ''RelayAddressLinkData)