{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE StrictData #-}

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

-- | > docs/reference/user/connection.md {#RefConnection}
--
-- Types for connections between users.
module Wire.API.Connection
  ( -- * UserConnection
    UserConnection (..),
    UserConnectionList (..),
    ConnectionsPage,
    ConnectionPagingState,
    pattern ConnectionPagingState,
    Relation (..),
    RelationWithHistory (..),
    relationDropHistory,
    relationWithHistory,

    -- * Requests
    ConnectionRequest (..),
    ConnectionUpdate (..),
    ListConnectionsRequestPaginated,
  )
where

import Cassandra qualified as C
import Control.Applicative (optional)
import Control.Lens ((?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Id
import Data.Json.Util (UTCTimeMillis)
import Data.OpenApi qualified as S
import Data.Qualified (Qualified (qUnqualified), deprecatedSchema)
import Data.Range
import Data.Schema
import Data.Text as Text
import Imports
import Servant.API
import Wire.API.Routes.MultiTablePaging
import Wire.Arbitrary (Arbitrary (..), GenericUniform (..))

--------------------------------------------------------------------------------
-- UserConnectionList

-- | Request to get a paginated list of connection
type ListConnectionsRequestPaginated = GetMultiTablePageRequest "Connections" LocalOrRemoteTable 500 100

-- | A page in response to 'ListConnectionsRequestPaginated'
type ConnectionsPage = MultiTablePage "Connections" "connections" LocalOrRemoteTable UserConnection

type ConnectionPagingName = "ConnectionIds"

type ConnectionPagingState = MultiTablePagingState ConnectionPagingName LocalOrRemoteTable

pattern ConnectionPagingState :: tables -> Maybe ByteString -> MultiTablePagingState name tables
pattern $mConnectionPagingState :: forall {r} {tables} {name :: Symbol}.
MultiTablePagingState name tables
-> (tables -> Maybe ByteString -> r) -> ((# #) -> r) -> r
$bConnectionPagingState :: forall tables (name :: Symbol).
tables -> Maybe ByteString -> MultiTablePagingState name tables
ConnectionPagingState table state = MultiTablePagingState table state

-- | Response type for endpoints returning lists of connections.
data UserConnectionList = UserConnectionList
  { UserConnectionList -> [UserConnection]
clConnections :: [UserConnection],
    -- | Pagination flag ("we have more results")
    UserConnectionList -> Bool
clHasMore :: Bool
  }
  deriving stock (UserConnectionList -> UserConnectionList -> Bool
(UserConnectionList -> UserConnectionList -> Bool)
-> (UserConnectionList -> UserConnectionList -> Bool)
-> Eq UserConnectionList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserConnectionList -> UserConnectionList -> Bool
== :: UserConnectionList -> UserConnectionList -> Bool
$c/= :: UserConnectionList -> UserConnectionList -> Bool
/= :: UserConnectionList -> UserConnectionList -> Bool
Eq, Int -> UserConnectionList -> ShowS
[UserConnectionList] -> ShowS
UserConnectionList -> String
(Int -> UserConnectionList -> ShowS)
-> (UserConnectionList -> String)
-> ([UserConnectionList] -> ShowS)
-> Show UserConnectionList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserConnectionList -> ShowS
showsPrec :: Int -> UserConnectionList -> ShowS
$cshow :: UserConnectionList -> String
show :: UserConnectionList -> String
$cshowList :: [UserConnectionList] -> ShowS
showList :: [UserConnectionList] -> ShowS
Show, (forall x. UserConnectionList -> Rep UserConnectionList x)
-> (forall x. Rep UserConnectionList x -> UserConnectionList)
-> Generic UserConnectionList
forall x. Rep UserConnectionList x -> UserConnectionList
forall x. UserConnectionList -> Rep UserConnectionList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserConnectionList -> Rep UserConnectionList x
from :: forall x. UserConnectionList -> Rep UserConnectionList x
$cto :: forall x. Rep UserConnectionList x -> UserConnectionList
to :: forall x. Rep UserConnectionList x -> UserConnectionList
Generic)
  deriving (Gen UserConnectionList
Gen UserConnectionList
-> (UserConnectionList -> [UserConnectionList])
-> Arbitrary UserConnectionList
UserConnectionList -> [UserConnectionList]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserConnectionList
arbitrary :: Gen UserConnectionList
$cshrink :: UserConnectionList -> [UserConnectionList]
shrink :: UserConnectionList -> [UserConnectionList]
Arbitrary) via (GenericUniform UserConnectionList)
  deriving (Value -> Parser [UserConnectionList]
Value -> Parser UserConnectionList
(Value -> Parser UserConnectionList)
-> (Value -> Parser [UserConnectionList])
-> FromJSON UserConnectionList
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserConnectionList
parseJSON :: Value -> Parser UserConnectionList
$cparseJSONList :: Value -> Parser [UserConnectionList]
parseJSONList :: Value -> Parser [UserConnectionList]
FromJSON, [UserConnectionList] -> Value
[UserConnectionList] -> Encoding
UserConnectionList -> Value
UserConnectionList -> Encoding
(UserConnectionList -> Value)
-> (UserConnectionList -> Encoding)
-> ([UserConnectionList] -> Value)
-> ([UserConnectionList] -> Encoding)
-> ToJSON UserConnectionList
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserConnectionList -> Value
toJSON :: UserConnectionList -> Value
$ctoEncoding :: UserConnectionList -> Encoding
toEncoding :: UserConnectionList -> Encoding
$ctoJSONList :: [UserConnectionList] -> Value
toJSONList :: [UserConnectionList] -> Value
$ctoEncodingList :: [UserConnectionList] -> Encoding
toEncodingList :: [UserConnectionList] -> Encoding
ToJSON, Typeable UserConnectionList
Typeable UserConnectionList =>
(Proxy UserConnectionList
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UserConnectionList
Proxy UserConnectionList
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UserConnectionList
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UserConnectionList
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema UserConnectionList)

instance ToSchema UserConnectionList where
  schema :: ValueSchema NamedSwaggerDoc UserConnectionList
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] UserConnectionList UserConnectionList
-> ValueSchema NamedSwaggerDoc UserConnectionList
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UserConnectionList" (SchemaP
   SwaggerDoc Object [Pair] UserConnectionList UserConnectionList
 -> ValueSchema NamedSwaggerDoc UserConnectionList)
-> SchemaP
     SwaggerDoc Object [Pair] UserConnectionList UserConnectionList
-> ValueSchema NamedSwaggerDoc UserConnectionList
forall a b. (a -> b) -> a -> b
$
      [UserConnection] -> Bool -> UserConnectionList
UserConnectionList
        ([UserConnection] -> Bool -> UserConnectionList)
-> SchemaP
     SwaggerDoc Object [Pair] UserConnectionList [UserConnection]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserConnectionList
     (Bool -> UserConnectionList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserConnectionList -> [UserConnection]
clConnections (UserConnectionList -> [UserConnection])
-> SchemaP
     SwaggerDoc Object [Pair] [UserConnection] [UserConnection]
-> SchemaP
     SwaggerDoc Object [Pair] UserConnectionList [UserConnection]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [UserConnection] [UserConnection]
-> SchemaP
     SwaggerDoc Object [Pair] [UserConnection] [UserConnection]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"connections" (ValueSchema NamedSwaggerDoc UserConnection
-> SchemaP SwaggerDoc Value Value [UserConnection] [UserConnection]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc UserConnection
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserConnectionList
  (Bool -> UserConnectionList)
-> SchemaP SwaggerDoc Object [Pair] UserConnectionList Bool
-> SchemaP
     SwaggerDoc Object [Pair] UserConnectionList UserConnectionList
forall a b.
SchemaP SwaggerDoc Object [Pair] UserConnectionList (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserConnectionList a
-> SchemaP SwaggerDoc Object [Pair] UserConnectionList b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserConnectionList -> Bool
clHasMore (UserConnectionList -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] UserConnectionList Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"has_more" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Indicator that the server has more connections than returned.") SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- UserConnection

-- | Exact state of the connection between two users, stored in Brig database (see
-- 'Brig.Data.Connection.lookupConnections').
--
-- Connection states have a direction -- e.g. if A sends a connection request to B, we'll
-- create connections (A, B, Sent) and (B, A, Pending).
data UserConnection = UserConnection
  { UserConnection -> UserId
ucFrom :: UserId,
    UserConnection -> Qualified UserId
ucTo :: Qualified UserId,
    UserConnection -> Relation
ucStatus :: Relation,
    -- | When 'ucStatus' was last changed
    UserConnection -> UTCTimeMillis
ucLastUpdate :: UTCTimeMillis,
    UserConnection -> Maybe (Qualified ConvId)
ucConvId :: Maybe (Qualified ConvId)
  }
  deriving stock (UserConnection -> UserConnection -> Bool
(UserConnection -> UserConnection -> Bool)
-> (UserConnection -> UserConnection -> Bool) -> Eq UserConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserConnection -> UserConnection -> Bool
== :: UserConnection -> UserConnection -> Bool
$c/= :: UserConnection -> UserConnection -> Bool
/= :: UserConnection -> UserConnection -> Bool
Eq, Int -> UserConnection -> ShowS
[UserConnection] -> ShowS
UserConnection -> String
(Int -> UserConnection -> ShowS)
-> (UserConnection -> String)
-> ([UserConnection] -> ShowS)
-> Show UserConnection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserConnection -> ShowS
showsPrec :: Int -> UserConnection -> ShowS
$cshow :: UserConnection -> String
show :: UserConnection -> String
$cshowList :: [UserConnection] -> ShowS
showList :: [UserConnection] -> ShowS
Show, (forall x. UserConnection -> Rep UserConnection x)
-> (forall x. Rep UserConnection x -> UserConnection)
-> Generic UserConnection
forall x. Rep UserConnection x -> UserConnection
forall x. UserConnection -> Rep UserConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserConnection -> Rep UserConnection x
from :: forall x. UserConnection -> Rep UserConnection x
$cto :: forall x. Rep UserConnection x -> UserConnection
to :: forall x. Rep UserConnection x -> UserConnection
Generic)
  deriving (Gen UserConnection
Gen UserConnection
-> (UserConnection -> [UserConnection]) -> Arbitrary UserConnection
UserConnection -> [UserConnection]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserConnection
arbitrary :: Gen UserConnection
$cshrink :: UserConnection -> [UserConnection]
shrink :: UserConnection -> [UserConnection]
Arbitrary) via (GenericUniform UserConnection)
  deriving (Value -> Parser [UserConnection]
Value -> Parser UserConnection
(Value -> Parser UserConnection)
-> (Value -> Parser [UserConnection]) -> FromJSON UserConnection
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserConnection
parseJSON :: Value -> Parser UserConnection
$cparseJSONList :: Value -> Parser [UserConnection]
parseJSONList :: Value -> Parser [UserConnection]
FromJSON, [UserConnection] -> Value
[UserConnection] -> Encoding
UserConnection -> Value
UserConnection -> Encoding
(UserConnection -> Value)
-> (UserConnection -> Encoding)
-> ([UserConnection] -> Value)
-> ([UserConnection] -> Encoding)
-> ToJSON UserConnection
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserConnection -> Value
toJSON :: UserConnection -> Value
$ctoEncoding :: UserConnection -> Encoding
toEncoding :: UserConnection -> Encoding
$ctoJSONList :: [UserConnection] -> Value
toJSONList :: [UserConnection] -> Value
$ctoEncodingList :: [UserConnection] -> Encoding
toEncodingList :: [UserConnection] -> Encoding
ToJSON, Typeable UserConnection
Typeable UserConnection =>
(Proxy UserConnection -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UserConnection
Proxy UserConnection -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UserConnection -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UserConnection -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema UserConnection)

instance ToSchema UserConnection where
  schema :: ValueSchema NamedSwaggerDoc UserConnection
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] UserConnection UserConnection
-> ValueSchema NamedSwaggerDoc UserConnection
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UserConnection" (SchemaP SwaggerDoc Object [Pair] UserConnection UserConnection
 -> ValueSchema NamedSwaggerDoc UserConnection)
-> SchemaP SwaggerDoc Object [Pair] UserConnection UserConnection
-> ValueSchema NamedSwaggerDoc UserConnection
forall a b. (a -> b) -> a -> b
$
      UserId
-> Qualified UserId
-> Relation
-> UTCTimeMillis
-> Maybe (Qualified ConvId)
-> UserConnection
UserConnection
        (UserId
 -> Qualified UserId
 -> Relation
 -> UTCTimeMillis
 -> Maybe (Qualified ConvId)
 -> UserConnection)
-> SchemaP SwaggerDoc Object [Pair] UserConnection UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserConnection
     (Qualified UserId
      -> Relation
      -> UTCTimeMillis
      -> Maybe (Qualified ConvId)
      -> UserConnection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserConnection -> UserId
ucFrom (UserConnection -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserConnection UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"from" SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserConnection
  (Qualified UserId
   -> Relation
   -> UTCTimeMillis
   -> Maybe (Qualified ConvId)
   -> UserConnection)
-> SchemaP
     SwaggerDoc Object [Pair] UserConnection (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserConnection
     (Relation
      -> UTCTimeMillis -> Maybe (Qualified ConvId) -> UserConnection)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserConnection (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserConnection a
-> SchemaP SwaggerDoc Object [Pair] UserConnection b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserConnection -> Qualified UserId
ucTo (UserConnection -> Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified UserId) (Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] UserConnection (Qualified UserId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified UserId) (Qualified UserId)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"qualified_to" SchemaP
  NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserConnection
  (Relation
   -> UTCTimeMillis -> Maybe (Qualified ConvId) -> UserConnection)
-> SchemaP SwaggerDoc Object [Pair] UserConnection (Maybe UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserConnection
     (Relation
      -> UTCTimeMillis -> Maybe (Qualified ConvId) -> UserConnection)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserConnection a
-> SchemaP SwaggerDoc Object [Pair] UserConnection b
-> SchemaP SwaggerDoc Object [Pair] UserConnection a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Qualified UserId -> UserId
forall a. Qualified a -> a
qUnqualified (Qualified UserId -> UserId)
-> (UserConnection -> Qualified UserId) -> UserConnection -> UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserConnection -> Qualified UserId
ucTo)
          (UserConnection -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId (Maybe UserId)
-> SchemaP SwaggerDoc Object [Pair] UserConnection (Maybe UserId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId (Maybe UserId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"to" (Text
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
forall doc a.
(HasDeprecated doc (Maybe Bool),
 HasDescription doc (Maybe Text)) =>
Text -> ValueSchema doc a -> ValueSchema doc a
deprecatedSchema Text
"qualified_to" SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserConnection
  (Relation
   -> UTCTimeMillis -> Maybe (Qualified ConvId) -> UserConnection)
-> SchemaP SwaggerDoc Object [Pair] UserConnection Relation
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserConnection
     (UTCTimeMillis -> Maybe (Qualified ConvId) -> UserConnection)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserConnection (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserConnection a
-> SchemaP SwaggerDoc Object [Pair] UserConnection b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserConnection -> Relation
ucStatus (UserConnection -> Relation)
-> SchemaP SwaggerDoc Object [Pair] Relation Relation
-> SchemaP SwaggerDoc Object [Pair] UserConnection Relation
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Relation Relation
-> SchemaP SwaggerDoc Object [Pair] Relation Relation
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"status" SchemaP NamedSwaggerDoc Value Value Relation Relation
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserConnection
  (UTCTimeMillis -> Maybe (Qualified ConvId) -> UserConnection)
-> SchemaP SwaggerDoc Object [Pair] UserConnection UTCTimeMillis
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserConnection
     (Maybe (Qualified ConvId) -> UserConnection)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserConnection (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserConnection a
-> SchemaP SwaggerDoc Object [Pair] UserConnection b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserConnection -> UTCTimeMillis
ucLastUpdate (UserConnection -> UTCTimeMillis)
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis UTCTimeMillis
-> SchemaP SwaggerDoc Object [Pair] UserConnection UTCTimeMillis
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis UTCTimeMillis
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"last_update" SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserConnection
  (Maybe (Qualified ConvId) -> UserConnection)
-> SchemaP
     SwaggerDoc Object [Pair] UserConnection (Maybe (Qualified ConvId))
-> SchemaP SwaggerDoc Object [Pair] UserConnection UserConnection
forall a b.
SchemaP SwaggerDoc Object [Pair] UserConnection (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserConnection a
-> SchemaP SwaggerDoc Object [Pair] UserConnection b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserConnection -> Maybe (Qualified ConvId)
ucConvId (UserConnection -> Maybe (Qualified ConvId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Qualified ConvId))
     (Maybe (Qualified ConvId))
-> SchemaP
     SwaggerDoc Object [Pair] UserConnection (Maybe (Qualified ConvId))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Qualified ConvId)
  (Maybe (Qualified ConvId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Qualified ConvId))
     (Maybe (Qualified ConvId))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Qualified ConvId)
     (Maybe (Qualified ConvId))
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
"qualified_conversation" SchemaP
  NamedSwaggerDoc Value Value (Qualified ConvId) (Qualified ConvId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP SwaggerDoc Object [Pair] UserConnection UserConnection
-> SchemaP SwaggerDoc Object [Pair] UserConnection (Maybe ConvId)
-> SchemaP SwaggerDoc Object [Pair] UserConnection UserConnection
forall a b.
SchemaP SwaggerDoc Object [Pair] UserConnection a
-> SchemaP SwaggerDoc Object [Pair] UserConnection b
-> SchemaP SwaggerDoc Object [Pair] UserConnection a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Qualified ConvId -> ConvId)
-> Maybe (Qualified ConvId) -> Maybe ConvId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Qualified ConvId -> ConvId
forall a. Qualified a -> a
qUnqualified (Maybe (Qualified ConvId) -> Maybe ConvId)
-> (UserConnection -> Maybe (Qualified ConvId))
-> UserConnection
-> Maybe ConvId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserConnection -> Maybe (Qualified ConvId)
ucConvId)
          (UserConnection -> Maybe ConvId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe ConvId) (Maybe ConvId)
-> SchemaP SwaggerDoc Object [Pair] UserConnection (Maybe ConvId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ConvId (Maybe ConvId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe ConvId) (Maybe ConvId)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value ConvId ConvId
-> SchemaP SwaggerDoc Object [Pair] ConvId (Maybe ConvId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"conversation" (Text
-> SchemaP NamedSwaggerDoc Value Value ConvId ConvId
-> SchemaP NamedSwaggerDoc Value Value ConvId ConvId
forall doc a.
(HasDeprecated doc (Maybe Bool),
 HasDescription doc (Maybe Text)) =>
Text -> ValueSchema doc a -> ValueSchema doc a
deprecatedSchema Text
"qualified_conversation" SchemaP NamedSwaggerDoc Value Value ConvId ConvId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))

--------------------------------------------------------------------------------
-- Relation

-- | Possible relations between two users. For detailed descriptions of these states, see:
--
-- > docs/reference/user/connection.md {#RefConnectionStates}
data Relation
  = Accepted
  | Blocked
  | Pending
  | Ignored
  | Sent
  | Cancelled
  | -- | behaves like blocked, the extra constructor is just to inform why.
    MissingLegalholdConsent
  deriving stock (Relation
Relation -> Relation -> Bounded Relation
forall a. a -> a -> Bounded a
$cminBound :: Relation
minBound :: Relation
$cmaxBound :: Relation
maxBound :: Relation
Bounded, Int -> Relation
Relation -> Int
Relation -> [Relation]
Relation -> Relation
Relation -> Relation -> [Relation]
Relation -> Relation -> Relation -> [Relation]
(Relation -> Relation)
-> (Relation -> Relation)
-> (Int -> Relation)
-> (Relation -> Int)
-> (Relation -> [Relation])
-> (Relation -> Relation -> [Relation])
-> (Relation -> Relation -> [Relation])
-> (Relation -> Relation -> Relation -> [Relation])
-> Enum Relation
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 :: Relation -> Relation
succ :: Relation -> Relation
$cpred :: Relation -> Relation
pred :: Relation -> Relation
$ctoEnum :: Int -> Relation
toEnum :: Int -> Relation
$cfromEnum :: Relation -> Int
fromEnum :: Relation -> Int
$cenumFrom :: Relation -> [Relation]
enumFrom :: Relation -> [Relation]
$cenumFromThen :: Relation -> Relation -> [Relation]
enumFromThen :: Relation -> Relation -> [Relation]
$cenumFromTo :: Relation -> Relation -> [Relation]
enumFromTo :: Relation -> Relation -> [Relation]
$cenumFromThenTo :: Relation -> Relation -> Relation -> [Relation]
enumFromThenTo :: Relation -> Relation -> Relation -> [Relation]
Enum, Relation -> Relation -> Bool
(Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool) -> Eq Relation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
/= :: Relation -> Relation -> Bool
Eq, Eq Relation
Eq Relation =>
(Relation -> Relation -> Ordering)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Relation)
-> (Relation -> Relation -> Relation)
-> Ord Relation
Relation -> Relation -> Bool
Relation -> Relation -> Ordering
Relation -> Relation -> Relation
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 :: Relation -> Relation -> Ordering
compare :: Relation -> Relation -> Ordering
$c< :: Relation -> Relation -> Bool
< :: Relation -> Relation -> Bool
$c<= :: Relation -> Relation -> Bool
<= :: Relation -> Relation -> Bool
$c> :: Relation -> Relation -> Bool
> :: Relation -> Relation -> Bool
$c>= :: Relation -> Relation -> Bool
>= :: Relation -> Relation -> Bool
$cmax :: Relation -> Relation -> Relation
max :: Relation -> Relation -> Relation
$cmin :: Relation -> Relation -> Relation
min :: Relation -> Relation -> Relation
Ord, Int -> Relation -> ShowS
[Relation] -> ShowS
Relation -> String
(Int -> Relation -> ShowS)
-> (Relation -> String) -> ([Relation] -> ShowS) -> Show Relation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Relation -> ShowS
showsPrec :: Int -> Relation -> ShowS
$cshow :: Relation -> String
show :: Relation -> String
$cshowList :: [Relation] -> ShowS
showList :: [Relation] -> ShowS
Show, (forall x. Relation -> Rep Relation x)
-> (forall x. Rep Relation x -> Relation) -> Generic Relation
forall x. Rep Relation x -> Relation
forall x. Relation -> Rep Relation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Relation -> Rep Relation x
from :: forall x. Relation -> Rep Relation x
$cto :: forall x. Rep Relation x -> Relation
to :: forall x. Rep Relation x -> Relation
Generic)
  deriving (Gen Relation
Gen Relation -> (Relation -> [Relation]) -> Arbitrary Relation
Relation -> [Relation]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Relation
arbitrary :: Gen Relation
$cshrink :: Relation -> [Relation]
shrink :: Relation -> [Relation]
Arbitrary) via (GenericUniform Relation)
  deriving (Value -> Parser [Relation]
Value -> Parser Relation
(Value -> Parser Relation)
-> (Value -> Parser [Relation]) -> FromJSON Relation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Relation
parseJSON :: Value -> Parser Relation
$cparseJSONList :: Value -> Parser [Relation]
parseJSONList :: Value -> Parser [Relation]
FromJSON, [Relation] -> Value
[Relation] -> Encoding
Relation -> Value
Relation -> Encoding
(Relation -> Value)
-> (Relation -> Encoding)
-> ([Relation] -> Value)
-> ([Relation] -> Encoding)
-> ToJSON Relation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Relation -> Value
toJSON :: Relation -> Value
$ctoEncoding :: Relation -> Encoding
toEncoding :: Relation -> Encoding
$ctoJSONList :: [Relation] -> Value
toJSONList :: [Relation] -> Value
$ctoEncodingList :: [Relation] -> Encoding
toEncodingList :: [Relation] -> Encoding
ToJSON, Typeable Relation
Typeable Relation =>
(Proxy Relation -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Relation
Proxy Relation -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Relation -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Relation -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Relation)

instance S.ToParamSchema Relation where
  toParamSchema :: Proxy Relation -> Schema
toParamSchema Proxy Relation
_ = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString

-- | 'updateConnectionInternal', requires knowledge of the previous state (before
-- 'MissingLegalholdConsent'), but the clients don't need that information.  To avoid having
-- to change the API, we introduce an internal variant of 'Relation' with surjective mapping
-- 'relationDropHistory'.
data RelationWithHistory
  = AcceptedWithHistory
  | BlockedWithHistory
  | PendingWithHistory
  | IgnoredWithHistory
  | SentWithHistory
  | CancelledWithHistory
  | MissingLegalholdConsentFromAccepted
  | MissingLegalholdConsentFromBlocked
  | MissingLegalholdConsentFromPending
  | MissingLegalholdConsentFromIgnored
  | MissingLegalholdConsentFromSent
  | MissingLegalholdConsentFromCancelled
  deriving stock (RelationWithHistory -> RelationWithHistory -> Bool
(RelationWithHistory -> RelationWithHistory -> Bool)
-> (RelationWithHistory -> RelationWithHistory -> Bool)
-> Eq RelationWithHistory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelationWithHistory -> RelationWithHistory -> Bool
== :: RelationWithHistory -> RelationWithHistory -> Bool
$c/= :: RelationWithHistory -> RelationWithHistory -> Bool
/= :: RelationWithHistory -> RelationWithHistory -> Bool
Eq, Eq RelationWithHistory
Eq RelationWithHistory =>
(RelationWithHistory -> RelationWithHistory -> Ordering)
-> (RelationWithHistory -> RelationWithHistory -> Bool)
-> (RelationWithHistory -> RelationWithHistory -> Bool)
-> (RelationWithHistory -> RelationWithHistory -> Bool)
-> (RelationWithHistory -> RelationWithHistory -> Bool)
-> (RelationWithHistory
    -> RelationWithHistory -> RelationWithHistory)
-> (RelationWithHistory
    -> RelationWithHistory -> RelationWithHistory)
-> Ord RelationWithHistory
RelationWithHistory -> RelationWithHistory -> Bool
RelationWithHistory -> RelationWithHistory -> Ordering
RelationWithHistory -> RelationWithHistory -> RelationWithHistory
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 :: RelationWithHistory -> RelationWithHistory -> Ordering
compare :: RelationWithHistory -> RelationWithHistory -> Ordering
$c< :: RelationWithHistory -> RelationWithHistory -> Bool
< :: RelationWithHistory -> RelationWithHistory -> Bool
$c<= :: RelationWithHistory -> RelationWithHistory -> Bool
<= :: RelationWithHistory -> RelationWithHistory -> Bool
$c> :: RelationWithHistory -> RelationWithHistory -> Bool
> :: RelationWithHistory -> RelationWithHistory -> Bool
$c>= :: RelationWithHistory -> RelationWithHistory -> Bool
>= :: RelationWithHistory -> RelationWithHistory -> Bool
$cmax :: RelationWithHistory -> RelationWithHistory -> RelationWithHistory
max :: RelationWithHistory -> RelationWithHistory -> RelationWithHistory
$cmin :: RelationWithHistory -> RelationWithHistory -> RelationWithHistory
min :: RelationWithHistory -> RelationWithHistory -> RelationWithHistory
Ord, Int -> RelationWithHistory -> ShowS
[RelationWithHistory] -> ShowS
RelationWithHistory -> String
(Int -> RelationWithHistory -> ShowS)
-> (RelationWithHistory -> String)
-> ([RelationWithHistory] -> ShowS)
-> Show RelationWithHistory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelationWithHistory -> ShowS
showsPrec :: Int -> RelationWithHistory -> ShowS
$cshow :: RelationWithHistory -> String
show :: RelationWithHistory -> String
$cshowList :: [RelationWithHistory] -> ShowS
showList :: [RelationWithHistory] -> ShowS
Show, (forall x. RelationWithHistory -> Rep RelationWithHistory x)
-> (forall x. Rep RelationWithHistory x -> RelationWithHistory)
-> Generic RelationWithHistory
forall x. Rep RelationWithHistory x -> RelationWithHistory
forall x. RelationWithHistory -> Rep RelationWithHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RelationWithHistory -> Rep RelationWithHistory x
from :: forall x. RelationWithHistory -> Rep RelationWithHistory x
$cto :: forall x. Rep RelationWithHistory x -> RelationWithHistory
to :: forall x. Rep RelationWithHistory x -> RelationWithHistory
Generic)
  deriving (Gen RelationWithHistory
Gen RelationWithHistory
-> (RelationWithHistory -> [RelationWithHistory])
-> Arbitrary RelationWithHistory
RelationWithHistory -> [RelationWithHistory]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen RelationWithHistory
arbitrary :: Gen RelationWithHistory
$cshrink :: RelationWithHistory -> [RelationWithHistory]
shrink :: RelationWithHistory -> [RelationWithHistory]
Arbitrary) via (GenericUniform RelationWithHistory)

-- | Convert a 'Relation' to 'RelationWithHistory'. This is to be used only if
-- the MissingLegalholdConsent case does not need to be supported.
relationWithHistory :: Relation -> RelationWithHistory
relationWithHistory :: Relation -> RelationWithHistory
relationWithHistory Relation
Accepted = RelationWithHistory
AcceptedWithHistory
relationWithHistory Relation
Blocked = RelationWithHistory
BlockedWithHistory
relationWithHistory Relation
Pending = RelationWithHistory
PendingWithHistory
relationWithHistory Relation
Ignored = RelationWithHistory
IgnoredWithHistory
relationWithHistory Relation
Sent = RelationWithHistory
SentWithHistory
relationWithHistory Relation
Cancelled = RelationWithHistory
CancelledWithHistory
relationWithHistory Relation
MissingLegalholdConsent = RelationWithHistory
MissingLegalholdConsentFromCancelled

relationDropHistory :: RelationWithHistory -> Relation
relationDropHistory :: RelationWithHistory -> Relation
relationDropHistory = \case
  RelationWithHistory
AcceptedWithHistory -> Relation
Accepted
  RelationWithHistory
BlockedWithHistory -> Relation
Blocked
  RelationWithHistory
PendingWithHistory -> Relation
Pending
  RelationWithHistory
IgnoredWithHistory -> Relation
Ignored
  RelationWithHistory
SentWithHistory -> Relation
Sent
  RelationWithHistory
CancelledWithHistory -> Relation
Cancelled
  RelationWithHistory
MissingLegalholdConsentFromAccepted -> Relation
MissingLegalholdConsent
  RelationWithHistory
MissingLegalholdConsentFromBlocked -> Relation
MissingLegalholdConsent
  RelationWithHistory
MissingLegalholdConsentFromPending -> Relation
MissingLegalholdConsent
  RelationWithHistory
MissingLegalholdConsentFromIgnored -> Relation
MissingLegalholdConsent
  RelationWithHistory
MissingLegalholdConsentFromSent -> Relation
MissingLegalholdConsent
  RelationWithHistory
MissingLegalholdConsentFromCancelled -> Relation
MissingLegalholdConsent

instance ToSchema Relation where
  schema :: SchemaP NamedSwaggerDoc Value Value Relation Relation
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
"Relation" (SchemaP [Value] Text (Alt Maybe Text) Relation Relation
 -> SchemaP NamedSwaggerDoc Value Value Relation Relation)
-> SchemaP [Value] Text (Alt Maybe Text) Relation Relation
-> SchemaP NamedSwaggerDoc Value Value Relation Relation
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) Relation Relation]
-> SchemaP [Value] Text (Alt Maybe Text) Relation Relation
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> Relation
-> SchemaP [Value] Text (Alt Maybe Text) Relation Relation
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"accepted" Relation
Accepted,
          Text
-> Relation
-> SchemaP [Value] Text (Alt Maybe Text) Relation Relation
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"blocked" Relation
Blocked,
          Text
-> Relation
-> SchemaP [Value] Text (Alt Maybe Text) Relation Relation
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"pending" Relation
Pending,
          Text
-> Relation
-> SchemaP [Value] Text (Alt Maybe Text) Relation Relation
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"ignored" Relation
Ignored,
          Text
-> Relation
-> SchemaP [Value] Text (Alt Maybe Text) Relation Relation
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"sent" Relation
Sent,
          Text
-> Relation
-> SchemaP [Value] Text (Alt Maybe Text) Relation Relation
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"cancelled" Relation
Cancelled,
          Text
-> Relation
-> SchemaP [Value] Text (Alt Maybe Text) Relation Relation
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"missing-legalhold-consent" Relation
MissingLegalholdConsent
        ]

instance FromHttpApiData Relation where
  parseQueryParam :: Text -> Either Text Relation
parseQueryParam = \case
    Text
"accepted" -> Relation -> Either Text Relation
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
Accepted
    Text
"blocked" -> Relation -> Either Text Relation
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
Blocked
    Text
"pending" -> Relation -> Either Text Relation
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
Pending
    Text
"ignored" -> Relation -> Either Text Relation
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
Ignored
    Text
"sent" -> Relation -> Either Text Relation
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
Sent
    Text
"cancelled" -> Relation -> Either Text Relation
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
Cancelled
    Text
"missing-legalhold-consent" -> Relation -> Either Text Relation
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
MissingLegalholdConsent
    Text
x -> Text -> Either Text Relation
forall a b. a -> Either a b
Left (Text -> Either Text Relation) -> Text -> Either Text Relation
forall a b. (a -> b) -> a -> b
$ Text
"Invalid relation-type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x

instance ToHttpApiData Relation where
  toQueryParam :: Relation -> Text
toQueryParam = \case
    Relation
Accepted -> Text
"accepted"
    Relation
Blocked -> Text
"blocked"
    Relation
Pending -> Text
"pending"
    Relation
Ignored -> Text
"ignored"
    Relation
Sent -> Text
"sent"
    Relation
Cancelled -> Text
"cancelled"
    Relation
MissingLegalholdConsent -> Text
"missing-legalhold-consent"

instance C.Cql RelationWithHistory where
  ctype :: Tagged RelationWithHistory ColumnType
ctype = ColumnType -> Tagged RelationWithHistory ColumnType
forall a b. b -> Tagged a b
C.Tagged ColumnType
C.IntColumn

  fromCql :: Value -> Either String RelationWithHistory
fromCql (C.CqlInt Int32
i) = case Int32
i of
    Int32
0 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
AcceptedWithHistory
    Int32
1 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
BlockedWithHistory
    Int32
2 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
PendingWithHistory
    Int32
3 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
IgnoredWithHistory
    Int32
4 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
SentWithHistory
    Int32
5 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
CancelledWithHistory
    Int32
6 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
MissingLegalholdConsentFromAccepted
    Int32
7 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
MissingLegalholdConsentFromBlocked
    Int32
8 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
MissingLegalholdConsentFromPending
    Int32
9 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
MissingLegalholdConsentFromIgnored
    Int32
10 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
MissingLegalholdConsentFromSent
    Int32
11 -> RelationWithHistory -> Either String RelationWithHistory
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationWithHistory
MissingLegalholdConsentFromCancelled
    Int32
n -> String -> Either String RelationWithHistory
forall a b. a -> Either a b
Left (String -> Either String RelationWithHistory)
-> String -> Either String RelationWithHistory
forall a b. (a -> b) -> a -> b
$ String
"unexpected RelationWithHistory: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
n
  fromCql Value
_ = String -> Either String RelationWithHistory
forall a b. a -> Either a b
Left String
"RelationWithHistory: int expected"

  toCql :: RelationWithHistory -> Value
toCql RelationWithHistory
AcceptedWithHistory = Int32 -> Value
C.CqlInt Int32
0
  toCql RelationWithHistory
BlockedWithHistory = Int32 -> Value
C.CqlInt Int32
1
  toCql RelationWithHistory
PendingWithHistory = Int32 -> Value
C.CqlInt Int32
2
  toCql RelationWithHistory
IgnoredWithHistory = Int32 -> Value
C.CqlInt Int32
3
  toCql RelationWithHistory
SentWithHistory = Int32 -> Value
C.CqlInt Int32
4
  toCql RelationWithHistory
CancelledWithHistory = Int32 -> Value
C.CqlInt Int32
5
  toCql RelationWithHistory
MissingLegalholdConsentFromAccepted = Int32 -> Value
C.CqlInt Int32
6
  toCql RelationWithHistory
MissingLegalholdConsentFromBlocked = Int32 -> Value
C.CqlInt Int32
7
  toCql RelationWithHistory
MissingLegalholdConsentFromPending = Int32 -> Value
C.CqlInt Int32
8
  toCql RelationWithHistory
MissingLegalholdConsentFromIgnored = Int32 -> Value
C.CqlInt Int32
9
  toCql RelationWithHistory
MissingLegalholdConsentFromSent = Int32 -> Value
C.CqlInt Int32
10
  toCql RelationWithHistory
MissingLegalholdConsentFromCancelled = Int32 -> Value
C.CqlInt Int32
11

----------------
-- Requests

-- | Payload type for a connection request from one user to another.
data ConnectionRequest = ConnectionRequest
  { -- | Connection recipient
    ConnectionRequest -> UserId
crUser :: UserId,
    -- | Name of the conversation to be created. This is not used in any
    -- meaningful way anymore. The clients just write the name of the target
    -- user here and it is ignored later.
    --
    -- (In the past, this was used; but due to spam, clients started ignoring
    -- it)
    ConnectionRequest -> Range 1 256 Text
crName :: Range 1 256 Text
  }
  deriving stock (ConnectionRequest -> ConnectionRequest -> Bool
(ConnectionRequest -> ConnectionRequest -> Bool)
-> (ConnectionRequest -> ConnectionRequest -> Bool)
-> Eq ConnectionRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionRequest -> ConnectionRequest -> Bool
== :: ConnectionRequest -> ConnectionRequest -> Bool
$c/= :: ConnectionRequest -> ConnectionRequest -> Bool
/= :: ConnectionRequest -> ConnectionRequest -> Bool
Eq, Int -> ConnectionRequest -> ShowS
[ConnectionRequest] -> ShowS
ConnectionRequest -> String
(Int -> ConnectionRequest -> ShowS)
-> (ConnectionRequest -> String)
-> ([ConnectionRequest] -> ShowS)
-> Show ConnectionRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionRequest -> ShowS
showsPrec :: Int -> ConnectionRequest -> ShowS
$cshow :: ConnectionRequest -> String
show :: ConnectionRequest -> String
$cshowList :: [ConnectionRequest] -> ShowS
showList :: [ConnectionRequest] -> ShowS
Show, (forall x. ConnectionRequest -> Rep ConnectionRequest x)
-> (forall x. Rep ConnectionRequest x -> ConnectionRequest)
-> Generic ConnectionRequest
forall x. Rep ConnectionRequest x -> ConnectionRequest
forall x. ConnectionRequest -> Rep ConnectionRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConnectionRequest -> Rep ConnectionRequest x
from :: forall x. ConnectionRequest -> Rep ConnectionRequest x
$cto :: forall x. Rep ConnectionRequest x -> ConnectionRequest
to :: forall x. Rep ConnectionRequest x -> ConnectionRequest
Generic)
  deriving (Gen ConnectionRequest
Gen ConnectionRequest
-> (ConnectionRequest -> [ConnectionRequest])
-> Arbitrary ConnectionRequest
ConnectionRequest -> [ConnectionRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConnectionRequest
arbitrary :: Gen ConnectionRequest
$cshrink :: ConnectionRequest -> [ConnectionRequest]
shrink :: ConnectionRequest -> [ConnectionRequest]
Arbitrary) via (GenericUniform ConnectionRequest)
  deriving (Value -> Parser [ConnectionRequest]
Value -> Parser ConnectionRequest
(Value -> Parser ConnectionRequest)
-> (Value -> Parser [ConnectionRequest])
-> FromJSON ConnectionRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConnectionRequest
parseJSON :: Value -> Parser ConnectionRequest
$cparseJSONList :: Value -> Parser [ConnectionRequest]
parseJSONList :: Value -> Parser [ConnectionRequest]
FromJSON, [ConnectionRequest] -> Value
[ConnectionRequest] -> Encoding
ConnectionRequest -> Value
ConnectionRequest -> Encoding
(ConnectionRequest -> Value)
-> (ConnectionRequest -> Encoding)
-> ([ConnectionRequest] -> Value)
-> ([ConnectionRequest] -> Encoding)
-> ToJSON ConnectionRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConnectionRequest -> Value
toJSON :: ConnectionRequest -> Value
$ctoEncoding :: ConnectionRequest -> Encoding
toEncoding :: ConnectionRequest -> Encoding
$ctoJSONList :: [ConnectionRequest] -> Value
toJSONList :: [ConnectionRequest] -> Value
$ctoEncodingList :: [ConnectionRequest] -> Encoding
toEncodingList :: [ConnectionRequest] -> Encoding
ToJSON, Typeable ConnectionRequest
Typeable ConnectionRequest =>
(Proxy ConnectionRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConnectionRequest
Proxy ConnectionRequest -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConnectionRequest -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConnectionRequest -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema ConnectionRequest)

instance ToSchema ConnectionRequest where
  schema :: ValueSchema NamedSwaggerDoc ConnectionRequest
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] ConnectionRequest ConnectionRequest
-> ValueSchema NamedSwaggerDoc ConnectionRequest
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ConnectionRequest" (SchemaP
   SwaggerDoc Object [Pair] ConnectionRequest ConnectionRequest
 -> ValueSchema NamedSwaggerDoc ConnectionRequest)
-> SchemaP
     SwaggerDoc Object [Pair] ConnectionRequest ConnectionRequest
-> ValueSchema NamedSwaggerDoc ConnectionRequest
forall a b. (a -> b) -> a -> b
$
      UserId -> Range 1 256 Text -> ConnectionRequest
ConnectionRequest
        (UserId -> Range 1 256 Text -> ConnectionRequest)
-> SchemaP SwaggerDoc Object [Pair] ConnectionRequest UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConnectionRequest
     (Range 1 256 Text -> ConnectionRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionRequest -> UserId
crUser (ConnectionRequest -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] ConnectionRequest UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"user" ((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
"user ID of the user to request a connection with") SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConnectionRequest
  (Range 1 256 Text -> ConnectionRequest)
-> SchemaP
     SwaggerDoc Object [Pair] ConnectionRequest (Range 1 256 Text)
-> SchemaP
     SwaggerDoc Object [Pair] ConnectionRequest ConnectionRequest
forall a b.
SchemaP SwaggerDoc Object [Pair] ConnectionRequest (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConnectionRequest a
-> SchemaP SwaggerDoc Object [Pair] ConnectionRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConnectionRequest -> Range 1 256 Text
crName (ConnectionRequest -> Range 1 256 Text)
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 256 Text) (Range 1 256 Text)
-> SchemaP
     SwaggerDoc Object [Pair] ConnectionRequest (Range 1 256 Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value (Range 1 256 Text) (Range 1 256 Text)
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 256 Text) (Range 1 256 Text)
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"name" ((Maybe Text -> Identity (Maybe Text))
-> 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
"Name of the (pending) conversation being initiated (1 - 256) characters)") SchemaP
  NamedSwaggerDoc Value Value (Range 1 256 Text) (Range 1 256 Text)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

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

instance ToSchema ConnectionUpdate where
  schema :: ValueSchema NamedSwaggerDoc ConnectionUpdate
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] ConnectionUpdate ConnectionUpdate
-> ValueSchema NamedSwaggerDoc ConnectionUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ConnectionUpdate" (SchemaP SwaggerDoc Object [Pair] ConnectionUpdate ConnectionUpdate
 -> ValueSchema NamedSwaggerDoc ConnectionUpdate)
-> SchemaP
     SwaggerDoc Object [Pair] ConnectionUpdate ConnectionUpdate
-> ValueSchema NamedSwaggerDoc ConnectionUpdate
forall a b. (a -> b) -> a -> b
$
      Relation -> ConnectionUpdate
ConnectionUpdate
        (Relation -> ConnectionUpdate)
-> SchemaP SwaggerDoc Object [Pair] ConnectionUpdate Relation
-> SchemaP
     SwaggerDoc Object [Pair] ConnectionUpdate ConnectionUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionUpdate -> Relation
cuStatus (ConnectionUpdate -> Relation)
-> SchemaP SwaggerDoc Object [Pair] Relation Relation
-> SchemaP SwaggerDoc Object [Pair] ConnectionUpdate Relation
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Relation Relation
-> SchemaP SwaggerDoc Object [Pair] Relation Relation
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
"status" ((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
"New relation status") SchemaP NamedSwaggerDoc Value Value Relation Relation
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema