{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

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

module Wire.API.MLS.SubConversation where

import Control.Applicative
import Control.Lens (makePrisms, (?~))
import Control.Lens.Tuple (_1)
import Control.Monad.Except
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as A
import Data.ByteString.Conversion
import Data.Id
import Data.OpenApi qualified as S
import Data.Qualified
import Data.Schema hiding (HasField)
import Data.Text qualified as T
import GHC.Records
import Imports
import Servant (FromHttpApiData (..), ToHttpApiData (toQueryParam))
import Test.QuickCheck
import Wire.API.Conversation.Protocol
import Wire.API.MLS.Credential
import Wire.API.MLS.Group
import Wire.API.Routes.Version
import Wire.API.Routes.Versioned
import Wire.Arbitrary

-- | An MLS subconversation ID, which identifies a subconversation within a
-- conversation. The pair of a qualified conversation ID and a subconversation
-- ID identifies globally.
newtype SubConvId = SubConvId {SubConvId -> Text
unSubConvId :: Text}
  deriving newtype (SubConvId -> SubConvId -> Bool
(SubConvId -> SubConvId -> Bool)
-> (SubConvId -> SubConvId -> Bool) -> Eq SubConvId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubConvId -> SubConvId -> Bool
== :: SubConvId -> SubConvId -> Bool
$c/= :: SubConvId -> SubConvId -> Bool
/= :: SubConvId -> SubConvId -> Bool
Eq, ValueSchema NamedSwaggerDoc SubConvId
ValueSchema NamedSwaggerDoc SubConvId -> ToSchema SubConvId
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: ValueSchema NamedSwaggerDoc SubConvId
schema :: ValueSchema NamedSwaggerDoc SubConvId
ToSchema, Eq SubConvId
Eq SubConvId =>
(SubConvId -> SubConvId -> Ordering)
-> (SubConvId -> SubConvId -> Bool)
-> (SubConvId -> SubConvId -> Bool)
-> (SubConvId -> SubConvId -> Bool)
-> (SubConvId -> SubConvId -> Bool)
-> (SubConvId -> SubConvId -> SubConvId)
-> (SubConvId -> SubConvId -> SubConvId)
-> Ord SubConvId
SubConvId -> SubConvId -> Bool
SubConvId -> SubConvId -> Ordering
SubConvId -> SubConvId -> SubConvId
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 :: SubConvId -> SubConvId -> Ordering
compare :: SubConvId -> SubConvId -> Ordering
$c< :: SubConvId -> SubConvId -> Bool
< :: SubConvId -> SubConvId -> Bool
$c<= :: SubConvId -> SubConvId -> Bool
<= :: SubConvId -> SubConvId -> Bool
$c> :: SubConvId -> SubConvId -> Bool
> :: SubConvId -> SubConvId -> Bool
$c>= :: SubConvId -> SubConvId -> Bool
>= :: SubConvId -> SubConvId -> Bool
$cmax :: SubConvId -> SubConvId -> SubConvId
max :: SubConvId -> SubConvId -> SubConvId
$cmin :: SubConvId -> SubConvId -> SubConvId
min :: SubConvId -> SubConvId -> SubConvId
Ord, Proxy SubConvId -> Schema
(Proxy SubConvId -> Schema) -> ToParamSchema SubConvId
forall a. (Proxy a -> Schema) -> ToParamSchema a
$ctoParamSchema :: Proxy SubConvId -> Schema
toParamSchema :: Proxy SubConvId -> Schema
S.ToParamSchema, SubConvId -> Builder
(SubConvId -> Builder) -> ToByteString SubConvId
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: SubConvId -> Builder
builder :: SubConvId -> Builder
ToByteString, [SubConvId] -> Value
[SubConvId] -> Encoding
SubConvId -> Value
SubConvId -> Encoding
(SubConvId -> Value)
-> (SubConvId -> Encoding)
-> ([SubConvId] -> Value)
-> ([SubConvId] -> Encoding)
-> ToJSON SubConvId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SubConvId -> Value
toJSON :: SubConvId -> Value
$ctoEncoding :: SubConvId -> Encoding
toEncoding :: SubConvId -> Encoding
$ctoJSONList :: [SubConvId] -> Value
toJSONList :: [SubConvId] -> Value
$ctoEncodingList :: [SubConvId] -> Encoding
toEncodingList :: [SubConvId] -> Encoding
ToJSON, Value -> Parser [SubConvId]
Value -> Parser SubConvId
(Value -> Parser SubConvId)
-> (Value -> Parser [SubConvId]) -> FromJSON SubConvId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SubConvId
parseJSON :: Value -> Parser SubConvId
$cparseJSONList :: Value -> Parser [SubConvId]
parseJSONList :: Value -> Parser [SubConvId]
FromJSON, Typeable SubConvId
Typeable SubConvId =>
(Proxy SubConvId -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SubConvId
Proxy SubConvId -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SubConvId -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SubConvId -> Declare (Definitions Schema) NamedSchema
S.ToSchema)
  deriving stock ((forall x. SubConvId -> Rep SubConvId x)
-> (forall x. Rep SubConvId x -> SubConvId) -> Generic SubConvId
forall x. Rep SubConvId x -> SubConvId
forall x. SubConvId -> Rep SubConvId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubConvId -> Rep SubConvId x
from :: forall x. SubConvId -> Rep SubConvId x
$cto :: forall x. Rep SubConvId x -> SubConvId
to :: forall x. Rep SubConvId x -> SubConvId
Generic)
  deriving stock (Int -> SubConvId -> ShowS
[SubConvId] -> ShowS
SubConvId -> String
(Int -> SubConvId -> ShowS)
-> (SubConvId -> String)
-> ([SubConvId] -> ShowS)
-> Show SubConvId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubConvId -> ShowS
showsPrec :: Int -> SubConvId -> ShowS
$cshow :: SubConvId -> String
show :: SubConvId -> String
$cshowList :: [SubConvId] -> ShowS
showList :: [SubConvId] -> ShowS
Show)

instance FromHttpApiData SubConvId where
  parseQueryParam :: Text -> Either Text SubConvId
parseQueryParam Text
s = do
    Bool -> Either Text () -> Either Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Either Text () -> Either Text ())
-> Either Text () -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a. Text -> Either Text a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"The subconversation ID cannot be empty"
    Bool -> Either Text () -> Either Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256) (Either Text () -> Either Text ())
-> Either Text () -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a. Text -> Either Text a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"The subconversation ID cannot be longer than 255 characters"
    Bool -> Either Text () -> Either Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isValidSubConvChar Text
s) (Either Text () -> Either Text ())
-> Either Text () -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a. Text -> Either Text a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"The subconversation ID contains invalid characters"
    SubConvId -> Either Text SubConvId
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> SubConvId
SubConvId Text
s)

instance ToHttpApiData SubConvId where
  toQueryParam :: SubConvId -> Text
toQueryParam = SubConvId -> Text
unSubConvId

instance Arbitrary SubConvId where
  arbitrary :: Gen SubConvId
arbitrary = do
    Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
255)
    String
cs <- Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Gen Char
forall a. Arbitrary a => Gen a
arbitrary Gen Char -> (Char -> Bool) -> Gen Char
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Char -> Bool
isValidSubConvChar)
    SubConvId -> Gen SubConvId
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubConvId -> Gen SubConvId) -> SubConvId -> Gen SubConvId
forall a b. (a -> b) -> a -> b
$ Text -> SubConvId
SubConvId (String -> Text
T.pack String
cs)

isValidSubConvChar :: Char -> Bool
isValidSubConvChar :: Char -> Bool
isValidSubConvChar Char
c = Char -> Bool
isPrint Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c)

data PublicSubConversation = PublicSubConversation
  { PublicSubConversation -> Qualified ConvId
pscParentConvId :: Qualified ConvId,
    PublicSubConversation -> SubConvId
pscSubConvId :: SubConvId,
    PublicSubConversation -> GroupId
pscGroupId :: GroupId,
    PublicSubConversation -> Maybe ActiveMLSConversationData
pscActiveData :: Maybe ActiveMLSConversationData,
    PublicSubConversation -> [ClientIdentity]
pscMembers :: [ClientIdentity]
  }
  deriving (PublicSubConversation -> PublicSubConversation -> Bool
(PublicSubConversation -> PublicSubConversation -> Bool)
-> (PublicSubConversation -> PublicSubConversation -> Bool)
-> Eq PublicSubConversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicSubConversation -> PublicSubConversation -> Bool
== :: PublicSubConversation -> PublicSubConversation -> Bool
$c/= :: PublicSubConversation -> PublicSubConversation -> Bool
/= :: PublicSubConversation -> PublicSubConversation -> Bool
Eq, Int -> PublicSubConversation -> ShowS
[PublicSubConversation] -> ShowS
PublicSubConversation -> String
(Int -> PublicSubConversation -> ShowS)
-> (PublicSubConversation -> String)
-> ([PublicSubConversation] -> ShowS)
-> Show PublicSubConversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicSubConversation -> ShowS
showsPrec :: Int -> PublicSubConversation -> ShowS
$cshow :: PublicSubConversation -> String
show :: PublicSubConversation -> String
$cshowList :: [PublicSubConversation] -> ShowS
showList :: [PublicSubConversation] -> ShowS
Show)
  deriving ([PublicSubConversation] -> Value
[PublicSubConversation] -> Encoding
PublicSubConversation -> Value
PublicSubConversation -> Encoding
(PublicSubConversation -> Value)
-> (PublicSubConversation -> Encoding)
-> ([PublicSubConversation] -> Value)
-> ([PublicSubConversation] -> Encoding)
-> ToJSON PublicSubConversation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PublicSubConversation -> Value
toJSON :: PublicSubConversation -> Value
$ctoEncoding :: PublicSubConversation -> Encoding
toEncoding :: PublicSubConversation -> Encoding
$ctoJSONList :: [PublicSubConversation] -> Value
toJSONList :: [PublicSubConversation] -> Value
$ctoEncodingList :: [PublicSubConversation] -> Encoding
toEncodingList :: [PublicSubConversation] -> Encoding
A.ToJSON, Value -> Parser [PublicSubConversation]
Value -> Parser PublicSubConversation
(Value -> Parser PublicSubConversation)
-> (Value -> Parser [PublicSubConversation])
-> FromJSON PublicSubConversation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PublicSubConversation
parseJSON :: Value -> Parser PublicSubConversation
$cparseJSONList :: Value -> Parser [PublicSubConversation]
parseJSONList :: Value -> Parser [PublicSubConversation]
A.FromJSON, Typeable PublicSubConversation
Typeable PublicSubConversation =>
(Proxy PublicSubConversation
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PublicSubConversation
Proxy PublicSubConversation
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy PublicSubConversation
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PublicSubConversation
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema PublicSubConversation)

publicSubConversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc PublicSubConversation
publicSubConversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc PublicSubConversation
publicSubConversationSchema Maybe Version
v =
  Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc PublicSubConversation
-> ValueSchema NamedSwaggerDoc PublicSubConversation
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
    (Text
"PublicSubConversation" 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
T.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
"An MLS subconversation")
    (ObjectSchema SwaggerDoc PublicSubConversation
 -> ValueSchema NamedSwaggerDoc PublicSubConversation)
-> ObjectSchema SwaggerDoc PublicSubConversation
-> ValueSchema NamedSwaggerDoc PublicSubConversation
forall a b. (a -> b) -> a -> b
$ Qualified ConvId
-> SubConvId
-> GroupId
-> Maybe ActiveMLSConversationData
-> [ClientIdentity]
-> PublicSubConversation
PublicSubConversation
      (Qualified ConvId
 -> SubConvId
 -> GroupId
 -> Maybe ActiveMLSConversationData
 -> [ClientIdentity]
 -> PublicSubConversation)
-> SchemaP
     SwaggerDoc Object [Pair] PublicSubConversation (Qualified ConvId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PublicSubConversation
     (SubConvId
      -> GroupId
      -> Maybe ActiveMLSConversationData
      -> [ClientIdentity]
      -> PublicSubConversation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PublicSubConversation -> Qualified ConvId
pscParentConvId (PublicSubConversation -> Qualified ConvId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified ConvId) (Qualified ConvId)
-> SchemaP
     SwaggerDoc Object [Pair] PublicSubConversation (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
"parent_qualified_id" SchemaP
  NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  PublicSubConversation
  (SubConvId
   -> GroupId
   -> Maybe ActiveMLSConversationData
   -> [ClientIdentity]
   -> PublicSubConversation)
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation SubConvId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PublicSubConversation
     (GroupId
      -> Maybe ActiveMLSConversationData
      -> [ClientIdentity]
      -> PublicSubConversation)
forall a b.
SchemaP SwaggerDoc Object [Pair] PublicSubConversation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation a
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PublicSubConversation -> SubConvId
pscSubConvId (PublicSubConversation -> SubConvId)
-> SchemaP SwaggerDoc Object [Pair] SubConvId SubConvId
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation SubConvId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc SubConvId
-> SchemaP SwaggerDoc Object [Pair] SubConvId SubConvId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"subconv_id" ValueSchema NamedSwaggerDoc SubConvId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  PublicSubConversation
  (GroupId
   -> Maybe ActiveMLSConversationData
   -> [ClientIdentity]
   -> PublicSubConversation)
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation GroupId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PublicSubConversation
     (Maybe ActiveMLSConversationData
      -> [ClientIdentity] -> PublicSubConversation)
forall a b.
SchemaP SwaggerDoc Object [Pair] PublicSubConversation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation a
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PublicSubConversation -> GroupId
pscGroupId (PublicSubConversation -> GroupId)
-> SchemaP SwaggerDoc Object [Pair] GroupId GroupId
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation GroupId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value GroupId GroupId
-> SchemaP SwaggerDoc Object [Pair] GroupId GroupId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"group_id" SchemaP NamedSwaggerDoc Value Value GroupId GroupId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  PublicSubConversation
  (Maybe ActiveMLSConversationData
   -> [ClientIdentity] -> PublicSubConversation)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PublicSubConversation
     (Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PublicSubConversation
     ([ClientIdentity] -> PublicSubConversation)
forall a b.
SchemaP SwaggerDoc Object [Pair] PublicSubConversation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation a
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PublicSubConversation -> Maybe ActiveMLSConversationData
pscActiveData (PublicSubConversation -> Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PublicSubConversation
     (Maybe ActiveMLSConversationData)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe ActiveMLSConversationData)
optionalActiveMLSConversationDataSchema Maybe Version
v
      SchemaP
  SwaggerDoc
  Object
  [Pair]
  PublicSubConversation
  ([ClientIdentity] -> PublicSubConversation)
-> SchemaP
     SwaggerDoc Object [Pair] PublicSubConversation [ClientIdentity]
-> ObjectSchema SwaggerDoc PublicSubConversation
forall a b.
SchemaP SwaggerDoc Object [Pair] PublicSubConversation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation a
-> SchemaP SwaggerDoc Object [Pair] PublicSubConversation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PublicSubConversation -> [ClientIdentity]
pscMembers (PublicSubConversation -> [ClientIdentity])
-> SchemaP
     SwaggerDoc Object [Pair] [ClientIdentity] [ClientIdentity]
-> SchemaP
     SwaggerDoc Object [Pair] PublicSubConversation [ClientIdentity]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [ClientIdentity] [ClientIdentity]
-> SchemaP
     SwaggerDoc Object [Pair] [ClientIdentity] [ClientIdentity]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"members" (ValueSchema NamedSwaggerDoc ClientIdentity
-> SchemaP SwaggerDoc Value Value [ClientIdentity] [ClientIdentity]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc ClientIdentity
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

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

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

data ConvOrSubTag = ConvTag | SubConvTag
  deriving (ConvOrSubTag -> ConvOrSubTag -> Bool
(ConvOrSubTag -> ConvOrSubTag -> Bool)
-> (ConvOrSubTag -> ConvOrSubTag -> Bool) -> Eq ConvOrSubTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConvOrSubTag -> ConvOrSubTag -> Bool
== :: ConvOrSubTag -> ConvOrSubTag -> Bool
$c/= :: ConvOrSubTag -> ConvOrSubTag -> Bool
/= :: ConvOrSubTag -> ConvOrSubTag -> Bool
Eq, Int -> ConvOrSubTag
ConvOrSubTag -> Int
ConvOrSubTag -> [ConvOrSubTag]
ConvOrSubTag -> ConvOrSubTag
ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag]
ConvOrSubTag -> ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag]
(ConvOrSubTag -> ConvOrSubTag)
-> (ConvOrSubTag -> ConvOrSubTag)
-> (Int -> ConvOrSubTag)
-> (ConvOrSubTag -> Int)
-> (ConvOrSubTag -> [ConvOrSubTag])
-> (ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag])
-> (ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag])
-> (ConvOrSubTag -> ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag])
-> Enum ConvOrSubTag
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 :: ConvOrSubTag -> ConvOrSubTag
succ :: ConvOrSubTag -> ConvOrSubTag
$cpred :: ConvOrSubTag -> ConvOrSubTag
pred :: ConvOrSubTag -> ConvOrSubTag
$ctoEnum :: Int -> ConvOrSubTag
toEnum :: Int -> ConvOrSubTag
$cfromEnum :: ConvOrSubTag -> Int
fromEnum :: ConvOrSubTag -> Int
$cenumFrom :: ConvOrSubTag -> [ConvOrSubTag]
enumFrom :: ConvOrSubTag -> [ConvOrSubTag]
$cenumFromThen :: ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag]
enumFromThen :: ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag]
$cenumFromTo :: ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag]
enumFromTo :: ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag]
$cenumFromThenTo :: ConvOrSubTag -> ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag]
enumFromThenTo :: ConvOrSubTag -> ConvOrSubTag -> ConvOrSubTag -> [ConvOrSubTag]
Enum, ConvOrSubTag
ConvOrSubTag -> ConvOrSubTag -> Bounded ConvOrSubTag
forall a. a -> a -> Bounded a
$cminBound :: ConvOrSubTag
minBound :: ConvOrSubTag
$cmaxBound :: ConvOrSubTag
maxBound :: ConvOrSubTag
Bounded)

data ConvOrSubChoice c s
  = Conv c
  | SubConv c s

deriving instance (Eq c, Eq s) => Eq (ConvOrSubChoice c s)

deriving instance (Show c, Show s) => Show (ConvOrSubChoice c s)

deriving instance (Generic c, Generic s) => Generic (ConvOrSubChoice c s)

deriving via
  (GenericUniform (ConvOrSubChoice c s))
  instance
    (Generic c, Generic s, Arbitrary c, Arbitrary s) => Arbitrary (ConvOrSubChoice c s)

instance HasField "conv" (ConvOrSubChoice c s) c where
  getField :: ConvOrSubChoice c s -> c
getField (Conv c
c) = c
c
  getField (SubConv c
c s
_) = c
c

instance HasField "subconv" (ConvOrSubChoice c s) (Maybe s) where
  getField :: ConvOrSubChoice c s -> Maybe s
getField (Conv c
_) = Maybe s
forall a. Maybe a
Nothing
  getField (SubConv c
_ s
s) = s -> Maybe s
forall a. a -> Maybe a
Just s
s

type ConvOrSubConvId = ConvOrSubChoice ConvId SubConvId

makePrisms ''ConvOrSubChoice

instance ToSchema ConvOrSubConvId where
  schema :: ValueSchema NamedSwaggerDoc ConvOrSubConvId
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] ConvOrSubConvId ConvOrSubConvId
-> ValueSchema NamedSwaggerDoc ConvOrSubConvId
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ConvOrSubConvId" (SchemaP SwaggerDoc Object [Pair] ConvOrSubConvId ConvOrSubConvId
 -> ValueSchema NamedSwaggerDoc ConvOrSubConvId)
-> SchemaP SwaggerDoc Object [Pair] ConvOrSubConvId ConvOrSubConvId
-> ValueSchema NamedSwaggerDoc ConvOrSubConvId
forall a b. (a -> b) -> a -> b
$
      (ConvOrSubTag, ConvOrSubConvId) -> ConvOrSubConvId
fromTagged
        ((ConvOrSubTag, ConvOrSubConvId) -> ConvOrSubConvId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConvOrSubConvId
     (ConvOrSubTag, ConvOrSubConvId)
-> SchemaP SwaggerDoc Object [Pair] ConvOrSubConvId ConvOrSubConvId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConvOrSubConvId -> (ConvOrSubTag, ConvOrSubConvId)
toTagged
          (ConvOrSubConvId -> (ConvOrSubTag, ConvOrSubConvId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (ConvOrSubTag, ConvOrSubConvId)
     (ConvOrSubTag, ConvOrSubConvId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConvOrSubConvId
     (ConvOrSubTag, ConvOrSubConvId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (ConvOrSubTag, ConvOrSubConvId)
  ConvOrSubTag
-> SchemaP
     SwaggerDoc
     (Object, ConvOrSubTag)
     [Pair]
     (ConvOrSubTag, ConvOrSubConvId)
     ConvOrSubConvId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (ConvOrSubTag, ConvOrSubConvId)
     (ConvOrSubTag, ConvOrSubConvId)
forall d w v a b c.
(Monoid d, Monoid w) =>
SchemaP d v w a b
-> SchemaP d (v, b) w a c -> SchemaP d v w a (b, c)
bind
            ((ConvOrSubTag, ConvOrSubConvId) -> ConvOrSubTag
forall a b. (a, b) -> a
fst ((ConvOrSubTag, ConvOrSubConvId) -> ConvOrSubTag)
-> SchemaP SwaggerDoc Object [Pair] ConvOrSubTag ConvOrSubTag
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (ConvOrSubTag, ConvOrSubConvId)
     ConvOrSubTag
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ConvOrSubTag ConvOrSubTag
-> SchemaP SwaggerDoc Object [Pair] ConvOrSubTag ConvOrSubTag
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"tag" SchemaP NamedSwaggerDoc Value Value ConvOrSubTag ConvOrSubTag
tagSchema)
            ((ConvOrSubTag, ConvOrSubConvId) -> ConvOrSubConvId
forall a b. (a, b) -> b
snd ((ConvOrSubTag, ConvOrSubConvId) -> ConvOrSubConvId)
-> SchemaP
     SwaggerDoc
     (Object, ConvOrSubTag)
     [Pair]
     ConvOrSubConvId
     ConvOrSubConvId
-> SchemaP
     SwaggerDoc
     (Object, ConvOrSubTag)
     [Pair]
     (ConvOrSubTag, ConvOrSubConvId)
     ConvOrSubConvId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Lens (Object, ConvOrSubTag) (Value, ConvOrSubTag) Object Value
-> Text
-> SchemaP
     SwaggerDoc
     (Value, ConvOrSubTag)
     Value
     ConvOrSubConvId
     ConvOrSubConvId
-> SchemaP
     SwaggerDoc
     (Object, ConvOrSubTag)
     [Pair]
     ConvOrSubConvId
     ConvOrSubConvId
forall doc' doc v v' a b.
HasField doc' doc =>
Lens v v' Object Value
-> Text -> SchemaP doc' v' Value a b -> SchemaP doc v [Pair] a b
fieldOver (Object -> f Value)
-> (Object, ConvOrSubTag) -> f (Value, ConvOrSubTag)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Object, ConvOrSubTag) (Value, ConvOrSubTag) Object Value
_1 Text
"value" SchemaP
  SwaggerDoc
  (Value, ConvOrSubTag)
  Value
  ConvOrSubConvId
  ConvOrSubConvId
untaggedSchema)
    where
      toTagged :: ConvOrSubConvId -> (ConvOrSubTag, ConvOrSubConvId)
      toTagged :: ConvOrSubConvId -> (ConvOrSubTag, ConvOrSubConvId)
toTagged c :: ConvOrSubConvId
c@(Conv ConvId
_) = (ConvOrSubTag
ConvTag, ConvOrSubConvId
c)
      toTagged c :: ConvOrSubConvId
c@(SubConv ConvId
_ SubConvId
_) = (ConvOrSubTag
SubConvTag, ConvOrSubConvId
c)

      fromTagged :: (ConvOrSubTag, ConvOrSubConvId) -> ConvOrSubConvId
      fromTagged :: (ConvOrSubTag, ConvOrSubConvId) -> ConvOrSubConvId
fromTagged = (ConvOrSubTag, ConvOrSubConvId) -> ConvOrSubConvId
forall a b. (a, b) -> b
snd

      untaggedSchema :: SchemaP
  SwaggerDoc
  (Value, ConvOrSubTag)
  Value
  ConvOrSubConvId
  ConvOrSubConvId
untaggedSchema = (ConvOrSubTag
 -> SchemaP SwaggerDoc Value Value ConvOrSubConvId ConvOrSubConvId)
-> SchemaP
     SwaggerDoc
     (Value, ConvOrSubTag)
     Value
     ConvOrSubConvId
     ConvOrSubConvId
forall t d v w a b.
(Bounded t, Enum t, Monoid d) =>
(t -> SchemaP d v w a b) -> SchemaP d (v, t) w a b
dispatch ((ConvOrSubTag
  -> SchemaP SwaggerDoc Value Value ConvOrSubConvId ConvOrSubConvId)
 -> SchemaP
      SwaggerDoc
      (Value, ConvOrSubTag)
      Value
      ConvOrSubConvId
      ConvOrSubConvId)
-> (ConvOrSubTag
    -> SchemaP SwaggerDoc Value Value ConvOrSubConvId ConvOrSubConvId)
-> SchemaP
     SwaggerDoc
     (Value, ConvOrSubTag)
     Value
     ConvOrSubConvId
     ConvOrSubConvId
forall a b. (a -> b) -> a -> b
$ \case
        ConvOrSubTag
ConvTag ->
          Prism ConvOrSubConvId ConvOrSubConvId ConvId ConvId
-> SchemaP SwaggerDoc Value Value ConvId ConvId
-> SchemaP SwaggerDoc Value Value ConvOrSubConvId ConvOrSubConvId
forall b b' a a' ss v m.
Prism b b' a a' -> SchemaP ss v m a a' -> SchemaP ss v m b b'
tag
            p ConvId (f ConvId) -> p ConvOrSubConvId (f ConvOrSubConvId)
forall c s (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p c (f c) -> p (ConvOrSubChoice c s) (f (ConvOrSubChoice c s))
Prism ConvOrSubConvId ConvOrSubConvId ConvId ConvId
_Conv
            (SchemaP NamedSwaggerDoc Value Value ConvId ConvId
-> SchemaP SwaggerDoc Value Value ConvId ConvId
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 ConvId ConvId
 -> SchemaP SwaggerDoc Value Value ConvId ConvId)
-> SchemaP NamedSwaggerDoc Value Value ConvId ConvId
-> SchemaP SwaggerDoc Value Value ConvId ConvId
forall a b. (a -> b) -> a -> b
$ Text
-> SchemaP SwaggerDoc Object [Pair] ConvId ConvId
-> SchemaP NamedSwaggerDoc Value Value ConvId ConvId
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"" (SchemaP SwaggerDoc Object [Pair] ConvId ConvId
 -> SchemaP NamedSwaggerDoc Value Value ConvId ConvId)
-> SchemaP SwaggerDoc Object [Pair] ConvId ConvId
-> SchemaP NamedSwaggerDoc Value Value ConvId ConvId
forall a b. (a -> b) -> 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
"conv_id" SchemaP NamedSwaggerDoc Value Value ConvId ConvId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        ConvOrSubTag
SubConvTag ->
          Prism
  ConvOrSubConvId
  ConvOrSubConvId
  (ConvId, SubConvId)
  (ConvId, SubConvId)
-> SchemaP
     SwaggerDoc Value Value (ConvId, SubConvId) (ConvId, SubConvId)
-> SchemaP SwaggerDoc Value Value ConvOrSubConvId ConvOrSubConvId
forall b b' a a' ss v m.
Prism b b' a a' -> SchemaP ss v m a a' -> SchemaP ss v m b b'
tag
            p (ConvId, SubConvId) (f (ConvId, SubConvId))
-> p ConvOrSubConvId (f ConvOrSubConvId)
forall c s s (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (c, s) (f (c, s))
-> p (ConvOrSubChoice c s) (f (ConvOrSubChoice c s))
Prism
  ConvOrSubConvId
  ConvOrSubConvId
  (ConvId, SubConvId)
  (ConvId, SubConvId)
_SubConv
            ( SchemaP
  NamedSwaggerDoc Value Value (ConvId, SubConvId) (ConvId, SubConvId)
-> SchemaP
     SwaggerDoc Value Value (ConvId, SubConvId) (ConvId, SubConvId)
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 (ConvId, SubConvId) (ConvId, SubConvId)
 -> SchemaP
      SwaggerDoc Value Value (ConvId, SubConvId) (ConvId, SubConvId))
-> SchemaP
     NamedSwaggerDoc Value Value (ConvId, SubConvId) (ConvId, SubConvId)
-> SchemaP
     SwaggerDoc Value Value (ConvId, SubConvId) (ConvId, SubConvId)
forall a b. (a -> b) -> a -> b
$
                Text
-> SchemaP
     SwaggerDoc Object [Pair] (ConvId, SubConvId) (ConvId, SubConvId)
-> SchemaP
     NamedSwaggerDoc Value Value (ConvId, SubConvId) (ConvId, SubConvId)
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"" (SchemaP
   SwaggerDoc Object [Pair] (ConvId, SubConvId) (ConvId, SubConvId)
 -> SchemaP
      NamedSwaggerDoc
      Value
      Value
      (ConvId, SubConvId)
      (ConvId, SubConvId))
-> SchemaP
     SwaggerDoc Object [Pair] (ConvId, SubConvId) (ConvId, SubConvId)
-> SchemaP
     NamedSwaggerDoc Value Value (ConvId, SubConvId) (ConvId, SubConvId)
forall a b. (a -> b) -> a -> b
$
                  ( (,)
                      (ConvId -> SubConvId -> (ConvId, SubConvId))
-> SchemaP SwaggerDoc Object [Pair] (ConvId, SubConvId) ConvId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (ConvId, SubConvId)
     (SubConvId -> (ConvId, SubConvId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConvId, SubConvId) -> ConvId
forall a b. (a, b) -> a
fst ((ConvId, SubConvId) -> ConvId)
-> SchemaP SwaggerDoc Object [Pair] ConvId ConvId
-> SchemaP SwaggerDoc Object [Pair] (ConvId, SubConvId) 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
"conv_id" SchemaP NamedSwaggerDoc Value Value ConvId ConvId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
                      SchemaP
  SwaggerDoc
  Object
  [Pair]
  (ConvId, SubConvId)
  (SubConvId -> (ConvId, SubConvId))
-> SchemaP SwaggerDoc Object [Pair] (ConvId, SubConvId) SubConvId
-> SchemaP
     SwaggerDoc Object [Pair] (ConvId, SubConvId) (ConvId, SubConvId)
forall a b.
SchemaP SwaggerDoc Object [Pair] (ConvId, SubConvId) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (ConvId, SubConvId) a
-> SchemaP SwaggerDoc Object [Pair] (ConvId, SubConvId) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ConvId, SubConvId) -> SubConvId
forall a b. (a, b) -> b
snd ((ConvId, SubConvId) -> SubConvId)
-> SchemaP SwaggerDoc Object [Pair] SubConvId SubConvId
-> SchemaP SwaggerDoc Object [Pair] (ConvId, SubConvId) SubConvId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc SubConvId
-> SchemaP SwaggerDoc Object [Pair] SubConvId SubConvId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"subconv_id" ValueSchema NamedSwaggerDoc SubConvId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
                  )
            )

      tagSchema :: ValueSchema NamedSwaggerDoc ConvOrSubTag
      tagSchema :: SchemaP NamedSwaggerDoc Value Value ConvOrSubTag ConvOrSubTag
tagSchema =
        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
"ConvOrSubTag" (SchemaP [Value] Text (Alt Maybe Text) ConvOrSubTag ConvOrSubTag
 -> SchemaP NamedSwaggerDoc Value Value ConvOrSubTag ConvOrSubTag)
-> SchemaP [Value] Text (Alt Maybe Text) ConvOrSubTag ConvOrSubTag
-> SchemaP NamedSwaggerDoc Value Value ConvOrSubTag ConvOrSubTag
forall a b. (a -> b) -> a -> b
$
          [SchemaP [Value] Text (Alt Maybe Text) ConvOrSubTag ConvOrSubTag]
-> SchemaP [Value] Text (Alt Maybe Text) ConvOrSubTag ConvOrSubTag
forall a. Monoid a => [a] -> a
mconcat
            [ Text
-> ConvOrSubTag
-> SchemaP [Value] Text (Alt Maybe Text) ConvOrSubTag ConvOrSubTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"conv" ConvOrSubTag
ConvTag,
              Text
-> ConvOrSubTag
-> SchemaP [Value] Text (Alt Maybe Text) ConvOrSubTag ConvOrSubTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"subconv" ConvOrSubTag
SubConvTag
            ]

deriving via Schema ConvOrSubConvId instance FromJSON ConvOrSubConvId

deriving via Schema ConvOrSubConvId instance ToJSON ConvOrSubConvId

deriving via Schema ConvOrSubConvId instance S.ToSchema ConvOrSubConvId

-- | The body of the delete subconversation request
data DeleteSubConversationRequest = DeleteSubConversationRequest
  { DeleteSubConversationRequest -> GroupId
dscGroupId :: GroupId,
    DeleteSubConversationRequest -> Epoch
dscEpoch :: Epoch
  }
  deriving (DeleteSubConversationRequest
-> DeleteSubConversationRequest -> Bool
(DeleteSubConversationRequest
 -> DeleteSubConversationRequest -> Bool)
-> (DeleteSubConversationRequest
    -> DeleteSubConversationRequest -> Bool)
-> Eq DeleteSubConversationRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteSubConversationRequest
-> DeleteSubConversationRequest -> Bool
== :: DeleteSubConversationRequest
-> DeleteSubConversationRequest -> Bool
$c/= :: DeleteSubConversationRequest
-> DeleteSubConversationRequest -> Bool
/= :: DeleteSubConversationRequest
-> DeleteSubConversationRequest -> Bool
Eq, Int -> DeleteSubConversationRequest -> ShowS
[DeleteSubConversationRequest] -> ShowS
DeleteSubConversationRequest -> String
(Int -> DeleteSubConversationRequest -> ShowS)
-> (DeleteSubConversationRequest -> String)
-> ([DeleteSubConversationRequest] -> ShowS)
-> Show DeleteSubConversationRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteSubConversationRequest -> ShowS
showsPrec :: Int -> DeleteSubConversationRequest -> ShowS
$cshow :: DeleteSubConversationRequest -> String
show :: DeleteSubConversationRequest -> String
$cshowList :: [DeleteSubConversationRequest] -> ShowS
showList :: [DeleteSubConversationRequest] -> ShowS
Show)
  deriving ([DeleteSubConversationRequest] -> Value
[DeleteSubConversationRequest] -> Encoding
DeleteSubConversationRequest -> Value
DeleteSubConversationRequest -> Encoding
(DeleteSubConversationRequest -> Value)
-> (DeleteSubConversationRequest -> Encoding)
-> ([DeleteSubConversationRequest] -> Value)
-> ([DeleteSubConversationRequest] -> Encoding)
-> ToJSON DeleteSubConversationRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: DeleteSubConversationRequest -> Value
toJSON :: DeleteSubConversationRequest -> Value
$ctoEncoding :: DeleteSubConversationRequest -> Encoding
toEncoding :: DeleteSubConversationRequest -> Encoding
$ctoJSONList :: [DeleteSubConversationRequest] -> Value
toJSONList :: [DeleteSubConversationRequest] -> Value
$ctoEncodingList :: [DeleteSubConversationRequest] -> Encoding
toEncodingList :: [DeleteSubConversationRequest] -> Encoding
A.ToJSON, Value -> Parser [DeleteSubConversationRequest]
Value -> Parser DeleteSubConversationRequest
(Value -> Parser DeleteSubConversationRequest)
-> (Value -> Parser [DeleteSubConversationRequest])
-> FromJSON DeleteSubConversationRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DeleteSubConversationRequest
parseJSON :: Value -> Parser DeleteSubConversationRequest
$cparseJSONList :: Value -> Parser [DeleteSubConversationRequest]
parseJSONList :: Value -> Parser [DeleteSubConversationRequest]
A.FromJSON, Typeable DeleteSubConversationRequest
Typeable DeleteSubConversationRequest =>
(Proxy DeleteSubConversationRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema DeleteSubConversationRequest
Proxy DeleteSubConversationRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy DeleteSubConversationRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy DeleteSubConversationRequest
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema DeleteSubConversationRequest)

instance ToSchema DeleteSubConversationRequest where
  schema :: ValueSchema NamedSwaggerDoc DeleteSubConversationRequest
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc DeleteSubConversationRequest
-> ValueSchema NamedSwaggerDoc DeleteSubConversationRequest
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"DeleteSubConversationRequest"
      ((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
"Delete an MLS subconversation")
      (ObjectSchema SwaggerDoc DeleteSubConversationRequest
 -> ValueSchema NamedSwaggerDoc DeleteSubConversationRequest)
-> ObjectSchema SwaggerDoc DeleteSubConversationRequest
-> ValueSchema NamedSwaggerDoc DeleteSubConversationRequest
forall a b. (a -> b) -> a -> b
$ GroupId -> Epoch -> DeleteSubConversationRequest
DeleteSubConversationRequest
        (GroupId -> Epoch -> DeleteSubConversationRequest)
-> SchemaP
     SwaggerDoc Object [Pair] DeleteSubConversationRequest GroupId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DeleteSubConversationRequest
     (Epoch -> DeleteSubConversationRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DeleteSubConversationRequest -> GroupId
dscGroupId (DeleteSubConversationRequest -> GroupId)
-> SchemaP SwaggerDoc Object [Pair] GroupId GroupId
-> SchemaP
     SwaggerDoc Object [Pair] DeleteSubConversationRequest GroupId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value GroupId GroupId
-> SchemaP SwaggerDoc Object [Pair] GroupId GroupId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"group_id" SchemaP NamedSwaggerDoc Value Value GroupId GroupId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  DeleteSubConversationRequest
  (Epoch -> DeleteSubConversationRequest)
-> SchemaP
     SwaggerDoc Object [Pair] DeleteSubConversationRequest Epoch
-> ObjectSchema SwaggerDoc DeleteSubConversationRequest
forall a b.
SchemaP
  SwaggerDoc Object [Pair] DeleteSubConversationRequest (a -> b)
-> SchemaP SwaggerDoc Object [Pair] DeleteSubConversationRequest a
-> SchemaP SwaggerDoc Object [Pair] DeleteSubConversationRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DeleteSubConversationRequest -> Epoch
dscEpoch (DeleteSubConversationRequest -> Epoch)
-> SchemaP SwaggerDoc Object [Pair] Epoch Epoch
-> SchemaP
     SwaggerDoc Object [Pair] DeleteSubConversationRequest Epoch
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Epoch Epoch
-> SchemaP SwaggerDoc Object [Pair] Epoch Epoch
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"epoch" SchemaP NamedSwaggerDoc Value Value Epoch Epoch
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema