{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

-- 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.Conversation.Protocol
  ( ProtocolTag (..),
    protocolTag,
    protocolTagSchema,
    protocolValidAction,
    Epoch (..),
    Protocol (..),
    _ProtocolMLS,
    _ProtocolMixed,
    _ProtocolProteus,
    protocolSchema,
    ConversationMLSData (..),
    ActiveMLSConversationData (..),
    optionalActiveMLSConversationDataSchema,
    cnvmlsEpoch,
    ProtocolUpdate (..),
  )
where

import Control.Applicative
import Control.Arrow
import Control.Lens (makePrisms, (?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Json.Util
import Data.OpenApi qualified as S
import Data.Schema
import Data.Time.Clock
import Imports
import Test.QuickCheck
import Wire.API.Conversation.Action.Tag
import Wire.API.MLS.CipherSuite
import Wire.API.MLS.Epoch
import Wire.API.MLS.Group
import Wire.API.Routes.Version
import Wire.API.Routes.Versioned
import Wire.Arbitrary

data ProtocolTag = ProtocolProteusTag | ProtocolMLSTag | ProtocolMixedTag
  deriving stock (ProtocolTag -> ProtocolTag -> Bool
(ProtocolTag -> ProtocolTag -> Bool)
-> (ProtocolTag -> ProtocolTag -> Bool) -> Eq ProtocolTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolTag -> ProtocolTag -> Bool
== :: ProtocolTag -> ProtocolTag -> Bool
$c/= :: ProtocolTag -> ProtocolTag -> Bool
/= :: ProtocolTag -> ProtocolTag -> Bool
Eq, Int -> ProtocolTag -> ShowS
[ProtocolTag] -> ShowS
ProtocolTag -> String
(Int -> ProtocolTag -> ShowS)
-> (ProtocolTag -> String)
-> ([ProtocolTag] -> ShowS)
-> Show ProtocolTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolTag -> ShowS
showsPrec :: Int -> ProtocolTag -> ShowS
$cshow :: ProtocolTag -> String
show :: ProtocolTag -> String
$cshowList :: [ProtocolTag] -> ShowS
showList :: [ProtocolTag] -> ShowS
Show, Int -> ProtocolTag
ProtocolTag -> Int
ProtocolTag -> [ProtocolTag]
ProtocolTag -> ProtocolTag
ProtocolTag -> ProtocolTag -> [ProtocolTag]
ProtocolTag -> ProtocolTag -> ProtocolTag -> [ProtocolTag]
(ProtocolTag -> ProtocolTag)
-> (ProtocolTag -> ProtocolTag)
-> (Int -> ProtocolTag)
-> (ProtocolTag -> Int)
-> (ProtocolTag -> [ProtocolTag])
-> (ProtocolTag -> ProtocolTag -> [ProtocolTag])
-> (ProtocolTag -> ProtocolTag -> [ProtocolTag])
-> (ProtocolTag -> ProtocolTag -> ProtocolTag -> [ProtocolTag])
-> Enum ProtocolTag
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 :: ProtocolTag -> ProtocolTag
succ :: ProtocolTag -> ProtocolTag
$cpred :: ProtocolTag -> ProtocolTag
pred :: ProtocolTag -> ProtocolTag
$ctoEnum :: Int -> ProtocolTag
toEnum :: Int -> ProtocolTag
$cfromEnum :: ProtocolTag -> Int
fromEnum :: ProtocolTag -> Int
$cenumFrom :: ProtocolTag -> [ProtocolTag]
enumFrom :: ProtocolTag -> [ProtocolTag]
$cenumFromThen :: ProtocolTag -> ProtocolTag -> [ProtocolTag]
enumFromThen :: ProtocolTag -> ProtocolTag -> [ProtocolTag]
$cenumFromTo :: ProtocolTag -> ProtocolTag -> [ProtocolTag]
enumFromTo :: ProtocolTag -> ProtocolTag -> [ProtocolTag]
$cenumFromThenTo :: ProtocolTag -> ProtocolTag -> ProtocolTag -> [ProtocolTag]
enumFromThenTo :: ProtocolTag -> ProtocolTag -> ProtocolTag -> [ProtocolTag]
Enum, Eq ProtocolTag
Eq ProtocolTag =>
(ProtocolTag -> ProtocolTag -> Ordering)
-> (ProtocolTag -> ProtocolTag -> Bool)
-> (ProtocolTag -> ProtocolTag -> Bool)
-> (ProtocolTag -> ProtocolTag -> Bool)
-> (ProtocolTag -> ProtocolTag -> Bool)
-> (ProtocolTag -> ProtocolTag -> ProtocolTag)
-> (ProtocolTag -> ProtocolTag -> ProtocolTag)
-> Ord ProtocolTag
ProtocolTag -> ProtocolTag -> Bool
ProtocolTag -> ProtocolTag -> Ordering
ProtocolTag -> ProtocolTag -> ProtocolTag
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 :: ProtocolTag -> ProtocolTag -> Ordering
compare :: ProtocolTag -> ProtocolTag -> Ordering
$c< :: ProtocolTag -> ProtocolTag -> Bool
< :: ProtocolTag -> ProtocolTag -> Bool
$c<= :: ProtocolTag -> ProtocolTag -> Bool
<= :: ProtocolTag -> ProtocolTag -> Bool
$c> :: ProtocolTag -> ProtocolTag -> Bool
> :: ProtocolTag -> ProtocolTag -> Bool
$c>= :: ProtocolTag -> ProtocolTag -> Bool
>= :: ProtocolTag -> ProtocolTag -> Bool
$cmax :: ProtocolTag -> ProtocolTag -> ProtocolTag
max :: ProtocolTag -> ProtocolTag -> ProtocolTag
$cmin :: ProtocolTag -> ProtocolTag -> ProtocolTag
min :: ProtocolTag -> ProtocolTag -> ProtocolTag
Ord, ProtocolTag
ProtocolTag -> ProtocolTag -> Bounded ProtocolTag
forall a. a -> a -> Bounded a
$cminBound :: ProtocolTag
minBound :: ProtocolTag
$cmaxBound :: ProtocolTag
maxBound :: ProtocolTag
Bounded, (forall x. ProtocolTag -> Rep ProtocolTag x)
-> (forall x. Rep ProtocolTag x -> ProtocolTag)
-> Generic ProtocolTag
forall x. Rep ProtocolTag x -> ProtocolTag
forall x. ProtocolTag -> Rep ProtocolTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProtocolTag -> Rep ProtocolTag x
from :: forall x. ProtocolTag -> Rep ProtocolTag x
$cto :: forall x. Rep ProtocolTag x -> ProtocolTag
to :: forall x. Rep ProtocolTag x -> ProtocolTag
Generic)
  deriving (Gen ProtocolTag
Gen ProtocolTag
-> (ProtocolTag -> [ProtocolTag]) -> Arbitrary ProtocolTag
ProtocolTag -> [ProtocolTag]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ProtocolTag
arbitrary :: Gen ProtocolTag
$cshrink :: ProtocolTag -> [ProtocolTag]
shrink :: ProtocolTag -> [ProtocolTag]
Arbitrary) via GenericUniform ProtocolTag

instance S.ToSchema ProtocolTag

data ConversationMLSData = ConversationMLSData
  { -- | The MLS group ID associated to the conversation.
    ConversationMLSData -> GroupId
cnvmlsGroupId :: GroupId,
    -- | Information available once the conversation is active (epoch > 0).
    ConversationMLSData -> Maybe ActiveMLSConversationData
cnvmlsActiveData :: Maybe ActiveMLSConversationData
  }
  deriving stock (ConversationMLSData -> ConversationMLSData -> Bool
(ConversationMLSData -> ConversationMLSData -> Bool)
-> (ConversationMLSData -> ConversationMLSData -> Bool)
-> Eq ConversationMLSData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationMLSData -> ConversationMLSData -> Bool
== :: ConversationMLSData -> ConversationMLSData -> Bool
$c/= :: ConversationMLSData -> ConversationMLSData -> Bool
/= :: ConversationMLSData -> ConversationMLSData -> Bool
Eq, Int -> ConversationMLSData -> ShowS
[ConversationMLSData] -> ShowS
ConversationMLSData -> String
(Int -> ConversationMLSData -> ShowS)
-> (ConversationMLSData -> String)
-> ([ConversationMLSData] -> ShowS)
-> Show ConversationMLSData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationMLSData -> ShowS
showsPrec :: Int -> ConversationMLSData -> ShowS
$cshow :: ConversationMLSData -> String
show :: ConversationMLSData -> String
$cshowList :: [ConversationMLSData] -> ShowS
showList :: [ConversationMLSData] -> ShowS
Show, (forall x. ConversationMLSData -> Rep ConversationMLSData x)
-> (forall x. Rep ConversationMLSData x -> ConversationMLSData)
-> Generic ConversationMLSData
forall x. Rep ConversationMLSData x -> ConversationMLSData
forall x. ConversationMLSData -> Rep ConversationMLSData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConversationMLSData -> Rep ConversationMLSData x
from :: forall x. ConversationMLSData -> Rep ConversationMLSData x
$cto :: forall x. Rep ConversationMLSData x -> ConversationMLSData
to :: forall x. Rep ConversationMLSData x -> ConversationMLSData
Generic)
  deriving ([ConversationMLSData] -> Value
[ConversationMLSData] -> Encoding
ConversationMLSData -> Value
ConversationMLSData -> Encoding
(ConversationMLSData -> Value)
-> (ConversationMLSData -> Encoding)
-> ([ConversationMLSData] -> Value)
-> ([ConversationMLSData] -> Encoding)
-> ToJSON ConversationMLSData
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConversationMLSData -> Value
toJSON :: ConversationMLSData -> Value
$ctoEncoding :: ConversationMLSData -> Encoding
toEncoding :: ConversationMLSData -> Encoding
$ctoJSONList :: [ConversationMLSData] -> Value
toJSONList :: [ConversationMLSData] -> Value
$ctoEncodingList :: [ConversationMLSData] -> Encoding
toEncodingList :: [ConversationMLSData] -> Encoding
ToJSON, Value -> Parser [ConversationMLSData]
Value -> Parser ConversationMLSData
(Value -> Parser ConversationMLSData)
-> (Value -> Parser [ConversationMLSData])
-> FromJSON ConversationMLSData
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConversationMLSData
parseJSON :: Value -> Parser ConversationMLSData
$cparseJSONList :: Value -> Parser [ConversationMLSData]
parseJSONList :: Value -> Parser [ConversationMLSData]
FromJSON) via Schema ConversationMLSData

arbitraryActiveData :: Gen (Maybe ActiveMLSConversationData)
arbitraryActiveData :: Gen (Maybe ActiveMLSConversationData)
arbitraryActiveData = do
  Epoch
epoch <- Gen Epoch
forall a. Arbitrary a => Gen a
arbitrary
  if Epoch
epoch Epoch -> Epoch -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> Epoch
Epoch Word64
0
    then Maybe ActiveMLSConversationData
-> Gen (Maybe ActiveMLSConversationData)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ActiveMLSConversationData
forall a. Maybe a
Nothing
    else
      (ActiveMLSConversationData -> Maybe ActiveMLSConversationData)
-> Gen ActiveMLSConversationData
-> Gen (Maybe ActiveMLSConversationData)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ActiveMLSConversationData -> Maybe ActiveMLSConversationData
forall a. a -> Maybe a
Just (Gen ActiveMLSConversationData
 -> Gen (Maybe ActiveMLSConversationData))
-> Gen ActiveMLSConversationData
-> Gen (Maybe ActiveMLSConversationData)
forall a b. (a -> b) -> a -> b
$
        Epoch -> UTCTime -> CipherSuiteTag -> ActiveMLSConversationData
ActiveMLSConversationData Epoch
epoch (UTCTime -> CipherSuiteTag -> ActiveMLSConversationData)
-> Gen UTCTime -> Gen (CipherSuiteTag -> ActiveMLSConversationData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UTCTime
forall a. Arbitrary a => Gen a
arbitrary Gen (CipherSuiteTag -> ActiveMLSConversationData)
-> Gen CipherSuiteTag -> Gen ActiveMLSConversationData
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen CipherSuiteTag
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary ConversationMLSData where
  arbitrary :: Gen ConversationMLSData
arbitrary = GroupId -> Maybe ActiveMLSConversationData -> ConversationMLSData
ConversationMLSData (GroupId -> Maybe ActiveMLSConversationData -> ConversationMLSData)
-> Gen GroupId
-> Gen (Maybe ActiveMLSConversationData -> ConversationMLSData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen GroupId
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe ActiveMLSConversationData -> ConversationMLSData)
-> Gen (Maybe ActiveMLSConversationData) -> Gen ConversationMLSData
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe ActiveMLSConversationData)
arbitraryActiveData

cnvmlsEpoch :: ConversationMLSData -> Epoch
cnvmlsEpoch :: ConversationMLSData -> Epoch
cnvmlsEpoch = Epoch
-> (ActiveMLSConversationData -> Epoch)
-> Maybe ActiveMLSConversationData
-> Epoch
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Word64 -> Epoch
Epoch Word64
0) (.epoch) (Maybe ActiveMLSConversationData -> Epoch)
-> (ConversationMLSData -> Maybe ActiveMLSConversationData)
-> ConversationMLSData
-> Epoch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversationMLSData -> Maybe ActiveMLSConversationData
cnvmlsActiveData

mlsDataSchema :: Maybe Version -> ObjectSchema SwaggerDoc ConversationMLSData
mlsDataSchema :: Maybe Version -> ObjectSchema SwaggerDoc ConversationMLSData
mlsDataSchema Maybe Version
v =
  GroupId -> Maybe ActiveMLSConversationData -> ConversationMLSData
ConversationMLSData
    (GroupId -> Maybe ActiveMLSConversationData -> ConversationMLSData)
-> SchemaP SwaggerDoc Object [Pair] ConversationMLSData GroupId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMLSData
     (Maybe ActiveMLSConversationData -> ConversationMLSData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationMLSData -> GroupId
cnvmlsGroupId
      (ConversationMLSData -> GroupId)
-> SchemaP SwaggerDoc Object [Pair] GroupId GroupId
-> SchemaP SwaggerDoc Object [Pair] ConversationMLSData GroupId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value GroupId GroupId
-> SchemaP SwaggerDoc Object [Pair] GroupId GroupId
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
"group_id"
        ((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 base64-encoded MLS group ID")
        SchemaP NamedSwaggerDoc Value Value GroupId GroupId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationMLSData
  (Maybe ActiveMLSConversationData -> ConversationMLSData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMLSData
     (Maybe ActiveMLSConversationData)
-> ObjectSchema SwaggerDoc ConversationMLSData
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationMLSData (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationMLSData a
-> SchemaP SwaggerDoc Object [Pair] ConversationMLSData b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationMLSData -> Maybe ActiveMLSConversationData
cnvmlsActiveData (ConversationMLSData -> Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationMLSData
     (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

optionalActiveMLSConversationDataSchema ::
  Maybe Version ->
  ObjectSchema SwaggerDoc (Maybe ActiveMLSConversationData)
optionalActiveMLSConversationDataSchema :: Maybe Version
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe ActiveMLSConversationData)
optionalActiveMLSConversationDataSchema (Just Version
v)
  | Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
V6 =
      -- legacy serialisation
      Epoch
-> Maybe UTCTime
-> CipherSuiteTag
-> Maybe ActiveMLSConversationData
mk
        (Epoch
 -> Maybe UTCTime
 -> CipherSuiteTag
 -> Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) Epoch
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe UTCTime
      -> CipherSuiteTag -> Maybe ActiveMLSConversationData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Epoch
-> (ActiveMLSConversationData -> Epoch)
-> Maybe ActiveMLSConversationData
-> Epoch
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Word64 -> Epoch
Epoch Word64
0) (.epoch)
          (Maybe ActiveMLSConversationData -> Epoch)
-> SchemaP SwaggerDoc Object [Pair] Epoch Epoch
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) Epoch
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Epoch Epoch
-> SchemaP SwaggerDoc Object [Pair] Epoch Epoch
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
"epoch"
            ((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 epoch number of the corresponding MLS group")
            SchemaP NamedSwaggerDoc Value Value Epoch Epoch
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe ActiveMLSConversationData)
  (Maybe UTCTime
   -> CipherSuiteTag -> Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe UTCTime)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (CipherSuiteTag -> Maybe ActiveMLSConversationData)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) a
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ActiveMLSConversationData -> UTCTime)
-> Maybe ActiveMLSConversationData -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.epochTimestamp)
          (Maybe ActiveMLSConversationData -> Maybe UTCTime)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UTCTime) (Maybe UTCTime)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe UTCTime)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UTCTime) (Maybe UTCTime)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"epoch_timestamp" (Text
-> SchemaP SwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime)
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime)
forall doc doc' v m a b.
HasObject doc doc' =>
Text -> SchemaP doc v m a b -> SchemaP doc' v m a b
named Text
"Epoch Timestamp" (SchemaP SwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime)
 -> SchemaP
      NamedSwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime))
-> (ValueSchema NamedSwaggerDoc UTCTime
    -> SchemaP SwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime))
-> ValueSchema NamedSwaggerDoc UTCTime
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueSchema SwaggerDoc UTCTime
-> SchemaP SwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime)
forall d a. Monoid d => ValueSchema d a -> ValueSchema d (Maybe a)
nullable (ValueSchema SwaggerDoc UTCTime
 -> SchemaP SwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime))
-> (ValueSchema NamedSwaggerDoc UTCTime
    -> ValueSchema SwaggerDoc UTCTime)
-> ValueSchema NamedSwaggerDoc UTCTime
-> SchemaP SwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueSchema NamedSwaggerDoc UTCTime
-> ValueSchema SwaggerDoc UTCTime
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed (ValueSchema NamedSwaggerDoc UTCTime
 -> SchemaP
      NamedSwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime))
-> ValueSchema NamedSwaggerDoc UTCTime
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe UTCTime) (Maybe UTCTime)
forall a b. (a -> b) -> a -> b
$ ValueSchema NamedSwaggerDoc UTCTime
utcTimeSchema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe ActiveMLSConversationData)
  (CipherSuiteTag -> Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     CipherSuiteTag
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe ActiveMLSConversationData)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) a
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CipherSuiteTag
-> (ActiveMLSConversationData -> CipherSuiteTag)
-> Maybe ActiveMLSConversationData
-> CipherSuiteTag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CipherSuiteTag
MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 (.ciphersuite)
          (Maybe ActiveMLSConversationData -> CipherSuiteTag)
-> SchemaP SwaggerDoc Object [Pair] CipherSuiteTag CipherSuiteTag
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     CipherSuiteTag
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value CipherSuiteTag CipherSuiteTag
-> SchemaP SwaggerDoc Object [Pair] CipherSuiteTag CipherSuiteTag
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
"cipher_suite"
            ((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 cipher suite of the corresponding MLS group")
            SchemaP NamedSwaggerDoc Value Value CipherSuiteTag CipherSuiteTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
  where
    mk :: Epoch -> Maybe UTCTime -> CipherSuiteTag -> Maybe ActiveMLSConversationData
    mk :: Epoch
-> Maybe UTCTime
-> CipherSuiteTag
-> Maybe ActiveMLSConversationData
mk (Epoch Word64
0) Maybe UTCTime
_ CipherSuiteTag
_ = Maybe ActiveMLSConversationData
forall a. Maybe a
Nothing
    mk Epoch
epoch Maybe UTCTime
ts CipherSuiteTag
cs = Epoch -> UTCTime -> CipherSuiteTag -> ActiveMLSConversationData
ActiveMLSConversationData Epoch
epoch (UTCTime -> CipherSuiteTag -> ActiveMLSConversationData)
-> Maybe UTCTime
-> Maybe (CipherSuiteTag -> ActiveMLSConversationData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
ts Maybe (CipherSuiteTag -> ActiveMLSConversationData)
-> Maybe CipherSuiteTag -> Maybe ActiveMLSConversationData
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CipherSuiteTag -> Maybe CipherSuiteTag
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CipherSuiteTag
cs
optionalActiveMLSConversationDataSchema Maybe Version
_ =
  Epoch
-> Maybe UTCTime
-> Maybe CipherSuiteTag
-> Maybe ActiveMLSConversationData
mk
    (Epoch
 -> Maybe UTCTime
 -> Maybe CipherSuiteTag
 -> Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) Epoch
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe UTCTime
      -> Maybe CipherSuiteTag -> Maybe ActiveMLSConversationData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Epoch
-> (ActiveMLSConversationData -> Epoch)
-> Maybe ActiveMLSConversationData
-> Epoch
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Word64 -> Epoch
Epoch Word64
0) (.epoch)
      (Maybe ActiveMLSConversationData -> Epoch)
-> SchemaP SwaggerDoc Object [Pair] Epoch Epoch
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) Epoch
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Epoch Epoch
-> SchemaP SwaggerDoc Object [Pair] Epoch Epoch
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
"epoch"
        ((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 epoch number of the corresponding MLS group")
        SchemaP NamedSwaggerDoc Value Value Epoch Epoch
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe ActiveMLSConversationData)
  (Maybe UTCTime
   -> Maybe CipherSuiteTag -> Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe UTCTime)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe CipherSuiteTag -> Maybe ActiveMLSConversationData)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) a
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ActiveMLSConversationData -> UTCTime)
-> Maybe ActiveMLSConversationData -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.epochTimestamp)
      (Maybe ActiveMLSConversationData -> Maybe UTCTime)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UTCTime) (Maybe UTCTime)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe UTCTime)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] UTCTime (Maybe UTCTime)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UTCTime) (Maybe UTCTime)
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)
-> ValueSchema NamedSwaggerDoc UTCTime
-> SchemaP SwaggerDoc Object [Pair] UTCTime (Maybe UTCTime)
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
"epoch_timestamp"
            ((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 timestamp of the epoch number")
            ValueSchema NamedSwaggerDoc UTCTime
utcTimeSchema
        )
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe ActiveMLSConversationData)
  (Maybe CipherSuiteTag -> Maybe ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe CipherSuiteTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe ActiveMLSConversationData)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) a
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ActiveMLSConversationData) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ActiveMLSConversationData -> CipherSuiteTag)
-> Maybe ActiveMLSConversationData -> Maybe CipherSuiteTag
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.ciphersuite)
      (Maybe ActiveMLSConversationData -> Maybe CipherSuiteTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe CipherSuiteTag)
     (Maybe CipherSuiteTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActiveMLSConversationData)
     (Maybe CipherSuiteTag)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] CipherSuiteTag (Maybe CipherSuiteTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe CipherSuiteTag)
     (Maybe CipherSuiteTag)
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 CipherSuiteTag CipherSuiteTag
-> SchemaP
     SwaggerDoc Object [Pair] CipherSuiteTag (Maybe CipherSuiteTag)
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
"cipher_suite"
            ((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 cipher suite of the corresponding MLS group")
            SchemaP NamedSwaggerDoc Value Value CipherSuiteTag CipherSuiteTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        )
  where
    mk :: Epoch -> Maybe UTCTime -> Maybe CipherSuiteTag -> Maybe ActiveMLSConversationData
    mk :: Epoch
-> Maybe UTCTime
-> Maybe CipherSuiteTag
-> Maybe ActiveMLSConversationData
mk (Epoch Word64
0) Maybe UTCTime
_ Maybe CipherSuiteTag
_ = Maybe ActiveMLSConversationData
forall a. Maybe a
Nothing
    mk Epoch
epoch Maybe UTCTime
ts Maybe CipherSuiteTag
cs = Epoch -> UTCTime -> CipherSuiteTag -> ActiveMLSConversationData
ActiveMLSConversationData Epoch
epoch (UTCTime -> CipherSuiteTag -> ActiveMLSConversationData)
-> Maybe UTCTime
-> Maybe (CipherSuiteTag -> ActiveMLSConversationData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
ts Maybe (CipherSuiteTag -> ActiveMLSConversationData)
-> Maybe CipherSuiteTag -> Maybe ActiveMLSConversationData
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe CipherSuiteTag
cs

instance ToSchema ConversationMLSData where
  schema :: ValueSchema NamedSwaggerDoc ConversationMLSData
schema = Text
-> ObjectSchema SwaggerDoc ConversationMLSData
-> ValueSchema NamedSwaggerDoc ConversationMLSData
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ConversationMLSData" (Maybe Version -> ObjectSchema SwaggerDoc ConversationMLSData
mlsDataSchema Maybe Version
forall a. Maybe a
Nothing)

instance ToSchema (Versioned 'V5 ConversationMLSData) where
  schema :: ValueSchema NamedSwaggerDoc (Versioned 'V5 ConversationMLSData)
schema = ConversationMLSData -> Versioned 'V5 ConversationMLSData
forall (v :: Version) a. a -> Versioned v a
Versioned (ConversationMLSData -> Versioned 'V5 ConversationMLSData)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned 'V5 ConversationMLSData)
     ConversationMLSData
-> ValueSchema NamedSwaggerDoc (Versioned 'V5 ConversationMLSData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Versioned 'V5 ConversationMLSData)
     ConversationMLSData
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Versioned 'V5 ConversationMLSData)
     ConversationMLSData
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ConversationMLSDataV5" (Versioned 'V5 ConversationMLSData -> ConversationMLSData
forall (v :: Version) a. Versioned v a -> a
unVersioned (Versioned 'V5 ConversationMLSData -> ConversationMLSData)
-> ObjectSchema SwaggerDoc ConversationMLSData
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Versioned 'V5 ConversationMLSData)
     ConversationMLSData
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version -> ObjectSchema SwaggerDoc ConversationMLSData
mlsDataSchema (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
V5))

-- TODO: Fix API compatibility
data ActiveMLSConversationData = ActiveMLSConversationData
  { -- | The current epoch number of the corresponding MLS group.
    ActiveMLSConversationData -> Epoch
epoch :: Epoch,
    -- | The time stamp of the epoch.
    ActiveMLSConversationData -> UTCTime
epochTimestamp :: UTCTime,
    -- | The cipher suite to be used in the MLS group.
    ActiveMLSConversationData -> CipherSuiteTag
ciphersuite :: CipherSuiteTag
  }
  deriving stock (ActiveMLSConversationData -> ActiveMLSConversationData -> Bool
(ActiveMLSConversationData -> ActiveMLSConversationData -> Bool)
-> (ActiveMLSConversationData -> ActiveMLSConversationData -> Bool)
-> Eq ActiveMLSConversationData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveMLSConversationData -> ActiveMLSConversationData -> Bool
== :: ActiveMLSConversationData -> ActiveMLSConversationData -> Bool
$c/= :: ActiveMLSConversationData -> ActiveMLSConversationData -> Bool
/= :: ActiveMLSConversationData -> ActiveMLSConversationData -> Bool
Eq, Int -> ActiveMLSConversationData -> ShowS
[ActiveMLSConversationData] -> ShowS
ActiveMLSConversationData -> String
(Int -> ActiveMLSConversationData -> ShowS)
-> (ActiveMLSConversationData -> String)
-> ([ActiveMLSConversationData] -> ShowS)
-> Show ActiveMLSConversationData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActiveMLSConversationData -> ShowS
showsPrec :: Int -> ActiveMLSConversationData -> ShowS
$cshow :: ActiveMLSConversationData -> String
show :: ActiveMLSConversationData -> String
$cshowList :: [ActiveMLSConversationData] -> ShowS
showList :: [ActiveMLSConversationData] -> ShowS
Show, (forall x.
 ActiveMLSConversationData -> Rep ActiveMLSConversationData x)
-> (forall x.
    Rep ActiveMLSConversationData x -> ActiveMLSConversationData)
-> Generic ActiveMLSConversationData
forall x.
Rep ActiveMLSConversationData x -> ActiveMLSConversationData
forall x.
ActiveMLSConversationData -> Rep ActiveMLSConversationData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ActiveMLSConversationData -> Rep ActiveMLSConversationData x
from :: forall x.
ActiveMLSConversationData -> Rep ActiveMLSConversationData x
$cto :: forall x.
Rep ActiveMLSConversationData x -> ActiveMLSConversationData
to :: forall x.
Rep ActiveMLSConversationData x -> ActiveMLSConversationData
Generic)
  deriving (Gen ActiveMLSConversationData
Gen ActiveMLSConversationData
-> (ActiveMLSConversationData -> [ActiveMLSConversationData])
-> Arbitrary ActiveMLSConversationData
ActiveMLSConversationData -> [ActiveMLSConversationData]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ActiveMLSConversationData
arbitrary :: Gen ActiveMLSConversationData
$cshrink :: ActiveMLSConversationData -> [ActiveMLSConversationData]
shrink :: ActiveMLSConversationData -> [ActiveMLSConversationData]
Arbitrary) via GenericUniform ActiveMLSConversationData
  deriving ([ActiveMLSConversationData] -> Value
[ActiveMLSConversationData] -> Encoding
ActiveMLSConversationData -> Value
ActiveMLSConversationData -> Encoding
(ActiveMLSConversationData -> Value)
-> (ActiveMLSConversationData -> Encoding)
-> ([ActiveMLSConversationData] -> Value)
-> ([ActiveMLSConversationData] -> Encoding)
-> ToJSON ActiveMLSConversationData
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ActiveMLSConversationData -> Value
toJSON :: ActiveMLSConversationData -> Value
$ctoEncoding :: ActiveMLSConversationData -> Encoding
toEncoding :: ActiveMLSConversationData -> Encoding
$ctoJSONList :: [ActiveMLSConversationData] -> Value
toJSONList :: [ActiveMLSConversationData] -> Value
$ctoEncodingList :: [ActiveMLSConversationData] -> Encoding
toEncodingList :: [ActiveMLSConversationData] -> Encoding
ToJSON, Value -> Parser [ActiveMLSConversationData]
Value -> Parser ActiveMLSConversationData
(Value -> Parser ActiveMLSConversationData)
-> (Value -> Parser [ActiveMLSConversationData])
-> FromJSON ActiveMLSConversationData
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ActiveMLSConversationData
parseJSON :: Value -> Parser ActiveMLSConversationData
$cparseJSONList :: Value -> Parser [ActiveMLSConversationData]
parseJSONList :: Value -> Parser [ActiveMLSConversationData]
FromJSON) via Schema ActiveMLSConversationData

instance ToSchema ActiveMLSConversationData where
  schema :: ValueSchema NamedSwaggerDoc ActiveMLSConversationData
schema = Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ActiveMLSConversationData
     ActiveMLSConversationData
-> ValueSchema NamedSwaggerDoc ActiveMLSConversationData
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ActiveMLSConversationData" SchemaP
  SwaggerDoc
  Object
  [Pair]
  ActiveMLSConversationData
  ActiveMLSConversationData
activeMLSConversationDataSchema

activeMLSConversationDataSchema :: ObjectSchema SwaggerDoc ActiveMLSConversationData
activeMLSConversationDataSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  ActiveMLSConversationData
  ActiveMLSConversationData
activeMLSConversationDataSchema =
  Epoch -> UTCTime -> CipherSuiteTag -> ActiveMLSConversationData
ActiveMLSConversationData
    (Epoch -> UTCTime -> CipherSuiteTag -> ActiveMLSConversationData)
-> SchemaP SwaggerDoc Object [Pair] ActiveMLSConversationData Epoch
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ActiveMLSConversationData
     (UTCTime -> CipherSuiteTag -> ActiveMLSConversationData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.epoch)
      (ActiveMLSConversationData -> Epoch)
-> SchemaP SwaggerDoc Object [Pair] Epoch Epoch
-> SchemaP SwaggerDoc Object [Pair] ActiveMLSConversationData Epoch
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Epoch Epoch
-> SchemaP SwaggerDoc Object [Pair] Epoch Epoch
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
"epoch"
        ((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 epoch number of the corresponding MLS group")
        SchemaP NamedSwaggerDoc Value Value Epoch Epoch
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ActiveMLSConversationData
  (UTCTime -> CipherSuiteTag -> ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc Object [Pair] ActiveMLSConversationData UTCTime
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ActiveMLSConversationData
     (CipherSuiteTag -> ActiveMLSConversationData)
forall a b.
SchemaP SwaggerDoc Object [Pair] ActiveMLSConversationData (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ActiveMLSConversationData a
-> SchemaP SwaggerDoc Object [Pair] ActiveMLSConversationData b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.epochTimestamp)
      (ActiveMLSConversationData -> UTCTime)
-> SchemaP SwaggerDoc Object [Pair] UTCTime UTCTime
-> SchemaP
     SwaggerDoc Object [Pair] ActiveMLSConversationData UTCTime
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc UTCTime
-> SchemaP SwaggerDoc Object [Pair] UTCTime UTCTime
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
"epoch_timestamp"
        ((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 timestamp of the epoch number")
        ValueSchema NamedSwaggerDoc UTCTime
utcTimeSchema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ActiveMLSConversationData
  (CipherSuiteTag -> ActiveMLSConversationData)
-> SchemaP
     SwaggerDoc Object [Pair] ActiveMLSConversationData CipherSuiteTag
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ActiveMLSConversationData
     ActiveMLSConversationData
forall a b.
SchemaP SwaggerDoc Object [Pair] ActiveMLSConversationData (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ActiveMLSConversationData a
-> SchemaP SwaggerDoc Object [Pair] ActiveMLSConversationData b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.ciphersuite)
      (ActiveMLSConversationData -> CipherSuiteTag)
-> SchemaP SwaggerDoc Object [Pair] CipherSuiteTag CipherSuiteTag
-> SchemaP
     SwaggerDoc Object [Pair] ActiveMLSConversationData CipherSuiteTag
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value CipherSuiteTag CipherSuiteTag
-> SchemaP SwaggerDoc Object [Pair] CipherSuiteTag CipherSuiteTag
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
"cipher_suite"
        ((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 cipher suite of the corresponding MLS group")
        SchemaP NamedSwaggerDoc Value Value CipherSuiteTag CipherSuiteTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

-- | Conversation protocol and protocol-specific data.
data Protocol
  = ProtocolProteus
  | ProtocolMLS ConversationMLSData
  | ProtocolMixed ConversationMLSData
  deriving (Protocol -> Protocol -> Bool
(Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool) -> Eq Protocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
/= :: Protocol -> Protocol -> Bool
Eq, Int -> Protocol -> ShowS
[Protocol] -> ShowS
Protocol -> String
(Int -> Protocol -> ShowS)
-> (Protocol -> String) -> ([Protocol] -> ShowS) -> Show Protocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Protocol -> ShowS
showsPrec :: Int -> Protocol -> ShowS
$cshow :: Protocol -> String
show :: Protocol -> String
$cshowList :: [Protocol] -> ShowS
showList :: [Protocol] -> ShowS
Show, (forall x. Protocol -> Rep Protocol x)
-> (forall x. Rep Protocol x -> Protocol) -> Generic Protocol
forall x. Rep Protocol x -> Protocol
forall x. Protocol -> Rep Protocol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Protocol -> Rep Protocol x
from :: forall x. Protocol -> Rep Protocol x
$cto :: forall x. Rep Protocol x -> Protocol
to :: forall x. Rep Protocol x -> Protocol
Generic)
  deriving (Gen Protocol
Gen Protocol -> (Protocol -> [Protocol]) -> Arbitrary Protocol
Protocol -> [Protocol]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Protocol
arbitrary :: Gen Protocol
$cshrink :: Protocol -> [Protocol]
shrink :: Protocol -> [Protocol]
Arbitrary) via GenericUniform Protocol

$(makePrisms ''Protocol)

protocolTag :: Protocol -> ProtocolTag
protocolTag :: Protocol -> ProtocolTag
protocolTag Protocol
ProtocolProteus = ProtocolTag
ProtocolProteusTag
protocolTag (ProtocolMLS ConversationMLSData
_) = ProtocolTag
ProtocolMLSTag
protocolTag (ProtocolMixed ConversationMLSData
_) = ProtocolTag
ProtocolMixedTag

-- | Certain actions need to be performed at the level of the underlying
-- protocol (MLS, mostly) before being applied to conversations. This function
-- returns whether a given action tag is directly applicable to a conversation
-- with the given protocol.
protocolValidAction :: Protocol -> ConversationActionTag -> Bool
protocolValidAction :: Protocol -> ConversationActionTag -> Bool
protocolValidAction Protocol
ProtocolProteus ConversationActionTag
_ = Bool
True
protocolValidAction (ProtocolMixed ConversationMLSData
_) ConversationActionTag
_ = Bool
True
protocolValidAction (ProtocolMLS ConversationMLSData
_) ConversationActionTag
ConversationJoinTag = Bool
False
protocolValidAction (ProtocolMLS ConversationMLSData
_) ConversationActionTag
ConversationLeaveTag = Bool
True
protocolValidAction (ProtocolMLS ConversationMLSData
_) ConversationActionTag
ConversationRemoveMembersTag = Bool
False
protocolValidAction (ProtocolMLS ConversationMLSData
_) ConversationActionTag
ConversationDeleteTag = Bool
True
protocolValidAction (ProtocolMLS ConversationMLSData
_) ConversationActionTag
_ = Bool
True

instance ToSchema ProtocolTag where
  schema :: ValueSchema NamedSwaggerDoc ProtocolTag
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 @Text Text
"Protocol" (SchemaP [Value] Text (Alt Maybe Text) ProtocolTag ProtocolTag
 -> ValueSchema NamedSwaggerDoc ProtocolTag)
-> SchemaP [Value] Text (Alt Maybe Text) ProtocolTag ProtocolTag
-> ValueSchema NamedSwaggerDoc ProtocolTag
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) ProtocolTag ProtocolTag]
-> SchemaP [Value] Text (Alt Maybe Text) ProtocolTag ProtocolTag
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> ProtocolTag
-> SchemaP [Value] Text (Alt Maybe Text) ProtocolTag ProtocolTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"proteus" ProtocolTag
ProtocolProteusTag,
          Text
-> ProtocolTag
-> SchemaP [Value] Text (Alt Maybe Text) ProtocolTag ProtocolTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"mls" ProtocolTag
ProtocolMLSTag,
          Text
-> ProtocolTag
-> SchemaP [Value] Text (Alt Maybe Text) ProtocolTag ProtocolTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"mixed" ProtocolTag
ProtocolMixedTag
        ]

deriving via (Schema ProtocolTag) instance FromJSON ProtocolTag

deriving via (Schema ProtocolTag) instance ToJSON ProtocolTag

protocolTagSchema :: ObjectSchema SwaggerDoc ProtocolTag
protocolTagSchema :: ObjectSchema SwaggerDoc ProtocolTag
protocolTagSchema = (Maybe ProtocolTag -> ProtocolTag)
-> SchemaP SwaggerDoc Object [Pair] ProtocolTag (Maybe ProtocolTag)
-> ObjectSchema SwaggerDoc ProtocolTag
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] ProtocolTag a
-> SchemaP SwaggerDoc Object [Pair] ProtocolTag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProtocolTag -> Maybe ProtocolTag -> ProtocolTag
forall a. a -> Maybe a -> a
fromMaybe ProtocolTag
ProtocolProteusTag) (Text
-> ValueSchema NamedSwaggerDoc ProtocolTag
-> SchemaP SwaggerDoc Object [Pair] ProtocolTag (Maybe ProtocolTag)
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" ValueSchema NamedSwaggerDoc ProtocolTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

protocolSchema :: Maybe Version -> ObjectSchema SwaggerDoc Protocol
protocolSchema :: Maybe Version -> ObjectSchema SwaggerDoc Protocol
protocolSchema Maybe Version
v =
  (ProtocolTag, Protocol) -> Protocol
forall a b. (a, b) -> b
snd
    ((ProtocolTag, Protocol) -> Protocol)
-> SchemaP
     SwaggerDoc Object [Pair] Protocol (ProtocolTag, Protocol)
-> ObjectSchema SwaggerDoc Protocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Protocol -> ProtocolTag
protocolTag (Protocol -> ProtocolTag)
-> (Protocol -> Protocol) -> Protocol -> (ProtocolTag, Protocol)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Protocol -> Protocol
forall a. a -> a
id)
      (Protocol -> (ProtocolTag, Protocol))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (ProtocolTag, Protocol)
     (ProtocolTag, Protocol)
-> SchemaP
     SwaggerDoc Object [Pair] Protocol (ProtocolTag, Protocol)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] (ProtocolTag, Protocol) ProtocolTag
-> SchemaP
     SwaggerDoc
     (Object, ProtocolTag)
     [Pair]
     (ProtocolTag, Protocol)
     Protocol
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (ProtocolTag, Protocol)
     (ProtocolTag, Protocol)
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
        ((ProtocolTag, Protocol) -> ProtocolTag
forall a b. (a, b) -> a
fst ((ProtocolTag, Protocol) -> ProtocolTag)
-> ObjectSchema SwaggerDoc ProtocolTag
-> SchemaP
     SwaggerDoc Object [Pair] (ProtocolTag, Protocol) ProtocolTag
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ObjectSchema SwaggerDoc ProtocolTag
protocolTagSchema)
        ((ProtocolTag, Protocol) -> Protocol
forall a b. (a, b) -> b
snd ((ProtocolTag, Protocol) -> Protocol)
-> SchemaP
     SwaggerDoc (Object, ProtocolTag) [Pair] Protocol Protocol
-> SchemaP
     SwaggerDoc
     (Object, ProtocolTag)
     [Pair]
     (ProtocolTag, Protocol)
     Protocol
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (ProtocolTag -> ObjectSchema SwaggerDoc Protocol)
-> SchemaP
     SwaggerDoc (Object, ProtocolTag) [Pair] Protocol Protocol
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 (Maybe Version -> ProtocolTag -> ObjectSchema SwaggerDoc Protocol
protocolDataSchema Maybe Version
v))

instance ToSchema Protocol where
  schema :: ValueSchema NamedSwaggerDoc Protocol
schema = Text
-> ObjectSchema SwaggerDoc Protocol
-> ValueSchema NamedSwaggerDoc Protocol
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Protocol" (Maybe Version -> ObjectSchema SwaggerDoc Protocol
protocolSchema Maybe Version
forall a. Maybe a
Nothing)

instance ToSchema (Versioned 'V5 Protocol) where
  schema :: ValueSchema NamedSwaggerDoc (Versioned 'V5 Protocol)
schema = Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Versioned 'V5 Protocol)
     (Versioned 'V5 Protocol)
-> ValueSchema NamedSwaggerDoc (Versioned 'V5 Protocol)
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Protocol" (Protocol -> Versioned 'V5 Protocol
forall (v :: Version) a. a -> Versioned v a
Versioned (Protocol -> Versioned 'V5 Protocol)
-> SchemaP
     SwaggerDoc Object [Pair] (Versioned 'V5 Protocol) Protocol
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Versioned 'V5 Protocol)
     (Versioned 'V5 Protocol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned 'V5 Protocol -> Protocol
forall (v :: Version) a. Versioned v a -> a
unVersioned (Versioned 'V5 Protocol -> Protocol)
-> ObjectSchema SwaggerDoc Protocol
-> SchemaP
     SwaggerDoc Object [Pair] (Versioned 'V5 Protocol) Protocol
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Maybe Version -> ObjectSchema SwaggerDoc Protocol
protocolSchema (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
V5))

deriving via (Schema Protocol) instance FromJSON Protocol

deriving via (Schema Protocol) instance ToJSON Protocol

deriving via (Schema Protocol) instance S.ToSchema Protocol

protocolDataSchema :: Maybe Version -> ProtocolTag -> ObjectSchema SwaggerDoc Protocol
protocolDataSchema :: Maybe Version -> ProtocolTag -> ObjectSchema SwaggerDoc Protocol
protocolDataSchema Maybe Version
_ ProtocolTag
ProtocolProteusTag = Prism' Protocol ()
-> SchemaP SwaggerDoc Object [Pair] () ()
-> ObjectSchema SwaggerDoc Protocol
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 () (f ()) -> p Protocol (f Protocol)
Prism' Protocol ()
_ProtocolProteus (() -> SchemaP SwaggerDoc Object [Pair] () ()
forall a. a -> SchemaP SwaggerDoc Object [Pair] () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
protocolDataSchema Maybe Version
v ProtocolTag
ProtocolMLSTag = Prism' Protocol ConversationMLSData
-> ObjectSchema SwaggerDoc ConversationMLSData
-> ObjectSchema SwaggerDoc Protocol
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 ConversationMLSData (f ConversationMLSData)
-> p Protocol (f Protocol)
Prism' Protocol ConversationMLSData
_ProtocolMLS (Maybe Version -> ObjectSchema SwaggerDoc ConversationMLSData
mlsDataSchema Maybe Version
v)
protocolDataSchema Maybe Version
v ProtocolTag
ProtocolMixedTag = Prism' Protocol ConversationMLSData
-> ObjectSchema SwaggerDoc ConversationMLSData
-> ObjectSchema SwaggerDoc Protocol
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 ConversationMLSData (f ConversationMLSData)
-> p Protocol (f Protocol)
Prism' Protocol ConversationMLSData
_ProtocolMixed (Maybe Version -> ObjectSchema SwaggerDoc ConversationMLSData
mlsDataSchema Maybe Version
v)

newtype ProtocolUpdate = ProtocolUpdate {ProtocolUpdate -> ProtocolTag
unProtocolUpdate :: ProtocolTag}
  deriving (Int -> ProtocolUpdate -> ShowS
[ProtocolUpdate] -> ShowS
ProtocolUpdate -> String
(Int -> ProtocolUpdate -> ShowS)
-> (ProtocolUpdate -> String)
-> ([ProtocolUpdate] -> ShowS)
-> Show ProtocolUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolUpdate -> ShowS
showsPrec :: Int -> ProtocolUpdate -> ShowS
$cshow :: ProtocolUpdate -> String
show :: ProtocolUpdate -> String
$cshowList :: [ProtocolUpdate] -> ShowS
showList :: [ProtocolUpdate] -> ShowS
Show, ProtocolUpdate -> ProtocolUpdate -> Bool
(ProtocolUpdate -> ProtocolUpdate -> Bool)
-> (ProtocolUpdate -> ProtocolUpdate -> Bool) -> Eq ProtocolUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolUpdate -> ProtocolUpdate -> Bool
== :: ProtocolUpdate -> ProtocolUpdate -> Bool
$c/= :: ProtocolUpdate -> ProtocolUpdate -> Bool
/= :: ProtocolUpdate -> ProtocolUpdate -> Bool
Eq, (forall x. ProtocolUpdate -> Rep ProtocolUpdate x)
-> (forall x. Rep ProtocolUpdate x -> ProtocolUpdate)
-> Generic ProtocolUpdate
forall x. Rep ProtocolUpdate x -> ProtocolUpdate
forall x. ProtocolUpdate -> Rep ProtocolUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProtocolUpdate -> Rep ProtocolUpdate x
from :: forall x. ProtocolUpdate -> Rep ProtocolUpdate x
$cto :: forall x. Rep ProtocolUpdate x -> ProtocolUpdate
to :: forall x. Rep ProtocolUpdate x -> ProtocolUpdate
Generic)
  deriving (Gen ProtocolUpdate
Gen ProtocolUpdate
-> (ProtocolUpdate -> [ProtocolUpdate]) -> Arbitrary ProtocolUpdate
ProtocolUpdate -> [ProtocolUpdate]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ProtocolUpdate
arbitrary :: Gen ProtocolUpdate
$cshrink :: ProtocolUpdate -> [ProtocolUpdate]
shrink :: ProtocolUpdate -> [ProtocolUpdate]
Arbitrary) via GenericUniform ProtocolUpdate

instance ToSchema ProtocolUpdate where
  schema :: ValueSchema NamedSwaggerDoc ProtocolUpdate
schema = Text
-> SchemaP SwaggerDoc Object [Pair] ProtocolUpdate ProtocolUpdate
-> ValueSchema NamedSwaggerDoc ProtocolUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ProtocolUpdate" (ProtocolTag -> ProtocolUpdate
ProtocolUpdate (ProtocolTag -> ProtocolUpdate)
-> SchemaP SwaggerDoc Object [Pair] ProtocolUpdate ProtocolTag
-> SchemaP SwaggerDoc Object [Pair] ProtocolUpdate ProtocolUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolUpdate -> ProtocolTag
unProtocolUpdate (ProtocolUpdate -> ProtocolTag)
-> ObjectSchema SwaggerDoc ProtocolTag
-> SchemaP SwaggerDoc Object [Pair] ProtocolUpdate ProtocolTag
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ObjectSchema SwaggerDoc ProtocolTag
protocolTagSchema)

deriving via (Schema ProtocolUpdate) instance FromJSON ProtocolUpdate

deriving via (Schema ProtocolUpdate) instance ToJSON ProtocolUpdate

deriving via (Schema ProtocolUpdate) instance S.ToSchema ProtocolUpdate