{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
{-# OPTIONS_GHC -fno-warn-operator-whitespace #-}

module Simplex.Chat.Messages where

import Control.Applicative ((<|>))
import Control.Monad ((>=>))
import Data.Aeson (FromJSON, ToJSON, (.:))
import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import qualified Data.Aeson.TH as JQ
import qualified Data.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char (isSpace)
import Data.Int (Int64)
import Data.Kind (Constraint)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, nominalDay)
import Data.Type.Equality
import Data.Typeable (Typeable)
import GHC.TypeLits (ErrorMessage (ShowType, type (:<>:)), TypeError)
import qualified GHC.TypeLits as Type
import Simplex.Chat.Markdown
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Options.DB (FromField (..), ToField (..))
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptStatus (..))
import Simplex.Messaging.Agent.Store.DB (fromTextField_)
import Simplex.Messaging.Crypto.File (CryptoFile (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, sumTypeJSON)
import Simplex.Messaging.Protocol (BlockingInfo, MsgBody)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))

data ChatType = CTDirect | CTGroup | CTLocal | CTContactRequest | CTContactConnection
  deriving (ChatType -> ChatType -> Bool
(ChatType -> ChatType -> Bool)
-> (ChatType -> ChatType -> Bool) -> Eq ChatType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatType -> ChatType -> Bool
== :: ChatType -> ChatType -> Bool
$c/= :: ChatType -> ChatType -> Bool
/= :: ChatType -> ChatType -> Bool
Eq, Int -> ChatType -> ShowS
[ChatType] -> ShowS
ChatType -> String
(Int -> ChatType -> ShowS)
-> (ChatType -> String) -> ([ChatType] -> ShowS) -> Show ChatType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatType -> ShowS
showsPrec :: Int -> ChatType -> ShowS
$cshow :: ChatType -> String
show :: ChatType -> String
$cshowList :: [ChatType] -> ShowS
showList :: [ChatType] -> ShowS
Show, Eq ChatType
Eq ChatType =>
(ChatType -> ChatType -> Ordering)
-> (ChatType -> ChatType -> Bool)
-> (ChatType -> ChatType -> Bool)
-> (ChatType -> ChatType -> Bool)
-> (ChatType -> ChatType -> Bool)
-> (ChatType -> ChatType -> ChatType)
-> (ChatType -> ChatType -> ChatType)
-> Ord ChatType
ChatType -> ChatType -> Bool
ChatType -> ChatType -> Ordering
ChatType -> ChatType -> ChatType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatType -> ChatType -> Ordering
compare :: ChatType -> ChatType -> Ordering
$c< :: ChatType -> ChatType -> Bool
< :: ChatType -> ChatType -> Bool
$c<= :: ChatType -> ChatType -> Bool
<= :: ChatType -> ChatType -> Bool
$c> :: ChatType -> ChatType -> Bool
> :: ChatType -> ChatType -> Bool
$c>= :: ChatType -> ChatType -> Bool
>= :: ChatType -> ChatType -> Bool
$cmax :: ChatType -> ChatType -> ChatType
max :: ChatType -> ChatType -> ChatType
$cmin :: ChatType -> ChatType -> ChatType
min :: ChatType -> ChatType -> ChatType
Ord)

$(JQ.deriveJSON (enumJSON $ dropPrefix "CT") ''ChatType)

data SChatType (c :: ChatType) where
  SCTDirect :: SChatType 'CTDirect
  SCTGroup :: SChatType 'CTGroup
  SCTLocal :: SChatType 'CTLocal
  SCTContactRequest :: SChatType 'CTContactRequest
  SCTContactConnection :: SChatType 'CTContactConnection

deriving instance Show (SChatType c)

instance TestEquality SChatType where
  testEquality :: forall (a :: ChatType) (b :: ChatType).
SChatType a -> SChatType b -> Maybe (a :~: b)
testEquality SChatType a
SCTDirect SChatType b
SCTDirect = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SChatType a
SCTGroup SChatType b
SCTGroup = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SChatType a
SCTLocal SChatType b
SCTLocal = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SChatType a
SCTContactRequest SChatType b
SCTContactRequest = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SChatType a
SCTContactConnection SChatType b
SCTContactConnection = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SChatType a
_ SChatType b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

data AChatType = forall c. ChatTypeI c => ACT (SChatType c)

class ChatTypeI (c :: ChatType) where
  chatTypeI :: SChatType c

instance ChatTypeI 'CTDirect where chatTypeI :: SChatType 'CTDirect
chatTypeI = SChatType 'CTDirect
SCTDirect

instance ChatTypeI 'CTGroup where chatTypeI :: SChatType 'CTGroup
chatTypeI = SChatType 'CTGroup
SCTGroup

instance ChatTypeI 'CTLocal where chatTypeI :: SChatType 'CTLocal
chatTypeI = SChatType 'CTLocal
SCTLocal

instance ChatTypeI 'CTContactRequest where chatTypeI :: SChatType 'CTContactRequest
chatTypeI = SChatType 'CTContactRequest
SCTContactRequest

instance ChatTypeI 'CTContactConnection where chatTypeI :: SChatType 'CTContactConnection
chatTypeI = SChatType 'CTContactConnection
SCTContactConnection

toChatType :: SChatType c -> ChatType
toChatType :: forall (c :: ChatType). SChatType c -> ChatType
toChatType = \case
  SChatType c
SCTDirect -> ChatType
CTDirect
  SChatType c
SCTGroup -> ChatType
CTGroup
  SChatType c
SCTLocal -> ChatType
CTLocal
  SChatType c
SCTContactRequest -> ChatType
CTContactRequest
  SChatType c
SCTContactConnection -> ChatType
CTContactConnection

aChatType :: ChatType -> AChatType
aChatType :: ChatType -> AChatType
aChatType = \case
  ChatType
CTDirect -> SChatType 'CTDirect -> AChatType
forall (c :: ChatType). ChatTypeI c => SChatType c -> AChatType
ACT SChatType 'CTDirect
SCTDirect
  ChatType
CTGroup -> SChatType 'CTGroup -> AChatType
forall (c :: ChatType). ChatTypeI c => SChatType c -> AChatType
ACT SChatType 'CTGroup
SCTGroup
  ChatType
CTLocal -> SChatType 'CTLocal -> AChatType
forall (c :: ChatType). ChatTypeI c => SChatType c -> AChatType
ACT SChatType 'CTLocal
SCTLocal
  ChatType
CTContactRequest -> SChatType 'CTContactRequest -> AChatType
forall (c :: ChatType). ChatTypeI c => SChatType c -> AChatType
ACT SChatType 'CTContactRequest
SCTContactRequest
  ChatType
CTContactConnection -> SChatType 'CTContactConnection -> AChatType
forall (c :: ChatType). ChatTypeI c => SChatType c -> AChatType
ACT SChatType 'CTContactConnection
SCTContactConnection

checkChatType :: forall t c c'. (ChatTypeI c, ChatTypeI c') => t c' -> Either String (t c)
checkChatType :: forall (t :: ChatType -> *) (c :: ChatType) (c' :: ChatType).
(ChatTypeI c, ChatTypeI c') =>
t c' -> Either String (t c)
checkChatType t c'
x = case SChatType c -> SChatType c' -> Maybe (c :~: c')
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: ChatType) (b :: ChatType).
SChatType a -> SChatType b -> Maybe (a :~: b)
testEquality (forall (c :: ChatType). ChatTypeI c => SChatType c
chatTypeI @c) (forall (c :: ChatType). ChatTypeI c => SChatType c
chatTypeI @c') of
  Just c :~: c'
Refl -> t c -> Either String (t c)
forall a b. b -> Either a b
Right t c
t c'
x
  Maybe (c :~: c')
Nothing -> String -> Either String (t c)
forall a b. a -> Either a b
Left String
"bad chat type"

data GroupChatScope
  = GCSMemberSupport {GroupChatScope -> Maybe Int64
groupMemberId_ :: Maybe GroupMemberId} -- Nothing means own conversation with support
  deriving (GroupChatScope -> GroupChatScope -> Bool
(GroupChatScope -> GroupChatScope -> Bool)
-> (GroupChatScope -> GroupChatScope -> Bool) -> Eq GroupChatScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupChatScope -> GroupChatScope -> Bool
== :: GroupChatScope -> GroupChatScope -> Bool
$c/= :: GroupChatScope -> GroupChatScope -> Bool
/= :: GroupChatScope -> GroupChatScope -> Bool
Eq, Int -> GroupChatScope -> ShowS
[GroupChatScope] -> ShowS
GroupChatScope -> String
(Int -> GroupChatScope -> ShowS)
-> (GroupChatScope -> String)
-> ([GroupChatScope] -> ShowS)
-> Show GroupChatScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupChatScope -> ShowS
showsPrec :: Int -> GroupChatScope -> ShowS
$cshow :: GroupChatScope -> String
show :: GroupChatScope -> String
$cshowList :: [GroupChatScope] -> ShowS
showList :: [GroupChatScope] -> ShowS
Show, Eq GroupChatScope
Eq GroupChatScope =>
(GroupChatScope -> GroupChatScope -> Ordering)
-> (GroupChatScope -> GroupChatScope -> Bool)
-> (GroupChatScope -> GroupChatScope -> Bool)
-> (GroupChatScope -> GroupChatScope -> Bool)
-> (GroupChatScope -> GroupChatScope -> Bool)
-> (GroupChatScope -> GroupChatScope -> GroupChatScope)
-> (GroupChatScope -> GroupChatScope -> GroupChatScope)
-> Ord GroupChatScope
GroupChatScope -> GroupChatScope -> Bool
GroupChatScope -> GroupChatScope -> Ordering
GroupChatScope -> GroupChatScope -> GroupChatScope
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GroupChatScope -> GroupChatScope -> Ordering
compare :: GroupChatScope -> GroupChatScope -> Ordering
$c< :: GroupChatScope -> GroupChatScope -> Bool
< :: GroupChatScope -> GroupChatScope -> Bool
$c<= :: GroupChatScope -> GroupChatScope -> Bool
<= :: GroupChatScope -> GroupChatScope -> Bool
$c> :: GroupChatScope -> GroupChatScope -> Bool
> :: GroupChatScope -> GroupChatScope -> Bool
$c>= :: GroupChatScope -> GroupChatScope -> Bool
>= :: GroupChatScope -> GroupChatScope -> Bool
$cmax :: GroupChatScope -> GroupChatScope -> GroupChatScope
max :: GroupChatScope -> GroupChatScope -> GroupChatScope
$cmin :: GroupChatScope -> GroupChatScope -> GroupChatScope
min :: GroupChatScope -> GroupChatScope -> GroupChatScope
Ord)

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

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

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

instance TextEncoding GroupChatScopeTag where
  textDecode :: Text -> Maybe GroupChatScopeTag
textDecode = \case
    Text
"member_support" -> GroupChatScopeTag -> Maybe GroupChatScopeTag
forall a. a -> Maybe a
Just GroupChatScopeTag
GCSTMemberSupport_
    Text
_ -> Maybe GroupChatScopeTag
forall a. Maybe a
Nothing
  textEncode :: GroupChatScopeTag -> Text
textEncode = \case
    GroupChatScopeTag
GCSTMemberSupport_ -> Text
"member_support"

data ChatName = ChatName {ChatName -> ChatType
chatType :: ChatType, ChatName -> Text
chatName :: Text}
  deriving (Int -> ChatName -> ShowS
[ChatName] -> ShowS
ChatName -> String
(Int -> ChatName -> ShowS)
-> (ChatName -> String) -> ([ChatName] -> ShowS) -> Show ChatName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatName -> ShowS
showsPrec :: Int -> ChatName -> ShowS
$cshow :: ChatName -> String
show :: ChatName -> String
$cshowList :: [ChatName] -> ShowS
showList :: [ChatName] -> ShowS
Show)

data SendName
  = SNDirect ContactName
  | SNGroup GroupName (Maybe GroupScopeName)
  | SNLocal
  deriving (Int -> SendName -> ShowS
[SendName] -> ShowS
SendName -> String
(Int -> SendName -> ShowS)
-> (SendName -> String) -> ([SendName] -> ShowS) -> Show SendName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SendName -> ShowS
showsPrec :: Int -> SendName -> ShowS
$cshow :: SendName -> String
show :: SendName -> String
$cshowList :: [SendName] -> ShowS
showList :: [SendName] -> ShowS
Show)

data GroupScopeName
  = GSNMemberSupport (Maybe ContactName)
  deriving (Int -> GroupScopeName -> ShowS
[GroupScopeName] -> ShowS
GroupScopeName -> String
(Int -> GroupScopeName -> ShowS)
-> (GroupScopeName -> String)
-> ([GroupScopeName] -> ShowS)
-> Show GroupScopeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupScopeName -> ShowS
showsPrec :: Int -> GroupScopeName -> ShowS
$cshow :: GroupScopeName -> String
show :: GroupScopeName -> String
$cshowList :: [GroupScopeName] -> ShowS
showList :: [GroupScopeName] -> ShowS
Show)

chatTypeStr :: ChatType -> Text
chatTypeStr :: ChatType -> Text
chatTypeStr = \case
  ChatType
CTDirect -> Text
"@"
  ChatType
CTGroup -> Text
"#"
  ChatType
CTLocal -> Text
"*"
  ChatType
CTContactRequest -> Text
"<@"
  ChatType
CTContactConnection -> Text
":"

chatNameStr :: ChatName -> String
chatNameStr :: ChatName -> String
chatNameStr (ChatName ChatType
cType Text
name) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ChatType -> Text
chatTypeStr ChatType
cType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpace Text
name then Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'" else Text
name

data ChatRef = ChatRef {ChatRef -> ChatType
chatType :: ChatType, ChatRef -> Int64
chatId :: Int64, ChatRef -> Maybe GroupChatScope
chatScope :: Maybe GroupChatScope}
  deriving (ChatRef -> ChatRef -> Bool
(ChatRef -> ChatRef -> Bool)
-> (ChatRef -> ChatRef -> Bool) -> Eq ChatRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatRef -> ChatRef -> Bool
== :: ChatRef -> ChatRef -> Bool
$c/= :: ChatRef -> ChatRef -> Bool
/= :: ChatRef -> ChatRef -> Bool
Eq, Int -> ChatRef -> ShowS
[ChatRef] -> ShowS
ChatRef -> String
(Int -> ChatRef -> ShowS)
-> (ChatRef -> String) -> ([ChatRef] -> ShowS) -> Show ChatRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatRef -> ShowS
showsPrec :: Int -> ChatRef -> ShowS
$cshow :: ChatRef -> String
show :: ChatRef -> String
$cshowList :: [ChatRef] -> ShowS
showList :: [ChatRef] -> ShowS
Show, Eq ChatRef
Eq ChatRef =>
(ChatRef -> ChatRef -> Ordering)
-> (ChatRef -> ChatRef -> Bool)
-> (ChatRef -> ChatRef -> Bool)
-> (ChatRef -> ChatRef -> Bool)
-> (ChatRef -> ChatRef -> Bool)
-> (ChatRef -> ChatRef -> ChatRef)
-> (ChatRef -> ChatRef -> ChatRef)
-> Ord ChatRef
ChatRef -> ChatRef -> Bool
ChatRef -> ChatRef -> Ordering
ChatRef -> ChatRef -> ChatRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChatRef -> ChatRef -> Ordering
compare :: ChatRef -> ChatRef -> Ordering
$c< :: ChatRef -> ChatRef -> Bool
< :: ChatRef -> ChatRef -> Bool
$c<= :: ChatRef -> ChatRef -> Bool
<= :: ChatRef -> ChatRef -> Bool
$c> :: ChatRef -> ChatRef -> Bool
> :: ChatRef -> ChatRef -> Bool
$c>= :: ChatRef -> ChatRef -> Bool
>= :: ChatRef -> ChatRef -> Bool
$cmax :: ChatRef -> ChatRef -> ChatRef
max :: ChatRef -> ChatRef -> ChatRef
$cmin :: ChatRef -> ChatRef -> ChatRef
min :: ChatRef -> ChatRef -> ChatRef
Ord)

data ChatInfo (c :: ChatType) where
  DirectChat :: Contact -> ChatInfo 'CTDirect
  GroupChat :: GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
  LocalChat :: NoteFolder -> ChatInfo 'CTLocal
  ContactRequest :: UserContactRequest -> ChatInfo 'CTContactRequest
  ContactConnection :: PendingContactConnection -> ChatInfo 'CTContactConnection
  CInfoInvalidJSON :: SChatType c -> J.Object -> ChatInfo c -- this constructor is needed to catch JSON errors for Remote connection parsing

deriving instance Show (ChatInfo c)

data GroupChatScopeInfo
  = GCSIMemberSupport {GroupChatScopeInfo -> Maybe GroupMember
groupMember_ :: Maybe GroupMember}
  deriving (Int -> GroupChatScopeInfo -> ShowS
[GroupChatScopeInfo] -> ShowS
GroupChatScopeInfo -> String
(Int -> GroupChatScopeInfo -> ShowS)
-> (GroupChatScopeInfo -> String)
-> ([GroupChatScopeInfo] -> ShowS)
-> Show GroupChatScopeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupChatScopeInfo -> ShowS
showsPrec :: Int -> GroupChatScopeInfo -> ShowS
$cshow :: GroupChatScopeInfo -> String
show :: GroupChatScopeInfo -> String
$cshowList :: [GroupChatScopeInfo] -> ShowS
showList :: [GroupChatScopeInfo] -> ShowS
Show)

toChatScope :: GroupChatScopeInfo -> GroupChatScope
toChatScope :: GroupChatScopeInfo -> GroupChatScope
toChatScope = \case
  GCSIMemberSupport {Maybe GroupMember
groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ :: Maybe GroupMember
groupMember_} -> Maybe Int64 -> GroupChatScope
GCSMemberSupport (Maybe Int64 -> GroupChatScope) -> Maybe Int64 -> GroupChatScope
forall a b. (a -> b) -> a -> b
$ GroupMember -> Int64
groupMemberId' (GroupMember -> Int64) -> Maybe GroupMember -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupMember
groupMember_

toMsgScope :: GroupInfo -> GroupChatScopeInfo -> MsgScope
toMsgScope :: GroupInfo -> GroupChatScopeInfo -> MsgScope
toMsgScope GroupInfo {GroupMember
membership :: GroupMember
membership :: GroupInfo -> GroupMember
membership} = \case
  GCSIMemberSupport {Maybe GroupMember
groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ :: Maybe GroupMember
groupMember_} -> MemberId -> MsgScope
MSMember (MemberId -> MsgScope) -> MemberId -> MsgScope
forall a b. (a -> b) -> a -> b
$ GroupMember -> MemberId
memberId' (GroupMember -> MemberId) -> GroupMember -> MemberId
forall a b. (a -> b) -> a -> b
$ GroupMember -> Maybe GroupMember -> GroupMember
forall a. a -> Maybe a -> a
fromMaybe GroupMember
membership Maybe GroupMember
groupMember_

chatInfoToRef :: ChatInfo c -> Maybe ChatRef
chatInfoToRef :: forall (c :: ChatType). ChatInfo c -> Maybe ChatRef
chatInfoToRef = \case
  DirectChat Contact {Int64
contactId :: Int64
contactId :: Contact -> Int64
contactId} -> ChatRef -> Maybe ChatRef
forall a. a -> Maybe a
Just (ChatRef -> Maybe ChatRef) -> ChatRef -> Maybe ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect Int64
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing
  GroupChat GroupInfo {Int64
groupId :: Int64
groupId :: GroupInfo -> Int64
groupId} Maybe GroupChatScopeInfo
scopeInfo -> ChatRef -> Maybe ChatRef
forall a. a -> Maybe a
Just (ChatRef -> Maybe ChatRef) -> ChatRef -> Maybe ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup Int64
groupId (GroupChatScopeInfo -> GroupChatScope
toChatScope (GroupChatScopeInfo -> GroupChatScope)
-> Maybe GroupChatScopeInfo -> Maybe GroupChatScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupChatScopeInfo
scopeInfo)
  LocalChat NoteFolder {Int64
noteFolderId :: Int64
noteFolderId :: NoteFolder -> Int64
noteFolderId} -> ChatRef -> Maybe ChatRef
forall a. a -> Maybe a
Just (ChatRef -> Maybe ChatRef) -> ChatRef -> Maybe ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTLocal Int64
noteFolderId Maybe GroupChatScope
forall a. Maybe a
Nothing
  ContactRequest UserContactRequest {Int64
contactRequestId :: Int64
contactRequestId :: UserContactRequest -> Int64
contactRequestId} -> ChatRef -> Maybe ChatRef
forall a. a -> Maybe a
Just (ChatRef -> Maybe ChatRef) -> ChatRef -> Maybe ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTContactRequest Int64
contactRequestId Maybe GroupChatScope
forall a. Maybe a
Nothing
  ContactConnection PendingContactConnection {Int64
pccConnId :: Int64
pccConnId :: PendingContactConnection -> Int64
pccConnId} -> ChatRef -> Maybe ChatRef
forall a. a -> Maybe a
Just (ChatRef -> Maybe ChatRef) -> ChatRef -> Maybe ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTContactConnection Int64
pccConnId Maybe GroupChatScope
forall a. Maybe a
Nothing
  CInfoInvalidJSON {} -> Maybe ChatRef
forall a. Maybe a
Nothing

chatInfoMembership :: ChatInfo c -> Maybe GroupMember
chatInfoMembership :: forall (c :: ChatType). ChatInfo c -> Maybe GroupMember
chatInfoMembership = \case
  GroupChat GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} Maybe GroupChatScopeInfo
_scopeInfo -> GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
membership
  ChatInfo c
_ -> Maybe GroupMember
forall a. Maybe a
Nothing

data JSONChatInfo
  = JCInfoDirect {JSONChatInfo -> Contact
contact :: Contact}
  | JCInfoGroup {JSONChatInfo -> GroupInfo
groupInfo :: GroupInfo, JSONChatInfo -> Maybe GroupChatScopeInfo
groupChatScope :: Maybe GroupChatScopeInfo}
  | JCInfoLocal {JSONChatInfo -> NoteFolder
noteFolder :: NoteFolder}
  | JCInfoContactRequest {JSONChatInfo -> UserContactRequest
contactRequest :: UserContactRequest}
  | JCInfoContactConnection {JSONChatInfo -> PendingContactConnection
contactConnection :: PendingContactConnection}
  | JCInfoInvalidJSON {JSONChatInfo -> ChatType
chatType :: ChatType, JSONChatInfo -> Object
json :: J.Object}

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GCSI") ''GroupChatScopeInfo)

$(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "JCInfo") ''JSONChatInfo)

instance FromJSON JSONChatInfo where
  parseJSON :: Value -> Parser JSONChatInfo
parseJSON v :: Value
v@(J.Object Object
o) =
    $(JQ.mkParseJSON (sumTypeJSON $ dropPrefix "JCInfo") ''JSONChatInfo) Value
v
      Parser JSONChatInfo -> Parser JSONChatInfo -> Parser JSONChatInfo
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((ChatType -> Object -> JSONChatInfo
`JCInfoInvalidJSON` Object
o) (ChatType -> JSONChatInfo)
-> Parser ChatType -> Parser JSONChatInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ChatType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type") -- fallback for forward compatible remote parser
  parseJSON Value
invalid = String -> Value -> Parser JSONChatInfo
forall a. String -> Value -> Parser a
JT.typeMismatch String
"Object" Value
invalid

instance ChatTypeI c => FromJSON (ChatInfo c) where
  parseJSON :: Value -> Parser (ChatInfo c)
parseJSON Value
v = (\(AChatInfo SChatType c
_ ChatInfo c
c) -> ChatInfo c -> Either String (ChatInfo c)
forall (t :: ChatType -> *) (c :: ChatType) (c' :: ChatType).
(ChatTypeI c, ChatTypeI c') =>
t c' -> Either String (t c)
checkChatType ChatInfo c
c) (AChatInfo -> Either String (ChatInfo c))
-> Parser AChatInfo -> Parser (ChatInfo c)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Value -> Parser AChatInfo
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

instance ToJSON (ChatInfo c) where
  toJSON :: ChatInfo c -> Value
toJSON = JSONChatInfo -> Value
forall a. ToJSON a => a -> Value
J.toJSON (JSONChatInfo -> Value)
-> (ChatInfo c -> JSONChatInfo) -> ChatInfo c -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatInfo c -> JSONChatInfo
forall (c :: ChatType). ChatInfo c -> JSONChatInfo
jsonChatInfo
  toEncoding :: ChatInfo c -> Encoding
toEncoding = JSONChatInfo -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding (JSONChatInfo -> Encoding)
-> (ChatInfo c -> JSONChatInfo) -> ChatInfo c -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatInfo c -> JSONChatInfo
forall (c :: ChatType). ChatInfo c -> JSONChatInfo
jsonChatInfo

jsonChatInfo :: ChatInfo c -> JSONChatInfo
jsonChatInfo :: forall (c :: ChatType). ChatInfo c -> JSONChatInfo
jsonChatInfo = \case
  DirectChat Contact
c -> Contact -> JSONChatInfo
JCInfoDirect Contact
c
  GroupChat GroupInfo
g Maybe GroupChatScopeInfo
s -> GroupInfo -> Maybe GroupChatScopeInfo -> JSONChatInfo
JCInfoGroup GroupInfo
g Maybe GroupChatScopeInfo
s
  LocalChat NoteFolder
l -> NoteFolder -> JSONChatInfo
JCInfoLocal NoteFolder
l
  ContactRequest UserContactRequest
g -> UserContactRequest -> JSONChatInfo
JCInfoContactRequest UserContactRequest
g
  ContactConnection PendingContactConnection
c -> PendingContactConnection -> JSONChatInfo
JCInfoContactConnection PendingContactConnection
c
  CInfoInvalidJSON SChatType c
c Object
o -> ChatType -> Object -> JSONChatInfo
JCInfoInvalidJSON (SChatType c -> ChatType
forall (c :: ChatType). SChatType c -> ChatType
toChatType SChatType c
c) Object
o

data AChatInfo = forall c. ChatTypeI c => AChatInfo (SChatType c) (ChatInfo c)

deriving instance Show AChatInfo

jsonAChatInfo :: JSONChatInfo -> AChatInfo
jsonAChatInfo :: JSONChatInfo -> AChatInfo
jsonAChatInfo = \case
  JCInfoDirect Contact
c -> SChatType 'CTDirect -> ChatInfo 'CTDirect -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTDirect
SCTDirect (ChatInfo 'CTDirect -> AChatInfo)
-> ChatInfo 'CTDirect -> AChatInfo
forall a b. (a -> b) -> a -> b
$ Contact -> ChatInfo 'CTDirect
DirectChat Contact
c
  JCInfoGroup GroupInfo
g Maybe GroupChatScopeInfo
s -> SChatType 'CTGroup -> ChatInfo 'CTGroup -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTGroup
SCTGroup (ChatInfo 'CTGroup -> AChatInfo) -> ChatInfo 'CTGroup -> AChatInfo
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g Maybe GroupChatScopeInfo
s
  JCInfoLocal NoteFolder
l -> SChatType 'CTLocal -> ChatInfo 'CTLocal -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTLocal
SCTLocal (ChatInfo 'CTLocal -> AChatInfo) -> ChatInfo 'CTLocal -> AChatInfo
forall a b. (a -> b) -> a -> b
$ NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
l
  JCInfoContactRequest UserContactRequest
g -> SChatType 'CTContactRequest
-> ChatInfo 'CTContactRequest -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTContactRequest
SCTContactRequest (ChatInfo 'CTContactRequest -> AChatInfo)
-> ChatInfo 'CTContactRequest -> AChatInfo
forall a b. (a -> b) -> a -> b
$ UserContactRequest -> ChatInfo 'CTContactRequest
ContactRequest UserContactRequest
g
  JCInfoContactConnection PendingContactConnection
c -> SChatType 'CTContactConnection
-> ChatInfo 'CTContactConnection -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTContactConnection
SCTContactConnection (ChatInfo 'CTContactConnection -> AChatInfo)
-> ChatInfo 'CTContactConnection -> AChatInfo
forall a b. (a -> b) -> a -> b
$ PendingContactConnection -> ChatInfo 'CTContactConnection
ContactConnection PendingContactConnection
c
  JCInfoInvalidJSON ChatType
cType Object
o -> case ChatType -> AChatType
aChatType ChatType
cType of ACT SChatType c
c -> SChatType c -> ChatInfo c -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType c
c (ChatInfo c -> AChatInfo) -> ChatInfo c -> AChatInfo
forall a b. (a -> b) -> a -> b
$ SChatType c -> Object -> ChatInfo c
forall (c :: ChatType). SChatType c -> Object -> ChatInfo c
CInfoInvalidJSON SChatType c
c Object
o

instance FromJSON AChatInfo where
  parseJSON :: Value -> Parser AChatInfo
parseJSON Value
v = JSONChatInfo -> AChatInfo
jsonAChatInfo (JSONChatInfo -> AChatInfo)
-> Parser JSONChatInfo -> Parser AChatInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser JSONChatInfo
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

instance ToJSON AChatInfo where
  toJSON :: AChatInfo -> Value
toJSON (AChatInfo SChatType c
_ ChatInfo c
c) = ChatInfo c -> Value
forall a. ToJSON a => a -> Value
J.toJSON ChatInfo c
c
  toEncoding :: AChatInfo -> Encoding
toEncoding (AChatInfo SChatType c
_ ChatInfo c
c) = ChatInfo c -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding ChatInfo c
c

data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
  { forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIDirection c d
chatDir :: CIDirection c d,
    forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta :: CIMeta c d,
    forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content :: CIContent d,
    -- The `mentions` map prevents loading all members from UI.
    -- The key is a name used in the message text, used to look up CIMention.
    forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Map Text CIMention
mentions :: Map MemberName CIMention,
    forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe MarkdownList
formattedText :: Maybe MarkdownList,
    forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe (CIQuote c)
quotedItem :: Maybe (CIQuote c),
    forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> [CIReactionCount]
reactions :: [CIReactionCount],
    forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe (CIFile d)
file :: Maybe (CIFile d)
  }
  deriving (Int -> ChatItem c d -> ShowS
[ChatItem c d] -> ShowS
ChatItem c d -> String
(Int -> ChatItem c d -> ShowS)
-> (ChatItem c d -> String)
-> ([ChatItem c d] -> ShowS)
-> Show (ChatItem c d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: ChatType) (d :: MsgDirection).
Int -> ChatItem c d -> ShowS
forall (c :: ChatType) (d :: MsgDirection). [ChatItem c d] -> ShowS
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> String
$cshowsPrec :: forall (c :: ChatType) (d :: MsgDirection).
Int -> ChatItem c d -> ShowS
showsPrec :: Int -> ChatItem c d -> ShowS
$cshow :: forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> String
show :: ChatItem c d -> String
$cshowList :: forall (c :: ChatType) (d :: MsgDirection). [ChatItem c d] -> ShowS
showList :: [ChatItem c d] -> ShowS
Show)

data CIMention = CIMention
  { CIMention -> MemberId
memberId :: MemberId,
    -- member record can be created later than the mention is received
    CIMention -> Maybe CIMentionMember
memberRef :: Maybe CIMentionMember
  }
  deriving (CIMention -> CIMention -> Bool
(CIMention -> CIMention -> Bool)
-> (CIMention -> CIMention -> Bool) -> Eq CIMention
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CIMention -> CIMention -> Bool
== :: CIMention -> CIMention -> Bool
$c/= :: CIMention -> CIMention -> Bool
/= :: CIMention -> CIMention -> Bool
Eq, Int -> CIMention -> ShowS
[CIMention] -> ShowS
CIMention -> String
(Int -> CIMention -> ShowS)
-> (CIMention -> String)
-> ([CIMention] -> ShowS)
-> Show CIMention
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIMention -> ShowS
showsPrec :: Int -> CIMention -> ShowS
$cshow :: CIMention -> String
show :: CIMention -> String
$cshowList :: [CIMention] -> ShowS
showList :: [CIMention] -> ShowS
Show)

data CIMentionMember = CIMentionMember
  { CIMentionMember -> Int64
groupMemberId :: GroupMemberId,
    CIMentionMember -> Text
displayName :: Text, -- use `displayName` in copy/share actions
    CIMentionMember -> Maybe Text
localAlias :: Maybe Text, -- use `fromMaybe displayName localAlias` in chat view
    CIMentionMember -> GroupMemberRole
memberRole :: GroupMemberRole -- shown for admins/owners in the message
  }
  deriving (CIMentionMember -> CIMentionMember -> Bool
(CIMentionMember -> CIMentionMember -> Bool)
-> (CIMentionMember -> CIMentionMember -> Bool)
-> Eq CIMentionMember
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CIMentionMember -> CIMentionMember -> Bool
== :: CIMentionMember -> CIMentionMember -> Bool
$c/= :: CIMentionMember -> CIMentionMember -> Bool
/= :: CIMentionMember -> CIMentionMember -> Bool
Eq, Int -> CIMentionMember -> ShowS
[CIMentionMember] -> ShowS
CIMentionMember -> String
(Int -> CIMentionMember -> ShowS)
-> (CIMentionMember -> String)
-> ([CIMentionMember] -> ShowS)
-> Show CIMentionMember
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIMentionMember -> ShowS
showsPrec :: Int -> CIMentionMember -> ShowS
$cshow :: CIMentionMember -> String
show :: CIMentionMember -> String
$cshowList :: [CIMentionMember] -> ShowS
showList :: [CIMentionMember] -> ShowS
Show)

isACIUserMention :: AChatItem -> Bool
isACIUserMention :: AChatItem -> Bool
isACIUserMention (AChatItem SChatType c
_ SMsgDirection d
_ ChatInfo c
_ ChatItem c d
ci) = ChatItem c d -> Bool
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Bool
isUserMention ChatItem c d
ci

isUserMention :: ChatItem c d -> Bool
isUserMention :: forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Bool
isUserMention ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Bool
userMention :: Bool
userMention :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
userMention}} = Bool
userMention

data CIDirection (c :: ChatType) (d :: MsgDirection) where
  CIDirectSnd :: CIDirection 'CTDirect 'MDSnd
  CIDirectRcv :: CIDirection 'CTDirect 'MDRcv
  CIGroupSnd :: CIDirection 'CTGroup 'MDSnd
  CIGroupRcv :: GroupMember -> CIDirection 'CTGroup 'MDRcv
  CILocalSnd :: CIDirection 'CTLocal 'MDSnd
  CILocalRcv :: CIDirection 'CTLocal 'MDRcv

deriving instance Show (CIDirection c d)

data CCIDirection c = forall d. MsgDirectionI d => CCID (SMsgDirection d) (CIDirection c d)

data ACIDirection = forall c d. (ChatTypeI c, MsgDirectionI d) => ACID (SChatType c) (SMsgDirection d) (CIDirection c d)

data JSONCIDirection
  = JCIDirectSnd
  | JCIDirectRcv
  | JCIGroupSnd
  | JCIGroupRcv {JSONCIDirection -> GroupMember
groupMember :: GroupMember}
  | JCILocalSnd
  | JCILocalRcv
  deriving (Int -> JSONCIDirection -> ShowS
[JSONCIDirection] -> ShowS
JSONCIDirection -> String
(Int -> JSONCIDirection -> ShowS)
-> (JSONCIDirection -> String)
-> ([JSONCIDirection] -> ShowS)
-> Show JSONCIDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONCIDirection -> ShowS
showsPrec :: Int -> JSONCIDirection -> ShowS
$cshow :: JSONCIDirection -> String
show :: JSONCIDirection -> String
$cshowList :: [JSONCIDirection] -> ShowS
showList :: [JSONCIDirection] -> ShowS
Show)

jsonCIDirection :: CIDirection c d -> JSONCIDirection
jsonCIDirection :: forall (c :: ChatType) (d :: MsgDirection).
CIDirection c d -> JSONCIDirection
jsonCIDirection = \case
  CIDirection c d
CIDirectSnd -> JSONCIDirection
JCIDirectSnd
  CIDirection c d
CIDirectRcv -> JSONCIDirection
JCIDirectRcv
  CIDirection c d
CIGroupSnd -> JSONCIDirection
JCIGroupSnd
  CIGroupRcv GroupMember
m -> GroupMember -> JSONCIDirection
JCIGroupRcv GroupMember
m
  CIDirection c d
CILocalSnd -> JSONCIDirection
JCILocalSnd
  CIDirection c d
CILocalRcv -> JSONCIDirection
JCILocalRcv

jsonACIDirection :: JSONCIDirection -> ACIDirection
jsonACIDirection :: JSONCIDirection -> ACIDirection
jsonACIDirection = \case
  JSONCIDirection
JCIDirectSnd -> SChatType 'CTDirect
-> SMsgDirection 'MDSnd
-> CIDirection 'CTDirect 'MDSnd
-> ACIDirection
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c -> SMsgDirection d -> CIDirection c d -> ACIDirection
ACID SChatType 'CTDirect
SCTDirect SMsgDirection 'MDSnd
SMDSnd CIDirection 'CTDirect 'MDSnd
CIDirectSnd
  JSONCIDirection
JCIDirectRcv -> SChatType 'CTDirect
-> SMsgDirection 'MDRcv
-> CIDirection 'CTDirect 'MDRcv
-> ACIDirection
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c -> SMsgDirection d -> CIDirection c d -> ACIDirection
ACID SChatType 'CTDirect
SCTDirect SMsgDirection 'MDRcv
SMDRcv CIDirection 'CTDirect 'MDRcv
CIDirectRcv
  JSONCIDirection
JCIGroupSnd -> SChatType 'CTGroup
-> SMsgDirection 'MDSnd
-> CIDirection 'CTGroup 'MDSnd
-> ACIDirection
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c -> SMsgDirection d -> CIDirection c d -> ACIDirection
ACID SChatType 'CTGroup
SCTGroup SMsgDirection 'MDSnd
SMDSnd CIDirection 'CTGroup 'MDSnd
CIGroupSnd
  JCIGroupRcv GroupMember
m -> SChatType 'CTGroup
-> SMsgDirection 'MDRcv
-> CIDirection 'CTGroup 'MDRcv
-> ACIDirection
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c -> SMsgDirection d -> CIDirection c d -> ACIDirection
ACID SChatType 'CTGroup
SCTGroup SMsgDirection 'MDRcv
SMDRcv (CIDirection 'CTGroup 'MDRcv -> ACIDirection)
-> CIDirection 'CTGroup 'MDRcv -> ACIDirection
forall a b. (a -> b) -> a -> b
$ GroupMember -> CIDirection 'CTGroup 'MDRcv
CIGroupRcv GroupMember
m
  JSONCIDirection
JCILocalSnd -> SChatType 'CTLocal
-> SMsgDirection 'MDSnd
-> CIDirection 'CTLocal 'MDSnd
-> ACIDirection
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c -> SMsgDirection d -> CIDirection c d -> ACIDirection
ACID SChatType 'CTLocal
SCTLocal SMsgDirection 'MDSnd
SMDSnd CIDirection 'CTLocal 'MDSnd
CILocalSnd
  JSONCIDirection
JCILocalRcv -> SChatType 'CTLocal
-> SMsgDirection 'MDRcv
-> CIDirection 'CTLocal 'MDRcv
-> ACIDirection
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c -> SMsgDirection d -> CIDirection c d -> ACIDirection
ACID SChatType 'CTLocal
SCTLocal SMsgDirection 'MDRcv
SMDRcv CIDirection 'CTLocal 'MDRcv
CILocalRcv

data CIReactionCount = CIReactionCount {CIReactionCount -> MsgReaction
reaction :: MsgReaction, CIReactionCount -> Bool
userReacted :: Bool, CIReactionCount -> Int
totalReacted :: Int}
  deriving (Int -> CIReactionCount -> ShowS
[CIReactionCount] -> ShowS
CIReactionCount -> String
(Int -> CIReactionCount -> ShowS)
-> (CIReactionCount -> String)
-> ([CIReactionCount] -> ShowS)
-> Show CIReactionCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIReactionCount -> ShowS
showsPrec :: Int -> CIReactionCount -> ShowS
$cshow :: CIReactionCount -> String
show :: CIReactionCount -> String
$cshowList :: [CIReactionCount] -> ShowS
showList :: [CIReactionCount] -> ShowS
Show)

data CChatItem c = forall d. MsgDirectionI d => CChatItem (SMsgDirection d) (ChatItem c d)

deriving instance Show (CChatItem c)

cChatItemId :: CChatItem c -> ChatItemId
cChatItemId :: forall (c :: ChatType). CChatItem c -> Int64
cChatItemId (CChatItem SMsgDirection d
_ ChatItem c d
ci) = ChatItem c d -> Int64
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem c d
ci

chatItemId' :: ChatItem c d -> ChatItemId
chatItemId' :: forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Int64
itemId :: Int64
itemId :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Int64
itemId}} = Int64
itemId

chatItemTs :: CChatItem c -> UTCTime
chatItemTs :: forall (c :: ChatType). CChatItem c -> UTCTime
chatItemTs (CChatItem SMsgDirection d
_ ChatItem c d
ci) = ChatItem c d -> UTCTime
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> UTCTime
chatItemTs' ChatItem c d
ci

chatItemTs' :: ChatItem c d -> UTCTime
chatItemTs' :: forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> UTCTime
chatItemTs' ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {UTCTime
itemTs :: UTCTime
itemTs :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
itemTs}} = UTCTime
itemTs

ciCreatedAt :: CChatItem c -> UTCTime
ciCreatedAt :: forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt (CChatItem SMsgDirection d
_ ChatItem c d
ci) = ChatItem c d -> UTCTime
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> UTCTime
ciCreatedAt' ChatItem c d
ci

ciCreatedAt' :: ChatItem c d -> UTCTime
ciCreatedAt' :: forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> UTCTime
ciCreatedAt' ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {UTCTime
createdAt :: UTCTime
createdAt :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
createdAt}} = UTCTime
createdAt

chatItemTimed :: ChatItem c d -> Maybe CITimed
chatItemTimed :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe CITimed
chatItemTimed ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe CITimed
itemTimed :: Maybe CITimed
itemTimed :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe CITimed
itemTimed}} = Maybe CITimed
itemTimed

timedDeleteAt' :: CITimed -> Maybe UTCTime
timedDeleteAt' :: CITimed -> Maybe UTCTime
timedDeleteAt' CITimed {Maybe UTCTime
deleteAt :: Maybe UTCTime
deleteAt :: CITimed -> Maybe UTCTime
deleteAt} = Maybe UTCTime
deleteAt

chatItemMember :: GroupInfo -> ChatItem 'CTGroup d -> GroupMember
chatItemMember :: forall (d :: MsgDirection).
GroupInfo -> ChatItem 'CTGroup d -> GroupMember
chatItemMember GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} ChatItem {CIDirection 'CTGroup d
chatDir :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIDirection c d
chatDir :: CIDirection 'CTGroup d
chatDir} = case CIDirection 'CTGroup d
chatDir of
  CIDirection 'CTGroup d
CIGroupSnd -> GroupMember
membership
  CIGroupRcv GroupMember
m -> GroupMember
m

chatItemRcvFromMember :: ChatItem c d -> Maybe GroupMember
chatItemRcvFromMember :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe GroupMember
chatItemRcvFromMember ChatItem {CIDirection c d
chatDir :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIDirection c d
chatDir :: CIDirection c d
chatDir} = case CIDirection c d
chatDir of
  CIGroupRcv GroupMember
m -> GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
m
  CIDirection c d
_ -> Maybe GroupMember
forall a. Maybe a
Nothing

chatItemIsRcvNew :: ChatItem c d -> Bool
chatItemIsRcvNew :: forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Bool
chatItemIsRcvNew ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {CIStatus d
itemStatus :: CIStatus d
itemStatus :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> CIStatus d
itemStatus}} = case CIStatus d
itemStatus of
  CIStatus d
CISRcvNew -> Bool
True
  CIStatus d
_ -> Bool
False

ciReactionAllowed :: ChatItem c d -> Bool
ciReactionAllowed :: forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Bool
ciReactionAllowed ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {itemDeleted :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe (CIDeleted c)
itemDeleted = Just CIDeleted c
_}} = Bool
False
ciReactionAllowed ChatItem {CIContent d
content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content :: CIContent d
content} = Maybe MsgContent -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MsgContent -> Bool) -> Maybe MsgContent -> Bool
forall a b. (a -> b) -> a -> b
$ CIContent d -> Maybe MsgContent
forall (d :: MsgDirection). CIContent d -> Maybe MsgContent
ciMsgContent CIContent d
content

data ChatDirection (c :: ChatType) (d :: MsgDirection) where
  CDDirectSnd :: Contact -> ChatDirection 'CTDirect 'MDSnd
  CDDirectRcv :: Contact -> ChatDirection 'CTDirect 'MDRcv
  CDGroupSnd :: GroupInfo -> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
  CDGroupRcv :: GroupInfo -> Maybe GroupChatScopeInfo -> GroupMember -> ChatDirection 'CTGroup 'MDRcv
  CDLocalSnd :: NoteFolder -> ChatDirection 'CTLocal 'MDSnd
  CDLocalRcv :: NoteFolder -> ChatDirection 'CTLocal 'MDRcv

toCIDirection :: ChatDirection c d -> CIDirection c d
toCIDirection :: forall (c :: ChatType) (d :: MsgDirection).
ChatDirection c d -> CIDirection c d
toCIDirection = \case
  CDDirectSnd Contact
_ -> CIDirection c d
CIDirection 'CTDirect 'MDSnd
CIDirectSnd
  CDDirectRcv Contact
_ -> CIDirection c d
CIDirection 'CTDirect 'MDRcv
CIDirectRcv
  CDGroupSnd GroupInfo
_ Maybe GroupChatScopeInfo
_ -> CIDirection c d
CIDirection 'CTGroup 'MDSnd
CIGroupSnd
  CDGroupRcv GroupInfo
_ Maybe GroupChatScopeInfo
_ GroupMember
m -> GroupMember -> CIDirection 'CTGroup 'MDRcv
CIGroupRcv GroupMember
m
  CDLocalSnd NoteFolder
_ -> CIDirection c d
CIDirection 'CTLocal 'MDSnd
CILocalSnd
  CDLocalRcv NoteFolder
_ -> CIDirection c d
CIDirection 'CTLocal 'MDRcv
CILocalRcv

toChatInfo :: ChatDirection c d -> ChatInfo c
toChatInfo :: forall (c :: ChatType) (d :: MsgDirection).
ChatDirection c d -> ChatInfo c
toChatInfo = \case
  CDDirectSnd Contact
c -> Contact -> ChatInfo 'CTDirect
DirectChat Contact
c
  CDDirectRcv Contact
c -> Contact -> ChatInfo 'CTDirect
DirectChat Contact
c
  CDGroupSnd GroupInfo
g Maybe GroupChatScopeInfo
s -> GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g Maybe GroupChatScopeInfo
s
  CDGroupRcv GroupInfo
g Maybe GroupChatScopeInfo
s GroupMember
_ -> GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g Maybe GroupChatScopeInfo
s
  CDLocalSnd NoteFolder
l -> NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
l
  CDLocalRcv NoteFolder
l -> NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
l

contactChatDeleted :: ChatDirection c d -> Bool
contactChatDeleted :: forall (c :: ChatType) (d :: MsgDirection).
ChatDirection c d -> Bool
contactChatDeleted = \case
  CDDirectSnd Contact {Bool
chatDeleted :: Bool
chatDeleted :: Contact -> Bool
chatDeleted} -> Bool
chatDeleted
  CDDirectRcv Contact {Bool
chatDeleted :: Contact -> Bool
chatDeleted :: Bool
chatDeleted} -> Bool
chatDeleted
  ChatDirection c d
_ -> Bool
False

data NewChatItem d = NewChatItem
  { forall (d :: MsgDirection). NewChatItem d -> Maybe Int64
createdByMsgId :: Maybe MessageId,
    forall (d :: MsgDirection). NewChatItem d -> SMsgDirection d
itemSent :: SMsgDirection d,
    forall (d :: MsgDirection). NewChatItem d -> UTCTime
itemTs :: ChatItemTs,
    forall (d :: MsgDirection). NewChatItem d -> CIContent d
itemContent :: CIContent d,
    forall (d :: MsgDirection). NewChatItem d -> Text
itemText :: Text,
    forall (d :: MsgDirection). NewChatItem d -> CIStatus d
itemStatus :: CIStatus d,
    forall (d :: MsgDirection). NewChatItem d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId,
    forall (d :: MsgDirection). NewChatItem d -> Maybe QuotedMsg
itemQuotedMsg :: Maybe QuotedMsg,
    forall (d :: MsgDirection). NewChatItem d -> UTCTime
createdAt :: UTCTime
  }
  deriving (Int -> NewChatItem d -> ShowS
[NewChatItem d] -> ShowS
NewChatItem d -> String
(Int -> NewChatItem d -> ShowS)
-> (NewChatItem d -> String)
-> ([NewChatItem d] -> ShowS)
-> Show (NewChatItem d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (d :: MsgDirection). Int -> NewChatItem d -> ShowS
forall (d :: MsgDirection). [NewChatItem d] -> ShowS
forall (d :: MsgDirection). NewChatItem d -> String
$cshowsPrec :: forall (d :: MsgDirection). Int -> NewChatItem d -> ShowS
showsPrec :: Int -> NewChatItem d -> ShowS
$cshow :: forall (d :: MsgDirection). NewChatItem d -> String
show :: NewChatItem d -> String
$cshowList :: forall (d :: MsgDirection). [NewChatItem d] -> ShowS
showList :: [NewChatItem d] -> ShowS
Show)

-- | type to show one chat with messages
data Chat c = Chat
  { forall (c :: ChatType). Chat c -> ChatInfo c
chatInfo :: ChatInfo c,
    forall (c :: ChatType). Chat c -> [CChatItem c]
chatItems :: [CChatItem c],
    forall (c :: ChatType). Chat c -> ChatStats
chatStats :: ChatStats
  }
  deriving (Int -> Chat c -> ShowS
[Chat c] -> ShowS
Chat c -> String
(Int -> Chat c -> ShowS)
-> (Chat c -> String) -> ([Chat c] -> ShowS) -> Show (Chat c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: ChatType). Int -> Chat c -> ShowS
forall (c :: ChatType). [Chat c] -> ShowS
forall (c :: ChatType). Chat c -> String
$cshowsPrec :: forall (c :: ChatType). Int -> Chat c -> ShowS
showsPrec :: Int -> Chat c -> ShowS
$cshow :: forall (c :: ChatType). Chat c -> String
show :: Chat c -> String
$cshowList :: forall (c :: ChatType). [Chat c] -> ShowS
showList :: [Chat c] -> ShowS
Show)

data AChat = forall c. ChatTypeI c => AChat (SChatType c) (Chat c)

deriving instance Show AChat

data ChatStats = ChatStats
  { ChatStats -> Int
unreadCount :: Int, -- returned both in /_get chat initial API and in /_get chats API
    ChatStats -> Int
unreadMentions :: Int, -- returned both in /_get chat initial API and in /_get chats API
    ChatStats -> Int
reportsCount :: Int, -- returned both in /_get chat initial API and in /_get chats API
    ChatStats -> Int64
minUnreadItemId :: ChatItemId,
    ChatStats -> Bool
unreadChat :: Bool
  }
  deriving (Int -> ChatStats -> ShowS
[ChatStats] -> ShowS
ChatStats -> String
(Int -> ChatStats -> ShowS)
-> (ChatStats -> String)
-> ([ChatStats] -> ShowS)
-> Show ChatStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatStats -> ShowS
showsPrec :: Int -> ChatStats -> ShowS
$cshow :: ChatStats -> String
show :: ChatStats -> String
$cshowList :: [ChatStats] -> ShowS
showList :: [ChatStats] -> ShowS
Show)

emptyChatStats :: ChatStats
emptyChatStats :: ChatStats
emptyChatStats = Int -> Int -> Int -> Int64 -> Bool -> ChatStats
ChatStats Int
0 Int
0 Int
0 Int64
0 Bool
False

data NavigationInfo = NavigationInfo
  { NavigationInfo -> Int
afterUnread :: Int,
    NavigationInfo -> Int
afterTotal :: Int
  }
  deriving (Int -> NavigationInfo -> ShowS
[NavigationInfo] -> ShowS
NavigationInfo -> String
(Int -> NavigationInfo -> ShowS)
-> (NavigationInfo -> String)
-> ([NavigationInfo] -> ShowS)
-> Show NavigationInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NavigationInfo -> ShowS
showsPrec :: Int -> NavigationInfo -> ShowS
$cshow :: NavigationInfo -> String
show :: NavigationInfo -> String
$cshowList :: [NavigationInfo] -> ShowS
showList :: [NavigationInfo] -> ShowS
Show)

-- | type to show a mix of messages from multiple chats
data AChatItem = forall c d. (ChatTypeI c, MsgDirectionI d) => AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d)

deriving instance Show AChatItem

data JSONAnyChatItem c d = JSONAnyChatItem {forall (c :: ChatType) (d :: MsgDirection).
JSONAnyChatItem c d -> ChatInfo c
chatInfo :: ChatInfo c, forall (c :: ChatType) (d :: MsgDirection).
JSONAnyChatItem c d -> ChatItem c d
chatItem :: ChatItem c d}

aChatItems :: AChat -> [AChatItem]
aChatItems :: AChat -> [AChatItem]
aChatItems (AChat SChatType c
ct Chat {ChatInfo c
chatInfo :: forall (c :: ChatType). Chat c -> ChatInfo c
chatInfo :: ChatInfo c
chatInfo, [CChatItem c]
chatItems :: forall (c :: ChatType). Chat c -> [CChatItem c]
chatItems :: [CChatItem c]
chatItems}) = (CChatItem c -> AChatItem) -> [CChatItem c] -> [AChatItem]
forall a b. (a -> b) -> [a] -> [b]
map CChatItem c -> AChatItem
aChatItem [CChatItem c]
chatItems
  where
    aChatItem :: CChatItem c -> AChatItem
aChatItem (CChatItem SMsgDirection d
md ChatItem c d
ci) = SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType c
ct SMsgDirection d
md ChatInfo c
chatInfo ChatItem c d
ci

aChatItemId :: AChatItem -> Int64
aChatItemId :: AChatItem -> Int64
aChatItemId (AChatItem SChatType c
_ SMsgDirection d
_ ChatInfo c
_ ChatItem c d
ci) = ChatItem c d -> Int64
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem c d
ci

aChatItemTs :: AChatItem -> UTCTime
aChatItemTs :: AChatItem -> UTCTime
aChatItemTs (AChatItem SChatType c
_ SMsgDirection d
_ ChatInfo c
_ ChatItem c d
ci) = ChatItem c d -> UTCTime
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> UTCTime
chatItemTs' ChatItem c d
ci

aChatItemDir :: AChatItem -> MsgDirection
aChatItemDir :: AChatItem -> MsgDirection
aChatItemDir (AChatItem SChatType c
_ SMsgDirection d
sMsgDir ChatInfo c
_ ChatItem c d
_) = SMsgDirection d -> MsgDirection
forall (d :: MsgDirection). SMsgDirection d -> MsgDirection
toMsgDirection SMsgDirection d
sMsgDir

aChatItemRcvFromMember :: AChatItem -> Maybe GroupMember
aChatItemRcvFromMember :: AChatItem -> Maybe GroupMember
aChatItemRcvFromMember (AChatItem SChatType c
_ SMsgDirection d
_ ChatInfo c
_ ChatItem c d
ci) = ChatItem c d -> Maybe GroupMember
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe GroupMember
chatItemRcvFromMember ChatItem c d
ci

aChatItemIsRcvNew :: AChatItem -> Bool
aChatItemIsRcvNew :: AChatItem -> Bool
aChatItemIsRcvNew (AChatItem SChatType c
_ SMsgDirection d
_ ChatInfo c
_ ChatItem c d
ci) = ChatItem c d -> Bool
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Bool
chatItemIsRcvNew ChatItem c d
ci

updateFileStatus :: forall c d. ChatItem c d -> CIFileStatus d -> ChatItem c d
updateFileStatus :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIFileStatus d -> ChatItem c d
updateFileStatus ci :: ChatItem c d
ci@ChatItem {Maybe (CIFile d)
file :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe (CIFile d)
file :: Maybe (CIFile d)
file} CIFileStatus d
status = case Maybe (CIFile d)
file of
  Just CIFile d
f -> ChatItem c d
ci {file = Just (f :: CIFile d) {fileStatus = status}}
  Maybe (CIFile d)
Nothing -> ChatItem c d
ci

-- This type is not saved to DB, so all JSON encodings are platform-specific
data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
  { forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Int64
itemId :: ChatItemId,
    forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
itemTs :: ChatItemTs,
    forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Text
itemText :: Text,
    forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> CIStatus d
itemStatus :: CIStatus d,
    forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe Bool
sentViaProxy :: Maybe Bool,
    forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId,
    forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe CIForwardedFrom
itemForwarded :: Maybe CIForwardedFrom,
    forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe (CIDeleted c)
itemDeleted :: Maybe (CIDeleted c),
    forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
itemEdited :: Bool,
    forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe CITimed
itemTimed :: Maybe CITimed,
    forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe Bool
itemLive :: Maybe Bool,
    forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
userMention :: Bool, -- True for messages that mention user or reply to user messages
    forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
deletable :: Bool,
    forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
editable :: Bool,
    forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe Int64
forwardedByMember :: Maybe GroupMemberId,
    forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
showGroupAsSender :: ShowGroupAsSender,
    forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
createdAt :: UTCTime,
    forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
updatedAt :: UTCTime
  }
  deriving (Int -> CIMeta c d -> ShowS
[CIMeta c d] -> ShowS
CIMeta c d -> String
(Int -> CIMeta c d -> ShowS)
-> (CIMeta c d -> String)
-> ([CIMeta c d] -> ShowS)
-> Show (CIMeta c d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: ChatType) (d :: MsgDirection).
Int -> CIMeta c d -> ShowS
forall (c :: ChatType) (d :: MsgDirection). [CIMeta c d] -> ShowS
forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> String
$cshowsPrec :: forall (c :: ChatType) (d :: MsgDirection).
Int -> CIMeta c d -> ShowS
showsPrec :: Int -> CIMeta c d -> ShowS
$cshow :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> String
show :: CIMeta c d -> String
$cshowList :: forall (c :: ChatType) (d :: MsgDirection). [CIMeta c d] -> ShowS
showList :: [CIMeta c d] -> ShowS
Show)

type ShowGroupAsSender = Bool

mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe Bool -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> Bool -> UTCTime -> UTCTime -> CIMeta c d
mkCIMeta :: forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
Int64
-> CIContent d
-> Text
-> CIStatus d
-> Maybe Bool
-> Maybe SharedMsgId
-> Maybe CIForwardedFrom
-> Maybe (CIDeleted c)
-> Bool
-> Maybe CITimed
-> Maybe Bool
-> Bool
-> UTCTime
-> UTCTime
-> Maybe Int64
-> Bool
-> UTCTime
-> UTCTime
-> CIMeta c d
mkCIMeta Int64
itemId CIContent d
itemContent Text
itemText CIStatus d
itemStatus Maybe Bool
sentViaProxy Maybe SharedMsgId
itemSharedMsgId Maybe CIForwardedFrom
itemForwarded Maybe (CIDeleted c)
itemDeleted Bool
itemEdited Maybe CITimed
itemTimed Maybe Bool
itemLive Bool
userMention UTCTime
currentTs UTCTime
itemTs Maybe Int64
forwardedByMember Bool
showGroupAsSender UTCTime
createdAt UTCTime
updatedAt =
  let deletable :: Bool
deletable = CIContent d
-> Maybe (CIDeleted c)
-> UTCTime
-> NominalDiffTime
-> UTCTime
-> Bool
forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
CIContent d
-> Maybe (CIDeleted c)
-> UTCTime
-> NominalDiffTime
-> UTCTime
-> Bool
deletable' CIContent d
itemContent Maybe (CIDeleted c)
itemDeleted UTCTime
itemTs NominalDiffTime
nominalDay UTCTime
currentTs
      editable :: Bool
editable = Bool
deletable Bool -> Bool -> Bool
&& Maybe CIForwardedFrom -> Bool
forall a. Maybe a -> Bool
isNothing Maybe CIForwardedFrom
itemForwarded
   in CIMeta {Int64
itemId :: Int64
itemId :: Int64
itemId, UTCTime
itemTs :: UTCTime
itemTs :: UTCTime
itemTs, Text
itemText :: Text
itemText :: Text
itemText, CIStatus d
itemStatus :: CIStatus d
itemStatus :: CIStatus d
itemStatus, Maybe Bool
sentViaProxy :: Maybe Bool
sentViaProxy :: Maybe Bool
sentViaProxy, Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId, Maybe CIForwardedFrom
itemForwarded :: Maybe CIForwardedFrom
itemForwarded :: Maybe CIForwardedFrom
itemForwarded, Maybe (CIDeleted c)
itemDeleted :: Maybe (CIDeleted c)
itemDeleted :: Maybe (CIDeleted c)
itemDeleted, Bool
itemEdited :: Bool
itemEdited :: Bool
itemEdited, Maybe CITimed
itemTimed :: Maybe CITimed
itemTimed :: Maybe CITimed
itemTimed, Maybe Bool
itemLive :: Maybe Bool
itemLive :: Maybe Bool
itemLive, Bool
userMention :: Bool
userMention :: Bool
userMention, Bool
deletable :: Bool
deletable :: Bool
deletable, Bool
editable :: Bool
editable :: Bool
editable, Maybe Int64
forwardedByMember :: Maybe Int64
forwardedByMember :: Maybe Int64
forwardedByMember, Bool
showGroupAsSender :: Bool
showGroupAsSender :: Bool
showGroupAsSender, UTCTime
createdAt :: UTCTime
createdAt :: UTCTime
createdAt, UTCTime
updatedAt :: UTCTime
updatedAt :: UTCTime
updatedAt}

deletable' :: forall c d. ChatTypeI c => CIContent d -> Maybe (CIDeleted c) -> UTCTime -> NominalDiffTime -> UTCTime -> Bool
deletable' :: forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
CIContent d
-> Maybe (CIDeleted c)
-> UTCTime
-> NominalDiffTime
-> UTCTime
-> Bool
deletable' CIContent d
itemContent Maybe (CIDeleted c)
itemDeleted UTCTime
itemTs NominalDiffTime
allowedInterval UTCTime
currentTs =
  case CIContent d
itemContent of
    CISndMsgContent MsgContent
_ ->
      case forall (c :: ChatType). ChatTypeI c => SChatType c
chatTypeI @c of
        SChatType c
SCTLocal -> Maybe (CIDeleted c) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (CIDeleted c)
itemDeleted
        SChatType c
_ -> UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
currentTs UTCTime
itemTs NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
allowedInterval Bool -> Bool -> Bool
&& Maybe (CIDeleted c) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (CIDeleted c)
itemDeleted
    CIContent d
_ -> Bool
False

dummyMeta :: ChatItemId -> UTCTime -> Text -> CIMeta c 'MDSnd
dummyMeta :: forall (c :: ChatType). Int64 -> UTCTime -> Text -> CIMeta c 'MDSnd
dummyMeta Int64
itemId UTCTime
ts Text
itemText =
  CIMeta
    { Int64
itemId :: Int64
itemId :: Int64
itemId,
      itemTs :: UTCTime
itemTs = UTCTime
ts,
      Text
itemText :: Text
itemText :: Text
itemText,
      itemStatus :: CIStatus 'MDSnd
itemStatus = CIStatus 'MDSnd
CISSndNew,
      sentViaProxy :: Maybe Bool
sentViaProxy = Maybe Bool
forall a. Maybe a
Nothing,
      itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId = Maybe SharedMsgId
forall a. Maybe a
Nothing,
      itemForwarded :: Maybe CIForwardedFrom
itemForwarded = Maybe CIForwardedFrom
forall a. Maybe a
Nothing,
      itemDeleted :: Maybe (CIDeleted c)
itemDeleted = Maybe (CIDeleted c)
forall a. Maybe a
Nothing,
      itemEdited :: Bool
itemEdited = Bool
False,
      itemTimed :: Maybe CITimed
itemTimed = Maybe CITimed
forall a. Maybe a
Nothing,
      itemLive :: Maybe Bool
itemLive = Maybe Bool
forall a. Maybe a
Nothing,
      userMention :: Bool
userMention = Bool
False,
      deletable :: Bool
deletable = Bool
False,
      editable :: Bool
editable = Bool
False,
      forwardedByMember :: Maybe Int64
forwardedByMember = Maybe Int64
forall a. Maybe a
Nothing,
      showGroupAsSender :: Bool
showGroupAsSender = Bool
False,
      createdAt :: UTCTime
createdAt = UTCTime
ts,
      updatedAt :: UTCTime
updatedAt = UTCTime
ts
    }

data CITimed = CITimed
  { CITimed -> Int
ttl :: Int, -- seconds
    CITimed -> Maybe UTCTime
deleteAt :: Maybe UTCTime -- this is initially Nothing for received items, the timer starts when they are read
  }
  deriving (Int -> CITimed -> ShowS
[CITimed] -> ShowS
CITimed -> String
(Int -> CITimed -> ShowS)
-> (CITimed -> String) -> ([CITimed] -> ShowS) -> Show CITimed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CITimed -> ShowS
showsPrec :: Int -> CITimed -> ShowS
$cshow :: CITimed -> String
show :: CITimed -> String
$cshowList :: [CITimed] -> ShowS
showList :: [CITimed] -> ShowS
Show)

ttl' :: CITimed -> Int
ttl' :: CITimed -> Int
ttl' CITimed {Int
ttl :: CITimed -> Int
ttl :: Int
ttl} = Int
ttl

contactTimedTTL :: Contact -> Maybe (Maybe Int)
contactTimedTTL :: Contact -> Maybe (Maybe Int)
contactTimedTTL Contact {mergedPreferences :: Contact -> ContactUserPreferences
mergedPreferences = ContactUserPreferences {timedMessages :: ContactUserPreferences
-> ContactUserPreference TimedMessagesPreference
timedMessages = ContactUserPreference {PrefEnabled
enabled :: PrefEnabled
enabled :: forall p. ContactUserPreference p -> PrefEnabled
enabled, ContactUserPref TimedMessagesPreference
userPreference :: ContactUserPref TimedMessagesPreference
userPreference :: forall p. ContactUserPreference p -> ContactUserPref p
userPreference}}}
  | PrefEnabled -> Bool
forUser PrefEnabled
enabled Bool -> Bool -> Bool
&& PrefEnabled -> Bool
forContact PrefEnabled
enabled = Maybe Int -> Maybe (Maybe Int)
forall a. a -> Maybe a
Just Maybe Int
ttl
  | Bool
otherwise = Maybe (Maybe Int)
forall a. Maybe a
Nothing
  where
    TimedMessagesPreference {Maybe Int
ttl :: Maybe Int
ttl :: TimedMessagesPreference -> Maybe Int
ttl} = case ContactUserPref TimedMessagesPreference
userPreference of
      CUPContact {TimedMessagesPreference
preference :: TimedMessagesPreference
preference :: forall p. ContactUserPref p -> p
preference} -> TimedMessagesPreference
preference
      CUPUser {TimedMessagesPreference
preference :: forall p. ContactUserPref p -> p
preference :: TimedMessagesPreference
preference} -> TimedMessagesPreference
preference

groupTimedTTL :: GroupInfo -> Maybe (Maybe Int)
groupTimedTTL :: GroupInfo -> Maybe (Maybe Int)
groupTimedTTL GroupInfo {fullGroupPreferences :: GroupInfo -> FullGroupPreferences
fullGroupPreferences = FullGroupPreferences {timedMessages :: FullGroupPreferences -> TimedMessagesGroupPreference
timedMessages = TimedMessagesGroupPreference {GroupFeatureEnabled
enable :: GroupFeatureEnabled
enable :: TimedMessagesGroupPreference -> GroupFeatureEnabled
enable, Maybe Int
ttl :: Maybe Int
ttl :: TimedMessagesGroupPreference -> Maybe Int
ttl}}}
  | GroupFeatureEnabled
enable GroupFeatureEnabled -> GroupFeatureEnabled -> Bool
forall a. Eq a => a -> a -> Bool
== GroupFeatureEnabled
FEOn = Maybe Int -> Maybe (Maybe Int)
forall a. a -> Maybe a
Just Maybe Int
ttl
  | Bool
otherwise = Maybe (Maybe Int)
forall a. Maybe a
Nothing

rcvContactCITimed :: Contact -> Maybe Int -> Maybe CITimed
rcvContactCITimed :: Contact -> Maybe Int -> Maybe CITimed
rcvContactCITimed = Maybe (Maybe Int) -> Maybe Int -> Maybe CITimed
rcvCITimed_ (Maybe (Maybe Int) -> Maybe Int -> Maybe CITimed)
-> (Contact -> Maybe (Maybe Int))
-> Contact
-> Maybe Int
-> Maybe CITimed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contact -> Maybe (Maybe Int)
contactTimedTTL

rcvGroupCITimed :: GroupInfo -> Maybe Int -> Maybe CITimed
rcvGroupCITimed :: GroupInfo -> Maybe Int -> Maybe CITimed
rcvGroupCITimed = Maybe (Maybe Int) -> Maybe Int -> Maybe CITimed
rcvCITimed_ (Maybe (Maybe Int) -> Maybe Int -> Maybe CITimed)
-> (GroupInfo -> Maybe (Maybe Int))
-> GroupInfo
-> Maybe Int
-> Maybe CITimed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupInfo -> Maybe (Maybe Int)
groupTimedTTL

rcvCITimed_ :: Maybe (Maybe Int) -> Maybe Int -> Maybe CITimed
rcvCITimed_ :: Maybe (Maybe Int) -> Maybe Int -> Maybe CITimed
rcvCITimed_ Maybe (Maybe Int)
chatTTL Maybe Int
itemTTL = (Int -> Maybe UTCTime -> CITimed
`CITimed` Maybe UTCTime
forall a. Maybe a
Nothing) (Int -> CITimed) -> Maybe Int -> Maybe CITimed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Maybe Int)
chatTTL Maybe (Maybe Int) -> Maybe Int -> Maybe Int
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Int
itemTTL)

data CIQuote (c :: ChatType) = CIQuote
  { forall (c :: ChatType). CIQuote c -> CIQDirection c
chatDir :: CIQDirection c,
    forall (c :: ChatType). CIQuote c -> Maybe Int64
itemId :: Maybe ChatItemId, -- Nothing in case MsgRef references the item the user did not receive yet
    forall (c :: ChatType). CIQuote c -> Maybe SharedMsgId
sharedMsgId :: Maybe SharedMsgId, -- Nothing for the messages from the old clients
    forall (c :: ChatType). CIQuote c -> UTCTime
sentAt :: UTCTime,
    forall (c :: ChatType). CIQuote c -> MsgContent
content :: MsgContent,
    forall (c :: ChatType). CIQuote c -> Maybe MarkdownList
formattedText :: Maybe MarkdownList
  }
  deriving (Int -> CIQuote c -> ShowS
[CIQuote c] -> ShowS
CIQuote c -> String
(Int -> CIQuote c -> ShowS)
-> (CIQuote c -> String)
-> ([CIQuote c] -> ShowS)
-> Show (CIQuote c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: ChatType). Int -> CIQuote c -> ShowS
forall (c :: ChatType). [CIQuote c] -> ShowS
forall (c :: ChatType). CIQuote c -> String
$cshowsPrec :: forall (c :: ChatType). Int -> CIQuote c -> ShowS
showsPrec :: Int -> CIQuote c -> ShowS
$cshow :: forall (c :: ChatType). CIQuote c -> String
show :: CIQuote c -> String
$cshowList :: forall (c :: ChatType). [CIQuote c] -> ShowS
showList :: [CIQuote c] -> ShowS
Show)

quoteItemId :: CIQuote c -> Maybe ChatItemId
quoteItemId :: forall (c :: ChatType). CIQuote c -> Maybe Int64
quoteItemId CIQuote {Maybe Int64
itemId :: forall (c :: ChatType). CIQuote c -> Maybe Int64
itemId :: Maybe Int64
itemId} = Maybe Int64
itemId

data CIReaction (c :: ChatType) (d :: MsgDirection) = CIReaction
  { forall (c :: ChatType) (d :: MsgDirection).
CIReaction c d -> CIDirection c d
chatDir :: CIDirection c d,
    forall (c :: ChatType) (d :: MsgDirection).
CIReaction c d -> CChatItem c
chatItem :: CChatItem c,
    forall (c :: ChatType) (d :: MsgDirection).
CIReaction c d -> UTCTime
sentAt :: UTCTime,
    forall (c :: ChatType) (d :: MsgDirection).
CIReaction c d -> MsgReaction
reaction :: MsgReaction
  }
  deriving (Int -> CIReaction c d -> ShowS
[CIReaction c d] -> ShowS
CIReaction c d -> String
(Int -> CIReaction c d -> ShowS)
-> (CIReaction c d -> String)
-> ([CIReaction c d] -> ShowS)
-> Show (CIReaction c d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: ChatType) (d :: MsgDirection).
Int -> CIReaction c d -> ShowS
forall (c :: ChatType) (d :: MsgDirection).
[CIReaction c d] -> ShowS
forall (c :: ChatType) (d :: MsgDirection).
CIReaction c d -> String
$cshowsPrec :: forall (c :: ChatType) (d :: MsgDirection).
Int -> CIReaction c d -> ShowS
showsPrec :: Int -> CIReaction c d -> ShowS
$cshow :: forall (c :: ChatType) (d :: MsgDirection).
CIReaction c d -> String
show :: CIReaction c d -> String
$cshowList :: forall (c :: ChatType) (d :: MsgDirection).
[CIReaction c d] -> ShowS
showList :: [CIReaction c d] -> ShowS
Show)

data AnyCIReaction = forall c d. ChatTypeI c => ACIR (SChatType c) (SMsgDirection d) (CIReaction c d)

data ACIReaction = forall c d. ChatTypeI c => ACIReaction (SChatType c) (SMsgDirection d) (ChatInfo c) (CIReaction c d)

deriving instance Show ACIReaction

data JSONCIReaction c d = JSONCIReaction {forall (c :: ChatType) (d :: MsgDirection).
JSONCIReaction c d -> ChatInfo c
chatInfo :: ChatInfo c, forall (c :: ChatType) (d :: MsgDirection).
JSONCIReaction c d -> CIReaction c d
chatReaction :: CIReaction c d}

data MemberReaction = MemberReaction
  { MemberReaction -> GroupMember
groupMember :: GroupMember,
    MemberReaction -> UTCTime
reactionTs :: UTCTime
  }
  deriving (Int -> MemberReaction -> ShowS
[MemberReaction] -> ShowS
MemberReaction -> String
(Int -> MemberReaction -> ShowS)
-> (MemberReaction -> String)
-> ([MemberReaction] -> ShowS)
-> Show MemberReaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemberReaction -> ShowS
showsPrec :: Int -> MemberReaction -> ShowS
$cshow :: MemberReaction -> String
show :: MemberReaction -> String
$cshowList :: [MemberReaction] -> ShowS
showList :: [MemberReaction] -> ShowS
Show)

type family ChatTypeQuotable (a :: ChatType) :: Constraint where
  ChatTypeQuotable 'CTDirect = ()
  ChatTypeQuotable 'CTGroup = ()
  ChatTypeQuotable a =
    (Int ~ Bool, TypeError ('Type.Text "ChatType " ':<>: 'ShowType a ':<>: 'Type.Text " cannot be quoted"))

data CIQDirection (c :: ChatType) where
  CIQDirectSnd :: CIQDirection 'CTDirect
  CIQDirectRcv :: CIQDirection 'CTDirect
  CIQGroupSnd :: CIQDirection 'CTGroup
  CIQGroupRcv :: Maybe GroupMember -> CIQDirection 'CTGroup -- member can be Nothing in case MsgRef has memberId that the user is not notified about yet

deriving instance Show (CIQDirection c)

data ACIQDirection = forall c. (ChatTypeI c, ChatTypeQuotable c) => ACIQDirection (SChatType c) (CIQDirection c)

jsonCIQDirection :: CIQDirection c -> Maybe JSONCIDirection
jsonCIQDirection :: forall (c :: ChatType). CIQDirection c -> Maybe JSONCIDirection
jsonCIQDirection = \case
  CIQDirection c
CIQDirectSnd -> JSONCIDirection -> Maybe JSONCIDirection
forall a. a -> Maybe a
Just JSONCIDirection
JCIDirectSnd
  CIQDirection c
CIQDirectRcv -> JSONCIDirection -> Maybe JSONCIDirection
forall a. a -> Maybe a
Just JSONCIDirection
JCIDirectRcv
  CIQDirection c
CIQGroupSnd -> JSONCIDirection -> Maybe JSONCIDirection
forall a. a -> Maybe a
Just JSONCIDirection
JCIGroupSnd
  CIQGroupRcv (Just GroupMember
m) -> JSONCIDirection -> Maybe JSONCIDirection
forall a. a -> Maybe a
Just (JSONCIDirection -> Maybe JSONCIDirection)
-> JSONCIDirection -> Maybe JSONCIDirection
forall a b. (a -> b) -> a -> b
$ GroupMember -> JSONCIDirection
JCIGroupRcv GroupMember
m
  CIQGroupRcv Maybe GroupMember
Nothing -> Maybe JSONCIDirection
forall a. Maybe a
Nothing

jsonACIQDirection :: Maybe JSONCIDirection -> Either String ACIQDirection
jsonACIQDirection :: Maybe JSONCIDirection -> Either String ACIQDirection
jsonACIQDirection = \case
  Just JSONCIDirection
JCIDirectSnd -> ACIQDirection -> Either String ACIQDirection
forall a b. b -> Either a b
Right (ACIQDirection -> Either String ACIQDirection)
-> ACIQDirection -> Either String ACIQDirection
forall a b. (a -> b) -> a -> b
$ SChatType 'CTDirect -> CIQDirection 'CTDirect -> ACIQDirection
forall (c :: ChatType).
(ChatTypeI c, ChatTypeQuotable c) =>
SChatType c -> CIQDirection c -> ACIQDirection
ACIQDirection SChatType 'CTDirect
SCTDirect CIQDirection 'CTDirect
CIQDirectSnd
  Just JSONCIDirection
JCIDirectRcv -> ACIQDirection -> Either String ACIQDirection
forall a b. b -> Either a b
Right (ACIQDirection -> Either String ACIQDirection)
-> ACIQDirection -> Either String ACIQDirection
forall a b. (a -> b) -> a -> b
$ SChatType 'CTDirect -> CIQDirection 'CTDirect -> ACIQDirection
forall (c :: ChatType).
(ChatTypeI c, ChatTypeQuotable c) =>
SChatType c -> CIQDirection c -> ACIQDirection
ACIQDirection SChatType 'CTDirect
SCTDirect CIQDirection 'CTDirect
CIQDirectRcv
  Just JSONCIDirection
JCIGroupSnd -> ACIQDirection -> Either String ACIQDirection
forall a b. b -> Either a b
Right (ACIQDirection -> Either String ACIQDirection)
-> ACIQDirection -> Either String ACIQDirection
forall a b. (a -> b) -> a -> b
$ SChatType 'CTGroup -> CIQDirection 'CTGroup -> ACIQDirection
forall (c :: ChatType).
(ChatTypeI c, ChatTypeQuotable c) =>
SChatType c -> CIQDirection c -> ACIQDirection
ACIQDirection SChatType 'CTGroup
SCTGroup CIQDirection 'CTGroup
CIQGroupSnd
  Just (JCIGroupRcv GroupMember
m) -> ACIQDirection -> Either String ACIQDirection
forall a b. b -> Either a b
Right (ACIQDirection -> Either String ACIQDirection)
-> ACIQDirection -> Either String ACIQDirection
forall a b. (a -> b) -> a -> b
$ SChatType 'CTGroup -> CIQDirection 'CTGroup -> ACIQDirection
forall (c :: ChatType).
(ChatTypeI c, ChatTypeQuotable c) =>
SChatType c -> CIQDirection c -> ACIQDirection
ACIQDirection SChatType 'CTGroup
SCTGroup (CIQDirection 'CTGroup -> ACIQDirection)
-> CIQDirection 'CTGroup -> ACIQDirection
forall a b. (a -> b) -> a -> b
$ Maybe GroupMember -> CIQDirection 'CTGroup
CIQGroupRcv (GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
m)
  Maybe JSONCIDirection
Nothing -> ACIQDirection -> Either String ACIQDirection
forall a b. b -> Either a b
Right (ACIQDirection -> Either String ACIQDirection)
-> ACIQDirection -> Either String ACIQDirection
forall a b. (a -> b) -> a -> b
$ SChatType 'CTGroup -> CIQDirection 'CTGroup -> ACIQDirection
forall (c :: ChatType).
(ChatTypeI c, ChatTypeQuotable c) =>
SChatType c -> CIQDirection c -> ACIQDirection
ACIQDirection SChatType 'CTGroup
SCTGroup (CIQDirection 'CTGroup -> ACIQDirection)
-> CIQDirection 'CTGroup -> ACIQDirection
forall a b. (a -> b) -> a -> b
$ Maybe GroupMember -> CIQDirection 'CTGroup
CIQGroupRcv Maybe GroupMember
forall a. Maybe a
Nothing
  Just JSONCIDirection
JCILocalSnd -> String -> Either String ACIQDirection
forall a b. a -> Either a b
Left String
"unquotable"
  Just JSONCIDirection
JCILocalRcv -> String -> Either String ACIQDirection
forall a b. a -> Either a b
Left String
"unquotable"

quoteMsgDirection :: CIQDirection c -> MsgDirection
quoteMsgDirection :: forall (c :: ChatType). CIQDirection c -> MsgDirection
quoteMsgDirection = \case
  CIQDirection c
CIQDirectSnd -> MsgDirection
MDSnd
  CIQDirection c
CIQDirectRcv -> MsgDirection
MDRcv
  CIQDirection c
CIQGroupSnd -> MsgDirection
MDSnd
  CIQGroupRcv Maybe GroupMember
_ -> MsgDirection
MDRcv

data CIFile (d :: MsgDirection) = CIFile
  { forall (d :: MsgDirection). CIFile d -> Int64
fileId :: Int64,
    forall (d :: MsgDirection). CIFile d -> String
fileName :: String,
    forall (d :: MsgDirection). CIFile d -> Integer
fileSize :: Integer,
    forall (d :: MsgDirection). CIFile d -> Maybe CryptoFile
fileSource :: Maybe CryptoFile, -- local file path with optional key and nonce
    forall (d :: MsgDirection). CIFile d -> CIFileStatus d
fileStatus :: CIFileStatus d,
    forall (d :: MsgDirection). CIFile d -> FileProtocol
fileProtocol :: FileProtocol
  }
  deriving (Int -> CIFile d -> ShowS
[CIFile d] -> ShowS
CIFile d -> String
(Int -> CIFile d -> ShowS)
-> (CIFile d -> String) -> ([CIFile d] -> ShowS) -> Show (CIFile d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (d :: MsgDirection). Int -> CIFile d -> ShowS
forall (d :: MsgDirection). [CIFile d] -> ShowS
forall (d :: MsgDirection). CIFile d -> String
$cshowsPrec :: forall (d :: MsgDirection). Int -> CIFile d -> ShowS
showsPrec :: Int -> CIFile d -> ShowS
$cshow :: forall (d :: MsgDirection). CIFile d -> String
show :: CIFile d -> String
$cshowList :: forall (d :: MsgDirection). [CIFile d] -> ShowS
showList :: [CIFile d] -> ShowS
Show)

data FileProtocol = FPSMP | FPXFTP | FPLocal
  deriving (FileProtocol -> FileProtocol -> Bool
(FileProtocol -> FileProtocol -> Bool)
-> (FileProtocol -> FileProtocol -> Bool) -> Eq FileProtocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileProtocol -> FileProtocol -> Bool
== :: FileProtocol -> FileProtocol -> Bool
$c/= :: FileProtocol -> FileProtocol -> Bool
/= :: FileProtocol -> FileProtocol -> Bool
Eq, Int -> FileProtocol -> ShowS
[FileProtocol] -> ShowS
FileProtocol -> String
(Int -> FileProtocol -> ShowS)
-> (FileProtocol -> String)
-> ([FileProtocol] -> ShowS)
-> Show FileProtocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileProtocol -> ShowS
showsPrec :: Int -> FileProtocol -> ShowS
$cshow :: FileProtocol -> String
show :: FileProtocol -> String
$cshowList :: [FileProtocol] -> ShowS
showList :: [FileProtocol] -> ShowS
Show, Eq FileProtocol
Eq FileProtocol =>
(FileProtocol -> FileProtocol -> Ordering)
-> (FileProtocol -> FileProtocol -> Bool)
-> (FileProtocol -> FileProtocol -> Bool)
-> (FileProtocol -> FileProtocol -> Bool)
-> (FileProtocol -> FileProtocol -> Bool)
-> (FileProtocol -> FileProtocol -> FileProtocol)
-> (FileProtocol -> FileProtocol -> FileProtocol)
-> Ord FileProtocol
FileProtocol -> FileProtocol -> Bool
FileProtocol -> FileProtocol -> Ordering
FileProtocol -> FileProtocol -> FileProtocol
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FileProtocol -> FileProtocol -> Ordering
compare :: FileProtocol -> FileProtocol -> Ordering
$c< :: FileProtocol -> FileProtocol -> Bool
< :: FileProtocol -> FileProtocol -> Bool
$c<= :: FileProtocol -> FileProtocol -> Bool
<= :: FileProtocol -> FileProtocol -> Bool
$c> :: FileProtocol -> FileProtocol -> Bool
> :: FileProtocol -> FileProtocol -> Bool
$c>= :: FileProtocol -> FileProtocol -> Bool
>= :: FileProtocol -> FileProtocol -> Bool
$cmax :: FileProtocol -> FileProtocol -> FileProtocol
max :: FileProtocol -> FileProtocol -> FileProtocol
$cmin :: FileProtocol -> FileProtocol -> FileProtocol
min :: FileProtocol -> FileProtocol -> FileProtocol
Ord)

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

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

instance FromJSON FileProtocol where
  parseJSON :: Value -> Parser FileProtocol
parseJSON = String -> Value -> Parser FileProtocol
forall a. TextEncoding a => String -> Value -> Parser a
textParseJSON String
"FileProtocol"

instance ToJSON FileProtocol where
  toJSON :: FileProtocol -> Value
toJSON = Text -> Value
J.String (Text -> Value) -> (FileProtocol -> Text) -> FileProtocol -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileProtocol -> Text
forall a. TextEncoding a => a -> Text
textEncode
  toEncoding :: FileProtocol -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
JE.text (Text -> Encoding)
-> (FileProtocol -> Text) -> FileProtocol -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileProtocol -> Text
forall a. TextEncoding a => a -> Text
textEncode

instance TextEncoding FileProtocol where
  textDecode :: Text -> Maybe FileProtocol
textDecode = \case
    Text
"smp" -> FileProtocol -> Maybe FileProtocol
forall a. a -> Maybe a
Just FileProtocol
FPSMP
    Text
"xftp" -> FileProtocol -> Maybe FileProtocol
forall a. a -> Maybe a
Just FileProtocol
FPXFTP
    Text
"local" -> FileProtocol -> Maybe FileProtocol
forall a. a -> Maybe a
Just FileProtocol
FPLocal
    Text
_ -> Maybe FileProtocol
forall a. Maybe a
Nothing
  textEncode :: FileProtocol -> Text
textEncode = \case
    FileProtocol
FPSMP -> Text
"smp"
    FileProtocol
FPXFTP -> Text
"xftp"
    FileProtocol
FPLocal -> Text
"local"

data CIFileStatus (d :: MsgDirection) where
  CIFSSndStored :: CIFileStatus 'MDSnd
  CIFSSndTransfer :: {CIFileStatus 'MDSnd -> Int64
sndProgress :: Int64, CIFileStatus 'MDSnd -> Int64
sndTotal :: Int64} -> CIFileStatus 'MDSnd
  CIFSSndCancelled :: CIFileStatus 'MDSnd
  CIFSSndComplete :: CIFileStatus 'MDSnd
  CIFSSndError :: {CIFileStatus 'MDSnd -> FileError
sndFileError :: FileError} -> CIFileStatus 'MDSnd
  CIFSSndWarning :: {sndFileError :: FileError} -> CIFileStatus 'MDSnd
  CIFSRcvInvitation :: CIFileStatus 'MDRcv
  CIFSRcvAccepted :: CIFileStatus 'MDRcv
  CIFSRcvTransfer :: {CIFileStatus 'MDRcv -> Int64
rcvProgress :: Int64, CIFileStatus 'MDRcv -> Int64
rcvTotal :: Int64} -> CIFileStatus 'MDRcv
  CIFSRcvAborted :: CIFileStatus 'MDRcv
  CIFSRcvComplete :: CIFileStatus 'MDRcv
  CIFSRcvCancelled :: CIFileStatus 'MDRcv
  CIFSRcvError :: {CIFileStatus 'MDRcv -> FileError
rcvFileError :: FileError} -> CIFileStatus 'MDRcv
  CIFSRcvWarning :: {rcvFileError :: FileError} -> CIFileStatus 'MDRcv
  CIFSInvalid :: {CIFileStatus 'MDSnd -> Text
text :: Text} -> CIFileStatus 'MDSnd

deriving instance Eq (CIFileStatus d)

deriving instance Show (CIFileStatus d)

ciFileEnded :: CIFileStatus d -> Bool
ciFileEnded :: forall (d :: MsgDirection). CIFileStatus d -> Bool
ciFileEnded = \case
  CIFileStatus d
CIFSSndStored -> Bool
False
  CIFSSndTransfer {} -> Bool
False
  CIFileStatus d
CIFSSndCancelled -> Bool
True
  CIFileStatus d
CIFSSndComplete -> Bool
True
  CIFSSndError {} -> Bool
True
  CIFSSndWarning {} -> Bool
False
  CIFileStatus d
CIFSRcvInvitation -> Bool
False
  CIFileStatus d
CIFSRcvAccepted -> Bool
False
  CIFSRcvTransfer {} -> Bool
False
  CIFileStatus d
CIFSRcvAborted -> Bool
True
  CIFileStatus d
CIFSRcvCancelled -> Bool
True
  CIFileStatus d
CIFSRcvComplete -> Bool
True
  CIFSRcvError {} -> Bool
True
  CIFSRcvWarning {} -> Bool
False
  CIFSInvalid {} -> Bool
True

ciFileLoaded :: CIFileStatus d -> Bool
ciFileLoaded :: forall (d :: MsgDirection). CIFileStatus d -> Bool
ciFileLoaded = \case
  CIFileStatus d
CIFSSndStored -> Bool
True
  CIFSSndTransfer {} -> Bool
True
  CIFileStatus d
CIFSSndComplete -> Bool
True
  CIFileStatus d
CIFSSndCancelled -> Bool
True
  CIFSSndError {} -> Bool
True
  CIFSSndWarning {} -> Bool
True
  CIFileStatus d
CIFSRcvInvitation -> Bool
False
  CIFileStatus d
CIFSRcvAccepted -> Bool
False
  CIFSRcvTransfer {} -> Bool
False
  CIFileStatus d
CIFSRcvAborted -> Bool
False
  CIFileStatus d
CIFSRcvCancelled -> Bool
False
  CIFileStatus d
CIFSRcvComplete -> Bool
True
  CIFSRcvError {} -> Bool
False
  CIFSRcvWarning {} -> Bool
False
  CIFSInvalid {} -> Bool
False

data ForwardFileError = FFENotAccepted FileTransferId | FFEInProgress | FFEFailed | FFEMissing
  deriving (ForwardFileError -> ForwardFileError -> Bool
(ForwardFileError -> ForwardFileError -> Bool)
-> (ForwardFileError -> ForwardFileError -> Bool)
-> Eq ForwardFileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForwardFileError -> ForwardFileError -> Bool
== :: ForwardFileError -> ForwardFileError -> Bool
$c/= :: ForwardFileError -> ForwardFileError -> Bool
/= :: ForwardFileError -> ForwardFileError -> Bool
Eq, Eq ForwardFileError
Eq ForwardFileError =>
(ForwardFileError -> ForwardFileError -> Ordering)
-> (ForwardFileError -> ForwardFileError -> Bool)
-> (ForwardFileError -> ForwardFileError -> Bool)
-> (ForwardFileError -> ForwardFileError -> Bool)
-> (ForwardFileError -> ForwardFileError -> Bool)
-> (ForwardFileError -> ForwardFileError -> ForwardFileError)
-> (ForwardFileError -> ForwardFileError -> ForwardFileError)
-> Ord ForwardFileError
ForwardFileError -> ForwardFileError -> Bool
ForwardFileError -> ForwardFileError -> Ordering
ForwardFileError -> ForwardFileError -> ForwardFileError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ForwardFileError -> ForwardFileError -> Ordering
compare :: ForwardFileError -> ForwardFileError -> Ordering
$c< :: ForwardFileError -> ForwardFileError -> Bool
< :: ForwardFileError -> ForwardFileError -> Bool
$c<= :: ForwardFileError -> ForwardFileError -> Bool
<= :: ForwardFileError -> ForwardFileError -> Bool
$c> :: ForwardFileError -> ForwardFileError -> Bool
> :: ForwardFileError -> ForwardFileError -> Bool
$c>= :: ForwardFileError -> ForwardFileError -> Bool
>= :: ForwardFileError -> ForwardFileError -> Bool
$cmax :: ForwardFileError -> ForwardFileError -> ForwardFileError
max :: ForwardFileError -> ForwardFileError -> ForwardFileError
$cmin :: ForwardFileError -> ForwardFileError -> ForwardFileError
min :: ForwardFileError -> ForwardFileError -> ForwardFileError
Ord)

ciFileForwardError :: FileTransferId -> CIFileStatus d -> Maybe ForwardFileError
ciFileForwardError :: forall (d :: MsgDirection).
Int64 -> CIFileStatus d -> Maybe ForwardFileError
ciFileForwardError Int64
fId = \case
  CIFileStatus d
CIFSSndStored -> Maybe ForwardFileError
forall a. Maybe a
Nothing
  CIFSSndTransfer {} -> Maybe ForwardFileError
forall a. Maybe a
Nothing
  CIFileStatus d
CIFSSndComplete -> Maybe ForwardFileError
forall a. Maybe a
Nothing
  CIFileStatus d
CIFSSndCancelled -> Maybe ForwardFileError
forall a. Maybe a
Nothing
  CIFSSndError {} -> Maybe ForwardFileError
forall a. Maybe a
Nothing
  CIFSSndWarning {} -> Maybe ForwardFileError
forall a. Maybe a
Nothing
  CIFileStatus d
CIFSRcvInvitation -> ForwardFileError -> Maybe ForwardFileError
forall a. a -> Maybe a
Just (ForwardFileError -> Maybe ForwardFileError)
-> ForwardFileError -> Maybe ForwardFileError
forall a b. (a -> b) -> a -> b
$ Int64 -> ForwardFileError
FFENotAccepted Int64
fId
  CIFileStatus d
CIFSRcvAccepted -> ForwardFileError -> Maybe ForwardFileError
forall a. a -> Maybe a
Just ForwardFileError
FFEInProgress
  CIFSRcvTransfer {} -> ForwardFileError -> Maybe ForwardFileError
forall a. a -> Maybe a
Just ForwardFileError
FFEInProgress
  CIFileStatus d
CIFSRcvAborted -> ForwardFileError -> Maybe ForwardFileError
forall a. a -> Maybe a
Just (ForwardFileError -> Maybe ForwardFileError)
-> ForwardFileError -> Maybe ForwardFileError
forall a b. (a -> b) -> a -> b
$ Int64 -> ForwardFileError
FFENotAccepted Int64
fId
  CIFileStatus d
CIFSRcvCancelled -> ForwardFileError -> Maybe ForwardFileError
forall a. a -> Maybe a
Just ForwardFileError
FFEFailed
  CIFileStatus d
CIFSRcvComplete -> Maybe ForwardFileError
forall a. Maybe a
Nothing
  CIFSRcvError {} -> ForwardFileError -> Maybe ForwardFileError
forall a. a -> Maybe a
Just ForwardFileError
FFEFailed
  CIFSRcvWarning {} -> ForwardFileError -> Maybe ForwardFileError
forall a. a -> Maybe a
Just ForwardFileError
FFEFailed
  CIFSInvalid {} -> ForwardFileError -> Maybe ForwardFileError
forall a. a -> Maybe a
Just ForwardFileError
FFEFailed

data ACIFileStatus = forall d. MsgDirectionI d => AFS (SMsgDirection d) (CIFileStatus d)

deriving instance Show ACIFileStatus

instance MsgDirectionI d => StrEncoding (CIFileStatus d) where
  strEncode :: CIFileStatus d -> ByteString
strEncode = \case
    CIFileStatus d
CIFSSndStored -> ByteString
"snd_stored"
    CIFSSndTransfer Int64
sent Int64
total -> (Str, Int64, Int64) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> Str
Str ByteString
"snd_transfer", Int64
sent, Int64
total)
    CIFileStatus d
CIFSSndCancelled -> ByteString
"snd_cancelled"
    CIFileStatus d
CIFSSndComplete -> ByteString
"snd_complete"
    CIFSSndError FileError
sndFileErr -> ByteString
"snd_error " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> FileError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode FileError
sndFileErr
    CIFSSndWarning FileError
sndFileErr -> ByteString
"snd_warning " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> FileError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode FileError
sndFileErr
    CIFileStatus d
CIFSRcvInvitation -> ByteString
"rcv_invitation"
    CIFileStatus d
CIFSRcvAccepted -> ByteString
"rcv_accepted"
    CIFSRcvTransfer Int64
rcvd Int64
total -> (Str, Int64, Int64) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> Str
Str ByteString
"rcv_transfer", Int64
rcvd, Int64
total)
    CIFileStatus d
CIFSRcvAborted -> ByteString
"rcv_aborted"
    CIFileStatus d
CIFSRcvComplete -> ByteString
"rcv_complete"
    CIFileStatus d
CIFSRcvCancelled -> ByteString
"rcv_cancelled"
    CIFSRcvError FileError
rcvFileErr -> ByteString
"rcv_error " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> FileError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode FileError
rcvFileErr
    CIFSRcvWarning FileError
rcvFileErr -> ByteString
"rcv_warning " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> FileError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode FileError
rcvFileErr
    CIFSInvalid {} -> ByteString
"invalid"
  strP :: Parser (CIFileStatus d)
strP = (\(AFS SMsgDirection d
_ CIFileStatus d
st) -> CIFileStatus d -> Either String (CIFileStatus d)
forall (t :: MsgDirection -> *) (d :: MsgDirection)
       (d' :: MsgDirection).
(MsgDirectionI d, MsgDirectionI d') =>
t d' -> Either String (t d)
checkDirection CIFileStatus d
st) (ACIFileStatus -> Either String (CIFileStatus d))
-> Parser ByteString ACIFileStatus -> Parser (CIFileStatus d)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ACIFileStatus
forall a. StrEncoding a => Parser a
strP

instance StrEncoding ACIFileStatus where
  strEncode :: ACIFileStatus -> ByteString
strEncode (AFS SMsgDirection d
_ CIFileStatus d
s) = CIFileStatus d -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode CIFileStatus d
s
  strP :: Parser ByteString ACIFileStatus
strP =
    (Parser ByteString ACIFileStatus
statusP Parser ByteString ACIFileStatus
-> Parser ByteString () -> Parser ByteString ACIFileStatus
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput) -- endOfInput to make it fail on partial correct parse
      Parser ByteString ACIFileStatus
-> Parser ByteString ACIFileStatus
-> Parser ByteString ACIFileStatus
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd (CIFileStatus 'MDSnd -> ACIFileStatus)
-> (ByteString -> CIFileStatus 'MDSnd)
-> ByteString
-> ACIFileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CIFileStatus 'MDSnd
CIFSInvalid (Text -> CIFileStatus 'MDSnd)
-> (ByteString -> Text) -> ByteString -> CIFileStatus 'MDSnd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> ACIFileStatus)
-> Parser ByteString ByteString -> Parser ByteString ACIFileStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
A.takeByteString)
    where
      statusP :: Parser ByteString ACIFileStatus
statusP =
        (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString ByteString
-> (ByteString -> Parser ByteString ACIFileStatus)
-> Parser ByteString ACIFileStatus
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
"snd_stored" -> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIFileStatus -> Parser ByteString ACIFileStatus)
-> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd CIFileStatus 'MDSnd
CIFSSndStored
          ByteString
"snd_transfer" -> SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd (CIFileStatus 'MDSnd -> ACIFileStatus)
-> Parser ByteString (CIFileStatus 'MDSnd)
-> Parser ByteString ACIFileStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> Int64 -> CIFileStatus 'MDSnd)
-> Parser ByteString (CIFileStatus 'MDSnd)
forall a. (Int64 -> Int64 -> a) -> Parser a
progress Int64 -> Int64 -> CIFileStatus 'MDSnd
CIFSSndTransfer
          ByteString
"snd_cancelled" -> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIFileStatus -> Parser ByteString ACIFileStatus)
-> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd CIFileStatus 'MDSnd
CIFSSndCancelled
          ByteString
"snd_complete" -> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIFileStatus -> Parser ByteString ACIFileStatus)
-> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd CIFileStatus 'MDSnd
CIFSSndComplete
          ByteString
"snd_error" -> SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd (CIFileStatus 'MDSnd -> ACIFileStatus)
-> (FileError -> CIFileStatus 'MDSnd) -> FileError -> ACIFileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError -> CIFileStatus 'MDSnd
CIFSSndError (FileError -> ACIFileStatus)
-> Parser ByteString FileError -> Parser ByteString ACIFileStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser Char
A.space Parser Char
-> Parser ByteString FileError -> Parser ByteString FileError
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString FileError
forall a. StrEncoding a => Parser a
strP) Parser ByteString FileError
-> Parser ByteString FileError -> Parser ByteString FileError
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FileError -> Parser ByteString FileError
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> FileError
FileErrOther Text
"")) -- alternative for backwards compatibility
          ByteString
"snd_warning" -> SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd (CIFileStatus 'MDSnd -> ACIFileStatus)
-> (FileError -> CIFileStatus 'MDSnd) -> FileError -> ACIFileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError -> CIFileStatus 'MDSnd
CIFSSndWarning (FileError -> ACIFileStatus)
-> Parser ByteString FileError -> Parser ByteString ACIFileStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString FileError -> Parser ByteString FileError
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString FileError
forall a. StrEncoding a => Parser a
strP)
          ByteString
"rcv_invitation" -> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIFileStatus -> Parser ByteString ACIFileStatus)
-> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv CIFileStatus 'MDRcv
CIFSRcvInvitation
          ByteString
"rcv_accepted" -> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIFileStatus -> Parser ByteString ACIFileStatus)
-> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv CIFileStatus 'MDRcv
CIFSRcvAccepted
          ByteString
"rcv_transfer" -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv (CIFileStatus 'MDRcv -> ACIFileStatus)
-> Parser ByteString (CIFileStatus 'MDRcv)
-> Parser ByteString ACIFileStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> Int64 -> CIFileStatus 'MDRcv)
-> Parser ByteString (CIFileStatus 'MDRcv)
forall a. (Int64 -> Int64 -> a) -> Parser a
progress Int64 -> Int64 -> CIFileStatus 'MDRcv
CIFSRcvTransfer
          ByteString
"rcv_aborted" -> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIFileStatus -> Parser ByteString ACIFileStatus)
-> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv CIFileStatus 'MDRcv
CIFSRcvAborted
          ByteString
"rcv_complete" -> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIFileStatus -> Parser ByteString ACIFileStatus)
-> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv CIFileStatus 'MDRcv
CIFSRcvComplete
          ByteString
"rcv_cancelled" -> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIFileStatus -> Parser ByteString ACIFileStatus)
-> ACIFileStatus -> Parser ByteString ACIFileStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv CIFileStatus 'MDRcv
CIFSRcvCancelled
          ByteString
"rcv_error" -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv (CIFileStatus 'MDRcv -> ACIFileStatus)
-> (FileError -> CIFileStatus 'MDRcv) -> FileError -> ACIFileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError -> CIFileStatus 'MDRcv
CIFSRcvError (FileError -> ACIFileStatus)
-> Parser ByteString FileError -> Parser ByteString ACIFileStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser Char
A.space Parser Char
-> Parser ByteString FileError -> Parser ByteString FileError
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString FileError
forall a. StrEncoding a => Parser a
strP) Parser ByteString FileError
-> Parser ByteString FileError -> Parser ByteString FileError
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FileError -> Parser ByteString FileError
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> FileError
FileErrOther Text
"")) -- alternative for backwards compatibility
          ByteString
"rcv_warning" -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv (CIFileStatus 'MDRcv -> ACIFileStatus)
-> (FileError -> CIFileStatus 'MDRcv) -> FileError -> ACIFileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError -> CIFileStatus 'MDRcv
CIFSRcvWarning (FileError -> ACIFileStatus)
-> Parser ByteString FileError -> Parser ByteString ACIFileStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString FileError -> Parser ByteString FileError
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString FileError
forall a. StrEncoding a => Parser a
strP)
          ByteString
_ -> String -> Parser ByteString ACIFileStatus
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad file status"
      progress :: (Int64 -> Int64 -> a) -> A.Parser a
      progress :: forall a. (Int64 -> Int64 -> a) -> Parser a
progress Int64 -> Int64 -> a
f = Int64 -> Int64 -> a
f (Int64 -> Int64 -> a)
-> Parser ByteString Int64 -> Parser ByteString (Int64 -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
num Parser ByteString (Int64 -> a)
-> Parser ByteString Int64 -> Parser ByteString a
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
<*> Parser ByteString Int64
num Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Parser ByteString a
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Int64 -> a
f Int64
0 Int64
1)
      num :: Parser ByteString Int64
num = Parser Char
A.space Parser Char -> Parser ByteString Int64 -> Parser ByteString Int64
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal

data JSONCIFileStatus
  = JCIFSSndStored
  | JCIFSSndTransfer {JSONCIFileStatus -> Int64
sndProgress :: Int64, JSONCIFileStatus -> Int64
sndTotal :: Int64}
  | JCIFSSndCancelled
  | JCIFSSndComplete
  | JCIFSSndError {JSONCIFileStatus -> FileError
sndFileError :: FileError}
  | JCIFSSndWarning {sndFileError :: FileError}
  | JCIFSRcvInvitation
  | JCIFSRcvAccepted
  | JCIFSRcvTransfer {JSONCIFileStatus -> Int64
rcvProgress :: Int64, JSONCIFileStatus -> Int64
rcvTotal :: Int64}
  | JCIFSRcvAborted
  | JCIFSRcvComplete
  | JCIFSRcvCancelled
  | JCIFSRcvError {JSONCIFileStatus -> FileError
rcvFileError :: FileError}
  | JCIFSRcvWarning {rcvFileError :: FileError}
  | JCIFSInvalid {JSONCIFileStatus -> Text
text :: Text}

jsonCIFileStatus :: CIFileStatus d -> JSONCIFileStatus
jsonCIFileStatus :: forall (d :: MsgDirection). CIFileStatus d -> JSONCIFileStatus
jsonCIFileStatus = \case
  CIFileStatus d
CIFSSndStored -> JSONCIFileStatus
JCIFSSndStored
  CIFSSndTransfer Int64
sent Int64
total -> Int64 -> Int64 -> JSONCIFileStatus
JCIFSSndTransfer Int64
sent Int64
total
  CIFileStatus d
CIFSSndCancelled -> JSONCIFileStatus
JCIFSSndCancelled
  CIFileStatus d
CIFSSndComplete -> JSONCIFileStatus
JCIFSSndComplete
  CIFSSndError FileError
sndFileErr -> FileError -> JSONCIFileStatus
JCIFSSndError FileError
sndFileErr
  CIFSSndWarning FileError
sndFileErr -> FileError -> JSONCIFileStatus
JCIFSSndWarning FileError
sndFileErr
  CIFileStatus d
CIFSRcvInvitation -> JSONCIFileStatus
JCIFSRcvInvitation
  CIFileStatus d
CIFSRcvAccepted -> JSONCIFileStatus
JCIFSRcvAccepted
  CIFSRcvTransfer Int64
rcvd Int64
total -> Int64 -> Int64 -> JSONCIFileStatus
JCIFSRcvTransfer Int64
rcvd Int64
total
  CIFileStatus d
CIFSRcvAborted -> JSONCIFileStatus
JCIFSRcvAborted
  CIFileStatus d
CIFSRcvComplete -> JSONCIFileStatus
JCIFSRcvComplete
  CIFileStatus d
CIFSRcvCancelled -> JSONCIFileStatus
JCIFSRcvCancelled
  CIFSRcvError FileError
rcvFileErr -> FileError -> JSONCIFileStatus
JCIFSRcvError FileError
rcvFileErr
  CIFSRcvWarning FileError
rcvFileErr -> FileError -> JSONCIFileStatus
JCIFSRcvWarning FileError
rcvFileErr
  CIFSInvalid Text
text -> Text -> JSONCIFileStatus
JCIFSInvalid Text
text

aciFileStatusJSON :: JSONCIFileStatus -> ACIFileStatus
aciFileStatusJSON :: JSONCIFileStatus -> ACIFileStatus
aciFileStatusJSON = \case
  JSONCIFileStatus
JCIFSSndStored -> SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd CIFileStatus 'MDSnd
CIFSSndStored
  JCIFSSndTransfer Int64
sent Int64
total -> SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd (CIFileStatus 'MDSnd -> ACIFileStatus)
-> CIFileStatus 'MDSnd -> ACIFileStatus
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> CIFileStatus 'MDSnd
CIFSSndTransfer Int64
sent Int64
total
  JSONCIFileStatus
JCIFSSndCancelled -> SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd CIFileStatus 'MDSnd
CIFSSndCancelled
  JSONCIFileStatus
JCIFSSndComplete -> SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd CIFileStatus 'MDSnd
CIFSSndComplete
  JCIFSSndError FileError
sndFileErr -> SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd (FileError -> CIFileStatus 'MDSnd
CIFSSndError FileError
sndFileErr)
  JCIFSSndWarning FileError
sndFileErr -> SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd (FileError -> CIFileStatus 'MDSnd
CIFSSndWarning FileError
sndFileErr)
  JSONCIFileStatus
JCIFSRcvInvitation -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv CIFileStatus 'MDRcv
CIFSRcvInvitation
  JSONCIFileStatus
JCIFSRcvAccepted -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv CIFileStatus 'MDRcv
CIFSRcvAccepted
  JCIFSRcvTransfer Int64
rcvd Int64
total -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv (CIFileStatus 'MDRcv -> ACIFileStatus)
-> CIFileStatus 'MDRcv -> ACIFileStatus
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> CIFileStatus 'MDRcv
CIFSRcvTransfer Int64
rcvd Int64
total
  JSONCIFileStatus
JCIFSRcvAborted -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv CIFileStatus 'MDRcv
CIFSRcvAborted
  JSONCIFileStatus
JCIFSRcvComplete -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv CIFileStatus 'MDRcv
CIFSRcvComplete
  JSONCIFileStatus
JCIFSRcvCancelled -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv CIFileStatus 'MDRcv
CIFSRcvCancelled
  JCIFSRcvError FileError
rcvFileErr -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv (FileError -> CIFileStatus 'MDRcv
CIFSRcvError FileError
rcvFileErr)
  JCIFSRcvWarning FileError
rcvFileErr -> SMsgDirection 'MDRcv -> CIFileStatus 'MDRcv -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDRcv
SMDRcv (FileError -> CIFileStatus 'MDRcv
CIFSRcvWarning FileError
rcvFileErr)
  JCIFSInvalid Text
text -> SMsgDirection 'MDSnd -> CIFileStatus 'MDSnd -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection 'MDSnd
SMDSnd (CIFileStatus 'MDSnd -> ACIFileStatus)
-> CIFileStatus 'MDSnd -> ACIFileStatus
forall a b. (a -> b) -> a -> b
$ Text -> CIFileStatus 'MDSnd
CIFSInvalid Text
text

data FileError
  = FileErrAuth
  | FileErrBlocked {FileError -> String
server :: String, FileError -> BlockingInfo
blockInfo :: BlockingInfo}
  | FileErrNoFile
  | FileErrRelay {FileError -> SrvError
srvError :: SrvError}
  | FileErrOther {FileError -> Text
fileError :: Text}
  deriving (FileError -> FileError -> Bool
(FileError -> FileError -> Bool)
-> (FileError -> FileError -> Bool) -> Eq FileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileError -> FileError -> Bool
== :: FileError -> FileError -> Bool
$c/= :: FileError -> FileError -> Bool
/= :: FileError -> FileError -> Bool
Eq, Int -> FileError -> ShowS
[FileError] -> ShowS
FileError -> String
(Int -> FileError -> ShowS)
-> (FileError -> String)
-> ([FileError] -> ShowS)
-> Show FileError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileError -> ShowS
showsPrec :: Int -> FileError -> ShowS
$cshow :: FileError -> String
show :: FileError -> String
$cshowList :: [FileError] -> ShowS
showList :: [FileError] -> ShowS
Show)

instance StrEncoding FileError where
  strEncode :: FileError -> ByteString
strEncode = \case
    FileError
FileErrAuth -> ByteString
"auth"
    FileErrBlocked String
srv BlockingInfo
info -> ByteString
"blocked " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String, BlockingInfo) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (String
srv, BlockingInfo
info)
    FileError
FileErrNoFile -> ByteString
"no_file"
    FileErrRelay SrvError
srvErr -> ByteString
"relay " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SrvError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SrvError
srvErr
    FileErrOther Text
e -> ByteString
"other " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
e
  strP :: Parser ByteString FileError
strP =
    (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Parser ByteString ByteString
-> (ByteString -> Parser ByteString FileError)
-> Parser ByteString FileError
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
"auth" -> FileError -> Parser ByteString FileError
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileError
FileErrAuth
      ByteString
"blocked" -> String -> BlockingInfo -> FileError
FileErrBlocked (String -> BlockingInfo -> FileError)
-> Parser ByteString String
-> Parser ByteString (BlockingInfo -> FileError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String
forall a. StrEncoding a => Parser a
_strP Parser ByteString (BlockingInfo -> FileError)
-> Parser ByteString BlockingInfo -> Parser ByteString FileError
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
<*> Parser ByteString BlockingInfo
forall a. StrEncoding a => Parser a
_strP
      ByteString
"no_file" -> FileError -> Parser ByteString FileError
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileError
FileErrNoFile
      ByteString
"relay" -> SrvError -> FileError
FileErrRelay (SrvError -> FileError)
-> Parser ByteString SrvError -> Parser ByteString FileError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SrvError
forall a. StrEncoding a => Parser a
_strP
      ByteString
"other" -> Text -> FileError
FileErrOther (Text -> FileError)
-> (ByteString -> Text) -> ByteString -> FileError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> FileError)
-> Parser ByteString ByteString -> Parser ByteString FileError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
A.takeByteString)
      ByteString
s -> Text -> FileError
FileErrOther (Text -> FileError)
-> (ByteString -> Text) -> ByteString -> FileError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> FileError)
-> Parser ByteString ByteString -> Parser ByteString FileError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
A.takeByteString

-- to conveniently read file data from db
data CIFileInfo = CIFileInfo
  { CIFileInfo -> Int64
fileId :: Int64,
    CIFileInfo -> Maybe ACIFileStatus
fileStatus :: Maybe ACIFileStatus,
    CIFileInfo -> Maybe String
filePath :: Maybe FilePath
  }
  deriving (Int -> CIFileInfo -> ShowS
[CIFileInfo] -> ShowS
CIFileInfo -> String
(Int -> CIFileInfo -> ShowS)
-> (CIFileInfo -> String)
-> ([CIFileInfo] -> ShowS)
-> Show CIFileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIFileInfo -> ShowS
showsPrec :: Int -> CIFileInfo -> ShowS
$cshow :: CIFileInfo -> String
show :: CIFileInfo -> String
$cshowList :: [CIFileInfo] -> ShowS
showList :: [CIFileInfo] -> ShowS
Show)

mkCIFileInfo :: MsgDirectionI d => CIFile d -> CIFileInfo
mkCIFileInfo :: forall (d :: MsgDirection).
MsgDirectionI d =>
CIFile d -> CIFileInfo
mkCIFileInfo CIFile {Int64
fileId :: forall (d :: MsgDirection). CIFile d -> Int64
fileId :: Int64
fileId, CIFileStatus d
fileStatus :: forall (d :: MsgDirection). CIFile d -> CIFileStatus d
fileStatus :: CIFileStatus d
fileStatus, Maybe CryptoFile
fileSource :: forall (d :: MsgDirection). CIFile d -> Maybe CryptoFile
fileSource :: Maybe CryptoFile
fileSource} =
  CIFileInfo
    { Int64
fileId :: Int64
fileId :: Int64
fileId,
      fileStatus :: Maybe ACIFileStatus
fileStatus = ACIFileStatus -> Maybe ACIFileStatus
forall a. a -> Maybe a
Just (ACIFileStatus -> Maybe ACIFileStatus)
-> ACIFileStatus -> Maybe ACIFileStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection d -> CIFileStatus d -> ACIFileStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIFileStatus d -> ACIFileStatus
AFS SMsgDirection d
forall (d :: MsgDirection). MsgDirectionI d => SMsgDirection d
msgDirection CIFileStatus d
fileStatus,
      filePath :: Maybe String
filePath = CryptoFile -> String
CF.filePath (CryptoFile -> String) -> Maybe CryptoFile -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CryptoFile
fileSource
    }

data CIStatus (d :: MsgDirection) where
  CISSndNew :: CIStatus 'MDSnd
  CISSndSent :: SndCIStatusProgress -> CIStatus 'MDSnd
  CISSndRcvd :: MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd
  CISSndErrorAuth :: CIStatus 'MDSnd -- deprecated
  CISSndError :: SndError -> CIStatus 'MDSnd
  CISSndWarning :: SndError -> CIStatus 'MDSnd
  CISRcvNew :: CIStatus 'MDRcv
  CISRcvRead :: CIStatus 'MDRcv
  CISInvalid :: Text -> CIStatus 'MDSnd

deriving instance Eq (CIStatus d)

deriving instance Show (CIStatus d)

data ACIStatus = forall d. MsgDirectionI d => ACIStatus (SMsgDirection d) (CIStatus d)

deriving instance Show ACIStatus

instance MsgDirectionI d => StrEncoding (CIStatus d) where
  strEncode :: CIStatus d -> ByteString
strEncode = \case
    CIStatus d
CISSndNew -> ByteString
"snd_new"
    CISSndSent SndCIStatusProgress
sndProgress -> ByteString
"snd_sent " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SndCIStatusProgress -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SndCIStatusProgress
sndProgress
    CISSndRcvd MsgReceiptStatus
msgRcptStatus SndCIStatusProgress
sndProgress -> ByteString
"snd_rcvd " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> MsgReceiptStatus -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode MsgReceiptStatus
msgRcptStatus ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SndCIStatusProgress -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SndCIStatusProgress
sndProgress
    CIStatus d
CISSndErrorAuth -> ByteString
"snd_error_auth"
    CISSndError SndError
sndErr -> ByteString
"snd_error " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SndError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SndError
sndErr
    CISSndWarning SndError
sndErr -> ByteString
"snd_warning " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SndError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SndError
sndErr
    CIStatus d
CISRcvNew -> ByteString
"rcv_new"
    CIStatus d
CISRcvRead -> ByteString
"rcv_read"
    CISInvalid {} -> ByteString
"invalid"
  strP :: Parser (CIStatus d)
strP = (\(ACIStatus SMsgDirection d
_ CIStatus d
st) -> CIStatus d -> Either String (CIStatus d)
forall (t :: MsgDirection -> *) (d :: MsgDirection)
       (d' :: MsgDirection).
(MsgDirectionI d, MsgDirectionI d') =>
t d' -> Either String (t d)
checkDirection CIStatus d
st) (ACIStatus -> Either String (CIStatus d))
-> Parser ByteString ACIStatus -> Parser (CIStatus d)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ACIStatus
forall a. StrEncoding a => Parser a
strP

instance StrEncoding ACIStatus where
  strEncode :: ACIStatus -> ByteString
strEncode (ACIStatus SMsgDirection d
_ CIStatus d
s) = CIStatus d -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode CIStatus d
s
  strP :: Parser ByteString ACIStatus
strP =
    (Parser ByteString ACIStatus
statusP Parser ByteString ACIStatus
-> Parser ByteString () -> Parser ByteString ACIStatus
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput) -- endOfInput to make it fail on partial correct parse, e.g. "snd_rcvd ok complete"
      Parser ByteString ACIStatus
-> Parser ByteString ACIStatus -> Parser ByteString ACIStatus
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd (CIStatus 'MDSnd -> ACIStatus)
-> (ByteString -> CIStatus 'MDSnd) -> ByteString -> ACIStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CIStatus 'MDSnd
CISInvalid (Text -> CIStatus 'MDSnd)
-> (ByteString -> Text) -> ByteString -> CIStatus 'MDSnd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> ACIStatus)
-> Parser ByteString ByteString -> Parser ByteString ACIStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
A.takeByteString)
    where
      statusP :: Parser ByteString ACIStatus
statusP =
        (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString ByteString
-> (ByteString -> Parser ByteString ACIStatus)
-> Parser ByteString ACIStatus
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
"snd_new" -> ACIStatus -> Parser ByteString ACIStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIStatus -> Parser ByteString ACIStatus)
-> ACIStatus -> Parser ByteString ACIStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd CIStatus 'MDSnd
CISSndNew
          ByteString
"snd_sent" -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd (CIStatus 'MDSnd -> ACIStatus)
-> (SndCIStatusProgress -> CIStatus 'MDSnd)
-> SndCIStatusProgress
-> ACIStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndCIStatusProgress -> CIStatus 'MDSnd
CISSndSent (SndCIStatusProgress -> ACIStatus)
-> Parser ByteString SndCIStatusProgress
-> Parser ByteString ACIStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser Char
A.space Parser Char
-> Parser ByteString SndCIStatusProgress
-> Parser ByteString SndCIStatusProgress
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SndCIStatusProgress
forall a. StrEncoding a => Parser a
strP) Parser ByteString SndCIStatusProgress
-> Parser ByteString SndCIStatusProgress
-> Parser ByteString SndCIStatusProgress
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SndCIStatusProgress -> Parser ByteString SndCIStatusProgress
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndCIStatusProgress
SSPComplete)
          ByteString
"snd_rcvd" -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd (CIStatus 'MDSnd -> ACIStatus)
-> Parser ByteString (CIStatus 'MDSnd)
-> Parser ByteString ACIStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd
CISSndRcvd (MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd)
-> Parser ByteString MsgReceiptStatus
-> Parser ByteString (SndCIStatusProgress -> CIStatus 'MDSnd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString MsgReceiptStatus
-> Parser ByteString MsgReceiptStatus
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString MsgReceiptStatus
forall a. StrEncoding a => Parser a
strP) Parser ByteString (SndCIStatusProgress -> CIStatus 'MDSnd)
-> Parser ByteString SndCIStatusProgress
-> Parser ByteString (CIStatus 'MDSnd)
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
<*> ((Parser Char
A.space Parser Char
-> Parser ByteString SndCIStatusProgress
-> Parser ByteString SndCIStatusProgress
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SndCIStatusProgress
forall a. StrEncoding a => Parser a
strP) Parser ByteString SndCIStatusProgress
-> Parser ByteString SndCIStatusProgress
-> Parser ByteString SndCIStatusProgress
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SndCIStatusProgress -> Parser ByteString SndCIStatusProgress
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndCIStatusProgress
SSPComplete))
          ByteString
"snd_error_auth" -> ACIStatus -> Parser ByteString ACIStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIStatus -> Parser ByteString ACIStatus)
-> ACIStatus -> Parser ByteString ACIStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd CIStatus 'MDSnd
CISSndErrorAuth
          ByteString
"snd_error" -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd (CIStatus 'MDSnd -> ACIStatus)
-> (SndError -> CIStatus 'MDSnd) -> SndError -> ACIStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndError -> CIStatus 'MDSnd
CISSndError (SndError -> ACIStatus)
-> Parser ByteString SndError -> Parser ByteString ACIStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString SndError -> Parser ByteString SndError
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SndError
forall a. StrEncoding a => Parser a
strP)
          ByteString
"snd_warning" -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd (CIStatus 'MDSnd -> ACIStatus)
-> (SndError -> CIStatus 'MDSnd) -> SndError -> ACIStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndError -> CIStatus 'MDSnd
CISSndWarning (SndError -> ACIStatus)
-> Parser ByteString SndError -> Parser ByteString ACIStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString SndError -> Parser ByteString SndError
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SndError
forall a. StrEncoding a => Parser a
strP)
          ByteString
"rcv_new" -> ACIStatus -> Parser ByteString ACIStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIStatus -> Parser ByteString ACIStatus)
-> ACIStatus -> Parser ByteString ACIStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv -> CIStatus 'MDRcv -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDRcv
SMDRcv CIStatus 'MDRcv
CISRcvNew
          ByteString
"rcv_read" -> ACIStatus -> Parser ByteString ACIStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIStatus -> Parser ByteString ACIStatus)
-> ACIStatus -> Parser ByteString ACIStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv -> CIStatus 'MDRcv -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDRcv
SMDRcv CIStatus 'MDRcv
CISRcvRead
          ByteString
_ -> String -> Parser ByteString ACIStatus
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad status"

-- see serverHostError in agent
data SndError
  = SndErrAuth
  | SndErrQuota
  | SndErrExpired -- TIMEOUT/NETWORK errors
  | SndErrRelay {SndError -> SrvError
srvError :: SrvError} -- BROKER errors (other than TIMEOUT/NETWORK)
  | SndErrProxy {SndError -> String
proxyServer :: String, srvError :: SrvError} -- SMP PROXY errors
  | SndErrProxyRelay {proxyServer :: String, srvError :: SrvError} -- PROXY BROKER errors
  | SndErrOther {SndError -> Text
sndError :: Text} -- other errors
  deriving (SndError -> SndError -> Bool
(SndError -> SndError -> Bool)
-> (SndError -> SndError -> Bool) -> Eq SndError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SndError -> SndError -> Bool
== :: SndError -> SndError -> Bool
$c/= :: SndError -> SndError -> Bool
/= :: SndError -> SndError -> Bool
Eq, Int -> SndError -> ShowS
[SndError] -> ShowS
SndError -> String
(Int -> SndError -> ShowS)
-> (SndError -> String) -> ([SndError] -> ShowS) -> Show SndError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SndError -> ShowS
showsPrec :: Int -> SndError -> ShowS
$cshow :: SndError -> String
show :: SndError -> String
$cshowList :: [SndError] -> ShowS
showList :: [SndError] -> ShowS
Show)

data SrvError
  = SrvErrHost
  | SrvErrVersion
  | SrvErrOther {SrvError -> Text
srvError :: Text}
  deriving (SrvError -> SrvError -> Bool
(SrvError -> SrvError -> Bool)
-> (SrvError -> SrvError -> Bool) -> Eq SrvError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrvError -> SrvError -> Bool
== :: SrvError -> SrvError -> Bool
$c/= :: SrvError -> SrvError -> Bool
/= :: SrvError -> SrvError -> Bool
Eq, Int -> SrvError -> ShowS
[SrvError] -> ShowS
SrvError -> String
(Int -> SrvError -> ShowS)
-> (SrvError -> String) -> ([SrvError] -> ShowS) -> Show SrvError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SrvError -> ShowS
showsPrec :: Int -> SrvError -> ShowS
$cshow :: SrvError -> String
show :: SrvError -> String
$cshowList :: [SrvError] -> ShowS
showList :: [SrvError] -> ShowS
Show)

instance StrEncoding SndError where
  strEncode :: SndError -> ByteString
strEncode = \case
    SndError
SndErrAuth -> ByteString
"auth"
    SndError
SndErrQuota -> ByteString
"quota"
    SndError
SndErrExpired -> ByteString
"expired"
    SndErrRelay SrvError
srvErr -> ByteString
"relay " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SrvError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SrvError
srvErr
    SndErrProxy String
proxy SrvError
srvErr -> ByteString
"proxy " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 (String -> Text
T.pack String
proxy) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SrvError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SrvError
srvErr
    SndErrProxyRelay String
proxy SrvError
srvErr -> ByteString
"proxy_relay " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 (String -> Text
T.pack String
proxy) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SrvError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SrvError
srvErr
    SndErrOther Text
e -> ByteString
"other " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
e
  strP :: Parser ByteString SndError
strP =
    (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Parser ByteString ByteString
-> (ByteString -> Parser ByteString SndError)
-> Parser ByteString SndError
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
"auth" -> SndError -> Parser ByteString SndError
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndError
SndErrAuth
      ByteString
"quota" -> SndError -> Parser ByteString SndError
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndError
SndErrQuota
      ByteString
"expired" -> SndError -> Parser ByteString SndError
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndError
SndErrExpired
      ByteString
"relay" -> SrvError -> SndError
SndErrRelay (SrvError -> SndError)
-> Parser ByteString SrvError -> Parser ByteString SndError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString SrvError -> Parser ByteString SrvError
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SrvError
forall a. StrEncoding a => Parser a
strP)
      ByteString
"proxy" -> String -> SrvError -> SndError
SndErrProxy (String -> SrvError -> SndError)
-> (ByteString -> String) -> ByteString -> SrvError -> SndError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> SrvError -> SndError)
-> Parser ByteString ByteString
-> Parser ByteString (SrvError -> SndError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Parser ByteString ByteString
-> Parser Char -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
A.space) Parser ByteString (SrvError -> SndError)
-> Parser ByteString SrvError -> Parser ByteString SndError
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
<*> Parser ByteString SrvError
forall a. StrEncoding a => Parser a
strP
      ByteString
"proxy_relay" -> String -> SrvError -> SndError
SndErrProxyRelay (String -> SrvError -> SndError)
-> (ByteString -> String) -> ByteString -> SrvError -> SndError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> SrvError -> SndError)
-> Parser ByteString ByteString
-> Parser ByteString (SrvError -> SndError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Parser ByteString ByteString
-> Parser Char -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
A.space) Parser ByteString (SrvError -> SndError)
-> Parser ByteString SrvError -> Parser ByteString SndError
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
<*> Parser ByteString SrvError
forall a. StrEncoding a => Parser a
strP
      ByteString
"other" -> Text -> SndError
SndErrOther (Text -> SndError)
-> (ByteString -> Text) -> ByteString -> SndError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> SndError)
-> Parser ByteString ByteString -> Parser ByteString SndError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
A.takeByteString)
      ByteString
s -> Text -> SndError
SndErrOther (Text -> SndError)
-> (ByteString -> Text) -> ByteString -> SndError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> SndError)
-> Parser ByteString ByteString -> Parser ByteString SndError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
A.takeByteString -- for backward compatibility with `CISSndError String`

instance StrEncoding SrvError where
  strEncode :: SrvError -> ByteString
strEncode = \case
    SrvError
SrvErrHost -> ByteString
"host"
    SrvError
SrvErrVersion -> ByteString
"version"
    SrvErrOther Text
e -> ByteString
"other " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
e
  strP :: Parser ByteString SrvError
strP =
    (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Parser ByteString ByteString
-> (ByteString -> Parser ByteString SrvError)
-> Parser ByteString SrvError
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
"host" -> SrvError -> Parser ByteString SrvError
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrvError
SrvErrHost
      ByteString
"version" -> SrvError -> Parser ByteString SrvError
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrvError
SrvErrVersion
      ByteString
"other" -> Text -> SrvError
SrvErrOther (Text -> SrvError)
-> (ByteString -> Text) -> ByteString -> SrvError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> SrvError)
-> Parser ByteString ByteString -> Parser ByteString SrvError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
A.takeByteString)
      ByteString
_ -> String -> Parser ByteString SrvError
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad SrvError"

data JSONCIStatus
  = JCISSndNew
  | JCISSndSent {JSONCIStatus -> SndCIStatusProgress
sndProgress :: SndCIStatusProgress}
  | JCISSndRcvd {JSONCIStatus -> MsgReceiptStatus
msgRcptStatus :: MsgReceiptStatus, sndProgress :: SndCIStatusProgress}
  | JCISSndErrorAuth -- deprecated
  | JCISSndError {JSONCIStatus -> SndError
agentError :: SndError}
  | JCISSndWarning {agentError :: SndError}
  | JCISRcvNew
  | JCISRcvRead
  | JCISInvalid {JSONCIStatus -> Text
text :: Text}
  deriving (Int -> JSONCIStatus -> ShowS
[JSONCIStatus] -> ShowS
JSONCIStatus -> String
(Int -> JSONCIStatus -> ShowS)
-> (JSONCIStatus -> String)
-> ([JSONCIStatus] -> ShowS)
-> Show JSONCIStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONCIStatus -> ShowS
showsPrec :: Int -> JSONCIStatus -> ShowS
$cshow :: JSONCIStatus -> String
show :: JSONCIStatus -> String
$cshowList :: [JSONCIStatus] -> ShowS
showList :: [JSONCIStatus] -> ShowS
Show)

jsonCIStatus :: CIStatus d -> JSONCIStatus
jsonCIStatus :: forall (d :: MsgDirection). CIStatus d -> JSONCIStatus
jsonCIStatus = \case
  CIStatus d
CISSndNew -> JSONCIStatus
JCISSndNew
  CISSndSent SndCIStatusProgress
sndProgress -> SndCIStatusProgress -> JSONCIStatus
JCISSndSent SndCIStatusProgress
sndProgress
  CISSndRcvd MsgReceiptStatus
msgRcptStatus SndCIStatusProgress
sndProgress -> MsgReceiptStatus -> SndCIStatusProgress -> JSONCIStatus
JCISSndRcvd MsgReceiptStatus
msgRcptStatus SndCIStatusProgress
sndProgress
  CIStatus d
CISSndErrorAuth -> JSONCIStatus
JCISSndErrorAuth
  CISSndError SndError
sndErr -> SndError -> JSONCIStatus
JCISSndError SndError
sndErr
  CISSndWarning SndError
sndErr -> SndError -> JSONCIStatus
JCISSndWarning SndError
sndErr
  CIStatus d
CISRcvNew -> JSONCIStatus
JCISRcvNew
  CIStatus d
CISRcvRead -> JSONCIStatus
JCISRcvRead
  CISInvalid Text
text -> Text -> JSONCIStatus
JCISInvalid Text
text

jsonACIStatus :: JSONCIStatus -> ACIStatus
jsonACIStatus :: JSONCIStatus -> ACIStatus
jsonACIStatus = \case
  JSONCIStatus
JCISSndNew -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd CIStatus 'MDSnd
CISSndNew
  JCISSndSent SndCIStatusProgress
sndProgress -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd (CIStatus 'MDSnd -> ACIStatus) -> CIStatus 'MDSnd -> ACIStatus
forall a b. (a -> b) -> a -> b
$ SndCIStatusProgress -> CIStatus 'MDSnd
CISSndSent SndCIStatusProgress
sndProgress
  JCISSndRcvd MsgReceiptStatus
msgRcptStatus SndCIStatusProgress
sndProgress -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd (CIStatus 'MDSnd -> ACIStatus) -> CIStatus 'MDSnd -> ACIStatus
forall a b. (a -> b) -> a -> b
$ MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd
CISSndRcvd MsgReceiptStatus
msgRcptStatus SndCIStatusProgress
sndProgress
  JSONCIStatus
JCISSndErrorAuth -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd CIStatus 'MDSnd
CISSndErrorAuth
  JCISSndError SndError
sndErr -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd (CIStatus 'MDSnd -> ACIStatus) -> CIStatus 'MDSnd -> ACIStatus
forall a b. (a -> b) -> a -> b
$ SndError -> CIStatus 'MDSnd
CISSndError SndError
sndErr
  JCISSndWarning SndError
sndErr -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd (CIStatus 'MDSnd -> ACIStatus) -> CIStatus 'MDSnd -> ACIStatus
forall a b. (a -> b) -> a -> b
$ SndError -> CIStatus 'MDSnd
CISSndWarning SndError
sndErr
  JSONCIStatus
JCISRcvNew -> SMsgDirection 'MDRcv -> CIStatus 'MDRcv -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDRcv
SMDRcv CIStatus 'MDRcv
CISRcvNew
  JSONCIStatus
JCISRcvRead -> SMsgDirection 'MDRcv -> CIStatus 'MDRcv -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDRcv
SMDRcv CIStatus 'MDRcv
CISRcvRead
  JCISInvalid Text
text -> SMsgDirection 'MDSnd -> CIStatus 'MDSnd -> ACIStatus
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIStatus d -> ACIStatus
ACIStatus SMsgDirection 'MDSnd
SMDSnd (CIStatus 'MDSnd -> ACIStatus) -> CIStatus 'MDSnd -> ACIStatus
forall a b. (a -> b) -> a -> b
$ Text -> CIStatus 'MDSnd
CISInvalid Text
text

ciStatusNew :: forall d. MsgDirectionI d => CIStatus d
ciStatusNew :: forall (d :: MsgDirection). MsgDirectionI d => CIStatus d
ciStatusNew = case forall (d :: MsgDirection). MsgDirectionI d => SMsgDirection d
msgDirection @d of
  SMsgDirection d
SMDSnd -> CIStatus d
CIStatus 'MDSnd
CISSndNew
  SMsgDirection d
SMDRcv -> CIStatus d
CIStatus 'MDRcv
CISRcvNew

ciCreateStatus :: forall d. MsgDirectionI d => CIContent d -> CIStatus d
ciCreateStatus :: forall (d :: MsgDirection).
MsgDirectionI d =>
CIContent d -> CIStatus d
ciCreateStatus CIContent d
content = case forall (d :: MsgDirection). MsgDirectionI d => SMsgDirection d
msgDirection @d of
  SMsgDirection d
SMDSnd -> CIStatus d
forall (d :: MsgDirection). MsgDirectionI d => CIStatus d
ciStatusNew
  SMsgDirection d
SMDRcv
    | CIContent d -> Bool
forall (d :: MsgDirection). CIContent d -> Bool
isCIReport CIContent d
content -> CIStatus d
CIStatus 'MDRcv
CISRcvRead
    | CIContent d -> Bool
forall (d :: MsgDirection). MsgDirectionI d => CIContent d -> Bool
ciRequiresAttention CIContent d
content -> CIStatus d
forall (d :: MsgDirection). MsgDirectionI d => CIStatus d
ciStatusNew
    | Bool
otherwise -> CIStatus d
CIStatus 'MDRcv
CISRcvRead

membersGroupItemStatus :: [(GroupSndStatus, Int)] -> CIStatus 'MDSnd
membersGroupItemStatus :: [(GroupSndStatus, Int)] -> CIStatus 'MDSnd
membersGroupItemStatus [(GroupSndStatus, Int)]
memStatusCounts
  | Int
rcvdOk Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
total = MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd
CISSndRcvd MsgReceiptStatus
MROk SndCIStatusProgress
SSPComplete
  | Int
rcvdOk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rcvdBad Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
total = MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd
CISSndRcvd MsgReceiptStatus
MRBadMsgHash SndCIStatusProgress
SSPComplete
  | Int
rcvdBad Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd
CISSndRcvd MsgReceiptStatus
MRBadMsgHash SndCIStatusProgress
SSPPartial
  | Int
rcvdOk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd
CISSndRcvd MsgReceiptStatus
MROk SndCIStatusProgress
SSPPartial
  | Int
sent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
total = SndCIStatusProgress -> CIStatus 'MDSnd
CISSndSent SndCIStatusProgress
SSPComplete
  | Int
sent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = SndCIStatusProgress -> CIStatus 'MDSnd
CISSndSent SndCIStatusProgress
SSPPartial
  | Bool
otherwise = CIStatus 'MDSnd
CISSndNew
  where
    total :: Int
total = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((GroupSndStatus, Int) -> Int) -> [(GroupSndStatus, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (GroupSndStatus, Int) -> Int
forall a b. (a, b) -> b
snd [(GroupSndStatus, Int)]
memStatusCounts
    rcvdOk :: Int
rcvdOk = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ GroupSndStatus -> [(GroupSndStatus, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (MsgReceiptStatus -> GroupSndStatus
GSSRcvd MsgReceiptStatus
MROk) [(GroupSndStatus, Int)]
memStatusCounts
    rcvdBad :: Int
rcvdBad = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ GroupSndStatus -> [(GroupSndStatus, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (MsgReceiptStatus -> GroupSndStatus
GSSRcvd MsgReceiptStatus
MRBadMsgHash) [(GroupSndStatus, Int)]
memStatusCounts
    sent :: Int
sent = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ GroupSndStatus -> [(GroupSndStatus, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupSndStatus
GSSSent [(GroupSndStatus, Int)]
memStatusCounts

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

instance StrEncoding SndCIStatusProgress where
  strEncode :: SndCIStatusProgress -> ByteString
strEncode = \case
    SndCIStatusProgress
SSPPartial -> ByteString
"partial"
    SndCIStatusProgress
SSPComplete -> ByteString
"complete"
  strP :: Parser ByteString SndCIStatusProgress
strP =
    (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Parser ByteString ByteString
-> (ByteString -> Parser ByteString SndCIStatusProgress)
-> Parser ByteString SndCIStatusProgress
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
"partial" -> SndCIStatusProgress -> Parser ByteString SndCIStatusProgress
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndCIStatusProgress
SSPPartial
      ByteString
"complete" -> SndCIStatusProgress -> Parser ByteString SndCIStatusProgress
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndCIStatusProgress
SSPComplete
      ByteString
_ -> String -> Parser ByteString SndCIStatusProgress
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad SndCIStatusProgress"

data GroupSndStatus
  = GSSNew
  | GSSForwarded
  | GSSInactive
  | GSSSent
  | GSSRcvd {GroupSndStatus -> MsgReceiptStatus
msgRcptStatus :: MsgReceiptStatus}
  | GSSError {GroupSndStatus -> SndError
agentError :: SndError}
  | GSSWarning {agentError :: SndError}
  | GSSInvalid {GroupSndStatus -> Text
text :: Text}

deriving instance Eq GroupSndStatus

deriving instance Show GroupSndStatus

-- Preserve CIStatus encoding for backwards compatibility
instance StrEncoding GroupSndStatus where
  strEncode :: GroupSndStatus -> ByteString
strEncode = \case
    GroupSndStatus
GSSNew -> ByteString
"snd_new"
    GroupSndStatus
GSSForwarded -> ByteString
"snd_forwarded"
    GroupSndStatus
GSSInactive -> ByteString
"snd_inactive"
    GroupSndStatus
GSSSent -> ByteString
"snd_sent complete"
    GSSRcvd MsgReceiptStatus
msgRcptStatus -> ByteString
"snd_rcvd " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> MsgReceiptStatus -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode MsgReceiptStatus
msgRcptStatus ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" complete"
    GSSError SndError
sndErr -> ByteString
"snd_error " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SndError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SndError
sndErr
    GSSWarning SndError
sndErr -> ByteString
"snd_warning " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SndError -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SndError
sndErr
    GSSInvalid {} -> ByteString
"invalid"
  strP :: Parser GroupSndStatus
strP =
    (Parser GroupSndStatus
statusP Parser GroupSndStatus
-> Parser ByteString () -> Parser GroupSndStatus
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput) -- see ACIStatus decoding
      Parser GroupSndStatus
-> Parser GroupSndStatus -> Parser GroupSndStatus
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> GroupSndStatus
GSSInvalid (Text -> GroupSndStatus)
-> (ByteString -> Text) -> ByteString -> GroupSndStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> GroupSndStatus)
-> Parser ByteString ByteString -> Parser GroupSndStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
A.takeByteString)
    where
      statusP :: Parser GroupSndStatus
statusP =
        (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString ByteString
-> (ByteString -> Parser GroupSndStatus) -> Parser GroupSndStatus
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
"snd_new" -> GroupSndStatus -> Parser GroupSndStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupSndStatus
GSSNew
          ByteString
"snd_forwarded" -> GroupSndStatus -> Parser GroupSndStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupSndStatus
GSSForwarded
          ByteString
"snd_inactive" -> GroupSndStatus -> Parser GroupSndStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupSndStatus
GSSInactive
          ByteString
"snd_sent" -> GroupSndStatus
GSSSent GroupSndStatus
-> Parser ByteString ByteString -> Parser GroupSndStatus
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
" complete"
          ByteString
"snd_rcvd" -> MsgReceiptStatus -> GroupSndStatus
GSSRcvd (MsgReceiptStatus -> GroupSndStatus)
-> Parser ByteString MsgReceiptStatus -> Parser GroupSndStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString MsgReceiptStatus
forall a. StrEncoding a => Parser a
_strP Parser ByteString MsgReceiptStatus
-> Parser ByteString ByteString
-> Parser ByteString MsgReceiptStatus
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" complete")
          ByteString
"snd_error_auth" -> GroupSndStatus -> Parser GroupSndStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupSndStatus -> Parser GroupSndStatus)
-> GroupSndStatus -> Parser GroupSndStatus
forall a b. (a -> b) -> a -> b
$ SndError -> GroupSndStatus
GSSError SndError
SndErrAuth
          ByteString
"snd_error" -> SndError -> GroupSndStatus
GSSError (SndError -> GroupSndStatus)
-> Parser ByteString SndError -> Parser GroupSndStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString SndError -> Parser ByteString SndError
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SndError
forall a. StrEncoding a => Parser a
strP)
          ByteString
"snd_warning" -> SndError -> GroupSndStatus
GSSWarning (SndError -> GroupSndStatus)
-> Parser ByteString SndError -> Parser GroupSndStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString SndError -> Parser ByteString SndError
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SndError
forall a. StrEncoding a => Parser a
strP)
          ByteString
_ -> String -> Parser GroupSndStatus
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad status"

type ChatItemId = Int64

type ChatItemTs = UTCTime

data SndMessage = SndMessage
  { SndMessage -> Int64
msgId :: MessageId,
    SndMessage -> SharedMsgId
sharedMsgId :: SharedMsgId,
    SndMessage -> ByteString
msgBody :: MsgBody
  }
  deriving (Int -> SndMessage -> ShowS
[SndMessage] -> ShowS
SndMessage -> String
(Int -> SndMessage -> ShowS)
-> (SndMessage -> String)
-> ([SndMessage] -> ShowS)
-> Show SndMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SndMessage -> ShowS
showsPrec :: Int -> SndMessage -> ShowS
$cshow :: SndMessage -> String
show :: SndMessage -> String
$cshowList :: [SndMessage] -> ShowS
showList :: [SndMessage] -> ShowS
Show)

data NewRcvMessage e = NewRcvMessage
  { forall (e :: MsgEncoding). NewRcvMessage e -> ChatMsgEvent e
chatMsgEvent :: ChatMsgEvent e,
    forall (e :: MsgEncoding). NewRcvMessage e -> ByteString
msgBody :: MsgBody,
    forall (e :: MsgEncoding). NewRcvMessage e -> UTCTime
brokerTs :: UTCTime
  }
  deriving (Int -> NewRcvMessage e -> ShowS
[NewRcvMessage e] -> ShowS
NewRcvMessage e -> String
(Int -> NewRcvMessage e -> ShowS)
-> (NewRcvMessage e -> String)
-> ([NewRcvMessage e] -> ShowS)
-> Show (NewRcvMessage e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (e :: MsgEncoding). Int -> NewRcvMessage e -> ShowS
forall (e :: MsgEncoding). [NewRcvMessage e] -> ShowS
forall (e :: MsgEncoding). NewRcvMessage e -> String
$cshowsPrec :: forall (e :: MsgEncoding). Int -> NewRcvMessage e -> ShowS
showsPrec :: Int -> NewRcvMessage e -> ShowS
$cshow :: forall (e :: MsgEncoding). NewRcvMessage e -> String
show :: NewRcvMessage e -> String
$cshowList :: forall (e :: MsgEncoding). [NewRcvMessage e] -> ShowS
showList :: [NewRcvMessage e] -> ShowS
Show)

data RcvMessage = RcvMessage
  { RcvMessage -> Int64
msgId :: MessageId,
    RcvMessage -> AChatMsgEvent
chatMsgEvent :: AChatMsgEvent,
    RcvMessage -> Maybe SharedMsgId
sharedMsgId_ :: Maybe SharedMsgId,
    RcvMessage -> ByteString
msgBody :: MsgBody,
    RcvMessage -> Maybe Int64
authorMember :: Maybe GroupMemberId,
    RcvMessage -> Maybe Int64
forwardedByMember :: Maybe GroupMemberId
  }

type MessageId = Int64

data ConnOrGroupId = ConnectionId Int64 | GroupId Int64

data SndMsgDelivery = SndMsgDelivery
  { SndMsgDelivery -> Int64
connId :: Int64,
    SndMsgDelivery -> Int64
agentMsgId :: AgentMsgId
  }
  deriving (Int -> SndMsgDelivery -> ShowS
[SndMsgDelivery] -> ShowS
SndMsgDelivery -> String
(Int -> SndMsgDelivery -> ShowS)
-> (SndMsgDelivery -> String)
-> ([SndMsgDelivery] -> ShowS)
-> Show SndMsgDelivery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SndMsgDelivery -> ShowS
showsPrec :: Int -> SndMsgDelivery -> ShowS
$cshow :: SndMsgDelivery -> String
show :: SndMsgDelivery -> String
$cshowList :: [SndMsgDelivery] -> ShowS
showList :: [SndMsgDelivery] -> ShowS
Show)

data RcvMsgDelivery = RcvMsgDelivery
  { RcvMsgDelivery -> Int64
connId :: Int64,
    RcvMsgDelivery -> Int64
agentMsgId :: AgentMsgId,
    RcvMsgDelivery -> MsgMeta
agentMsgMeta :: MsgMeta
  }
  deriving (Int -> RcvMsgDelivery -> ShowS
[RcvMsgDelivery] -> ShowS
RcvMsgDelivery -> String
(Int -> RcvMsgDelivery -> ShowS)
-> (RcvMsgDelivery -> String)
-> ([RcvMsgDelivery] -> ShowS)
-> Show RcvMsgDelivery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RcvMsgDelivery -> ShowS
showsPrec :: Int -> RcvMsgDelivery -> ShowS
$cshow :: RcvMsgDelivery -> String
show :: RcvMsgDelivery -> String
$cshowList :: [RcvMsgDelivery] -> ShowS
showList :: [RcvMsgDelivery] -> ShowS
Show)

data RcvMsgInfo = RcvMsgInfo
  { RcvMsgInfo -> Int64
msgId :: Int64,
    RcvMsgInfo -> Int64
msgDeliveryId :: Int64,
    RcvMsgInfo -> Text
msgDeliveryStatus :: Text,
    RcvMsgInfo -> Int64
agentMsgId :: AgentMsgId,
    RcvMsgInfo -> Text
agentMsgMeta :: Text
  }
  deriving (Int -> RcvMsgInfo -> ShowS
[RcvMsgInfo] -> ShowS
RcvMsgInfo -> String
(Int -> RcvMsgInfo -> ShowS)
-> (RcvMsgInfo -> String)
-> ([RcvMsgInfo] -> ShowS)
-> Show RcvMsgInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RcvMsgInfo -> ShowS
showsPrec :: Int -> RcvMsgInfo -> ShowS
$cshow :: RcvMsgInfo -> String
show :: RcvMsgInfo -> String
$cshowList :: [RcvMsgInfo] -> ShowS
showList :: [RcvMsgInfo] -> ShowS
Show)

data MsgMetaJSON = MsgMetaJSON
  { MsgMetaJSON -> Text
integrity :: Text,
    MsgMetaJSON -> Int64
rcvId :: Int64,
    MsgMetaJSON -> UTCTime
rcvTs :: UTCTime,
    MsgMetaJSON -> Text
serverId :: Text,
    MsgMetaJSON -> UTCTime
serverTs :: UTCTime,
    MsgMetaJSON -> Int64
sndId :: Int64
  }
  deriving (MsgMetaJSON -> MsgMetaJSON -> Bool
(MsgMetaJSON -> MsgMetaJSON -> Bool)
-> (MsgMetaJSON -> MsgMetaJSON -> Bool) -> Eq MsgMetaJSON
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgMetaJSON -> MsgMetaJSON -> Bool
== :: MsgMetaJSON -> MsgMetaJSON -> Bool
$c/= :: MsgMetaJSON -> MsgMetaJSON -> Bool
/= :: MsgMetaJSON -> MsgMetaJSON -> Bool
Eq, Int -> MsgMetaJSON -> ShowS
[MsgMetaJSON] -> ShowS
MsgMetaJSON -> String
(Int -> MsgMetaJSON -> ShowS)
-> (MsgMetaJSON -> String)
-> ([MsgMetaJSON] -> ShowS)
-> Show MsgMetaJSON
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgMetaJSON -> ShowS
showsPrec :: Int -> MsgMetaJSON -> ShowS
$cshow :: MsgMetaJSON -> String
show :: MsgMetaJSON -> String
$cshowList :: [MsgMetaJSON] -> ShowS
showList :: [MsgMetaJSON] -> ShowS
Show)

msgMetaToJson :: MsgMeta -> MsgMetaJSON
msgMetaToJson :: MsgMeta -> MsgMetaJSON
msgMetaToJson MsgMeta {MsgIntegrity
integrity :: MsgIntegrity
integrity :: MsgMeta -> MsgIntegrity
integrity, recipient :: MsgMeta -> (Int64, UTCTime)
recipient = (Int64
rcvId, UTCTime
rcvTs), broker :: MsgMeta -> (ByteString, UTCTime)
broker = (ByteString
serverId, UTCTime
serverTs), sndMsgId :: MsgMeta -> Int64
sndMsgId = Int64
sndId} =
  MsgMetaJSON
    { integrity :: Text
integrity = (ByteString -> Text
decodeLatin1 (ByteString -> Text)
-> (MsgIntegrity -> ByteString) -> MsgIntegrity -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgIntegrity -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode) MsgIntegrity
integrity,
      Int64
rcvId :: Int64
rcvId :: Int64
rcvId,
      UTCTime
rcvTs :: UTCTime
rcvTs :: UTCTime
rcvTs,
      serverId :: Text
serverId = (ByteString -> Text
decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode) ByteString
serverId,
      UTCTime
serverTs :: UTCTime
serverTs :: UTCTime
serverTs,
      Int64
sndId :: Int64
sndId :: Int64
sndId
    }

data MsgDeliveryStatus (d :: MsgDirection) where
  MDSRcvAgent :: MsgDeliveryStatus 'MDRcv
  MDSRcvAcknowledged :: MsgDeliveryStatus 'MDRcv -- not used
  MDSSndPending :: MsgDeliveryStatus 'MDSnd
  MDSSndAgent :: MsgDeliveryStatus 'MDSnd
  MDSSndSent :: MsgDeliveryStatus 'MDSnd
  MDSSndRcvd :: MsgReceiptStatus -> MsgDeliveryStatus 'MDSnd
  MDSSndRead :: MsgDeliveryStatus 'MDSnd

data AMsgDeliveryStatus = forall d. AMDS (SMsgDirection d) (MsgDeliveryStatus d)

instance (Typeable d, MsgDirectionI d) => FromField (MsgDeliveryStatus d) where
  fromField :: FieldParser (MsgDeliveryStatus d)
fromField = (Text -> Maybe (MsgDeliveryStatus d))
-> FieldParser (MsgDeliveryStatus d)
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ Text -> Maybe (MsgDeliveryStatus d)
forall (d :: MsgDirection).
MsgDirectionI d =>
Text -> Maybe (MsgDeliveryStatus d)
msgDeliveryStatusT'

instance ToField (MsgDeliveryStatus d) where toField :: MsgDeliveryStatus d -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData)
-> (MsgDeliveryStatus d -> Text) -> MsgDeliveryStatus d -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgDeliveryStatus d -> Text
forall (d :: MsgDirection). MsgDeliveryStatus d -> Text
serializeMsgDeliveryStatus

serializeMsgDeliveryStatus :: MsgDeliveryStatus d -> Text
serializeMsgDeliveryStatus :: forall (d :: MsgDirection). MsgDeliveryStatus d -> Text
serializeMsgDeliveryStatus = \case
  MsgDeliveryStatus d
MDSRcvAgent -> Text
"rcv_agent"
  MsgDeliveryStatus d
MDSRcvAcknowledged -> Text
"rcv_acknowledged"
  MsgDeliveryStatus d
MDSSndPending -> Text
"snd_pending"
  MsgDeliveryStatus d
MDSSndAgent -> Text
"snd_agent"
  MsgDeliveryStatus d
MDSSndSent -> Text
"snd_sent"
  MDSSndRcvd MsgReceiptStatus
status -> Text
"snd_rcvd " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
safeDecodeUtf8 (MsgReceiptStatus -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode MsgReceiptStatus
status)
  MsgDeliveryStatus d
MDSSndRead -> Text
"snd_read"

msgDeliveryStatusT :: Text -> Maybe AMsgDeliveryStatus
msgDeliveryStatusT :: Text -> Maybe AMsgDeliveryStatus
msgDeliveryStatusT = Either String AMsgDeliveryStatus -> Maybe AMsgDeliveryStatus
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String AMsgDeliveryStatus -> Maybe AMsgDeliveryStatus)
-> (Text -> Either String AMsgDeliveryStatus)
-> Text
-> Maybe AMsgDeliveryStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser AMsgDeliveryStatus
-> ByteString -> Either String AMsgDeliveryStatus
forall a. Parser a -> ByteString -> Either String a
parseAll Parser AMsgDeliveryStatus
statusP (ByteString -> Either String AMsgDeliveryStatus)
-> (Text -> ByteString) -> Text -> Either String AMsgDeliveryStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
  where
    statusP :: Parser AMsgDeliveryStatus
statusP =
      (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString ByteString
-> (ByteString -> Parser AMsgDeliveryStatus)
-> Parser AMsgDeliveryStatus
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
"rcv_agent" -> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AMsgDeliveryStatus -> Parser AMsgDeliveryStatus)
-> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv
-> MsgDeliveryStatus 'MDRcv -> AMsgDeliveryStatus
forall (d :: MsgDirection).
SMsgDirection d -> MsgDeliveryStatus d -> AMsgDeliveryStatus
AMDS SMsgDirection 'MDRcv
SMDRcv MsgDeliveryStatus 'MDRcv
MDSRcvAgent
        ByteString
"rcv_acknowledged" -> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AMsgDeliveryStatus -> Parser AMsgDeliveryStatus)
-> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv
-> MsgDeliveryStatus 'MDRcv -> AMsgDeliveryStatus
forall (d :: MsgDirection).
SMsgDirection d -> MsgDeliveryStatus d -> AMsgDeliveryStatus
AMDS SMsgDirection 'MDRcv
SMDRcv MsgDeliveryStatus 'MDRcv
MDSRcvAcknowledged
        ByteString
"snd_pending" -> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AMsgDeliveryStatus -> Parser AMsgDeliveryStatus)
-> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd
-> MsgDeliveryStatus 'MDSnd -> AMsgDeliveryStatus
forall (d :: MsgDirection).
SMsgDirection d -> MsgDeliveryStatus d -> AMsgDeliveryStatus
AMDS SMsgDirection 'MDSnd
SMDSnd MsgDeliveryStatus 'MDSnd
MDSSndPending
        ByteString
"snd_agent" -> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AMsgDeliveryStatus -> Parser AMsgDeliveryStatus)
-> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd
-> MsgDeliveryStatus 'MDSnd -> AMsgDeliveryStatus
forall (d :: MsgDirection).
SMsgDirection d -> MsgDeliveryStatus d -> AMsgDeliveryStatus
AMDS SMsgDirection 'MDSnd
SMDSnd MsgDeliveryStatus 'MDSnd
MDSSndAgent
        ByteString
"snd_sent" -> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AMsgDeliveryStatus -> Parser AMsgDeliveryStatus)
-> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd
-> MsgDeliveryStatus 'MDSnd -> AMsgDeliveryStatus
forall (d :: MsgDirection).
SMsgDirection d -> MsgDeliveryStatus d -> AMsgDeliveryStatus
AMDS SMsgDirection 'MDSnd
SMDSnd MsgDeliveryStatus 'MDSnd
MDSSndSent
        ByteString
"snd_rcvd" -> SMsgDirection 'MDSnd
-> MsgDeliveryStatus 'MDSnd -> AMsgDeliveryStatus
forall (d :: MsgDirection).
SMsgDirection d -> MsgDeliveryStatus d -> AMsgDeliveryStatus
AMDS SMsgDirection 'MDSnd
SMDSnd (MsgDeliveryStatus 'MDSnd -> AMsgDeliveryStatus)
-> (MsgReceiptStatus -> MsgDeliveryStatus 'MDSnd)
-> MsgReceiptStatus
-> AMsgDeliveryStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgReceiptStatus -> MsgDeliveryStatus 'MDSnd
MDSSndRcvd (MsgReceiptStatus -> AMsgDeliveryStatus)
-> Parser ByteString MsgReceiptStatus -> Parser AMsgDeliveryStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char
-> Parser ByteString MsgReceiptStatus
-> Parser ByteString MsgReceiptStatus
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString MsgReceiptStatus
forall a. StrEncoding a => Parser a
strP)
        ByteString
"snd_read" -> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AMsgDeliveryStatus -> Parser AMsgDeliveryStatus)
-> AMsgDeliveryStatus -> Parser AMsgDeliveryStatus
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd
-> MsgDeliveryStatus 'MDSnd -> AMsgDeliveryStatus
forall (d :: MsgDirection).
SMsgDirection d -> MsgDeliveryStatus d -> AMsgDeliveryStatus
AMDS SMsgDirection 'MDSnd
SMDSnd MsgDeliveryStatus 'MDSnd
MDSSndRead
        ByteString
_ -> String -> Parser AMsgDeliveryStatus
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad AMsgDeliveryStatus"

msgDeliveryStatusT' :: forall d. MsgDirectionI d => Text -> Maybe (MsgDeliveryStatus d)
msgDeliveryStatusT' :: forall (d :: MsgDirection).
MsgDirectionI d =>
Text -> Maybe (MsgDeliveryStatus d)
msgDeliveryStatusT' Text
s =
  Text -> Maybe AMsgDeliveryStatus
msgDeliveryStatusT Text
s Maybe AMsgDeliveryStatus
-> (AMsgDeliveryStatus -> Maybe (MsgDeliveryStatus d))
-> Maybe (MsgDeliveryStatus d)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(AMDS SMsgDirection d
d MsgDeliveryStatus d
st) ->
    case SMsgDirection d -> SMsgDirection d -> Maybe (d :~: d)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: MsgDirection) (b :: MsgDirection).
SMsgDirection a -> SMsgDirection b -> Maybe (a :~: b)
testEquality SMsgDirection d
d (forall (d :: MsgDirection). MsgDirectionI d => SMsgDirection d
msgDirection @d) of
      Just d :~: d
Refl -> MsgDeliveryStatus d -> Maybe (MsgDeliveryStatus d)
forall a. a -> Maybe a
Just MsgDeliveryStatus d
MsgDeliveryStatus d
st
      Maybe (d :~: d)
_ -> Maybe (MsgDeliveryStatus d)
forall a. Maybe a
Nothing

data CIDeleted (c :: ChatType) where
  CIDeleted :: Maybe UTCTime -> CIDeleted c
  CIBlocked :: Maybe UTCTime -> CIDeleted 'CTGroup
  CIBlockedByAdmin :: Maybe UTCTime -> CIDeleted 'CTGroup
  CIModerated :: Maybe UTCTime -> GroupMember -> CIDeleted 'CTGroup

deriving instance Show (CIDeleted c)

data ACIDeleted = forall c. ChatTypeI c => ACIDeleted (SChatType c) (CIDeleted c)

data JSONCIDeleted
  = JCIDDeleted {JSONCIDeleted -> Maybe UTCTime
deletedTs :: Maybe UTCTime, JSONCIDeleted -> ChatType
chatType :: ChatType}
  | JCIDBlocked {deletedTs :: Maybe UTCTime}
  | JCIDBlockedByAdmin {deletedTs :: Maybe UTCTime}
  | JCIDModerated {deletedTs :: Maybe UTCTime, JSONCIDeleted -> GroupMember
byGroupMember :: GroupMember}
  deriving (Int -> JSONCIDeleted -> ShowS
[JSONCIDeleted] -> ShowS
JSONCIDeleted -> String
(Int -> JSONCIDeleted -> ShowS)
-> (JSONCIDeleted -> String)
-> ([JSONCIDeleted] -> ShowS)
-> Show JSONCIDeleted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONCIDeleted -> ShowS
showsPrec :: Int -> JSONCIDeleted -> ShowS
$cshow :: JSONCIDeleted -> String
show :: JSONCIDeleted -> String
$cshowList :: [JSONCIDeleted] -> ShowS
showList :: [JSONCIDeleted] -> ShowS
Show)

jsonCIDeleted :: forall d. ChatTypeI d => CIDeleted d -> JSONCIDeleted
jsonCIDeleted :: forall (d :: ChatType). ChatTypeI d => CIDeleted d -> JSONCIDeleted
jsonCIDeleted = \case
  CIDeleted Maybe UTCTime
ts -> Maybe UTCTime -> ChatType -> JSONCIDeleted
JCIDDeleted Maybe UTCTime
ts (SChatType d -> ChatType
forall (c :: ChatType). SChatType c -> ChatType
toChatType (SChatType d -> ChatType) -> SChatType d -> ChatType
forall a b. (a -> b) -> a -> b
$ forall (c :: ChatType). ChatTypeI c => SChatType c
chatTypeI @d)
  CIBlocked Maybe UTCTime
ts -> Maybe UTCTime -> JSONCIDeleted
JCIDBlocked Maybe UTCTime
ts
  CIBlockedByAdmin Maybe UTCTime
ts -> Maybe UTCTime -> JSONCIDeleted
JCIDBlockedByAdmin Maybe UTCTime
ts
  CIModerated Maybe UTCTime
ts GroupMember
m -> Maybe UTCTime -> GroupMember -> JSONCIDeleted
JCIDModerated Maybe UTCTime
ts GroupMember
m

jsonACIDeleted :: JSONCIDeleted -> ACIDeleted
jsonACIDeleted :: JSONCIDeleted -> ACIDeleted
jsonACIDeleted = \case
  JCIDDeleted Maybe UTCTime
ts ChatType
cType -> case ChatType -> AChatType
aChatType ChatType
cType of ACT SChatType c
c -> SChatType c -> CIDeleted c -> ACIDeleted
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> CIDeleted c -> ACIDeleted
ACIDeleted SChatType c
c (CIDeleted c -> ACIDeleted) -> CIDeleted c -> ACIDeleted
forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> CIDeleted c
forall (c :: ChatType). Maybe UTCTime -> CIDeleted c
CIDeleted Maybe UTCTime
ts
  JCIDBlocked Maybe UTCTime
ts -> SChatType 'CTGroup -> CIDeleted 'CTGroup -> ACIDeleted
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> CIDeleted c -> ACIDeleted
ACIDeleted SChatType 'CTGroup
SCTGroup (CIDeleted 'CTGroup -> ACIDeleted)
-> CIDeleted 'CTGroup -> ACIDeleted
forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> CIDeleted 'CTGroup
CIBlocked Maybe UTCTime
ts
  JCIDBlockedByAdmin Maybe UTCTime
ts -> SChatType 'CTGroup -> CIDeleted 'CTGroup -> ACIDeleted
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> CIDeleted c -> ACIDeleted
ACIDeleted SChatType 'CTGroup
SCTGroup (CIDeleted 'CTGroup -> ACIDeleted)
-> CIDeleted 'CTGroup -> ACIDeleted
forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> CIDeleted 'CTGroup
CIBlockedByAdmin Maybe UTCTime
ts
  JCIDModerated Maybe UTCTime
ts GroupMember
m -> SChatType 'CTGroup -> CIDeleted 'CTGroup -> ACIDeleted
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> CIDeleted c -> ACIDeleted
ACIDeleted SChatType 'CTGroup
SCTGroup (Maybe UTCTime -> GroupMember -> CIDeleted 'CTGroup
CIModerated Maybe UTCTime
ts GroupMember
m)

itemDeletedTs :: CIDeleted d -> Maybe UTCTime
itemDeletedTs :: forall (d :: ChatType). CIDeleted d -> Maybe UTCTime
itemDeletedTs = \case
  CIDeleted Maybe UTCTime
ts -> Maybe UTCTime
ts
  CIBlocked Maybe UTCTime
ts -> Maybe UTCTime
ts
  CIBlockedByAdmin Maybe UTCTime
ts -> Maybe UTCTime
ts
  CIModerated Maybe UTCTime
ts GroupMember
_ -> Maybe UTCTime
ts

data CIForwardedFrom
  = CIFFUnknown
  | CIFFContact {CIForwardedFrom -> Text
chatName :: Text, CIForwardedFrom -> MsgDirection
msgDir :: MsgDirection, CIForwardedFrom -> Maybe Int64
contactId :: Maybe ContactId, CIForwardedFrom -> Maybe Int64
chatItemId :: Maybe ChatItemId}
  | CIFFGroup {chatName :: Text, msgDir :: MsgDirection, CIForwardedFrom -> Maybe Int64
groupId :: Maybe GroupId, chatItemId :: Maybe ChatItemId}
  deriving (Int -> CIForwardedFrom -> ShowS
[CIForwardedFrom] -> ShowS
CIForwardedFrom -> String
(Int -> CIForwardedFrom -> ShowS)
-> (CIForwardedFrom -> String)
-> ([CIForwardedFrom] -> ShowS)
-> Show CIForwardedFrom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIForwardedFrom -> ShowS
showsPrec :: Int -> CIForwardedFrom -> ShowS
$cshow :: CIForwardedFrom -> String
show :: CIForwardedFrom -> String
$cshowList :: [CIForwardedFrom] -> ShowS
showList :: [CIForwardedFrom] -> ShowS
Show)

cmForwardedFrom :: AChatMsgEvent -> Maybe CIForwardedFrom
cmForwardedFrom :: AChatMsgEvent -> Maybe CIForwardedFrom
cmForwardedFrom = \case
  ACME SMsgEncoding e
_ (XMsgNew (MCForward ExtMsgContent
_)) -> CIForwardedFrom -> Maybe CIForwardedFrom
forall a. a -> Maybe a
Just CIForwardedFrom
CIFFUnknown
  AChatMsgEvent
_ -> Maybe CIForwardedFrom
forall a. Maybe a
Nothing

data CIForwardedFromTag
  = CIFFUnknown_
  | CIFFContact_
  | CIFFGroup_

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

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

instance TextEncoding CIForwardedFromTag where
  textDecode :: Text -> Maybe CIForwardedFromTag
textDecode = \case
    Text
"unknown" -> CIForwardedFromTag -> Maybe CIForwardedFromTag
forall a. a -> Maybe a
Just CIForwardedFromTag
CIFFUnknown_
    Text
"contact" -> CIForwardedFromTag -> Maybe CIForwardedFromTag
forall a. a -> Maybe a
Just CIForwardedFromTag
CIFFContact_
    Text
"group" -> CIForwardedFromTag -> Maybe CIForwardedFromTag
forall a. a -> Maybe a
Just CIForwardedFromTag
CIFFGroup_
    Text
_ -> Maybe CIForwardedFromTag
forall a. Maybe a
Nothing
  textEncode :: CIForwardedFromTag -> Text
textEncode = \case
    CIForwardedFromTag
CIFFUnknown_ -> Text
"unknown"
    CIForwardedFromTag
CIFFContact_ -> Text
"contact"
    CIForwardedFromTag
CIFFGroup_ -> Text
"group"

data ChatItemInfo = ChatItemInfo
  { ChatItemInfo -> [ChatItemVersion]
itemVersions :: [ChatItemVersion],
    ChatItemInfo -> Maybe (NonEmpty MemberDeliveryStatus)
memberDeliveryStatuses :: Maybe (NonEmpty MemberDeliveryStatus),
    ChatItemInfo -> Maybe AChatItem
forwardedFromChatItem :: Maybe AChatItem
  }
  deriving (Int -> ChatItemInfo -> ShowS
[ChatItemInfo] -> ShowS
ChatItemInfo -> String
(Int -> ChatItemInfo -> ShowS)
-> (ChatItemInfo -> String)
-> ([ChatItemInfo] -> ShowS)
-> Show ChatItemInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatItemInfo -> ShowS
showsPrec :: Int -> ChatItemInfo -> ShowS
$cshow :: ChatItemInfo -> String
show :: ChatItemInfo -> String
$cshowList :: [ChatItemInfo] -> ShowS
showList :: [ChatItemInfo] -> ShowS
Show)

data ChatItemVersion = ChatItemVersion
  { ChatItemVersion -> Int64
chatItemVersionId :: Int64,
    ChatItemVersion -> MsgContent
msgContent :: MsgContent,
    ChatItemVersion -> Maybe MarkdownList
formattedText :: Maybe MarkdownList,
    ChatItemVersion -> UTCTime
itemVersionTs :: UTCTime,
    ChatItemVersion -> UTCTime
createdAt :: UTCTime
  }
  deriving (ChatItemVersion -> ChatItemVersion -> Bool
(ChatItemVersion -> ChatItemVersion -> Bool)
-> (ChatItemVersion -> ChatItemVersion -> Bool)
-> Eq ChatItemVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatItemVersion -> ChatItemVersion -> Bool
== :: ChatItemVersion -> ChatItemVersion -> Bool
$c/= :: ChatItemVersion -> ChatItemVersion -> Bool
/= :: ChatItemVersion -> ChatItemVersion -> Bool
Eq, Int -> ChatItemVersion -> ShowS
[ChatItemVersion] -> ShowS
ChatItemVersion -> String
(Int -> ChatItemVersion -> ShowS)
-> (ChatItemVersion -> String)
-> ([ChatItemVersion] -> ShowS)
-> Show ChatItemVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatItemVersion -> ShowS
showsPrec :: Int -> ChatItemVersion -> ShowS
$cshow :: ChatItemVersion -> String
show :: ChatItemVersion -> String
$cshowList :: [ChatItemVersion] -> ShowS
showList :: [ChatItemVersion] -> ShowS
Show)

mkItemVersion :: ChatItem c d -> Maybe ChatItemVersion
mkItemVersion :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe ChatItemVersion
mkItemVersion ChatItem {CIContent d
content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content :: CIContent d
content, Maybe MarkdownList
formattedText :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe MarkdownList
formattedText :: Maybe MarkdownList
formattedText, CIMeta c d
meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta :: CIMeta c d
meta} = MsgContent -> ChatItemVersion
version (MsgContent -> ChatItemVersion)
-> Maybe MsgContent -> Maybe ChatItemVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CIContent d -> Maybe MsgContent
forall (d :: MsgDirection). CIContent d -> Maybe MsgContent
ciMsgContent CIContent d
content
  where
    CIMeta {Int64
itemId :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Int64
itemId :: Int64
itemId, UTCTime
itemTs :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
itemTs :: UTCTime
itemTs, UTCTime
createdAt :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
createdAt :: UTCTime
createdAt} = CIMeta c d
meta
    version :: MsgContent -> ChatItemVersion
version MsgContent
mc =
      ChatItemVersion
        { chatItemVersionId :: Int64
chatItemVersionId = Int64
itemId,
          msgContent :: MsgContent
msgContent = MsgContent
mc,
          Maybe MarkdownList
formattedText :: Maybe MarkdownList
formattedText :: Maybe MarkdownList
formattedText,
          itemVersionTs :: UTCTime
itemVersionTs = UTCTime
itemTs,
          createdAt :: UTCTime
createdAt = UTCTime
createdAt
        }

data MemberDeliveryStatus = MemberDeliveryStatus
  { MemberDeliveryStatus -> Int64
groupMemberId :: GroupMemberId,
    MemberDeliveryStatus -> GroupSndStatus
memberDeliveryStatus :: GroupSndStatus,
    MemberDeliveryStatus -> Maybe Bool
sentViaProxy :: Maybe Bool
  }
  deriving (MemberDeliveryStatus -> MemberDeliveryStatus -> Bool
(MemberDeliveryStatus -> MemberDeliveryStatus -> Bool)
-> (MemberDeliveryStatus -> MemberDeliveryStatus -> Bool)
-> Eq MemberDeliveryStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemberDeliveryStatus -> MemberDeliveryStatus -> Bool
== :: MemberDeliveryStatus -> MemberDeliveryStatus -> Bool
$c/= :: MemberDeliveryStatus -> MemberDeliveryStatus -> Bool
/= :: MemberDeliveryStatus -> MemberDeliveryStatus -> Bool
Eq, Int -> MemberDeliveryStatus -> ShowS
[MemberDeliveryStatus] -> ShowS
MemberDeliveryStatus -> String
(Int -> MemberDeliveryStatus -> ShowS)
-> (MemberDeliveryStatus -> String)
-> ([MemberDeliveryStatus] -> ShowS)
-> Show MemberDeliveryStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemberDeliveryStatus -> ShowS
showsPrec :: Int -> MemberDeliveryStatus -> ShowS
$cshow :: MemberDeliveryStatus -> String
show :: MemberDeliveryStatus -> String
$cshowList :: [MemberDeliveryStatus] -> ShowS
showList :: [MemberDeliveryStatus] -> ShowS
Show)

data CIModeration = CIModeration
  { CIModeration -> Int64
moderationId :: Int64,
    CIModeration -> GroupMember
moderatorMember :: GroupMember,
    CIModeration -> Int64
createdByMsgId :: MessageId,
    CIModeration -> UTCTime
moderatedAt :: UTCTime
  }
  deriving (Int -> CIModeration -> ShowS
[CIModeration] -> ShowS
CIModeration -> String
(Int -> CIModeration -> ShowS)
-> (CIModeration -> String)
-> ([CIModeration] -> ShowS)
-> Show CIModeration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIModeration -> ShowS
showsPrec :: Int -> CIModeration -> ShowS
$cshow :: CIModeration -> String
show :: CIModeration -> String
$cshowList :: [CIModeration] -> ShowS
showList :: [CIModeration] -> ShowS
Show)

instance ChatTypeI c => FromJSON (SChatType c) where
  parseJSON :: Value -> Parser (SChatType c)
parseJSON Value
v = (\(ACT SChatType c
t) -> SChatType c -> Either String (SChatType c)
forall (t :: ChatType -> *) (c :: ChatType) (c' :: ChatType).
(ChatTypeI c, ChatTypeI c') =>
t c' -> Either String (t c)
checkChatType SChatType c
t) (AChatType -> Either String (SChatType c))
-> (ChatType -> AChatType)
-> ChatType
-> Either String (SChatType c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatType -> AChatType
aChatType (ChatType -> Either String (SChatType c))
-> Parser ChatType -> Parser (SChatType c)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Value -> Parser ChatType
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

instance ToJSON (SChatType c) where
  toJSON :: SChatType c -> Value
toJSON = ChatType -> Value
forall a. ToJSON a => a -> Value
J.toJSON (ChatType -> Value)
-> (SChatType c -> ChatType) -> SChatType c -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SChatType c -> ChatType
forall (c :: ChatType). SChatType c -> ChatType
toChatType
  toEncoding :: SChatType c -> Encoding
toEncoding = ChatType -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding (ChatType -> Encoding)
-> (SChatType c -> ChatType) -> SChatType c -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SChatType c -> ChatType
forall (c :: ChatType). SChatType c -> ChatType
toChatType

$(JQ.deriveJSON defaultJSON ''ChatName)

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCID") ''JSONCIDeleted)

instance ChatTypeI c => FromJSON (CIDeleted c) where
  parseJSON :: Value -> Parser (CIDeleted c)
parseJSON Value
v = (\(ACIDeleted SChatType c
_ CIDeleted c
x) -> CIDeleted c -> Either String (CIDeleted c)
forall (t :: ChatType -> *) (c :: ChatType) (c' :: ChatType).
(ChatTypeI c, ChatTypeI c') =>
t c' -> Either String (t c)
checkChatType CIDeleted c
x) (ACIDeleted -> Either String (CIDeleted c))
-> (JSONCIDeleted -> ACIDeleted)
-> JSONCIDeleted
-> Either String (CIDeleted c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONCIDeleted -> ACIDeleted
jsonACIDeleted (JSONCIDeleted -> Either String (CIDeleted c))
-> Parser JSONCIDeleted -> Parser (CIDeleted c)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Value -> Parser JSONCIDeleted
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

instance ChatTypeI c => ToJSON (CIDeleted c) where
  toJSON :: CIDeleted c -> Value
toJSON = JSONCIDeleted -> Value
forall a. ToJSON a => a -> Value
J.toJSON (JSONCIDeleted -> Value)
-> (CIDeleted c -> JSONCIDeleted) -> CIDeleted c -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDeleted c -> JSONCIDeleted
forall (d :: ChatType). ChatTypeI d => CIDeleted d -> JSONCIDeleted
jsonCIDeleted
  toEncoding :: CIDeleted c -> Encoding
toEncoding = JSONCIDeleted -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding (JSONCIDeleted -> Encoding)
-> (CIDeleted c -> JSONCIDeleted) -> CIDeleted c -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDeleted c -> JSONCIDeleted
forall (d :: ChatType). ChatTypeI d => CIDeleted d -> JSONCIDeleted
jsonCIDeleted

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CIFF") ''CIForwardedFrom)

$(JQ.deriveJSON defaultJSON ''CITimed)

$(JQ.deriveJSON (enumJSON $ dropPrefix "SSP") ''SndCIStatusProgress)

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "SrvErr") ''SrvError)

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "SndErr") ''SndError)

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCIS") ''JSONCIStatus)

instance MsgDirectionI d => FromJSON (CIStatus d) where
  parseJSON :: Value -> Parser (CIStatus d)
parseJSON Value
v = (\(ACIStatus SMsgDirection d
_ CIStatus d
s) -> CIStatus d -> Either String (CIStatus d)
forall (t :: MsgDirection -> *) (d :: MsgDirection)
       (d' :: MsgDirection).
(MsgDirectionI d, MsgDirectionI d') =>
t d' -> Either String (t d)
checkDirection CIStatus d
s) (ACIStatus -> Either String (CIStatus d))
-> (JSONCIStatus -> ACIStatus)
-> JSONCIStatus
-> Either String (CIStatus d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONCIStatus -> ACIStatus
jsonACIStatus (JSONCIStatus -> Either String (CIStatus d))
-> Parser JSONCIStatus -> Parser (CIStatus d)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Value -> Parser JSONCIStatus
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

instance ToJSON (CIStatus d) where
  toJSON :: CIStatus d -> Value
toJSON = JSONCIStatus -> Value
forall a. ToJSON a => a -> Value
J.toJSON (JSONCIStatus -> Value)
-> (CIStatus d -> JSONCIStatus) -> CIStatus d -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIStatus d -> JSONCIStatus
forall (d :: MsgDirection). CIStatus d -> JSONCIStatus
jsonCIStatus
  toEncoding :: CIStatus d -> Encoding
toEncoding = JSONCIStatus -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding (JSONCIStatus -> Encoding)
-> (CIStatus d -> JSONCIStatus) -> CIStatus d -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIStatus d -> JSONCIStatus
forall (d :: MsgDirection). CIStatus d -> JSONCIStatus
jsonCIStatus

instance MsgDirectionI d => ToField (CIStatus d) where toField :: CIStatus d -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData) -> (CIStatus d -> Text) -> CIStatus d -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeLatin1 (ByteString -> Text)
-> (CIStatus d -> ByteString) -> CIStatus d -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIStatus d -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode

instance (Typeable d, MsgDirectionI d) => FromField (CIStatus d) where fromField :: FieldParser (CIStatus d)
fromField = (Text -> Maybe (CIStatus d)) -> FieldParser (CIStatus d)
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ ((Text -> Maybe (CIStatus d)) -> FieldParser (CIStatus d))
-> (Text -> Maybe (CIStatus d)) -> FieldParser (CIStatus d)
forall a b. (a -> b) -> a -> b
$ Either String (CIStatus d) -> Maybe (CIStatus d)
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String (CIStatus d) -> Maybe (CIStatus d))
-> (Text -> Either String (CIStatus d))
-> Text
-> Maybe (CIStatus d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (CIStatus d)
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String (CIStatus d))
-> (Text -> ByteString) -> Text -> Either String (CIStatus d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance FromField ACIStatus where fromField :: FieldParser ACIStatus
fromField = (Text -> Maybe ACIStatus) -> FieldParser ACIStatus
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ ((Text -> Maybe ACIStatus) -> FieldParser ACIStatus)
-> (Text -> Maybe ACIStatus) -> FieldParser ACIStatus
forall a b. (a -> b) -> a -> b
$ Either String ACIStatus -> Maybe ACIStatus
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String ACIStatus -> Maybe ACIStatus)
-> (Text -> Either String ACIStatus) -> Text -> Maybe ACIStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ACIStatus
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String ACIStatus)
-> (Text -> ByteString) -> Text -> Either String ACIStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GSS") ''GroupSndStatus)

instance ToField GroupSndStatus where toField :: GroupSndStatus -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData)
-> (GroupSndStatus -> Text) -> GroupSndStatus -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeLatin1 (ByteString -> Text)
-> (GroupSndStatus -> ByteString) -> GroupSndStatus -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupSndStatus -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode

instance FromField GroupSndStatus where fromField :: FieldParser GroupSndStatus
fromField = (Text -> Maybe GroupSndStatus) -> FieldParser GroupSndStatus
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ ((Text -> Maybe GroupSndStatus) -> FieldParser GroupSndStatus)
-> (Text -> Maybe GroupSndStatus) -> FieldParser GroupSndStatus
forall a b. (a -> b) -> a -> b
$ Either String GroupSndStatus -> Maybe GroupSndStatus
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String GroupSndStatus -> Maybe GroupSndStatus)
-> (Text -> Either String GroupSndStatus)
-> Text
-> Maybe GroupSndStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String GroupSndStatus
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String GroupSndStatus)
-> (Text -> ByteString) -> Text -> Either String GroupSndStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

$(JQ.deriveJSON defaultJSON ''MemberDeliveryStatus)

$(JQ.deriveJSON defaultJSON ''ChatItemVersion)

instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIMeta c d) where
  parseJSON :: Value -> Parser (CIMeta c d)
parseJSON = $(JQ.mkParseJSON defaultJSON ''CIMeta)

instance ChatTypeI c => ToJSON (CIMeta c d) where
  toJSON :: CIMeta c d -> Value
toJSON = $(JQ.mkToJSON defaultJSON ''CIMeta)
  toEncoding :: CIMeta c d -> Encoding
toEncoding = $(JQ.mkToEncoding defaultJSON ''CIMeta)

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "FileErr") ''FileError)

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCIFS") ''JSONCIFileStatus)

instance MsgDirectionI d => FromJSON (CIFileStatus d) where
  parseJSON :: Value -> Parser (CIFileStatus d)
parseJSON Value
v = (\(AFS SMsgDirection d
_ CIFileStatus d
s) -> CIFileStatus d -> Either String (CIFileStatus d)
forall (t :: MsgDirection -> *) (d :: MsgDirection)
       (d' :: MsgDirection).
(MsgDirectionI d, MsgDirectionI d') =>
t d' -> Either String (t d)
checkDirection CIFileStatus d
s) (ACIFileStatus -> Either String (CIFileStatus d))
-> (JSONCIFileStatus -> ACIFileStatus)
-> JSONCIFileStatus
-> Either String (CIFileStatus d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONCIFileStatus -> ACIFileStatus
aciFileStatusJSON (JSONCIFileStatus -> Either String (CIFileStatus d))
-> Parser JSONCIFileStatus -> Parser (CIFileStatus d)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Value -> Parser JSONCIFileStatus
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

instance ToJSON (CIFileStatus d) where
  toJSON :: CIFileStatus d -> Value
toJSON = JSONCIFileStatus -> Value
forall a. ToJSON a => a -> Value
J.toJSON (JSONCIFileStatus -> Value)
-> (CIFileStatus d -> JSONCIFileStatus) -> CIFileStatus d -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIFileStatus d -> JSONCIFileStatus
forall (d :: MsgDirection). CIFileStatus d -> JSONCIFileStatus
jsonCIFileStatus
  toEncoding :: CIFileStatus d -> Encoding
toEncoding = JSONCIFileStatus -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding (JSONCIFileStatus -> Encoding)
-> (CIFileStatus d -> JSONCIFileStatus)
-> CIFileStatus d
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIFileStatus d -> JSONCIFileStatus
forall (d :: MsgDirection). CIFileStatus d -> JSONCIFileStatus
jsonCIFileStatus

instance MsgDirectionI d => ToField (CIFileStatus d) where toField :: CIFileStatus d -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData)
-> (CIFileStatus d -> Text) -> CIFileStatus d -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeLatin1 (ByteString -> Text)
-> (CIFileStatus d -> ByteString) -> CIFileStatus d -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIFileStatus d -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode

instance FromField ACIFileStatus where fromField :: FieldParser ACIFileStatus
fromField = (Text -> Maybe ACIFileStatus) -> FieldParser ACIFileStatus
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ ((Text -> Maybe ACIFileStatus) -> FieldParser ACIFileStatus)
-> (Text -> Maybe ACIFileStatus) -> FieldParser ACIFileStatus
forall a b. (a -> b) -> a -> b
$ Either String ACIFileStatus -> Maybe ACIFileStatus
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String ACIFileStatus -> Maybe ACIFileStatus)
-> (Text -> Either String ACIFileStatus)
-> Text
-> Maybe ACIFileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ACIFileStatus
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String ACIFileStatus)
-> (Text -> ByteString) -> Text -> Either String ACIFileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance MsgDirectionI d => FromJSON (CIFile d) where
  parseJSON :: Value -> Parser (CIFile d)
parseJSON = $(JQ.mkParseJSON defaultJSON ''CIFile)

instance MsgDirectionI d => ToJSON (CIFile d) where
  toJSON :: CIFile d -> Value
toJSON = $(JQ.mkToJSON defaultJSON ''CIFile)
  toEncoding :: CIFile d -> Encoding
toEncoding = $(JQ.mkToEncoding defaultJSON ''CIFile)

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GCS") ''GroupChatScope)

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCI") ''JSONCIDirection)

instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIDirection c d) where
  parseJSON :: Value -> Parser (CIDirection c d)
parseJSON Value
v = (\(CCID SMsgDirection d
_ CIDirection c d
x') -> CIDirection c d -> Either String (CIDirection c d)
forall (t :: MsgDirection -> *) (d :: MsgDirection)
       (d' :: MsgDirection).
(MsgDirectionI d, MsgDirectionI d') =>
t d' -> Either String (t d)
checkDirection CIDirection c d
x') (CCIDirection c -> Either String (CIDirection c d))
-> Parser (CCIDirection c) -> Parser (CIDirection c d)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Value -> Parser (CCIDirection c)
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

instance ToJSON (CIDirection c d) where
  toJSON :: CIDirection c d -> Value
toJSON = JSONCIDirection -> Value
forall a. ToJSON a => a -> Value
J.toJSON (JSONCIDirection -> Value)
-> (CIDirection c d -> JSONCIDirection) -> CIDirection c d -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDirection c d -> JSONCIDirection
forall (c :: ChatType) (d :: MsgDirection).
CIDirection c d -> JSONCIDirection
jsonCIDirection
  toEncoding :: CIDirection c d -> Encoding
toEncoding = JSONCIDirection -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding (JSONCIDirection -> Encoding)
-> (CIDirection c d -> JSONCIDirection)
-> CIDirection c d
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDirection c d -> JSONCIDirection
forall (c :: ChatType) (d :: MsgDirection).
CIDirection c d -> JSONCIDirection
jsonCIDirection

instance ChatTypeI c => FromJSON (CCIDirection c) where
  parseJSON :: Value -> Parser (CCIDirection c)
parseJSON Value
v = (\(ACID SChatType c
_ SMsgDirection d
d CIDirection c d
x) -> CCIDirection c -> Either String (CCIDirection c)
forall (t :: ChatType -> *) (c :: ChatType) (c' :: ChatType).
(ChatTypeI c, ChatTypeI c') =>
t c' -> Either String (t c)
checkChatType (SMsgDirection d -> CIDirection c d -> CCIDirection c
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIDirection c d -> CCIDirection c
CCID SMsgDirection d
d CIDirection c d
x)) (ACIDirection -> Either String (CCIDirection c))
-> Parser ACIDirection -> Parser (CCIDirection c)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Value -> Parser ACIDirection
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

instance FromJSON ACIDirection where
  parseJSON :: Value -> Parser ACIDirection
parseJSON Value
v = JSONCIDirection -> ACIDirection
jsonACIDirection (JSONCIDirection -> ACIDirection)
-> Parser JSONCIDirection -> Parser ACIDirection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser JSONCIDirection
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

instance ChatTypeI c => FromJSON (CIQDirection c) where
  parseJSON :: Value -> Parser (CIQDirection c)
parseJSON Value
v = (Maybe JSONCIDirection -> Either String ACIQDirection
jsonACIQDirection (Maybe JSONCIDirection -> Either String ACIQDirection)
-> (ACIQDirection -> Either String (CIQDirection c))
-> Maybe JSONCIDirection
-> Either String (CIQDirection c)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \(ACIQDirection SChatType c
_ CIQDirection c
x) -> CIQDirection c -> Either String (CIQDirection c)
forall (t :: ChatType -> *) (c :: ChatType) (c' :: ChatType).
(ChatTypeI c, ChatTypeI c') =>
t c' -> Either String (t c)
checkChatType CIQDirection c
x) (Maybe JSONCIDirection -> Either String (CIQDirection c))
-> Parser (Maybe JSONCIDirection) -> Parser (CIQDirection c)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Value -> Parser (Maybe JSONCIDirection)
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v

instance ToJSON (CIQDirection c) where
  toJSON :: CIQDirection c -> Value
toJSON = Maybe JSONCIDirection -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Maybe JSONCIDirection -> Value)
-> (CIQDirection c -> Maybe JSONCIDirection)
-> CIQDirection c
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIQDirection c -> Maybe JSONCIDirection
forall (c :: ChatType). CIQDirection c -> Maybe JSONCIDirection
jsonCIQDirection
  toEncoding :: CIQDirection c -> Encoding
toEncoding = Maybe JSONCIDirection -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding (Maybe JSONCIDirection -> Encoding)
-> (CIQDirection c -> Maybe JSONCIDirection)
-> CIQDirection c
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIQDirection c -> Maybe JSONCIDirection
forall (c :: ChatType). CIQDirection c -> Maybe JSONCIDirection
jsonCIQDirection

instance ChatTypeI c => FromJSON (CIQuote c) where
  parseJSON :: Value -> Parser (CIQuote c)
parseJSON = $(JQ.mkParseJSON defaultJSON ''CIQuote)

$(JQ.deriveToJSON defaultJSON ''CIQuote)

$(JQ.deriveJSON defaultJSON ''CIReactionCount)

$(JQ.deriveJSON defaultJSON ''CIMentionMember)

$(JQ.deriveJSON defaultJSON ''CIMention)

instance (ChatTypeI c, MsgDirectionI d) => FromJSON (ChatItem c d) where
  parseJSON :: Value -> Parser (ChatItem c d)
parseJSON = $(JQ.mkParseJSON defaultJSON ''ChatItem)

instance (ChatTypeI c, MsgDirectionI d) => ToJSON (ChatItem c d) where
  toJSON :: ChatItem c d -> Value
toJSON = $(JQ.mkToJSON defaultJSON ''ChatItem)
  toEncoding :: ChatItem c d -> Encoding
toEncoding = $(JQ.mkToEncoding defaultJSON ''ChatItem)

instance (ChatTypeI c, MsgDirectionI d) => ToJSON (JSONAnyChatItem c d) where
  toJSON :: JSONAnyChatItem c d -> Value
toJSON = $(JQ.mkToJSON defaultJSON ''JSONAnyChatItem)
  toEncoding :: JSONAnyChatItem c d -> Encoding
toEncoding = $(JQ.mkToEncoding defaultJSON ''JSONAnyChatItem)

-- if JSON encoding changes, update AChatItem type definition in bots/src/API/Docs/Types.hs
instance FromJSON AChatItem where
  parseJSON :: Value -> Parser AChatItem
parseJSON = String -> (Object -> Parser AChatItem) -> Value -> Parser AChatItem
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"AChatItem" ((Object -> Parser AChatItem) -> Value -> Parser AChatItem)
-> (Object -> Parser AChatItem) -> Value -> Parser AChatItem
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    AChatInfo SChatType c
c ChatInfo c
chatInfo <- Object
o Object -> Key -> Parser AChatInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chatInfo"
    CChatItem SMsgDirection d
d ChatItem c d
chatItem <- Object
o Object -> Key -> Parser (CChatItem c)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chatItem"
    AChatItem -> Parser AChatItem
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChatItem -> Parser AChatItem) -> AChatItem -> Parser AChatItem
forall a b. (a -> b) -> a -> b
$ SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType c
c SMsgDirection d
d ChatInfo c
chatInfo ChatItem c d
chatItem

instance ToJSON AChatItem where
  toJSON :: AChatItem -> Value
toJSON (AChatItem SChatType c
_ SMsgDirection d
_ ChatInfo c
chat ChatItem c d
item) = JSONAnyChatItem c d -> Value
forall a. ToJSON a => a -> Value
J.toJSON (JSONAnyChatItem c d -> Value) -> JSONAnyChatItem c d -> Value
forall a b. (a -> b) -> a -> b
$ ChatInfo c -> ChatItem c d -> JSONAnyChatItem c d
forall (c :: ChatType) (d :: MsgDirection).
ChatInfo c -> ChatItem c d -> JSONAnyChatItem c d
JSONAnyChatItem ChatInfo c
chat ChatItem c d
item
  toEncoding :: AChatItem -> Encoding
toEncoding (AChatItem SChatType c
_ SMsgDirection d
_ ChatInfo c
chat ChatItem c d
item) = JSONAnyChatItem c d -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding (JSONAnyChatItem c d -> Encoding)
-> JSONAnyChatItem c d -> Encoding
forall a b. (a -> b) -> a -> b
$ ChatInfo c -> ChatItem c d -> JSONAnyChatItem c d
forall (c :: ChatType) (d :: MsgDirection).
ChatInfo c -> ChatItem c d -> JSONAnyChatItem c d
JSONAnyChatItem ChatInfo c
chat ChatItem c d
item

instance forall c. ChatTypeI c => FromJSON (CChatItem c) where
  parseJSON :: Value -> Parser (CChatItem c)
parseJSON Value
v = String
-> (Object -> Parser (CChatItem c))
-> Value
-> Parser (CChatItem c)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"CChatItem" Object -> Parser (CChatItem c)
parse Value
v
    where
      parse :: Object -> Parser (CChatItem c)
parse Object
o = do
        CCID SMsgDirection d
d (CIDirection c d
_ :: CIDirection c d) <- Object
o Object -> Key -> Parser (CCIDirection c)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chatDir"
        ChatItem c d
ci <- forall a. FromJSON a => Value -> Parser a
J.parseJSON @(ChatItem c d) Value
v
        CChatItem c -> Parser (CChatItem c)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CChatItem c -> Parser (CChatItem c))
-> CChatItem c -> Parser (CChatItem c)
forall a b. (a -> b) -> a -> b
$ SMsgDirection d -> ChatItem c d -> CChatItem c
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
d ChatItem c d
ci

instance ChatTypeI c => ToJSON (CChatItem c) where
  toJSON :: CChatItem c -> Value
toJSON (CChatItem SMsgDirection d
_ ChatItem c d
ci) = ChatItem c d -> Value
forall a. ToJSON a => a -> Value
J.toJSON ChatItem c d
ci
  toEncoding :: CChatItem c -> Encoding
toEncoding (CChatItem SMsgDirection d
_ ChatItem c d
ci) = ChatItem c d -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding ChatItem c d
ci

$(JQ.deriveJSON defaultJSON ''ChatItemInfo)

$(JQ.deriveJSON defaultJSON ''ChatStats)

$(JQ.deriveJSON defaultJSON ''NavigationInfo)

instance ChatTypeI c => ToJSON (Chat c) where
  toJSON :: Chat c -> Value
toJSON = $(JQ.mkToJSON defaultJSON ''Chat)
  toEncoding :: Chat c -> Encoding
toEncoding = $(JQ.mkToEncoding defaultJSON ''Chat)

instance FromJSON AChat where
  parseJSON :: Value -> Parser AChat
parseJSON = String -> (Object -> Parser AChat) -> Value -> Parser AChat
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"AChat" ((Object -> Parser AChat) -> Value -> Parser AChat)
-> (Object -> Parser AChat) -> Value -> Parser AChat
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    AChatInfo SChatType c
c ChatInfo c
chatInfo <- Object
o Object -> Key -> Parser AChatInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chatInfo"
    [CChatItem c]
chatItems <- Object
o Object -> Key -> Parser [CChatItem c]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chatItems"
    ChatStats
chatStats <- Object
o Object -> Key -> Parser ChatStats
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chatStats"
    AChat -> Parser AChat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChat -> Parser AChat) -> AChat -> Parser AChat
forall a b. (a -> b) -> a -> b
$ SChatType c -> Chat c -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType c
c Chat {ChatInfo c
chatInfo :: ChatInfo c
chatInfo :: ChatInfo c
chatInfo, [CChatItem c]
chatItems :: [CChatItem c]
chatItems :: [CChatItem c]
chatItems, ChatStats
chatStats :: ChatStats
chatStats :: ChatStats
chatStats}

instance ToJSON AChat where
  toJSON :: AChat -> Value
toJSON (AChat SChatType c
_ Chat c
c) = Chat c -> Value
forall a. ToJSON a => a -> Value
J.toJSON Chat c
c
  toEncoding :: AChat -> Encoding
toEncoding (AChat SChatType c
_ Chat c
c) = Chat c -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding Chat c
c

instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIReaction c d) where
  parseJSON :: Value -> Parser (CIReaction c d)
parseJSON = $(JQ.mkParseJSON defaultJSON ''CIReaction)

instance ChatTypeI c => ToJSON (CIReaction c d) where
  toJSON :: CIReaction c d -> Value
toJSON = $(JQ.mkToJSON defaultJSON ''CIReaction)
  toEncoding :: CIReaction c d -> Encoding
toEncoding = $(JQ.mkToEncoding defaultJSON ''CIReaction)

instance FromJSON AnyCIReaction where
  parseJSON :: Value -> Parser AnyCIReaction
parseJSON Value
v = String
-> (Object -> Parser AnyCIReaction)
-> Value
-> Parser AnyCIReaction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"AnyCIReaction" Object -> Parser AnyCIReaction
parse Value
v
    where
      parse :: Object -> Parser AnyCIReaction
parse Object
o = do
        ACID SChatType c
c SMsgDirection d
d (CIDirection c d
_ :: CIDirection c d) <- Object
o Object -> Key -> Parser ACIDirection
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chatDir"
        SChatType c -> SMsgDirection d -> CIReaction c d -> AnyCIReaction
forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
SChatType c -> SMsgDirection d -> CIReaction c d -> AnyCIReaction
ACIR SChatType c
c SMsgDirection d
d (CIReaction c d -> AnyCIReaction)
-> Parser (CIReaction c d) -> Parser AnyCIReaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
J.parseJSON @(CIReaction c d) Value
v

instance ChatTypeI c => ToJSON (JSONCIReaction c d) where
  toJSON :: JSONCIReaction c d -> Value
toJSON = $(JQ.mkToJSON defaultJSON ''JSONCIReaction)
  toEncoding :: JSONCIReaction c d -> Encoding
toEncoding = $(JQ.mkToEncoding defaultJSON ''JSONCIReaction)

-- if JSON encoding changes, update ACIReaction type definition in bots/src/API/Docs/Types.hs
instance FromJSON ACIReaction where
  parseJSON :: Value -> Parser ACIReaction
parseJSON = String
-> (Object -> Parser ACIReaction) -> Value -> Parser ACIReaction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"ACIReaction" ((Object -> Parser ACIReaction) -> Value -> Parser ACIReaction)
-> (Object -> Parser ACIReaction) -> Value -> Parser ACIReaction
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ACIR SChatType c
c SMsgDirection d
d CIReaction c d
reaction <- Object
o Object -> Key -> Parser AnyCIReaction
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chatReaction"
    ChatInfo c
cInfo <- Object
o Object -> Key -> Parser (ChatInfo c)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chatInfo"
    ACIReaction -> Parser ACIReaction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACIReaction -> Parser ACIReaction)
-> ACIReaction -> Parser ACIReaction
forall a b. (a -> b) -> a -> b
$ SChatType c
-> SMsgDirection d -> ChatInfo c -> CIReaction c d -> ACIReaction
forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> CIReaction c d -> ACIReaction
ACIReaction SChatType c
c SMsgDirection d
d ChatInfo c
cInfo CIReaction c d
reaction

instance ToJSON ACIReaction where
  toJSON :: ACIReaction -> Value
toJSON (ACIReaction SChatType c
_ SMsgDirection d
_ ChatInfo c
cInfo CIReaction c d
reaction) = JSONCIReaction c d -> Value
forall a. ToJSON a => a -> Value
J.toJSON (JSONCIReaction c d -> Value) -> JSONCIReaction c d -> Value
forall a b. (a -> b) -> a -> b
$ ChatInfo c -> CIReaction c d -> JSONCIReaction c d
forall (c :: ChatType) (d :: MsgDirection).
ChatInfo c -> CIReaction c d -> JSONCIReaction c d
JSONCIReaction ChatInfo c
cInfo CIReaction c d
reaction
  toEncoding :: ACIReaction -> Encoding
toEncoding (ACIReaction SChatType c
_ SMsgDirection d
_ ChatInfo c
cInfo CIReaction c d
reaction) = JSONCIReaction c d -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding (JSONCIReaction c d -> Encoding) -> JSONCIReaction c d -> Encoding
forall a b. (a -> b) -> a -> b
$ ChatInfo c -> CIReaction c d -> JSONCIReaction c d
forall (c :: ChatType) (d :: MsgDirection).
ChatInfo c -> CIReaction c d -> JSONCIReaction c d
JSONCIReaction ChatInfo c
cInfo CIReaction c d
reaction

$(JQ.deriveJSON defaultJSON ''MemberReaction)

$(JQ.deriveJSON defaultJSON ''MsgMetaJSON)

msgMetaJson :: MsgMeta -> Text
msgMetaJson :: MsgMeta -> Text
msgMetaJson = ByteString -> Text
decodeLatin1 (ByteString -> Text) -> (MsgMeta -> ByteString) -> MsgMeta -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
LB.toStrict (LazyByteString -> ByteString)
-> (MsgMeta -> LazyByteString) -> MsgMeta -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgMetaJSON -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
J.encode (MsgMetaJSON -> LazyByteString)
-> (MsgMeta -> MsgMetaJSON) -> MsgMeta -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgMeta -> MsgMetaJSON
msgMetaToJson

$(JQ.deriveJSON defaultJSON ''RcvMsgInfo)