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

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

import Data.Aeson
import Data.Domain (Domain)
import Data.Handle (Handle)
import Data.Id
import Data.OpenApi (OpenApi, ToSchema)
import Data.Proxy (Proxy (Proxy))
import Imports
import Servant.API
import Servant.OpenApi (HasOpenApi (toOpenApi))
import Test.QuickCheck (Arbitrary)
import Wire.API.Federation.API.Brig.Notifications as Notifications
import Wire.API.Federation.Endpoint
import Wire.API.Federation.Version
import Wire.API.MLS.CipherSuite
import Wire.API.MLS.KeyPackage
import Wire.API.Routes.SpecialiseToVersion
import Wire.API.User (UserProfile)
import Wire.API.User.Client
import Wire.API.User.Client.Prekey (ClientPrekey, PrekeyBundle)
import Wire.API.User.Search
import Wire.API.UserMap (UserMap)
import Wire.API.Util.Aeson (CustomEncoded (..))
import Wire.API.VersionInfo
import Wire.Arbitrary (GenericUniform (..))

data SearchRequest = SearchRequest
  { SearchRequest -> Text
term :: Text,
    -- | The searcher's team ID, used to matched against the remote backend's team federation policy.
    SearchRequest -> Maybe TeamId
from :: Maybe TeamId,
    -- | The remote teams that the calling backend is allowed to federate with.
    SearchRequest -> Maybe [TeamId]
onlyInTeams :: Maybe [TeamId]
  }
  deriving (Int -> SearchRequest -> ShowS
[SearchRequest] -> ShowS
SearchRequest -> String
(Int -> SearchRequest -> ShowS)
-> (SearchRequest -> String)
-> ([SearchRequest] -> ShowS)
-> Show SearchRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchRequest -> ShowS
showsPrec :: Int -> SearchRequest -> ShowS
$cshow :: SearchRequest -> String
show :: SearchRequest -> String
$cshowList :: [SearchRequest] -> ShowS
showList :: [SearchRequest] -> ShowS
Show, SearchRequest -> SearchRequest -> Bool
(SearchRequest -> SearchRequest -> Bool)
-> (SearchRequest -> SearchRequest -> Bool) -> Eq SearchRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchRequest -> SearchRequest -> Bool
== :: SearchRequest -> SearchRequest -> Bool
$c/= :: SearchRequest -> SearchRequest -> Bool
/= :: SearchRequest -> SearchRequest -> Bool
Eq, (forall x. SearchRequest -> Rep SearchRequest x)
-> (forall x. Rep SearchRequest x -> SearchRequest)
-> Generic SearchRequest
forall x. Rep SearchRequest x -> SearchRequest
forall x. SearchRequest -> Rep SearchRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SearchRequest -> Rep SearchRequest x
from :: forall x. SearchRequest -> Rep SearchRequest x
$cto :: forall x. Rep SearchRequest x -> SearchRequest
to :: forall x. Rep SearchRequest x -> SearchRequest
Generic, Typeable)
  deriving (Gen SearchRequest
Gen SearchRequest
-> (SearchRequest -> [SearchRequest]) -> Arbitrary SearchRequest
SearchRequest -> [SearchRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SearchRequest
arbitrary :: Gen SearchRequest
$cshrink :: SearchRequest -> [SearchRequest]
shrink :: SearchRequest -> [SearchRequest]
Arbitrary) via (GenericUniform SearchRequest)

instance ToJSON SearchRequest

instance FromJSON SearchRequest

instance ToSchema SearchRequest

data SearchResponse = SearchResponse
  { SearchResponse -> [Contact]
contacts :: [Contact],
    SearchResponse -> FederatedUserSearchPolicy
searchPolicy :: FederatedUserSearchPolicy
  }
  deriving (Int -> SearchResponse -> ShowS
[SearchResponse] -> ShowS
SearchResponse -> String
(Int -> SearchResponse -> ShowS)
-> (SearchResponse -> String)
-> ([SearchResponse] -> ShowS)
-> Show SearchResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchResponse -> ShowS
showsPrec :: Int -> SearchResponse -> ShowS
$cshow :: SearchResponse -> String
show :: SearchResponse -> String
$cshowList :: [SearchResponse] -> ShowS
showList :: [SearchResponse] -> ShowS
Show, (forall x. SearchResponse -> Rep SearchResponse x)
-> (forall x. Rep SearchResponse x -> SearchResponse)
-> Generic SearchResponse
forall x. Rep SearchResponse x -> SearchResponse
forall x. SearchResponse -> Rep SearchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SearchResponse -> Rep SearchResponse x
from :: forall x. SearchResponse -> Rep SearchResponse x
$cto :: forall x. Rep SearchResponse x -> SearchResponse
to :: forall x. Rep SearchResponse x -> SearchResponse
Generic, Typeable)

instance ToJSON SearchResponse

instance FromJSON SearchResponse

instance ToSchema SearchResponse

-- | For conventions see /docs/developer/federation-api-conventions.md
type BrigApi =
  FedEndpoint "api-version" () VersionInfo
    :<|> FedEndpoint "get-user-by-handle" Handle (Maybe UserProfile)
    :<|> FedEndpoint "get-users-by-ids" [UserId] [UserProfile]
    :<|> FedEndpoint "claim-prekey" (UserId, ClientId) (Maybe ClientPrekey)
    :<|> FedEndpoint "claim-prekey-bundle" UserId PrekeyBundle
    :<|> FedEndpoint "claim-multi-prekey-bundle" UserClients UserClientPrekeyMap
    -- FUTUREWORK(federation): do we want to perform some type-level validation like length checks?
    -- (handles can be up to 256 chars currently)
    :<|> FedEndpoint "search-users" SearchRequest SearchResponse
    :<|> FedEndpoint "get-user-clients" GetUserClients (UserMap (Set PubClient))
    :<|> FedEndpointWithMods '[Until V1] (Versioned 'V0 "get-mls-clients") MLSClientsRequestV0 (Set ClientInfo)
    :<|> FedEndpointWithMods '[From V1] "get-mls-clients" MLSClientsRequest (Set ClientInfo)
    :<|> FedEndpoint "send-connection-action" NewConnectionRequest NewConnectionResponse
    :<|> FedEndpoint "claim-key-packages" ClaimKeyPackageRequest (Maybe KeyPackageBundle)
    :<|> FedEndpoint "get-not-fully-connected-backends" DomainSet NonConnectedBackends
    -- All the notification endpoints that go through the queue-based
    -- federation client ('fedQueueClient').
    :<|> BrigNotificationAPI

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

instance ToSchema DomainSet

newtype NonConnectedBackends = NonConnectedBackends
  -- TODO:
  -- The encoding rules that were in place would make this "connectedBackends" over the wire.
  -- I do not think that this was intended, so I'm leaving this note as it will be an API break.
  { NonConnectedBackends -> Set Domain
nonConnectedBackends :: Set Domain
  }
  deriving stock (NonConnectedBackends -> NonConnectedBackends -> Bool
(NonConnectedBackends -> NonConnectedBackends -> Bool)
-> (NonConnectedBackends -> NonConnectedBackends -> Bool)
-> Eq NonConnectedBackends
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonConnectedBackends -> NonConnectedBackends -> Bool
== :: NonConnectedBackends -> NonConnectedBackends -> Bool
$c/= :: NonConnectedBackends -> NonConnectedBackends -> Bool
/= :: NonConnectedBackends -> NonConnectedBackends -> Bool
Eq, Int -> NonConnectedBackends -> ShowS
[NonConnectedBackends] -> ShowS
NonConnectedBackends -> String
(Int -> NonConnectedBackends -> ShowS)
-> (NonConnectedBackends -> String)
-> ([NonConnectedBackends] -> ShowS)
-> Show NonConnectedBackends
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonConnectedBackends -> ShowS
showsPrec :: Int -> NonConnectedBackends -> ShowS
$cshow :: NonConnectedBackends -> String
show :: NonConnectedBackends -> String
$cshowList :: [NonConnectedBackends] -> ShowS
showList :: [NonConnectedBackends] -> ShowS
Show, (forall x. NonConnectedBackends -> Rep NonConnectedBackends x)
-> (forall x. Rep NonConnectedBackends x -> NonConnectedBackends)
-> Generic NonConnectedBackends
forall x. Rep NonConnectedBackends x -> NonConnectedBackends
forall x. NonConnectedBackends -> Rep NonConnectedBackends x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NonConnectedBackends -> Rep NonConnectedBackends x
from :: forall x. NonConnectedBackends -> Rep NonConnectedBackends x
$cto :: forall x. Rep NonConnectedBackends x -> NonConnectedBackends
to :: forall x. Rep NonConnectedBackends x -> NonConnectedBackends
Generic)
  deriving ([NonConnectedBackends] -> Value
[NonConnectedBackends] -> Encoding
NonConnectedBackends -> Value
NonConnectedBackends -> Encoding
(NonConnectedBackends -> Value)
-> (NonConnectedBackends -> Encoding)
-> ([NonConnectedBackends] -> Value)
-> ([NonConnectedBackends] -> Encoding)
-> ToJSON NonConnectedBackends
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NonConnectedBackends -> Value
toJSON :: NonConnectedBackends -> Value
$ctoEncoding :: NonConnectedBackends -> Encoding
toEncoding :: NonConnectedBackends -> Encoding
$ctoJSONList :: [NonConnectedBackends] -> Value
toJSONList :: [NonConnectedBackends] -> Value
$ctoEncodingList :: [NonConnectedBackends] -> Encoding
toEncodingList :: [NonConnectedBackends] -> Encoding
ToJSON, Value -> Parser [NonConnectedBackends]
Value -> Parser NonConnectedBackends
(Value -> Parser NonConnectedBackends)
-> (Value -> Parser [NonConnectedBackends])
-> FromJSON NonConnectedBackends
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NonConnectedBackends
parseJSON :: Value -> Parser NonConnectedBackends
$cparseJSONList :: Value -> Parser [NonConnectedBackends]
parseJSONList :: Value -> Parser [NonConnectedBackends]
FromJSON) via (CustomEncoded NonConnectedBackends)

instance ToSchema NonConnectedBackends

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

instance ToSchema GetUserClients

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

instance ToSchema MLSClientsRequestV0

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

instance ToSchema MLSClientsRequest

mlsClientsRequestToV0 :: MLSClientsRequest -> MLSClientsRequestV0
mlsClientsRequestToV0 :: MLSClientsRequest -> MLSClientsRequestV0
mlsClientsRequestToV0 MLSClientsRequest
mcr =
  MLSClientsRequestV0
    { $sel:userId:MLSClientsRequestV0 :: UserId
userId = MLSClientsRequest
mcr.userId,
      $sel:signatureScheme:MLSClientsRequestV0 :: SignatureSchemeTag
signatureScheme = SignatureSchemeTag
Ed25519
    }

mlsClientsRequestFromV0 :: MLSClientsRequestV0 -> MLSClientsRequest
mlsClientsRequestFromV0 :: MLSClientsRequestV0 -> MLSClientsRequest
mlsClientsRequestFromV0 MLSClientsRequestV0
mcr =
  MLSClientsRequest
    { $sel:userId:MLSClientsRequest :: UserId
userId = MLSClientsRequestV0
mcr.userId,
      $sel:cipherSuite:MLSClientsRequest :: CipherSuite
cipherSuite = CipherSuiteTag -> CipherSuite
tagCipherSuite CipherSuiteTag
MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
    }

-- NOTE: ConversationId for remote connections
--
-- The plan is to model the connect/one2one conversationId as deterministically derived from
-- the combination of both userIds and both domains. It may be in the domain
-- of the sending OR the receiving backend (with a 50/50 probability).
-- However at the level of the federation API, we are only concerned about
-- the question of which backend has the authority over the conversationId.
--
-- (Backend A should not prescribe backend B to use a certain UUID for its
-- conversation; as that could lead to a potential malicious override of an
-- existing conversation)
--
-- The deterministic conversation Id should be seen as a 'best effort'
-- attempt only. (we cannot guarantee a backend won't change the code in the
-- future)

data NewConnectionRequest = NewConnectionRequest
  { -- | The 'from' userId is understood to always have the domain of the backend making the connection request
    NewConnectionRequest -> UserId
from :: UserId,
    -- | The team ID of the 'from' user. If the user is not in a team, it is set
    -- to 'Nothing'. It is implicitly qualified the same as the 'from' user.
    NewConnectionRequest -> Maybe TeamId
fromTeam :: Maybe TeamId,
    -- | The 'to' userId is understood to always have the domain of the receiving backend.
    NewConnectionRequest -> UserId
to :: UserId,
    NewConnectionRequest -> RemoteConnectionAction
action :: RemoteConnectionAction
  }
  deriving stock (NewConnectionRequest -> NewConnectionRequest -> Bool
(NewConnectionRequest -> NewConnectionRequest -> Bool)
-> (NewConnectionRequest -> NewConnectionRequest -> Bool)
-> Eq NewConnectionRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewConnectionRequest -> NewConnectionRequest -> Bool
== :: NewConnectionRequest -> NewConnectionRequest -> Bool
$c/= :: NewConnectionRequest -> NewConnectionRequest -> Bool
/= :: NewConnectionRequest -> NewConnectionRequest -> Bool
Eq, Int -> NewConnectionRequest -> ShowS
[NewConnectionRequest] -> ShowS
NewConnectionRequest -> String
(Int -> NewConnectionRequest -> ShowS)
-> (NewConnectionRequest -> String)
-> ([NewConnectionRequest] -> ShowS)
-> Show NewConnectionRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewConnectionRequest -> ShowS
showsPrec :: Int -> NewConnectionRequest -> ShowS
$cshow :: NewConnectionRequest -> String
show :: NewConnectionRequest -> String
$cshowList :: [NewConnectionRequest] -> ShowS
showList :: [NewConnectionRequest] -> ShowS
Show, (forall x. NewConnectionRequest -> Rep NewConnectionRequest x)
-> (forall x. Rep NewConnectionRequest x -> NewConnectionRequest)
-> Generic NewConnectionRequest
forall x. Rep NewConnectionRequest x -> NewConnectionRequest
forall x. NewConnectionRequest -> Rep NewConnectionRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewConnectionRequest -> Rep NewConnectionRequest x
from :: forall x. NewConnectionRequest -> Rep NewConnectionRequest x
$cto :: forall x. Rep NewConnectionRequest x -> NewConnectionRequest
to :: forall x. Rep NewConnectionRequest x -> NewConnectionRequest
Generic)
  deriving (Gen NewConnectionRequest
Gen NewConnectionRequest
-> (NewConnectionRequest -> [NewConnectionRequest])
-> Arbitrary NewConnectionRequest
NewConnectionRequest -> [NewConnectionRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewConnectionRequest
arbitrary :: Gen NewConnectionRequest
$cshrink :: NewConnectionRequest -> [NewConnectionRequest]
shrink :: NewConnectionRequest -> [NewConnectionRequest]
Arbitrary) via (GenericUniform NewConnectionRequest)
  deriving (Value -> Parser [NewConnectionRequest]
Value -> Parser NewConnectionRequest
(Value -> Parser NewConnectionRequest)
-> (Value -> Parser [NewConnectionRequest])
-> FromJSON NewConnectionRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewConnectionRequest
parseJSON :: Value -> Parser NewConnectionRequest
$cparseJSONList :: Value -> Parser [NewConnectionRequest]
parseJSONList :: Value -> Parser [NewConnectionRequest]
FromJSON, [NewConnectionRequest] -> Value
[NewConnectionRequest] -> Encoding
NewConnectionRequest -> Value
NewConnectionRequest -> Encoding
(NewConnectionRequest -> Value)
-> (NewConnectionRequest -> Encoding)
-> ([NewConnectionRequest] -> Value)
-> ([NewConnectionRequest] -> Encoding)
-> ToJSON NewConnectionRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewConnectionRequest -> Value
toJSON :: NewConnectionRequest -> Value
$ctoEncoding :: NewConnectionRequest -> Encoding
toEncoding :: NewConnectionRequest -> Encoding
$ctoJSONList :: [NewConnectionRequest] -> Value
toJSONList :: [NewConnectionRequest] -> Value
$ctoEncodingList :: [NewConnectionRequest] -> Encoding
toEncodingList :: [NewConnectionRequest] -> Encoding
ToJSON) via (CustomEncoded NewConnectionRequest)

instance ToSchema NewConnectionRequest

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

instance ToSchema RemoteConnectionAction

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

instance ToSchema NewConnectionResponse

data ClaimKeyPackageRequest = ClaimKeyPackageRequest
  { -- | The user making the request, implictly qualified by the origin domain.
    ClaimKeyPackageRequest -> UserId
claimant :: UserId,
    -- | The user whose key packages are being claimed, implictly qualified by
    -- the target domain.
    ClaimKeyPackageRequest -> UserId
target :: UserId,
    -- | The ciphersuite of the key packages being claimed.
    ClaimKeyPackageRequest -> CipherSuite
cipherSuite :: CipherSuite
  }
  deriving stock (ClaimKeyPackageRequest -> ClaimKeyPackageRequest -> Bool
(ClaimKeyPackageRequest -> ClaimKeyPackageRequest -> Bool)
-> (ClaimKeyPackageRequest -> ClaimKeyPackageRequest -> Bool)
-> Eq ClaimKeyPackageRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClaimKeyPackageRequest -> ClaimKeyPackageRequest -> Bool
== :: ClaimKeyPackageRequest -> ClaimKeyPackageRequest -> Bool
$c/= :: ClaimKeyPackageRequest -> ClaimKeyPackageRequest -> Bool
/= :: ClaimKeyPackageRequest -> ClaimKeyPackageRequest -> Bool
Eq, Int -> ClaimKeyPackageRequest -> ShowS
[ClaimKeyPackageRequest] -> ShowS
ClaimKeyPackageRequest -> String
(Int -> ClaimKeyPackageRequest -> ShowS)
-> (ClaimKeyPackageRequest -> String)
-> ([ClaimKeyPackageRequest] -> ShowS)
-> Show ClaimKeyPackageRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClaimKeyPackageRequest -> ShowS
showsPrec :: Int -> ClaimKeyPackageRequest -> ShowS
$cshow :: ClaimKeyPackageRequest -> String
show :: ClaimKeyPackageRequest -> String
$cshowList :: [ClaimKeyPackageRequest] -> ShowS
showList :: [ClaimKeyPackageRequest] -> ShowS
Show, (forall x. ClaimKeyPackageRequest -> Rep ClaimKeyPackageRequest x)
-> (forall x.
    Rep ClaimKeyPackageRequest x -> ClaimKeyPackageRequest)
-> Generic ClaimKeyPackageRequest
forall x. Rep ClaimKeyPackageRequest x -> ClaimKeyPackageRequest
forall x. ClaimKeyPackageRequest -> Rep ClaimKeyPackageRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClaimKeyPackageRequest -> Rep ClaimKeyPackageRequest x
from :: forall x. ClaimKeyPackageRequest -> Rep ClaimKeyPackageRequest x
$cto :: forall x. Rep ClaimKeyPackageRequest x -> ClaimKeyPackageRequest
to :: forall x. Rep ClaimKeyPackageRequest x -> ClaimKeyPackageRequest
Generic)
  deriving (Gen ClaimKeyPackageRequest
Gen ClaimKeyPackageRequest
-> (ClaimKeyPackageRequest -> [ClaimKeyPackageRequest])
-> Arbitrary ClaimKeyPackageRequest
ClaimKeyPackageRequest -> [ClaimKeyPackageRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ClaimKeyPackageRequest
arbitrary :: Gen ClaimKeyPackageRequest
$cshrink :: ClaimKeyPackageRequest -> [ClaimKeyPackageRequest]
shrink :: ClaimKeyPackageRequest -> [ClaimKeyPackageRequest]
Arbitrary) via (GenericUniform ClaimKeyPackageRequest)
  deriving (Value -> Parser [ClaimKeyPackageRequest]
Value -> Parser ClaimKeyPackageRequest
(Value -> Parser ClaimKeyPackageRequest)
-> (Value -> Parser [ClaimKeyPackageRequest])
-> FromJSON ClaimKeyPackageRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ClaimKeyPackageRequest
parseJSON :: Value -> Parser ClaimKeyPackageRequest
$cparseJSONList :: Value -> Parser [ClaimKeyPackageRequest]
parseJSONList :: Value -> Parser [ClaimKeyPackageRequest]
FromJSON, [ClaimKeyPackageRequest] -> Value
[ClaimKeyPackageRequest] -> Encoding
ClaimKeyPackageRequest -> Value
ClaimKeyPackageRequest -> Encoding
(ClaimKeyPackageRequest -> Value)
-> (ClaimKeyPackageRequest -> Encoding)
-> ([ClaimKeyPackageRequest] -> Value)
-> ([ClaimKeyPackageRequest] -> Encoding)
-> ToJSON ClaimKeyPackageRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ClaimKeyPackageRequest -> Value
toJSON :: ClaimKeyPackageRequest -> Value
$ctoEncoding :: ClaimKeyPackageRequest -> Encoding
toEncoding :: ClaimKeyPackageRequest -> Encoding
$ctoJSONList :: [ClaimKeyPackageRequest] -> Value
toJSONList :: [ClaimKeyPackageRequest] -> Value
$ctoEncodingList :: [ClaimKeyPackageRequest] -> Encoding
toEncodingList :: [ClaimKeyPackageRequest] -> Encoding
ToJSON) via (CustomEncoded ClaimKeyPackageRequest)

instance ToSchema ClaimKeyPackageRequest

swaggerDoc :: OpenApi
swaggerDoc :: OpenApi
swaggerDoc = Proxy
  (Named
     "api-version"
     ("api-version"
      :> (OriginDomainHeader
          :> (ReqBody '[JSON] () :> Verb 'POST 200 '[JSON] VersionInfo)))
   :<|> (Named
           "get-user-by-handle"
           ("get-user-by-handle"
            :> (OriginDomainHeader
                :> (ReqBody '[JSON] Handle
                    :> Verb 'POST 200 '[JSON] (Maybe UserProfile))))
         :<|> (Named
                 "get-users-by-ids"
                 ("get-users-by-ids"
                  :> (OriginDomainHeader
                      :> (ReqBody '[JSON] [UserId]
                          :> Verb 'POST 200 '[JSON] [UserProfile])))
               :<|> (Named
                       "claim-prekey"
                       ("claim-prekey"
                        :> (OriginDomainHeader
                            :> (ReqBody '[JSON] (UserId, ClientId)
                                :> Verb 'POST 200 '[JSON] (Maybe ClientPrekey))))
                     :<|> (Named
                             "claim-prekey-bundle"
                             ("claim-prekey-bundle"
                              :> (OriginDomainHeader
                                  :> (ReqBody '[JSON] UserId
                                      :> Verb 'POST 200 '[JSON] PrekeyBundle)))
                           :<|> (Named
                                   "claim-multi-prekey-bundle"
                                   ("claim-multi-prekey-bundle"
                                    :> (OriginDomainHeader
                                        :> (ReqBody '[JSON] UserClients
                                            :> Verb 'POST 200 '[JSON] UserClientPrekeyMap)))
                                 :<|> (Named
                                         "search-users"
                                         ("search-users"
                                          :> (OriginDomainHeader
                                              :> (ReqBody '[JSON] SearchRequest
                                                  :> Verb 'POST 200 '[JSON] SearchResponse)))
                                       :<|> (Named
                                               "get-user-clients"
                                               ("get-user-clients"
                                                :> (OriginDomainHeader
                                                    :> (ReqBody '[JSON] GetUserClients
                                                        :> Verb
                                                             'POST
                                                             200
                                                             '[JSON]
                                                             (UserMap (Set PubClient)))))
                                             :<|> (Named (Versioned 'V0 "get-mls-clients") EmptyAPI
                                                   :<|> (Named
                                                           "get-mls-clients"
                                                           ("get-mls-clients"
                                                            :> (OriginDomainHeader
                                                                :> (ReqBody
                                                                      '[JSON] MLSClientsRequest
                                                                    :> Verb
                                                                         'POST
                                                                         200
                                                                         '[JSON]
                                                                         (Set ClientInfo))))
                                                         :<|> (Named
                                                                 "send-connection-action"
                                                                 ("send-connection-action"
                                                                  :> (OriginDomainHeader
                                                                      :> (ReqBody
                                                                            '[JSON]
                                                                            NewConnectionRequest
                                                                          :> Verb
                                                                               'POST
                                                                               200
                                                                               '[JSON]
                                                                               NewConnectionResponse)))
                                                               :<|> (Named
                                                                       "claim-key-packages"
                                                                       ("claim-key-packages"
                                                                        :> (OriginDomainHeader
                                                                            :> (ReqBody
                                                                                  '[JSON]
                                                                                  ClaimKeyPackageRequest
                                                                                :> Verb
                                                                                     'POST
                                                                                     200
                                                                                     '[JSON]
                                                                                     (Maybe
                                                                                        KeyPackageBundle))))
                                                                     :<|> (Named
                                                                             "get-not-fully-connected-backends"
                                                                             ("get-not-fully-connected-backends"
                                                                              :> (OriginDomainHeader
                                                                                  :> (ReqBody
                                                                                        '[JSON]
                                                                                        DomainSet
                                                                                      :> Verb
                                                                                           'POST
                                                                                           200
                                                                                           '[JSON]
                                                                                           NonConnectedBackends)))
                                                                           :<|> Named
                                                                                  "on-user-deleted-connections"
                                                                                  ("on-user-deleted-connections"
                                                                                   :> (OriginDomainHeader
                                                                                       :> (ReqBody
                                                                                             '[JSON]
                                                                                             UserDeletedConnectionsNotification
                                                                                           :> Verb
                                                                                                'POST
                                                                                                200
                                                                                                '[JSON]
                                                                                                EmptyResponse))))))))))))))))
-> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SpecialiseToVersion 'V1 BrigApi))