-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.Federation.API.Galley
  ( module Wire.API.Federation.API.Galley,
    module Notifications,
  )
where

import Data.Aeson (FromJSON, ToJSON)
import Data.Domain
import Data.Id
import Data.Json.Util
import Data.Misc (Milliseconds)
import Data.OpenApi (OpenApi, ToSchema)
import Data.Proxy (Proxy (Proxy))
import Data.Qualified
import Data.Time.Clock (UTCTime)
import Imports
import Network.Wai.Utilities.JSONResponse
import Servant.API
import Servant.OpenApi (HasOpenApi (toOpenApi))
import Wire.API.Conversation
import Wire.API.Conversation.Action
import Wire.API.Conversation.Protocol
import Wire.API.Conversation.Role (RoleName)
import Wire.API.Conversation.Typing
import Wire.API.Error.Galley
import Wire.API.Federation.API.Common
import Wire.API.Federation.API.Galley.Notifications as Notifications
import Wire.API.Federation.Endpoint
import Wire.API.Federation.Version
import Wire.API.MLS.Keys
import Wire.API.MLS.SubConversation
import Wire.API.Message
import Wire.API.Routes.Named
import Wire.API.Routes.Public.Galley.Messaging
import Wire.API.Routes.SpecialiseToVersion
import Wire.API.Routes.Version qualified as ClientAPI
import Wire.API.Routes.Versioned qualified as ClientAPI
import Wire.API.Util.Aeson (CustomEncoded (..))
import Wire.API.VersionInfo
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

-- FUTUREWORK: data types, json instances, more endpoints. See
-- https://wearezeta.atlassian.net/wiki/spaces/CORE/pages/356090113/Federation+Galley+Conversation+API
-- for the current list we need.

-- | For conventions see /docs/developer/federation-api-conventions.md
type GalleyApi =
  -- | Register a new conversation. This is only called on backends of users
  -- that are part of a conversation at creation time. Since MLS conversations
  -- are always created empty (i.e. they only contain the creator), this RPC is
  -- never invoked for such conversations.
  FedEndpoint "on-conversation-created" (ConversationCreated ConvId) EmptyResponse
    -- This endpoint is called the first time a user from this backend is
    -- added to a remote conversation.
    :<|> Named
           "get-conversations@v1"
           ( UnnamedFedEndpointWithMods
               '[Until 'V2]
               "get-conversations"
               GetConversationsRequest
               GetConversationsResponse
           )
    :<|> FedEndpointWithMods
           '[From 'V2]
           "get-conversations"
           GetConversationsRequest
           GetConversationsResponseV2
    :<|> FedEndpoint
           "leave-conversation"
           LeaveConversationRequest
           LeaveConversationResponse
    -- used by a remote backend to send a message to a conversation owned by
    -- this backend
    :<|> FedEndpoint
           "send-message"
           ProteusMessageSendRequest
           MessageSendResponse
    :<|> FedEndpoint
           "update-conversation"
           ConversationUpdateRequest
           ConversationUpdateResponse
    :<|> FedEndpoint "mls-welcome" MLSWelcomeRequest MLSWelcomeResponse
    :<|> FedEndpoint
           "send-mls-message"
           MLSMessageSendRequest
           MLSMessageResponse
    :<|> FedEndpoint
           "send-mls-commit-bundle"
           MLSMessageSendRequest
           MLSMessageResponse
    :<|> FedEndpoint "query-group-info" GetGroupInfoRequest GetGroupInfoResponse
    :<|> FedEndpointWithMods
           '[
            ]
           "update-typing-indicator"
           TypingDataUpdateRequest
           TypingDataUpdateResponse
    :<|> FedEndpoint "on-typing-indicator-updated" TypingDataUpdated EmptyResponse
    :<|> FedEndpointWithMods
           '[ From 'V1
            ]
           "get-sub-conversation"
           GetSubConversationsRequest
           GetSubConversationsResponse
    :<|> FedEndpointWithMods
           '[ From 'V1
            ]
           "delete-sub-conversation"
           DeleteSubConversationFedRequest
           DeleteSubConversationResponse
    :<|> FedEndpointWithMods
           '[ From 'V1
            ]
           "leave-sub-conversation"
           LeaveSubConversationRequest
           LeaveSubConversationResponse
    :<|> Named
           "get-one2one-conversation@v1"
           ( UnnamedFedEndpointWithMods
               '[From 'V1, Until 'V2]
               "get-one2one-conversation"
               GetOne2OneConversationRequest
               GetOne2OneConversationResponse
           )
    :<|> FedEndpointWithMods
           '[From 'V2]
           "get-one2one-conversation"
           GetOne2OneConversationRequest
           GetOne2OneConversationResponseV2
    -- All the notification endpoints that go through the queue-based
    -- federation client ('fedQueueClient').
    :<|> GalleyNotificationAPI

data TypingDataUpdateRequest = TypingDataUpdateRequest
  { TypingDataUpdateRequest -> TypingStatus
typingStatus :: TypingStatus,
    TypingDataUpdateRequest -> UserId
userId :: UserId,
    TypingDataUpdateRequest -> ConvId
convId :: ConvId
  }
  deriving stock (TypingDataUpdateRequest -> TypingDataUpdateRequest -> Bool
(TypingDataUpdateRequest -> TypingDataUpdateRequest -> Bool)
-> (TypingDataUpdateRequest -> TypingDataUpdateRequest -> Bool)
-> Eq TypingDataUpdateRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypingDataUpdateRequest -> TypingDataUpdateRequest -> Bool
== :: TypingDataUpdateRequest -> TypingDataUpdateRequest -> Bool
$c/= :: TypingDataUpdateRequest -> TypingDataUpdateRequest -> Bool
/= :: TypingDataUpdateRequest -> TypingDataUpdateRequest -> Bool
Eq, Int -> TypingDataUpdateRequest -> ShowS
[TypingDataUpdateRequest] -> ShowS
TypingDataUpdateRequest -> String
(Int -> TypingDataUpdateRequest -> ShowS)
-> (TypingDataUpdateRequest -> String)
-> ([TypingDataUpdateRequest] -> ShowS)
-> Show TypingDataUpdateRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypingDataUpdateRequest -> ShowS
showsPrec :: Int -> TypingDataUpdateRequest -> ShowS
$cshow :: TypingDataUpdateRequest -> String
show :: TypingDataUpdateRequest -> String
$cshowList :: [TypingDataUpdateRequest] -> ShowS
showList :: [TypingDataUpdateRequest] -> ShowS
Show, (forall x.
 TypingDataUpdateRequest -> Rep TypingDataUpdateRequest x)
-> (forall x.
    Rep TypingDataUpdateRequest x -> TypingDataUpdateRequest)
-> Generic TypingDataUpdateRequest
forall x. Rep TypingDataUpdateRequest x -> TypingDataUpdateRequest
forall x. TypingDataUpdateRequest -> Rep TypingDataUpdateRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypingDataUpdateRequest -> Rep TypingDataUpdateRequest x
from :: forall x. TypingDataUpdateRequest -> Rep TypingDataUpdateRequest x
$cto :: forall x. Rep TypingDataUpdateRequest x -> TypingDataUpdateRequest
to :: forall x. Rep TypingDataUpdateRequest x -> TypingDataUpdateRequest
Generic)
  deriving (Value -> Parser [TypingDataUpdateRequest]
Value -> Parser TypingDataUpdateRequest
(Value -> Parser TypingDataUpdateRequest)
-> (Value -> Parser [TypingDataUpdateRequest])
-> FromJSON TypingDataUpdateRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TypingDataUpdateRequest
parseJSON :: Value -> Parser TypingDataUpdateRequest
$cparseJSONList :: Value -> Parser [TypingDataUpdateRequest]
parseJSONList :: Value -> Parser [TypingDataUpdateRequest]
FromJSON, [TypingDataUpdateRequest] -> Value
[TypingDataUpdateRequest] -> Encoding
TypingDataUpdateRequest -> Value
TypingDataUpdateRequest -> Encoding
(TypingDataUpdateRequest -> Value)
-> (TypingDataUpdateRequest -> Encoding)
-> ([TypingDataUpdateRequest] -> Value)
-> ([TypingDataUpdateRequest] -> Encoding)
-> ToJSON TypingDataUpdateRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TypingDataUpdateRequest -> Value
toJSON :: TypingDataUpdateRequest -> Value
$ctoEncoding :: TypingDataUpdateRequest -> Encoding
toEncoding :: TypingDataUpdateRequest -> Encoding
$ctoJSONList :: [TypingDataUpdateRequest] -> Value
toJSONList :: [TypingDataUpdateRequest] -> Value
$ctoEncodingList :: [TypingDataUpdateRequest] -> Encoding
toEncodingList :: [TypingDataUpdateRequest] -> Encoding
ToJSON) via (CustomEncoded TypingDataUpdateRequest)

instance ToSchema TypingDataUpdateRequest

data TypingDataUpdateResponse
  = TypingDataUpdateSuccess TypingDataUpdated
  | TypingDataUpdateError GalleyError
  deriving stock (TypingDataUpdateResponse -> TypingDataUpdateResponse -> Bool
(TypingDataUpdateResponse -> TypingDataUpdateResponse -> Bool)
-> (TypingDataUpdateResponse -> TypingDataUpdateResponse -> Bool)
-> Eq TypingDataUpdateResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypingDataUpdateResponse -> TypingDataUpdateResponse -> Bool
== :: TypingDataUpdateResponse -> TypingDataUpdateResponse -> Bool
$c/= :: TypingDataUpdateResponse -> TypingDataUpdateResponse -> Bool
/= :: TypingDataUpdateResponse -> TypingDataUpdateResponse -> Bool
Eq, Int -> TypingDataUpdateResponse -> ShowS
[TypingDataUpdateResponse] -> ShowS
TypingDataUpdateResponse -> String
(Int -> TypingDataUpdateResponse -> ShowS)
-> (TypingDataUpdateResponse -> String)
-> ([TypingDataUpdateResponse] -> ShowS)
-> Show TypingDataUpdateResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypingDataUpdateResponse -> ShowS
showsPrec :: Int -> TypingDataUpdateResponse -> ShowS
$cshow :: TypingDataUpdateResponse -> String
show :: TypingDataUpdateResponse -> String
$cshowList :: [TypingDataUpdateResponse] -> ShowS
showList :: [TypingDataUpdateResponse] -> ShowS
Show, (forall x.
 TypingDataUpdateResponse -> Rep TypingDataUpdateResponse x)
-> (forall x.
    Rep TypingDataUpdateResponse x -> TypingDataUpdateResponse)
-> Generic TypingDataUpdateResponse
forall x.
Rep TypingDataUpdateResponse x -> TypingDataUpdateResponse
forall x.
TypingDataUpdateResponse -> Rep TypingDataUpdateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
TypingDataUpdateResponse -> Rep TypingDataUpdateResponse x
from :: forall x.
TypingDataUpdateResponse -> Rep TypingDataUpdateResponse x
$cto :: forall x.
Rep TypingDataUpdateResponse x -> TypingDataUpdateResponse
to :: forall x.
Rep TypingDataUpdateResponse x -> TypingDataUpdateResponse
Generic)
  deriving (Value -> Parser [TypingDataUpdateResponse]
Value -> Parser TypingDataUpdateResponse
(Value -> Parser TypingDataUpdateResponse)
-> (Value -> Parser [TypingDataUpdateResponse])
-> FromJSON TypingDataUpdateResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TypingDataUpdateResponse
parseJSON :: Value -> Parser TypingDataUpdateResponse
$cparseJSONList :: Value -> Parser [TypingDataUpdateResponse]
parseJSONList :: Value -> Parser [TypingDataUpdateResponse]
FromJSON, [TypingDataUpdateResponse] -> Value
[TypingDataUpdateResponse] -> Encoding
TypingDataUpdateResponse -> Value
TypingDataUpdateResponse -> Encoding
(TypingDataUpdateResponse -> Value)
-> (TypingDataUpdateResponse -> Encoding)
-> ([TypingDataUpdateResponse] -> Value)
-> ([TypingDataUpdateResponse] -> Encoding)
-> ToJSON TypingDataUpdateResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TypingDataUpdateResponse -> Value
toJSON :: TypingDataUpdateResponse -> Value
$ctoEncoding :: TypingDataUpdateResponse -> Encoding
toEncoding :: TypingDataUpdateResponse -> Encoding
$ctoJSONList :: [TypingDataUpdateResponse] -> Value
toJSONList :: [TypingDataUpdateResponse] -> Value
$ctoEncodingList :: [TypingDataUpdateResponse] -> Encoding
toEncodingList :: [TypingDataUpdateResponse] -> Encoding
ToJSON) via (CustomEncoded TypingDataUpdateResponse)

instance ToSchema TypingDataUpdateResponse

data TypingDataUpdated = TypingDataUpdated
  { TypingDataUpdated -> UTCTime
time :: UTCTime,
    TypingDataUpdated -> Qualified UserId
origUserId :: Qualified UserId,
    -- | Implicitely qualified by sender's domain
    TypingDataUpdated -> ConvId
convId :: ConvId,
    -- | Implicitely qualified by receiver's domain
    TypingDataUpdated -> [UserId]
usersInConv :: [UserId],
    TypingDataUpdated -> TypingStatus
typingStatus :: TypingStatus
  }
  deriving stock (TypingDataUpdated -> TypingDataUpdated -> Bool
(TypingDataUpdated -> TypingDataUpdated -> Bool)
-> (TypingDataUpdated -> TypingDataUpdated -> Bool)
-> Eq TypingDataUpdated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypingDataUpdated -> TypingDataUpdated -> Bool
== :: TypingDataUpdated -> TypingDataUpdated -> Bool
$c/= :: TypingDataUpdated -> TypingDataUpdated -> Bool
/= :: TypingDataUpdated -> TypingDataUpdated -> Bool
Eq, Int -> TypingDataUpdated -> ShowS
[TypingDataUpdated] -> ShowS
TypingDataUpdated -> String
(Int -> TypingDataUpdated -> ShowS)
-> (TypingDataUpdated -> String)
-> ([TypingDataUpdated] -> ShowS)
-> Show TypingDataUpdated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypingDataUpdated -> ShowS
showsPrec :: Int -> TypingDataUpdated -> ShowS
$cshow :: TypingDataUpdated -> String
show :: TypingDataUpdated -> String
$cshowList :: [TypingDataUpdated] -> ShowS
showList :: [TypingDataUpdated] -> ShowS
Show, (forall x. TypingDataUpdated -> Rep TypingDataUpdated x)
-> (forall x. Rep TypingDataUpdated x -> TypingDataUpdated)
-> Generic TypingDataUpdated
forall x. Rep TypingDataUpdated x -> TypingDataUpdated
forall x. TypingDataUpdated -> Rep TypingDataUpdated x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypingDataUpdated -> Rep TypingDataUpdated x
from :: forall x. TypingDataUpdated -> Rep TypingDataUpdated x
$cto :: forall x. Rep TypingDataUpdated x -> TypingDataUpdated
to :: forall x. Rep TypingDataUpdated x -> TypingDataUpdated
Generic)
  deriving (Value -> Parser [TypingDataUpdated]
Value -> Parser TypingDataUpdated
(Value -> Parser TypingDataUpdated)
-> (Value -> Parser [TypingDataUpdated])
-> FromJSON TypingDataUpdated
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TypingDataUpdated
parseJSON :: Value -> Parser TypingDataUpdated
$cparseJSONList :: Value -> Parser [TypingDataUpdated]
parseJSONList :: Value -> Parser [TypingDataUpdated]
FromJSON, [TypingDataUpdated] -> Value
[TypingDataUpdated] -> Encoding
TypingDataUpdated -> Value
TypingDataUpdated -> Encoding
(TypingDataUpdated -> Value)
-> (TypingDataUpdated -> Encoding)
-> ([TypingDataUpdated] -> Value)
-> ([TypingDataUpdated] -> Encoding)
-> ToJSON TypingDataUpdated
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TypingDataUpdated -> Value
toJSON :: TypingDataUpdated -> Value
$ctoEncoding :: TypingDataUpdated -> Encoding
toEncoding :: TypingDataUpdated -> Encoding
$ctoJSONList :: [TypingDataUpdated] -> Value
toJSONList :: [TypingDataUpdated] -> Value
$ctoEncodingList :: [TypingDataUpdated] -> Encoding
toEncodingList :: [TypingDataUpdated] -> Encoding
ToJSON) via (CustomEncoded TypingDataUpdated)

instance ToSchema TypingDataUpdated

data GetConversationsRequest = GetConversationsRequest
  { GetConversationsRequest -> UserId
userId :: UserId,
    GetConversationsRequest -> [ConvId]
convIds :: [ConvId]
  }
  deriving stock (GetConversationsRequest -> GetConversationsRequest -> Bool
(GetConversationsRequest -> GetConversationsRequest -> Bool)
-> (GetConversationsRequest -> GetConversationsRequest -> Bool)
-> Eq GetConversationsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetConversationsRequest -> GetConversationsRequest -> Bool
== :: GetConversationsRequest -> GetConversationsRequest -> Bool
$c/= :: GetConversationsRequest -> GetConversationsRequest -> Bool
/= :: GetConversationsRequest -> GetConversationsRequest -> Bool
Eq, Int -> GetConversationsRequest -> ShowS
[GetConversationsRequest] -> ShowS
GetConversationsRequest -> String
(Int -> GetConversationsRequest -> ShowS)
-> (GetConversationsRequest -> String)
-> ([GetConversationsRequest] -> ShowS)
-> Show GetConversationsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetConversationsRequest -> ShowS
showsPrec :: Int -> GetConversationsRequest -> ShowS
$cshow :: GetConversationsRequest -> String
show :: GetConversationsRequest -> String
$cshowList :: [GetConversationsRequest] -> ShowS
showList :: [GetConversationsRequest] -> ShowS
Show, (forall x.
 GetConversationsRequest -> Rep GetConversationsRequest x)
-> (forall x.
    Rep GetConversationsRequest x -> GetConversationsRequest)
-> Generic GetConversationsRequest
forall x. Rep GetConversationsRequest x -> GetConversationsRequest
forall x. GetConversationsRequest -> Rep GetConversationsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetConversationsRequest -> Rep GetConversationsRequest x
from :: forall x. GetConversationsRequest -> Rep GetConversationsRequest x
$cto :: forall x. Rep GetConversationsRequest x -> GetConversationsRequest
to :: forall x. Rep GetConversationsRequest x -> GetConversationsRequest
Generic)
  deriving (Gen GetConversationsRequest
Gen GetConversationsRequest
-> (GetConversationsRequest -> [GetConversationsRequest])
-> Arbitrary GetConversationsRequest
GetConversationsRequest -> [GetConversationsRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GetConversationsRequest
arbitrary :: Gen GetConversationsRequest
$cshrink :: GetConversationsRequest -> [GetConversationsRequest]
shrink :: GetConversationsRequest -> [GetConversationsRequest]
Arbitrary) via (GenericUniform GetConversationsRequest)
  deriving ([GetConversationsRequest] -> Value
[GetConversationsRequest] -> Encoding
GetConversationsRequest -> Value
GetConversationsRequest -> Encoding
(GetConversationsRequest -> Value)
-> (GetConversationsRequest -> Encoding)
-> ([GetConversationsRequest] -> Value)
-> ([GetConversationsRequest] -> Encoding)
-> ToJSON GetConversationsRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GetConversationsRequest -> Value
toJSON :: GetConversationsRequest -> Value
$ctoEncoding :: GetConversationsRequest -> Encoding
toEncoding :: GetConversationsRequest -> Encoding
$ctoJSONList :: [GetConversationsRequest] -> Value
toJSONList :: [GetConversationsRequest] -> Value
$ctoEncodingList :: [GetConversationsRequest] -> Encoding
toEncodingList :: [GetConversationsRequest] -> Encoding
ToJSON, Value -> Parser [GetConversationsRequest]
Value -> Parser GetConversationsRequest
(Value -> Parser GetConversationsRequest)
-> (Value -> Parser [GetConversationsRequest])
-> FromJSON GetConversationsRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GetConversationsRequest
parseJSON :: Value -> Parser GetConversationsRequest
$cparseJSONList :: Value -> Parser [GetConversationsRequest]
parseJSONList :: Value -> Parser [GetConversationsRequest]
FromJSON) via (CustomEncoded GetConversationsRequest)

instance ToSchema GetConversationsRequest

data GetOne2OneConversationRequest = GetOne2OneConversationRequest
  { -- The user on the sender's domain
    GetOne2OneConversationRequest -> UserId
goocSenderUser :: UserId,
    -- The user on the receiver's domain
    GetOne2OneConversationRequest -> UserId
goocReceiverUser :: UserId
  }
  deriving stock (GetOne2OneConversationRequest
-> GetOne2OneConversationRequest -> Bool
(GetOne2OneConversationRequest
 -> GetOne2OneConversationRequest -> Bool)
-> (GetOne2OneConversationRequest
    -> GetOne2OneConversationRequest -> Bool)
-> Eq GetOne2OneConversationRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetOne2OneConversationRequest
-> GetOne2OneConversationRequest -> Bool
== :: GetOne2OneConversationRequest
-> GetOne2OneConversationRequest -> Bool
$c/= :: GetOne2OneConversationRequest
-> GetOne2OneConversationRequest -> Bool
/= :: GetOne2OneConversationRequest
-> GetOne2OneConversationRequest -> Bool
Eq, Int -> GetOne2OneConversationRequest -> ShowS
[GetOne2OneConversationRequest] -> ShowS
GetOne2OneConversationRequest -> String
(Int -> GetOne2OneConversationRequest -> ShowS)
-> (GetOne2OneConversationRequest -> String)
-> ([GetOne2OneConversationRequest] -> ShowS)
-> Show GetOne2OneConversationRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetOne2OneConversationRequest -> ShowS
showsPrec :: Int -> GetOne2OneConversationRequest -> ShowS
$cshow :: GetOne2OneConversationRequest -> String
show :: GetOne2OneConversationRequest -> String
$cshowList :: [GetOne2OneConversationRequest] -> ShowS
showList :: [GetOne2OneConversationRequest] -> ShowS
Show, (forall x.
 GetOne2OneConversationRequest
 -> Rep GetOne2OneConversationRequest x)
-> (forall x.
    Rep GetOne2OneConversationRequest x
    -> GetOne2OneConversationRequest)
-> Generic GetOne2OneConversationRequest
forall x.
Rep GetOne2OneConversationRequest x
-> GetOne2OneConversationRequest
forall x.
GetOne2OneConversationRequest
-> Rep GetOne2OneConversationRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetOne2OneConversationRequest
-> Rep GetOne2OneConversationRequest x
from :: forall x.
GetOne2OneConversationRequest
-> Rep GetOne2OneConversationRequest x
$cto :: forall x.
Rep GetOne2OneConversationRequest x
-> GetOne2OneConversationRequest
to :: forall x.
Rep GetOne2OneConversationRequest x
-> GetOne2OneConversationRequest
Generic)
  deriving (Gen GetOne2OneConversationRequest
Gen GetOne2OneConversationRequest
-> (GetOne2OneConversationRequest
    -> [GetOne2OneConversationRequest])
-> Arbitrary GetOne2OneConversationRequest
GetOne2OneConversationRequest -> [GetOne2OneConversationRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GetOne2OneConversationRequest
arbitrary :: Gen GetOne2OneConversationRequest
$cshrink :: GetOne2OneConversationRequest -> [GetOne2OneConversationRequest]
shrink :: GetOne2OneConversationRequest -> [GetOne2OneConversationRequest]
Arbitrary) via (GenericUniform GetOne2OneConversationRequest)
  deriving ([GetOne2OneConversationRequest] -> Value
[GetOne2OneConversationRequest] -> Encoding
GetOne2OneConversationRequest -> Value
GetOne2OneConversationRequest -> Encoding
(GetOne2OneConversationRequest -> Value)
-> (GetOne2OneConversationRequest -> Encoding)
-> ([GetOne2OneConversationRequest] -> Value)
-> ([GetOne2OneConversationRequest] -> Encoding)
-> ToJSON GetOne2OneConversationRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GetOne2OneConversationRequest -> Value
toJSON :: GetOne2OneConversationRequest -> Value
$ctoEncoding :: GetOne2OneConversationRequest -> Encoding
toEncoding :: GetOne2OneConversationRequest -> Encoding
$ctoJSONList :: [GetOne2OneConversationRequest] -> Value
toJSONList :: [GetOne2OneConversationRequest] -> Value
$ctoEncodingList :: [GetOne2OneConversationRequest] -> Encoding
toEncodingList :: [GetOne2OneConversationRequest] -> Encoding
ToJSON, Value -> Parser [GetOne2OneConversationRequest]
Value -> Parser GetOne2OneConversationRequest
(Value -> Parser GetOne2OneConversationRequest)
-> (Value -> Parser [GetOne2OneConversationRequest])
-> FromJSON GetOne2OneConversationRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GetOne2OneConversationRequest
parseJSON :: Value -> Parser GetOne2OneConversationRequest
$cparseJSONList :: Value -> Parser [GetOne2OneConversationRequest]
parseJSONList :: Value -> Parser [GetOne2OneConversationRequest]
FromJSON) via (CustomEncoded GetOne2OneConversationRequest)

instance ToSchema GetOne2OneConversationRequest

data RemoteConvMembers = RemoteConvMembers
  { RemoteConvMembers -> RoleName
selfRole :: RoleName,
    RemoteConvMembers -> [OtherMember]
others :: [OtherMember]
  }
  deriving stock (RemoteConvMembers -> RemoteConvMembers -> Bool
(RemoteConvMembers -> RemoteConvMembers -> Bool)
-> (RemoteConvMembers -> RemoteConvMembers -> Bool)
-> Eq RemoteConvMembers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteConvMembers -> RemoteConvMembers -> Bool
== :: RemoteConvMembers -> RemoteConvMembers -> Bool
$c/= :: RemoteConvMembers -> RemoteConvMembers -> Bool
/= :: RemoteConvMembers -> RemoteConvMembers -> Bool
Eq, Int -> RemoteConvMembers -> ShowS
[RemoteConvMembers] -> ShowS
RemoteConvMembers -> String
(Int -> RemoteConvMembers -> ShowS)
-> (RemoteConvMembers -> String)
-> ([RemoteConvMembers] -> ShowS)
-> Show RemoteConvMembers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteConvMembers -> ShowS
showsPrec :: Int -> RemoteConvMembers -> ShowS
$cshow :: RemoteConvMembers -> String
show :: RemoteConvMembers -> String
$cshowList :: [RemoteConvMembers] -> ShowS
showList :: [RemoteConvMembers] -> ShowS
Show, (forall x. RemoteConvMembers -> Rep RemoteConvMembers x)
-> (forall x. Rep RemoteConvMembers x -> RemoteConvMembers)
-> Generic RemoteConvMembers
forall x. Rep RemoteConvMembers x -> RemoteConvMembers
forall x. RemoteConvMembers -> Rep RemoteConvMembers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteConvMembers -> Rep RemoteConvMembers x
from :: forall x. RemoteConvMembers -> Rep RemoteConvMembers x
$cto :: forall x. Rep RemoteConvMembers x -> RemoteConvMembers
to :: forall x. Rep RemoteConvMembers x -> RemoteConvMembers
Generic)
  deriving (Gen RemoteConvMembers
Gen RemoteConvMembers
-> (RemoteConvMembers -> [RemoteConvMembers])
-> Arbitrary RemoteConvMembers
RemoteConvMembers -> [RemoteConvMembers]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen RemoteConvMembers
arbitrary :: Gen RemoteConvMembers
$cshrink :: RemoteConvMembers -> [RemoteConvMembers]
shrink :: RemoteConvMembers -> [RemoteConvMembers]
Arbitrary) via (GenericUniform RemoteConvMembers)
  deriving (Value -> Parser [RemoteConvMembers]
Value -> Parser RemoteConvMembers
(Value -> Parser RemoteConvMembers)
-> (Value -> Parser [RemoteConvMembers])
-> FromJSON RemoteConvMembers
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RemoteConvMembers
parseJSON :: Value -> Parser RemoteConvMembers
$cparseJSONList :: Value -> Parser [RemoteConvMembers]
parseJSONList :: Value -> Parser [RemoteConvMembers]
FromJSON, [RemoteConvMembers] -> Value
[RemoteConvMembers] -> Encoding
RemoteConvMembers -> Value
RemoteConvMembers -> Encoding
(RemoteConvMembers -> Value)
-> (RemoteConvMembers -> Encoding)
-> ([RemoteConvMembers] -> Value)
-> ([RemoteConvMembers] -> Encoding)
-> ToJSON RemoteConvMembers
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RemoteConvMembers -> Value
toJSON :: RemoteConvMembers -> Value
$ctoEncoding :: RemoteConvMembers -> Encoding
toEncoding :: RemoteConvMembers -> Encoding
$ctoJSONList :: [RemoteConvMembers] -> Value
toJSONList :: [RemoteConvMembers] -> Value
$ctoEncodingList :: [RemoteConvMembers] -> Encoding
toEncodingList :: [RemoteConvMembers] -> Encoding
ToJSON) via (CustomEncoded RemoteConvMembers)

instance ToSchema RemoteConvMembers

-- | A conversation hosted on a remote backend. This contains the same
-- information as a 'Conversation', with the exception that conversation status
-- fields (muted\/archived\/hidden) are omitted, since they are not known by the
-- remote backend.
data RemoteConversation = RemoteConversation
  { -- | Id of the conversation, implicitly qualified with the domain of the
    -- backend that created this value.
    RemoteConversation -> ConvId
id :: ConvId,
    RemoteConversation -> ConversationMetadata
metadata :: ConversationMetadata,
    RemoteConversation -> RemoteConvMembers
members :: RemoteConvMembers,
    RemoteConversation -> Versioned 'V5 Protocol
protocol :: ClientAPI.Versioned 'ClientAPI.V5 Protocol
  }
  deriving stock (RemoteConversation -> RemoteConversation -> Bool
(RemoteConversation -> RemoteConversation -> Bool)
-> (RemoteConversation -> RemoteConversation -> Bool)
-> Eq RemoteConversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteConversation -> RemoteConversation -> Bool
== :: RemoteConversation -> RemoteConversation -> Bool
$c/= :: RemoteConversation -> RemoteConversation -> Bool
/= :: RemoteConversation -> RemoteConversation -> Bool
Eq, Int -> RemoteConversation -> ShowS
[RemoteConversation] -> ShowS
RemoteConversation -> String
(Int -> RemoteConversation -> ShowS)
-> (RemoteConversation -> String)
-> ([RemoteConversation] -> ShowS)
-> Show RemoteConversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteConversation -> ShowS
showsPrec :: Int -> RemoteConversation -> ShowS
$cshow :: RemoteConversation -> String
show :: RemoteConversation -> String
$cshowList :: [RemoteConversation] -> ShowS
showList :: [RemoteConversation] -> ShowS
Show, (forall x. RemoteConversation -> Rep RemoteConversation x)
-> (forall x. Rep RemoteConversation x -> RemoteConversation)
-> Generic RemoteConversation
forall x. Rep RemoteConversation x -> RemoteConversation
forall x. RemoteConversation -> Rep RemoteConversation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteConversation -> Rep RemoteConversation x
from :: forall x. RemoteConversation -> Rep RemoteConversation x
$cto :: forall x. Rep RemoteConversation x -> RemoteConversation
to :: forall x. Rep RemoteConversation x -> RemoteConversation
Generic)
  deriving (Gen RemoteConversation
Gen RemoteConversation
-> (RemoteConversation -> [RemoteConversation])
-> Arbitrary RemoteConversation
RemoteConversation -> [RemoteConversation]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen RemoteConversation
arbitrary :: Gen RemoteConversation
$cshrink :: RemoteConversation -> [RemoteConversation]
shrink :: RemoteConversation -> [RemoteConversation]
Arbitrary) via (GenericUniform RemoteConversation)
  deriving (Value -> Parser [RemoteConversation]
Value -> Parser RemoteConversation
(Value -> Parser RemoteConversation)
-> (Value -> Parser [RemoteConversation])
-> FromJSON RemoteConversation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RemoteConversation
parseJSON :: Value -> Parser RemoteConversation
$cparseJSONList :: Value -> Parser [RemoteConversation]
parseJSONList :: Value -> Parser [RemoteConversation]
FromJSON, [RemoteConversation] -> Value
[RemoteConversation] -> Encoding
RemoteConversation -> Value
RemoteConversation -> Encoding
(RemoteConversation -> Value)
-> (RemoteConversation -> Encoding)
-> ([RemoteConversation] -> Value)
-> ([RemoteConversation] -> Encoding)
-> ToJSON RemoteConversation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RemoteConversation -> Value
toJSON :: RemoteConversation -> Value
$ctoEncoding :: RemoteConversation -> Encoding
toEncoding :: RemoteConversation -> Encoding
$ctoJSONList :: [RemoteConversation] -> Value
toJSONList :: [RemoteConversation] -> Value
$ctoEncodingList :: [RemoteConversation] -> Encoding
toEncodingList :: [RemoteConversation] -> Encoding
ToJSON) via (CustomEncoded RemoteConversation)

instance ToSchema RemoteConversation

-- | A conversation hosted on a remote backend. This contains the same
-- information as a 'Conversation', with the exception that conversation status
-- fields (muted\/archived\/hidden) are omitted, since they are not known by the
-- remote backend.
data RemoteConversationV2 = RemoteConversationV2
  { -- | Id of the conversation, implicitly qualified with the domain of the
    -- backend that created this value.
    RemoteConversationV2 -> ConvId
id :: ConvId,
    RemoteConversationV2 -> ConversationMetadata
metadata :: ConversationMetadata,
    RemoteConversationV2 -> RemoteConvMembers
members :: RemoteConvMembers,
    RemoteConversationV2 -> Protocol
protocol :: Protocol
  }
  deriving stock (RemoteConversationV2 -> RemoteConversationV2 -> Bool
(RemoteConversationV2 -> RemoteConversationV2 -> Bool)
-> (RemoteConversationV2 -> RemoteConversationV2 -> Bool)
-> Eq RemoteConversationV2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteConversationV2 -> RemoteConversationV2 -> Bool
== :: RemoteConversationV2 -> RemoteConversationV2 -> Bool
$c/= :: RemoteConversationV2 -> RemoteConversationV2 -> Bool
/= :: RemoteConversationV2 -> RemoteConversationV2 -> Bool
Eq, Int -> RemoteConversationV2 -> ShowS
[RemoteConversationV2] -> ShowS
RemoteConversationV2 -> String
(Int -> RemoteConversationV2 -> ShowS)
-> (RemoteConversationV2 -> String)
-> ([RemoteConversationV2] -> ShowS)
-> Show RemoteConversationV2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteConversationV2 -> ShowS
showsPrec :: Int -> RemoteConversationV2 -> ShowS
$cshow :: RemoteConversationV2 -> String
show :: RemoteConversationV2 -> String
$cshowList :: [RemoteConversationV2] -> ShowS
showList :: [RemoteConversationV2] -> ShowS
Show, (forall x. RemoteConversationV2 -> Rep RemoteConversationV2 x)
-> (forall x. Rep RemoteConversationV2 x -> RemoteConversationV2)
-> Generic RemoteConversationV2
forall x. Rep RemoteConversationV2 x -> RemoteConversationV2
forall x. RemoteConversationV2 -> Rep RemoteConversationV2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteConversationV2 -> Rep RemoteConversationV2 x
from :: forall x. RemoteConversationV2 -> Rep RemoteConversationV2 x
$cto :: forall x. Rep RemoteConversationV2 x -> RemoteConversationV2
to :: forall x. Rep RemoteConversationV2 x -> RemoteConversationV2
Generic)
  deriving (Gen RemoteConversationV2
Gen RemoteConversationV2
-> (RemoteConversationV2 -> [RemoteConversationV2])
-> Arbitrary RemoteConversationV2
RemoteConversationV2 -> [RemoteConversationV2]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen RemoteConversationV2
arbitrary :: Gen RemoteConversationV2
$cshrink :: RemoteConversationV2 -> [RemoteConversationV2]
shrink :: RemoteConversationV2 -> [RemoteConversationV2]
Arbitrary) via (GenericUniform RemoteConversationV2)
  deriving (Value -> Parser [RemoteConversationV2]
Value -> Parser RemoteConversationV2
(Value -> Parser RemoteConversationV2)
-> (Value -> Parser [RemoteConversationV2])
-> FromJSON RemoteConversationV2
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RemoteConversationV2
parseJSON :: Value -> Parser RemoteConversationV2
$cparseJSONList :: Value -> Parser [RemoteConversationV2]
parseJSONList :: Value -> Parser [RemoteConversationV2]
FromJSON, [RemoteConversationV2] -> Value
[RemoteConversationV2] -> Encoding
RemoteConversationV2 -> Value
RemoteConversationV2 -> Encoding
(RemoteConversationV2 -> Value)
-> (RemoteConversationV2 -> Encoding)
-> ([RemoteConversationV2] -> Value)
-> ([RemoteConversationV2] -> Encoding)
-> ToJSON RemoteConversationV2
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RemoteConversationV2 -> Value
toJSON :: RemoteConversationV2 -> Value
$ctoEncoding :: RemoteConversationV2 -> Encoding
toEncoding :: RemoteConversationV2 -> Encoding
$ctoJSONList :: [RemoteConversationV2] -> Value
toJSONList :: [RemoteConversationV2] -> Value
$ctoEncodingList :: [RemoteConversationV2] -> Encoding
toEncodingList :: [RemoteConversationV2] -> Encoding
ToJSON) via (CustomEncoded RemoteConversationV2)

instance ToSchema RemoteConversationV2

remoteConversationFromV2 :: RemoteConversationV2 -> RemoteConversation
remoteConversationFromV2 :: RemoteConversationV2 -> RemoteConversation
remoteConversationFromV2 RemoteConversationV2
rc =
  RemoteConversation
    { $sel:id:RemoteConversation :: ConvId
id = RemoteConversationV2
rc.id,
      $sel:metadata:RemoteConversation :: ConversationMetadata
metadata = RemoteConversationV2
rc.metadata,
      $sel:members:RemoteConversation :: RemoteConvMembers
members = RemoteConversationV2
rc.members,
      $sel:protocol:RemoteConversation :: Versioned 'V5 Protocol
protocol = Protocol -> Versioned 'V5 Protocol
forall (v :: Version) a. a -> Versioned v a
ClientAPI.Versioned RemoteConversationV2
rc.protocol
    }

remoteConversationToV2 :: RemoteConversation -> RemoteConversationV2
remoteConversationToV2 :: RemoteConversation -> RemoteConversationV2
remoteConversationToV2 RemoteConversation
rc =
  RemoteConversationV2
    { $sel:id:RemoteConversationV2 :: ConvId
id = RemoteConversation
rc.id,
      $sel:metadata:RemoteConversationV2 :: ConversationMetadata
metadata = RemoteConversation
rc.metadata,
      $sel:members:RemoteConversationV2 :: RemoteConvMembers
members = RemoteConversation
rc.members,
      $sel:protocol:RemoteConversationV2 :: Protocol
protocol = RemoteConversation
rc.protocol.unVersioned
    }

newtype GetConversationsResponse = GetConversationsResponse
  { GetConversationsResponse -> [RemoteConversation]
convs :: [RemoteConversation]
  }
  deriving stock (GetConversationsResponse -> GetConversationsResponse -> Bool
(GetConversationsResponse -> GetConversationsResponse -> Bool)
-> (GetConversationsResponse -> GetConversationsResponse -> Bool)
-> Eq GetConversationsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetConversationsResponse -> GetConversationsResponse -> Bool
== :: GetConversationsResponse -> GetConversationsResponse -> Bool
$c/= :: GetConversationsResponse -> GetConversationsResponse -> Bool
/= :: GetConversationsResponse -> GetConversationsResponse -> Bool
Eq, Int -> GetConversationsResponse -> ShowS
[GetConversationsResponse] -> ShowS
GetConversationsResponse -> String
(Int -> GetConversationsResponse -> ShowS)
-> (GetConversationsResponse -> String)
-> ([GetConversationsResponse] -> ShowS)
-> Show GetConversationsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetConversationsResponse -> ShowS
showsPrec :: Int -> GetConversationsResponse -> ShowS
$cshow :: GetConversationsResponse -> String
show :: GetConversationsResponse -> String
$cshowList :: [GetConversationsResponse] -> ShowS
showList :: [GetConversationsResponse] -> ShowS
Show, (forall x.
 GetConversationsResponse -> Rep GetConversationsResponse x)
-> (forall x.
    Rep GetConversationsResponse x -> GetConversationsResponse)
-> Generic GetConversationsResponse
forall x.
Rep GetConversationsResponse x -> GetConversationsResponse
forall x.
GetConversationsResponse -> Rep GetConversationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetConversationsResponse -> Rep GetConversationsResponse x
from :: forall x.
GetConversationsResponse -> Rep GetConversationsResponse x
$cto :: forall x.
Rep GetConversationsResponse x -> GetConversationsResponse
to :: forall x.
Rep GetConversationsResponse x -> GetConversationsResponse
Generic)
  deriving (Gen GetConversationsResponse
Gen GetConversationsResponse
-> (GetConversationsResponse -> [GetConversationsResponse])
-> Arbitrary GetConversationsResponse
GetConversationsResponse -> [GetConversationsResponse]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GetConversationsResponse
arbitrary :: Gen GetConversationsResponse
$cshrink :: GetConversationsResponse -> [GetConversationsResponse]
shrink :: GetConversationsResponse -> [GetConversationsResponse]
Arbitrary) via (GenericUniform GetConversationsResponse)
  deriving ([GetConversationsResponse] -> Value
[GetConversationsResponse] -> Encoding
GetConversationsResponse -> Value
GetConversationsResponse -> Encoding
(GetConversationsResponse -> Value)
-> (GetConversationsResponse -> Encoding)
-> ([GetConversationsResponse] -> Value)
-> ([GetConversationsResponse] -> Encoding)
-> ToJSON GetConversationsResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GetConversationsResponse -> Value
toJSON :: GetConversationsResponse -> Value
$ctoEncoding :: GetConversationsResponse -> Encoding
toEncoding :: GetConversationsResponse -> Encoding
$ctoJSONList :: [GetConversationsResponse] -> Value
toJSONList :: [GetConversationsResponse] -> Value
$ctoEncodingList :: [GetConversationsResponse] -> Encoding
toEncodingList :: [GetConversationsResponse] -> Encoding
ToJSON, Value -> Parser [GetConversationsResponse]
Value -> Parser GetConversationsResponse
(Value -> Parser GetConversationsResponse)
-> (Value -> Parser [GetConversationsResponse])
-> FromJSON GetConversationsResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GetConversationsResponse
parseJSON :: Value -> Parser GetConversationsResponse
$cparseJSONList :: Value -> Parser [GetConversationsResponse]
parseJSONList :: Value -> Parser [GetConversationsResponse]
FromJSON) via (CustomEncoded GetConversationsResponse)

instance ToSchema GetConversationsResponse

newtype GetConversationsResponseV2 = GetConversationsResponseV2
  { GetConversationsResponseV2 -> [RemoteConversationV2]
convs :: [RemoteConversationV2]
  }
  deriving stock (GetConversationsResponseV2 -> GetConversationsResponseV2 -> Bool
(GetConversationsResponseV2 -> GetConversationsResponseV2 -> Bool)
-> (GetConversationsResponseV2
    -> GetConversationsResponseV2 -> Bool)
-> Eq GetConversationsResponseV2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetConversationsResponseV2 -> GetConversationsResponseV2 -> Bool
== :: GetConversationsResponseV2 -> GetConversationsResponseV2 -> Bool
$c/= :: GetConversationsResponseV2 -> GetConversationsResponseV2 -> Bool
/= :: GetConversationsResponseV2 -> GetConversationsResponseV2 -> Bool
Eq, Int -> GetConversationsResponseV2 -> ShowS
[GetConversationsResponseV2] -> ShowS
GetConversationsResponseV2 -> String
(Int -> GetConversationsResponseV2 -> ShowS)
-> (GetConversationsResponseV2 -> String)
-> ([GetConversationsResponseV2] -> ShowS)
-> Show GetConversationsResponseV2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetConversationsResponseV2 -> ShowS
showsPrec :: Int -> GetConversationsResponseV2 -> ShowS
$cshow :: GetConversationsResponseV2 -> String
show :: GetConversationsResponseV2 -> String
$cshowList :: [GetConversationsResponseV2] -> ShowS
showList :: [GetConversationsResponseV2] -> ShowS
Show, (forall x.
 GetConversationsResponseV2 -> Rep GetConversationsResponseV2 x)
-> (forall x.
    Rep GetConversationsResponseV2 x -> GetConversationsResponseV2)
-> Generic GetConversationsResponseV2
forall x.
Rep GetConversationsResponseV2 x -> GetConversationsResponseV2
forall x.
GetConversationsResponseV2 -> Rep GetConversationsResponseV2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetConversationsResponseV2 -> Rep GetConversationsResponseV2 x
from :: forall x.
GetConversationsResponseV2 -> Rep GetConversationsResponseV2 x
$cto :: forall x.
Rep GetConversationsResponseV2 x -> GetConversationsResponseV2
to :: forall x.
Rep GetConversationsResponseV2 x -> GetConversationsResponseV2
Generic)
  deriving (Gen GetConversationsResponseV2
Gen GetConversationsResponseV2
-> (GetConversationsResponseV2 -> [GetConversationsResponseV2])
-> Arbitrary GetConversationsResponseV2
GetConversationsResponseV2 -> [GetConversationsResponseV2]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GetConversationsResponseV2
arbitrary :: Gen GetConversationsResponseV2
$cshrink :: GetConversationsResponseV2 -> [GetConversationsResponseV2]
shrink :: GetConversationsResponseV2 -> [GetConversationsResponseV2]
Arbitrary) via (GenericUniform GetConversationsResponseV2)
  deriving ([GetConversationsResponseV2] -> Value
[GetConversationsResponseV2] -> Encoding
GetConversationsResponseV2 -> Value
GetConversationsResponseV2 -> Encoding
(GetConversationsResponseV2 -> Value)
-> (GetConversationsResponseV2 -> Encoding)
-> ([GetConversationsResponseV2] -> Value)
-> ([GetConversationsResponseV2] -> Encoding)
-> ToJSON GetConversationsResponseV2
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GetConversationsResponseV2 -> Value
toJSON :: GetConversationsResponseV2 -> Value
$ctoEncoding :: GetConversationsResponseV2 -> Encoding
toEncoding :: GetConversationsResponseV2 -> Encoding
$ctoJSONList :: [GetConversationsResponseV2] -> Value
toJSONList :: [GetConversationsResponseV2] -> Value
$ctoEncodingList :: [GetConversationsResponseV2] -> Encoding
toEncodingList :: [GetConversationsResponseV2] -> Encoding
ToJSON, Value -> Parser [GetConversationsResponseV2]
Value -> Parser GetConversationsResponseV2
(Value -> Parser GetConversationsResponseV2)
-> (Value -> Parser [GetConversationsResponseV2])
-> FromJSON GetConversationsResponseV2
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GetConversationsResponseV2
parseJSON :: Value -> Parser GetConversationsResponseV2
$cparseJSONList :: Value -> Parser [GetConversationsResponseV2]
parseJSONList :: Value -> Parser [GetConversationsResponseV2]
FromJSON) via (CustomEncoded GetConversationsResponseV2)

instance ToSchema GetConversationsResponseV2

getConversationsResponseToV2 :: GetConversationsResponse -> GetConversationsResponseV2
getConversationsResponseToV2 :: GetConversationsResponse -> GetConversationsResponseV2
getConversationsResponseToV2 GetConversationsResponse
res = [RemoteConversationV2] -> GetConversationsResponseV2
GetConversationsResponseV2 ((RemoteConversation -> RemoteConversationV2)
-> [RemoteConversation] -> [RemoteConversationV2]
forall a b. (a -> b) -> [a] -> [b]
map RemoteConversation -> RemoteConversationV2
remoteConversationToV2 GetConversationsResponse
res.convs)

getConversationsResponseFromV2 :: GetConversationsResponseV2 -> GetConversationsResponse
getConversationsResponseFromV2 :: GetConversationsResponseV2 -> GetConversationsResponse
getConversationsResponseFromV2 GetConversationsResponseV2
res = [RemoteConversation] -> GetConversationsResponse
GetConversationsResponse ((RemoteConversationV2 -> RemoteConversation)
-> [RemoteConversationV2] -> [RemoteConversation]
forall a b. (a -> b) -> [a] -> [b]
map RemoteConversationV2 -> RemoteConversation
remoteConversationFromV2 GetConversationsResponseV2
res.convs)

data GetOne2OneConversationResponse
  = GetOne2OneConversationOk RemoteConversation
  | -- | This is returned when the local backend is asked for a 1-1 conversation
    -- that should reside on the other backend.
    GetOne2OneConversationBackendMismatch
  | -- | This is returned when a 1-1 conversation between two unconnected users
    -- is requested.
    GetOne2OneConversationNotConnected
  deriving stock (GetOne2OneConversationResponse
-> GetOne2OneConversationResponse -> Bool
(GetOne2OneConversationResponse
 -> GetOne2OneConversationResponse -> Bool)
-> (GetOne2OneConversationResponse
    -> GetOne2OneConversationResponse -> Bool)
-> Eq GetOne2OneConversationResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetOne2OneConversationResponse
-> GetOne2OneConversationResponse -> Bool
== :: GetOne2OneConversationResponse
-> GetOne2OneConversationResponse -> Bool
$c/= :: GetOne2OneConversationResponse
-> GetOne2OneConversationResponse -> Bool
/= :: GetOne2OneConversationResponse
-> GetOne2OneConversationResponse -> Bool
Eq, Int -> GetOne2OneConversationResponse -> ShowS
[GetOne2OneConversationResponse] -> ShowS
GetOne2OneConversationResponse -> String
(Int -> GetOne2OneConversationResponse -> ShowS)
-> (GetOne2OneConversationResponse -> String)
-> ([GetOne2OneConversationResponse] -> ShowS)
-> Show GetOne2OneConversationResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetOne2OneConversationResponse -> ShowS
showsPrec :: Int -> GetOne2OneConversationResponse -> ShowS
$cshow :: GetOne2OneConversationResponse -> String
show :: GetOne2OneConversationResponse -> String
$cshowList :: [GetOne2OneConversationResponse] -> ShowS
showList :: [GetOne2OneConversationResponse] -> ShowS
Show, (forall x.
 GetOne2OneConversationResponse
 -> Rep GetOne2OneConversationResponse x)
-> (forall x.
    Rep GetOne2OneConversationResponse x
    -> GetOne2OneConversationResponse)
-> Generic GetOne2OneConversationResponse
forall x.
Rep GetOne2OneConversationResponse x
-> GetOne2OneConversationResponse
forall x.
GetOne2OneConversationResponse
-> Rep GetOne2OneConversationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetOne2OneConversationResponse
-> Rep GetOne2OneConversationResponse x
from :: forall x.
GetOne2OneConversationResponse
-> Rep GetOne2OneConversationResponse x
$cto :: forall x.
Rep GetOne2OneConversationResponse x
-> GetOne2OneConversationResponse
to :: forall x.
Rep GetOne2OneConversationResponse x
-> GetOne2OneConversationResponse
Generic)
  deriving (Gen GetOne2OneConversationResponse
Gen GetOne2OneConversationResponse
-> (GetOne2OneConversationResponse
    -> [GetOne2OneConversationResponse])
-> Arbitrary GetOne2OneConversationResponse
GetOne2OneConversationResponse -> [GetOne2OneConversationResponse]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GetOne2OneConversationResponse
arbitrary :: Gen GetOne2OneConversationResponse
$cshrink :: GetOne2OneConversationResponse -> [GetOne2OneConversationResponse]
shrink :: GetOne2OneConversationResponse -> [GetOne2OneConversationResponse]
Arbitrary) via (GenericUniform GetOne2OneConversationResponse)
  deriving ([GetOne2OneConversationResponse] -> Value
[GetOne2OneConversationResponse] -> Encoding
GetOne2OneConversationResponse -> Value
GetOne2OneConversationResponse -> Encoding
(GetOne2OneConversationResponse -> Value)
-> (GetOne2OneConversationResponse -> Encoding)
-> ([GetOne2OneConversationResponse] -> Value)
-> ([GetOne2OneConversationResponse] -> Encoding)
-> ToJSON GetOne2OneConversationResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GetOne2OneConversationResponse -> Value
toJSON :: GetOne2OneConversationResponse -> Value
$ctoEncoding :: GetOne2OneConversationResponse -> Encoding
toEncoding :: GetOne2OneConversationResponse -> Encoding
$ctoJSONList :: [GetOne2OneConversationResponse] -> Value
toJSONList :: [GetOne2OneConversationResponse] -> Value
$ctoEncodingList :: [GetOne2OneConversationResponse] -> Encoding
toEncodingList :: [GetOne2OneConversationResponse] -> Encoding
ToJSON, Value -> Parser [GetOne2OneConversationResponse]
Value -> Parser GetOne2OneConversationResponse
(Value -> Parser GetOne2OneConversationResponse)
-> (Value -> Parser [GetOne2OneConversationResponse])
-> FromJSON GetOne2OneConversationResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GetOne2OneConversationResponse
parseJSON :: Value -> Parser GetOne2OneConversationResponse
$cparseJSONList :: Value -> Parser [GetOne2OneConversationResponse]
parseJSONList :: Value -> Parser [GetOne2OneConversationResponse]
FromJSON) via (CustomEncoded GetOne2OneConversationResponse)

instance ToSchema GetOne2OneConversationResponse

data GetOne2OneConversationResponseV2
  = GetOne2OneConversationV2Ok RemoteMLSOne2OneConversation
  | -- | This is returned when the local backend is asked for a 1-1 conversation
    -- that should reside on the other backend.
    GetOne2OneConversationV2BackendMismatch
  | -- | This is returned when a 1-1 conversation between two unconnected users
    -- is requested.
    GetOne2OneConversationV2NotConnected
  | GetOne2OneConversationV2MLSNotEnabled
  deriving stock (GetOne2OneConversationResponseV2
-> GetOne2OneConversationResponseV2 -> Bool
(GetOne2OneConversationResponseV2
 -> GetOne2OneConversationResponseV2 -> Bool)
-> (GetOne2OneConversationResponseV2
    -> GetOne2OneConversationResponseV2 -> Bool)
-> Eq GetOne2OneConversationResponseV2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetOne2OneConversationResponseV2
-> GetOne2OneConversationResponseV2 -> Bool
== :: GetOne2OneConversationResponseV2
-> GetOne2OneConversationResponseV2 -> Bool
$c/= :: GetOne2OneConversationResponseV2
-> GetOne2OneConversationResponseV2 -> Bool
/= :: GetOne2OneConversationResponseV2
-> GetOne2OneConversationResponseV2 -> Bool
Eq, Int -> GetOne2OneConversationResponseV2 -> ShowS
[GetOne2OneConversationResponseV2] -> ShowS
GetOne2OneConversationResponseV2 -> String
(Int -> GetOne2OneConversationResponseV2 -> ShowS)
-> (GetOne2OneConversationResponseV2 -> String)
-> ([GetOne2OneConversationResponseV2] -> ShowS)
-> Show GetOne2OneConversationResponseV2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetOne2OneConversationResponseV2 -> ShowS
showsPrec :: Int -> GetOne2OneConversationResponseV2 -> ShowS
$cshow :: GetOne2OneConversationResponseV2 -> String
show :: GetOne2OneConversationResponseV2 -> String
$cshowList :: [GetOne2OneConversationResponseV2] -> ShowS
showList :: [GetOne2OneConversationResponseV2] -> ShowS
Show, (forall x.
 GetOne2OneConversationResponseV2
 -> Rep GetOne2OneConversationResponseV2 x)
-> (forall x.
    Rep GetOne2OneConversationResponseV2 x
    -> GetOne2OneConversationResponseV2)
-> Generic GetOne2OneConversationResponseV2
forall x.
Rep GetOne2OneConversationResponseV2 x
-> GetOne2OneConversationResponseV2
forall x.
GetOne2OneConversationResponseV2
-> Rep GetOne2OneConversationResponseV2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetOne2OneConversationResponseV2
-> Rep GetOne2OneConversationResponseV2 x
from :: forall x.
GetOne2OneConversationResponseV2
-> Rep GetOne2OneConversationResponseV2 x
$cto :: forall x.
Rep GetOne2OneConversationResponseV2 x
-> GetOne2OneConversationResponseV2
to :: forall x.
Rep GetOne2OneConversationResponseV2 x
-> GetOne2OneConversationResponseV2
Generic)
  deriving ([GetOne2OneConversationResponseV2] -> Value
[GetOne2OneConversationResponseV2] -> Encoding
GetOne2OneConversationResponseV2 -> Value
GetOne2OneConversationResponseV2 -> Encoding
(GetOne2OneConversationResponseV2 -> Value)
-> (GetOne2OneConversationResponseV2 -> Encoding)
-> ([GetOne2OneConversationResponseV2] -> Value)
-> ([GetOne2OneConversationResponseV2] -> Encoding)
-> ToJSON GetOne2OneConversationResponseV2
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GetOne2OneConversationResponseV2 -> Value
toJSON :: GetOne2OneConversationResponseV2 -> Value
$ctoEncoding :: GetOne2OneConversationResponseV2 -> Encoding
toEncoding :: GetOne2OneConversationResponseV2 -> Encoding
$ctoJSONList :: [GetOne2OneConversationResponseV2] -> Value
toJSONList :: [GetOne2OneConversationResponseV2] -> Value
$ctoEncodingList :: [GetOne2OneConversationResponseV2] -> Encoding
toEncodingList :: [GetOne2OneConversationResponseV2] -> Encoding
ToJSON, Value -> Parser [GetOne2OneConversationResponseV2]
Value -> Parser GetOne2OneConversationResponseV2
(Value -> Parser GetOne2OneConversationResponseV2)
-> (Value -> Parser [GetOne2OneConversationResponseV2])
-> FromJSON GetOne2OneConversationResponseV2
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GetOne2OneConversationResponseV2
parseJSON :: Value -> Parser GetOne2OneConversationResponseV2
$cparseJSONList :: Value -> Parser [GetOne2OneConversationResponseV2]
parseJSONList :: Value -> Parser [GetOne2OneConversationResponseV2]
FromJSON) via (CustomEncoded GetOne2OneConversationResponseV2)

instance ToSchema GetOne2OneConversationResponseV2

data RemoteMLSOne2OneConversation = RemoteMLSOne2OneConversation
  { RemoteMLSOne2OneConversation -> RemoteConversationV2
conversation :: RemoteConversationV2,
    RemoteMLSOne2OneConversation -> MLSKeysByPurpose MLSPublicKeys
publicKeys :: MLSKeysByPurpose MLSPublicKeys
  }
  deriving stock (RemoteMLSOne2OneConversation
-> RemoteMLSOne2OneConversation -> Bool
(RemoteMLSOne2OneConversation
 -> RemoteMLSOne2OneConversation -> Bool)
-> (RemoteMLSOne2OneConversation
    -> RemoteMLSOne2OneConversation -> Bool)
-> Eq RemoteMLSOne2OneConversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteMLSOne2OneConversation
-> RemoteMLSOne2OneConversation -> Bool
== :: RemoteMLSOne2OneConversation
-> RemoteMLSOne2OneConversation -> Bool
$c/= :: RemoteMLSOne2OneConversation
-> RemoteMLSOne2OneConversation -> Bool
/= :: RemoteMLSOne2OneConversation
-> RemoteMLSOne2OneConversation -> Bool
Eq, Int -> RemoteMLSOne2OneConversation -> ShowS
[RemoteMLSOne2OneConversation] -> ShowS
RemoteMLSOne2OneConversation -> String
(Int -> RemoteMLSOne2OneConversation -> ShowS)
-> (RemoteMLSOne2OneConversation -> String)
-> ([RemoteMLSOne2OneConversation] -> ShowS)
-> Show RemoteMLSOne2OneConversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteMLSOne2OneConversation -> ShowS
showsPrec :: Int -> RemoteMLSOne2OneConversation -> ShowS
$cshow :: RemoteMLSOne2OneConversation -> String
show :: RemoteMLSOne2OneConversation -> String
$cshowList :: [RemoteMLSOne2OneConversation] -> ShowS
showList :: [RemoteMLSOne2OneConversation] -> ShowS
Show, (forall x.
 RemoteMLSOne2OneConversation -> Rep RemoteMLSOne2OneConversation x)
-> (forall x.
    Rep RemoteMLSOne2OneConversation x -> RemoteMLSOne2OneConversation)
-> Generic RemoteMLSOne2OneConversation
forall x.
Rep RemoteMLSOne2OneConversation x -> RemoteMLSOne2OneConversation
forall x.
RemoteMLSOne2OneConversation -> Rep RemoteMLSOne2OneConversation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RemoteMLSOne2OneConversation -> Rep RemoteMLSOne2OneConversation x
from :: forall x.
RemoteMLSOne2OneConversation -> Rep RemoteMLSOne2OneConversation x
$cto :: forall x.
Rep RemoteMLSOne2OneConversation x -> RemoteMLSOne2OneConversation
to :: forall x.
Rep RemoteMLSOne2OneConversation x -> RemoteMLSOne2OneConversation
Generic)
  deriving ([RemoteMLSOne2OneConversation] -> Value
[RemoteMLSOne2OneConversation] -> Encoding
RemoteMLSOne2OneConversation -> Value
RemoteMLSOne2OneConversation -> Encoding
(RemoteMLSOne2OneConversation -> Value)
-> (RemoteMLSOne2OneConversation -> Encoding)
-> ([RemoteMLSOne2OneConversation] -> Value)
-> ([RemoteMLSOne2OneConversation] -> Encoding)
-> ToJSON RemoteMLSOne2OneConversation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RemoteMLSOne2OneConversation -> Value
toJSON :: RemoteMLSOne2OneConversation -> Value
$ctoEncoding :: RemoteMLSOne2OneConversation -> Encoding
toEncoding :: RemoteMLSOne2OneConversation -> Encoding
$ctoJSONList :: [RemoteMLSOne2OneConversation] -> Value
toJSONList :: [RemoteMLSOne2OneConversation] -> Value
$ctoEncodingList :: [RemoteMLSOne2OneConversation] -> Encoding
toEncodingList :: [RemoteMLSOne2OneConversation] -> Encoding
ToJSON, Value -> Parser [RemoteMLSOne2OneConversation]
Value -> Parser RemoteMLSOne2OneConversation
(Value -> Parser RemoteMLSOne2OneConversation)
-> (Value -> Parser [RemoteMLSOne2OneConversation])
-> FromJSON RemoteMLSOne2OneConversation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RemoteMLSOne2OneConversation
parseJSON :: Value -> Parser RemoteMLSOne2OneConversation
$cparseJSONList :: Value -> Parser [RemoteMLSOne2OneConversation]
parseJSONList :: Value -> Parser [RemoteMLSOne2OneConversation]
FromJSON) via (CustomEncoded RemoteMLSOne2OneConversation)

instance ToSchema RemoteMLSOne2OneConversation

-- | A record type describing a new federated conversation
--
-- FUTUREWORK: Think about extracting common conversation metadata into a
-- separarate data type that can be reused in several data types in this module.
data ConversationCreated conv = ConversationCreated
  { -- | The time when the conversation was created
    forall conv. ConversationCreated conv -> UTCTime
time :: UTCTime,
    -- | The user that created the conversation. This is implicitly qualified
    -- by the requesting domain, since it is impossible to create a regular/group
    -- conversation on a remote backend.
    forall conv. ConversationCreated conv -> UserId
origUserId :: UserId,
    -- | The conversation ID, local to the backend invoking the RPC
    forall conv. ConversationCreated conv -> conv
cnvId :: conv,
    -- | The conversation type
    forall conv. ConversationCreated conv -> ConvType
cnvType :: ConvType,
    forall conv. ConversationCreated conv -> [Access]
cnvAccess :: [Access],
    forall conv. ConversationCreated conv -> Set AccessRole
cnvAccessRoles :: Set AccessRole,
    -- | The conversation name,
    forall conv. ConversationCreated conv -> Maybe Text
cnvName :: Maybe Text,
    -- | Members of the conversation apart from the creator
    forall conv. ConversationCreated conv -> Set OtherMember
nonCreatorMembers :: Set OtherMember,
    forall conv. ConversationCreated conv -> Maybe Milliseconds
messageTimer :: Maybe Milliseconds,
    forall conv. ConversationCreated conv -> Maybe ReceiptMode
receiptMode :: Maybe ReceiptMode,
    forall conv. ConversationCreated conv -> Protocol
protocol :: Protocol
  }
  deriving stock (ConversationCreated conv -> ConversationCreated conv -> Bool
(ConversationCreated conv -> ConversationCreated conv -> Bool)
-> (ConversationCreated conv -> ConversationCreated conv -> Bool)
-> Eq (ConversationCreated conv)
forall conv.
Eq conv =>
ConversationCreated conv -> ConversationCreated conv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall conv.
Eq conv =>
ConversationCreated conv -> ConversationCreated conv -> Bool
== :: ConversationCreated conv -> ConversationCreated conv -> Bool
$c/= :: forall conv.
Eq conv =>
ConversationCreated conv -> ConversationCreated conv -> Bool
/= :: ConversationCreated conv -> ConversationCreated conv -> Bool
Eq, Int -> ConversationCreated conv -> ShowS
[ConversationCreated conv] -> ShowS
ConversationCreated conv -> String
(Int -> ConversationCreated conv -> ShowS)
-> (ConversationCreated conv -> String)
-> ([ConversationCreated conv] -> ShowS)
-> Show (ConversationCreated conv)
forall conv. Show conv => Int -> ConversationCreated conv -> ShowS
forall conv. Show conv => [ConversationCreated conv] -> ShowS
forall conv. Show conv => ConversationCreated conv -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall conv. Show conv => Int -> ConversationCreated conv -> ShowS
showsPrec :: Int -> ConversationCreated conv -> ShowS
$cshow :: forall conv. Show conv => ConversationCreated conv -> String
show :: ConversationCreated conv -> String
$cshowList :: forall conv. Show conv => [ConversationCreated conv] -> ShowS
showList :: [ConversationCreated conv] -> ShowS
Show, (forall x.
 ConversationCreated conv -> Rep (ConversationCreated conv) x)
-> (forall x.
    Rep (ConversationCreated conv) x -> ConversationCreated conv)
-> Generic (ConversationCreated conv)
forall x.
Rep (ConversationCreated conv) x -> ConversationCreated conv
forall x.
ConversationCreated conv -> Rep (ConversationCreated conv) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall conv x.
Rep (ConversationCreated conv) x -> ConversationCreated conv
forall conv x.
ConversationCreated conv -> Rep (ConversationCreated conv) x
$cfrom :: forall conv x.
ConversationCreated conv -> Rep (ConversationCreated conv) x
from :: forall x.
ConversationCreated conv -> Rep (ConversationCreated conv) x
$cto :: forall conv x.
Rep (ConversationCreated conv) x -> ConversationCreated conv
to :: forall x.
Rep (ConversationCreated conv) x -> ConversationCreated conv
Generic, (forall a b.
 (a -> b) -> ConversationCreated a -> ConversationCreated b)
-> (forall a b.
    a -> ConversationCreated b -> ConversationCreated a)
-> Functor ConversationCreated
forall a b. a -> ConversationCreated b -> ConversationCreated a
forall a b.
(a -> b) -> ConversationCreated a -> ConversationCreated b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> ConversationCreated a -> ConversationCreated b
fmap :: forall a b.
(a -> b) -> ConversationCreated a -> ConversationCreated b
$c<$ :: forall a b. a -> ConversationCreated b -> ConversationCreated a
<$ :: forall a b. a -> ConversationCreated b -> ConversationCreated a
Functor)
  deriving ([ConversationCreated conv] -> Value
[ConversationCreated conv] -> Encoding
ConversationCreated conv -> Value
ConversationCreated conv -> Encoding
(ConversationCreated conv -> Value)
-> (ConversationCreated conv -> Encoding)
-> ([ConversationCreated conv] -> Value)
-> ([ConversationCreated conv] -> Encoding)
-> ToJSON (ConversationCreated conv)
forall conv. ToJSON conv => [ConversationCreated conv] -> Value
forall conv. ToJSON conv => [ConversationCreated conv] -> Encoding
forall conv. ToJSON conv => ConversationCreated conv -> Value
forall conv. ToJSON conv => ConversationCreated conv -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall conv. ToJSON conv => ConversationCreated conv -> Value
toJSON :: ConversationCreated conv -> Value
$ctoEncoding :: forall conv. ToJSON conv => ConversationCreated conv -> Encoding
toEncoding :: ConversationCreated conv -> Encoding
$ctoJSONList :: forall conv. ToJSON conv => [ConversationCreated conv] -> Value
toJSONList :: [ConversationCreated conv] -> Value
$ctoEncodingList :: forall conv. ToJSON conv => [ConversationCreated conv] -> Encoding
toEncodingList :: [ConversationCreated conv] -> Encoding
ToJSON, Value -> Parser [ConversationCreated conv]
Value -> Parser (ConversationCreated conv)
(Value -> Parser (ConversationCreated conv))
-> (Value -> Parser [ConversationCreated conv])
-> FromJSON (ConversationCreated conv)
forall conv.
FromJSON conv =>
Value -> Parser [ConversationCreated conv]
forall conv.
FromJSON conv =>
Value -> Parser (ConversationCreated conv)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall conv.
FromJSON conv =>
Value -> Parser (ConversationCreated conv)
parseJSON :: Value -> Parser (ConversationCreated conv)
$cparseJSONList :: forall conv.
FromJSON conv =>
Value -> Parser [ConversationCreated conv]
parseJSONList :: Value -> Parser [ConversationCreated conv]
FromJSON) via (CustomEncoded (ConversationCreated conv))

instance (ToSchema a) => ToSchema (ConversationCreated a)

ccRemoteOrigUserId :: ConversationCreated (Remote ConvId) -> Remote UserId
ccRemoteOrigUserId :: ConversationCreated (Remote ConvId) -> Remote UserId
ccRemoteOrigUserId ConversationCreated (Remote ConvId)
cc = Remote ConvId -> UserId -> Remote UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs ConversationCreated (Remote ConvId)
cc.cnvId ConversationCreated (Remote ConvId)
cc.origUserId

data LeaveConversationRequest = LeaveConversationRequest
  { -- | The conversation is assumed to be owned by the target domain, which
    -- allows us to protect against relay attacks
    LeaveConversationRequest -> ConvId
convId :: ConvId,
    -- | The leaver is assumed to be owned by the origin domain, which allows us
    -- to protect against spoofing attacks
    LeaveConversationRequest -> UserId
leaver :: UserId
  }
  deriving stock ((forall x.
 LeaveConversationRequest -> Rep LeaveConversationRequest x)
-> (forall x.
    Rep LeaveConversationRequest x -> LeaveConversationRequest)
-> Generic LeaveConversationRequest
forall x.
Rep LeaveConversationRequest x -> LeaveConversationRequest
forall x.
LeaveConversationRequest -> Rep LeaveConversationRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
LeaveConversationRequest -> Rep LeaveConversationRequest x
from :: forall x.
LeaveConversationRequest -> Rep LeaveConversationRequest x
$cto :: forall x.
Rep LeaveConversationRequest x -> LeaveConversationRequest
to :: forall x.
Rep LeaveConversationRequest x -> LeaveConversationRequest
Generic, LeaveConversationRequest -> LeaveConversationRequest -> Bool
(LeaveConversationRequest -> LeaveConversationRequest -> Bool)
-> (LeaveConversationRequest -> LeaveConversationRequest -> Bool)
-> Eq LeaveConversationRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeaveConversationRequest -> LeaveConversationRequest -> Bool
== :: LeaveConversationRequest -> LeaveConversationRequest -> Bool
$c/= :: LeaveConversationRequest -> LeaveConversationRequest -> Bool
/= :: LeaveConversationRequest -> LeaveConversationRequest -> Bool
Eq, Int -> LeaveConversationRequest -> ShowS
[LeaveConversationRequest] -> ShowS
LeaveConversationRequest -> String
(Int -> LeaveConversationRequest -> ShowS)
-> (LeaveConversationRequest -> String)
-> ([LeaveConversationRequest] -> ShowS)
-> Show LeaveConversationRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeaveConversationRequest -> ShowS
showsPrec :: Int -> LeaveConversationRequest -> ShowS
$cshow :: LeaveConversationRequest -> String
show :: LeaveConversationRequest -> String
$cshowList :: [LeaveConversationRequest] -> ShowS
showList :: [LeaveConversationRequest] -> ShowS
Show)
  deriving ([LeaveConversationRequest] -> Value
[LeaveConversationRequest] -> Encoding
LeaveConversationRequest -> Value
LeaveConversationRequest -> Encoding
(LeaveConversationRequest -> Value)
-> (LeaveConversationRequest -> Encoding)
-> ([LeaveConversationRequest] -> Value)
-> ([LeaveConversationRequest] -> Encoding)
-> ToJSON LeaveConversationRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LeaveConversationRequest -> Value
toJSON :: LeaveConversationRequest -> Value
$ctoEncoding :: LeaveConversationRequest -> Encoding
toEncoding :: LeaveConversationRequest -> Encoding
$ctoJSONList :: [LeaveConversationRequest] -> Value
toJSONList :: [LeaveConversationRequest] -> Value
$ctoEncodingList :: [LeaveConversationRequest] -> Encoding
toEncodingList :: [LeaveConversationRequest] -> Encoding
ToJSON, Value -> Parser [LeaveConversationRequest]
Value -> Parser LeaveConversationRequest
(Value -> Parser LeaveConversationRequest)
-> (Value -> Parser [LeaveConversationRequest])
-> FromJSON LeaveConversationRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LeaveConversationRequest
parseJSON :: Value -> Parser LeaveConversationRequest
$cparseJSONList :: Value -> Parser [LeaveConversationRequest]
parseJSONList :: Value -> Parser [LeaveConversationRequest]
FromJSON) via (CustomEncoded LeaveConversationRequest)

instance ToSchema LeaveConversationRequest

-- | Error outcomes of the leave-conversation RPC.
data RemoveFromConversationError
  = RemoveFromConversationErrorRemovalNotAllowed
  | RemoveFromConversationErrorNotFound
  | RemoveFromConversationErrorUnchanged
  deriving stock (RemoveFromConversationError -> RemoveFromConversationError -> Bool
(RemoveFromConversationError
 -> RemoveFromConversationError -> Bool)
-> (RemoveFromConversationError
    -> RemoveFromConversationError -> Bool)
-> Eq RemoveFromConversationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoveFromConversationError -> RemoveFromConversationError -> Bool
== :: RemoveFromConversationError -> RemoveFromConversationError -> Bool
$c/= :: RemoveFromConversationError -> RemoveFromConversationError -> Bool
/= :: RemoveFromConversationError -> RemoveFromConversationError -> Bool
Eq, Int -> RemoveFromConversationError -> ShowS
[RemoveFromConversationError] -> ShowS
RemoveFromConversationError -> String
(Int -> RemoveFromConversationError -> ShowS)
-> (RemoveFromConversationError -> String)
-> ([RemoveFromConversationError] -> ShowS)
-> Show RemoveFromConversationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoveFromConversationError -> ShowS
showsPrec :: Int -> RemoveFromConversationError -> ShowS
$cshow :: RemoveFromConversationError -> String
show :: RemoveFromConversationError -> String
$cshowList :: [RemoveFromConversationError] -> ShowS
showList :: [RemoveFromConversationError] -> ShowS
Show, (forall x.
 RemoveFromConversationError -> Rep RemoveFromConversationError x)
-> (forall x.
    Rep RemoveFromConversationError x -> RemoveFromConversationError)
-> Generic RemoveFromConversationError
forall x.
Rep RemoveFromConversationError x -> RemoveFromConversationError
forall x.
RemoveFromConversationError -> Rep RemoveFromConversationError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RemoveFromConversationError -> Rep RemoveFromConversationError x
from :: forall x.
RemoveFromConversationError -> Rep RemoveFromConversationError x
$cto :: forall x.
Rep RemoveFromConversationError x -> RemoveFromConversationError
to :: forall x.
Rep RemoveFromConversationError x -> RemoveFromConversationError
Generic)
  deriving ([RemoveFromConversationError] -> Value
[RemoveFromConversationError] -> Encoding
RemoveFromConversationError -> Value
RemoveFromConversationError -> Encoding
(RemoveFromConversationError -> Value)
-> (RemoveFromConversationError -> Encoding)
-> ([RemoveFromConversationError] -> Value)
-> ([RemoveFromConversationError] -> Encoding)
-> ToJSON RemoveFromConversationError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RemoveFromConversationError -> Value
toJSON :: RemoveFromConversationError -> Value
$ctoEncoding :: RemoveFromConversationError -> Encoding
toEncoding :: RemoveFromConversationError -> Encoding
$ctoJSONList :: [RemoveFromConversationError] -> Value
toJSONList :: [RemoveFromConversationError] -> Value
$ctoEncodingList :: [RemoveFromConversationError] -> Encoding
toEncodingList :: [RemoveFromConversationError] -> Encoding
ToJSON, Value -> Parser [RemoveFromConversationError]
Value -> Parser RemoveFromConversationError
(Value -> Parser RemoveFromConversationError)
-> (Value -> Parser [RemoveFromConversationError])
-> FromJSON RemoveFromConversationError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RemoveFromConversationError
parseJSON :: Value -> Parser RemoveFromConversationError
$cparseJSONList :: Value -> Parser [RemoveFromConversationError]
parseJSONList :: Value -> Parser [RemoveFromConversationError]
FromJSON) via (CustomEncoded RemoveFromConversationError)

instance ToSchema RemoveFromConversationError

data RemoteMLSMessageResponse
  = RemoteMLSMessageOk
  | RemoteMLSMessageMLSNotEnabled
  deriving stock (RemoteMLSMessageResponse -> RemoteMLSMessageResponse -> Bool
(RemoteMLSMessageResponse -> RemoteMLSMessageResponse -> Bool)
-> (RemoteMLSMessageResponse -> RemoteMLSMessageResponse -> Bool)
-> Eq RemoteMLSMessageResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteMLSMessageResponse -> RemoteMLSMessageResponse -> Bool
== :: RemoteMLSMessageResponse -> RemoteMLSMessageResponse -> Bool
$c/= :: RemoteMLSMessageResponse -> RemoteMLSMessageResponse -> Bool
/= :: RemoteMLSMessageResponse -> RemoteMLSMessageResponse -> Bool
Eq, Int -> RemoteMLSMessageResponse -> ShowS
[RemoteMLSMessageResponse] -> ShowS
RemoteMLSMessageResponse -> String
(Int -> RemoteMLSMessageResponse -> ShowS)
-> (RemoteMLSMessageResponse -> String)
-> ([RemoteMLSMessageResponse] -> ShowS)
-> Show RemoteMLSMessageResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteMLSMessageResponse -> ShowS
showsPrec :: Int -> RemoteMLSMessageResponse -> ShowS
$cshow :: RemoteMLSMessageResponse -> String
show :: RemoteMLSMessageResponse -> String
$cshowList :: [RemoteMLSMessageResponse] -> ShowS
showList :: [RemoteMLSMessageResponse] -> ShowS
Show, (forall x.
 RemoteMLSMessageResponse -> Rep RemoteMLSMessageResponse x)
-> (forall x.
    Rep RemoteMLSMessageResponse x -> RemoteMLSMessageResponse)
-> Generic RemoteMLSMessageResponse
forall x.
Rep RemoteMLSMessageResponse x -> RemoteMLSMessageResponse
forall x.
RemoteMLSMessageResponse -> Rep RemoteMLSMessageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RemoteMLSMessageResponse -> Rep RemoteMLSMessageResponse x
from :: forall x.
RemoteMLSMessageResponse -> Rep RemoteMLSMessageResponse x
$cto :: forall x.
Rep RemoteMLSMessageResponse x -> RemoteMLSMessageResponse
to :: forall x.
Rep RemoteMLSMessageResponse x -> RemoteMLSMessageResponse
Generic)
  deriving ([RemoteMLSMessageResponse] -> Value
[RemoteMLSMessageResponse] -> Encoding
RemoteMLSMessageResponse -> Value
RemoteMLSMessageResponse -> Encoding
(RemoteMLSMessageResponse -> Value)
-> (RemoteMLSMessageResponse -> Encoding)
-> ([RemoteMLSMessageResponse] -> Value)
-> ([RemoteMLSMessageResponse] -> Encoding)
-> ToJSON RemoteMLSMessageResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RemoteMLSMessageResponse -> Value
toJSON :: RemoteMLSMessageResponse -> Value
$ctoEncoding :: RemoteMLSMessageResponse -> Encoding
toEncoding :: RemoteMLSMessageResponse -> Encoding
$ctoJSONList :: [RemoteMLSMessageResponse] -> Value
toJSONList :: [RemoteMLSMessageResponse] -> Value
$ctoEncodingList :: [RemoteMLSMessageResponse] -> Encoding
toEncodingList :: [RemoteMLSMessageResponse] -> Encoding
ToJSON, Value -> Parser [RemoteMLSMessageResponse]
Value -> Parser RemoteMLSMessageResponse
(Value -> Parser RemoteMLSMessageResponse)
-> (Value -> Parser [RemoteMLSMessageResponse])
-> FromJSON RemoteMLSMessageResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RemoteMLSMessageResponse
parseJSON :: Value -> Parser RemoteMLSMessageResponse
$cparseJSONList :: Value -> Parser [RemoteMLSMessageResponse]
parseJSONList :: Value -> Parser [RemoteMLSMessageResponse]
FromJSON) via (CustomEncoded RemoteMLSMessageResponse)

instance ToSchema RemoteMLSMessageResponse

data ProteusMessageSendRequest = ProteusMessageSendRequest
  { -- | Conversation is assumed to be owned by the target domain, this allows
    -- us to protect against relay attacks
    ProteusMessageSendRequest -> ConvId
convId :: ConvId,
    -- | Sender is assumed to be owned by the origin domain, this allows us to
    -- protect against spoofing attacks
    ProteusMessageSendRequest -> UserId
sender :: UserId,
    ProteusMessageSendRequest -> Base64ByteString
rawMessage :: Base64ByteString
  }
  deriving stock (ProteusMessageSendRequest -> ProteusMessageSendRequest -> Bool
(ProteusMessageSendRequest -> ProteusMessageSendRequest -> Bool)
-> (ProteusMessageSendRequest -> ProteusMessageSendRequest -> Bool)
-> Eq ProteusMessageSendRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProteusMessageSendRequest -> ProteusMessageSendRequest -> Bool
== :: ProteusMessageSendRequest -> ProteusMessageSendRequest -> Bool
$c/= :: ProteusMessageSendRequest -> ProteusMessageSendRequest -> Bool
/= :: ProteusMessageSendRequest -> ProteusMessageSendRequest -> Bool
Eq, Int -> ProteusMessageSendRequest -> ShowS
[ProteusMessageSendRequest] -> ShowS
ProteusMessageSendRequest -> String
(Int -> ProteusMessageSendRequest -> ShowS)
-> (ProteusMessageSendRequest -> String)
-> ([ProteusMessageSendRequest] -> ShowS)
-> Show ProteusMessageSendRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProteusMessageSendRequest -> ShowS
showsPrec :: Int -> ProteusMessageSendRequest -> ShowS
$cshow :: ProteusMessageSendRequest -> String
show :: ProteusMessageSendRequest -> String
$cshowList :: [ProteusMessageSendRequest] -> ShowS
showList :: [ProteusMessageSendRequest] -> ShowS
Show, (forall x.
 ProteusMessageSendRequest -> Rep ProteusMessageSendRequest x)
-> (forall x.
    Rep ProteusMessageSendRequest x -> ProteusMessageSendRequest)
-> Generic ProteusMessageSendRequest
forall x.
Rep ProteusMessageSendRequest x -> ProteusMessageSendRequest
forall x.
ProteusMessageSendRequest -> Rep ProteusMessageSendRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ProteusMessageSendRequest -> Rep ProteusMessageSendRequest x
from :: forall x.
ProteusMessageSendRequest -> Rep ProteusMessageSendRequest x
$cto :: forall x.
Rep ProteusMessageSendRequest x -> ProteusMessageSendRequest
to :: forall x.
Rep ProteusMessageSendRequest x -> ProteusMessageSendRequest
Generic)
  deriving (Gen ProteusMessageSendRequest
Gen ProteusMessageSendRequest
-> (ProteusMessageSendRequest -> [ProteusMessageSendRequest])
-> Arbitrary ProteusMessageSendRequest
ProteusMessageSendRequest -> [ProteusMessageSendRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ProteusMessageSendRequest
arbitrary :: Gen ProteusMessageSendRequest
$cshrink :: ProteusMessageSendRequest -> [ProteusMessageSendRequest]
shrink :: ProteusMessageSendRequest -> [ProteusMessageSendRequest]
Arbitrary) via (GenericUniform ProteusMessageSendRequest)
  deriving ([ProteusMessageSendRequest] -> Value
[ProteusMessageSendRequest] -> Encoding
ProteusMessageSendRequest -> Value
ProteusMessageSendRequest -> Encoding
(ProteusMessageSendRequest -> Value)
-> (ProteusMessageSendRequest -> Encoding)
-> ([ProteusMessageSendRequest] -> Value)
-> ([ProteusMessageSendRequest] -> Encoding)
-> ToJSON ProteusMessageSendRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ProteusMessageSendRequest -> Value
toJSON :: ProteusMessageSendRequest -> Value
$ctoEncoding :: ProteusMessageSendRequest -> Encoding
toEncoding :: ProteusMessageSendRequest -> Encoding
$ctoJSONList :: [ProteusMessageSendRequest] -> Value
toJSONList :: [ProteusMessageSendRequest] -> Value
$ctoEncodingList :: [ProteusMessageSendRequest] -> Encoding
toEncodingList :: [ProteusMessageSendRequest] -> Encoding
ToJSON, Value -> Parser [ProteusMessageSendRequest]
Value -> Parser ProteusMessageSendRequest
(Value -> Parser ProteusMessageSendRequest)
-> (Value -> Parser [ProteusMessageSendRequest])
-> FromJSON ProteusMessageSendRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ProteusMessageSendRequest
parseJSON :: Value -> Parser ProteusMessageSendRequest
$cparseJSONList :: Value -> Parser [ProteusMessageSendRequest]
parseJSONList :: Value -> Parser [ProteusMessageSendRequest]
FromJSON) via (CustomEncoded ProteusMessageSendRequest)

instance ToSchema ProteusMessageSendRequest

data MLSMessageSendRequest = MLSMessageSendRequest
  { -- | Conversation (or sub conversation) is assumed to be owned by the target
    -- domain, this allows us to protect against relay attacks
    MLSMessageSendRequest -> ConvOrSubConvId
convOrSubId :: ConvOrSubConvId,
    -- | Sender is assumed to be owned by the origin domain, this allows us to
    -- protect against spoofing attacks
    MLSMessageSendRequest -> UserId
sender :: UserId,
    MLSMessageSendRequest -> ClientId
senderClient :: ClientId,
    MLSMessageSendRequest -> Base64ByteString
rawMessage :: Base64ByteString
  }
  deriving stock (MLSMessageSendRequest -> MLSMessageSendRequest -> Bool
(MLSMessageSendRequest -> MLSMessageSendRequest -> Bool)
-> (MLSMessageSendRequest -> MLSMessageSendRequest -> Bool)
-> Eq MLSMessageSendRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLSMessageSendRequest -> MLSMessageSendRequest -> Bool
== :: MLSMessageSendRequest -> MLSMessageSendRequest -> Bool
$c/= :: MLSMessageSendRequest -> MLSMessageSendRequest -> Bool
/= :: MLSMessageSendRequest -> MLSMessageSendRequest -> Bool
Eq, Int -> MLSMessageSendRequest -> ShowS
[MLSMessageSendRequest] -> ShowS
MLSMessageSendRequest -> String
(Int -> MLSMessageSendRequest -> ShowS)
-> (MLSMessageSendRequest -> String)
-> ([MLSMessageSendRequest] -> ShowS)
-> Show MLSMessageSendRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLSMessageSendRequest -> ShowS
showsPrec :: Int -> MLSMessageSendRequest -> ShowS
$cshow :: MLSMessageSendRequest -> String
show :: MLSMessageSendRequest -> String
$cshowList :: [MLSMessageSendRequest] -> ShowS
showList :: [MLSMessageSendRequest] -> ShowS
Show, (forall x. MLSMessageSendRequest -> Rep MLSMessageSendRequest x)
-> (forall x. Rep MLSMessageSendRequest x -> MLSMessageSendRequest)
-> Generic MLSMessageSendRequest
forall x. Rep MLSMessageSendRequest x -> MLSMessageSendRequest
forall x. MLSMessageSendRequest -> Rep MLSMessageSendRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MLSMessageSendRequest -> Rep MLSMessageSendRequest x
from :: forall x. MLSMessageSendRequest -> Rep MLSMessageSendRequest x
$cto :: forall x. Rep MLSMessageSendRequest x -> MLSMessageSendRequest
to :: forall x. Rep MLSMessageSendRequest x -> MLSMessageSendRequest
Generic)
  deriving (Gen MLSMessageSendRequest
Gen MLSMessageSendRequest
-> (MLSMessageSendRequest -> [MLSMessageSendRequest])
-> Arbitrary MLSMessageSendRequest
MLSMessageSendRequest -> [MLSMessageSendRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen MLSMessageSendRequest
arbitrary :: Gen MLSMessageSendRequest
$cshrink :: MLSMessageSendRequest -> [MLSMessageSendRequest]
shrink :: MLSMessageSendRequest -> [MLSMessageSendRequest]
Arbitrary) via (GenericUniform MLSMessageSendRequest)
  deriving ([MLSMessageSendRequest] -> Value
[MLSMessageSendRequest] -> Encoding
MLSMessageSendRequest -> Value
MLSMessageSendRequest -> Encoding
(MLSMessageSendRequest -> Value)
-> (MLSMessageSendRequest -> Encoding)
-> ([MLSMessageSendRequest] -> Value)
-> ([MLSMessageSendRequest] -> Encoding)
-> ToJSON MLSMessageSendRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MLSMessageSendRequest -> Value
toJSON :: MLSMessageSendRequest -> Value
$ctoEncoding :: MLSMessageSendRequest -> Encoding
toEncoding :: MLSMessageSendRequest -> Encoding
$ctoJSONList :: [MLSMessageSendRequest] -> Value
toJSONList :: [MLSMessageSendRequest] -> Value
$ctoEncodingList :: [MLSMessageSendRequest] -> Encoding
toEncodingList :: [MLSMessageSendRequest] -> Encoding
ToJSON, Value -> Parser [MLSMessageSendRequest]
Value -> Parser MLSMessageSendRequest
(Value -> Parser MLSMessageSendRequest)
-> (Value -> Parser [MLSMessageSendRequest])
-> FromJSON MLSMessageSendRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MLSMessageSendRequest
parseJSON :: Value -> Parser MLSMessageSendRequest
$cparseJSONList :: Value -> Parser [MLSMessageSendRequest]
parseJSONList :: Value -> Parser [MLSMessageSendRequest]
FromJSON) via (CustomEncoded MLSMessageSendRequest)

instance ToSchema MLSMessageSendRequest

newtype MessageSendResponse = MessageSendResponse
  {MessageSendResponse -> PostOtrResponse MessageSendingStatus
response :: PostOtrResponse MessageSendingStatus}
  deriving stock (MessageSendResponse -> MessageSendResponse -> Bool
(MessageSendResponse -> MessageSendResponse -> Bool)
-> (MessageSendResponse -> MessageSendResponse -> Bool)
-> Eq MessageSendResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageSendResponse -> MessageSendResponse -> Bool
== :: MessageSendResponse -> MessageSendResponse -> Bool
$c/= :: MessageSendResponse -> MessageSendResponse -> Bool
/= :: MessageSendResponse -> MessageSendResponse -> Bool
Eq, Int -> MessageSendResponse -> ShowS
[MessageSendResponse] -> ShowS
MessageSendResponse -> String
(Int -> MessageSendResponse -> ShowS)
-> (MessageSendResponse -> String)
-> ([MessageSendResponse] -> ShowS)
-> Show MessageSendResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageSendResponse -> ShowS
showsPrec :: Int -> MessageSendResponse -> ShowS
$cshow :: MessageSendResponse -> String
show :: MessageSendResponse -> String
$cshowList :: [MessageSendResponse] -> ShowS
showList :: [MessageSendResponse] -> ShowS
Show, (forall x. MessageSendResponse -> Rep MessageSendResponse x)
-> (forall x. Rep MessageSendResponse x -> MessageSendResponse)
-> Generic MessageSendResponse
forall x. Rep MessageSendResponse x -> MessageSendResponse
forall x. MessageSendResponse -> Rep MessageSendResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageSendResponse -> Rep MessageSendResponse x
from :: forall x. MessageSendResponse -> Rep MessageSendResponse x
$cto :: forall x. Rep MessageSendResponse x -> MessageSendResponse
to :: forall x. Rep MessageSendResponse x -> MessageSendResponse
Generic)
  deriving
    ([MessageSendResponse] -> Value
[MessageSendResponse] -> Encoding
MessageSendResponse -> Value
MessageSendResponse -> Encoding
(MessageSendResponse -> Value)
-> (MessageSendResponse -> Encoding)
-> ([MessageSendResponse] -> Value)
-> ([MessageSendResponse] -> Encoding)
-> ToJSON MessageSendResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MessageSendResponse -> Value
toJSON :: MessageSendResponse -> Value
$ctoEncoding :: MessageSendResponse -> Encoding
toEncoding :: MessageSendResponse -> Encoding
$ctoJSONList :: [MessageSendResponse] -> Value
toJSONList :: [MessageSendResponse] -> Value
$ctoEncodingList :: [MessageSendResponse] -> Encoding
toEncodingList :: [MessageSendResponse] -> Encoding
ToJSON, Value -> Parser [MessageSendResponse]
Value -> Parser MessageSendResponse
(Value -> Parser MessageSendResponse)
-> (Value -> Parser [MessageSendResponse])
-> FromJSON MessageSendResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MessageSendResponse
parseJSON :: Value -> Parser MessageSendResponse
$cparseJSONList :: Value -> Parser [MessageSendResponse]
parseJSONList :: Value -> Parser [MessageSendResponse]
FromJSON)
    via ( Either
            (CustomEncoded (MessageNotSent MessageSendingStatus))
            MessageSendingStatus
        )

instance ToSchema MessageSendResponse

newtype LeaveConversationResponse = LeaveConversationResponse
  {LeaveConversationResponse -> Either RemoveFromConversationError ()
response :: Either RemoveFromConversationError ()}
  deriving stock (LeaveConversationResponse -> LeaveConversationResponse -> Bool
(LeaveConversationResponse -> LeaveConversationResponse -> Bool)
-> (LeaveConversationResponse -> LeaveConversationResponse -> Bool)
-> Eq LeaveConversationResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeaveConversationResponse -> LeaveConversationResponse -> Bool
== :: LeaveConversationResponse -> LeaveConversationResponse -> Bool
$c/= :: LeaveConversationResponse -> LeaveConversationResponse -> Bool
/= :: LeaveConversationResponse -> LeaveConversationResponse -> Bool
Eq, Int -> LeaveConversationResponse -> ShowS
[LeaveConversationResponse] -> ShowS
LeaveConversationResponse -> String
(Int -> LeaveConversationResponse -> ShowS)
-> (LeaveConversationResponse -> String)
-> ([LeaveConversationResponse] -> ShowS)
-> Show LeaveConversationResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeaveConversationResponse -> ShowS
showsPrec :: Int -> LeaveConversationResponse -> ShowS
$cshow :: LeaveConversationResponse -> String
show :: LeaveConversationResponse -> String
$cshowList :: [LeaveConversationResponse] -> ShowS
showList :: [LeaveConversationResponse] -> ShowS
Show, (forall x.
 LeaveConversationResponse -> Rep LeaveConversationResponse x)
-> (forall x.
    Rep LeaveConversationResponse x -> LeaveConversationResponse)
-> Generic LeaveConversationResponse
forall x.
Rep LeaveConversationResponse x -> LeaveConversationResponse
forall x.
LeaveConversationResponse -> Rep LeaveConversationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
LeaveConversationResponse -> Rep LeaveConversationResponse x
from :: forall x.
LeaveConversationResponse -> Rep LeaveConversationResponse x
$cto :: forall x.
Rep LeaveConversationResponse x -> LeaveConversationResponse
to :: forall x.
Rep LeaveConversationResponse x -> LeaveConversationResponse
Generic)
  deriving
    ([LeaveConversationResponse] -> Value
[LeaveConversationResponse] -> Encoding
LeaveConversationResponse -> Value
LeaveConversationResponse -> Encoding
(LeaveConversationResponse -> Value)
-> (LeaveConversationResponse -> Encoding)
-> ([LeaveConversationResponse] -> Value)
-> ([LeaveConversationResponse] -> Encoding)
-> ToJSON LeaveConversationResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LeaveConversationResponse -> Value
toJSON :: LeaveConversationResponse -> Value
$ctoEncoding :: LeaveConversationResponse -> Encoding
toEncoding :: LeaveConversationResponse -> Encoding
$ctoJSONList :: [LeaveConversationResponse] -> Value
toJSONList :: [LeaveConversationResponse] -> Value
$ctoEncodingList :: [LeaveConversationResponse] -> Encoding
toEncodingList :: [LeaveConversationResponse] -> Encoding
ToJSON, Value -> Parser [LeaveConversationResponse]
Value -> Parser LeaveConversationResponse
(Value -> Parser LeaveConversationResponse)
-> (Value -> Parser [LeaveConversationResponse])
-> FromJSON LeaveConversationResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LeaveConversationResponse
parseJSON :: Value -> Parser LeaveConversationResponse
$cparseJSONList :: Value -> Parser [LeaveConversationResponse]
parseJSONList :: Value -> Parser [LeaveConversationResponse]
FromJSON)
    via (Either (CustomEncoded RemoveFromConversationError) ())

instance ToSchema LeaveConversationResponse

data ConversationUpdateRequest = ConversationUpdateRequest
  { -- | The user that is attempting to perform the action. This is qualified
    -- implicitly by the origin domain
    ConversationUpdateRequest -> UserId
user :: UserId,
    -- | Id of conversation the action should be performed on. The is qualified
    -- implicity by the owning backend which receives this request.
    ConversationUpdateRequest -> ConvId
convId :: ConvId,
    ConversationUpdateRequest -> SomeConversationAction
action :: SomeConversationAction
  }
  deriving stock (ConversationUpdateRequest -> ConversationUpdateRequest -> Bool
(ConversationUpdateRequest -> ConversationUpdateRequest -> Bool)
-> (ConversationUpdateRequest -> ConversationUpdateRequest -> Bool)
-> Eq ConversationUpdateRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationUpdateRequest -> ConversationUpdateRequest -> Bool
== :: ConversationUpdateRequest -> ConversationUpdateRequest -> Bool
$c/= :: ConversationUpdateRequest -> ConversationUpdateRequest -> Bool
/= :: ConversationUpdateRequest -> ConversationUpdateRequest -> Bool
Eq, Int -> ConversationUpdateRequest -> ShowS
[ConversationUpdateRequest] -> ShowS
ConversationUpdateRequest -> String
(Int -> ConversationUpdateRequest -> ShowS)
-> (ConversationUpdateRequest -> String)
-> ([ConversationUpdateRequest] -> ShowS)
-> Show ConversationUpdateRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationUpdateRequest -> ShowS
showsPrec :: Int -> ConversationUpdateRequest -> ShowS
$cshow :: ConversationUpdateRequest -> String
show :: ConversationUpdateRequest -> String
$cshowList :: [ConversationUpdateRequest] -> ShowS
showList :: [ConversationUpdateRequest] -> ShowS
Show, (forall x.
 ConversationUpdateRequest -> Rep ConversationUpdateRequest x)
-> (forall x.
    Rep ConversationUpdateRequest x -> ConversationUpdateRequest)
-> Generic ConversationUpdateRequest
forall x.
Rep ConversationUpdateRequest x -> ConversationUpdateRequest
forall x.
ConversationUpdateRequest -> Rep ConversationUpdateRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ConversationUpdateRequest -> Rep ConversationUpdateRequest x
from :: forall x.
ConversationUpdateRequest -> Rep ConversationUpdateRequest x
$cto :: forall x.
Rep ConversationUpdateRequest x -> ConversationUpdateRequest
to :: forall x.
Rep ConversationUpdateRequest x -> ConversationUpdateRequest
Generic)
  deriving (Gen ConversationUpdateRequest
Gen ConversationUpdateRequest
-> (ConversationUpdateRequest -> [ConversationUpdateRequest])
-> Arbitrary ConversationUpdateRequest
ConversationUpdateRequest -> [ConversationUpdateRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationUpdateRequest
arbitrary :: Gen ConversationUpdateRequest
$cshrink :: ConversationUpdateRequest -> [ConversationUpdateRequest]
shrink :: ConversationUpdateRequest -> [ConversationUpdateRequest]
Arbitrary) via (GenericUniform ConversationUpdateRequest)
  deriving (Value -> Parser [ConversationUpdateRequest]
Value -> Parser ConversationUpdateRequest
(Value -> Parser ConversationUpdateRequest)
-> (Value -> Parser [ConversationUpdateRequest])
-> FromJSON ConversationUpdateRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationUpdateRequest
parseJSON :: Value -> Parser ConversationUpdateRequest
$cparseJSONList :: Value -> Parser [ConversationUpdateRequest]
parseJSONList :: Value -> Parser [ConversationUpdateRequest]
FromJSON, [ConversationUpdateRequest] -> Value
[ConversationUpdateRequest] -> Encoding
ConversationUpdateRequest -> Value
ConversationUpdateRequest -> Encoding
(ConversationUpdateRequest -> Value)
-> (ConversationUpdateRequest -> Encoding)
-> ([ConversationUpdateRequest] -> Value)
-> ([ConversationUpdateRequest] -> Encoding)
-> ToJSON ConversationUpdateRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationUpdateRequest -> Value
toJSON :: ConversationUpdateRequest -> Value
$ctoEncoding :: ConversationUpdateRequest -> Encoding
toEncoding :: ConversationUpdateRequest -> Encoding
$ctoJSONList :: [ConversationUpdateRequest] -> Value
toJSONList :: [ConversationUpdateRequest] -> Value
$ctoEncodingList :: [ConversationUpdateRequest] -> Encoding
toEncodingList :: [ConversationUpdateRequest] -> Encoding
ToJSON) via (CustomEncoded ConversationUpdateRequest)

instance ToSchema ConversationUpdateRequest

data ConversationUpdateResponse
  = ConversationUpdateResponseError GalleyError
  | ConversationUpdateResponseUpdate ConversationUpdate
  | ConversationUpdateResponseNoChanges
  | ConversationUpdateResponseNonFederatingBackends NonFederatingBackends
  | ConversationUpdateResponseUnreachableBackends UnreachableBackends
  deriving stock (ConversationUpdateResponse -> ConversationUpdateResponse -> Bool
(ConversationUpdateResponse -> ConversationUpdateResponse -> Bool)
-> (ConversationUpdateResponse
    -> ConversationUpdateResponse -> Bool)
-> Eq ConversationUpdateResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationUpdateResponse -> ConversationUpdateResponse -> Bool
== :: ConversationUpdateResponse -> ConversationUpdateResponse -> Bool
$c/= :: ConversationUpdateResponse -> ConversationUpdateResponse -> Bool
/= :: ConversationUpdateResponse -> ConversationUpdateResponse -> Bool
Eq, Int -> ConversationUpdateResponse -> ShowS
[ConversationUpdateResponse] -> ShowS
ConversationUpdateResponse -> String
(Int -> ConversationUpdateResponse -> ShowS)
-> (ConversationUpdateResponse -> String)
-> ([ConversationUpdateResponse] -> ShowS)
-> Show ConversationUpdateResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationUpdateResponse -> ShowS
showsPrec :: Int -> ConversationUpdateResponse -> ShowS
$cshow :: ConversationUpdateResponse -> String
show :: ConversationUpdateResponse -> String
$cshowList :: [ConversationUpdateResponse] -> ShowS
showList :: [ConversationUpdateResponse] -> ShowS
Show, (forall x.
 ConversationUpdateResponse -> Rep ConversationUpdateResponse x)
-> (forall x.
    Rep ConversationUpdateResponse x -> ConversationUpdateResponse)
-> Generic ConversationUpdateResponse
forall x.
Rep ConversationUpdateResponse x -> ConversationUpdateResponse
forall x.
ConversationUpdateResponse -> Rep ConversationUpdateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ConversationUpdateResponse -> Rep ConversationUpdateResponse x
from :: forall x.
ConversationUpdateResponse -> Rep ConversationUpdateResponse x
$cto :: forall x.
Rep ConversationUpdateResponse x -> ConversationUpdateResponse
to :: forall x.
Rep ConversationUpdateResponse x -> ConversationUpdateResponse
Generic)
  deriving
    ([ConversationUpdateResponse] -> Value
[ConversationUpdateResponse] -> Encoding
ConversationUpdateResponse -> Value
ConversationUpdateResponse -> Encoding
(ConversationUpdateResponse -> Value)
-> (ConversationUpdateResponse -> Encoding)
-> ([ConversationUpdateResponse] -> Value)
-> ([ConversationUpdateResponse] -> Encoding)
-> ToJSON ConversationUpdateResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationUpdateResponse -> Value
toJSON :: ConversationUpdateResponse -> Value
$ctoEncoding :: ConversationUpdateResponse -> Encoding
toEncoding :: ConversationUpdateResponse -> Encoding
$ctoJSONList :: [ConversationUpdateResponse] -> Value
toJSONList :: [ConversationUpdateResponse] -> Value
$ctoEncodingList :: [ConversationUpdateResponse] -> Encoding
toEncodingList :: [ConversationUpdateResponse] -> Encoding
ToJSON, Value -> Parser [ConversationUpdateResponse]
Value -> Parser ConversationUpdateResponse
(Value -> Parser ConversationUpdateResponse)
-> (Value -> Parser [ConversationUpdateResponse])
-> FromJSON ConversationUpdateResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationUpdateResponse
parseJSON :: Value -> Parser ConversationUpdateResponse
$cparseJSONList :: Value -> Parser [ConversationUpdateResponse]
parseJSONList :: Value -> Parser [ConversationUpdateResponse]
FromJSON)
    via (CustomEncoded ConversationUpdateResponse)

instance ToSchema ConversationUpdateResponse

-- | A wrapper around a raw welcome message
data MLSWelcomeRequest = MLSWelcomeRequest
  { -- | Implicitely qualified by origin domain
    MLSWelcomeRequest -> UserId
originatingUser :: UserId,
    -- | A serialised welcome message.
    MLSWelcomeRequest -> Base64ByteString
welcomeMessage :: Base64ByteString,
    -- | Recipients local to the target backend.
    MLSWelcomeRequest -> [(UserId, ClientId)]
recipients :: [(UserId, ClientId)],
    -- | The conversation id, qualified to the owning domain
    MLSWelcomeRequest -> Qualified ConvId
qualifiedConvId :: Qualified ConvId
  }
  deriving stock (MLSWelcomeRequest -> MLSWelcomeRequest -> Bool
(MLSWelcomeRequest -> MLSWelcomeRequest -> Bool)
-> (MLSWelcomeRequest -> MLSWelcomeRequest -> Bool)
-> Eq MLSWelcomeRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLSWelcomeRequest -> MLSWelcomeRequest -> Bool
== :: MLSWelcomeRequest -> MLSWelcomeRequest -> Bool
$c/= :: MLSWelcomeRequest -> MLSWelcomeRequest -> Bool
/= :: MLSWelcomeRequest -> MLSWelcomeRequest -> Bool
Eq, (forall x. MLSWelcomeRequest -> Rep MLSWelcomeRequest x)
-> (forall x. Rep MLSWelcomeRequest x -> MLSWelcomeRequest)
-> Generic MLSWelcomeRequest
forall x. Rep MLSWelcomeRequest x -> MLSWelcomeRequest
forall x. MLSWelcomeRequest -> Rep MLSWelcomeRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MLSWelcomeRequest -> Rep MLSWelcomeRequest x
from :: forall x. MLSWelcomeRequest -> Rep MLSWelcomeRequest x
$cto :: forall x. Rep MLSWelcomeRequest x -> MLSWelcomeRequest
to :: forall x. Rep MLSWelcomeRequest x -> MLSWelcomeRequest
Generic, Int -> MLSWelcomeRequest -> ShowS
[MLSWelcomeRequest] -> ShowS
MLSWelcomeRequest -> String
(Int -> MLSWelcomeRequest -> ShowS)
-> (MLSWelcomeRequest -> String)
-> ([MLSWelcomeRequest] -> ShowS)
-> Show MLSWelcomeRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLSWelcomeRequest -> ShowS
showsPrec :: Int -> MLSWelcomeRequest -> ShowS
$cshow :: MLSWelcomeRequest -> String
show :: MLSWelcomeRequest -> String
$cshowList :: [MLSWelcomeRequest] -> ShowS
showList :: [MLSWelcomeRequest] -> ShowS
Show)
  deriving (Gen MLSWelcomeRequest
Gen MLSWelcomeRequest
-> (MLSWelcomeRequest -> [MLSWelcomeRequest])
-> Arbitrary MLSWelcomeRequest
MLSWelcomeRequest -> [MLSWelcomeRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen MLSWelcomeRequest
arbitrary :: Gen MLSWelcomeRequest
$cshrink :: MLSWelcomeRequest -> [MLSWelcomeRequest]
shrink :: MLSWelcomeRequest -> [MLSWelcomeRequest]
Arbitrary) via (GenericUniform MLSWelcomeRequest)
  deriving (Value -> Parser [MLSWelcomeRequest]
Value -> Parser MLSWelcomeRequest
(Value -> Parser MLSWelcomeRequest)
-> (Value -> Parser [MLSWelcomeRequest])
-> FromJSON MLSWelcomeRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MLSWelcomeRequest
parseJSON :: Value -> Parser MLSWelcomeRequest
$cparseJSONList :: Value -> Parser [MLSWelcomeRequest]
parseJSONList :: Value -> Parser [MLSWelcomeRequest]
FromJSON, [MLSWelcomeRequest] -> Value
[MLSWelcomeRequest] -> Encoding
MLSWelcomeRequest -> Value
MLSWelcomeRequest -> Encoding
(MLSWelcomeRequest -> Value)
-> (MLSWelcomeRequest -> Encoding)
-> ([MLSWelcomeRequest] -> Value)
-> ([MLSWelcomeRequest] -> Encoding)
-> ToJSON MLSWelcomeRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MLSWelcomeRequest -> Value
toJSON :: MLSWelcomeRequest -> Value
$ctoEncoding :: MLSWelcomeRequest -> Encoding
toEncoding :: MLSWelcomeRequest -> Encoding
$ctoJSONList :: [MLSWelcomeRequest] -> Value
toJSONList :: [MLSWelcomeRequest] -> Value
$ctoEncodingList :: [MLSWelcomeRequest] -> Encoding
toEncodingList :: [MLSWelcomeRequest] -> Encoding
ToJSON) via (CustomEncoded MLSWelcomeRequest)

instance ToSchema MLSWelcomeRequest

data MLSWelcomeResponse
  = MLSWelcomeSent
  | MLSWelcomeMLSNotEnabled
  deriving stock (MLSWelcomeResponse -> MLSWelcomeResponse -> Bool
(MLSWelcomeResponse -> MLSWelcomeResponse -> Bool)
-> (MLSWelcomeResponse -> MLSWelcomeResponse -> Bool)
-> Eq MLSWelcomeResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLSWelcomeResponse -> MLSWelcomeResponse -> Bool
== :: MLSWelcomeResponse -> MLSWelcomeResponse -> Bool
$c/= :: MLSWelcomeResponse -> MLSWelcomeResponse -> Bool
/= :: MLSWelcomeResponse -> MLSWelcomeResponse -> Bool
Eq, (forall x. MLSWelcomeResponse -> Rep MLSWelcomeResponse x)
-> (forall x. Rep MLSWelcomeResponse x -> MLSWelcomeResponse)
-> Generic MLSWelcomeResponse
forall x. Rep MLSWelcomeResponse x -> MLSWelcomeResponse
forall x. MLSWelcomeResponse -> Rep MLSWelcomeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MLSWelcomeResponse -> Rep MLSWelcomeResponse x
from :: forall x. MLSWelcomeResponse -> Rep MLSWelcomeResponse x
$cto :: forall x. Rep MLSWelcomeResponse x -> MLSWelcomeResponse
to :: forall x. Rep MLSWelcomeResponse x -> MLSWelcomeResponse
Generic, Int -> MLSWelcomeResponse -> ShowS
[MLSWelcomeResponse] -> ShowS
MLSWelcomeResponse -> String
(Int -> MLSWelcomeResponse -> ShowS)
-> (MLSWelcomeResponse -> String)
-> ([MLSWelcomeResponse] -> ShowS)
-> Show MLSWelcomeResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLSWelcomeResponse -> ShowS
showsPrec :: Int -> MLSWelcomeResponse -> ShowS
$cshow :: MLSWelcomeResponse -> String
show :: MLSWelcomeResponse -> String
$cshowList :: [MLSWelcomeResponse] -> ShowS
showList :: [MLSWelcomeResponse] -> ShowS
Show)
  deriving (Value -> Parser [MLSWelcomeResponse]
Value -> Parser MLSWelcomeResponse
(Value -> Parser MLSWelcomeResponse)
-> (Value -> Parser [MLSWelcomeResponse])
-> FromJSON MLSWelcomeResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MLSWelcomeResponse
parseJSON :: Value -> Parser MLSWelcomeResponse
$cparseJSONList :: Value -> Parser [MLSWelcomeResponse]
parseJSONList :: Value -> Parser [MLSWelcomeResponse]
FromJSON, [MLSWelcomeResponse] -> Value
[MLSWelcomeResponse] -> Encoding
MLSWelcomeResponse -> Value
MLSWelcomeResponse -> Encoding
(MLSWelcomeResponse -> Value)
-> (MLSWelcomeResponse -> Encoding)
-> ([MLSWelcomeResponse] -> Value)
-> ([MLSWelcomeResponse] -> Encoding)
-> ToJSON MLSWelcomeResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MLSWelcomeResponse -> Value
toJSON :: MLSWelcomeResponse -> Value
$ctoEncoding :: MLSWelcomeResponse -> Encoding
toEncoding :: MLSWelcomeResponse -> Encoding
$ctoJSONList :: [MLSWelcomeResponse] -> Value
toJSONList :: [MLSWelcomeResponse] -> Value
$ctoEncodingList :: [MLSWelcomeResponse] -> Encoding
toEncodingList :: [MLSWelcomeResponse] -> Encoding
ToJSON) via (CustomEncoded MLSWelcomeResponse)

instance ToSchema MLSWelcomeResponse

data MLSMessageResponse
  = MLSMessageResponseError GalleyError
  | MLSMessageResponseProtocolError Text
  | MLSMessageResponseProposalFailure JSONResponse
  | -- | The conversation-owning backend could not reach some of the backends that
    -- have users in the conversation when processing a commit.
    MLSMessageResponseUnreachableBackends (Set Domain)
  | -- | If the list of unreachable users is non-empty, it corresponds to users
    -- that an application message could not be sent to.
    MLSMessageResponseUpdates [ConversationUpdate]
  | MLSMessageResponseNonFederatingBackends NonFederatingBackends
  deriving stock (MLSMessageResponse -> MLSMessageResponse -> Bool
(MLSMessageResponse -> MLSMessageResponse -> Bool)
-> (MLSMessageResponse -> MLSMessageResponse -> Bool)
-> Eq MLSMessageResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLSMessageResponse -> MLSMessageResponse -> Bool
== :: MLSMessageResponse -> MLSMessageResponse -> Bool
$c/= :: MLSMessageResponse -> MLSMessageResponse -> Bool
/= :: MLSMessageResponse -> MLSMessageResponse -> Bool
Eq, Int -> MLSMessageResponse -> ShowS
[MLSMessageResponse] -> ShowS
MLSMessageResponse -> String
(Int -> MLSMessageResponse -> ShowS)
-> (MLSMessageResponse -> String)
-> ([MLSMessageResponse] -> ShowS)
-> Show MLSMessageResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLSMessageResponse -> ShowS
showsPrec :: Int -> MLSMessageResponse -> ShowS
$cshow :: MLSMessageResponse -> String
show :: MLSMessageResponse -> String
$cshowList :: [MLSMessageResponse] -> ShowS
showList :: [MLSMessageResponse] -> ShowS
Show, (forall x. MLSMessageResponse -> Rep MLSMessageResponse x)
-> (forall x. Rep MLSMessageResponse x -> MLSMessageResponse)
-> Generic MLSMessageResponse
forall x. Rep MLSMessageResponse x -> MLSMessageResponse
forall x. MLSMessageResponse -> Rep MLSMessageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MLSMessageResponse -> Rep MLSMessageResponse x
from :: forall x. MLSMessageResponse -> Rep MLSMessageResponse x
$cto :: forall x. Rep MLSMessageResponse x -> MLSMessageResponse
to :: forall x. Rep MLSMessageResponse x -> MLSMessageResponse
Generic)
  deriving ([MLSMessageResponse] -> Value
[MLSMessageResponse] -> Encoding
MLSMessageResponse -> Value
MLSMessageResponse -> Encoding
(MLSMessageResponse -> Value)
-> (MLSMessageResponse -> Encoding)
-> ([MLSMessageResponse] -> Value)
-> ([MLSMessageResponse] -> Encoding)
-> ToJSON MLSMessageResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MLSMessageResponse -> Value
toJSON :: MLSMessageResponse -> Value
$ctoEncoding :: MLSMessageResponse -> Encoding
toEncoding :: MLSMessageResponse -> Encoding
$ctoJSONList :: [MLSMessageResponse] -> Value
toJSONList :: [MLSMessageResponse] -> Value
$ctoEncodingList :: [MLSMessageResponse] -> Encoding
toEncodingList :: [MLSMessageResponse] -> Encoding
ToJSON, Value -> Parser [MLSMessageResponse]
Value -> Parser MLSMessageResponse
(Value -> Parser MLSMessageResponse)
-> (Value -> Parser [MLSMessageResponse])
-> FromJSON MLSMessageResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MLSMessageResponse
parseJSON :: Value -> Parser MLSMessageResponse
$cparseJSONList :: Value -> Parser [MLSMessageResponse]
parseJSONList :: Value -> Parser [MLSMessageResponse]
FromJSON) via (CustomEncoded MLSMessageResponse)

instance ToSchema MLSMessageResponse

data GetGroupInfoRequest = GetGroupInfoRequest
  { -- | Conversation (or subconversation) is assumed to be owned by the target
    -- domain, this allows us to protect against relay attacks
    GetGroupInfoRequest -> ConvOrSubConvId
conv :: ConvOrSubConvId,
    -- | Sender is assumed to be owned by the origin domain, this allows us to
    -- protect against spoofing attacks
    GetGroupInfoRequest -> UserId
sender :: UserId
  }
  deriving stock (GetGroupInfoRequest -> GetGroupInfoRequest -> Bool
(GetGroupInfoRequest -> GetGroupInfoRequest -> Bool)
-> (GetGroupInfoRequest -> GetGroupInfoRequest -> Bool)
-> Eq GetGroupInfoRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetGroupInfoRequest -> GetGroupInfoRequest -> Bool
== :: GetGroupInfoRequest -> GetGroupInfoRequest -> Bool
$c/= :: GetGroupInfoRequest -> GetGroupInfoRequest -> Bool
/= :: GetGroupInfoRequest -> GetGroupInfoRequest -> Bool
Eq, Int -> GetGroupInfoRequest -> ShowS
[GetGroupInfoRequest] -> ShowS
GetGroupInfoRequest -> String
(Int -> GetGroupInfoRequest -> ShowS)
-> (GetGroupInfoRequest -> String)
-> ([GetGroupInfoRequest] -> ShowS)
-> Show GetGroupInfoRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetGroupInfoRequest -> ShowS
showsPrec :: Int -> GetGroupInfoRequest -> ShowS
$cshow :: GetGroupInfoRequest -> String
show :: GetGroupInfoRequest -> String
$cshowList :: [GetGroupInfoRequest] -> ShowS
showList :: [GetGroupInfoRequest] -> ShowS
Show, (forall x. GetGroupInfoRequest -> Rep GetGroupInfoRequest x)
-> (forall x. Rep GetGroupInfoRequest x -> GetGroupInfoRequest)
-> Generic GetGroupInfoRequest
forall x. Rep GetGroupInfoRequest x -> GetGroupInfoRequest
forall x. GetGroupInfoRequest -> Rep GetGroupInfoRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetGroupInfoRequest -> Rep GetGroupInfoRequest x
from :: forall x. GetGroupInfoRequest -> Rep GetGroupInfoRequest x
$cto :: forall x. Rep GetGroupInfoRequest x -> GetGroupInfoRequest
to :: forall x. Rep GetGroupInfoRequest x -> GetGroupInfoRequest
Generic)
  deriving (Gen GetGroupInfoRequest
Gen GetGroupInfoRequest
-> (GetGroupInfoRequest -> [GetGroupInfoRequest])
-> Arbitrary GetGroupInfoRequest
GetGroupInfoRequest -> [GetGroupInfoRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GetGroupInfoRequest
arbitrary :: Gen GetGroupInfoRequest
$cshrink :: GetGroupInfoRequest -> [GetGroupInfoRequest]
shrink :: GetGroupInfoRequest -> [GetGroupInfoRequest]
Arbitrary) via (GenericUniform GetGroupInfoRequest)
  deriving ([GetGroupInfoRequest] -> Value
[GetGroupInfoRequest] -> Encoding
GetGroupInfoRequest -> Value
GetGroupInfoRequest -> Encoding
(GetGroupInfoRequest -> Value)
-> (GetGroupInfoRequest -> Encoding)
-> ([GetGroupInfoRequest] -> Value)
-> ([GetGroupInfoRequest] -> Encoding)
-> ToJSON GetGroupInfoRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GetGroupInfoRequest -> Value
toJSON :: GetGroupInfoRequest -> Value
$ctoEncoding :: GetGroupInfoRequest -> Encoding
toEncoding :: GetGroupInfoRequest -> Encoding
$ctoJSONList :: [GetGroupInfoRequest] -> Value
toJSONList :: [GetGroupInfoRequest] -> Value
$ctoEncodingList :: [GetGroupInfoRequest] -> Encoding
toEncodingList :: [GetGroupInfoRequest] -> Encoding
ToJSON, Value -> Parser [GetGroupInfoRequest]
Value -> Parser GetGroupInfoRequest
(Value -> Parser GetGroupInfoRequest)
-> (Value -> Parser [GetGroupInfoRequest])
-> FromJSON GetGroupInfoRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GetGroupInfoRequest
parseJSON :: Value -> Parser GetGroupInfoRequest
$cparseJSONList :: Value -> Parser [GetGroupInfoRequest]
parseJSONList :: Value -> Parser [GetGroupInfoRequest]
FromJSON) via (CustomEncoded GetGroupInfoRequest)

instance ToSchema GetGroupInfoRequest

data GetGroupInfoResponse
  = GetGroupInfoResponseError GalleyError
  | GetGroupInfoResponseState Base64ByteString
  deriving stock (GetGroupInfoResponse -> GetGroupInfoResponse -> Bool
(GetGroupInfoResponse -> GetGroupInfoResponse -> Bool)
-> (GetGroupInfoResponse -> GetGroupInfoResponse -> Bool)
-> Eq GetGroupInfoResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetGroupInfoResponse -> GetGroupInfoResponse -> Bool
== :: GetGroupInfoResponse -> GetGroupInfoResponse -> Bool
$c/= :: GetGroupInfoResponse -> GetGroupInfoResponse -> Bool
/= :: GetGroupInfoResponse -> GetGroupInfoResponse -> Bool
Eq, Int -> GetGroupInfoResponse -> ShowS
[GetGroupInfoResponse] -> ShowS
GetGroupInfoResponse -> String
(Int -> GetGroupInfoResponse -> ShowS)
-> (GetGroupInfoResponse -> String)
-> ([GetGroupInfoResponse] -> ShowS)
-> Show GetGroupInfoResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetGroupInfoResponse -> ShowS
showsPrec :: Int -> GetGroupInfoResponse -> ShowS
$cshow :: GetGroupInfoResponse -> String
show :: GetGroupInfoResponse -> String
$cshowList :: [GetGroupInfoResponse] -> ShowS
showList :: [GetGroupInfoResponse] -> ShowS
Show, (forall x. GetGroupInfoResponse -> Rep GetGroupInfoResponse x)
-> (forall x. Rep GetGroupInfoResponse x -> GetGroupInfoResponse)
-> Generic GetGroupInfoResponse
forall x. Rep GetGroupInfoResponse x -> GetGroupInfoResponse
forall x. GetGroupInfoResponse -> Rep GetGroupInfoResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetGroupInfoResponse -> Rep GetGroupInfoResponse x
from :: forall x. GetGroupInfoResponse -> Rep GetGroupInfoResponse x
$cto :: forall x. Rep GetGroupInfoResponse x -> GetGroupInfoResponse
to :: forall x. Rep GetGroupInfoResponse x -> GetGroupInfoResponse
Generic)
  deriving ([GetGroupInfoResponse] -> Value
[GetGroupInfoResponse] -> Encoding
GetGroupInfoResponse -> Value
GetGroupInfoResponse -> Encoding
(GetGroupInfoResponse -> Value)
-> (GetGroupInfoResponse -> Encoding)
-> ([GetGroupInfoResponse] -> Value)
-> ([GetGroupInfoResponse] -> Encoding)
-> ToJSON GetGroupInfoResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GetGroupInfoResponse -> Value
toJSON :: GetGroupInfoResponse -> Value
$ctoEncoding :: GetGroupInfoResponse -> Encoding
toEncoding :: GetGroupInfoResponse -> Encoding
$ctoJSONList :: [GetGroupInfoResponse] -> Value
toJSONList :: [GetGroupInfoResponse] -> Value
$ctoEncodingList :: [GetGroupInfoResponse] -> Encoding
toEncodingList :: [GetGroupInfoResponse] -> Encoding
ToJSON, Value -> Parser [GetGroupInfoResponse]
Value -> Parser GetGroupInfoResponse
(Value -> Parser GetGroupInfoResponse)
-> (Value -> Parser [GetGroupInfoResponse])
-> FromJSON GetGroupInfoResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GetGroupInfoResponse
parseJSON :: Value -> Parser GetGroupInfoResponse
$cparseJSONList :: Value -> Parser [GetGroupInfoResponse]
parseJSONList :: Value -> Parser [GetGroupInfoResponse]
FromJSON) via (CustomEncoded GetGroupInfoResponse)

instance ToSchema GetGroupInfoResponse

data GetSubConversationsRequest = GetSubConversationsRequest
  { GetSubConversationsRequest -> UserId
gsreqUser :: UserId,
    GetSubConversationsRequest -> ConvId
gsreqConv :: ConvId,
    GetSubConversationsRequest -> SubConvId
gsreqSubConv :: SubConvId
  }
  deriving stock (GetSubConversationsRequest -> GetSubConversationsRequest -> Bool
(GetSubConversationsRequest -> GetSubConversationsRequest -> Bool)
-> (GetSubConversationsRequest
    -> GetSubConversationsRequest -> Bool)
-> Eq GetSubConversationsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetSubConversationsRequest -> GetSubConversationsRequest -> Bool
== :: GetSubConversationsRequest -> GetSubConversationsRequest -> Bool
$c/= :: GetSubConversationsRequest -> GetSubConversationsRequest -> Bool
/= :: GetSubConversationsRequest -> GetSubConversationsRequest -> Bool
Eq, Int -> GetSubConversationsRequest -> ShowS
[GetSubConversationsRequest] -> ShowS
GetSubConversationsRequest -> String
(Int -> GetSubConversationsRequest -> ShowS)
-> (GetSubConversationsRequest -> String)
-> ([GetSubConversationsRequest] -> ShowS)
-> Show GetSubConversationsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetSubConversationsRequest -> ShowS
showsPrec :: Int -> GetSubConversationsRequest -> ShowS
$cshow :: GetSubConversationsRequest -> String
show :: GetSubConversationsRequest -> String
$cshowList :: [GetSubConversationsRequest] -> ShowS
showList :: [GetSubConversationsRequest] -> ShowS
Show, (forall x.
 GetSubConversationsRequest -> Rep GetSubConversationsRequest x)
-> (forall x.
    Rep GetSubConversationsRequest x -> GetSubConversationsRequest)
-> Generic GetSubConversationsRequest
forall x.
Rep GetSubConversationsRequest x -> GetSubConversationsRequest
forall x.
GetSubConversationsRequest -> Rep GetSubConversationsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetSubConversationsRequest -> Rep GetSubConversationsRequest x
from :: forall x.
GetSubConversationsRequest -> Rep GetSubConversationsRequest x
$cto :: forall x.
Rep GetSubConversationsRequest x -> GetSubConversationsRequest
to :: forall x.
Rep GetSubConversationsRequest x -> GetSubConversationsRequest
Generic)
  deriving ([GetSubConversationsRequest] -> Value
[GetSubConversationsRequest] -> Encoding
GetSubConversationsRequest -> Value
GetSubConversationsRequest -> Encoding
(GetSubConversationsRequest -> Value)
-> (GetSubConversationsRequest -> Encoding)
-> ([GetSubConversationsRequest] -> Value)
-> ([GetSubConversationsRequest] -> Encoding)
-> ToJSON GetSubConversationsRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GetSubConversationsRequest -> Value
toJSON :: GetSubConversationsRequest -> Value
$ctoEncoding :: GetSubConversationsRequest -> Encoding
toEncoding :: GetSubConversationsRequest -> Encoding
$ctoJSONList :: [GetSubConversationsRequest] -> Value
toJSONList :: [GetSubConversationsRequest] -> Value
$ctoEncodingList :: [GetSubConversationsRequest] -> Encoding
toEncodingList :: [GetSubConversationsRequest] -> Encoding
ToJSON, Value -> Parser [GetSubConversationsRequest]
Value -> Parser GetSubConversationsRequest
(Value -> Parser GetSubConversationsRequest)
-> (Value -> Parser [GetSubConversationsRequest])
-> FromJSON GetSubConversationsRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GetSubConversationsRequest
parseJSON :: Value -> Parser GetSubConversationsRequest
$cparseJSONList :: Value -> Parser [GetSubConversationsRequest]
parseJSONList :: Value -> Parser [GetSubConversationsRequest]
FromJSON) via (CustomEncoded GetSubConversationsRequest)

instance ToSchema GetSubConversationsRequest

data GetSubConversationsResponse
  = GetSubConversationsResponseError GalleyError
  | GetSubConversationsResponseSuccess PublicSubConversation
  deriving stock (GetSubConversationsResponse -> GetSubConversationsResponse -> Bool
(GetSubConversationsResponse
 -> GetSubConversationsResponse -> Bool)
-> (GetSubConversationsResponse
    -> GetSubConversationsResponse -> Bool)
-> Eq GetSubConversationsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetSubConversationsResponse -> GetSubConversationsResponse -> Bool
== :: GetSubConversationsResponse -> GetSubConversationsResponse -> Bool
$c/= :: GetSubConversationsResponse -> GetSubConversationsResponse -> Bool
/= :: GetSubConversationsResponse -> GetSubConversationsResponse -> Bool
Eq, Int -> GetSubConversationsResponse -> ShowS
[GetSubConversationsResponse] -> ShowS
GetSubConversationsResponse -> String
(Int -> GetSubConversationsResponse -> ShowS)
-> (GetSubConversationsResponse -> String)
-> ([GetSubConversationsResponse] -> ShowS)
-> Show GetSubConversationsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetSubConversationsResponse -> ShowS
showsPrec :: Int -> GetSubConversationsResponse -> ShowS
$cshow :: GetSubConversationsResponse -> String
show :: GetSubConversationsResponse -> String
$cshowList :: [GetSubConversationsResponse] -> ShowS
showList :: [GetSubConversationsResponse] -> ShowS
Show, (forall x.
 GetSubConversationsResponse -> Rep GetSubConversationsResponse x)
-> (forall x.
    Rep GetSubConversationsResponse x -> GetSubConversationsResponse)
-> Generic GetSubConversationsResponse
forall x.
Rep GetSubConversationsResponse x -> GetSubConversationsResponse
forall x.
GetSubConversationsResponse -> Rep GetSubConversationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetSubConversationsResponse -> Rep GetSubConversationsResponse x
from :: forall x.
GetSubConversationsResponse -> Rep GetSubConversationsResponse x
$cto :: forall x.
Rep GetSubConversationsResponse x -> GetSubConversationsResponse
to :: forall x.
Rep GetSubConversationsResponse x -> GetSubConversationsResponse
Generic)
  deriving ([GetSubConversationsResponse] -> Value
[GetSubConversationsResponse] -> Encoding
GetSubConversationsResponse -> Value
GetSubConversationsResponse -> Encoding
(GetSubConversationsResponse -> Value)
-> (GetSubConversationsResponse -> Encoding)
-> ([GetSubConversationsResponse] -> Value)
-> ([GetSubConversationsResponse] -> Encoding)
-> ToJSON GetSubConversationsResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GetSubConversationsResponse -> Value
toJSON :: GetSubConversationsResponse -> Value
$ctoEncoding :: GetSubConversationsResponse -> Encoding
toEncoding :: GetSubConversationsResponse -> Encoding
$ctoJSONList :: [GetSubConversationsResponse] -> Value
toJSONList :: [GetSubConversationsResponse] -> Value
$ctoEncodingList :: [GetSubConversationsResponse] -> Encoding
toEncodingList :: [GetSubConversationsResponse] -> Encoding
ToJSON, Value -> Parser [GetSubConversationsResponse]
Value -> Parser GetSubConversationsResponse
(Value -> Parser GetSubConversationsResponse)
-> (Value -> Parser [GetSubConversationsResponse])
-> FromJSON GetSubConversationsResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GetSubConversationsResponse
parseJSON :: Value -> Parser GetSubConversationsResponse
$cparseJSONList :: Value -> Parser [GetSubConversationsResponse]
parseJSONList :: Value -> Parser [GetSubConversationsResponse]
FromJSON) via (CustomEncoded GetSubConversationsResponse)

instance ToSchema GetSubConversationsResponse

data LeaveSubConversationRequest = LeaveSubConversationRequest
  { LeaveSubConversationRequest -> UserId
lscrUser :: UserId,
    LeaveSubConversationRequest -> ClientId
lscrClient :: ClientId,
    LeaveSubConversationRequest -> ConvId
lscrConv :: ConvId,
    LeaveSubConversationRequest -> SubConvId
lscrSubConv :: SubConvId
  }
  deriving stock (LeaveSubConversationRequest -> LeaveSubConversationRequest -> Bool
(LeaveSubConversationRequest
 -> LeaveSubConversationRequest -> Bool)
-> (LeaveSubConversationRequest
    -> LeaveSubConversationRequest -> Bool)
-> Eq LeaveSubConversationRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeaveSubConversationRequest -> LeaveSubConversationRequest -> Bool
== :: LeaveSubConversationRequest -> LeaveSubConversationRequest -> Bool
$c/= :: LeaveSubConversationRequest -> LeaveSubConversationRequest -> Bool
/= :: LeaveSubConversationRequest -> LeaveSubConversationRequest -> Bool
Eq, Int -> LeaveSubConversationRequest -> ShowS
[LeaveSubConversationRequest] -> ShowS
LeaveSubConversationRequest -> String
(Int -> LeaveSubConversationRequest -> ShowS)
-> (LeaveSubConversationRequest -> String)
-> ([LeaveSubConversationRequest] -> ShowS)
-> Show LeaveSubConversationRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeaveSubConversationRequest -> ShowS
showsPrec :: Int -> LeaveSubConversationRequest -> ShowS
$cshow :: LeaveSubConversationRequest -> String
show :: LeaveSubConversationRequest -> String
$cshowList :: [LeaveSubConversationRequest] -> ShowS
showList :: [LeaveSubConversationRequest] -> ShowS
Show, (forall x.
 LeaveSubConversationRequest -> Rep LeaveSubConversationRequest x)
-> (forall x.
    Rep LeaveSubConversationRequest x -> LeaveSubConversationRequest)
-> Generic LeaveSubConversationRequest
forall x.
Rep LeaveSubConversationRequest x -> LeaveSubConversationRequest
forall x.
LeaveSubConversationRequest -> Rep LeaveSubConversationRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
LeaveSubConversationRequest -> Rep LeaveSubConversationRequest x
from :: forall x.
LeaveSubConversationRequest -> Rep LeaveSubConversationRequest x
$cto :: forall x.
Rep LeaveSubConversationRequest x -> LeaveSubConversationRequest
to :: forall x.
Rep LeaveSubConversationRequest x -> LeaveSubConversationRequest
Generic)
  deriving (Gen LeaveSubConversationRequest
Gen LeaveSubConversationRequest
-> (LeaveSubConversationRequest -> [LeaveSubConversationRequest])
-> Arbitrary LeaveSubConversationRequest
LeaveSubConversationRequest -> [LeaveSubConversationRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen LeaveSubConversationRequest
arbitrary :: Gen LeaveSubConversationRequest
$cshrink :: LeaveSubConversationRequest -> [LeaveSubConversationRequest]
shrink :: LeaveSubConversationRequest -> [LeaveSubConversationRequest]
Arbitrary) via (GenericUniform LeaveSubConversationRequest)
  deriving ([LeaveSubConversationRequest] -> Value
[LeaveSubConversationRequest] -> Encoding
LeaveSubConversationRequest -> Value
LeaveSubConversationRequest -> Encoding
(LeaveSubConversationRequest -> Value)
-> (LeaveSubConversationRequest -> Encoding)
-> ([LeaveSubConversationRequest] -> Value)
-> ([LeaveSubConversationRequest] -> Encoding)
-> ToJSON LeaveSubConversationRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LeaveSubConversationRequest -> Value
toJSON :: LeaveSubConversationRequest -> Value
$ctoEncoding :: LeaveSubConversationRequest -> Encoding
toEncoding :: LeaveSubConversationRequest -> Encoding
$ctoJSONList :: [LeaveSubConversationRequest] -> Value
toJSONList :: [LeaveSubConversationRequest] -> Value
$ctoEncodingList :: [LeaveSubConversationRequest] -> Encoding
toEncodingList :: [LeaveSubConversationRequest] -> Encoding
ToJSON, Value -> Parser [LeaveSubConversationRequest]
Value -> Parser LeaveSubConversationRequest
(Value -> Parser LeaveSubConversationRequest)
-> (Value -> Parser [LeaveSubConversationRequest])
-> FromJSON LeaveSubConversationRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LeaveSubConversationRequest
parseJSON :: Value -> Parser LeaveSubConversationRequest
$cparseJSONList :: Value -> Parser [LeaveSubConversationRequest]
parseJSONList :: Value -> Parser [LeaveSubConversationRequest]
FromJSON) via (CustomEncoded LeaveSubConversationRequest)

instance ToSchema LeaveSubConversationRequest

data LeaveSubConversationResponse
  = LeaveSubConversationResponseError GalleyError
  | LeaveSubConversationResponseProtocolError Text
  | LeaveSubConversationResponseOk
  deriving stock (LeaveSubConversationResponse
-> LeaveSubConversationResponse -> Bool
(LeaveSubConversationResponse
 -> LeaveSubConversationResponse -> Bool)
-> (LeaveSubConversationResponse
    -> LeaveSubConversationResponse -> Bool)
-> Eq LeaveSubConversationResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeaveSubConversationResponse
-> LeaveSubConversationResponse -> Bool
== :: LeaveSubConversationResponse
-> LeaveSubConversationResponse -> Bool
$c/= :: LeaveSubConversationResponse
-> LeaveSubConversationResponse -> Bool
/= :: LeaveSubConversationResponse
-> LeaveSubConversationResponse -> Bool
Eq, Int -> LeaveSubConversationResponse -> ShowS
[LeaveSubConversationResponse] -> ShowS
LeaveSubConversationResponse -> String
(Int -> LeaveSubConversationResponse -> ShowS)
-> (LeaveSubConversationResponse -> String)
-> ([LeaveSubConversationResponse] -> ShowS)
-> Show LeaveSubConversationResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeaveSubConversationResponse -> ShowS
showsPrec :: Int -> LeaveSubConversationResponse -> ShowS
$cshow :: LeaveSubConversationResponse -> String
show :: LeaveSubConversationResponse -> String
$cshowList :: [LeaveSubConversationResponse] -> ShowS
showList :: [LeaveSubConversationResponse] -> ShowS
Show, (forall x.
 LeaveSubConversationResponse -> Rep LeaveSubConversationResponse x)
-> (forall x.
    Rep LeaveSubConversationResponse x -> LeaveSubConversationResponse)
-> Generic LeaveSubConversationResponse
forall x.
Rep LeaveSubConversationResponse x -> LeaveSubConversationResponse
forall x.
LeaveSubConversationResponse -> Rep LeaveSubConversationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
LeaveSubConversationResponse -> Rep LeaveSubConversationResponse x
from :: forall x.
LeaveSubConversationResponse -> Rep LeaveSubConversationResponse x
$cto :: forall x.
Rep LeaveSubConversationResponse x -> LeaveSubConversationResponse
to :: forall x.
Rep LeaveSubConversationResponse x -> LeaveSubConversationResponse
Generic)
  deriving ([LeaveSubConversationResponse] -> Value
[LeaveSubConversationResponse] -> Encoding
LeaveSubConversationResponse -> Value
LeaveSubConversationResponse -> Encoding
(LeaveSubConversationResponse -> Value)
-> (LeaveSubConversationResponse -> Encoding)
-> ([LeaveSubConversationResponse] -> Value)
-> ([LeaveSubConversationResponse] -> Encoding)
-> ToJSON LeaveSubConversationResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LeaveSubConversationResponse -> Value
toJSON :: LeaveSubConversationResponse -> Value
$ctoEncoding :: LeaveSubConversationResponse -> Encoding
toEncoding :: LeaveSubConversationResponse -> Encoding
$ctoJSONList :: [LeaveSubConversationResponse] -> Value
toJSONList :: [LeaveSubConversationResponse] -> Value
$ctoEncodingList :: [LeaveSubConversationResponse] -> Encoding
toEncodingList :: [LeaveSubConversationResponse] -> Encoding
ToJSON, Value -> Parser [LeaveSubConversationResponse]
Value -> Parser LeaveSubConversationResponse
(Value -> Parser LeaveSubConversationResponse)
-> (Value -> Parser [LeaveSubConversationResponse])
-> FromJSON LeaveSubConversationResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LeaveSubConversationResponse
parseJSON :: Value -> Parser LeaveSubConversationResponse
$cparseJSONList :: Value -> Parser [LeaveSubConversationResponse]
parseJSONList :: Value -> Parser [LeaveSubConversationResponse]
FromJSON) via (CustomEncoded LeaveSubConversationResponse)

instance ToSchema LeaveSubConversationResponse

data DeleteSubConversationFedRequest = DeleteSubConversationFedRequest
  { DeleteSubConversationFedRequest -> UserId
dscreqUser :: UserId,
    DeleteSubConversationFedRequest -> ConvId
dscreqConv :: ConvId,
    DeleteSubConversationFedRequest -> SubConvId
dscreqSubConv :: SubConvId,
    DeleteSubConversationFedRequest -> GroupId
dscreqGroupId :: GroupId,
    DeleteSubConversationFedRequest -> Epoch
dscreqEpoch :: Epoch
  }
  deriving stock (DeleteSubConversationFedRequest
-> DeleteSubConversationFedRequest -> Bool
(DeleteSubConversationFedRequest
 -> DeleteSubConversationFedRequest -> Bool)
-> (DeleteSubConversationFedRequest
    -> DeleteSubConversationFedRequest -> Bool)
-> Eq DeleteSubConversationFedRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteSubConversationFedRequest
-> DeleteSubConversationFedRequest -> Bool
== :: DeleteSubConversationFedRequest
-> DeleteSubConversationFedRequest -> Bool
$c/= :: DeleteSubConversationFedRequest
-> DeleteSubConversationFedRequest -> Bool
/= :: DeleteSubConversationFedRequest
-> DeleteSubConversationFedRequest -> Bool
Eq, Int -> DeleteSubConversationFedRequest -> ShowS
[DeleteSubConversationFedRequest] -> ShowS
DeleteSubConversationFedRequest -> String
(Int -> DeleteSubConversationFedRequest -> ShowS)
-> (DeleteSubConversationFedRequest -> String)
-> ([DeleteSubConversationFedRequest] -> ShowS)
-> Show DeleteSubConversationFedRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteSubConversationFedRequest -> ShowS
showsPrec :: Int -> DeleteSubConversationFedRequest -> ShowS
$cshow :: DeleteSubConversationFedRequest -> String
show :: DeleteSubConversationFedRequest -> String
$cshowList :: [DeleteSubConversationFedRequest] -> ShowS
showList :: [DeleteSubConversationFedRequest] -> ShowS
Show, (forall x.
 DeleteSubConversationFedRequest
 -> Rep DeleteSubConversationFedRequest x)
-> (forall x.
    Rep DeleteSubConversationFedRequest x
    -> DeleteSubConversationFedRequest)
-> Generic DeleteSubConversationFedRequest
forall x.
Rep DeleteSubConversationFedRequest x
-> DeleteSubConversationFedRequest
forall x.
DeleteSubConversationFedRequest
-> Rep DeleteSubConversationFedRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
DeleteSubConversationFedRequest
-> Rep DeleteSubConversationFedRequest x
from :: forall x.
DeleteSubConversationFedRequest
-> Rep DeleteSubConversationFedRequest x
$cto :: forall x.
Rep DeleteSubConversationFedRequest x
-> DeleteSubConversationFedRequest
to :: forall x.
Rep DeleteSubConversationFedRequest x
-> DeleteSubConversationFedRequest
Generic)
  deriving ([DeleteSubConversationFedRequest] -> Value
[DeleteSubConversationFedRequest] -> Encoding
DeleteSubConversationFedRequest -> Value
DeleteSubConversationFedRequest -> Encoding
(DeleteSubConversationFedRequest -> Value)
-> (DeleteSubConversationFedRequest -> Encoding)
-> ([DeleteSubConversationFedRequest] -> Value)
-> ([DeleteSubConversationFedRequest] -> Encoding)
-> ToJSON DeleteSubConversationFedRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: DeleteSubConversationFedRequest -> Value
toJSON :: DeleteSubConversationFedRequest -> Value
$ctoEncoding :: DeleteSubConversationFedRequest -> Encoding
toEncoding :: DeleteSubConversationFedRequest -> Encoding
$ctoJSONList :: [DeleteSubConversationFedRequest] -> Value
toJSONList :: [DeleteSubConversationFedRequest] -> Value
$ctoEncodingList :: [DeleteSubConversationFedRequest] -> Encoding
toEncodingList :: [DeleteSubConversationFedRequest] -> Encoding
ToJSON, Value -> Parser [DeleteSubConversationFedRequest]
Value -> Parser DeleteSubConversationFedRequest
(Value -> Parser DeleteSubConversationFedRequest)
-> (Value -> Parser [DeleteSubConversationFedRequest])
-> FromJSON DeleteSubConversationFedRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DeleteSubConversationFedRequest
parseJSON :: Value -> Parser DeleteSubConversationFedRequest
$cparseJSONList :: Value -> Parser [DeleteSubConversationFedRequest]
parseJSONList :: Value -> Parser [DeleteSubConversationFedRequest]
FromJSON) via (CustomEncoded DeleteSubConversationFedRequest)

instance ToSchema DeleteSubConversationFedRequest

data DeleteSubConversationResponse
  = DeleteSubConversationResponseError GalleyError
  | DeleteSubConversationResponseSuccess
  deriving stock (DeleteSubConversationResponse
-> DeleteSubConversationResponse -> Bool
(DeleteSubConversationResponse
 -> DeleteSubConversationResponse -> Bool)
-> (DeleteSubConversationResponse
    -> DeleteSubConversationResponse -> Bool)
-> Eq DeleteSubConversationResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteSubConversationResponse
-> DeleteSubConversationResponse -> Bool
== :: DeleteSubConversationResponse
-> DeleteSubConversationResponse -> Bool
$c/= :: DeleteSubConversationResponse
-> DeleteSubConversationResponse -> Bool
/= :: DeleteSubConversationResponse
-> DeleteSubConversationResponse -> Bool
Eq, Int -> DeleteSubConversationResponse -> ShowS
[DeleteSubConversationResponse] -> ShowS
DeleteSubConversationResponse -> String
(Int -> DeleteSubConversationResponse -> ShowS)
-> (DeleteSubConversationResponse -> String)
-> ([DeleteSubConversationResponse] -> ShowS)
-> Show DeleteSubConversationResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteSubConversationResponse -> ShowS
showsPrec :: Int -> DeleteSubConversationResponse -> ShowS
$cshow :: DeleteSubConversationResponse -> String
show :: DeleteSubConversationResponse -> String
$cshowList :: [DeleteSubConversationResponse] -> ShowS
showList :: [DeleteSubConversationResponse] -> ShowS
Show, (forall x.
 DeleteSubConversationResponse
 -> Rep DeleteSubConversationResponse x)
-> (forall x.
    Rep DeleteSubConversationResponse x
    -> DeleteSubConversationResponse)
-> Generic DeleteSubConversationResponse
forall x.
Rep DeleteSubConversationResponse x
-> DeleteSubConversationResponse
forall x.
DeleteSubConversationResponse
-> Rep DeleteSubConversationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
DeleteSubConversationResponse
-> Rep DeleteSubConversationResponse x
from :: forall x.
DeleteSubConversationResponse
-> Rep DeleteSubConversationResponse x
$cto :: forall x.
Rep DeleteSubConversationResponse x
-> DeleteSubConversationResponse
to :: forall x.
Rep DeleteSubConversationResponse x
-> DeleteSubConversationResponse
Generic)
  deriving ([DeleteSubConversationResponse] -> Value
[DeleteSubConversationResponse] -> Encoding
DeleteSubConversationResponse -> Value
DeleteSubConversationResponse -> Encoding
(DeleteSubConversationResponse -> Value)
-> (DeleteSubConversationResponse -> Encoding)
-> ([DeleteSubConversationResponse] -> Value)
-> ([DeleteSubConversationResponse] -> Encoding)
-> ToJSON DeleteSubConversationResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: DeleteSubConversationResponse -> Value
toJSON :: DeleteSubConversationResponse -> Value
$ctoEncoding :: DeleteSubConversationResponse -> Encoding
toEncoding :: DeleteSubConversationResponse -> Encoding
$ctoJSONList :: [DeleteSubConversationResponse] -> Value
toJSONList :: [DeleteSubConversationResponse] -> Value
$ctoEncodingList :: [DeleteSubConversationResponse] -> Encoding
toEncodingList :: [DeleteSubConversationResponse] -> Encoding
ToJSON, Value -> Parser [DeleteSubConversationResponse]
Value -> Parser DeleteSubConversationResponse
(Value -> Parser DeleteSubConversationResponse)
-> (Value -> Parser [DeleteSubConversationResponse])
-> FromJSON DeleteSubConversationResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DeleteSubConversationResponse
parseJSON :: Value -> Parser DeleteSubConversationResponse
$cparseJSONList :: Value -> Parser [DeleteSubConversationResponse]
parseJSONList :: Value -> Parser [DeleteSubConversationResponse]
FromJSON) via (CustomEncoded DeleteSubConversationResponse)

instance ToSchema DeleteSubConversationResponse

swaggerDoc :: OpenApi
swaggerDoc :: OpenApi
swaggerDoc = Proxy
  (Named
     "on-conversation-created"
     ("on-conversation-created"
      :> (OriginDomainHeader
          :> (ReqBody '[JSON] (ConversationCreated ConvId)
              :> Verb 'POST 200 '[JSON] EmptyResponse)))
   :<|> (Named
           "get-conversations@v1"
           ("get-conversations"
            :> (OriginDomainHeader
                :> (ReqBody '[JSON] GetConversationsRequest
                    :> Verb 'POST 200 '[JSON] GetConversationsResponse)))
         :<|> (Named "get-conversations" EmptyAPI
               :<|> (Named
                       "leave-conversation"
                       ("leave-conversation"
                        :> (OriginDomainHeader
                            :> (ReqBody '[JSON] LeaveConversationRequest
                                :> Verb 'POST 200 '[JSON] LeaveConversationResponse)))
                     :<|> (Named
                             "send-message"
                             ("send-message"
                              :> (OriginDomainHeader
                                  :> (ReqBody '[JSON] ProteusMessageSendRequest
                                      :> Verb 'POST 200 '[JSON] MessageSendResponse)))
                           :<|> (Named
                                   "update-conversation"
                                   ("update-conversation"
                                    :> (OriginDomainHeader
                                        :> (ReqBody '[JSON] ConversationUpdateRequest
                                            :> Verb 'POST 200 '[JSON] ConversationUpdateResponse)))
                                 :<|> (Named
                                         "mls-welcome"
                                         ("mls-welcome"
                                          :> (OriginDomainHeader
                                              :> (ReqBody '[JSON] MLSWelcomeRequest
                                                  :> Verb 'POST 200 '[JSON] MLSWelcomeResponse)))
                                       :<|> (Named
                                               "send-mls-message"
                                               ("send-mls-message"
                                                :> (OriginDomainHeader
                                                    :> (ReqBody '[JSON] MLSMessageSendRequest
                                                        :> Verb
                                                             'POST 200 '[JSON] MLSMessageResponse)))
                                             :<|> (Named
                                                     "send-mls-commit-bundle"
                                                     ("send-mls-commit-bundle"
                                                      :> (OriginDomainHeader
                                                          :> (ReqBody '[JSON] MLSMessageSendRequest
                                                              :> Verb
                                                                   'POST
                                                                   200
                                                                   '[JSON]
                                                                   MLSMessageResponse)))
                                                   :<|> (Named
                                                           "query-group-info"
                                                           ("query-group-info"
                                                            :> (OriginDomainHeader
                                                                :> (ReqBody
                                                                      '[JSON] GetGroupInfoRequest
                                                                    :> Verb
                                                                         'POST
                                                                         200
                                                                         '[JSON]
                                                                         GetGroupInfoResponse)))
                                                         :<|> (Named
                                                                 "update-typing-indicator"
                                                                 ("update-typing-indicator"
                                                                  :> (OriginDomainHeader
                                                                      :> (ReqBody
                                                                            '[JSON]
                                                                            TypingDataUpdateRequest
                                                                          :> Verb
                                                                               'POST
                                                                               200
                                                                               '[JSON]
                                                                               TypingDataUpdateResponse)))
                                                               :<|> (Named
                                                                       "on-typing-indicator-updated"
                                                                       ("on-typing-indicator-updated"
                                                                        :> (OriginDomainHeader
                                                                            :> (ReqBody
                                                                                  '[JSON]
                                                                                  TypingDataUpdated
                                                                                :> Verb
                                                                                     'POST
                                                                                     200
                                                                                     '[JSON]
                                                                                     EmptyResponse)))
                                                                     :<|> (Named
                                                                             "get-sub-conversation"
                                                                             ("get-sub-conversation"
                                                                              :> (OriginDomainHeader
                                                                                  :> (ReqBody
                                                                                        '[JSON]
                                                                                        GetSubConversationsRequest
                                                                                      :> Verb
                                                                                           'POST
                                                                                           200
                                                                                           '[JSON]
                                                                                           GetSubConversationsResponse)))
                                                                           :<|> (Named
                                                                                   "delete-sub-conversation"
                                                                                   ("delete-sub-conversation"
                                                                                    :> (OriginDomainHeader
                                                                                        :> (ReqBody
                                                                                              '[JSON]
                                                                                              DeleteSubConversationFedRequest
                                                                                            :> Verb
                                                                                                 'POST
                                                                                                 200
                                                                                                 '[JSON]
                                                                                                 DeleteSubConversationResponse)))
                                                                                 :<|> (Named
                                                                                         "leave-sub-conversation"
                                                                                         ("leave-sub-conversation"
                                                                                          :> (OriginDomainHeader
                                                                                              :> (ReqBody
                                                                                                    '[JSON]
                                                                                                    LeaveSubConversationRequest
                                                                                                  :> Verb
                                                                                                       'POST
                                                                                                       200
                                                                                                       '[JSON]
                                                                                                       LeaveSubConversationResponse)))
                                                                                       :<|> (Named
                                                                                               "get-one2one-conversation@v1"
                                                                                               ("get-one2one-conversation"
                                                                                                :> (OriginDomainHeader
                                                                                                    :> (ReqBody
                                                                                                          '[JSON]
                                                                                                          GetOne2OneConversationRequest
                                                                                                        :> Verb
                                                                                                             'POST
                                                                                                             200
                                                                                                             '[JSON]
                                                                                                             GetOne2OneConversationResponse)))
                                                                                             :<|> (Named
                                                                                                     "get-one2one-conversation"
                                                                                                     EmptyAPI
                                                                                                   :<|> (Named
                                                                                                           "on-client-removed"
                                                                                                           ("on-client-removed"
                                                                                                            :> (OriginDomainHeader
                                                                                                                :> (ReqBody
                                                                                                                      '[JSON]
                                                                                                                      ClientRemovedRequest
                                                                                                                    :> Verb
                                                                                                                         'POST
                                                                                                                         200
                                                                                                                         '[JSON]
                                                                                                                         EmptyResponse)))
                                                                                                         :<|> (Named
                                                                                                                 "on-message-sent"
                                                                                                                 ("on-message-sent"
                                                                                                                  :> (OriginDomainHeader
                                                                                                                      :> (ReqBody
                                                                                                                            '[JSON]
                                                                                                                            (RemoteMessage
                                                                                                                               ConvId)
                                                                                                                          :> Verb
                                                                                                                               'POST
                                                                                                                               200
                                                                                                                               '[JSON]
                                                                                                                               EmptyResponse)))
                                                                                                               :<|> (Named
                                                                                                                       "on-mls-message-sent"
                                                                                                                       ("on-mls-message-sent"
                                                                                                                        :> (OriginDomainHeader
                                                                                                                            :> (ReqBody
                                                                                                                                  '[JSON]
                                                                                                                                  RemoteMLSMessage
                                                                                                                                :> Verb
                                                                                                                                     'POST
                                                                                                                                     200
                                                                                                                                     '[JSON]
                                                                                                                                     EmptyResponse)))
                                                                                                                     :<|> (Named
                                                                                                                             (Versioned
                                                                                                                                'V0
                                                                                                                                "on-conversation-updated")
                                                                                                                             EmptyAPI
                                                                                                                           :<|> (Named
                                                                                                                                   "on-conversation-updated"
                                                                                                                                   ("on-conversation-updated"
                                                                                                                                    :> (OriginDomainHeader
                                                                                                                                        :> (ReqBody
                                                                                                                                              '[JSON]
                                                                                                                                              ConversationUpdate
                                                                                                                                            :> Verb
                                                                                                                                                 'POST
                                                                                                                                                 200
                                                                                                                                                 '[JSON]
                                                                                                                                                 EmptyResponse)))
                                                                                                                                 :<|> Named
                                                                                                                                        "on-user-deleted-conversations"
                                                                                                                                        ("on-user-deleted-conversations"
                                                                                                                                         :> (OriginDomainHeader
                                                                                                                                             :> (ReqBody
                                                                                                                                                   '[JSON]
                                                                                                                                                   UserDeletedConversationsNotification
                                                                                                                                                 :> Verb
                                                                                                                                                      'POST
                                                                                                                                                      200
                                                                                                                                                      '[JSON]
                                                                                                                                                      EmptyResponse)))))))))))))))))))))))))
-> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SpecialiseToVersion 'V1 GalleyApi))