{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}

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

-- FUTUREWORK: There's still a lot of stuff we should factor out into separate
-- modules.
module Wire.API.Conversation
  ( -- * Conversation
    ConversationMetadata (..),
    defConversationMetadata,
    Conversation (..),
    conversationSchema,
    cnvType,
    cnvCreator,
    cnvAccess,
    cnvName,
    cnvTeam,
    cnvMessageTimer,
    cnvReceiptMode,
    cnvAccessRoles,
    MLSOne2OneConversation (..),
    CreateGroupConversation (..),
    ConversationCoverView (..),
    ConversationList (..),
    ListConversations (..),
    GetPaginatedConversationIds,
    pattern GetPaginatedConversationIds,
    ConvIdsPage,
    pattern ConvIdsPage,
    ConversationPagingState,
    pattern ConversationPagingState,
    ConversationsResponse (..),
    GroupId (..),
    mlsSelfConvId,

    -- * Conversation properties
    Access (..),
    AccessRole (..),
    accessRolesSchemaV2,
    genAccessRolesV2,
    AccessRoleLegacy (..),
    ConvType (..),
    ReceiptMode (..),
    fromAccessRoleLegacy,
    toAccessRoleLegacy,
    defRole,
    maybeRole,

    -- * create
    NewConv (..),
    ConvTeamInfo (..),

    -- * invite
    Invite (..),
    InviteQualified (..),

    -- * update
    ConversationRename (..),
    ConversationAccessData (..),
    conversationAccessDataSchema,
    ConversationReceiptModeUpdate (..),
    ConversationMessageTimerUpdate (..),
    ConversationJoin (..),
    ConversationMemberUpdate (..),
    ConversationRemoveMembers (..),

    -- * re-exports
    module Wire.API.Conversation.Member,
  )
where

import Control.Applicative
import Control.Lens ((?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as A
import Data.ByteString.Lazy qualified as LBS
import Data.Domain
import Data.Id
import Data.List.Extra (disjointOrd)
import Data.List.NonEmpty (NonEmpty)
import Data.List1
import Data.Map qualified as Map
import Data.Misc
import Data.OpenApi qualified as S
import Data.Qualified
import Data.Range (Range, fromRange, rangedSchema)
import Data.SOP
import Data.Schema
import Data.Set qualified as Set
import Data.Singletons
import Data.Text qualified as Text
import Data.UUID qualified as UUID
import Data.UUID.V5 qualified as UUIDV5
import Imports
import System.Random (randomRIO)
import Wire.API.Conversation.Member
import Wire.API.Conversation.Protocol
import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin)
import Wire.API.Event.LeaveReason
import Wire.API.MLS.Group
import Wire.API.MLS.Keys
import Wire.API.Routes.MultiTablePaging
import Wire.API.Routes.MultiVerb
import Wire.API.Routes.Version
import Wire.API.Routes.Versioned
import Wire.API.User
import Wire.Arbitrary

--------------------------------------------------------------------------------
-- Conversation

data ConversationMetadata = ConversationMetadata
  { ConversationMetadata -> ConvType
cnvmType :: ConvType,
    -- FUTUREWORK: Make this a qualified user ID.
    ConversationMetadata -> Maybe UserId
cnvmCreator :: Maybe UserId,
    ConversationMetadata -> [Access]
cnvmAccess :: [Access],
    ConversationMetadata -> Set AccessRole
cnvmAccessRoles :: Set AccessRole,
    ConversationMetadata -> Maybe Text
cnvmName :: Maybe Text,
    -- FUTUREWORK: Think if it makes sense to make the team ID qualified due to
    -- federation.
    ConversationMetadata -> Maybe TeamId
cnvmTeam :: Maybe TeamId,
    ConversationMetadata -> Maybe Milliseconds
cnvmMessageTimer :: Maybe Milliseconds,
    ConversationMetadata -> Maybe ReceiptMode
cnvmReceiptMode :: Maybe ReceiptMode
  }
  deriving stock (ConversationMetadata -> ConversationMetadata -> Bool
(ConversationMetadata -> ConversationMetadata -> Bool)
-> (ConversationMetadata -> ConversationMetadata -> Bool)
-> Eq ConversationMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationMetadata -> ConversationMetadata -> Bool
== :: ConversationMetadata -> ConversationMetadata -> Bool
$c/= :: ConversationMetadata -> ConversationMetadata -> Bool
/= :: ConversationMetadata -> ConversationMetadata -> Bool
Eq, Int -> ConversationMetadata -> ShowS
[ConversationMetadata] -> ShowS
ConversationMetadata -> String
(Int -> ConversationMetadata -> ShowS)
-> (ConversationMetadata -> String)
-> ([ConversationMetadata] -> ShowS)
-> Show ConversationMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationMetadata -> ShowS
showsPrec :: Int -> ConversationMetadata -> ShowS
$cshow :: ConversationMetadata -> String
show :: ConversationMetadata -> String
$cshowList :: [ConversationMetadata] -> ShowS
showList :: [ConversationMetadata] -> ShowS
Show, (forall x. ConversationMetadata -> Rep ConversationMetadata x)
-> (forall x. Rep ConversationMetadata x -> ConversationMetadata)
-> Generic ConversationMetadata
forall x. Rep ConversationMetadata x -> ConversationMetadata
forall x. ConversationMetadata -> Rep ConversationMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConversationMetadata -> Rep ConversationMetadata x
from :: forall x. ConversationMetadata -> Rep ConversationMetadata x
$cto :: forall x. Rep ConversationMetadata x -> ConversationMetadata
to :: forall x. Rep ConversationMetadata x -> ConversationMetadata
Generic)
  deriving (Gen ConversationMetadata
Gen ConversationMetadata
-> (ConversationMetadata -> [ConversationMetadata])
-> Arbitrary ConversationMetadata
ConversationMetadata -> [ConversationMetadata]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationMetadata
arbitrary :: Gen ConversationMetadata
$cshrink :: ConversationMetadata -> [ConversationMetadata]
shrink :: ConversationMetadata -> [ConversationMetadata]
Arbitrary) via (GenericUniform ConversationMetadata)
  deriving (Value -> Parser [ConversationMetadata]
Value -> Parser ConversationMetadata
(Value -> Parser ConversationMetadata)
-> (Value -> Parser [ConversationMetadata])
-> FromJSON ConversationMetadata
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationMetadata
parseJSON :: Value -> Parser ConversationMetadata
$cparseJSONList :: Value -> Parser [ConversationMetadata]
parseJSONList :: Value -> Parser [ConversationMetadata]
FromJSON, [ConversationMetadata] -> Value
[ConversationMetadata] -> Encoding
ConversationMetadata -> Value
ConversationMetadata -> Encoding
(ConversationMetadata -> Value)
-> (ConversationMetadata -> Encoding)
-> ([ConversationMetadata] -> Value)
-> ([ConversationMetadata] -> Encoding)
-> ToJSON ConversationMetadata
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationMetadata -> Value
toJSON :: ConversationMetadata -> Value
$ctoEncoding :: ConversationMetadata -> Encoding
toEncoding :: ConversationMetadata -> Encoding
$ctoJSONList :: [ConversationMetadata] -> Value
toJSONList :: [ConversationMetadata] -> Value
$ctoEncodingList :: [ConversationMetadata] -> Encoding
toEncodingList :: [ConversationMetadata] -> Encoding
ToJSON, Typeable ConversationMetadata
Typeable ConversationMetadata =>
(Proxy ConversationMetadata
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationMetadata
Proxy ConversationMetadata
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationMetadata
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationMetadata
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ConversationMetadata

defConversationMetadata :: Maybe UserId -> ConversationMetadata
defConversationMetadata :: Maybe UserId -> ConversationMetadata
defConversationMetadata Maybe UserId
mCreator =
  ConversationMetadata
    { $sel:cnvmType:ConversationMetadata :: ConvType
cnvmType = ConvType
RegularConv,
      $sel:cnvmCreator:ConversationMetadata :: Maybe UserId
cnvmCreator = Maybe UserId
mCreator,
      $sel:cnvmAccess:ConversationMetadata :: [Access]
cnvmAccess = [Access
PrivateAccess],
      $sel:cnvmAccessRoles:ConversationMetadata :: Set AccessRole
cnvmAccessRoles = Set AccessRole
forall a. Monoid a => a
mempty,
      $sel:cnvmName:ConversationMetadata :: Maybe Text
cnvmName = Maybe Text
forall a. Maybe a
Nothing,
      $sel:cnvmTeam:ConversationMetadata :: Maybe TeamId
cnvmTeam = Maybe TeamId
forall a. Maybe a
Nothing,
      $sel:cnvmMessageTimer:ConversationMetadata :: Maybe Milliseconds
cnvmMessageTimer = Maybe Milliseconds
forall a. Maybe a
Nothing,
      $sel:cnvmReceiptMode:ConversationMetadata :: Maybe ReceiptMode
cnvmReceiptMode = Maybe ReceiptMode
forall a. Maybe a
Nothing
    }

accessRolesVersionedSchema :: Maybe Version -> ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesVersionedSchema :: Maybe Version -> ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesVersionedSchema (Just Version
v) | Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
V3 = ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesSchemaV2
accessRolesVersionedSchema Maybe Version
_ = ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesSchema

accessRolesSchema :: ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesSchema :: ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesSchema = Text
-> SchemaP SwaggerDoc Value Value (Set AccessRole) (Set AccessRole)
-> ObjectSchema SwaggerDoc (Set AccessRole)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"access_role" (ValueSchema NamedSwaggerDoc AccessRole
-> SchemaP SwaggerDoc Value Value (Set AccessRole) (Set AccessRole)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc AccessRole
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

accessRolesSchemaV2 :: ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesSchemaV2 :: ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesSchemaV2 = Set AccessRole -> (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
toOutput (Set AccessRole
 -> (Maybe AccessRoleLegacy, Maybe (Set AccessRole)))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set AccessRole)
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
  (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
accessRolesSchemaTuple SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Set AccessRole)
  (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
-> ((Maybe AccessRoleLegacy, Maybe (Set AccessRole))
    -> Parser (Set AccessRole))
-> ObjectSchema SwaggerDoc (Set AccessRole)
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
`withParser` (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
-> Parser (Set AccessRole)
validate
  where
    toOutput :: Set AccessRole -> (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
toOutput Set AccessRole
accessRoles = (AccessRoleLegacy -> Maybe AccessRoleLegacy
forall a. a -> Maybe a
Just (AccessRoleLegacy -> Maybe AccessRoleLegacy)
-> AccessRoleLegacy -> Maybe AccessRoleLegacy
forall a b. (a -> b) -> a -> b
$ Set AccessRole -> AccessRoleLegacy
toAccessRoleLegacy Set AccessRole
accessRoles, Set AccessRole -> Maybe (Set AccessRole)
forall a. a -> Maybe a
Just Set AccessRole
accessRoles)
    validate :: (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
-> Parser (Set AccessRole)
validate =
      \case
        (Maybe AccessRoleLegacy
_, Just Set AccessRole
v2) -> Set AccessRole -> Parser (Set AccessRole)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set AccessRole
v2
        (Just AccessRoleLegacy
legacy, Maybe (Set AccessRole)
Nothing) -> Set AccessRole -> Parser (Set AccessRole)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set AccessRole -> Parser (Set AccessRole))
-> Set AccessRole -> Parser (Set AccessRole)
forall a b. (a -> b) -> a -> b
$ AccessRoleLegacy -> Set AccessRole
fromAccessRoleLegacy AccessRoleLegacy
legacy
        (Maybe AccessRoleLegacy
Nothing, Maybe (Set AccessRole)
Nothing) -> String -> Parser (Set AccessRole)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"access_role|access_role_v2"

accessRolesSchemaOptV2 :: ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
accessRolesSchemaOptV2 :: ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
accessRolesSchemaOptV2 = Maybe (Set AccessRole)
-> (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
forall {f :: * -> *}.
Functor f =>
f (Set AccessRole) -> (f AccessRoleLegacy, f (Set AccessRole))
toOutput (Maybe (Set AccessRole)
 -> (Maybe AccessRoleLegacy, Maybe (Set AccessRole)))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Set AccessRole))
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
  (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
accessRolesSchemaTuple SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe (Set AccessRole))
  (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
-> ((Maybe AccessRoleLegacy, Maybe (Set AccessRole))
    -> Parser (Maybe (Set AccessRole)))
-> ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
`withParser` (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
-> Parser (Maybe (Set AccessRole))
validate
  where
    toOutput :: f (Set AccessRole) -> (f AccessRoleLegacy, f (Set AccessRole))
toOutput f (Set AccessRole)
accessRoles = (Set AccessRole -> AccessRoleLegacy
toAccessRoleLegacy (Set AccessRole -> AccessRoleLegacy)
-> f (Set AccessRole) -> f AccessRoleLegacy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Set AccessRole)
accessRoles, f (Set AccessRole)
accessRoles)
    validate :: (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
-> Parser (Maybe (Set AccessRole))
validate =
      \case
        (Maybe AccessRoleLegacy
_, Just Set AccessRole
v2) -> Maybe (Set AccessRole) -> Parser (Maybe (Set AccessRole))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Set AccessRole) -> Parser (Maybe (Set AccessRole)))
-> Maybe (Set AccessRole) -> Parser (Maybe (Set AccessRole))
forall a b. (a -> b) -> a -> b
$ Set AccessRole -> Maybe (Set AccessRole)
forall a. a -> Maybe a
Just Set AccessRole
v2
        (Just AccessRoleLegacy
legacy, Maybe (Set AccessRole)
Nothing) -> Maybe (Set AccessRole) -> Parser (Maybe (Set AccessRole))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Set AccessRole) -> Parser (Maybe (Set AccessRole)))
-> Maybe (Set AccessRole) -> Parser (Maybe (Set AccessRole))
forall a b. (a -> b) -> a -> b
$ Set AccessRole -> Maybe (Set AccessRole)
forall a. a -> Maybe a
Just (AccessRoleLegacy -> Set AccessRole
fromAccessRoleLegacy AccessRoleLegacy
legacy)
        (Maybe AccessRoleLegacy
Nothing, Maybe (Set AccessRole)
Nothing) -> Maybe (Set AccessRole) -> Parser (Maybe (Set AccessRole))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Set AccessRole)
forall a. Maybe a
Nothing

accessRolesSchemaTuple :: ObjectSchema SwaggerDoc (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
accessRolesSchemaTuple :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
  (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
accessRolesSchemaTuple =
  (,)
    (Maybe AccessRoleLegacy
 -> Maybe (Set AccessRole)
 -> (Maybe AccessRoleLegacy, Maybe (Set AccessRole)))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
     (Maybe AccessRoleLegacy)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
     (Maybe (Set AccessRole)
      -> (Maybe AccessRoleLegacy, Maybe (Set AccessRole)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
-> Maybe AccessRoleLegacy
forall a b. (a, b) -> a
fst ((Maybe AccessRoleLegacy, Maybe (Set AccessRole))
 -> Maybe AccessRoleLegacy)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy)
     (Maybe AccessRoleLegacy)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
     (Maybe AccessRoleLegacy)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Maybe AccessRoleLegacy)
     AccessRoleLegacy
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy)
     (Maybe AccessRoleLegacy)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier Text
"access_role" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Deprecated, please use access_role_v2") (Value
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Maybe AccessRoleLegacy)
     AccessRoleLegacy
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP
  NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
  (Maybe (Set AccessRole)
   -> (Maybe AccessRoleLegacy, Maybe (Set AccessRole)))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
     (Maybe (Set AccessRole))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
  (a -> b)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
     a
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
-> Maybe (Set AccessRole)
forall a b. (a, b) -> b
snd ((Maybe AccessRoleLegacy, Maybe (Set AccessRole))
 -> Maybe (Set AccessRole))
-> ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe AccessRoleLegacy, Maybe (Set AccessRole))
     (Maybe (Set AccessRole))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc Value Value (Maybe (Set AccessRole)) (Set AccessRole)
-> ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"access_role_v2" (Value
-> SchemaP SwaggerDoc Value Value (Set AccessRole) (Set AccessRole)
-> SchemaP
     SwaggerDoc Value Value (Maybe (Set AccessRole)) (Set AccessRole)
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null (SchemaP SwaggerDoc Value Value (Set AccessRole) (Set AccessRole)
 -> SchemaP
      SwaggerDoc Value Value (Maybe (Set AccessRole)) (Set AccessRole))
-> SchemaP SwaggerDoc Value Value (Set AccessRole) (Set AccessRole)
-> SchemaP
     SwaggerDoc Value Value (Maybe (Set AccessRole)) (Set AccessRole)
forall a b. (a -> b) -> a -> b
$ ValueSchema NamedSwaggerDoc AccessRole
-> SchemaP SwaggerDoc Value Value (Set AccessRole) (Set AccessRole)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc AccessRole
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

conversationMetadataObjectSchema ::
  ObjectSchema SwaggerDoc (Set AccessRole) ->
  ObjectSchema SwaggerDoc ConversationMetadata
conversationMetadataObjectSchema :: ObjectSchema SwaggerDoc (Set AccessRole)
-> ObjectSchema SwaggerDoc ConversationMetadata
conversationMetadataObjectSchema ObjectSchema SwaggerDoc (Set AccessRole)
sch =
  ConvType
-> Maybe UserId
-> [Access]
-> Set AccessRole
-> Maybe Text
-> Maybe TeamId
-> Maybe Milliseconds
-> Maybe ReceiptMode
-> ConversationMetadata
ConversationMetadata
    (ConvType
 -> Maybe UserId
 -> [Access]
 -> Set AccessRole
 -> Maybe Text
 -> Maybe TeamId
 -> Maybe Milliseconds
 -> Maybe ReceiptMode
 -> ConversationMetadata)
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata ConvType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMetadata
     (Maybe UserId
      -> [Access]
      -> Set AccessRole
      -> Maybe Text
      -> Maybe TeamId
      -> Maybe Milliseconds
      -> Maybe ReceiptMode
      -> ConversationMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationMetadata -> ConvType
cnvmType (ConversationMetadata -> ConvType)
-> SchemaP SwaggerDoc Object [Pair] ConvType ConvType
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata ConvType
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ConvType ConvType
-> SchemaP SwaggerDoc Object [Pair] ConvType ConvType
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"type" SchemaP NamedSwaggerDoc Value Value ConvType ConvType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMetadata
  (Maybe UserId
   -> [Access]
   -> Set AccessRole
   -> Maybe Text
   -> Maybe TeamId
   -> Maybe Milliseconds
   -> Maybe ReceiptMode
   -> ConversationMetadata)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMetadata
     ([Access]
      -> Set AccessRole
      -> Maybe Text
      -> Maybe TeamId
      -> Maybe Milliseconds
      -> Maybe ReceiptMode
      -> ConversationMetadata)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMetadata (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationMetadata -> Maybe UserId
cnvmCreator
      (ConversationMetadata -> Maybe UserId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UserId) (Maybe UserId)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe UserId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value (Maybe UserId) UserId
-> SchemaP SwaggerDoc Object [Pair] (Maybe UserId) (Maybe UserId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier
        Text
"creator"
        ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The creator's user ID")
        (Value
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP NamedSwaggerDoc Value Value (Maybe UserId) UserId
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMetadata
  ([Access]
   -> Set AccessRole
   -> Maybe Text
   -> Maybe TeamId
   -> Maybe Milliseconds
   -> Maybe ReceiptMode
   -> ConversationMetadata)
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata [Access]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMetadata
     (Set AccessRole
      -> Maybe Text
      -> Maybe TeamId
      -> Maybe Milliseconds
      -> Maybe ReceiptMode
      -> ConversationMetadata)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMetadata (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationMetadata -> [Access]
cnvmAccess (ConversationMetadata -> [Access])
-> SchemaP SwaggerDoc Object [Pair] [Access] [Access]
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata [Access]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Access] [Access]
-> SchemaP SwaggerDoc Object [Pair] [Access] [Access]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"access" (ValueSchema NamedSwaggerDoc Access
-> SchemaP SwaggerDoc Value Value [Access] [Access]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Access
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMetadata
  (Set AccessRole
   -> Maybe Text
   -> Maybe TeamId
   -> Maybe Milliseconds
   -> Maybe ReceiptMode
   -> ConversationMetadata)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Set AccessRole)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMetadata
     (Maybe Text
      -> Maybe TeamId
      -> Maybe Milliseconds
      -> Maybe ReceiptMode
      -> ConversationMetadata)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMetadata (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationMetadata -> Set AccessRole
cnvmAccessRoles (ConversationMetadata -> Set AccessRole)
-> ObjectSchema SwaggerDoc (Set AccessRole)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Set AccessRole)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ObjectSchema SwaggerDoc (Set AccessRole)
sch
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMetadata
  (Maybe Text
   -> Maybe TeamId
   -> Maybe Milliseconds
   -> Maybe ReceiptMode
   -> ConversationMetadata)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMetadata
     (Maybe TeamId
      -> Maybe Milliseconds -> Maybe ReceiptMode -> ConversationMetadata)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMetadata (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationMetadata -> Maybe Text
cnvmName (ConversationMetadata -> Maybe Text)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Text) (Maybe Text)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value (Maybe Text) Text
-> SchemaP SwaggerDoc Object [Pair] (Maybe Text) (Maybe Text)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"name" (Value
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP NamedSwaggerDoc Value Value (Maybe Text) Text
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMetadata
  (Maybe TeamId
   -> Maybe Milliseconds -> Maybe ReceiptMode -> ConversationMetadata)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMetadata
     (Maybe TeamId
      -> Maybe Milliseconds -> Maybe ReceiptMode -> ConversationMetadata)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata b
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ConversationMetadata -> Text
forall a b. a -> b -> a
const (Text
"0.0" :: Text) (ConversationMetadata -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text (Maybe Text)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"last_event" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMetadata
  (Maybe TeamId
   -> Maybe Milliseconds -> Maybe ReceiptMode -> ConversationMetadata)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMetadata
     (Maybe TeamId
      -> Maybe Milliseconds -> Maybe ReceiptMode -> ConversationMetadata)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata b
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ConversationMetadata -> Text
forall a b. a -> b -> a
const (Text
"1970-01-01T00:00:00.000Z" :: Text)
      (ConversationMetadata -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text (Maybe Text)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"last_event_time" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMetadata
  (Maybe TeamId
   -> Maybe Milliseconds -> Maybe ReceiptMode -> ConversationMetadata)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe TeamId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMetadata
     (Maybe Milliseconds -> Maybe ReceiptMode -> ConversationMetadata)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMetadata (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationMetadata -> Maybe TeamId
cnvmTeam (ConversationMetadata -> Maybe TeamId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe TeamId) (Maybe TeamId)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe TeamId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value (Maybe TeamId) TeamId
-> SchemaP SwaggerDoc Object [Pair] (Maybe TeamId) (Maybe TeamId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"team" (Value
-> SchemaP NamedSwaggerDoc Value Value TeamId TeamId
-> SchemaP NamedSwaggerDoc Value Value (Maybe TeamId) TeamId
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value TeamId TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMetadata
  (Maybe Milliseconds -> Maybe ReceiptMode -> ConversationMetadata)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe Milliseconds)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMetadata
     (Maybe ReceiptMode -> ConversationMetadata)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMetadata (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationMetadata -> Maybe Milliseconds
cnvmMessageTimer
      (ConversationMetadata -> Maybe Milliseconds)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe Milliseconds) (Maybe Milliseconds)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe Milliseconds)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe Milliseconds) Milliseconds
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe Milliseconds) (Maybe Milliseconds)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier
        Text
"message_timer"
        ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Per-conversation message timer (can be null)")
        (Value
-> SchemaP NamedSwaggerDoc Value Value Milliseconds Milliseconds
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe Milliseconds) Milliseconds
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value Milliseconds Milliseconds
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMetadata
  (Maybe ReceiptMode -> ConversationMetadata)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe ReceiptMode)
-> ObjectSchema SwaggerDoc ConversationMetadata
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMetadata (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata a
-> SchemaP SwaggerDoc Object [Pair] ConversationMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationMetadata -> Maybe ReceiptMode
cnvmReceiptMode (ConversationMetadata -> Maybe ReceiptMode)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ReceiptMode) (Maybe ReceiptMode)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMetadata (Maybe ReceiptMode)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe ReceiptMode) ReceiptMode
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ReceiptMode) (Maybe ReceiptMode)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"receipt_mode" (Value
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe ReceiptMode) ReceiptMode
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

instance ToSchema ConversationMetadata where
  schema :: ValueSchema NamedSwaggerDoc ConversationMetadata
schema = Text
-> ObjectSchema SwaggerDoc ConversationMetadata
-> ValueSchema NamedSwaggerDoc ConversationMetadata
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ConversationMetadata" (ObjectSchema SwaggerDoc (Set AccessRole)
-> ObjectSchema SwaggerDoc ConversationMetadata
conversationMetadataObjectSchema ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesSchema)

instance ToSchema (Versioned 'V2 ConversationMetadata) where
  schema :: ValueSchema NamedSwaggerDoc (Versioned 'V2 ConversationMetadata)
schema =
    ConversationMetadata -> Versioned 'V2 ConversationMetadata
forall (v :: Version) a. a -> Versioned v a
Versioned
      (ConversationMetadata -> Versioned 'V2 ConversationMetadata)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned 'V2 ConversationMetadata)
     ConversationMetadata
-> ValueSchema NamedSwaggerDoc (Versioned 'V2 ConversationMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned 'V2 ConversationMetadata -> ConversationMetadata
forall (v :: Version) a. Versioned v a -> a
unVersioned
        (Versioned 'V2 ConversationMetadata -> ConversationMetadata)
-> ValueSchema NamedSwaggerDoc ConversationMetadata
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned 'V2 ConversationMetadata)
     ConversationMetadata
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ObjectSchema SwaggerDoc ConversationMetadata
-> ValueSchema NamedSwaggerDoc ConversationMetadata
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object
          Text
"ConversationMetadata"
          (ObjectSchema SwaggerDoc (Set AccessRole)
-> ObjectSchema SwaggerDoc ConversationMetadata
conversationMetadataObjectSchema ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesSchemaV2)

-- | Public-facing conversation type. Represents information that a
-- particular user is allowed to see.
--
-- Can be produced from the internal one ('Galley.Data.Types.Conversation')
-- by using 'Galley.API.Mapping.conversationView'.
data Conversation = Conversation
  { -- | A qualified conversation ID
    Conversation -> Qualified ConvId
cnvQualifiedId :: Qualified ConvId,
    Conversation -> ConversationMetadata
cnvMetadata :: ConversationMetadata,
    Conversation -> ConvMembers
cnvMembers :: ConvMembers,
    -- | The protocol of the conversation. It can be Proteus or MLS (1.0).
    Conversation -> Protocol
cnvProtocol :: Protocol
  }
  deriving stock (Conversation -> Conversation -> Bool
(Conversation -> Conversation -> Bool)
-> (Conversation -> Conversation -> Bool) -> Eq Conversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Conversation -> Conversation -> Bool
== :: Conversation -> Conversation -> Bool
$c/= :: Conversation -> Conversation -> Bool
/= :: Conversation -> Conversation -> Bool
Eq, Int -> Conversation -> ShowS
[Conversation] -> ShowS
Conversation -> String
(Int -> Conversation -> ShowS)
-> (Conversation -> String)
-> ([Conversation] -> ShowS)
-> Show Conversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Conversation -> ShowS
showsPrec :: Int -> Conversation -> ShowS
$cshow :: Conversation -> String
show :: Conversation -> String
$cshowList :: [Conversation] -> ShowS
showList :: [Conversation] -> ShowS
Show, (forall x. Conversation -> Rep Conversation x)
-> (forall x. Rep Conversation x -> Conversation)
-> Generic Conversation
forall x. Rep Conversation x -> Conversation
forall x. Conversation -> Rep Conversation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Conversation -> Rep Conversation x
from :: forall x. Conversation -> Rep Conversation x
$cto :: forall x. Rep Conversation x -> Conversation
to :: forall x. Rep Conversation x -> Conversation
Generic)
  deriving (Gen Conversation
Gen Conversation
-> (Conversation -> [Conversation]) -> Arbitrary Conversation
Conversation -> [Conversation]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Conversation
arbitrary :: Gen Conversation
$cshrink :: Conversation -> [Conversation]
shrink :: Conversation -> [Conversation]
Arbitrary) via (GenericUniform Conversation)
  deriving (Value -> Parser [Conversation]
Value -> Parser Conversation
(Value -> Parser Conversation)
-> (Value -> Parser [Conversation]) -> FromJSON Conversation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Conversation
parseJSON :: Value -> Parser Conversation
$cparseJSONList :: Value -> Parser [Conversation]
parseJSONList :: Value -> Parser [Conversation]
FromJSON, [Conversation] -> Value
[Conversation] -> Encoding
Conversation -> Value
Conversation -> Encoding
(Conversation -> Value)
-> (Conversation -> Encoding)
-> ([Conversation] -> Value)
-> ([Conversation] -> Encoding)
-> ToJSON Conversation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Conversation -> Value
toJSON :: Conversation -> Value
$ctoEncoding :: Conversation -> Encoding
toEncoding :: Conversation -> Encoding
$ctoJSONList :: [Conversation] -> Value
toJSONList :: [Conversation] -> Value
$ctoEncodingList :: [Conversation] -> Encoding
toEncodingList :: [Conversation] -> Encoding
ToJSON, Typeable Conversation
Typeable Conversation =>
(Proxy Conversation -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Conversation
Proxy Conversation -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Conversation -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Conversation -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema Conversation

cnvType :: Conversation -> ConvType
cnvType :: Conversation -> ConvType
cnvType = ConversationMetadata -> ConvType
cnvmType (ConversationMetadata -> ConvType)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> ConvType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
cnvMetadata

cnvCreator :: Conversation -> Maybe UserId
cnvCreator :: Conversation -> Maybe UserId
cnvCreator = ConversationMetadata -> Maybe UserId
cnvmCreator (ConversationMetadata -> Maybe UserId)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Maybe UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
cnvMetadata

cnvAccess :: Conversation -> [Access]
cnvAccess :: Conversation -> [Access]
cnvAccess = ConversationMetadata -> [Access]
cnvmAccess (ConversationMetadata -> [Access])
-> (Conversation -> ConversationMetadata)
-> Conversation
-> [Access]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
cnvMetadata

cnvAccessRoles :: Conversation -> Set AccessRole
cnvAccessRoles :: Conversation -> Set AccessRole
cnvAccessRoles = ConversationMetadata -> Set AccessRole
cnvmAccessRoles (ConversationMetadata -> Set AccessRole)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Set AccessRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
cnvMetadata

cnvName :: Conversation -> Maybe Text
cnvName :: Conversation -> Maybe Text
cnvName = ConversationMetadata -> Maybe Text
cnvmName (ConversationMetadata -> Maybe Text)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
cnvMetadata

cnvTeam :: Conversation -> Maybe TeamId
cnvTeam :: Conversation -> Maybe TeamId
cnvTeam = ConversationMetadata -> Maybe TeamId
cnvmTeam (ConversationMetadata -> Maybe TeamId)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Maybe TeamId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
cnvMetadata

cnvMessageTimer :: Conversation -> Maybe Milliseconds
cnvMessageTimer :: Conversation -> Maybe Milliseconds
cnvMessageTimer = ConversationMetadata -> Maybe Milliseconds
cnvmMessageTimer (ConversationMetadata -> Maybe Milliseconds)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Maybe Milliseconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
cnvMetadata

cnvReceiptMode :: Conversation -> Maybe ReceiptMode
cnvReceiptMode :: Conversation -> Maybe ReceiptMode
cnvReceiptMode = ConversationMetadata -> Maybe ReceiptMode
cnvmReceiptMode (ConversationMetadata -> Maybe ReceiptMode)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Maybe ReceiptMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
cnvMetadata

instance ToSchema Conversation where
  schema :: ValueSchema NamedSwaggerDoc Conversation
schema = Maybe Version -> ValueSchema NamedSwaggerDoc Conversation
conversationSchema Maybe Version
forall a. Maybe a
Nothing

instance (SingI v) => ToSchema (Versioned v Conversation) where
  schema :: ValueSchema NamedSwaggerDoc (Versioned v Conversation)
schema = Conversation -> Versioned v Conversation
forall (v :: Version) a. a -> Versioned v a
Versioned (Conversation -> Versioned v Conversation)
-> SchemaP
     NamedSwaggerDoc Value Value (Versioned v Conversation) Conversation
-> ValueSchema NamedSwaggerDoc (Versioned v Conversation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned v Conversation -> Conversation
forall (v :: Version) a. Versioned v a -> a
unVersioned (Versioned v Conversation -> Conversation)
-> ValueSchema NamedSwaggerDoc Conversation
-> SchemaP
     NamedSwaggerDoc Value Value (Versioned v Conversation) Conversation
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version -> ValueSchema NamedSwaggerDoc Conversation
conversationSchema (Version -> Maybe Version
forall a. a -> Maybe a
Just (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Version).
(SingKind Version, SingI a) =>
Demote Version
demote @v))

conversationObjectSchema :: Maybe Version -> ObjectSchema SwaggerDoc Conversation
conversationObjectSchema :: Maybe Version -> ObjectSchema SwaggerDoc Conversation
conversationObjectSchema Maybe Version
v =
  Qualified ConvId
-> ConversationMetadata -> ConvMembers -> Protocol -> Conversation
Conversation
    (Qualified ConvId
 -> ConversationMetadata -> ConvMembers -> Protocol -> Conversation)
-> SchemaP SwaggerDoc Object [Pair] Conversation (Qualified ConvId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Conversation
     (ConversationMetadata -> ConvMembers -> Protocol -> Conversation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Conversation -> Qualified ConvId
cnvQualifiedId (Conversation -> Qualified ConvId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified ConvId) (Qualified ConvId)
-> SchemaP SwaggerDoc Object [Pair] Conversation (Qualified ConvId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified ConvId) (Qualified ConvId)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"qualified_id" SchemaP
  NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  Conversation
  (ConversationMetadata -> ConvMembers -> Protocol -> Conversation)
-> SchemaP SwaggerDoc Object [Pair] Conversation (Maybe ConvId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Conversation
     (ConversationMetadata -> ConvMembers -> Protocol -> Conversation)
forall a b.
SchemaP SwaggerDoc Object [Pair] Conversation a
-> SchemaP SwaggerDoc Object [Pair] Conversation b
-> SchemaP SwaggerDoc Object [Pair] Conversation a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Qualified ConvId -> ConvId
forall a. Qualified a -> a
qUnqualified (Qualified ConvId -> ConvId)
-> (Conversation -> Qualified ConvId) -> Conversation -> ConvId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> Qualified ConvId
cnvQualifiedId)
      (Conversation -> ConvId)
-> SchemaP SwaggerDoc Object [Pair] ConvId (Maybe ConvId)
-> SchemaP SwaggerDoc Object [Pair] Conversation (Maybe ConvId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ConvId ConvId
-> SchemaP SwaggerDoc Object [Pair] ConvId (Maybe ConvId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text
-> SchemaP NamedSwaggerDoc Value Value ConvId ConvId
-> SchemaP SwaggerDoc Object [Pair] ConvId ConvId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"id" (Text
-> SchemaP NamedSwaggerDoc Value Value ConvId ConvId
-> SchemaP NamedSwaggerDoc Value Value ConvId ConvId
forall doc a.
(HasDeprecated doc (Maybe Bool),
 HasDescription doc (Maybe Text)) =>
Text -> ValueSchema doc a -> ValueSchema doc a
deprecatedSchema Text
"qualified_id" SchemaP NamedSwaggerDoc Value Value ConvId ConvId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  Conversation
  (ConversationMetadata -> ConvMembers -> Protocol -> Conversation)
-> SchemaP
     SwaggerDoc Object [Pair] Conversation ConversationMetadata
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Conversation
     (ConvMembers -> Protocol -> Conversation)
forall a b.
SchemaP SwaggerDoc Object [Pair] Conversation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Conversation a
-> SchemaP SwaggerDoc Object [Pair] Conversation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Conversation -> ConversationMetadata
cnvMetadata (Conversation -> ConversationMetadata)
-> ObjectSchema SwaggerDoc ConversationMetadata
-> SchemaP
     SwaggerDoc Object [Pair] Conversation ConversationMetadata
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ObjectSchema SwaggerDoc (Set AccessRole)
-> ObjectSchema SwaggerDoc ConversationMetadata
conversationMetadataObjectSchema (Maybe Version -> ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesVersionedSchema Maybe Version
v)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  Conversation
  (ConvMembers -> Protocol -> Conversation)
-> SchemaP SwaggerDoc Object [Pair] Conversation ConvMembers
-> SchemaP
     SwaggerDoc Object [Pair] Conversation (Protocol -> Conversation)
forall a b.
SchemaP SwaggerDoc Object [Pair] Conversation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Conversation a
-> SchemaP SwaggerDoc Object [Pair] Conversation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Conversation -> ConvMembers
cnvMembers (Conversation -> ConvMembers)
-> SchemaP SwaggerDoc Object [Pair] ConvMembers ConvMembers
-> SchemaP SwaggerDoc Object [Pair] Conversation ConvMembers
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ConvMembers ConvMembers
-> SchemaP SwaggerDoc Object [Pair] ConvMembers ConvMembers
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"members" SchemaP NamedSwaggerDoc Value Value ConvMembers ConvMembers
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc Object [Pair] Conversation (Protocol -> Conversation)
-> SchemaP SwaggerDoc Object [Pair] Conversation Protocol
-> ObjectSchema SwaggerDoc Conversation
forall a b.
SchemaP SwaggerDoc Object [Pair] Conversation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Conversation a
-> SchemaP SwaggerDoc Object [Pair] Conversation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Conversation -> Protocol
cnvProtocol (Conversation -> Protocol)
-> SchemaP SwaggerDoc Object [Pair] Protocol Protocol
-> SchemaP SwaggerDoc Object [Pair] Conversation Protocol
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version -> SchemaP SwaggerDoc Object [Pair] Protocol Protocol
protocolSchema Maybe Version
v

conversationSchema ::
  Maybe Version ->
  ValueSchema NamedSwaggerDoc Conversation
conversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc Conversation
conversationSchema Maybe Version
v =
  Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc Conversation
-> ValueSchema NamedSwaggerDoc Conversation
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
    (Text
"Conversation" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Version -> Text) -> Maybe Version -> Text
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text
Text.toUpper (Text -> Text) -> (Version -> Text) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
versionText) Maybe Version
v)
    ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A conversation object as returned from the server")
    (Maybe Version -> ObjectSchema SwaggerDoc Conversation
conversationObjectSchema Maybe Version
v)

data MLSOne2OneConversation a = MLSOne2OneConversation
  { forall a. MLSOne2OneConversation a -> Conversation
conversation :: Conversation,
    forall a. MLSOne2OneConversation a -> MLSKeysByPurpose (MLSKeys a)
publicKeys :: MLSKeysByPurpose (MLSKeys a)
  }
  deriving ([MLSOne2OneConversation a] -> Value
[MLSOne2OneConversation a] -> Encoding
MLSOne2OneConversation a -> Value
MLSOne2OneConversation a -> Encoding
(MLSOne2OneConversation a -> Value)
-> (MLSOne2OneConversation a -> Encoding)
-> ([MLSOne2OneConversation a] -> Value)
-> ([MLSOne2OneConversation a] -> Encoding)
-> ToJSON (MLSOne2OneConversation a)
forall a. ToSchema a => [MLSOne2OneConversation a] -> Value
forall a. ToSchema a => [MLSOne2OneConversation a] -> Encoding
forall a. ToSchema a => MLSOne2OneConversation a -> Value
forall a. ToSchema a => MLSOne2OneConversation a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall a. ToSchema a => MLSOne2OneConversation a -> Value
toJSON :: MLSOne2OneConversation a -> Value
$ctoEncoding :: forall a. ToSchema a => MLSOne2OneConversation a -> Encoding
toEncoding :: MLSOne2OneConversation a -> Encoding
$ctoJSONList :: forall a. ToSchema a => [MLSOne2OneConversation a] -> Value
toJSONList :: [MLSOne2OneConversation a] -> Value
$ctoEncodingList :: forall a. ToSchema a => [MLSOne2OneConversation a] -> Encoding
toEncodingList :: [MLSOne2OneConversation a] -> Encoding
ToJSON, Value -> Parser [MLSOne2OneConversation a]
Value -> Parser (MLSOne2OneConversation a)
(Value -> Parser (MLSOne2OneConversation a))
-> (Value -> Parser [MLSOne2OneConversation a])
-> FromJSON (MLSOne2OneConversation a)
forall a. ToSchema a => Value -> Parser [MLSOne2OneConversation a]
forall a. ToSchema a => Value -> Parser (MLSOne2OneConversation a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall a. ToSchema a => Value -> Parser (MLSOne2OneConversation a)
parseJSON :: Value -> Parser (MLSOne2OneConversation a)
$cparseJSONList :: forall a. ToSchema a => Value -> Parser [MLSOne2OneConversation a]
parseJSONList :: Value -> Parser [MLSOne2OneConversation a]
FromJSON, Typeable (MLSOne2OneConversation a)
Typeable (MLSOne2OneConversation a) =>
(Proxy (MLSOne2OneConversation a)
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (MLSOne2OneConversation a)
Proxy (MLSOne2OneConversation a)
-> Declare (Definitions Schema) NamedSchema
forall a.
(Typeable a, ToSchema a) =>
Typeable (MLSOne2OneConversation a)
forall a.
(Typeable a, ToSchema a) =>
Proxy (MLSOne2OneConversation a)
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: forall a.
(Typeable a, ToSchema a) =>
Proxy (MLSOne2OneConversation a)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (MLSOne2OneConversation a)
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema (MLSOne2OneConversation a))

instance (ToSchema a) => ToSchema (MLSOne2OneConversation a) where
  schema :: ValueSchema NamedSwaggerDoc (MLSOne2OneConversation a)
schema =
    let aName :: Text
aName = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
"_" <>) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ NamedSwaggerDoc -> Maybe Text
forall doc. HasName doc => doc -> Maybe Text
getName (SchemaP NamedSwaggerDoc Value Value a a -> NamedSwaggerDoc
forall ss v m a b. SchemaP ss v m a b -> ss
schemaDoc (forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema @a))
     in Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (MLSOne2OneConversation a)
     (MLSOne2OneConversation a)
-> ValueSchema NamedSwaggerDoc (MLSOne2OneConversation a)
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object (Text
"MLSOne2OneConversation" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aName) (SchemaP
   SwaggerDoc
   Object
   [Pair]
   (MLSOne2OneConversation a)
   (MLSOne2OneConversation a)
 -> ValueSchema NamedSwaggerDoc (MLSOne2OneConversation a))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (MLSOne2OneConversation a)
     (MLSOne2OneConversation a)
-> ValueSchema NamedSwaggerDoc (MLSOne2OneConversation a)
forall a b. (a -> b) -> a -> b
$
          Conversation
-> MLSKeysByPurpose (MLSKeys a) -> MLSOne2OneConversation a
forall a.
Conversation
-> MLSKeysByPurpose (MLSKeys a) -> MLSOne2OneConversation a
MLSOne2OneConversation
            (Conversation
 -> MLSKeysByPurpose (MLSKeys a) -> MLSOne2OneConversation a)
-> SchemaP
     SwaggerDoc Object [Pair] (MLSOne2OneConversation a) Conversation
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (MLSOne2OneConversation a)
     (MLSKeysByPurpose (MLSKeys a) -> MLSOne2OneConversation a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MLSOne2OneConversation a -> Conversation
forall a. MLSOne2OneConversation a -> Conversation
conversation (MLSOne2OneConversation a -> Conversation)
-> ObjectSchema SwaggerDoc Conversation
-> SchemaP
     SwaggerDoc Object [Pair] (MLSOne2OneConversation a) Conversation
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc Conversation
-> ObjectSchema SwaggerDoc Conversation
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"conversation" ValueSchema NamedSwaggerDoc Conversation
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
            SchemaP
  SwaggerDoc
  Object
  [Pair]
  (MLSOne2OneConversation a)
  (MLSKeysByPurpose (MLSKeys a) -> MLSOne2OneConversation a)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (MLSOne2OneConversation a)
     (MLSKeysByPurpose (MLSKeys a))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (MLSOne2OneConversation a)
     (MLSOne2OneConversation a)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] (MLSOne2OneConversation a) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (MLSOne2OneConversation a) a
-> SchemaP SwaggerDoc Object [Pair] (MLSOne2OneConversation a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MLSOne2OneConversation a -> MLSKeysByPurpose (MLSKeys a)
forall a. MLSOne2OneConversation a -> MLSKeysByPurpose (MLSKeys a)
publicKeys (MLSOne2OneConversation a -> MLSKeysByPurpose (MLSKeys a))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (MLSKeysByPurpose (MLSKeys a))
     (MLSKeysByPurpose (MLSKeys a))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (MLSOne2OneConversation a)
     (MLSKeysByPurpose (MLSKeys a))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (MLSKeysByPurpose (MLSKeys a))
     (MLSKeysByPurpose (MLSKeys a))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (MLSKeysByPurpose (MLSKeys a))
     (MLSKeysByPurpose (MLSKeys a))
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"public_keys" SchemaP
  NamedSwaggerDoc
  Value
  Value
  (MLSKeysByPurpose (MLSKeys a))
  (MLSKeysByPurpose (MLSKeys a))
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

-- | The public-facing conversation type extended with information on which
-- remote users could not be added when creating the conversation.
data CreateGroupConversation = CreateGroupConversation
  { CreateGroupConversation -> Conversation
cgcConversation :: Conversation,
    -- | Remote users that could not be added to the created group conversation
    -- because their backend was not reachable.
    CreateGroupConversation -> Map Domain (Set UserId)
cgcFailedToAdd :: Map Domain (Set UserId)
  }
  deriving stock (CreateGroupConversation -> CreateGroupConversation -> Bool
(CreateGroupConversation -> CreateGroupConversation -> Bool)
-> (CreateGroupConversation -> CreateGroupConversation -> Bool)
-> Eq CreateGroupConversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateGroupConversation -> CreateGroupConversation -> Bool
== :: CreateGroupConversation -> CreateGroupConversation -> Bool
$c/= :: CreateGroupConversation -> CreateGroupConversation -> Bool
/= :: CreateGroupConversation -> CreateGroupConversation -> Bool
Eq, Int -> CreateGroupConversation -> ShowS
[CreateGroupConversation] -> ShowS
CreateGroupConversation -> String
(Int -> CreateGroupConversation -> ShowS)
-> (CreateGroupConversation -> String)
-> ([CreateGroupConversation] -> ShowS)
-> Show CreateGroupConversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateGroupConversation -> ShowS
showsPrec :: Int -> CreateGroupConversation -> ShowS
$cshow :: CreateGroupConversation -> String
show :: CreateGroupConversation -> String
$cshowList :: [CreateGroupConversation] -> ShowS
showList :: [CreateGroupConversation] -> ShowS
Show, (forall x.
 CreateGroupConversation -> Rep CreateGroupConversation x)
-> (forall x.
    Rep CreateGroupConversation x -> CreateGroupConversation)
-> Generic CreateGroupConversation
forall x. Rep CreateGroupConversation x -> CreateGroupConversation
forall x. CreateGroupConversation -> Rep CreateGroupConversation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateGroupConversation -> Rep CreateGroupConversation x
from :: forall x. CreateGroupConversation -> Rep CreateGroupConversation x
$cto :: forall x. Rep CreateGroupConversation x -> CreateGroupConversation
to :: forall x. Rep CreateGroupConversation x -> CreateGroupConversation
Generic)
  deriving (Gen CreateGroupConversation
Gen CreateGroupConversation
-> (CreateGroupConversation -> [CreateGroupConversation])
-> Arbitrary CreateGroupConversation
CreateGroupConversation -> [CreateGroupConversation]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CreateGroupConversation
arbitrary :: Gen CreateGroupConversation
$cshrink :: CreateGroupConversation -> [CreateGroupConversation]
shrink :: CreateGroupConversation -> [CreateGroupConversation]
Arbitrary) via (GenericUniform CreateGroupConversation)
  deriving ([CreateGroupConversation] -> Value
[CreateGroupConversation] -> Encoding
CreateGroupConversation -> Value
CreateGroupConversation -> Encoding
(CreateGroupConversation -> Value)
-> (CreateGroupConversation -> Encoding)
-> ([CreateGroupConversation] -> Value)
-> ([CreateGroupConversation] -> Encoding)
-> ToJSON CreateGroupConversation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CreateGroupConversation -> Value
toJSON :: CreateGroupConversation -> Value
$ctoEncoding :: CreateGroupConversation -> Encoding
toEncoding :: CreateGroupConversation -> Encoding
$ctoJSONList :: [CreateGroupConversation] -> Value
toJSONList :: [CreateGroupConversation] -> Value
$ctoEncodingList :: [CreateGroupConversation] -> Encoding
toEncodingList :: [CreateGroupConversation] -> Encoding
ToJSON, Value -> Parser [CreateGroupConversation]
Value -> Parser CreateGroupConversation
(Value -> Parser CreateGroupConversation)
-> (Value -> Parser [CreateGroupConversation])
-> FromJSON CreateGroupConversation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CreateGroupConversation
parseJSON :: Value -> Parser CreateGroupConversation
$cparseJSONList :: Value -> Parser [CreateGroupConversation]
parseJSONList :: Value -> Parser [CreateGroupConversation]
FromJSON, Typeable CreateGroupConversation
Typeable CreateGroupConversation =>
(Proxy CreateGroupConversation
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema CreateGroupConversation
Proxy CreateGroupConversation
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy CreateGroupConversation
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy CreateGroupConversation
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema CreateGroupConversation

instance ToSchema CreateGroupConversation where
  schema :: ValueSchema NamedSwaggerDoc CreateGroupConversation
schema = Maybe Version
-> ValueSchema NamedSwaggerDoc CreateGroupConversation
createGroupConversationSchema Maybe Version
forall a. Maybe a
Nothing

instance (SingI v) => ToSchema (Versioned v CreateGroupConversation) where
  schema :: ValueSchema NamedSwaggerDoc (Versioned v CreateGroupConversation)
schema = CreateGroupConversation -> Versioned v CreateGroupConversation
forall (v :: Version) a. a -> Versioned v a
Versioned (CreateGroupConversation -> Versioned v CreateGroupConversation)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned v CreateGroupConversation)
     CreateGroupConversation
-> ValueSchema
     NamedSwaggerDoc (Versioned v CreateGroupConversation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned v CreateGroupConversation -> CreateGroupConversation
forall (v :: Version) a. Versioned v a -> a
unVersioned (Versioned v CreateGroupConversation -> CreateGroupConversation)
-> ValueSchema NamedSwaggerDoc CreateGroupConversation
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned v CreateGroupConversation)
     CreateGroupConversation
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version
-> ValueSchema NamedSwaggerDoc CreateGroupConversation
createGroupConversationSchema (Version -> Maybe Version
forall a. a -> Maybe a
Just (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Version).
(SingKind Version, SingI a) =>
Demote Version
demote @v))

createGroupConversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc CreateGroupConversation
createGroupConversationSchema :: Maybe Version
-> ValueSchema NamedSwaggerDoc CreateGroupConversation
createGroupConversationSchema Maybe Version
v =
  Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc CreateGroupConversation
-> ValueSchema NamedSwaggerDoc CreateGroupConversation
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
    Text
"CreateGroupConversation"
    ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A created group-conversation object extended with a list of failed-to-add users")
    (ObjectSchema SwaggerDoc CreateGroupConversation
 -> ValueSchema NamedSwaggerDoc CreateGroupConversation)
-> ObjectSchema SwaggerDoc CreateGroupConversation
-> ValueSchema NamedSwaggerDoc CreateGroupConversation
forall a b. (a -> b) -> a -> b
$ Conversation -> Map Domain (Set UserId) -> CreateGroupConversation
CreateGroupConversation
      (Conversation
 -> Map Domain (Set UserId) -> CreateGroupConversation)
-> SchemaP
     SwaggerDoc Object [Pair] CreateGroupConversation Conversation
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateGroupConversation
     (Map Domain (Set UserId) -> CreateGroupConversation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CreateGroupConversation -> Conversation
cgcConversation (CreateGroupConversation -> Conversation)
-> ObjectSchema SwaggerDoc Conversation
-> SchemaP
     SwaggerDoc Object [Pair] CreateGroupConversation Conversation
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version -> ObjectSchema SwaggerDoc Conversation
conversationObjectSchema Maybe Version
v
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateGroupConversation
  (Map Domain (Set UserId) -> CreateGroupConversation)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateGroupConversation
     (Map Domain (Set UserId))
-> ObjectSchema SwaggerDoc CreateGroupConversation
forall a b.
SchemaP SwaggerDoc Object [Pair] CreateGroupConversation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] CreateGroupConversation a
-> SchemaP SwaggerDoc Object [Pair] CreateGroupConversation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Map Domain (Set UserId) -> [Qualified UserId]
forall a. Map Domain (Set a) -> [Qualified a]
toFlatList (Map Domain (Set UserId) -> [Qualified UserId])
-> (CreateGroupConversation -> Map Domain (Set UserId))
-> CreateGroupConversation
-> [Qualified UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateGroupConversation -> Map Domain (Set UserId)
cgcFailedToAdd)
        (CreateGroupConversation -> [Qualified UserId])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     [Qualified UserId]
     (Map Domain (Set UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateGroupConversation
     (Map Domain (Set UserId))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc Value Value [Qualified UserId] (Map Domain (Set UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     [Qualified UserId]
     (Map Domain (Set UserId))
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"failed_to_add" ([Qualified UserId] -> Map Domain (Set UserId)
forall a. Ord a => [Qualified a] -> Map Domain (Set a)
fromFlatList ([Qualified UserId] -> Map Domain (Set UserId))
-> SchemaP
     SwaggerDoc Value Value [Qualified UserId] [Qualified UserId]
-> SchemaP
     SwaggerDoc Value Value [Qualified UserId] (Map Domain (Set UserId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSchema NamedSwaggerDoc (Qualified UserId)
-> SchemaP
     SwaggerDoc Value Value [Qualified UserId] [Qualified UserId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
  where
    toFlatList :: Map Domain (Set a) -> [Qualified a]
    toFlatList :: forall a. Map Domain (Set a) -> [Qualified a]
toFlatList Map Domain (Set a)
m =
      (\(Domain
d, Set a
s) -> (a -> Domain -> Qualified a) -> Domain -> a -> Qualified a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Domain -> Qualified a
forall a. a -> Domain -> Qualified a
Qualified Domain
d (a -> Qualified a) -> [a] -> [Qualified a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
s) ((Domain, Set a) -> [Qualified a])
-> [(Domain, Set a)] -> [Qualified a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Map Domain (Set a) -> [(Domain, Set a)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map Domain (Set a)
m
    fromFlatList :: (Ord a) => [Qualified a] -> Map Domain (Set a)
    fromFlatList :: forall a. Ord a => [Qualified a] -> Map Domain (Set a)
fromFlatList = ([a] -> Set a) -> Map Domain [a] -> Map Domain (Set a)
forall a b. (a -> b) -> Map Domain a -> Map Domain b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList (Map Domain [a] -> Map Domain (Set a))
-> ([Qualified a] -> Map Domain [a])
-> [Qualified a]
-> Map Domain (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Qualified a] -> Map Domain [a]
forall (f :: * -> *) a.
Foldable f =>
f (Qualified a) -> Map Domain [a]
indexQualified

-- | Limited view of a 'Conversation'. Is used to inform users with an invite
-- link about the conversation.
data ConversationCoverView = ConversationCoverView
  { ConversationCoverView -> ConvId
cnvCoverConvId :: ConvId,
    ConversationCoverView -> Maybe Text
cnvCoverName :: Maybe Text,
    ConversationCoverView -> Bool
cnvCoverHasPassword :: Bool
  }
  deriving stock (ConversationCoverView -> ConversationCoverView -> Bool
(ConversationCoverView -> ConversationCoverView -> Bool)
-> (ConversationCoverView -> ConversationCoverView -> Bool)
-> Eq ConversationCoverView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationCoverView -> ConversationCoverView -> Bool
== :: ConversationCoverView -> ConversationCoverView -> Bool
$c/= :: ConversationCoverView -> ConversationCoverView -> Bool
/= :: ConversationCoverView -> ConversationCoverView -> Bool
Eq, Int -> ConversationCoverView -> ShowS
[ConversationCoverView] -> ShowS
ConversationCoverView -> String
(Int -> ConversationCoverView -> ShowS)
-> (ConversationCoverView -> String)
-> ([ConversationCoverView] -> ShowS)
-> Show ConversationCoverView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationCoverView -> ShowS
showsPrec :: Int -> ConversationCoverView -> ShowS
$cshow :: ConversationCoverView -> String
show :: ConversationCoverView -> String
$cshowList :: [ConversationCoverView] -> ShowS
showList :: [ConversationCoverView] -> ShowS
Show, (forall x. ConversationCoverView -> Rep ConversationCoverView x)
-> (forall x. Rep ConversationCoverView x -> ConversationCoverView)
-> Generic ConversationCoverView
forall x. Rep ConversationCoverView x -> ConversationCoverView
forall x. ConversationCoverView -> Rep ConversationCoverView x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConversationCoverView -> Rep ConversationCoverView x
from :: forall x. ConversationCoverView -> Rep ConversationCoverView x
$cto :: forall x. Rep ConversationCoverView x -> ConversationCoverView
to :: forall x. Rep ConversationCoverView x -> ConversationCoverView
Generic)
  deriving (Gen ConversationCoverView
Gen ConversationCoverView
-> (ConversationCoverView -> [ConversationCoverView])
-> Arbitrary ConversationCoverView
ConversationCoverView -> [ConversationCoverView]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationCoverView
arbitrary :: Gen ConversationCoverView
$cshrink :: ConversationCoverView -> [ConversationCoverView]
shrink :: ConversationCoverView -> [ConversationCoverView]
Arbitrary) via (GenericUniform ConversationCoverView)
  deriving (Value -> Parser [ConversationCoverView]
Value -> Parser ConversationCoverView
(Value -> Parser ConversationCoverView)
-> (Value -> Parser [ConversationCoverView])
-> FromJSON ConversationCoverView
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationCoverView
parseJSON :: Value -> Parser ConversationCoverView
$cparseJSONList :: Value -> Parser [ConversationCoverView]
parseJSONList :: Value -> Parser [ConversationCoverView]
FromJSON, [ConversationCoverView] -> Value
[ConversationCoverView] -> Encoding
ConversationCoverView -> Value
ConversationCoverView -> Encoding
(ConversationCoverView -> Value)
-> (ConversationCoverView -> Encoding)
-> ([ConversationCoverView] -> Value)
-> ([ConversationCoverView] -> Encoding)
-> ToJSON ConversationCoverView
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationCoverView -> Value
toJSON :: ConversationCoverView -> Value
$ctoEncoding :: ConversationCoverView -> Encoding
toEncoding :: ConversationCoverView -> Encoding
$ctoJSONList :: [ConversationCoverView] -> Value
toJSONList :: [ConversationCoverView] -> Value
$ctoEncodingList :: [ConversationCoverView] -> Encoding
toEncodingList :: [ConversationCoverView] -> Encoding
ToJSON, Typeable ConversationCoverView
Typeable ConversationCoverView =>
(Proxy ConversationCoverView
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationCoverView
Proxy ConversationCoverView
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationCoverView
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationCoverView
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ConversationCoverView

-- | Schema is compatible to a subset of 'Conversation' schema, in case we
-- decide to substitute 'ConversationCoverView' with it in the future.
instance ToSchema ConversationCoverView where
  schema :: ValueSchema NamedSwaggerDoc ConversationCoverView
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ConversationCoverView
-> ValueSchema NamedSwaggerDoc ConversationCoverView
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"ConversationCoverView"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Limited view of Conversation.")
      (ObjectSchema SwaggerDoc ConversationCoverView
 -> ValueSchema NamedSwaggerDoc ConversationCoverView)
-> ObjectSchema SwaggerDoc ConversationCoverView
-> ValueSchema NamedSwaggerDoc ConversationCoverView
forall a b. (a -> b) -> a -> b
$ ConvId -> Maybe Text -> Bool -> ConversationCoverView
ConversationCoverView
        (ConvId -> Maybe Text -> Bool -> ConversationCoverView)
-> SchemaP SwaggerDoc Object [Pair] ConversationCoverView ConvId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationCoverView
     (Maybe Text -> Bool -> ConversationCoverView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationCoverView -> ConvId
cnvCoverConvId (ConversationCoverView -> ConvId)
-> SchemaP SwaggerDoc Object [Pair] ConvId ConvId
-> SchemaP SwaggerDoc Object [Pair] ConversationCoverView ConvId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ConvId ConvId
-> SchemaP SwaggerDoc Object [Pair] ConvId ConvId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"id" SchemaP NamedSwaggerDoc Value Value ConvId ConvId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationCoverView
  (Maybe Text -> Bool -> ConversationCoverView)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationCoverView (Maybe Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationCoverView
     (Bool -> ConversationCoverView)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationCoverView (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationCoverView a
-> SchemaP SwaggerDoc Object [Pair] ConversationCoverView b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationCoverView -> Maybe Text
cnvCoverName (ConversationCoverView -> Maybe Text)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Text) (Maybe Text)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationCoverView (Maybe Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value (Maybe Text) Text
-> SchemaP SwaggerDoc Object [Pair] (Maybe Text) (Maybe Text)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"name" (Value
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP NamedSwaggerDoc Value Value (Maybe Text) Text
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationCoverView
  (Bool -> ConversationCoverView)
-> SchemaP SwaggerDoc Object [Pair] ConversationCoverView Bool
-> ObjectSchema SwaggerDoc ConversationCoverView
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationCoverView (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationCoverView a
-> SchemaP SwaggerDoc Object [Pair] ConversationCoverView b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationCoverView -> Bool
cnvCoverHasPassword (ConversationCoverView -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] ConversationCoverView Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"has_password" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data ConversationList a = ConversationList
  { forall a. ConversationList a -> [a]
convList :: [a],
    forall a. ConversationList a -> Bool
convHasMore :: Bool
  }
  deriving stock (ConversationList a -> ConversationList a -> Bool
(ConversationList a -> ConversationList a -> Bool)
-> (ConversationList a -> ConversationList a -> Bool)
-> Eq (ConversationList a)
forall a. Eq a => ConversationList a -> ConversationList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ConversationList a -> ConversationList a -> Bool
== :: ConversationList a -> ConversationList a -> Bool
$c/= :: forall a. Eq a => ConversationList a -> ConversationList a -> Bool
/= :: ConversationList a -> ConversationList a -> Bool
Eq, Int -> ConversationList a -> ShowS
[ConversationList a] -> ShowS
ConversationList a -> String
(Int -> ConversationList a -> ShowS)
-> (ConversationList a -> String)
-> ([ConversationList a] -> ShowS)
-> Show (ConversationList a)
forall a. Show a => Int -> ConversationList a -> ShowS
forall a. Show a => [ConversationList a] -> ShowS
forall a. Show a => ConversationList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ConversationList a -> ShowS
showsPrec :: Int -> ConversationList a -> ShowS
$cshow :: forall a. Show a => ConversationList a -> String
show :: ConversationList a -> String
$cshowList :: forall a. Show a => [ConversationList a] -> ShowS
showList :: [ConversationList a] -> ShowS
Show, (forall x. ConversationList a -> Rep (ConversationList a) x)
-> (forall x. Rep (ConversationList a) x -> ConversationList a)
-> Generic (ConversationList a)
forall x. Rep (ConversationList a) x -> ConversationList a
forall x. ConversationList a -> Rep (ConversationList a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ConversationList a) x -> ConversationList a
forall a x. ConversationList a -> Rep (ConversationList a) x
$cfrom :: forall a x. ConversationList a -> Rep (ConversationList a) x
from :: forall x. ConversationList a -> Rep (ConversationList a) x
$cto :: forall a x. Rep (ConversationList a) x -> ConversationList a
to :: forall x. Rep (ConversationList a) x -> ConversationList a
Generic)
  deriving (Gen (ConversationList a)
Gen (ConversationList a)
-> (ConversationList a -> [ConversationList a])
-> Arbitrary (ConversationList a)
ConversationList a -> [ConversationList a]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
forall a. Arbitrary a => Gen (ConversationList a)
forall a. Arbitrary a => ConversationList a -> [ConversationList a]
$carbitrary :: forall a. Arbitrary a => Gen (ConversationList a)
arbitrary :: Gen (ConversationList a)
$cshrink :: forall a. Arbitrary a => ConversationList a -> [ConversationList a]
shrink :: ConversationList a -> [ConversationList a]
Arbitrary) via (GenericUniform (ConversationList a))
  deriving (Value -> Parser [ConversationList a]
Value -> Parser (ConversationList a)
(Value -> Parser (ConversationList a))
-> (Value -> Parser [ConversationList a])
-> FromJSON (ConversationList a)
forall a.
(ConversationListItem a, ToSchema a) =>
Value -> Parser [ConversationList a]
forall a.
(ConversationListItem a, ToSchema a) =>
Value -> Parser (ConversationList a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall a.
(ConversationListItem a, ToSchema a) =>
Value -> Parser (ConversationList a)
parseJSON :: Value -> Parser (ConversationList a)
$cparseJSONList :: forall a.
(ConversationListItem a, ToSchema a) =>
Value -> Parser [ConversationList a]
parseJSONList :: Value -> Parser [ConversationList a]
FromJSON, [ConversationList a] -> Value
[ConversationList a] -> Encoding
ConversationList a -> Value
ConversationList a -> Encoding
(ConversationList a -> Value)
-> (ConversationList a -> Encoding)
-> ([ConversationList a] -> Value)
-> ([ConversationList a] -> Encoding)
-> ToJSON (ConversationList a)
forall a.
(ConversationListItem a, ToSchema a) =>
[ConversationList a] -> Value
forall a.
(ConversationListItem a, ToSchema a) =>
[ConversationList a] -> Encoding
forall a.
(ConversationListItem a, ToSchema a) =>
ConversationList a -> Value
forall a.
(ConversationListItem a, ToSchema a) =>
ConversationList a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall a.
(ConversationListItem a, ToSchema a) =>
ConversationList a -> Value
toJSON :: ConversationList a -> Value
$ctoEncoding :: forall a.
(ConversationListItem a, ToSchema a) =>
ConversationList a -> Encoding
toEncoding :: ConversationList a -> Encoding
$ctoJSONList :: forall a.
(ConversationListItem a, ToSchema a) =>
[ConversationList a] -> Value
toJSONList :: [ConversationList a] -> Value
$ctoEncodingList :: forall a.
(ConversationListItem a, ToSchema a) =>
[ConversationList a] -> Encoding
toEncodingList :: [ConversationList a] -> Encoding
ToJSON, Typeable (ConversationList a)
Typeable (ConversationList a) =>
(Proxy (ConversationList a)
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (ConversationList a)
Proxy (ConversationList a)
-> Declare (Definitions Schema) NamedSchema
forall a.
(Typeable a, ConversationListItem a, ToSchema a) =>
Typeable (ConversationList a)
forall a.
(Typeable a, ConversationListItem a, ToSchema a) =>
Proxy (ConversationList a)
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: forall a.
(Typeable a, ConversationListItem a, ToSchema a) =>
Proxy (ConversationList a)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (ConversationList a)
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema (ConversationList a)

class ConversationListItem a where
  convListItemName :: Proxy a -> Text

instance ConversationListItem ConvId where
  convListItemName :: Proxy ConvId -> Text
convListItemName Proxy ConvId
_ = Text
"conversation IDs"

instance ConversationListItem Conversation where
  convListItemName :: Proxy Conversation -> Text
convListItemName Proxy Conversation
_ = Text
"conversations"

instance (ConversationListItem a, ToSchema a) => ToSchema (ConversationList a) where
  schema :: ValueSchema NamedSwaggerDoc (ConversationList a)
schema = ValueSchema NamedSwaggerDoc a
-> ValueSchema NamedSwaggerDoc (ConversationList a)
forall a.
ConversationListItem a =>
ValueSchema NamedSwaggerDoc a
-> ValueSchema NamedSwaggerDoc (ConversationList a)
conversationListSchema ValueSchema NamedSwaggerDoc a
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

instance ToSchema (Versioned 'V2 (ConversationList Conversation)) where
  schema :: ValueSchema
  NamedSwaggerDoc (Versioned 'V2 (ConversationList Conversation))
schema =
    ConversationList Conversation
-> Versioned 'V2 (ConversationList Conversation)
forall (v :: Version) a. a -> Versioned v a
Versioned
      (ConversationList Conversation
 -> Versioned 'V2 (ConversationList Conversation))
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned 'V2 (ConversationList Conversation))
     (ConversationList Conversation)
-> ValueSchema
     NamedSwaggerDoc (Versioned 'V2 (ConversationList Conversation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned 'V2 (ConversationList Conversation)
-> ConversationList Conversation
forall (v :: Version) a. Versioned v a -> a
unVersioned
        (Versioned 'V2 (ConversationList Conversation)
 -> ConversationList Conversation)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (ConversationList Conversation)
     (ConversationList Conversation)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned 'V2 (ConversationList Conversation))
     (ConversationList Conversation)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ValueSchema NamedSwaggerDoc Conversation
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (ConversationList Conversation)
     (ConversationList Conversation)
forall a.
ConversationListItem a =>
ValueSchema NamedSwaggerDoc a
-> ValueSchema NamedSwaggerDoc (ConversationList a)
conversationListSchema (Maybe Version -> ValueSchema NamedSwaggerDoc Conversation
conversationSchema (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
V2))

conversationListSchema ::
  forall a.
  (ConversationListItem a) =>
  ValueSchema NamedSwaggerDoc a ->
  ValueSchema NamedSwaggerDoc (ConversationList a)
conversationListSchema :: forall a.
ConversationListItem a =>
ValueSchema NamedSwaggerDoc a
-> ValueSchema NamedSwaggerDoc (ConversationList a)
conversationListSchema ValueSchema NamedSwaggerDoc a
sch =
  Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc (ConversationList a)
-> ValueSchema NamedSwaggerDoc (ConversationList a)
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
    Text
"ConversationList"
    ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Object holding a list of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Proxy a -> Text
forall {k} (a :: k). ConversationListItem a => Proxy a -> Text
convListItemName (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))
    (ObjectSchema SwaggerDoc (ConversationList a)
 -> ValueSchema NamedSwaggerDoc (ConversationList a))
-> ObjectSchema SwaggerDoc (ConversationList a)
-> ValueSchema NamedSwaggerDoc (ConversationList a)
forall a b. (a -> b) -> a -> b
$ [a] -> Bool -> ConversationList a
forall a. [a] -> Bool -> ConversationList a
ConversationList
      ([a] -> Bool -> ConversationList a)
-> SchemaP SwaggerDoc Object [Pair] (ConversationList a) [a]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (ConversationList a)
     (Bool -> ConversationList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationList a -> [a]
forall a. ConversationList a -> [a]
convList (ConversationList a -> [a])
-> SchemaP SwaggerDoc Object [Pair] [a] [a]
-> SchemaP SwaggerDoc Object [Pair] (ConversationList a) [a]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [a] [a]
-> SchemaP SwaggerDoc Object [Pair] [a] [a]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"conversations" (ValueSchema NamedSwaggerDoc a
-> SchemaP SwaggerDoc Value Value [a] [a]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc a
sch)
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  (ConversationList a)
  (Bool -> ConversationList a)
-> SchemaP SwaggerDoc Object [Pair] (ConversationList a) Bool
-> ObjectSchema SwaggerDoc (ConversationList a)
forall a b.
SchemaP SwaggerDoc Object [Pair] (ConversationList a) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (ConversationList a) a
-> SchemaP SwaggerDoc Object [Pair] (ConversationList a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationList a -> Bool
forall a. ConversationList a -> Bool
convHasMore
        (ConversationList a -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] (ConversationList a) Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
          Text
"has_more"
          ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Indicator that the server has more conversations than returned")
          SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

type ConversationPagingName = "ConversationIds"

type ConvIdPagingKey = "qualified_conversations"

type ConversationPagingState = MultiTablePagingState ConversationPagingName LocalOrRemoteTable

pattern ConversationPagingState :: tables -> Maybe ByteString -> MultiTablePagingState name tables
pattern $mConversationPagingState :: forall {r} {tables} {name :: Symbol}.
MultiTablePagingState name tables
-> (tables -> Maybe ByteString -> r) -> ((# #) -> r) -> r
$bConversationPagingState :: forall tables (name :: Symbol).
tables -> Maybe ByteString -> MultiTablePagingState name tables
ConversationPagingState table state = MultiTablePagingState table state

type ConvIdsPage = MultiTablePage ConversationPagingName ConvIdPagingKey LocalOrRemoteTable (Qualified ConvId)

pattern ConvIdsPage :: [a] -> Bool -> MultiTablePagingState name tables -> MultiTablePage name resultsKey tables a
pattern $mConvIdsPage :: forall {r} {a} {name :: Symbol} {tables} {resultsKey :: Symbol}.
MultiTablePage name resultsKey tables a
-> ([a] -> Bool -> MultiTablePagingState name tables -> r)
-> ((# #) -> r)
-> r
$bConvIdsPage :: forall a (name :: Symbol) tables (resultsKey :: Symbol).
[a]
-> Bool
-> MultiTablePagingState name tables
-> MultiTablePage name resultsKey tables a
ConvIdsPage ids hasMore state = MultiTablePage ids hasMore state

type GetPaginatedConversationIds = GetMultiTablePageRequest ConversationPagingName LocalOrRemoteTable 1000 1000

pattern GetPaginatedConversationIds :: Maybe (MultiTablePagingState name tables) -> Range 1 max Int32 -> GetMultiTablePageRequest name tables max def
pattern $mGetPaginatedConversationIds :: forall {r} {name :: Symbol} {tables} {max :: Nat} {def :: Nat}.
GetMultiTablePageRequest name tables max def
-> (Maybe (MultiTablePagingState name tables)
    -> Range 1 max Int32 -> r)
-> ((# #) -> r)
-> r
$bGetPaginatedConversationIds :: forall (name :: Symbol) tables (max :: Nat) (def :: Nat).
Maybe (MultiTablePagingState name tables)
-> Range 1 max Int32
-> GetMultiTablePageRequest name tables max def
GetPaginatedConversationIds state size = GetMultiTablePageRequest size state

-- | Used on the POST /conversations/list/v2 endpoint
newtype ListConversations = ListConversations
  { ListConversations -> Range 1 1000 [Qualified ConvId]
lcQualifiedIds :: Range 1 1000 [Qualified ConvId]
  }
  deriving stock (ListConversations -> ListConversations -> Bool
(ListConversations -> ListConversations -> Bool)
-> (ListConversations -> ListConversations -> Bool)
-> Eq ListConversations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListConversations -> ListConversations -> Bool
== :: ListConversations -> ListConversations -> Bool
$c/= :: ListConversations -> ListConversations -> Bool
/= :: ListConversations -> ListConversations -> Bool
Eq, Int -> ListConversations -> ShowS
[ListConversations] -> ShowS
ListConversations -> String
(Int -> ListConversations -> ShowS)
-> (ListConversations -> String)
-> ([ListConversations] -> ShowS)
-> Show ListConversations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListConversations -> ShowS
showsPrec :: Int -> ListConversations -> ShowS
$cshow :: ListConversations -> String
show :: ListConversations -> String
$cshowList :: [ListConversations] -> ShowS
showList :: [ListConversations] -> ShowS
Show, (forall x. ListConversations -> Rep ListConversations x)
-> (forall x. Rep ListConversations x -> ListConversations)
-> Generic ListConversations
forall x. Rep ListConversations x -> ListConversations
forall x. ListConversations -> Rep ListConversations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListConversations -> Rep ListConversations x
from :: forall x. ListConversations -> Rep ListConversations x
$cto :: forall x. Rep ListConversations x -> ListConversations
to :: forall x. Rep ListConversations x -> ListConversations
Generic)
  deriving (Value -> Parser [ListConversations]
Value -> Parser ListConversations
(Value -> Parser ListConversations)
-> (Value -> Parser [ListConversations])
-> FromJSON ListConversations
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ListConversations
parseJSON :: Value -> Parser ListConversations
$cparseJSONList :: Value -> Parser [ListConversations]
parseJSONList :: Value -> Parser [ListConversations]
FromJSON, [ListConversations] -> Value
[ListConversations] -> Encoding
ListConversations -> Value
ListConversations -> Encoding
(ListConversations -> Value)
-> (ListConversations -> Encoding)
-> ([ListConversations] -> Value)
-> ([ListConversations] -> Encoding)
-> ToJSON ListConversations
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ListConversations -> Value
toJSON :: ListConversations -> Value
$ctoEncoding :: ListConversations -> Encoding
toEncoding :: ListConversations -> Encoding
$ctoJSONList :: [ListConversations] -> Value
toJSONList :: [ListConversations] -> Value
$ctoEncodingList :: [ListConversations] -> Encoding
toEncodingList :: [ListConversations] -> Encoding
ToJSON, Typeable ListConversations
Typeable ListConversations =>
(Proxy ListConversations
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ListConversations
Proxy ListConversations -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ListConversations -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ListConversations -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ListConversations

instance ToSchema ListConversations where
  schema :: ValueSchema NamedSwaggerDoc ListConversations
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ListConversations
-> ValueSchema NamedSwaggerDoc ListConversations
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"ListConversations"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A request to list some of a user's conversations, including remote ones. Maximum 1000 qualified conversation IDs")
      (ObjectSchema SwaggerDoc ListConversations
 -> ValueSchema NamedSwaggerDoc ListConversations)
-> ObjectSchema SwaggerDoc ListConversations
-> ValueSchema NamedSwaggerDoc ListConversations
forall a b. (a -> b) -> a -> b
$ Range 1 1000 [Qualified ConvId] -> ListConversations
ListConversations
        (Range 1 1000 [Qualified ConvId] -> ListConversations)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ListConversations
     (Range 1 1000 [Qualified ConvId])
-> ObjectSchema SwaggerDoc ListConversations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Range 1 1000 [Qualified ConvId] -> [Qualified ConvId]
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range 1 1000 [Qualified ConvId] -> [Qualified ConvId])
-> (ListConversations -> Range 1 1000 [Qualified ConvId])
-> ListConversations
-> [Qualified ConvId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListConversations -> Range 1 1000 [Qualified ConvId]
lcQualifiedIds) (ListConversations -> [Qualified ConvId])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     [Qualified ConvId]
     (Range 1 1000 [Qualified ConvId])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ListConversations
     (Range 1 1000 [Qualified ConvId])
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     [Qualified ConvId]
     (Range 1 1000 [Qualified ConvId])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     [Qualified ConvId]
     (Range 1 1000 [Qualified ConvId])
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"qualified_ids" (SchemaP
  SwaggerDoc Value Value [Qualified ConvId] [Qualified ConvId]
-> SchemaP
     SwaggerDoc
     Value
     Value
     [Qualified ConvId]
     (Range 1 1000 [Qualified ConvId])
forall (n :: Nat) (m :: Nat) d v w a b.
(KnownNat n, KnownNat m, Within a n m,
 HasRangedSchemaDocModifier d b) =>
SchemaP d v w a b -> SchemaP d v w a (Range n m b)
rangedSchema (SchemaP
  NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
-> SchemaP
     SwaggerDoc Value Value [Qualified ConvId] [Qualified ConvId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array SchemaP
  NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))

data ConversationsResponse = ConversationsResponse
  { ConversationsResponse -> [Conversation]
crFound :: [Conversation],
    ConversationsResponse -> [Qualified ConvId]
crNotFound :: [Qualified ConvId],
    ConversationsResponse -> [Qualified ConvId]
crFailed :: [Qualified ConvId]
  }
  deriving stock (ConversationsResponse -> ConversationsResponse -> Bool
(ConversationsResponse -> ConversationsResponse -> Bool)
-> (ConversationsResponse -> ConversationsResponse -> Bool)
-> Eq ConversationsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationsResponse -> ConversationsResponse -> Bool
== :: ConversationsResponse -> ConversationsResponse -> Bool
$c/= :: ConversationsResponse -> ConversationsResponse -> Bool
/= :: ConversationsResponse -> ConversationsResponse -> Bool
Eq, Int -> ConversationsResponse -> ShowS
[ConversationsResponse] -> ShowS
ConversationsResponse -> String
(Int -> ConversationsResponse -> ShowS)
-> (ConversationsResponse -> String)
-> ([ConversationsResponse] -> ShowS)
-> Show ConversationsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationsResponse -> ShowS
showsPrec :: Int -> ConversationsResponse -> ShowS
$cshow :: ConversationsResponse -> String
show :: ConversationsResponse -> String
$cshowList :: [ConversationsResponse] -> ShowS
showList :: [ConversationsResponse] -> ShowS
Show)
  deriving (Value -> Parser [ConversationsResponse]
Value -> Parser ConversationsResponse
(Value -> Parser ConversationsResponse)
-> (Value -> Parser [ConversationsResponse])
-> FromJSON ConversationsResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationsResponse
parseJSON :: Value -> Parser ConversationsResponse
$cparseJSONList :: Value -> Parser [ConversationsResponse]
parseJSONList :: Value -> Parser [ConversationsResponse]
FromJSON, [ConversationsResponse] -> Value
[ConversationsResponse] -> Encoding
ConversationsResponse -> Value
ConversationsResponse -> Encoding
(ConversationsResponse -> Value)
-> (ConversationsResponse -> Encoding)
-> ([ConversationsResponse] -> Value)
-> ([ConversationsResponse] -> Encoding)
-> ToJSON ConversationsResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationsResponse -> Value
toJSON :: ConversationsResponse -> Value
$ctoEncoding :: ConversationsResponse -> Encoding
toEncoding :: ConversationsResponse -> Encoding
$ctoJSONList :: [ConversationsResponse] -> Value
toJSONList :: [ConversationsResponse] -> Value
$ctoEncodingList :: [ConversationsResponse] -> Encoding
toEncodingList :: [ConversationsResponse] -> Encoding
ToJSON, Typeable ConversationsResponse
Typeable ConversationsResponse =>
(Proxy ConversationsResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationsResponse
Proxy ConversationsResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationsResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationsResponse
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ConversationsResponse

conversationsResponseSchema ::
  Maybe Version ->
  ValueSchema NamedSwaggerDoc ConversationsResponse
conversationsResponseSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc ConversationsResponse
conversationsResponseSchema Maybe Version
v =
  let notFoundDoc :: SwaggerDoc -> SwaggerDoc
notFoundDoc = (Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"These conversations either don't exist or are deleted."
      failedDoc :: SwaggerDoc -> SwaggerDoc
failedDoc = (Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The server failed to fetch these conversations, most likely due to network issues while contacting a remote server"
   in Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ConversationsResponse
-> ValueSchema NamedSwaggerDoc ConversationsResponse
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
        (Text
"ConversationsResponse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Version -> Text) -> Maybe Version -> Text
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text
Text.toUpper (Text -> Text) -> (Version -> Text) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
versionText) Maybe Version
v)
        ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Response object for getting metadata of a list of conversations")
        (ObjectSchema SwaggerDoc ConversationsResponse
 -> ValueSchema NamedSwaggerDoc ConversationsResponse)
-> ObjectSchema SwaggerDoc ConversationsResponse
-> ValueSchema NamedSwaggerDoc ConversationsResponse
forall a b. (a -> b) -> a -> b
$ [Conversation]
-> [Qualified ConvId]
-> [Qualified ConvId]
-> ConversationsResponse
ConversationsResponse
          ([Conversation]
 -> [Qualified ConvId]
 -> [Qualified ConvId]
 -> ConversationsResponse)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationsResponse [Conversation]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationsResponse
     ([Qualified ConvId] -> [Qualified ConvId] -> ConversationsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationsResponse -> [Conversation]
crFound (ConversationsResponse -> [Conversation])
-> SchemaP SwaggerDoc Object [Pair] [Conversation] [Conversation]
-> SchemaP
     SwaggerDoc Object [Pair] ConversationsResponse [Conversation]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Conversation] [Conversation]
-> SchemaP SwaggerDoc Object [Pair] [Conversation] [Conversation]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"found" (ValueSchema NamedSwaggerDoc Conversation
-> SchemaP SwaggerDoc Value Value [Conversation] [Conversation]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array (Maybe Version -> ValueSchema NamedSwaggerDoc Conversation
conversationSchema Maybe Version
v))
          SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationsResponse
  ([Qualified ConvId] -> [Qualified ConvId] -> ConversationsResponse)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationsResponse [Qualified ConvId]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationsResponse
     ([Qualified ConvId] -> ConversationsResponse)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationsResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationsResponse a
-> SchemaP SwaggerDoc Object [Pair] ConversationsResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationsResponse -> [Qualified ConvId]
crNotFound (ConversationsResponse -> [Qualified ConvId])
-> SchemaP
     SwaggerDoc Object [Pair] [Qualified ConvId] [Qualified ConvId]
-> SchemaP
     SwaggerDoc Object [Pair] ConversationsResponse [Qualified ConvId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP
     SwaggerDoc Value Value [Qualified ConvId] [Qualified ConvId]
-> SchemaP
     SwaggerDoc Object [Pair] [Qualified ConvId] [Qualified ConvId]
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"not_found" SwaggerDoc -> SwaggerDoc
notFoundDoc (SchemaP
  NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
-> SchemaP
     SwaggerDoc Value Value [Qualified ConvId] [Qualified ConvId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array SchemaP
  NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
          SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationsResponse
  ([Qualified ConvId] -> ConversationsResponse)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationsResponse [Qualified ConvId]
-> ObjectSchema SwaggerDoc ConversationsResponse
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationsResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationsResponse a
-> SchemaP SwaggerDoc Object [Pair] ConversationsResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationsResponse -> [Qualified ConvId]
crFailed (ConversationsResponse -> [Qualified ConvId])
-> SchemaP
     SwaggerDoc Object [Pair] [Qualified ConvId] [Qualified ConvId]
-> SchemaP
     SwaggerDoc Object [Pair] ConversationsResponse [Qualified ConvId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP
     SwaggerDoc Value Value [Qualified ConvId] [Qualified ConvId]
-> SchemaP
     SwaggerDoc Object [Pair] [Qualified ConvId] [Qualified ConvId]
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"failed" SwaggerDoc -> SwaggerDoc
failedDoc (SchemaP
  NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
-> SchemaP
     SwaggerDoc Value Value [Qualified ConvId] [Qualified ConvId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array SchemaP
  NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

instance ToSchema ConversationsResponse where
  schema :: ValueSchema NamedSwaggerDoc ConversationsResponse
schema = Maybe Version -> ValueSchema NamedSwaggerDoc ConversationsResponse
conversationsResponseSchema Maybe Version
forall a. Maybe a
Nothing

instance (SingI v) => ToSchema (Versioned v ConversationsResponse) where
  schema :: ValueSchema NamedSwaggerDoc (Versioned v ConversationsResponse)
schema = ConversationsResponse -> Versioned v ConversationsResponse
forall (v :: Version) a. a -> Versioned v a
Versioned (ConversationsResponse -> Versioned v ConversationsResponse)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned v ConversationsResponse)
     ConversationsResponse
-> ValueSchema NamedSwaggerDoc (Versioned v ConversationsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned v ConversationsResponse -> ConversationsResponse
forall (v :: Version) a. Versioned v a -> a
unVersioned (Versioned v ConversationsResponse -> ConversationsResponse)
-> ValueSchema NamedSwaggerDoc ConversationsResponse
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned v ConversationsResponse)
     ConversationsResponse
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version -> ValueSchema NamedSwaggerDoc ConversationsResponse
conversationsResponseSchema (Version -> Maybe Version
forall a. a -> Maybe a
Just (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Version).
(SingKind Version, SingI a) =>
Demote Version
demote @v))

--------------------------------------------------------------------------------
-- Conversation properties

-- | Access define how users can join conversations
data Access
  = -- | Made obsolete by PrivateAccessRole
    PrivateAccess
  | -- | User A can add User B
    InviteAccess
  | -- | User can join knowing conversation id
    LinkAccess
  | -- | User can join knowing [changeable/revokable] code
    CodeAccess
  deriving stock (Access -> Access -> Bool
(Access -> Access -> Bool)
-> (Access -> Access -> Bool) -> Eq Access
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Access -> Access -> Bool
== :: Access -> Access -> Bool
$c/= :: Access -> Access -> Bool
/= :: Access -> Access -> Bool
Eq, Eq Access
Eq Access =>
(Access -> Access -> Ordering)
-> (Access -> Access -> Bool)
-> (Access -> Access -> Bool)
-> (Access -> Access -> Bool)
-> (Access -> Access -> Bool)
-> (Access -> Access -> Access)
-> (Access -> Access -> Access)
-> Ord Access
Access -> Access -> Bool
Access -> Access -> Ordering
Access -> Access -> Access
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Access -> Access -> Ordering
compare :: Access -> Access -> Ordering
$c< :: Access -> Access -> Bool
< :: Access -> Access -> Bool
$c<= :: Access -> Access -> Bool
<= :: Access -> Access -> Bool
$c> :: Access -> Access -> Bool
> :: Access -> Access -> Bool
$c>= :: Access -> Access -> Bool
>= :: Access -> Access -> Bool
$cmax :: Access -> Access -> Access
max :: Access -> Access -> Access
$cmin :: Access -> Access -> Access
min :: Access -> Access -> Access
Ord, Access
Access -> Access -> Bounded Access
forall a. a -> a -> Bounded a
$cminBound :: Access
minBound :: Access
$cmaxBound :: Access
maxBound :: Access
Bounded, Int -> Access
Access -> Int
Access -> [Access]
Access -> Access
Access -> Access -> [Access]
Access -> Access -> Access -> [Access]
(Access -> Access)
-> (Access -> Access)
-> (Int -> Access)
-> (Access -> Int)
-> (Access -> [Access])
-> (Access -> Access -> [Access])
-> (Access -> Access -> [Access])
-> (Access -> Access -> Access -> [Access])
-> Enum Access
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Access -> Access
succ :: Access -> Access
$cpred :: Access -> Access
pred :: Access -> Access
$ctoEnum :: Int -> Access
toEnum :: Int -> Access
$cfromEnum :: Access -> Int
fromEnum :: Access -> Int
$cenumFrom :: Access -> [Access]
enumFrom :: Access -> [Access]
$cenumFromThen :: Access -> Access -> [Access]
enumFromThen :: Access -> Access -> [Access]
$cenumFromTo :: Access -> Access -> [Access]
enumFromTo :: Access -> Access -> [Access]
$cenumFromThenTo :: Access -> Access -> Access -> [Access]
enumFromThenTo :: Access -> Access -> Access -> [Access]
Enum, Int -> Access -> ShowS
[Access] -> ShowS
Access -> String
(Int -> Access -> ShowS)
-> (Access -> String) -> ([Access] -> ShowS) -> Show Access
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Access -> ShowS
showsPrec :: Int -> Access -> ShowS
$cshow :: Access -> String
show :: Access -> String
$cshowList :: [Access] -> ShowS
showList :: [Access] -> ShowS
Show, (forall x. Access -> Rep Access x)
-> (forall x. Rep Access x -> Access) -> Generic Access
forall x. Rep Access x -> Access
forall x. Access -> Rep Access x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Access -> Rep Access x
from :: forall x. Access -> Rep Access x
$cto :: forall x. Rep Access x -> Access
to :: forall x. Rep Access x -> Access
Generic)
  deriving (Gen Access
Gen Access -> (Access -> [Access]) -> Arbitrary Access
Access -> [Access]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Access
arbitrary :: Gen Access
$cshrink :: Access -> [Access]
shrink :: Access -> [Access]
Arbitrary) via (GenericUniform Access)
  deriving ([Access] -> Value
[Access] -> Encoding
Access -> Value
Access -> Encoding
(Access -> Value)
-> (Access -> Encoding)
-> ([Access] -> Value)
-> ([Access] -> Encoding)
-> ToJSON Access
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Access -> Value
toJSON :: Access -> Value
$ctoEncoding :: Access -> Encoding
toEncoding :: Access -> Encoding
$ctoJSONList :: [Access] -> Value
toJSONList :: [Access] -> Value
$ctoEncodingList :: [Access] -> Encoding
toEncodingList :: [Access] -> Encoding
ToJSON, Value -> Parser [Access]
Value -> Parser Access
(Value -> Parser Access)
-> (Value -> Parser [Access]) -> FromJSON Access
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Access
parseJSON :: Value -> Parser Access
$cparseJSONList :: Value -> Parser [Access]
parseJSONList :: Value -> Parser [Access]
FromJSON, Typeable Access
Typeable Access =>
(Proxy Access -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Access
Proxy Access -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Access -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Access -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema Access

instance ToSchema Access where
  schema :: ValueSchema NamedSwaggerDoc Access
schema =
    ((Schema -> Identity Schema)
-> ValueSchema NamedSwaggerDoc Access
-> Identity (ValueSchema NamedSwaggerDoc Access)
forall s a. HasSchema s a => Lens' s a
Lens' (ValueSchema NamedSwaggerDoc Access) Schema
S.schema ((Schema -> Identity Schema)
 -> ValueSchema NamedSwaggerDoc Access
 -> Identity (ValueSchema NamedSwaggerDoc Access))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> ValueSchema NamedSwaggerDoc Access
-> Identity (ValueSchema NamedSwaggerDoc Access)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> ValueSchema NamedSwaggerDoc Access
 -> Identity (ValueSchema NamedSwaggerDoc Access))
-> Text
-> ValueSchema NamedSwaggerDoc Access
-> ValueSchema NamedSwaggerDoc Access
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"How users can join conversations") (ValueSchema NamedSwaggerDoc Access
 -> ValueSchema NamedSwaggerDoc Access)
-> ValueSchema NamedSwaggerDoc Access
-> ValueSchema NamedSwaggerDoc Access
forall a b. (a -> b) -> a -> b
$
      forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"Access" (SchemaP [Value] Text (Alt Maybe Text) Access Access
 -> ValueSchema NamedSwaggerDoc Access)
-> SchemaP [Value] Text (Alt Maybe Text) Access Access
-> ValueSchema NamedSwaggerDoc Access
forall a b. (a -> b) -> a -> b
$
        [SchemaP [Value] Text (Alt Maybe Text) Access Access]
-> SchemaP [Value] Text (Alt Maybe Text) Access Access
forall a. Monoid a => [a] -> a
mconcat
          [ Text
-> Access -> SchemaP [Value] Text (Alt Maybe Text) Access Access
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"private" Access
PrivateAccess,
            Text
-> Access -> SchemaP [Value] Text (Alt Maybe Text) Access Access
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"invite" Access
InviteAccess,
            Text
-> Access -> SchemaP [Value] Text (Alt Maybe Text) Access Access
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"link" Access
LinkAccess,
            Text
-> Access -> SchemaP [Value] Text (Alt Maybe Text) Access Access
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"code" Access
CodeAccess
          ]

-- | AccessRoles define who can join conversations. The roles are
-- "supersets", i.e. Activated includes Team and NonActivated includes
-- Activated.
data AccessRoleLegacy
  = -- | Nobody can be invited to this conversation
    --   (e.g. it's a 1:1 conversation)
    PrivateAccessRole
  | -- | Team-only conversation
    TeamAccessRole
  | -- | Conversation for users who have activated
    --   email, phone or SSO and bots
    ActivatedAccessRole
  | -- | No checks
    NonActivatedAccessRole
  deriving stock (AccessRoleLegacy -> AccessRoleLegacy -> Bool
(AccessRoleLegacy -> AccessRoleLegacy -> Bool)
-> (AccessRoleLegacy -> AccessRoleLegacy -> Bool)
-> Eq AccessRoleLegacy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
== :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
$c/= :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
/= :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
Eq, Eq AccessRoleLegacy
Eq AccessRoleLegacy =>
(AccessRoleLegacy -> AccessRoleLegacy -> Ordering)
-> (AccessRoleLegacy -> AccessRoleLegacy -> Bool)
-> (AccessRoleLegacy -> AccessRoleLegacy -> Bool)
-> (AccessRoleLegacy -> AccessRoleLegacy -> Bool)
-> (AccessRoleLegacy -> AccessRoleLegacy -> Bool)
-> (AccessRoleLegacy -> AccessRoleLegacy -> AccessRoleLegacy)
-> (AccessRoleLegacy -> AccessRoleLegacy -> AccessRoleLegacy)
-> Ord AccessRoleLegacy
AccessRoleLegacy -> AccessRoleLegacy -> Bool
AccessRoleLegacy -> AccessRoleLegacy -> Ordering
AccessRoleLegacy -> AccessRoleLegacy -> AccessRoleLegacy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AccessRoleLegacy -> AccessRoleLegacy -> Ordering
compare :: AccessRoleLegacy -> AccessRoleLegacy -> Ordering
$c< :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
< :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
$c<= :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
<= :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
$c> :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
> :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
$c>= :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
>= :: AccessRoleLegacy -> AccessRoleLegacy -> Bool
$cmax :: AccessRoleLegacy -> AccessRoleLegacy -> AccessRoleLegacy
max :: AccessRoleLegacy -> AccessRoleLegacy -> AccessRoleLegacy
$cmin :: AccessRoleLegacy -> AccessRoleLegacy -> AccessRoleLegacy
min :: AccessRoleLegacy -> AccessRoleLegacy -> AccessRoleLegacy
Ord, Int -> AccessRoleLegacy -> ShowS
[AccessRoleLegacy] -> ShowS
AccessRoleLegacy -> String
(Int -> AccessRoleLegacy -> ShowS)
-> (AccessRoleLegacy -> String)
-> ([AccessRoleLegacy] -> ShowS)
-> Show AccessRoleLegacy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccessRoleLegacy -> ShowS
showsPrec :: Int -> AccessRoleLegacy -> ShowS
$cshow :: AccessRoleLegacy -> String
show :: AccessRoleLegacy -> String
$cshowList :: [AccessRoleLegacy] -> ShowS
showList :: [AccessRoleLegacy] -> ShowS
Show, (forall x. AccessRoleLegacy -> Rep AccessRoleLegacy x)
-> (forall x. Rep AccessRoleLegacy x -> AccessRoleLegacy)
-> Generic AccessRoleLegacy
forall x. Rep AccessRoleLegacy x -> AccessRoleLegacy
forall x. AccessRoleLegacy -> Rep AccessRoleLegacy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccessRoleLegacy -> Rep AccessRoleLegacy x
from :: forall x. AccessRoleLegacy -> Rep AccessRoleLegacy x
$cto :: forall x. Rep AccessRoleLegacy x -> AccessRoleLegacy
to :: forall x. Rep AccessRoleLegacy x -> AccessRoleLegacy
Generic, Int -> AccessRoleLegacy
AccessRoleLegacy -> Int
AccessRoleLegacy -> [AccessRoleLegacy]
AccessRoleLegacy -> AccessRoleLegacy
AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy]
AccessRoleLegacy
-> AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy]
(AccessRoleLegacy -> AccessRoleLegacy)
-> (AccessRoleLegacy -> AccessRoleLegacy)
-> (Int -> AccessRoleLegacy)
-> (AccessRoleLegacy -> Int)
-> (AccessRoleLegacy -> [AccessRoleLegacy])
-> (AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy])
-> (AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy])
-> (AccessRoleLegacy
    -> AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy])
-> Enum AccessRoleLegacy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AccessRoleLegacy -> AccessRoleLegacy
succ :: AccessRoleLegacy -> AccessRoleLegacy
$cpred :: AccessRoleLegacy -> AccessRoleLegacy
pred :: AccessRoleLegacy -> AccessRoleLegacy
$ctoEnum :: Int -> AccessRoleLegacy
toEnum :: Int -> AccessRoleLegacy
$cfromEnum :: AccessRoleLegacy -> Int
fromEnum :: AccessRoleLegacy -> Int
$cenumFrom :: AccessRoleLegacy -> [AccessRoleLegacy]
enumFrom :: AccessRoleLegacy -> [AccessRoleLegacy]
$cenumFromThen :: AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy]
enumFromThen :: AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy]
$cenumFromTo :: AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy]
enumFromTo :: AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy]
$cenumFromThenTo :: AccessRoleLegacy
-> AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy]
enumFromThenTo :: AccessRoleLegacy
-> AccessRoleLegacy -> AccessRoleLegacy -> [AccessRoleLegacy]
Enum, AccessRoleLegacy
AccessRoleLegacy -> AccessRoleLegacy -> Bounded AccessRoleLegacy
forall a. a -> a -> Bounded a
$cminBound :: AccessRoleLegacy
minBound :: AccessRoleLegacy
$cmaxBound :: AccessRoleLegacy
maxBound :: AccessRoleLegacy
Bounded)
  deriving (Gen AccessRoleLegacy
Gen AccessRoleLegacy
-> (AccessRoleLegacy -> [AccessRoleLegacy])
-> Arbitrary AccessRoleLegacy
AccessRoleLegacy -> [AccessRoleLegacy]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AccessRoleLegacy
arbitrary :: Gen AccessRoleLegacy
$cshrink :: AccessRoleLegacy -> [AccessRoleLegacy]
shrink :: AccessRoleLegacy -> [AccessRoleLegacy]
Arbitrary) via (GenericUniform AccessRoleLegacy)
  deriving ([AccessRoleLegacy] -> Value
[AccessRoleLegacy] -> Encoding
AccessRoleLegacy -> Value
AccessRoleLegacy -> Encoding
(AccessRoleLegacy -> Value)
-> (AccessRoleLegacy -> Encoding)
-> ([AccessRoleLegacy] -> Value)
-> ([AccessRoleLegacy] -> Encoding)
-> ToJSON AccessRoleLegacy
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AccessRoleLegacy -> Value
toJSON :: AccessRoleLegacy -> Value
$ctoEncoding :: AccessRoleLegacy -> Encoding
toEncoding :: AccessRoleLegacy -> Encoding
$ctoJSONList :: [AccessRoleLegacy] -> Value
toJSONList :: [AccessRoleLegacy] -> Value
$ctoEncodingList :: [AccessRoleLegacy] -> Encoding
toEncodingList :: [AccessRoleLegacy] -> Encoding
ToJSON, Value -> Parser [AccessRoleLegacy]
Value -> Parser AccessRoleLegacy
(Value -> Parser AccessRoleLegacy)
-> (Value -> Parser [AccessRoleLegacy])
-> FromJSON AccessRoleLegacy
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AccessRoleLegacy
parseJSON :: Value -> Parser AccessRoleLegacy
$cparseJSONList :: Value -> Parser [AccessRoleLegacy]
parseJSONList :: Value -> Parser [AccessRoleLegacy]
FromJSON, Typeable AccessRoleLegacy
Typeable AccessRoleLegacy =>
(Proxy AccessRoleLegacy
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AccessRoleLegacy
Proxy AccessRoleLegacy -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AccessRoleLegacy -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AccessRoleLegacy -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema AccessRoleLegacy

fromAccessRoleLegacy :: AccessRoleLegacy -> Set AccessRole
fromAccessRoleLegacy :: AccessRoleLegacy -> Set AccessRole
fromAccessRoleLegacy = \case
  AccessRoleLegacy
PrivateAccessRole -> Set AccessRole
privateAccessRole
  AccessRoleLegacy
TeamAccessRole -> Set AccessRole
teamAccessRole
  AccessRoleLegacy
ActivatedAccessRole -> Set AccessRole
activatedAccessRole
  AccessRoleLegacy
NonActivatedAccessRole -> Set AccessRole
nonActivatedAccessRole

privateAccessRole :: Set AccessRole
privateAccessRole :: Set AccessRole
privateAccessRole = [AccessRole] -> Set AccessRole
forall a. Ord a => [a] -> Set a
Set.fromList []

teamAccessRole :: Set AccessRole
teamAccessRole :: Set AccessRole
teamAccessRole = [AccessRole] -> Set AccessRole
forall a. Ord a => [a] -> Set a
Set.fromList [AccessRole
TeamMemberAccessRole]

activatedAccessRole :: Set AccessRole
activatedAccessRole :: Set AccessRole
activatedAccessRole = [AccessRole] -> Set AccessRole
forall a. Ord a => [a] -> Set a
Set.fromList [AccessRole
TeamMemberAccessRole, AccessRole
NonTeamMemberAccessRole, AccessRole
ServiceAccessRole]

nonActivatedAccessRole :: Set AccessRole
nonActivatedAccessRole :: Set AccessRole
nonActivatedAccessRole = [AccessRole] -> Set AccessRole
forall a. Ord a => [a] -> Set a
Set.fromList [AccessRole
TeamMemberAccessRole, AccessRole
NonTeamMemberAccessRole, AccessRole
GuestAccessRole, AccessRole
ServiceAccessRole]

defRole :: Set AccessRole
defRole :: Set AccessRole
defRole = Set AccessRole
activatedAccessRole

maybeRole :: ConvType -> Maybe (Set AccessRole) -> Set AccessRole
maybeRole :: ConvType -> Maybe (Set AccessRole) -> Set AccessRole
maybeRole ConvType
SelfConv Maybe (Set AccessRole)
_ = Set AccessRole
privateAccessRole
maybeRole ConvType
ConnectConv Maybe (Set AccessRole)
_ = Set AccessRole
privateAccessRole
maybeRole ConvType
One2OneConv Maybe (Set AccessRole)
_ = Set AccessRole
privateAccessRole
maybeRole ConvType
RegularConv Maybe (Set AccessRole)
Nothing = Set AccessRole
defRole
maybeRole ConvType
RegularConv (Just Set AccessRole
r) = Set AccessRole
r

data AccessRole
  = TeamMemberAccessRole
  | NonTeamMemberAccessRole
  | GuestAccessRole
  | ServiceAccessRole
  deriving stock (AccessRole -> AccessRole -> Bool
(AccessRole -> AccessRole -> Bool)
-> (AccessRole -> AccessRole -> Bool) -> Eq AccessRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessRole -> AccessRole -> Bool
== :: AccessRole -> AccessRole -> Bool
$c/= :: AccessRole -> AccessRole -> Bool
/= :: AccessRole -> AccessRole -> Bool
Eq, Eq AccessRole
Eq AccessRole =>
(AccessRole -> AccessRole -> Ordering)
-> (AccessRole -> AccessRole -> Bool)
-> (AccessRole -> AccessRole -> Bool)
-> (AccessRole -> AccessRole -> Bool)
-> (AccessRole -> AccessRole -> Bool)
-> (AccessRole -> AccessRole -> AccessRole)
-> (AccessRole -> AccessRole -> AccessRole)
-> Ord AccessRole
AccessRole -> AccessRole -> Bool
AccessRole -> AccessRole -> Ordering
AccessRole -> AccessRole -> AccessRole
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AccessRole -> AccessRole -> Ordering
compare :: AccessRole -> AccessRole -> Ordering
$c< :: AccessRole -> AccessRole -> Bool
< :: AccessRole -> AccessRole -> Bool
$c<= :: AccessRole -> AccessRole -> Bool
<= :: AccessRole -> AccessRole -> Bool
$c> :: AccessRole -> AccessRole -> Bool
> :: AccessRole -> AccessRole -> Bool
$c>= :: AccessRole -> AccessRole -> Bool
>= :: AccessRole -> AccessRole -> Bool
$cmax :: AccessRole -> AccessRole -> AccessRole
max :: AccessRole -> AccessRole -> AccessRole
$cmin :: AccessRole -> AccessRole -> AccessRole
min :: AccessRole -> AccessRole -> AccessRole
Ord, Int -> AccessRole -> ShowS
[AccessRole] -> ShowS
AccessRole -> String
(Int -> AccessRole -> ShowS)
-> (AccessRole -> String)
-> ([AccessRole] -> ShowS)
-> Show AccessRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccessRole -> ShowS
showsPrec :: Int -> AccessRole -> ShowS
$cshow :: AccessRole -> String
show :: AccessRole -> String
$cshowList :: [AccessRole] -> ShowS
showList :: [AccessRole] -> ShowS
Show, (forall x. AccessRole -> Rep AccessRole x)
-> (forall x. Rep AccessRole x -> AccessRole) -> Generic AccessRole
forall x. Rep AccessRole x -> AccessRole
forall x. AccessRole -> Rep AccessRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccessRole -> Rep AccessRole x
from :: forall x. AccessRole -> Rep AccessRole x
$cto :: forall x. Rep AccessRole x -> AccessRole
to :: forall x. Rep AccessRole x -> AccessRole
Generic, AccessRole
AccessRole -> AccessRole -> Bounded AccessRole
forall a. a -> a -> Bounded a
$cminBound :: AccessRole
minBound :: AccessRole
$cmaxBound :: AccessRole
maxBound :: AccessRole
Bounded, Int -> AccessRole
AccessRole -> Int
AccessRole -> [AccessRole]
AccessRole -> AccessRole
AccessRole -> AccessRole -> [AccessRole]
AccessRole -> AccessRole -> AccessRole -> [AccessRole]
(AccessRole -> AccessRole)
-> (AccessRole -> AccessRole)
-> (Int -> AccessRole)
-> (AccessRole -> Int)
-> (AccessRole -> [AccessRole])
-> (AccessRole -> AccessRole -> [AccessRole])
-> (AccessRole -> AccessRole -> [AccessRole])
-> (AccessRole -> AccessRole -> AccessRole -> [AccessRole])
-> Enum AccessRole
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AccessRole -> AccessRole
succ :: AccessRole -> AccessRole
$cpred :: AccessRole -> AccessRole
pred :: AccessRole -> AccessRole
$ctoEnum :: Int -> AccessRole
toEnum :: Int -> AccessRole
$cfromEnum :: AccessRole -> Int
fromEnum :: AccessRole -> Int
$cenumFrom :: AccessRole -> [AccessRole]
enumFrom :: AccessRole -> [AccessRole]
$cenumFromThen :: AccessRole -> AccessRole -> [AccessRole]
enumFromThen :: AccessRole -> AccessRole -> [AccessRole]
$cenumFromTo :: AccessRole -> AccessRole -> [AccessRole]
enumFromTo :: AccessRole -> AccessRole -> [AccessRole]
$cenumFromThenTo :: AccessRole -> AccessRole -> AccessRole -> [AccessRole]
enumFromThenTo :: AccessRole -> AccessRole -> AccessRole -> [AccessRole]
Enum)
  deriving (Gen AccessRole
Gen AccessRole
-> (AccessRole -> [AccessRole]) -> Arbitrary AccessRole
AccessRole -> [AccessRole]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AccessRole
arbitrary :: Gen AccessRole
$cshrink :: AccessRole -> [AccessRole]
shrink :: AccessRole -> [AccessRole]
Arbitrary) via (GenericUniform AccessRole)
  deriving ([AccessRole] -> Value
[AccessRole] -> Encoding
AccessRole -> Value
AccessRole -> Encoding
(AccessRole -> Value)
-> (AccessRole -> Encoding)
-> ([AccessRole] -> Value)
-> ([AccessRole] -> Encoding)
-> ToJSON AccessRole
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AccessRole -> Value
toJSON :: AccessRole -> Value
$ctoEncoding :: AccessRole -> Encoding
toEncoding :: AccessRole -> Encoding
$ctoJSONList :: [AccessRole] -> Value
toJSONList :: [AccessRole] -> Value
$ctoEncodingList :: [AccessRole] -> Encoding
toEncodingList :: [AccessRole] -> Encoding
ToJSON, Value -> Parser [AccessRole]
Value -> Parser AccessRole
(Value -> Parser AccessRole)
-> (Value -> Parser [AccessRole]) -> FromJSON AccessRole
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AccessRole
parseJSON :: Value -> Parser AccessRole
$cparseJSONList :: Value -> Parser [AccessRole]
parseJSONList :: Value -> Parser [AccessRole]
FromJSON, Typeable AccessRole
Typeable AccessRole =>
(Proxy AccessRole -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AccessRole
Proxy AccessRole -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AccessRole -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AccessRole -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema AccessRole

genAccessRolesV2 :: [AccessRole] -> [AccessRole] -> IO (Either String (Set AccessRole))
genAccessRolesV2 :: [AccessRole] -> [AccessRole] -> IO (Either String (Set AccessRole))
genAccessRolesV2 = [AccessRole] -> [AccessRole] -> IO (Either String (Set AccessRole))
forall a.
(Bounded a, Enum a, Ord a, Show a) =>
[a] -> [a] -> IO (Either String (Set a))
genEnumSet

genEnumSet :: forall a. (Bounded a, Enum a, Ord a, Show a) => [a] -> [a] -> IO (Either String (Set a))
genEnumSet :: forall a.
(Bounded a, Enum a, Ord a, Show a) =>
[a] -> [a] -> IO (Either String (Set a))
genEnumSet [a]
with [a]
without =
  if [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
disjointOrd [a]
with [a]
without
    then do
      let xs :: [Set a]
xs = Set (Set a) -> [Set a]
forall a. Set a -> [a]
Set.toList (Set (Set a) -> [Set a]) -> ([a] -> Set (Set a)) -> [a] -> [Set a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Set (Set a)
forall a. Set a -> Set (Set a)
Set.powerSet (Set a -> Set (Set a)) -> ([a] -> Set a) -> [a] -> Set (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> [Set a]) -> [a] -> [Set a]
forall a b. (a -> b) -> a -> b
$ [a
forall a. Bounded a => a
minBound ..]
      Set a
x <- ([Set a]
xs !!) (Int -> Set a) -> IO Int -> IO (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, [Set a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Set a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      Either String (Set a) -> IO (Either String (Set a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Set a) -> IO (Either String (Set a)))
-> ([a] -> Either String (Set a))
-> [a]
-> IO (Either String (Set a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Either String (Set a)
forall a b. b -> Either a b
Right (Set a -> Either String (Set a))
-> ([a] -> Set a) -> [a] -> Either String (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> IO (Either String (Set a)))
-> [a] -> IO (Either String (Set a))
forall a b. (a -> b) -> a -> b
$ (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
x [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
with) [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
without
    else do
      Either String (Set a) -> IO (Either String (Set a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Set a) -> IO (Either String (Set a)))
-> Either String (Set a) -> IO (Either String (Set a))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Set a)
forall a b. a -> Either a b
Left (String
"overlapping arguments: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ([a], [a]) -> String
forall a. Show a => a -> String
show ([a]
with, [a]
without))

toAccessRoleLegacy :: Set AccessRole -> AccessRoleLegacy
toAccessRoleLegacy :: Set AccessRole -> AccessRoleLegacy
toAccessRoleLegacy Set AccessRole
accessRoles = do
  AccessRoleLegacy -> Maybe AccessRoleLegacy -> AccessRoleLegacy
forall a. a -> Maybe a -> a
fromMaybe AccessRoleLegacy
NonActivatedAccessRole (Maybe AccessRoleLegacy -> AccessRoleLegacy)
-> Maybe AccessRoleLegacy -> AccessRoleLegacy
forall a b. (a -> b) -> a -> b
$ (AccessRoleLegacy -> Bool)
-> [AccessRoleLegacy] -> Maybe AccessRoleLegacy
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Set AccessRole -> Set AccessRole -> Bool
forall a. Ord a => Set a -> Set a -> Bool
allMember Set AccessRole
accessRoles (Set AccessRole -> Bool)
-> (AccessRoleLegacy -> Set AccessRole) -> AccessRoleLegacy -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessRoleLegacy -> Set AccessRole
fromAccessRoleLegacy) [AccessRoleLegacy
forall a. Bounded a => a
minBound ..]
  where
    allMember :: (Ord a) => Set a -> Set a -> Bool
    allMember :: forall a. Ord a => Set a -> Set a -> Bool
allMember Set a
rhs Set a
lhs = (a -> Bool) -> Set a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
lhs) Set a
rhs

instance ToSchema AccessRole where
  schema :: ValueSchema NamedSwaggerDoc AccessRole
schema =
    ((Schema -> Identity Schema)
-> ValueSchema NamedSwaggerDoc AccessRole
-> Identity (ValueSchema NamedSwaggerDoc AccessRole)
forall s a. HasSchema s a => Lens' s a
Lens' (ValueSchema NamedSwaggerDoc AccessRole) Schema
S.schema ((Schema -> Identity Schema)
 -> ValueSchema NamedSwaggerDoc AccessRole
 -> Identity (ValueSchema NamedSwaggerDoc AccessRole))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> ValueSchema NamedSwaggerDoc AccessRole
-> Identity (ValueSchema NamedSwaggerDoc AccessRole)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> ValueSchema NamedSwaggerDoc AccessRole
 -> Identity (ValueSchema NamedSwaggerDoc AccessRole))
-> Text
-> ValueSchema NamedSwaggerDoc AccessRole
-> ValueSchema NamedSwaggerDoc AccessRole
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
desc) (ValueSchema NamedSwaggerDoc AccessRole
 -> ValueSchema NamedSwaggerDoc AccessRole)
-> ValueSchema NamedSwaggerDoc AccessRole
-> ValueSchema NamedSwaggerDoc AccessRole
forall a b. (a -> b) -> a -> b
$
      forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"AccessRole" (SchemaP [Value] Text (Alt Maybe Text) AccessRole AccessRole
 -> ValueSchema NamedSwaggerDoc AccessRole)
-> SchemaP [Value] Text (Alt Maybe Text) AccessRole AccessRole
-> ValueSchema NamedSwaggerDoc AccessRole
forall a b. (a -> b) -> a -> b
$
        [SchemaP [Value] Text (Alt Maybe Text) AccessRole AccessRole]
-> SchemaP [Value] Text (Alt Maybe Text) AccessRole AccessRole
forall a. Monoid a => [a] -> a
mconcat
          [ Text
-> AccessRole
-> SchemaP [Value] Text (Alt Maybe Text) AccessRole AccessRole
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"team_member" AccessRole
TeamMemberAccessRole,
            Text
-> AccessRole
-> SchemaP [Value] Text (Alt Maybe Text) AccessRole AccessRole
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"non_team_member" AccessRole
NonTeamMemberAccessRole,
            Text
-> AccessRole
-> SchemaP [Value] Text (Alt Maybe Text) AccessRole AccessRole
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"guest" AccessRole
GuestAccessRole,
            Text
-> AccessRole
-> SchemaP [Value] Text (Alt Maybe Text) AccessRole AccessRole
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"service" AccessRole
ServiceAccessRole
          ]
    where
      desc :: Text
desc =
        Text
"Which users/services can join conversations.\
        \ This replaces legacy access roles and allows a more fine grained\
        \ configuration of access roles, and in particular a separation of\
        \ guest and services access.\n\nThis field is optional. If it is not\
        \ present, the default will be `[team_member, non_team_member, service]`.\
        \ Please note that an empty list is not allowed when creating a new\
        \ conversation."

instance ToSchema AccessRoleLegacy where
  schema :: SchemaP
  NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
schema =
    ((Schema -> Identity Schema)
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
-> Identity
     (SchemaP
        NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy)
forall s a. HasSchema s a => Lens' s a
Lens'
  (SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy)
  Schema
S.schema ((Schema -> Identity Schema)
 -> SchemaP
      NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
 -> Identity
      (SchemaP
         NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy))
-> ((Maybe Bool -> Identity (Maybe Bool))
    -> Schema -> Identity Schema)
-> (Maybe Bool -> Identity (Maybe Bool))
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
-> Identity
     (SchemaP
        NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Identity (Maybe Bool)) -> Schema -> Identity Schema
forall s a. HasDeprecated s a => Lens' s a
Lens' Schema (Maybe Bool)
S.deprecated ((Maybe Bool -> Identity (Maybe Bool))
 -> SchemaP
      NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
 -> Identity
      (SchemaP
         NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy))
-> Bool
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True) (SchemaP
   NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
 -> SchemaP
      NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy)
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
forall a b. (a -> b) -> a -> b
$
      ((Schema -> Identity Schema)
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
-> Identity
     (SchemaP
        NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy)
forall s a. HasSchema s a => Lens' s a
Lens'
  (SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy)
  Schema
S.schema ((Schema -> Identity Schema)
 -> SchemaP
      NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
 -> Identity
      (SchemaP
         NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
-> Identity
     (SchemaP
        NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SchemaP
      NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
 -> Identity
      (SchemaP
         NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy))
-> Text
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
desc) (SchemaP
   NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
 -> SchemaP
      NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy)
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
forall a b. (a -> b) -> a -> b
$
        forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"AccessRoleLegacy" (SchemaP
   [Value] Text (Alt Maybe Text) AccessRoleLegacy AccessRoleLegacy
 -> SchemaP
      NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy)
-> SchemaP
     [Value] Text (Alt Maybe Text) AccessRoleLegacy AccessRoleLegacy
-> SchemaP
     NamedSwaggerDoc Value Value AccessRoleLegacy AccessRoleLegacy
forall a b. (a -> b) -> a -> b
$
          [SchemaP
   [Value] Text (Alt Maybe Text) AccessRoleLegacy AccessRoleLegacy]
-> SchemaP
     [Value] Text (Alt Maybe Text) AccessRoleLegacy AccessRoleLegacy
forall a. Monoid a => [a] -> a
mconcat
            [ Text
-> AccessRoleLegacy
-> SchemaP
     [Value] Text (Alt Maybe Text) AccessRoleLegacy AccessRoleLegacy
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"private" AccessRoleLegacy
PrivateAccessRole,
              Text
-> AccessRoleLegacy
-> SchemaP
     [Value] Text (Alt Maybe Text) AccessRoleLegacy AccessRoleLegacy
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"team" AccessRoleLegacy
TeamAccessRole,
              Text
-> AccessRoleLegacy
-> SchemaP
     [Value] Text (Alt Maybe Text) AccessRoleLegacy AccessRoleLegacy
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"activated" AccessRoleLegacy
ActivatedAccessRole,
              Text
-> AccessRoleLegacy
-> SchemaP
     [Value] Text (Alt Maybe Text) AccessRoleLegacy AccessRoleLegacy
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"non_activated" AccessRoleLegacy
NonActivatedAccessRole
            ]
    where
      desc :: Text
desc =
        Text
"Which users can join conversations (deprecated, use `access_role_v2` instead).\
        \Maps to `access_role_v2` as follows:\
        \`private` => `[]` - nobody can be invited to this conversation (e.g. it's a 1:1 conversation)\
        \`team` => `[team_member]` - team-only conversation\
        \`activated` => `[team_member, non_team_member, service]` - conversation for users who have activated email, phone or SSO and services\
        \`non_activated` => `[team_member, non_team_member, service, guest]` - all allowed, no checks\
        \\
        \Maps from `access_role_v2` as follows:\
        \`[]` => `private` - nobody can be invited to this conversation (e.g. it's a 1:1 conversation)\
        \`[team_member]` => `team` - team-only conversation\
        \`[team_member, non_team_member, service]` => `activated` - conversation for users who have activated email, phone or SSO and services\
        \`[team_member, non_team_member, service, guest]` => `non_activated` - all allowed, no checks.\
        \All other configurations of `access_role_v2` are mapped to the smallest superset containing all given access roles."

data ConvType
  = RegularConv
  | SelfConv
  | One2OneConv
  | ConnectConv
  deriving stock (ConvType -> ConvType -> Bool
(ConvType -> ConvType -> Bool)
-> (ConvType -> ConvType -> Bool) -> Eq ConvType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConvType -> ConvType -> Bool
== :: ConvType -> ConvType -> Bool
$c/= :: ConvType -> ConvType -> Bool
/= :: ConvType -> ConvType -> Bool
Eq, Int -> ConvType -> ShowS
[ConvType] -> ShowS
ConvType -> String
(Int -> ConvType -> ShowS)
-> (ConvType -> String) -> ([ConvType] -> ShowS) -> Show ConvType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConvType -> ShowS
showsPrec :: Int -> ConvType -> ShowS
$cshow :: ConvType -> String
show :: ConvType -> String
$cshowList :: [ConvType] -> ShowS
showList :: [ConvType] -> ShowS
Show, Int -> ConvType
ConvType -> Int
ConvType -> [ConvType]
ConvType -> ConvType
ConvType -> ConvType -> [ConvType]
ConvType -> ConvType -> ConvType -> [ConvType]
(ConvType -> ConvType)
-> (ConvType -> ConvType)
-> (Int -> ConvType)
-> (ConvType -> Int)
-> (ConvType -> [ConvType])
-> (ConvType -> ConvType -> [ConvType])
-> (ConvType -> ConvType -> [ConvType])
-> (ConvType -> ConvType -> ConvType -> [ConvType])
-> Enum ConvType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ConvType -> ConvType
succ :: ConvType -> ConvType
$cpred :: ConvType -> ConvType
pred :: ConvType -> ConvType
$ctoEnum :: Int -> ConvType
toEnum :: Int -> ConvType
$cfromEnum :: ConvType -> Int
fromEnum :: ConvType -> Int
$cenumFrom :: ConvType -> [ConvType]
enumFrom :: ConvType -> [ConvType]
$cenumFromThen :: ConvType -> ConvType -> [ConvType]
enumFromThen :: ConvType -> ConvType -> [ConvType]
$cenumFromTo :: ConvType -> ConvType -> [ConvType]
enumFromTo :: ConvType -> ConvType -> [ConvType]
$cenumFromThenTo :: ConvType -> ConvType -> ConvType -> [ConvType]
enumFromThenTo :: ConvType -> ConvType -> ConvType -> [ConvType]
Enum, (forall x. ConvType -> Rep ConvType x)
-> (forall x. Rep ConvType x -> ConvType) -> Generic ConvType
forall x. Rep ConvType x -> ConvType
forall x. ConvType -> Rep ConvType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConvType -> Rep ConvType x
from :: forall x. ConvType -> Rep ConvType x
$cto :: forall x. Rep ConvType x -> ConvType
to :: forall x. Rep ConvType x -> ConvType
Generic)
  deriving (Gen ConvType
Gen ConvType -> (ConvType -> [ConvType]) -> Arbitrary ConvType
ConvType -> [ConvType]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConvType
arbitrary :: Gen ConvType
$cshrink :: ConvType -> [ConvType]
shrink :: ConvType -> [ConvType]
Arbitrary) via (GenericUniform ConvType)
  deriving (Value -> Parser [ConvType]
Value -> Parser ConvType
(Value -> Parser ConvType)
-> (Value -> Parser [ConvType]) -> FromJSON ConvType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConvType
parseJSON :: Value -> Parser ConvType
$cparseJSONList :: Value -> Parser [ConvType]
parseJSONList :: Value -> Parser [ConvType]
FromJSON, [ConvType] -> Value
[ConvType] -> Encoding
ConvType -> Value
ConvType -> Encoding
(ConvType -> Value)
-> (ConvType -> Encoding)
-> ([ConvType] -> Value)
-> ([ConvType] -> Encoding)
-> ToJSON ConvType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConvType -> Value
toJSON :: ConvType -> Value
$ctoEncoding :: ConvType -> Encoding
toEncoding :: ConvType -> Encoding
$ctoJSONList :: [ConvType] -> Value
toJSONList :: [ConvType] -> Value
$ctoEncodingList :: [ConvType] -> Encoding
toEncodingList :: [ConvType] -> Encoding
ToJSON, Typeable ConvType
Typeable ConvType =>
(Proxy ConvType -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConvType
Proxy ConvType -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConvType -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConvType -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ConvType

instance ToSchema ConvType where
  schema :: SchemaP NamedSwaggerDoc Value Value ConvType ConvType
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Integer Text
"ConvType" (SchemaP [Value] Integer (Alt Maybe Integer) ConvType ConvType
 -> SchemaP NamedSwaggerDoc Value Value ConvType ConvType)
-> SchemaP [Value] Integer (Alt Maybe Integer) ConvType ConvType
-> SchemaP NamedSwaggerDoc Value Value ConvType ConvType
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Integer (Alt Maybe Integer) ConvType ConvType]
-> SchemaP [Value] Integer (Alt Maybe Integer) ConvType ConvType
forall a. Monoid a => [a] -> a
mconcat
        [ Integer
-> ConvType
-> SchemaP [Value] Integer (Alt Maybe Integer) ConvType ConvType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Integer
0 ConvType
RegularConv,
          Integer
-> ConvType
-> SchemaP [Value] Integer (Alt Maybe Integer) ConvType ConvType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Integer
1 ConvType
SelfConv,
          Integer
-> ConvType
-> SchemaP [Value] Integer (Alt Maybe Integer) ConvType ConvType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Integer
2 ConvType
One2OneConv,
          Integer
-> ConvType
-> SchemaP [Value] Integer (Alt Maybe Integer) ConvType ConvType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Integer
3 ConvType
ConnectConv
        ]

-- | Define whether receipts should be sent in the given conversation
--   This datatype is defined as an int32 but the Backend does not
--   interpret it in any way, rather just stores and forwards it
--   for clients
--   E.g. of an implementation: 0 - send no ReceiptModes
--                              1 - send read ReceiptModes
--                              2 - send delivery ReceiptModes
--                              ...
newtype ReceiptMode = ReceiptMode {ReceiptMode -> Int32
unReceiptMode :: Int32}
  deriving stock (ReceiptMode -> ReceiptMode -> Bool
(ReceiptMode -> ReceiptMode -> Bool)
-> (ReceiptMode -> ReceiptMode -> Bool) -> Eq ReceiptMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReceiptMode -> ReceiptMode -> Bool
== :: ReceiptMode -> ReceiptMode -> Bool
$c/= :: ReceiptMode -> ReceiptMode -> Bool
/= :: ReceiptMode -> ReceiptMode -> Bool
Eq, Eq ReceiptMode
Eq ReceiptMode =>
(ReceiptMode -> ReceiptMode -> Ordering)
-> (ReceiptMode -> ReceiptMode -> Bool)
-> (ReceiptMode -> ReceiptMode -> Bool)
-> (ReceiptMode -> ReceiptMode -> Bool)
-> (ReceiptMode -> ReceiptMode -> Bool)
-> (ReceiptMode -> ReceiptMode -> ReceiptMode)
-> (ReceiptMode -> ReceiptMode -> ReceiptMode)
-> Ord ReceiptMode
ReceiptMode -> ReceiptMode -> Bool
ReceiptMode -> ReceiptMode -> Ordering
ReceiptMode -> ReceiptMode -> ReceiptMode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ReceiptMode -> ReceiptMode -> Ordering
compare :: ReceiptMode -> ReceiptMode -> Ordering
$c< :: ReceiptMode -> ReceiptMode -> Bool
< :: ReceiptMode -> ReceiptMode -> Bool
$c<= :: ReceiptMode -> ReceiptMode -> Bool
<= :: ReceiptMode -> ReceiptMode -> Bool
$c> :: ReceiptMode -> ReceiptMode -> Bool
> :: ReceiptMode -> ReceiptMode -> Bool
$c>= :: ReceiptMode -> ReceiptMode -> Bool
>= :: ReceiptMode -> ReceiptMode -> Bool
$cmax :: ReceiptMode -> ReceiptMode -> ReceiptMode
max :: ReceiptMode -> ReceiptMode -> ReceiptMode
$cmin :: ReceiptMode -> ReceiptMode -> ReceiptMode
min :: ReceiptMode -> ReceiptMode -> ReceiptMode
Ord, Int -> ReceiptMode -> ShowS
[ReceiptMode] -> ShowS
ReceiptMode -> String
(Int -> ReceiptMode -> ShowS)
-> (ReceiptMode -> String)
-> ([ReceiptMode] -> ShowS)
-> Show ReceiptMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReceiptMode -> ShowS
showsPrec :: Int -> ReceiptMode -> ShowS
$cshow :: ReceiptMode -> String
show :: ReceiptMode -> String
$cshowList :: [ReceiptMode] -> ShowS
showList :: [ReceiptMode] -> ShowS
Show)
  deriving newtype (Gen ReceiptMode
Gen ReceiptMode
-> (ReceiptMode -> [ReceiptMode]) -> Arbitrary ReceiptMode
ReceiptMode -> [ReceiptMode]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ReceiptMode
arbitrary :: Gen ReceiptMode
$cshrink :: ReceiptMode -> [ReceiptMode]
shrink :: ReceiptMode -> [ReceiptMode]
Arbitrary)
  deriving (Value -> Parser [ReceiptMode]
Value -> Parser ReceiptMode
(Value -> Parser ReceiptMode)
-> (Value -> Parser [ReceiptMode]) -> FromJSON ReceiptMode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ReceiptMode
parseJSON :: Value -> Parser ReceiptMode
$cparseJSONList :: Value -> Parser [ReceiptMode]
parseJSONList :: Value -> Parser [ReceiptMode]
FromJSON, [ReceiptMode] -> Value
[ReceiptMode] -> Encoding
ReceiptMode -> Value
ReceiptMode -> Encoding
(ReceiptMode -> Value)
-> (ReceiptMode -> Encoding)
-> ([ReceiptMode] -> Value)
-> ([ReceiptMode] -> Encoding)
-> ToJSON ReceiptMode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ReceiptMode -> Value
toJSON :: ReceiptMode -> Value
$ctoEncoding :: ReceiptMode -> Encoding
toEncoding :: ReceiptMode -> Encoding
$ctoJSONList :: [ReceiptMode] -> Value
toJSONList :: [ReceiptMode] -> Value
$ctoEncodingList :: [ReceiptMode] -> Encoding
toEncodingList :: [ReceiptMode] -> Encoding
ToJSON, Typeable ReceiptMode
Typeable ReceiptMode =>
(Proxy ReceiptMode -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ReceiptMode
Proxy ReceiptMode -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ReceiptMode -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ReceiptMode -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ReceiptMode

instance ToSchema ReceiptMode where
  schema :: SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
schema =
    ((Schema -> Identity Schema)
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
-> Identity
     (SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode)
forall s a. HasSchema s a => Lens' s a
Lens'
  (SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode)
  Schema
S.schema ((Schema -> Identity Schema)
 -> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
 -> Identity
      (SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
-> Identity
     (SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
 -> Identity
      (SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode))
-> Text
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Conversation receipt mode") (SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
 -> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode)
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
forall a b. (a -> b) -> a -> b
$
      Int32 -> ReceiptMode
ReceiptMode (Int32 -> ReceiptMode)
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode Int32
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReceiptMode -> Int32
unReceiptMode (ReceiptMode -> Int32)
-> SchemaP NamedSwaggerDoc Value Value Int32 Int32
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode Int32
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP NamedSwaggerDoc Value Value Int32 Int32
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- create

data NewConv = NewConv
  { NewConv -> [UserId]
newConvUsers :: [UserId],
    -- | A list of qualified users, which can include some local qualified users
    -- too.
    NewConv -> [Qualified UserId]
newConvQualifiedUsers :: [Qualified UserId],
    NewConv -> Maybe (Range 1 256 Text)
newConvName :: Maybe (Range 1 256 Text),
    NewConv -> Set Access
newConvAccess :: Set Access,
    NewConv -> Maybe (Set AccessRole)
newConvAccessRoles :: Maybe (Set AccessRole),
    NewConv -> Maybe ConvTeamInfo
newConvTeam :: Maybe ConvTeamInfo,
    NewConv -> Maybe Milliseconds
newConvMessageTimer :: Maybe Milliseconds,
    NewConv -> Maybe ReceiptMode
newConvReceiptMode :: Maybe ReceiptMode,
    -- | Every member except for the creator will have this role
    NewConv -> RoleName
newConvUsersRole :: RoleName,
    -- | The protocol of the conversation. It can be Proteus or MLS (1.0).
    NewConv -> BaseProtocolTag
newConvProtocol :: BaseProtocolTag
  }
  deriving stock (NewConv -> NewConv -> Bool
(NewConv -> NewConv -> Bool)
-> (NewConv -> NewConv -> Bool) -> Eq NewConv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewConv -> NewConv -> Bool
== :: NewConv -> NewConv -> Bool
$c/= :: NewConv -> NewConv -> Bool
/= :: NewConv -> NewConv -> Bool
Eq, Int -> NewConv -> ShowS
[NewConv] -> ShowS
NewConv -> String
(Int -> NewConv -> ShowS)
-> (NewConv -> String) -> ([NewConv] -> ShowS) -> Show NewConv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewConv -> ShowS
showsPrec :: Int -> NewConv -> ShowS
$cshow :: NewConv -> String
show :: NewConv -> String
$cshowList :: [NewConv] -> ShowS
showList :: [NewConv] -> ShowS
Show, (forall x. NewConv -> Rep NewConv x)
-> (forall x. Rep NewConv x -> NewConv) -> Generic NewConv
forall x. Rep NewConv x -> NewConv
forall x. NewConv -> Rep NewConv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewConv -> Rep NewConv x
from :: forall x. NewConv -> Rep NewConv x
$cto :: forall x. Rep NewConv x -> NewConv
to :: forall x. Rep NewConv x -> NewConv
Generic)
  deriving (Gen NewConv
Gen NewConv -> (NewConv -> [NewConv]) -> Arbitrary NewConv
NewConv -> [NewConv]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewConv
arbitrary :: Gen NewConv
$cshrink :: NewConv -> [NewConv]
shrink :: NewConv -> [NewConv]
Arbitrary) via (GenericUniform NewConv)
  deriving (Value -> Parser [NewConv]
Value -> Parser NewConv
(Value -> Parser NewConv)
-> (Value -> Parser [NewConv]) -> FromJSON NewConv
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewConv
parseJSON :: Value -> Parser NewConv
$cparseJSONList :: Value -> Parser [NewConv]
parseJSONList :: Value -> Parser [NewConv]
FromJSON, [NewConv] -> Value
[NewConv] -> Encoding
NewConv -> Value
NewConv -> Encoding
(NewConv -> Value)
-> (NewConv -> Encoding)
-> ([NewConv] -> Value)
-> ([NewConv] -> Encoding)
-> ToJSON NewConv
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewConv -> Value
toJSON :: NewConv -> Value
$ctoEncoding :: NewConv -> Encoding
toEncoding :: NewConv -> Encoding
$ctoJSONList :: [NewConv] -> Value
toJSONList :: [NewConv] -> Value
$ctoEncodingList :: [NewConv] -> Encoding
toEncodingList :: [NewConv] -> Encoding
ToJSON, Typeable NewConv
Typeable NewConv =>
(Proxy NewConv -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewConv
Proxy NewConv -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewConv -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewConv -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema NewConv)

instance ToSchema NewConv where
  schema :: ValueSchema NamedSwaggerDoc NewConv
schema =
    Maybe Version
-> ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
-> ValueSchema NamedSwaggerDoc NewConv
newConvSchema Maybe Version
forall a. Maybe a
Nothing (ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
 -> ValueSchema NamedSwaggerDoc NewConv)
-> ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
-> ValueSchema NamedSwaggerDoc NewConv
forall a b. (a -> b) -> a -> b
$
      SchemaP
  SwaggerDoc Object [Pair] (Set AccessRole) (Maybe (Set AccessRole))
-> ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP SwaggerDoc Value Value (Set AccessRole) (Set AccessRole)
-> SchemaP
     SwaggerDoc Object [Pair] (Set AccessRole) (Maybe (Set AccessRole))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"access_role" (ValueSchema NamedSwaggerDoc AccessRole
-> SchemaP SwaggerDoc Value Value (Set AccessRole) (Set AccessRole)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc AccessRole
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))

instance ToSchema (Versioned 'V2 NewConv) where
  schema :: ValueSchema NamedSwaggerDoc (Versioned 'V2 NewConv)
schema = NewConv -> Versioned 'V2 NewConv
forall (v :: Version) a. a -> Versioned v a
Versioned (NewConv -> Versioned 'V2 NewConv)
-> SchemaP
     NamedSwaggerDoc Value Value (Versioned 'V2 NewConv) NewConv
-> ValueSchema NamedSwaggerDoc (Versioned 'V2 NewConv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned 'V2 NewConv -> NewConv
forall (v :: Version) a. Versioned v a -> a
unVersioned (Versioned 'V2 NewConv -> NewConv)
-> ValueSchema NamedSwaggerDoc NewConv
-> SchemaP
     NamedSwaggerDoc Value Value (Versioned 'V2 NewConv) NewConv
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version
-> ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
-> ValueSchema NamedSwaggerDoc NewConv
newConvSchema (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
V2) ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
accessRolesSchemaOptV2

newConvSchema ::
  Maybe Version ->
  ObjectSchema SwaggerDoc (Maybe (Set AccessRole)) ->
  ValueSchema NamedSwaggerDoc NewConv
newConvSchema :: Maybe Version
-> ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
-> ValueSchema NamedSwaggerDoc NewConv
newConvSchema Maybe Version
v ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
sch =
  Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc NewConv
-> ValueSchema NamedSwaggerDoc NewConv
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
    (Text
"NewConv" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Version -> Text) -> Maybe Version -> Text
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text
Text.toUpper (Text -> Text) -> (Version -> Text) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
versionText) Maybe Version
v)
    ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"JSON object to create a new conversation. When using 'qualified_users' (preferred), you can omit 'users'")
    (ObjectSchema SwaggerDoc NewConv
 -> ValueSchema NamedSwaggerDoc NewConv)
-> ObjectSchema SwaggerDoc NewConv
-> ValueSchema NamedSwaggerDoc NewConv
forall a b. (a -> b) -> a -> b
$ [UserId]
-> [Qualified UserId]
-> Maybe (Range 1 256 Text)
-> Set Access
-> Maybe (Set AccessRole)
-> Maybe ConvTeamInfo
-> Maybe Milliseconds
-> Maybe ReceiptMode
-> RoleName
-> BaseProtocolTag
-> NewConv
NewConv
      ([UserId]
 -> [Qualified UserId]
 -> Maybe (Range 1 256 Text)
 -> Set Access
 -> Maybe (Set AccessRole)
 -> Maybe ConvTeamInfo
 -> Maybe Milliseconds
 -> Maybe ReceiptMode
 -> RoleName
 -> BaseProtocolTag
 -> NewConv)
-> SchemaP SwaggerDoc Object [Pair] NewConv [UserId]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewConv
     ([Qualified UserId]
      -> Maybe (Range 1 256 Text)
      -> Set Access
      -> Maybe (Set AccessRole)
      -> Maybe ConvTeamInfo
      -> Maybe Milliseconds
      -> Maybe ReceiptMode
      -> RoleName
      -> BaseProtocolTag
      -> NewConv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewConv -> [UserId]
newConvUsers
        (NewConv -> [UserId])
-> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] NewConv [UserId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ( Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
               Text
"users"
               ( ((Maybe Bool -> Identity (Maybe Bool))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDeprecated s a => Lens' s a
Lens' SwaggerDoc (Maybe Bool)
S.deprecated ((Maybe Bool -> Identity (Maybe Bool))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Bool -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True)
                   (SwaggerDoc -> SwaggerDoc)
-> (SwaggerDoc -> SwaggerDoc) -> SwaggerDoc -> SwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
usersDesc)
               )
               (SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
               SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
forall a.
SchemaP SwaggerDoc Object [Pair] [UserId] a
-> SchemaP SwaggerDoc Object [Pair] [UserId] a
-> SchemaP SwaggerDoc Object [Pair] [UserId] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [UserId] -> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
forall a. a -> SchemaP SwaggerDoc Object [Pair] [UserId] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
           )
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewConv
  ([Qualified UserId]
   -> Maybe (Range 1 256 Text)
   -> Set Access
   -> Maybe (Set AccessRole)
   -> Maybe ConvTeamInfo
   -> Maybe Milliseconds
   -> Maybe ReceiptMode
   -> RoleName
   -> BaseProtocolTag
   -> NewConv)
-> SchemaP SwaggerDoc Object [Pair] NewConv [Qualified UserId]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewConv
     (Maybe (Range 1 256 Text)
      -> Set Access
      -> Maybe (Set AccessRole)
      -> Maybe ConvTeamInfo
      -> Maybe Milliseconds
      -> Maybe ReceiptMode
      -> RoleName
      -> BaseProtocolTag
      -> NewConv)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewConv (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewConv a
-> SchemaP SwaggerDoc Object [Pair] NewConv b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewConv -> [Qualified UserId]
newConvQualifiedUsers
        (NewConv -> [Qualified UserId])
-> SchemaP
     SwaggerDoc Object [Pair] [Qualified UserId] [Qualified UserId]
-> SchemaP SwaggerDoc Object [Pair] NewConv [Qualified UserId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ( Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP
     SwaggerDoc Value Value [Qualified UserId] [Qualified UserId]
-> SchemaP
     SwaggerDoc Object [Pair] [Qualified UserId] [Qualified UserId]
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
               Text
"qualified_users"
               ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
qualifiedUsersDesc)
               (ValueSchema NamedSwaggerDoc (Qualified UserId)
-> SchemaP
     SwaggerDoc Value Value [Qualified UserId] [Qualified UserId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
               SchemaP
  SwaggerDoc Object [Pair] [Qualified UserId] [Qualified UserId]
-> SchemaP
     SwaggerDoc Object [Pair] [Qualified UserId] [Qualified UserId]
-> SchemaP
     SwaggerDoc Object [Pair] [Qualified UserId] [Qualified UserId]
forall a.
SchemaP SwaggerDoc Object [Pair] [Qualified UserId] a
-> SchemaP SwaggerDoc Object [Pair] [Qualified UserId] a
-> SchemaP SwaggerDoc Object [Pair] [Qualified UserId] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Qualified UserId]
-> SchemaP
     SwaggerDoc Object [Pair] [Qualified UserId] [Qualified UserId]
forall a.
a -> SchemaP SwaggerDoc Object [Pair] [Qualified UserId] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
           )
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewConv
  (Maybe (Range 1 256 Text)
   -> Set Access
   -> Maybe (Set AccessRole)
   -> Maybe ConvTeamInfo
   -> Maybe Milliseconds
   -> Maybe ReceiptMode
   -> RoleName
   -> BaseProtocolTag
   -> NewConv)
-> SchemaP
     SwaggerDoc Object [Pair] NewConv (Maybe (Range 1 256 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewConv
     (Set Access
      -> Maybe (Set AccessRole)
      -> Maybe ConvTeamInfo
      -> Maybe Milliseconds
      -> Maybe ReceiptMode
      -> RoleName
      -> BaseProtocolTag
      -> NewConv)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewConv (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewConv a
-> SchemaP SwaggerDoc Object [Pair] NewConv b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewConv -> Maybe (Range 1 256 Text)
newConvName (NewConv -> Maybe (Range 1 256 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 256 Text))
     (Maybe (Range 1 256 Text))
-> SchemaP
     SwaggerDoc Object [Pair] NewConv (Maybe (Range 1 256 Text))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Range 1 256 Text)
  (Maybe (Range 1 256 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 256 Text))
     (Maybe (Range 1 256 Text))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value (Range 1 256 Text) (Range 1 256 Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Range 1 256 Text)
     (Maybe (Range 1 256 Text))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"name" SchemaP
  NamedSwaggerDoc Value Value (Range 1 256 Text) (Range 1 256 Text)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewConv
  (Set Access
   -> Maybe (Set AccessRole)
   -> Maybe ConvTeamInfo
   -> Maybe Milliseconds
   -> Maybe ReceiptMode
   -> RoleName
   -> BaseProtocolTag
   -> NewConv)
-> SchemaP SwaggerDoc Object [Pair] NewConv (Set Access)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewConv
     (Maybe (Set AccessRole)
      -> Maybe ConvTeamInfo
      -> Maybe Milliseconds
      -> Maybe ReceiptMode
      -> RoleName
      -> BaseProtocolTag
      -> NewConv)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewConv (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewConv a
-> SchemaP SwaggerDoc Object [Pair] NewConv b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set Access -> [Access]
forall a. Set a -> [a]
Set.toList (Set Access -> [Access])
-> (NewConv -> Set Access) -> NewConv -> [Access]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewConv -> Set Access
newConvAccess)
        (NewConv -> [Access])
-> SchemaP SwaggerDoc Object [Pair] [Access] (Set Access)
-> SchemaP SwaggerDoc Object [Pair] NewConv (Set Access)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Set Access -> Maybe (Set Access) -> Set Access
forall a. a -> Maybe a -> a
fromMaybe Set Access
forall a. Monoid a => a
mempty (Maybe (Set Access) -> Set Access)
-> SchemaP SwaggerDoc Object [Pair] [Access] (Maybe (Set Access))
-> SchemaP SwaggerDoc Object [Pair] [Access] (Set Access)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP SwaggerDoc Value Value [Access] (Set Access)
-> SchemaP SwaggerDoc Object [Pair] [Access] (Maybe (Set Access))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"access" ([Access] -> Set Access
forall a. Ord a => [a] -> Set a
Set.fromList ([Access] -> Set Access)
-> SchemaP SwaggerDoc Value Value [Access] [Access]
-> SchemaP SwaggerDoc Value Value [Access] (Set Access)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSchema NamedSwaggerDoc Access
-> SchemaP SwaggerDoc Value Value [Access] [Access]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Access
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewConv
  (Maybe (Set AccessRole)
   -> Maybe ConvTeamInfo
   -> Maybe Milliseconds
   -> Maybe ReceiptMode
   -> RoleName
   -> BaseProtocolTag
   -> NewConv)
-> SchemaP
     SwaggerDoc Object [Pair] NewConv (Maybe (Set AccessRole))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewConv
     (Maybe ConvTeamInfo
      -> Maybe Milliseconds
      -> Maybe ReceiptMode
      -> RoleName
      -> BaseProtocolTag
      -> NewConv)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewConv (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewConv a
-> SchemaP SwaggerDoc Object [Pair] NewConv b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewConv -> Maybe (Set AccessRole)
newConvAccessRoles (NewConv -> Maybe (Set AccessRole))
-> ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
-> SchemaP
     SwaggerDoc Object [Pair] NewConv (Maybe (Set AccessRole))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ObjectSchema SwaggerDoc (Maybe (Set AccessRole))
sch
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewConv
  (Maybe ConvTeamInfo
   -> Maybe Milliseconds
   -> Maybe ReceiptMode
   -> RoleName
   -> BaseProtocolTag
   -> NewConv)
-> SchemaP SwaggerDoc Object [Pair] NewConv (Maybe ConvTeamInfo)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewConv
     (Maybe Milliseconds
      -> Maybe ReceiptMode -> RoleName -> BaseProtocolTag -> NewConv)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewConv (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewConv a
-> SchemaP SwaggerDoc Object [Pair] NewConv b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewConv -> Maybe ConvTeamInfo
newConvTeam
        (NewConv -> Maybe ConvTeamInfo)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ConvTeamInfo) (Maybe ConvTeamInfo)
-> SchemaP SwaggerDoc Object [Pair] NewConv (Maybe ConvTeamInfo)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ConvTeamInfo (Maybe ConvTeamInfo)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ConvTeamInfo) (Maybe ConvTeamInfo)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_
          ( Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value ConvTeamInfo ConvTeamInfo
-> SchemaP
     SwaggerDoc Object [Pair] ConvTeamInfo (Maybe ConvTeamInfo)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier
              Text
"team"
              ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Team information of this conversation")
              SchemaP NamedSwaggerDoc Value Value ConvTeamInfo ConvTeamInfo
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
          )
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewConv
  (Maybe Milliseconds
   -> Maybe ReceiptMode -> RoleName -> BaseProtocolTag -> NewConv)
-> SchemaP SwaggerDoc Object [Pair] NewConv (Maybe Milliseconds)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewConv
     (Maybe ReceiptMode -> RoleName -> BaseProtocolTag -> NewConv)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewConv (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewConv a
-> SchemaP SwaggerDoc Object [Pair] NewConv b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewConv -> Maybe Milliseconds
newConvMessageTimer
        (NewConv -> Maybe Milliseconds)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe Milliseconds) (Maybe Milliseconds)
-> SchemaP SwaggerDoc Object [Pair] NewConv (Maybe Milliseconds)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Milliseconds (Maybe Milliseconds)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe Milliseconds) (Maybe Milliseconds)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_
          ( Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Milliseconds Milliseconds
-> SchemaP
     SwaggerDoc Object [Pair] Milliseconds (Maybe Milliseconds)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier
              Text
"message_timer"
              ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Per-conversation message timer")
              SchemaP NamedSwaggerDoc Value Value Milliseconds Milliseconds
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
          )
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewConv
  (Maybe ReceiptMode -> RoleName -> BaseProtocolTag -> NewConv)
-> SchemaP SwaggerDoc Object [Pair] NewConv (Maybe ReceiptMode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewConv
     (RoleName -> BaseProtocolTag -> NewConv)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewConv (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewConv a
-> SchemaP SwaggerDoc Object [Pair] NewConv b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewConv -> Maybe ReceiptMode
newConvReceiptMode (NewConv -> Maybe ReceiptMode)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ReceiptMode) (Maybe ReceiptMode)
-> SchemaP SwaggerDoc Object [Pair] NewConv (Maybe ReceiptMode)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ReceiptMode (Maybe ReceiptMode)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ReceiptMode) (Maybe ReceiptMode)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
-> SchemaP SwaggerDoc Object [Pair] ReceiptMode (Maybe ReceiptMode)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"receipt_mode" SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewConv
  (RoleName -> BaseProtocolTag -> NewConv)
-> SchemaP SwaggerDoc Object [Pair] NewConv RoleName
-> SchemaP
     SwaggerDoc Object [Pair] NewConv (BaseProtocolTag -> NewConv)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewConv (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewConv a
-> SchemaP SwaggerDoc Object [Pair] NewConv b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewConv -> RoleName
newConvUsersRole
        (NewConv -> RoleName)
-> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
-> SchemaP SwaggerDoc Object [Pair] NewConv RoleName
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ( Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value RoleName RoleName
-> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"conversation_role" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
usersRoleDesc) SchemaP NamedSwaggerDoc Value Value RoleName RoleName
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
               SchemaP SwaggerDoc Object [Pair] RoleName RoleName
-> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
-> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
forall a.
SchemaP SwaggerDoc Object [Pair] RoleName a
-> SchemaP SwaggerDoc Object [Pair] RoleName a
-> SchemaP SwaggerDoc Object [Pair] RoleName a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RoleName -> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
forall a. a -> SchemaP SwaggerDoc Object [Pair] RoleName a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RoleName
roleNameWireAdmin
           )
      SchemaP
  SwaggerDoc Object [Pair] NewConv (BaseProtocolTag -> NewConv)
-> SchemaP SwaggerDoc Object [Pair] NewConv BaseProtocolTag
-> ObjectSchema SwaggerDoc NewConv
forall a b.
SchemaP SwaggerDoc Object [Pair] NewConv (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewConv a
-> SchemaP SwaggerDoc Object [Pair] NewConv b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewConv -> BaseProtocolTag
newConvProtocol
        (NewConv -> BaseProtocolTag)
-> SchemaP SwaggerDoc Object [Pair] BaseProtocolTag BaseProtocolTag
-> SchemaP SwaggerDoc Object [Pair] NewConv BaseProtocolTag
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Maybe BaseProtocolTag -> BaseProtocolTag)
-> SchemaP
     SwaggerDoc Object [Pair] BaseProtocolTag (Maybe BaseProtocolTag)
-> SchemaP SwaggerDoc Object [Pair] BaseProtocolTag BaseProtocolTag
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] BaseProtocolTag a
-> SchemaP SwaggerDoc Object [Pair] BaseProtocolTag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (BaseProtocolTag -> Maybe BaseProtocolTag -> BaseProtocolTag
forall a. a -> Maybe a -> a
fromMaybe BaseProtocolTag
BaseProtocolProteusTag)
          (Text
-> SchemaP
     NamedSwaggerDoc Value Value BaseProtocolTag BaseProtocolTag
-> SchemaP
     SwaggerDoc Object [Pair] BaseProtocolTag (Maybe BaseProtocolTag)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"protocol" SchemaP NamedSwaggerDoc Value Value BaseProtocolTag BaseProtocolTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
  where
    usersDesc :: Text
usersDesc =
      Text
"List of user IDs (excluding the requestor) to be \
      \part of this conversation (deprecated)"
    qualifiedUsersDesc :: Text
qualifiedUsersDesc =
      Text
"List of qualified user IDs (excluding the requestor) \
      \to be part of this conversation"
    usersRoleDesc :: Text
    usersRoleDesc :: Text
usersRoleDesc =
      String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String
"The conversation permissions the users \
        \added in this request should have. \
        \Optional, defaults to '"
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> RoleName -> String
forall a. Show a => a -> String
show RoleName
roleNameWireAdmin
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' if unset."

newtype ConvTeamInfo = ConvTeamInfo
  { ConvTeamInfo -> TeamId
cnvTeamId :: TeamId
  }
  deriving stock (ConvTeamInfo -> ConvTeamInfo -> Bool
(ConvTeamInfo -> ConvTeamInfo -> Bool)
-> (ConvTeamInfo -> ConvTeamInfo -> Bool) -> Eq ConvTeamInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConvTeamInfo -> ConvTeamInfo -> Bool
== :: ConvTeamInfo -> ConvTeamInfo -> Bool
$c/= :: ConvTeamInfo -> ConvTeamInfo -> Bool
/= :: ConvTeamInfo -> ConvTeamInfo -> Bool
Eq, Int -> ConvTeamInfo -> ShowS
[ConvTeamInfo] -> ShowS
ConvTeamInfo -> String
(Int -> ConvTeamInfo -> ShowS)
-> (ConvTeamInfo -> String)
-> ([ConvTeamInfo] -> ShowS)
-> Show ConvTeamInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConvTeamInfo -> ShowS
showsPrec :: Int -> ConvTeamInfo -> ShowS
$cshow :: ConvTeamInfo -> String
show :: ConvTeamInfo -> String
$cshowList :: [ConvTeamInfo] -> ShowS
showList :: [ConvTeamInfo] -> ShowS
Show, (forall x. ConvTeamInfo -> Rep ConvTeamInfo x)
-> (forall x. Rep ConvTeamInfo x -> ConvTeamInfo)
-> Generic ConvTeamInfo
forall x. Rep ConvTeamInfo x -> ConvTeamInfo
forall x. ConvTeamInfo -> Rep ConvTeamInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConvTeamInfo -> Rep ConvTeamInfo x
from :: forall x. ConvTeamInfo -> Rep ConvTeamInfo x
$cto :: forall x. Rep ConvTeamInfo x -> ConvTeamInfo
to :: forall x. Rep ConvTeamInfo x -> ConvTeamInfo
Generic)
  deriving (Gen ConvTeamInfo
Gen ConvTeamInfo
-> (ConvTeamInfo -> [ConvTeamInfo]) -> Arbitrary ConvTeamInfo
ConvTeamInfo -> [ConvTeamInfo]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConvTeamInfo
arbitrary :: Gen ConvTeamInfo
$cshrink :: ConvTeamInfo -> [ConvTeamInfo]
shrink :: ConvTeamInfo -> [ConvTeamInfo]
Arbitrary) via (GenericUniform ConvTeamInfo)
  deriving (Value -> Parser [ConvTeamInfo]
Value -> Parser ConvTeamInfo
(Value -> Parser ConvTeamInfo)
-> (Value -> Parser [ConvTeamInfo]) -> FromJSON ConvTeamInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConvTeamInfo
parseJSON :: Value -> Parser ConvTeamInfo
$cparseJSONList :: Value -> Parser [ConvTeamInfo]
parseJSONList :: Value -> Parser [ConvTeamInfo]
FromJSON, [ConvTeamInfo] -> Value
[ConvTeamInfo] -> Encoding
ConvTeamInfo -> Value
ConvTeamInfo -> Encoding
(ConvTeamInfo -> Value)
-> (ConvTeamInfo -> Encoding)
-> ([ConvTeamInfo] -> Value)
-> ([ConvTeamInfo] -> Encoding)
-> ToJSON ConvTeamInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConvTeamInfo -> Value
toJSON :: ConvTeamInfo -> Value
$ctoEncoding :: ConvTeamInfo -> Encoding
toEncoding :: ConvTeamInfo -> Encoding
$ctoJSONList :: [ConvTeamInfo] -> Value
toJSONList :: [ConvTeamInfo] -> Value
$ctoEncodingList :: [ConvTeamInfo] -> Encoding
toEncodingList :: [ConvTeamInfo] -> Encoding
ToJSON, Typeable ConvTeamInfo
Typeable ConvTeamInfo =>
(Proxy ConvTeamInfo -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConvTeamInfo
Proxy ConvTeamInfo -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConvTeamInfo -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConvTeamInfo -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema ConvTeamInfo)

managedDesc :: Text
managedDesc :: Text
managedDesc =
  Text
"This field MUST NOT be used by clients. "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"It is here only for backwards compatibility of the interface."

instance ToSchema ConvTeamInfo where
  schema :: SchemaP NamedSwaggerDoc Value Value ConvTeamInfo ConvTeamInfo
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ConvTeamInfo
-> SchemaP NamedSwaggerDoc Value Value ConvTeamInfo ConvTeamInfo
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"ConvTeamInfo"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Team information")
      (ObjectSchema SwaggerDoc ConvTeamInfo
 -> SchemaP NamedSwaggerDoc Value Value ConvTeamInfo ConvTeamInfo)
-> ObjectSchema SwaggerDoc ConvTeamInfo
-> SchemaP NamedSwaggerDoc Value Value ConvTeamInfo ConvTeamInfo
forall a b. (a -> b) -> a -> b
$ TeamId -> ConvTeamInfo
ConvTeamInfo
        (TeamId -> ConvTeamInfo)
-> SchemaP SwaggerDoc Object [Pair] ConvTeamInfo TeamId
-> ObjectSchema SwaggerDoc ConvTeamInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConvTeamInfo -> TeamId
cnvTeamId (ConvTeamInfo -> TeamId)
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] ConvTeamInfo TeamId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"teamid" SchemaP NamedSwaggerDoc Value Value TeamId TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        ObjectSchema SwaggerDoc ConvTeamInfo
-> SchemaP SwaggerDoc Object [Pair] ConvTeamInfo ()
-> ObjectSchema SwaggerDoc ConvTeamInfo
forall a b.
SchemaP SwaggerDoc Object [Pair] ConvTeamInfo a
-> SchemaP SwaggerDoc Object [Pair] ConvTeamInfo b
-> SchemaP SwaggerDoc Object [Pair] ConvTeamInfo a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* () -> ConvTeamInfo -> ()
forall a b. a -> b -> a
const ()
          (ConvTeamInfo -> ())
-> SchemaP SwaggerDoc Object [Pair] () ()
-> SchemaP SwaggerDoc Object [Pair] ConvTeamInfo ()
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value () ()
-> SchemaP SwaggerDoc Object [Pair] () ()
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
            Text
"managed"
            ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
managedDesc)
            (Bool -> SchemaP SwaggerDoc Value Value () ()
forall a. ToJSON a => a -> SchemaP SwaggerDoc Value Value () ()
c (Bool
False :: Bool))
    where
      c :: (ToJSON a) => a -> ValueSchema SwaggerDoc ()
      c :: forall a. ToJSON a => a -> SchemaP SwaggerDoc Value Value () ()
c a
val = SwaggerDoc
-> (Value -> Parser ())
-> (() -> Maybe Value)
-> SchemaP SwaggerDoc Value Value () ()
forall doc v b a w.
doc -> (v -> Parser b) -> (a -> Maybe w) -> SchemaP doc v w a b
mkSchema SwaggerDoc
forall a. Monoid a => a
mempty (Parser () -> Value -> Parser ()
forall a b. a -> b -> a
const (() -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) (Maybe Value -> () -> Maybe Value
forall a b. a -> b -> a
const (Value -> Maybe Value
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
val)))

--------------------------------------------------------------------------------
-- invite

data Invite = Invite -- Deprecated, use InviteQualified (and maybe rename?)
  { Invite -> List1 UserId
invUsers :: List1 UserId,
    -- | This role name is to be applied to all users
    Invite -> RoleName
invRoleName :: RoleName
  }
  deriving stock (Invite -> Invite -> Bool
(Invite -> Invite -> Bool)
-> (Invite -> Invite -> Bool) -> Eq Invite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Invite -> Invite -> Bool
== :: Invite -> Invite -> Bool
$c/= :: Invite -> Invite -> Bool
/= :: Invite -> Invite -> Bool
Eq, Int -> Invite -> ShowS
[Invite] -> ShowS
Invite -> String
(Int -> Invite -> ShowS)
-> (Invite -> String) -> ([Invite] -> ShowS) -> Show Invite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Invite -> ShowS
showsPrec :: Int -> Invite -> ShowS
$cshow :: Invite -> String
show :: Invite -> String
$cshowList :: [Invite] -> ShowS
showList :: [Invite] -> ShowS
Show, (forall x. Invite -> Rep Invite x)
-> (forall x. Rep Invite x -> Invite) -> Generic Invite
forall x. Rep Invite x -> Invite
forall x. Invite -> Rep Invite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Invite -> Rep Invite x
from :: forall x. Invite -> Rep Invite x
$cto :: forall x. Rep Invite x -> Invite
to :: forall x. Rep Invite x -> Invite
Generic)
  deriving (Gen Invite
Gen Invite -> (Invite -> [Invite]) -> Arbitrary Invite
Invite -> [Invite]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Invite
arbitrary :: Gen Invite
$cshrink :: Invite -> [Invite]
shrink :: Invite -> [Invite]
Arbitrary) via (GenericUniform Invite)
  deriving (Value -> Parser [Invite]
Value -> Parser Invite
(Value -> Parser Invite)
-> (Value -> Parser [Invite]) -> FromJSON Invite
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Invite
parseJSON :: Value -> Parser Invite
$cparseJSONList :: Value -> Parser [Invite]
parseJSONList :: Value -> Parser [Invite]
FromJSON, [Invite] -> Value
[Invite] -> Encoding
Invite -> Value
Invite -> Encoding
(Invite -> Value)
-> (Invite -> Encoding)
-> ([Invite] -> Value)
-> ([Invite] -> Encoding)
-> ToJSON Invite
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Invite -> Value
toJSON :: Invite -> Value
$ctoEncoding :: Invite -> Encoding
toEncoding :: Invite -> Encoding
$ctoJSONList :: [Invite] -> Value
toJSONList :: [Invite] -> Value
$ctoEncodingList :: [Invite] -> Encoding
toEncodingList :: [Invite] -> Encoding
ToJSON, Typeable Invite
Typeable Invite =>
(Proxy Invite -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Invite
Proxy Invite -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Invite -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Invite -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Invite)

instance ToSchema Invite where
  schema :: ValueSchema NamedSwaggerDoc Invite
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Invite Invite
-> ValueSchema NamedSwaggerDoc Invite
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Invite" (SchemaP SwaggerDoc Object [Pair] Invite Invite
 -> ValueSchema NamedSwaggerDoc Invite)
-> SchemaP SwaggerDoc Object [Pair] Invite Invite
-> ValueSchema NamedSwaggerDoc Invite
forall a b. (a -> b) -> a -> b
$
      List1 UserId -> RoleName -> Invite
Invite
        (List1 UserId -> RoleName -> Invite)
-> SchemaP SwaggerDoc Object [Pair] Invite (List1 UserId)
-> SchemaP SwaggerDoc Object [Pair] Invite (RoleName -> Invite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (List1 UserId -> NonEmpty UserId
forall a. List1 a -> NonEmpty a
toNonEmpty (List1 UserId -> NonEmpty UserId)
-> (Invite -> List1 UserId) -> Invite -> NonEmpty UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Invite -> List1 UserId
invUsers)
          (Invite -> NonEmpty UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (NonEmpty UserId) (List1 UserId)
-> SchemaP SwaggerDoc Object [Pair] Invite (List1 UserId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (NonEmpty UserId -> List1 UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (NonEmpty UserId) (NonEmpty UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (NonEmpty UserId) (List1 UserId)
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] (NonEmpty UserId) a
-> SchemaP SwaggerDoc Object [Pair] (NonEmpty UserId) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty UserId -> List1 UserId
forall a. NonEmpty a -> List1 a
List1 (Text
-> SchemaP
     SwaggerDoc Value Value (NonEmpty UserId) (NonEmpty UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (NonEmpty UserId) (NonEmpty UserId)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"users" (SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP
     SwaggerDoc Value Value (NonEmpty UserId) (NonEmpty UserId)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc,
 HasMinItems doc (Maybe Integer)) =>
ValueSchema ndoc a -> ValueSchema doc (NonEmpty a)
nonEmptyArray SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP SwaggerDoc Object [Pair] Invite (RoleName -> Invite)
-> SchemaP SwaggerDoc Object [Pair] Invite RoleName
-> SchemaP SwaggerDoc Object [Pair] Invite Invite
forall a b.
SchemaP SwaggerDoc Object [Pair] Invite (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Invite a
-> SchemaP SwaggerDoc Object [Pair] Invite b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Invite -> RoleName
invRoleName
          (Invite -> RoleName)
-> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
-> SchemaP SwaggerDoc Object [Pair] Invite RoleName
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (RoleName -> Maybe RoleName -> RoleName
forall a. a -> Maybe a -> a
fromMaybe RoleName
roleNameWireAdmin (Maybe RoleName -> RoleName)
-> SchemaP SwaggerDoc Object [Pair] RoleName (Maybe RoleName)
-> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP NamedSwaggerDoc Value Value RoleName RoleName
-> SchemaP SwaggerDoc Object [Pair] RoleName (Maybe RoleName)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"conversation_role" SchemaP NamedSwaggerDoc Value Value RoleName RoleName
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

data InviteQualified = InviteQualified
  { InviteQualified -> NonEmpty (Qualified UserId)
invQUsers :: NonEmpty (Qualified UserId),
    -- | This role name is to be applied to all users
    InviteQualified -> RoleName
invQRoleName :: RoleName
  }
  deriving stock (InviteQualified -> InviteQualified -> Bool
(InviteQualified -> InviteQualified -> Bool)
-> (InviteQualified -> InviteQualified -> Bool)
-> Eq InviteQualified
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InviteQualified -> InviteQualified -> Bool
== :: InviteQualified -> InviteQualified -> Bool
$c/= :: InviteQualified -> InviteQualified -> Bool
/= :: InviteQualified -> InviteQualified -> Bool
Eq, Int -> InviteQualified -> ShowS
[InviteQualified] -> ShowS
InviteQualified -> String
(Int -> InviteQualified -> ShowS)
-> (InviteQualified -> String)
-> ([InviteQualified] -> ShowS)
-> Show InviteQualified
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InviteQualified -> ShowS
showsPrec :: Int -> InviteQualified -> ShowS
$cshow :: InviteQualified -> String
show :: InviteQualified -> String
$cshowList :: [InviteQualified] -> ShowS
showList :: [InviteQualified] -> ShowS
Show, (forall x. InviteQualified -> Rep InviteQualified x)
-> (forall x. Rep InviteQualified x -> InviteQualified)
-> Generic InviteQualified
forall x. Rep InviteQualified x -> InviteQualified
forall x. InviteQualified -> Rep InviteQualified x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InviteQualified -> Rep InviteQualified x
from :: forall x. InviteQualified -> Rep InviteQualified x
$cto :: forall x. Rep InviteQualified x -> InviteQualified
to :: forall x. Rep InviteQualified x -> InviteQualified
Generic)
  deriving (Gen InviteQualified
Gen InviteQualified
-> (InviteQualified -> [InviteQualified])
-> Arbitrary InviteQualified
InviteQualified -> [InviteQualified]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen InviteQualified
arbitrary :: Gen InviteQualified
$cshrink :: InviteQualified -> [InviteQualified]
shrink :: InviteQualified -> [InviteQualified]
Arbitrary) via (GenericUniform InviteQualified)
  deriving ([InviteQualified] -> Value
[InviteQualified] -> Encoding
InviteQualified -> Value
InviteQualified -> Encoding
(InviteQualified -> Value)
-> (InviteQualified -> Encoding)
-> ([InviteQualified] -> Value)
-> ([InviteQualified] -> Encoding)
-> ToJSON InviteQualified
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: InviteQualified -> Value
toJSON :: InviteQualified -> Value
$ctoEncoding :: InviteQualified -> Encoding
toEncoding :: InviteQualified -> Encoding
$ctoJSONList :: [InviteQualified] -> Value
toJSONList :: [InviteQualified] -> Value
$ctoEncodingList :: [InviteQualified] -> Encoding
toEncodingList :: [InviteQualified] -> Encoding
ToJSON, Value -> Parser [InviteQualified]
Value -> Parser InviteQualified
(Value -> Parser InviteQualified)
-> (Value -> Parser [InviteQualified]) -> FromJSON InviteQualified
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser InviteQualified
parseJSON :: Value -> Parser InviteQualified
$cparseJSONList :: Value -> Parser [InviteQualified]
parseJSONList :: Value -> Parser [InviteQualified]
FromJSON, Typeable InviteQualified
Typeable InviteQualified =>
(Proxy InviteQualified -> Declare (Definitions Schema) NamedSchema)
-> ToSchema InviteQualified
Proxy InviteQualified -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy InviteQualified -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy InviteQualified -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema InviteQualified)

instance ToSchema InviteQualified where
  schema :: ValueSchema NamedSwaggerDoc InviteQualified
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] InviteQualified InviteQualified
-> ValueSchema NamedSwaggerDoc InviteQualified
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"InviteQualified" (SchemaP SwaggerDoc Object [Pair] InviteQualified InviteQualified
 -> ValueSchema NamedSwaggerDoc InviteQualified)
-> SchemaP SwaggerDoc Object [Pair] InviteQualified InviteQualified
-> ValueSchema NamedSwaggerDoc InviteQualified
forall a b. (a -> b) -> a -> b
$
      NonEmpty (Qualified UserId) -> RoleName -> InviteQualified
InviteQualified
        (NonEmpty (Qualified UserId) -> RoleName -> InviteQualified)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     InviteQualified
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     InviteQualified
     (RoleName -> InviteQualified)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InviteQualified -> NonEmpty (Qualified UserId)
invQUsers (InviteQualified -> NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     InviteQualified
     (NonEmpty (Qualified UserId))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"qualified_users" (ValueSchema NamedSwaggerDoc (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc,
 HasMinItems doc (Maybe Integer)) =>
ValueSchema ndoc a -> ValueSchema doc (NonEmpty a)
nonEmptyArray ValueSchema NamedSwaggerDoc (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  InviteQualified
  (RoleName -> InviteQualified)
-> SchemaP SwaggerDoc Object [Pair] InviteQualified RoleName
-> SchemaP SwaggerDoc Object [Pair] InviteQualified InviteQualified
forall a b.
SchemaP SwaggerDoc Object [Pair] InviteQualified (a -> b)
-> SchemaP SwaggerDoc Object [Pair] InviteQualified a
-> SchemaP SwaggerDoc Object [Pair] InviteQualified b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InviteQualified -> RoleName
invQRoleName
          (InviteQualified -> RoleName)
-> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
-> SchemaP SwaggerDoc Object [Pair] InviteQualified RoleName
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (RoleName -> Maybe RoleName -> RoleName
forall a. a -> Maybe a -> a
fromMaybe RoleName
roleNameWireAdmin (Maybe RoleName -> RoleName)
-> SchemaP SwaggerDoc Object [Pair] RoleName (Maybe RoleName)
-> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP NamedSwaggerDoc Value Value RoleName RoleName
-> SchemaP SwaggerDoc Object [Pair] RoleName (Maybe RoleName)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"conversation_role" SchemaP NamedSwaggerDoc Value Value RoleName RoleName
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- update

newtype ConversationRename = ConversationRename
  { ConversationRename -> Text
cupName :: Text
  }
  deriving stock (ConversationRename -> ConversationRename -> Bool
(ConversationRename -> ConversationRename -> Bool)
-> (ConversationRename -> ConversationRename -> Bool)
-> Eq ConversationRename
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationRename -> ConversationRename -> Bool
== :: ConversationRename -> ConversationRename -> Bool
$c/= :: ConversationRename -> ConversationRename -> Bool
/= :: ConversationRename -> ConversationRename -> Bool
Eq, Int -> ConversationRename -> ShowS
[ConversationRename] -> ShowS
ConversationRename -> String
(Int -> ConversationRename -> ShowS)
-> (ConversationRename -> String)
-> ([ConversationRename] -> ShowS)
-> Show ConversationRename
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationRename -> ShowS
showsPrec :: Int -> ConversationRename -> ShowS
$cshow :: ConversationRename -> String
show :: ConversationRename -> String
$cshowList :: [ConversationRename] -> ShowS
showList :: [ConversationRename] -> ShowS
Show)
  deriving newtype (Gen ConversationRename
Gen ConversationRename
-> (ConversationRename -> [ConversationRename])
-> Arbitrary ConversationRename
ConversationRename -> [ConversationRename]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationRename
arbitrary :: Gen ConversationRename
$cshrink :: ConversationRename -> [ConversationRename]
shrink :: ConversationRename -> [ConversationRename]
Arbitrary)
  deriving (Typeable ConversationRename
Typeable ConversationRename =>
(Proxy ConversationRename
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationRename
Proxy ConversationRename
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationRename
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationRename
-> Declare (Definitions Schema) NamedSchema
S.ToSchema, [ConversationRename] -> Value
[ConversationRename] -> Encoding
ConversationRename -> Value
ConversationRename -> Encoding
(ConversationRename -> Value)
-> (ConversationRename -> Encoding)
-> ([ConversationRename] -> Value)
-> ([ConversationRename] -> Encoding)
-> ToJSON ConversationRename
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationRename -> Value
toJSON :: ConversationRename -> Value
$ctoEncoding :: ConversationRename -> Encoding
toEncoding :: ConversationRename -> Encoding
$ctoJSONList :: [ConversationRename] -> Value
toJSONList :: [ConversationRename] -> Value
$ctoEncodingList :: [ConversationRename] -> Encoding
toEncodingList :: [ConversationRename] -> Encoding
ToJSON, Value -> Parser [ConversationRename]
Value -> Parser ConversationRename
(Value -> Parser ConversationRename)
-> (Value -> Parser [ConversationRename])
-> FromJSON ConversationRename
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationRename
parseJSON :: Value -> Parser ConversationRename
$cparseJSONList :: Value -> Parser [ConversationRename]
parseJSONList :: Value -> Parser [ConversationRename]
FromJSON) via Schema ConversationRename

instance ToSchema ConversationRename where
  schema :: ValueSchema NamedSwaggerDoc ConversationRename
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] ConversationRename ConversationRename
-> ValueSchema NamedSwaggerDoc ConversationRename
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ConversationRename" (SchemaP
   SwaggerDoc Object [Pair] ConversationRename ConversationRename
 -> ValueSchema NamedSwaggerDoc ConversationRename)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationRename ConversationRename
-> ValueSchema NamedSwaggerDoc ConversationRename
forall a b. (a -> b) -> a -> b
$
      Text -> ConversationRename
ConversationRename
        (Text -> ConversationRename)
-> SchemaP SwaggerDoc Object [Pair] ConversationRename Text
-> SchemaP
     SwaggerDoc Object [Pair] ConversationRename ConversationRename
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationRename -> Text
cupName
          (ConversationRename -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] ConversationRename Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
            Text
"name"
            ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
desc)
            (SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Value Value Text Text
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed (forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema @Text))
    where
      desc :: Text
desc = Text
"The new conversation name"

data ConversationAccessData = ConversationAccessData
  { ConversationAccessData -> Set Access
cupAccess :: Set Access,
    ConversationAccessData -> Set AccessRole
cupAccessRoles :: Set AccessRole
  }
  deriving stock (ConversationAccessData -> ConversationAccessData -> Bool
(ConversationAccessData -> ConversationAccessData -> Bool)
-> (ConversationAccessData -> ConversationAccessData -> Bool)
-> Eq ConversationAccessData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationAccessData -> ConversationAccessData -> Bool
== :: ConversationAccessData -> ConversationAccessData -> Bool
$c/= :: ConversationAccessData -> ConversationAccessData -> Bool
/= :: ConversationAccessData -> ConversationAccessData -> Bool
Eq, Int -> ConversationAccessData -> ShowS
[ConversationAccessData] -> ShowS
ConversationAccessData -> String
(Int -> ConversationAccessData -> ShowS)
-> (ConversationAccessData -> String)
-> ([ConversationAccessData] -> ShowS)
-> Show ConversationAccessData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationAccessData -> ShowS
showsPrec :: Int -> ConversationAccessData -> ShowS
$cshow :: ConversationAccessData -> String
show :: ConversationAccessData -> String
$cshowList :: [ConversationAccessData] -> ShowS
showList :: [ConversationAccessData] -> ShowS
Show, (forall x. ConversationAccessData -> Rep ConversationAccessData x)
-> (forall x.
    Rep ConversationAccessData x -> ConversationAccessData)
-> Generic ConversationAccessData
forall x. Rep ConversationAccessData x -> ConversationAccessData
forall x. ConversationAccessData -> Rep ConversationAccessData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConversationAccessData -> Rep ConversationAccessData x
from :: forall x. ConversationAccessData -> Rep ConversationAccessData x
$cto :: forall x. Rep ConversationAccessData x -> ConversationAccessData
to :: forall x. Rep ConversationAccessData x -> ConversationAccessData
Generic)
  deriving (Gen ConversationAccessData
Gen ConversationAccessData
-> (ConversationAccessData -> [ConversationAccessData])
-> Arbitrary ConversationAccessData
ConversationAccessData -> [ConversationAccessData]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationAccessData
arbitrary :: Gen ConversationAccessData
$cshrink :: ConversationAccessData -> [ConversationAccessData]
shrink :: ConversationAccessData -> [ConversationAccessData]
Arbitrary) via (GenericUniform ConversationAccessData)
  deriving (Value -> Parser [ConversationAccessData]
Value -> Parser ConversationAccessData
(Value -> Parser ConversationAccessData)
-> (Value -> Parser [ConversationAccessData])
-> FromJSON ConversationAccessData
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationAccessData
parseJSON :: Value -> Parser ConversationAccessData
$cparseJSONList :: Value -> Parser [ConversationAccessData]
parseJSONList :: Value -> Parser [ConversationAccessData]
FromJSON, [ConversationAccessData] -> Value
[ConversationAccessData] -> Encoding
ConversationAccessData -> Value
ConversationAccessData -> Encoding
(ConversationAccessData -> Value)
-> (ConversationAccessData -> Encoding)
-> ([ConversationAccessData] -> Value)
-> ([ConversationAccessData] -> Encoding)
-> ToJSON ConversationAccessData
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationAccessData -> Value
toJSON :: ConversationAccessData -> Value
$ctoEncoding :: ConversationAccessData -> Encoding
toEncoding :: ConversationAccessData -> Encoding
$ctoJSONList :: [ConversationAccessData] -> Value
toJSONList :: [ConversationAccessData] -> Value
$ctoEncodingList :: [ConversationAccessData] -> Encoding
toEncodingList :: [ConversationAccessData] -> Encoding
ToJSON, Typeable ConversationAccessData
Typeable ConversationAccessData =>
(Proxy ConversationAccessData
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationAccessData
Proxy ConversationAccessData
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationAccessData
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationAccessData
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ConversationAccessData

conversationAccessDataSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc ConversationAccessData
conversationAccessDataSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc ConversationAccessData
conversationAccessDataSchema Maybe Version
v =
  Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationAccessData
     ConversationAccessData
-> ValueSchema NamedSwaggerDoc ConversationAccessData
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object (Text
"ConversationAccessData" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Version -> Text) -> Maybe Version -> Text
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text
Text.toUpper (Text -> Text) -> (Version -> Text) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
versionText) Maybe Version
v) (SchemaP
   SwaggerDoc
   Object
   [Pair]
   ConversationAccessData
   ConversationAccessData
 -> ValueSchema NamedSwaggerDoc ConversationAccessData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationAccessData
     ConversationAccessData
-> ValueSchema NamedSwaggerDoc ConversationAccessData
forall a b. (a -> b) -> a -> b
$
    Set Access -> Set AccessRole -> ConversationAccessData
ConversationAccessData
      (Set Access -> Set AccessRole -> ConversationAccessData)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationAccessData (Set Access)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationAccessData
     (Set AccessRole -> ConversationAccessData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationAccessData -> Set Access
cupAccess (ConversationAccessData -> Set Access)
-> SchemaP SwaggerDoc Object [Pair] (Set Access) (Set Access)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationAccessData (Set Access)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value (Set Access) (Set Access)
-> SchemaP SwaggerDoc Object [Pair] (Set Access) (Set Access)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"access" (ValueSchema NamedSwaggerDoc Access
-> SchemaP SwaggerDoc Value Value (Set Access) (Set Access)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc Access
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationAccessData
  (Set AccessRole -> ConversationAccessData)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationAccessData (Set AccessRole)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationAccessData
     ConversationAccessData
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationAccessData (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationAccessData a
-> SchemaP SwaggerDoc Object [Pair] ConversationAccessData b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationAccessData -> Set AccessRole
cupAccessRoles (ConversationAccessData -> Set AccessRole)
-> ObjectSchema SwaggerDoc (Set AccessRole)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationAccessData (Set AccessRole)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version -> ObjectSchema SwaggerDoc (Set AccessRole)
accessRolesVersionedSchema Maybe Version
v

instance ToSchema ConversationAccessData where
  schema :: ValueSchema NamedSwaggerDoc ConversationAccessData
schema = Maybe Version -> ValueSchema NamedSwaggerDoc ConversationAccessData
conversationAccessDataSchema Maybe Version
forall a. Maybe a
Nothing

instance ToSchema (Versioned 'V2 ConversationAccessData) where
  schema :: ValueSchema NamedSwaggerDoc (Versioned 'V2 ConversationAccessData)
schema = ConversationAccessData -> Versioned 'V2 ConversationAccessData
forall (v :: Version) a. a -> Versioned v a
Versioned (ConversationAccessData -> Versioned 'V2 ConversationAccessData)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned 'V2 ConversationAccessData)
     ConversationAccessData
-> ValueSchema
     NamedSwaggerDoc (Versioned 'V2 ConversationAccessData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned 'V2 ConversationAccessData -> ConversationAccessData
forall (v :: Version) a. Versioned v a -> a
unVersioned (Versioned 'V2 ConversationAccessData -> ConversationAccessData)
-> ValueSchema NamedSwaggerDoc ConversationAccessData
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned 'V2 ConversationAccessData)
     ConversationAccessData
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version -> ValueSchema NamedSwaggerDoc ConversationAccessData
conversationAccessDataSchema (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
V2)

data ConversationReceiptModeUpdate = ConversationReceiptModeUpdate
  { ConversationReceiptModeUpdate -> ReceiptMode
cruReceiptMode :: ReceiptMode
  }
  deriving stock (ConversationReceiptModeUpdate
-> ConversationReceiptModeUpdate -> Bool
(ConversationReceiptModeUpdate
 -> ConversationReceiptModeUpdate -> Bool)
-> (ConversationReceiptModeUpdate
    -> ConversationReceiptModeUpdate -> Bool)
-> Eq ConversationReceiptModeUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationReceiptModeUpdate
-> ConversationReceiptModeUpdate -> Bool
== :: ConversationReceiptModeUpdate
-> ConversationReceiptModeUpdate -> Bool
$c/= :: ConversationReceiptModeUpdate
-> ConversationReceiptModeUpdate -> Bool
/= :: ConversationReceiptModeUpdate
-> ConversationReceiptModeUpdate -> Bool
Eq, Int -> ConversationReceiptModeUpdate -> ShowS
[ConversationReceiptModeUpdate] -> ShowS
ConversationReceiptModeUpdate -> String
(Int -> ConversationReceiptModeUpdate -> ShowS)
-> (ConversationReceiptModeUpdate -> String)
-> ([ConversationReceiptModeUpdate] -> ShowS)
-> Show ConversationReceiptModeUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationReceiptModeUpdate -> ShowS
showsPrec :: Int -> ConversationReceiptModeUpdate -> ShowS
$cshow :: ConversationReceiptModeUpdate -> String
show :: ConversationReceiptModeUpdate -> String
$cshowList :: [ConversationReceiptModeUpdate] -> ShowS
showList :: [ConversationReceiptModeUpdate] -> ShowS
Show, (forall x.
 ConversationReceiptModeUpdate
 -> Rep ConversationReceiptModeUpdate x)
-> (forall x.
    Rep ConversationReceiptModeUpdate x
    -> ConversationReceiptModeUpdate)
-> Generic ConversationReceiptModeUpdate
forall x.
Rep ConversationReceiptModeUpdate x
-> ConversationReceiptModeUpdate
forall x.
ConversationReceiptModeUpdate
-> Rep ConversationReceiptModeUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ConversationReceiptModeUpdate
-> Rep ConversationReceiptModeUpdate x
from :: forall x.
ConversationReceiptModeUpdate
-> Rep ConversationReceiptModeUpdate x
$cto :: forall x.
Rep ConversationReceiptModeUpdate x
-> ConversationReceiptModeUpdate
to :: forall x.
Rep ConversationReceiptModeUpdate x
-> ConversationReceiptModeUpdate
Generic)
  deriving (Gen ConversationReceiptModeUpdate
Gen ConversationReceiptModeUpdate
-> (ConversationReceiptModeUpdate
    -> [ConversationReceiptModeUpdate])
-> Arbitrary ConversationReceiptModeUpdate
ConversationReceiptModeUpdate -> [ConversationReceiptModeUpdate]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationReceiptModeUpdate
arbitrary :: Gen ConversationReceiptModeUpdate
$cshrink :: ConversationReceiptModeUpdate -> [ConversationReceiptModeUpdate]
shrink :: ConversationReceiptModeUpdate -> [ConversationReceiptModeUpdate]
Arbitrary) via (GenericUniform ConversationReceiptModeUpdate)
  deriving ([ConversationReceiptModeUpdate] -> Value
[ConversationReceiptModeUpdate] -> Encoding
ConversationReceiptModeUpdate -> Value
ConversationReceiptModeUpdate -> Encoding
(ConversationReceiptModeUpdate -> Value)
-> (ConversationReceiptModeUpdate -> Encoding)
-> ([ConversationReceiptModeUpdate] -> Value)
-> ([ConversationReceiptModeUpdate] -> Encoding)
-> ToJSON ConversationReceiptModeUpdate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationReceiptModeUpdate -> Value
toJSON :: ConversationReceiptModeUpdate -> Value
$ctoEncoding :: ConversationReceiptModeUpdate -> Encoding
toEncoding :: ConversationReceiptModeUpdate -> Encoding
$ctoJSONList :: [ConversationReceiptModeUpdate] -> Value
toJSONList :: [ConversationReceiptModeUpdate] -> Value
$ctoEncodingList :: [ConversationReceiptModeUpdate] -> Encoding
toEncodingList :: [ConversationReceiptModeUpdate] -> Encoding
ToJSON, Value -> Parser [ConversationReceiptModeUpdate]
Value -> Parser ConversationReceiptModeUpdate
(Value -> Parser ConversationReceiptModeUpdate)
-> (Value -> Parser [ConversationReceiptModeUpdate])
-> FromJSON ConversationReceiptModeUpdate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationReceiptModeUpdate
parseJSON :: Value -> Parser ConversationReceiptModeUpdate
$cparseJSONList :: Value -> Parser [ConversationReceiptModeUpdate]
parseJSONList :: Value -> Parser [ConversationReceiptModeUpdate]
FromJSON, Typeable ConversationReceiptModeUpdate
Typeable ConversationReceiptModeUpdate =>
(Proxy ConversationReceiptModeUpdate
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationReceiptModeUpdate
Proxy ConversationReceiptModeUpdate
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationReceiptModeUpdate
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationReceiptModeUpdate
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ConversationReceiptModeUpdate

instance ToSchema ConversationReceiptModeUpdate where
  schema :: ValueSchema NamedSwaggerDoc ConversationReceiptModeUpdate
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ConversationReceiptModeUpdate
-> ValueSchema NamedSwaggerDoc ConversationReceiptModeUpdate
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"ConversationReceiptModeUpdate" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
desc) (ObjectSchema SwaggerDoc ConversationReceiptModeUpdate
 -> ValueSchema NamedSwaggerDoc ConversationReceiptModeUpdate)
-> ObjectSchema SwaggerDoc ConversationReceiptModeUpdate
-> ValueSchema NamedSwaggerDoc ConversationReceiptModeUpdate
forall a b. (a -> b) -> a -> b
$
      ReceiptMode -> ConversationReceiptModeUpdate
ConversationReceiptModeUpdate
        (ReceiptMode -> ConversationReceiptModeUpdate)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationReceiptModeUpdate ReceiptMode
-> ObjectSchema SwaggerDoc ConversationReceiptModeUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationReceiptModeUpdate -> ReceiptMode
cruReceiptMode (ConversationReceiptModeUpdate -> ReceiptMode)
-> SchemaP SwaggerDoc Object [Pair] ReceiptMode ReceiptMode
-> SchemaP
     SwaggerDoc Object [Pair] ConversationReceiptModeUpdate ReceiptMode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value ReceiptMode ReceiptMode
-> SchemaP SwaggerDoc Object [Pair] ReceiptMode ReceiptMode
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"receipt_mode" (SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
-> SchemaP SwaggerDoc Value Value ReceiptMode ReceiptMode
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed SchemaP NamedSwaggerDoc Value Value ReceiptMode ReceiptMode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    where
      desc :: Text
desc =
        Text
"Contains conversation receipt mode to update to. Receipt mode tells \
        \clients whether certain types of receipts should be sent in the given \
        \conversation or not. How this value is interpreted is up to clients."

data ConversationMessageTimerUpdate = ConversationMessageTimerUpdate
  { -- | New message timer
    ConversationMessageTimerUpdate -> Maybe Milliseconds
cupMessageTimer :: Maybe Milliseconds
  }
  deriving stock (ConversationMessageTimerUpdate
-> ConversationMessageTimerUpdate -> Bool
(ConversationMessageTimerUpdate
 -> ConversationMessageTimerUpdate -> Bool)
-> (ConversationMessageTimerUpdate
    -> ConversationMessageTimerUpdate -> Bool)
-> Eq ConversationMessageTimerUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationMessageTimerUpdate
-> ConversationMessageTimerUpdate -> Bool
== :: ConversationMessageTimerUpdate
-> ConversationMessageTimerUpdate -> Bool
$c/= :: ConversationMessageTimerUpdate
-> ConversationMessageTimerUpdate -> Bool
/= :: ConversationMessageTimerUpdate
-> ConversationMessageTimerUpdate -> Bool
Eq, Int -> ConversationMessageTimerUpdate -> ShowS
[ConversationMessageTimerUpdate] -> ShowS
ConversationMessageTimerUpdate -> String
(Int -> ConversationMessageTimerUpdate -> ShowS)
-> (ConversationMessageTimerUpdate -> String)
-> ([ConversationMessageTimerUpdate] -> ShowS)
-> Show ConversationMessageTimerUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationMessageTimerUpdate -> ShowS
showsPrec :: Int -> ConversationMessageTimerUpdate -> ShowS
$cshow :: ConversationMessageTimerUpdate -> String
show :: ConversationMessageTimerUpdate -> String
$cshowList :: [ConversationMessageTimerUpdate] -> ShowS
showList :: [ConversationMessageTimerUpdate] -> ShowS
Show, (forall x.
 ConversationMessageTimerUpdate
 -> Rep ConversationMessageTimerUpdate x)
-> (forall x.
    Rep ConversationMessageTimerUpdate x
    -> ConversationMessageTimerUpdate)
-> Generic ConversationMessageTimerUpdate
forall x.
Rep ConversationMessageTimerUpdate x
-> ConversationMessageTimerUpdate
forall x.
ConversationMessageTimerUpdate
-> Rep ConversationMessageTimerUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ConversationMessageTimerUpdate
-> Rep ConversationMessageTimerUpdate x
from :: forall x.
ConversationMessageTimerUpdate
-> Rep ConversationMessageTimerUpdate x
$cto :: forall x.
Rep ConversationMessageTimerUpdate x
-> ConversationMessageTimerUpdate
to :: forall x.
Rep ConversationMessageTimerUpdate x
-> ConversationMessageTimerUpdate
Generic)
  deriving (Gen ConversationMessageTimerUpdate
Gen ConversationMessageTimerUpdate
-> (ConversationMessageTimerUpdate
    -> [ConversationMessageTimerUpdate])
-> Arbitrary ConversationMessageTimerUpdate
ConversationMessageTimerUpdate -> [ConversationMessageTimerUpdate]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationMessageTimerUpdate
arbitrary :: Gen ConversationMessageTimerUpdate
$cshrink :: ConversationMessageTimerUpdate -> [ConversationMessageTimerUpdate]
shrink :: ConversationMessageTimerUpdate -> [ConversationMessageTimerUpdate]
Arbitrary) via (GenericUniform ConversationMessageTimerUpdate)
  deriving (Value -> Parser [ConversationMessageTimerUpdate]
Value -> Parser ConversationMessageTimerUpdate
(Value -> Parser ConversationMessageTimerUpdate)
-> (Value -> Parser [ConversationMessageTimerUpdate])
-> FromJSON ConversationMessageTimerUpdate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationMessageTimerUpdate
parseJSON :: Value -> Parser ConversationMessageTimerUpdate
$cparseJSONList :: Value -> Parser [ConversationMessageTimerUpdate]
parseJSONList :: Value -> Parser [ConversationMessageTimerUpdate]
FromJSON, [ConversationMessageTimerUpdate] -> Value
[ConversationMessageTimerUpdate] -> Encoding
ConversationMessageTimerUpdate -> Value
ConversationMessageTimerUpdate -> Encoding
(ConversationMessageTimerUpdate -> Value)
-> (ConversationMessageTimerUpdate -> Encoding)
-> ([ConversationMessageTimerUpdate] -> Value)
-> ([ConversationMessageTimerUpdate] -> Encoding)
-> ToJSON ConversationMessageTimerUpdate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationMessageTimerUpdate -> Value
toJSON :: ConversationMessageTimerUpdate -> Value
$ctoEncoding :: ConversationMessageTimerUpdate -> Encoding
toEncoding :: ConversationMessageTimerUpdate -> Encoding
$ctoJSONList :: [ConversationMessageTimerUpdate] -> Value
toJSONList :: [ConversationMessageTimerUpdate] -> Value
$ctoEncodingList :: [ConversationMessageTimerUpdate] -> Encoding
toEncodingList :: [ConversationMessageTimerUpdate] -> Encoding
ToJSON, Typeable ConversationMessageTimerUpdate
Typeable ConversationMessageTimerUpdate =>
(Proxy ConversationMessageTimerUpdate
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationMessageTimerUpdate
Proxy ConversationMessageTimerUpdate
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationMessageTimerUpdate
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationMessageTimerUpdate
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ConversationMessageTimerUpdate

instance ToSchema ConversationMessageTimerUpdate where
  schema :: ValueSchema NamedSwaggerDoc ConversationMessageTimerUpdate
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ConversationMessageTimerUpdate
-> ValueSchema NamedSwaggerDoc ConversationMessageTimerUpdate
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"ConversationMessageTimerUpdate"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Contains conversation properties to update")
      (ObjectSchema SwaggerDoc ConversationMessageTimerUpdate
 -> ValueSchema NamedSwaggerDoc ConversationMessageTimerUpdate)
-> ObjectSchema SwaggerDoc ConversationMessageTimerUpdate
-> ValueSchema NamedSwaggerDoc ConversationMessageTimerUpdate
forall a b. (a -> b) -> a -> b
$ Maybe Milliseconds -> ConversationMessageTimerUpdate
ConversationMessageTimerUpdate
        (Maybe Milliseconds -> ConversationMessageTimerUpdate)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMessageTimerUpdate
     (Maybe Milliseconds)
-> ObjectSchema SwaggerDoc ConversationMessageTimerUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationMessageTimerUpdate -> Maybe Milliseconds
cupMessageTimer (ConversationMessageTimerUpdate -> Maybe Milliseconds)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe Milliseconds) (Maybe Milliseconds)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMessageTimerUpdate
     (Maybe Milliseconds)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe Milliseconds) Milliseconds
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe Milliseconds) (Maybe Milliseconds)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"message_timer" (Value
-> SchemaP NamedSwaggerDoc Value Value Milliseconds Milliseconds
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe Milliseconds) Milliseconds
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value Milliseconds Milliseconds
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

data ConversationJoin = ConversationJoin
  { ConversationJoin -> NonEmpty (Qualified UserId)
cjUsers :: NonEmpty (Qualified UserId),
    ConversationJoin -> RoleName
cjRole :: RoleName
  }
  deriving stock (ConversationJoin -> ConversationJoin -> Bool
(ConversationJoin -> ConversationJoin -> Bool)
-> (ConversationJoin -> ConversationJoin -> Bool)
-> Eq ConversationJoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationJoin -> ConversationJoin -> Bool
== :: ConversationJoin -> ConversationJoin -> Bool
$c/= :: ConversationJoin -> ConversationJoin -> Bool
/= :: ConversationJoin -> ConversationJoin -> Bool
Eq, Int -> ConversationJoin -> ShowS
[ConversationJoin] -> ShowS
ConversationJoin -> String
(Int -> ConversationJoin -> ShowS)
-> (ConversationJoin -> String)
-> ([ConversationJoin] -> ShowS)
-> Show ConversationJoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationJoin -> ShowS
showsPrec :: Int -> ConversationJoin -> ShowS
$cshow :: ConversationJoin -> String
show :: ConversationJoin -> String
$cshowList :: [ConversationJoin] -> ShowS
showList :: [ConversationJoin] -> ShowS
Show, (forall x. ConversationJoin -> Rep ConversationJoin x)
-> (forall x. Rep ConversationJoin x -> ConversationJoin)
-> Generic ConversationJoin
forall x. Rep ConversationJoin x -> ConversationJoin
forall x. ConversationJoin -> Rep ConversationJoin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConversationJoin -> Rep ConversationJoin x
from :: forall x. ConversationJoin -> Rep ConversationJoin x
$cto :: forall x. Rep ConversationJoin x -> ConversationJoin
to :: forall x. Rep ConversationJoin x -> ConversationJoin
Generic)
  deriving (Gen ConversationJoin
Gen ConversationJoin
-> (ConversationJoin -> [ConversationJoin])
-> Arbitrary ConversationJoin
ConversationJoin -> [ConversationJoin]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationJoin
arbitrary :: Gen ConversationJoin
$cshrink :: ConversationJoin -> [ConversationJoin]
shrink :: ConversationJoin -> [ConversationJoin]
Arbitrary) via (GenericUniform ConversationJoin)
  deriving (Value -> Parser [ConversationJoin]
Value -> Parser ConversationJoin
(Value -> Parser ConversationJoin)
-> (Value -> Parser [ConversationJoin])
-> FromJSON ConversationJoin
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationJoin
parseJSON :: Value -> Parser ConversationJoin
$cparseJSONList :: Value -> Parser [ConversationJoin]
parseJSONList :: Value -> Parser [ConversationJoin]
FromJSON, [ConversationJoin] -> Value
[ConversationJoin] -> Encoding
ConversationJoin -> Value
ConversationJoin -> Encoding
(ConversationJoin -> Value)
-> (ConversationJoin -> Encoding)
-> ([ConversationJoin] -> Value)
-> ([ConversationJoin] -> Encoding)
-> ToJSON ConversationJoin
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationJoin -> Value
toJSON :: ConversationJoin -> Value
$ctoEncoding :: ConversationJoin -> Encoding
toEncoding :: ConversationJoin -> Encoding
$ctoJSONList :: [ConversationJoin] -> Value
toJSONList :: [ConversationJoin] -> Value
$ctoEncodingList :: [ConversationJoin] -> Encoding
toEncodingList :: [ConversationJoin] -> Encoding
ToJSON, Typeable ConversationJoin
Typeable ConversationJoin =>
(Proxy ConversationJoin
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationJoin
Proxy ConversationJoin -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationJoin -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationJoin -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ConversationJoin

instance ToSchema ConversationJoin where
  schema :: ValueSchema NamedSwaggerDoc ConversationJoin
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ConversationJoin
-> ValueSchema NamedSwaggerDoc ConversationJoin
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"ConversationJoin"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The action of some users joining a conversation")
      (ObjectSchema SwaggerDoc ConversationJoin
 -> ValueSchema NamedSwaggerDoc ConversationJoin)
-> ObjectSchema SwaggerDoc ConversationJoin
-> ValueSchema NamedSwaggerDoc ConversationJoin
forall a b. (a -> b) -> a -> b
$ NonEmpty (Qualified UserId) -> RoleName -> ConversationJoin
ConversationJoin
        (NonEmpty (Qualified UserId) -> RoleName -> ConversationJoin)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationJoin
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationJoin
     (RoleName -> ConversationJoin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationJoin -> NonEmpty (Qualified UserId)
cjUsers (ConversationJoin -> NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationJoin
     (NonEmpty (Qualified UserId))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"users" (ValueSchema NamedSwaggerDoc (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc,
 HasMinItems doc (Maybe Integer)) =>
ValueSchema ndoc a -> ValueSchema doc (NonEmpty a)
nonEmptyArray ValueSchema NamedSwaggerDoc (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationJoin
  (RoleName -> ConversationJoin)
-> SchemaP SwaggerDoc Object [Pair] ConversationJoin RoleName
-> ObjectSchema SwaggerDoc ConversationJoin
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationJoin (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationJoin a
-> SchemaP SwaggerDoc Object [Pair] ConversationJoin b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationJoin -> RoleName
cjRole (ConversationJoin -> RoleName)
-> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
-> SchemaP SwaggerDoc Object [Pair] ConversationJoin RoleName
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value RoleName RoleName
-> SchemaP SwaggerDoc Object [Pair] RoleName RoleName
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"role" SchemaP NamedSwaggerDoc Value Value RoleName RoleName
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data ConversationMemberUpdate = ConversationMemberUpdate
  { ConversationMemberUpdate -> Qualified UserId
cmuTarget :: Qualified UserId,
    ConversationMemberUpdate -> OtherMemberUpdate
cmuUpdate :: OtherMemberUpdate
  }
  deriving stock (ConversationMemberUpdate -> ConversationMemberUpdate -> Bool
(ConversationMemberUpdate -> ConversationMemberUpdate -> Bool)
-> (ConversationMemberUpdate -> ConversationMemberUpdate -> Bool)
-> Eq ConversationMemberUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationMemberUpdate -> ConversationMemberUpdate -> Bool
== :: ConversationMemberUpdate -> ConversationMemberUpdate -> Bool
$c/= :: ConversationMemberUpdate -> ConversationMemberUpdate -> Bool
/= :: ConversationMemberUpdate -> ConversationMemberUpdate -> Bool
Eq, Int -> ConversationMemberUpdate -> ShowS
[ConversationMemberUpdate] -> ShowS
ConversationMemberUpdate -> String
(Int -> ConversationMemberUpdate -> ShowS)
-> (ConversationMemberUpdate -> String)
-> ([ConversationMemberUpdate] -> ShowS)
-> Show ConversationMemberUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationMemberUpdate -> ShowS
showsPrec :: Int -> ConversationMemberUpdate -> ShowS
$cshow :: ConversationMemberUpdate -> String
show :: ConversationMemberUpdate -> String
$cshowList :: [ConversationMemberUpdate] -> ShowS
showList :: [ConversationMemberUpdate] -> ShowS
Show, (forall x.
 ConversationMemberUpdate -> Rep ConversationMemberUpdate x)
-> (forall x.
    Rep ConversationMemberUpdate x -> ConversationMemberUpdate)
-> Generic ConversationMemberUpdate
forall x.
Rep ConversationMemberUpdate x -> ConversationMemberUpdate
forall x.
ConversationMemberUpdate -> Rep ConversationMemberUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ConversationMemberUpdate -> Rep ConversationMemberUpdate x
from :: forall x.
ConversationMemberUpdate -> Rep ConversationMemberUpdate x
$cto :: forall x.
Rep ConversationMemberUpdate x -> ConversationMemberUpdate
to :: forall x.
Rep ConversationMemberUpdate x -> ConversationMemberUpdate
Generic)
  deriving (Gen ConversationMemberUpdate
Gen ConversationMemberUpdate
-> (ConversationMemberUpdate -> [ConversationMemberUpdate])
-> Arbitrary ConversationMemberUpdate
ConversationMemberUpdate -> [ConversationMemberUpdate]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationMemberUpdate
arbitrary :: Gen ConversationMemberUpdate
$cshrink :: ConversationMemberUpdate -> [ConversationMemberUpdate]
shrink :: ConversationMemberUpdate -> [ConversationMemberUpdate]
Arbitrary) via (GenericUniform ConversationMemberUpdate)
  deriving (Value -> Parser [ConversationMemberUpdate]
Value -> Parser ConversationMemberUpdate
(Value -> Parser ConversationMemberUpdate)
-> (Value -> Parser [ConversationMemberUpdate])
-> FromJSON ConversationMemberUpdate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationMemberUpdate
parseJSON :: Value -> Parser ConversationMemberUpdate
$cparseJSONList :: Value -> Parser [ConversationMemberUpdate]
parseJSONList :: Value -> Parser [ConversationMemberUpdate]
FromJSON, [ConversationMemberUpdate] -> Value
[ConversationMemberUpdate] -> Encoding
ConversationMemberUpdate -> Value
ConversationMemberUpdate -> Encoding
(ConversationMemberUpdate -> Value)
-> (ConversationMemberUpdate -> Encoding)
-> ([ConversationMemberUpdate] -> Value)
-> ([ConversationMemberUpdate] -> Encoding)
-> ToJSON ConversationMemberUpdate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationMemberUpdate -> Value
toJSON :: ConversationMemberUpdate -> Value
$ctoEncoding :: ConversationMemberUpdate -> Encoding
toEncoding :: ConversationMemberUpdate -> Encoding
$ctoJSONList :: [ConversationMemberUpdate] -> Value
toJSONList :: [ConversationMemberUpdate] -> Value
$ctoEncodingList :: [ConversationMemberUpdate] -> Encoding
toEncodingList :: [ConversationMemberUpdate] -> Encoding
ToJSON, Typeable ConversationMemberUpdate
Typeable ConversationMemberUpdate =>
(Proxy ConversationMemberUpdate
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationMemberUpdate
Proxy ConversationMemberUpdate
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationMemberUpdate
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationMemberUpdate
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ConversationMemberUpdate

instance ToSchema ConversationMemberUpdate where
  schema :: ValueSchema NamedSwaggerDoc ConversationMemberUpdate
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ConversationMemberUpdate
-> ValueSchema NamedSwaggerDoc ConversationMemberUpdate
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"ConversationMemberUpdate"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The action of promoting/demoting a member of a conversation")
      (ObjectSchema SwaggerDoc ConversationMemberUpdate
 -> ValueSchema NamedSwaggerDoc ConversationMemberUpdate)
-> ObjectSchema SwaggerDoc ConversationMemberUpdate
-> ValueSchema NamedSwaggerDoc ConversationMemberUpdate
forall a b. (a -> b) -> a -> b
$ Qualified UserId -> OtherMemberUpdate -> ConversationMemberUpdate
ConversationMemberUpdate
        (Qualified UserId -> OtherMemberUpdate -> ConversationMemberUpdate)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMemberUpdate
     (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMemberUpdate
     (OtherMemberUpdate -> ConversationMemberUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationMemberUpdate -> Qualified UserId
cmuTarget (ConversationMemberUpdate -> Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified UserId) (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMemberUpdate
     (Qualified UserId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc (Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified UserId) (Qualified UserId)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"target" ValueSchema NamedSwaggerDoc (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMemberUpdate
  (OtherMemberUpdate -> ConversationMemberUpdate)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMemberUpdate OtherMemberUpdate
-> ObjectSchema SwaggerDoc ConversationMemberUpdate
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMemberUpdate (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationMemberUpdate a
-> SchemaP SwaggerDoc Object [Pair] ConversationMemberUpdate b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationMemberUpdate -> OtherMemberUpdate
cmuUpdate (ConversationMemberUpdate -> OtherMemberUpdate)
-> SchemaP
     SwaggerDoc Object [Pair] OtherMemberUpdate OtherMemberUpdate
-> SchemaP
     SwaggerDoc Object [Pair] ConversationMemberUpdate OtherMemberUpdate
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value OtherMemberUpdate OtherMemberUpdate
-> SchemaP
     SwaggerDoc Object [Pair] OtherMemberUpdate OtherMemberUpdate
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"update" SchemaP
  NamedSwaggerDoc Value Value OtherMemberUpdate OtherMemberUpdate
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data ConversationRemoveMembers = ConversationRemoveMembers
  { ConversationRemoveMembers -> NonEmpty (Qualified UserId)
crmTargets :: NonEmpty (Qualified UserId),
    ConversationRemoveMembers -> EdMemberLeftReason
crmReason :: EdMemberLeftReason
  }
  deriving stock (ConversationRemoveMembers -> ConversationRemoveMembers -> Bool
(ConversationRemoveMembers -> ConversationRemoveMembers -> Bool)
-> (ConversationRemoveMembers -> ConversationRemoveMembers -> Bool)
-> Eq ConversationRemoveMembers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationRemoveMembers -> ConversationRemoveMembers -> Bool
== :: ConversationRemoveMembers -> ConversationRemoveMembers -> Bool
$c/= :: ConversationRemoveMembers -> ConversationRemoveMembers -> Bool
/= :: ConversationRemoveMembers -> ConversationRemoveMembers -> Bool
Eq, Int -> ConversationRemoveMembers -> ShowS
[ConversationRemoveMembers] -> ShowS
ConversationRemoveMembers -> String
(Int -> ConversationRemoveMembers -> ShowS)
-> (ConversationRemoveMembers -> String)
-> ([ConversationRemoveMembers] -> ShowS)
-> Show ConversationRemoveMembers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationRemoveMembers -> ShowS
showsPrec :: Int -> ConversationRemoveMembers -> ShowS
$cshow :: ConversationRemoveMembers -> String
show :: ConversationRemoveMembers -> String
$cshowList :: [ConversationRemoveMembers] -> ShowS
showList :: [ConversationRemoveMembers] -> ShowS
Show, (forall x.
 ConversationRemoveMembers -> Rep ConversationRemoveMembers x)
-> (forall x.
    Rep ConversationRemoveMembers x -> ConversationRemoveMembers)
-> Generic ConversationRemoveMembers
forall x.
Rep ConversationRemoveMembers x -> ConversationRemoveMembers
forall x.
ConversationRemoveMembers -> Rep ConversationRemoveMembers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ConversationRemoveMembers -> Rep ConversationRemoveMembers x
from :: forall x.
ConversationRemoveMembers -> Rep ConversationRemoveMembers x
$cto :: forall x.
Rep ConversationRemoveMembers x -> ConversationRemoveMembers
to :: forall x.
Rep ConversationRemoveMembers x -> ConversationRemoveMembers
Generic)
  deriving (Gen ConversationRemoveMembers
Gen ConversationRemoveMembers
-> (ConversationRemoveMembers -> [ConversationRemoveMembers])
-> Arbitrary ConversationRemoveMembers
ConversationRemoveMembers -> [ConversationRemoveMembers]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationRemoveMembers
arbitrary :: Gen ConversationRemoveMembers
$cshrink :: ConversationRemoveMembers -> [ConversationRemoveMembers]
shrink :: ConversationRemoveMembers -> [ConversationRemoveMembers]
Arbitrary) via (GenericUniform ConversationRemoveMembers)
  deriving (Value -> Parser [ConversationRemoveMembers]
Value -> Parser ConversationRemoveMembers
(Value -> Parser ConversationRemoveMembers)
-> (Value -> Parser [ConversationRemoveMembers])
-> FromJSON ConversationRemoveMembers
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationRemoveMembers
parseJSON :: Value -> Parser ConversationRemoveMembers
$cparseJSONList :: Value -> Parser [ConversationRemoveMembers]
parseJSONList :: Value -> Parser [ConversationRemoveMembers]
FromJSON, [ConversationRemoveMembers] -> Value
[ConversationRemoveMembers] -> Encoding
ConversationRemoveMembers -> Value
ConversationRemoveMembers -> Encoding
(ConversationRemoveMembers -> Value)
-> (ConversationRemoveMembers -> Encoding)
-> ([ConversationRemoveMembers] -> Value)
-> ([ConversationRemoveMembers] -> Encoding)
-> ToJSON ConversationRemoveMembers
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationRemoveMembers -> Value
toJSON :: ConversationRemoveMembers -> Value
$ctoEncoding :: ConversationRemoveMembers -> Encoding
toEncoding :: ConversationRemoveMembers -> Encoding
$ctoJSONList :: [ConversationRemoveMembers] -> Value
toJSONList :: [ConversationRemoveMembers] -> Value
$ctoEncodingList :: [ConversationRemoveMembers] -> Encoding
toEncodingList :: [ConversationRemoveMembers] -> Encoding
ToJSON, Typeable ConversationRemoveMembers
Typeable ConversationRemoveMembers =>
(Proxy ConversationRemoveMembers
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationRemoveMembers
Proxy ConversationRemoveMembers
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationRemoveMembers
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationRemoveMembers
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ConversationRemoveMembers

instance ToSchema ConversationRemoveMembers where
  schema :: ValueSchema NamedSwaggerDoc ConversationRemoveMembers
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ConversationRemoveMembers
-> ValueSchema NamedSwaggerDoc ConversationRemoveMembers
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"ConversationRemoveMembers"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The action of removing members from a conversation")
      (ObjectSchema SwaggerDoc ConversationRemoveMembers
 -> ValueSchema NamedSwaggerDoc ConversationRemoveMembers)
-> ObjectSchema SwaggerDoc ConversationRemoveMembers
-> ValueSchema NamedSwaggerDoc ConversationRemoveMembers
forall a b. (a -> b) -> a -> b
$ NonEmpty (Qualified UserId)
-> EdMemberLeftReason -> ConversationRemoveMembers
ConversationRemoveMembers
        (NonEmpty (Qualified UserId)
 -> EdMemberLeftReason -> ConversationRemoveMembers)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationRemoveMembers
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationRemoveMembers
     (EdMemberLeftReason -> ConversationRemoveMembers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationRemoveMembers -> NonEmpty (Qualified UserId)
crmTargets (ConversationRemoveMembers -> NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationRemoveMembers
     (NonEmpty (Qualified UserId))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"targets" (ValueSchema NamedSwaggerDoc (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc,
 HasMinItems doc (Maybe Integer)) =>
ValueSchema ndoc a -> ValueSchema doc (NonEmpty a)
nonEmptyArray ValueSchema NamedSwaggerDoc (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationRemoveMembers
  (EdMemberLeftReason -> ConversationRemoveMembers)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationRemoveMembers
     EdMemberLeftReason
-> ObjectSchema SwaggerDoc ConversationRemoveMembers
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationRemoveMembers (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationRemoveMembers a
-> SchemaP SwaggerDoc Object [Pair] ConversationRemoveMembers b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationRemoveMembers -> EdMemberLeftReason
crmReason (ConversationRemoveMembers -> EdMemberLeftReason)
-> SchemaP
     SwaggerDoc Object [Pair] EdMemberLeftReason EdMemberLeftReason
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationRemoveMembers
     EdMemberLeftReason
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value EdMemberLeftReason EdMemberLeftReason
-> SchemaP
     SwaggerDoc Object [Pair] EdMemberLeftReason EdMemberLeftReason
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"reason" SchemaP
  NamedSwaggerDoc Value Value EdMemberLeftReason EdMemberLeftReason
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

-- | The id of the MLS self conversation for a given user
mlsSelfConvId :: UserId -> ConvId
mlsSelfConvId :: UserId -> ConvId
mlsSelfConvId UserId
uid =
  let inputBytes :: [Word8]
inputBytes = ByteString -> [Word8]
LBS.unpack (ByteString -> [Word8])
-> (UserId -> ByteString) -> UserId -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
UUID.toByteString (UUID -> ByteString) -> (UserId -> UUID) -> UserId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> UUID
forall {k} (a :: k). Id a -> UUID
toUUID (UserId -> [Word8]) -> UserId -> [Word8]
forall a b. (a -> b) -> a -> b
$ UserId
uid
   in UUID -> ConvId
forall {k} (a :: k). UUID -> Id a
Id (UUID -> [Word8] -> UUID
UUIDV5.generateNamed UUID
namespaceMLSSelfConv [Word8]
inputBytes)

namespaceMLSSelfConv :: UUID.UUID
namespaceMLSSelfConv :: UUID
namespaceMLSSelfConv =
  -- a V5 uuid created with the nil namespace
  Maybe UUID -> UUID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UUID -> UUID) -> (String -> Maybe UUID) -> String -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe UUID
UUID.fromString (String -> UUID) -> String -> UUID
forall a b. (a -> b) -> a -> b
$ String
"3eac2a2c-3850-510b-bd08-8a98e80dd4d9"

--------------------------------------------------------------------------------
-- MultiVerb instances

instance AsHeaders '[ConvId] Conversation Conversation where
  toHeaders :: Conversation -> (NP I '[ConvId], Conversation)
toHeaders Conversation
c = (ConvId -> I ConvId
forall a. a -> I a
I (Qualified ConvId -> ConvId
forall a. Qualified a -> a
qUnqualified (Conversation -> Qualified ConvId
cnvQualifiedId Conversation
c)) I ConvId -> NP I '[] -> NP I '[ConvId]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil, Conversation
c)
  fromHeaders :: (NP I '[ConvId], Conversation) -> Conversation
fromHeaders = (NP I '[ConvId], Conversation) -> Conversation
forall a b. (a, b) -> b
snd

instance AsHeaders '[ConvId] CreateGroupConversation CreateGroupConversation where
  toHeaders :: CreateGroupConversation
-> (NP I '[ConvId], CreateGroupConversation)
toHeaders CreateGroupConversation
c =
    ((ConvId -> I ConvId
forall a. a -> I a
I (ConvId -> I ConvId)
-> (CreateGroupConversation -> ConvId)
-> CreateGroupConversation
-> I ConvId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified ConvId -> ConvId
forall a. Qualified a -> a
qUnqualified (Qualified ConvId -> ConvId)
-> (CreateGroupConversation -> Qualified ConvId)
-> CreateGroupConversation
-> ConvId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> Qualified ConvId
cnvQualifiedId (Conversation -> Qualified ConvId)
-> (CreateGroupConversation -> Conversation)
-> CreateGroupConversation
-> Qualified ConvId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateGroupConversation -> Conversation
cgcConversation (CreateGroupConversation -> I ConvId)
-> CreateGroupConversation -> I ConvId
forall a b. (a -> b) -> a -> b
$ CreateGroupConversation
c) I ConvId -> NP I '[] -> NP I '[ConvId]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil, CreateGroupConversation
c)
  fromHeaders :: (NP I '[ConvId], CreateGroupConversation)
-> CreateGroupConversation
fromHeaders = (NP I '[ConvId], CreateGroupConversation)
-> CreateGroupConversation
forall a b. (a, b) -> b
snd