{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Wire.API.Error.Galley
( GalleyError (..),
OperationDenied,
MLSProtocolError,
mlsProtocolError,
AuthenticationError (..),
TeamFeatureError (..),
MLSProposalFailure (..),
NonFederatingBackends (..),
UnreachableBackends (..),
unreachableUsersToUnreachableBackends,
UnreachableBackendsLegacy (..),
)
where
import Control.Lens ((%~), (.~), (?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Containers.ListUtils
import Data.Domain
import Data.HashMap.Strict.InsOrd (singleton)
import Data.OpenApi qualified as S
import Data.Proxy
import Data.Qualified
import Data.Schema
import Data.Singletons.TH (genSingletons)
import Data.Tagged
import GHC.TypeLits
import Imports
import Network.HTTP.Types.Status qualified as HTTP
import Network.Wai.Utilities.Error qualified as Wai
import Network.Wai.Utilities.JSONResponse
import Polysemy
import Polysemy.Error
import Prelude.Singletons (Show_)
import Servant.API.ContentTypes (JSON, contentType)
import Wire.API.Conversation.Role
import Wire.API.Error
import Wire.API.Error.Brig qualified as BrigError
import Wire.API.Routes.API
import Wire.API.Team.HardTruncationLimit
import Wire.API.Team.Permission
import Wire.API.Unreachable
import Wire.API.Util.Aeson (CustomEncoded (..))
data GalleyError
= InvalidAction
| InvalidTargetAccess
| TeamNotFound
| TeamMemberNotFound
| NotATeamMember
| NonBindingTeam
| BroadcastLimitExceeded
| UserBindingExists
| NoAddToBinding
| TooManyTeamMembers
| TooManyTeamAdmins
|
MissingPermission (Maybe Perm)
| ActionDenied Action
| NotConnected
| InvalidOperation
| InvalidTarget
| ConvNotFound
| ConvAccessDenied
| ConvInvalidProtocolTransition
|
MLSNotEnabled
| MLSNonEmptyMemberList
| MLSDuplicatePublicKey
| MLSInvalidLeafNodeIndex
| MLSUnsupportedMessage
| MLSProposalNotFound
| MLSUnsupportedProposal
| MLSProtocolErrorTag
| MLSClientMismatch
| MLSStaleMessage
| MLSCommitMissingReferences
| MLSSelfRemovalNotAllowed
| MLSGroupConversationMismatch
| MLSClientSenderUserMismatch
| MLSWelcomeMismatch
| MLSMissingGroupInfo
| MLSUnexpectedSenderClient
| MLSSubConvUnsupportedConvType
| MLSSubConvClientNotInParent
| MLSMigrationCriteriaNotSatisfied
| MLSFederatedOne2OneNotSupported
|
MLSLegalholdIncompatible
|
NoBindingTeamMembers
| NoBindingTeam
| NotAOneMemberTeam
| TooManyMembers
| ConvMemberNotFound
| GuestLinksDisabled
| CodeNotFound
| InvalidConversationPassword
| CreateConversationCodeConflict
| InvalidPermissions
| InvalidTeamStatusUpdate
| AccessDenied
| CustomBackendNotFound
| DeleteQueueFull
| TeamSearchVisibilityNotEnabled
| CannotEnableLegalHoldServiceLargeTeam
|
MissingLegalholdConsent
| MissingLegalholdConsentOldClients
| NoUserLegalHoldConsent
| LegalHoldNotEnabled
| LegalHoldDisableUnimplemented
| LegalHoldServiceInvalidKey
| LegalHoldServiceBadResponse
| UserLegalHoldAlreadyEnabled
| LegalHoldServiceNotRegistered
| LegalHoldCouldNotBlockConnections
| UserLegalHoldIllegalOperation
| TooManyTeamMembersOnTeamWithLegalhold
| NoLegalHoldDeviceAllocated
| UserLegalHoldNotPending
|
BulkGetMemberLimitExceeded
|
InvalidTeamNotificationId
deriving (Int -> GalleyError -> ShowS
[GalleyError] -> ShowS
GalleyError -> String
(Int -> GalleyError -> ShowS)
-> (GalleyError -> String)
-> ([GalleyError] -> ShowS)
-> Show GalleyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GalleyError -> ShowS
showsPrec :: Int -> GalleyError -> ShowS
$cshow :: GalleyError -> String
show :: GalleyError -> String
$cshowList :: [GalleyError] -> ShowS
showList :: [GalleyError] -> ShowS
Show, GalleyError -> GalleyError -> Bool
(GalleyError -> GalleyError -> Bool)
-> (GalleyError -> GalleyError -> Bool) -> Eq GalleyError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GalleyError -> GalleyError -> Bool
== :: GalleyError -> GalleyError -> Bool
$c/= :: GalleyError -> GalleyError -> Bool
/= :: GalleyError -> GalleyError -> Bool
Eq, (forall x. GalleyError -> Rep GalleyError x)
-> (forall x. Rep GalleyError x -> GalleyError)
-> Generic GalleyError
forall x. Rep GalleyError x -> GalleyError
forall x. GalleyError -> Rep GalleyError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GalleyError -> Rep GalleyError x
from :: forall x. GalleyError -> Rep GalleyError x
$cto :: forall x. Rep GalleyError x -> GalleyError
to :: forall x. Rep GalleyError x -> GalleyError
Generic)
deriving (Value -> Parser [GalleyError]
Value -> Parser GalleyError
(Value -> Parser GalleyError)
-> (Value -> Parser [GalleyError]) -> FromJSON GalleyError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GalleyError
parseJSON :: Value -> Parser GalleyError
$cparseJSONList :: Value -> Parser [GalleyError]
parseJSONList :: Value -> Parser [GalleyError]
FromJSON, [GalleyError] -> Value
[GalleyError] -> Encoding
GalleyError -> Value
GalleyError -> Encoding
(GalleyError -> Value)
-> (GalleyError -> Encoding)
-> ([GalleyError] -> Value)
-> ([GalleyError] -> Encoding)
-> ToJSON GalleyError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: GalleyError -> Value
toJSON :: GalleyError -> Value
$ctoEncoding :: GalleyError -> Encoding
toEncoding :: GalleyError -> Encoding
$ctoJSONList :: [GalleyError] -> Value
toJSONList :: [GalleyError] -> Value
$ctoEncodingList :: [GalleyError] -> Encoding
toEncodingList :: [GalleyError] -> Encoding
ToJSON) via (CustomEncoded GalleyError)
instance S.ToSchema GalleyError
$
instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: GalleyError) where
addToOpenApi :: OpenApi -> OpenApi
addToOpenApi = forall (e :: StaticError).
(Typeable e, KnownError e) =>
OpenApi -> OpenApi
addStaticErrorToSwagger @(MapError e)
instance (KnownError (MapError e)) => APIError (Tagged (e :: GalleyError) ()) where
toResponse :: Tagged e () -> JSONResponse
toResponse Tagged e ()
_ = DynError -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse (DynError -> JSONResponse) -> DynError -> JSONResponse
forall a b. (a -> b) -> a -> b
$ forall (e :: StaticError). KnownError e => DynError
dynError @(MapError e)
type OperationDenied = 'MissingPermission 'Nothing
type MLSProtocolError = Tagged 'MLSProtocolErrorTag Text
mlsProtocolError :: Text -> MLSProtocolError
mlsProtocolError :: Text -> MLSProtocolError
mlsProtocolError = Text -> MLSProtocolError
forall {k} (s :: k) b. b -> Tagged s b
Tagged
type family GalleyErrorEffect (e :: GalleyError) :: Effect where
GalleyErrorEffect 'MLSProtocolErrorTag = Error MLSProtocolError
GalleyErrorEffect e = ErrorS e
type instance ErrorEffect (e :: GalleyError) = GalleyErrorEffect e
type instance MapError 'InvalidAction = 'StaticError 400 "invalid-actions" "The specified actions are invalid"
type instance MapError 'InvalidTargetAccess = 'StaticError 403 "invalid-op" "Invalid target access"
type instance MapError 'TeamNotFound = 'StaticError 404 "no-team" "Team not found"
type instance MapError 'NonBindingTeam = 'StaticError 404 "non-binding-team" "Not a member of a binding team"
type instance MapError 'BroadcastLimitExceeded = 'StaticError 400 "too-many-users-to-broadcast" "Too many users to fan out the broadcast event to"
type instance MapError 'TeamMemberNotFound = 'StaticError 404 "no-team-member" "Team member not found"
type instance MapError 'NotATeamMember = 'StaticError 403 "no-team-member" "Requesting user is not a team member"
type instance MapError 'UserBindingExists = 'StaticError 403 "binding-exists" "User already bound to a different team"
type instance MapError 'NoAddToBinding = 'StaticError 403 "binding-team" "Cannot add users to binding teams, invite only"
type instance MapError 'TooManyTeamMembers = 'StaticError 403 "too-many-team-members" "Maximum number of members per team reached"
type instance MapError 'TooManyTeamAdmins = 'StaticError 403 "too-many-team-admins" "Maximum number of admins per team reached"
type instance MapError ('MissingPermission mperm) = 'StaticError 403 "operation-denied" (MissingPermissionMessage mperm)
type instance MapError ('ActionDenied action) = 'StaticError 403 "action-denied" ("Insufficient authorization (missing " `AppendSymbol` ActionName action `AppendSymbol` ")")
type instance MapError 'NotConnected = 'StaticError 403 "not-connected" "Users are not connected"
type instance MapError 'InvalidOperation = 'StaticError 403 "invalid-op" "Invalid operation"
type instance MapError 'InvalidTarget = 'StaticError 403 "invalid-op" "Invalid target"
type instance MapError 'ConvNotFound = 'StaticError 404 "no-conversation" "Conversation not found"
type instance MapError 'ConvAccessDenied = 'StaticError 403 "access-denied" "Conversation access denied"
type instance MapError 'ConvInvalidProtocolTransition = 'StaticError 403 "invalid-protocol-transition" "Protocol transition is invalid"
type instance MapError 'InvalidTeamNotificationId = 'StaticError 400 "invalid-notification-id" "Could not parse notification id (must be UUIDv1)."
type instance
MapError 'MLSNotEnabled =
'StaticError
400
"mls-not-enabled"
"MLS is not configured on this backend. See docs.wire.com for instructions on how to enable it"
type instance MapError 'MLSNonEmptyMemberList = 'StaticError 400 "non-empty-member-list" "Attempting to add group members outside MLS"
type instance MapError 'MLSDuplicatePublicKey = 'StaticError 400 "mls-duplicate-public-key" "MLS public key for the given signature scheme already exists"
type instance MapError 'MLSInvalidLeafNodeIndex = 'StaticError 400 "mls-invalid-leaf-node-index" "A referenced leaf node index points to a blank or non-existing node"
type instance MapError 'MLSUnsupportedMessage = 'StaticError 422 "mls-unsupported-message" "Attempted to send a message with an unsupported combination of content type and wire format"
type instance MapError 'MLSProposalNotFound = 'StaticError 404 "mls-proposal-not-found" "A proposal referenced in a commit message could not be found"
type instance MapError 'MLSUnsupportedProposal = 'StaticError 422 "mls-unsupported-proposal" "Unsupported proposal type"
type instance MapError 'MLSProtocolErrorTag = MapError 'BrigError.MLSProtocolError
type instance MapError 'MLSClientMismatch = 'StaticError 409 "mls-client-mismatch" "A proposal of type Add or Remove does not apply to the full list of clients for a user"
type instance MapError 'MLSStaleMessage = 'StaticError 409 "mls-stale-message" "The conversation epoch in a message is too old"
type instance MapError 'MLSCommitMissingReferences = 'StaticError 400 "mls-commit-missing-references" "The commit is not referencing all pending proposals"
type instance MapError 'MLSSelfRemovalNotAllowed = 'StaticError 400 "mls-self-removal-not-allowed" "Self removal from group is not allowed"
type instance MapError 'MLSGroupConversationMismatch = 'StaticError 400 "mls-group-conversation-mismatch" "Conversation ID resolved from Group ID does not match submitted Conversation ID"
type instance MapError 'MLSClientSenderUserMismatch = 'StaticError 400 "mls-client-sender-user-mismatch" "User ID resolved from Client ID does not match message's sender user ID"
type instance MapError 'MLSWelcomeMismatch = 'StaticError 400 "mls-welcome-mismatch" "The list of targets of a welcome message does not match the list of new clients in a group"
type instance MapError 'MLSMissingGroupInfo = 'StaticError 404 "mls-missing-group-info" "The conversation has no group information"
type instance MapError 'MLSSubConvUnsupportedConvType = 'StaticError 403 "mls-subconv-unsupported-convtype" "MLS subconversations are only supported for regular conversations"
type instance MapError 'MLSSubConvClientNotInParent = 'StaticError 403 "mls-subconv-join-parent-missing" "MLS client cannot join the subconversation because it is not member of the parent conversation"
type instance MapError 'MLSMigrationCriteriaNotSatisfied = 'StaticError 400 "mls-migration-criteria-not-satisfied" "The migration criteria for mixed to MLS protocol transition are not satisfied for this conversation"
type instance MapError 'MLSFederatedOne2OneNotSupported = 'StaticError 400 "mls-federated-one2one-not-supported" "Federated One2One MLS conversations are only supported in API version >= 6"
type instance MapError MLSLegalholdIncompatible = 'StaticError 409 "mls-legal-hold-not-allowed" "A user who is under legal-hold may not participate in MLS conversations"
type instance MapError 'NoBindingTeamMembers = 'StaticError 403 "non-binding-team-members" "Both users must be members of the same binding team"
type instance MapError 'NoBindingTeam = 'StaticError 403 "no-binding-team" "Operation allowed only on binding teams"
type instance MapError 'NotAOneMemberTeam = 'StaticError 403 "not-one-member-team" "Can only delete teams with a single member"
type instance MapError 'TooManyMembers = 'StaticError 403 "too-many-members" "Maximum number of members per conversation reached"
type instance MapError 'ConvMemberNotFound = 'StaticError 404 "no-conversation-member" "Conversation member not found"
type instance MapError 'GuestLinksDisabled = 'StaticError 409 "guest-links-disabled" "The guest link feature is disabled and all guest links have been revoked"
type instance MapError 'CodeNotFound = 'StaticError 404 "no-conversation-code" "Conversation code not found"
type instance MapError 'InvalidConversationPassword = 'StaticError 403 "invalid-conversation-password" "Invalid conversation password"
type instance MapError 'CreateConversationCodeConflict = 'StaticError 409 "create-conv-code-conflict" "Conversation code already exists with a different password setting than the requested one."
type instance MapError 'InvalidPermissions = 'StaticError 403 "invalid-permissions" "The specified permissions are invalid"
type instance MapError 'InvalidTeamStatusUpdate = 'StaticError 403 "invalid-team-status-update" "Cannot use this endpoint to update the team to the given status."
type instance MapError 'AccessDenied = 'StaticError 403 "access-denied" "You do not have permission to access this resource"
type instance MapError 'CustomBackendNotFound = 'StaticError 404 "custom-backend-not-found" "Custom backend not found"
type instance MapError 'DeleteQueueFull = 'StaticError 503 "queue-full" "The delete queue is full; no further delete requests can be processed at the moment"
type instance MapError 'TeamSearchVisibilityNotEnabled = 'StaticError 403 "team-search-visibility-not-enabled" "Custom search is not available for this team"
type instance MapError 'CannotEnableLegalHoldServiceLargeTeam = 'StaticError 403 "too-large-team-for-legalhold" "Cannot enable legalhold on large teams (reason: for removing LH from team, we need to iterate over all members, which is only supported for teams with less than 2k members)"
type family MissingPermissionMessage (a :: Maybe Perm) :: Symbol where
MissingPermissionMessage ('Just p) = "Insufficient permissions (missing " `AppendSymbol` Show_ p `AppendSymbol` ")"
MissingPermissionMessage 'Nothing = "Insufficient permissions"
type instance MapError 'TooManyTeamMembersOnTeamWithLegalhold = 'StaticError 403 "too-many-members-for-legalhold" "cannot add more members to team when legalhold service is enabled."
type instance MapError 'LegalHoldServiceInvalidKey = 'StaticError 400 "legalhold-invalid-key" "legal hold service pubkey is invalid"
type instance MapError 'MissingLegalholdConsent = 'StaticError 403 "missing-legalhold-consent" "Failed to connect to a user or to invite a user to a group because somebody is under legalhold and somebody else has not granted consent"
type instance MapError 'MissingLegalholdConsentOldClients = 'StaticError 403 "missing-legalhold-consent-old-clients" "Failed to connect to a user or to invite a user to a group because somebody is under legalhold and somebody else has old clients that do not support legalhold's UI requirements"
type instance MapError 'LegalHoldServiceNotRegistered = 'StaticError 400 "legalhold-not-registered" "legal hold service has not been registered for this team"
type instance MapError 'LegalHoldServiceBadResponse = 'StaticError 400 "legalhold-status-bad" "legal hold service: invalid response"
type instance MapError 'LegalHoldNotEnabled = 'StaticError 403 "legalhold-not-enabled" "legal hold is not enabled for this team"
type instance MapError 'LegalHoldDisableUnimplemented = 'StaticError 403 "legalhold-disable-unimplemented" "legal hold cannot be disabled for whitelisted teams"
type instance MapError 'UserLegalHoldAlreadyEnabled = 'StaticError 409 "legalhold-already-enabled" "legal hold is already enabled for this user"
type instance MapError 'NoUserLegalHoldConsent = 'StaticError 409 "legalhold-no-consent" "user has not given consent to using legal hold"
type instance MapError 'UserLegalHoldIllegalOperation = 'StaticError 500 "legalhold-illegal-op" "internal server error: inconsistent change of user's legalhold state"
type instance MapError 'UserLegalHoldNotPending = 'StaticError 412 "legalhold-not-pending" "legal hold cannot be approved without being in a pending state"
type instance MapError 'NoLegalHoldDeviceAllocated = 'StaticError 404 "legalhold-no-device-allocated" "no legal hold device is registered for this user. POST /teams/:tid/legalhold/:uid/ to start the flow."
type instance MapError 'LegalHoldCouldNotBlockConnections = 'StaticError 500 "legalhold-internal" "legal hold service: could not block connections when resolving policy conflicts."
type instance MapError 'BulkGetMemberLimitExceeded = 'StaticError 400 "too-many-uids" ("Can only process " `AppendSymbol` Show_ HardTruncationLimit `AppendSymbol` " user ids per request.")
data AuthenticationError
= ReAuthFailed
| VerificationCodeAuthFailed
| VerificationCodeRequired
type instance MapError 'ReAuthFailed = 'StaticError 403 "access-denied" "This operation requires reauthentication"
type instance MapError 'VerificationCodeAuthFailed = 'StaticError 403 "code-authentication-failed" "Code authentication failed"
type instance MapError 'VerificationCodeRequired = 'StaticError 403 "code-authentication-required" "Verification code required"
instance IsSwaggerError AuthenticationError where
addToOpenApi :: OpenApi -> OpenApi
addToOpenApi =
forall (e :: StaticError).
(Typeable e, KnownError e) =>
OpenApi -> OpenApi
addStaticErrorToSwagger @(MapError 'ReAuthFailed)
(OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: StaticError).
(Typeable e, KnownError e) =>
OpenApi -> OpenApi
addStaticErrorToSwagger @(MapError 'VerificationCodeAuthFailed)
(OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: StaticError).
(Typeable e, KnownError e) =>
OpenApi -> OpenApi
addStaticErrorToSwagger @(MapError 'VerificationCodeRequired)
type instance ErrorEffect AuthenticationError = Error AuthenticationError
authenticationErrorToDyn :: AuthenticationError -> DynError
authenticationErrorToDyn :: AuthenticationError -> DynError
authenticationErrorToDyn AuthenticationError
ReAuthFailed = forall (e :: StaticError). KnownError e => DynError
dynError @(MapError 'ReAuthFailed)
authenticationErrorToDyn AuthenticationError
VerificationCodeAuthFailed = forall (e :: StaticError). KnownError e => DynError
dynError @(MapError 'VerificationCodeAuthFailed)
authenticationErrorToDyn AuthenticationError
VerificationCodeRequired = forall (e :: StaticError). KnownError e => DynError
dynError @(MapError 'VerificationCodeRequired)
instance (Member (Error DynError) r) => ServerEffect (Error AuthenticationError) r where
interpretServerEffect :: forall a. Sem (Error AuthenticationError : r) a -> Sem r a
interpretServerEffect = (AuthenticationError -> DynError)
-> Sem (Error AuthenticationError : r) a -> Sem r a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError AuthenticationError -> DynError
authenticationErrorToDyn
data TeamFeatureError
= AppLockInactivityTimeoutTooLow
| LegalHoldFeatureFlagNotEnabled
| LegalHoldWhitelistedOnly
| DisableSsoNotImplemented
| FeatureLocked
| MLSProtocolMismatch
| MLSE2EIDMissingCrlProxy
| EmptyDownloadLocation
instance IsSwaggerError TeamFeatureError where
addToOpenApi :: OpenApi -> OpenApi
addToOpenApi = OpenApi -> OpenApi
forall a. a -> a
id
instance (Member (Error DynError) r) => ServerEffect (Error TeamFeatureError) r where
interpretServerEffect :: forall a. Sem (Error TeamFeatureError : r) a -> Sem r a
interpretServerEffect = (TeamFeatureError -> DynError)
-> Sem (Error TeamFeatureError : r) a -> Sem r a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError ((TeamFeatureError -> DynError)
-> Sem (Error TeamFeatureError : r) a -> Sem r a)
-> (TeamFeatureError -> DynError)
-> Sem (Error TeamFeatureError : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
TeamFeatureError
AppLockInactivityTimeoutTooLow ->
Nat -> Text -> Text -> DynError
DynError
Nat
400
Text
"inactivity-timeout-too-low"
Text
"Applock inactivity timeout must be at least 30 seconds"
TeamFeatureError
LegalHoldFeatureFlagNotEnabled -> Nat -> Text -> Text -> DynError
DynError Nat
403 Text
"legalhold-not-enabled" Text
"Legal hold is not enabled for this wire instance"
TeamFeatureError
LegalHoldWhitelistedOnly -> Nat -> Text -> Text -> DynError
DynError Nat
403 Text
"legalhold-whitelisted-only" Text
"Legal hold is enabled for teams via server config and cannot be changed here"
TeamFeatureError
DisableSsoNotImplemented ->
Nat -> Text -> Text -> DynError
DynError
Nat
403
Text
"not-implemented"
Text
"The SSO feature flag is disabled by default. It can only be enabled once for any team, never disabled.\n\
\\n\
\Rationale: there are two services in the backend that need to keep their status in sync: galley (teams),\n\
\and spar (SSO). Galley keeps track of team features. If galley creates an idp, the feature flag is\n\
\checked. For authentication, spar avoids this expensive check and assumes that the idp can only have\n\
\been created if the SSO is enabled. This assumption does not hold any more if the switch is turned off\n\
\again, so we do not support this.\n\
\\n\
\It is definitely feasible to change this. If you have a use case, please contact customer support, or\n\
\open an issue on https://github.com/wireapp/wire-server."
TeamFeatureError
FeatureLocked -> Nat -> Text -> Text -> DynError
DynError Nat
409 Text
"feature-locked" Text
"Feature config cannot be updated (e.g. because it is configured to be locked, or because you need to upgrade your plan)"
TeamFeatureError
MLSProtocolMismatch -> Nat -> Text -> Text -> DynError
DynError Nat
400 Text
"mls-protocol-mismatch" Text
"The default protocol needs to be part of the supported protocols"
TeamFeatureError
MLSE2EIDMissingCrlProxy -> Nat -> Text -> Text -> DynError
DynError Nat
400 Text
"mls-e2eid-missing-crl-proxy" Text
"The field 'crlProxy' is missing in the request payload"
TeamFeatureError
EmptyDownloadLocation -> Nat -> Text -> Text -> DynError
DynError Nat
400 Text
"empty-download-location" Text
"Download location cannot be empty"
type instance ErrorEffect TeamFeatureError = Error TeamFeatureError
data MLSProposalFailure = MLSProposalFailure
{ MLSProposalFailure -> JSONResponse
pfInner :: JSONResponse
}
type instance ErrorEffect MLSProposalFailure = Error MLSProposalFailure
instance IsSwaggerError MLSProposalFailure where
addToOpenApi :: OpenApi -> OpenApi
addToOpenApi = (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
S.allOperations ((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> ((Maybe Text -> Identity (Maybe Text))
-> Operation -> Identity Operation)
-> (Maybe Text -> Identity (Maybe Text))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> Operation -> Identity Operation
forall s a. HasDescription s a => Lens' s a
Lens' Operation (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
-> OpenApi -> Identity OpenApi)
-> (Maybe Text -> Maybe Text) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (Maybe Text -> Text) -> Maybe Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc) (Text -> Text) -> (Maybe Text -> Text) -> Maybe Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Text
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
where
desc :: Text
desc =
Text
"\n\n**Note**: this endpoint can execute proposals, and therefore \
\return all possible errors associated with adding or removing members to \
\a conversation, in addition to the ones listed below. See the documentation of [POST \
\/conversations/{cnv}/members/v2](#/default/post_conversations__cnv__members_v2) \
\and [POST \
\/conversations/{cnv_domain}/{cnv}/members/{usr_domain}/{usr}](#/default/delete_conversations__cnv_domain___cnv__members__usr_domain___usr_) \
\for more details on the possible error responses of each type of \
\proposal."
instance (Member (Error JSONResponse) r) => ServerEffect (Error MLSProposalFailure) r where
interpretServerEffect :: forall a. Sem (Error MLSProposalFailure : r) a -> Sem r a
interpretServerEffect = (MLSProposalFailure -> JSONResponse)
-> Sem (Error MLSProposalFailure : r) a -> Sem r a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError MLSProposalFailure -> JSONResponse
pfInner
data NonFederatingBackends = NonFederatingBackends Domain Domain
deriving stock (NonFederatingBackends -> NonFederatingBackends -> Bool
(NonFederatingBackends -> NonFederatingBackends -> Bool)
-> (NonFederatingBackends -> NonFederatingBackends -> Bool)
-> Eq NonFederatingBackends
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonFederatingBackends -> NonFederatingBackends -> Bool
== :: NonFederatingBackends -> NonFederatingBackends -> Bool
$c/= :: NonFederatingBackends -> NonFederatingBackends -> Bool
/= :: NonFederatingBackends -> NonFederatingBackends -> Bool
Eq, Int -> NonFederatingBackends -> ShowS
[NonFederatingBackends] -> ShowS
NonFederatingBackends -> String
(Int -> NonFederatingBackends -> ShowS)
-> (NonFederatingBackends -> String)
-> ([NonFederatingBackends] -> ShowS)
-> Show NonFederatingBackends
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonFederatingBackends -> ShowS
showsPrec :: Int -> NonFederatingBackends -> ShowS
$cshow :: NonFederatingBackends -> String
show :: NonFederatingBackends -> String
$cshowList :: [NonFederatingBackends] -> ShowS
showList :: [NonFederatingBackends] -> ShowS
Show, (forall x. NonFederatingBackends -> Rep NonFederatingBackends x)
-> (forall x. Rep NonFederatingBackends x -> NonFederatingBackends)
-> Generic NonFederatingBackends
forall x. Rep NonFederatingBackends x -> NonFederatingBackends
forall x. NonFederatingBackends -> Rep NonFederatingBackends x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NonFederatingBackends -> Rep NonFederatingBackends x
from :: forall x. NonFederatingBackends -> Rep NonFederatingBackends x
$cto :: forall x. Rep NonFederatingBackends x -> NonFederatingBackends
to :: forall x. Rep NonFederatingBackends x -> NonFederatingBackends
Generic)
deriving (Value -> Parser [NonFederatingBackends]
Value -> Parser NonFederatingBackends
(Value -> Parser NonFederatingBackends)
-> (Value -> Parser [NonFederatingBackends])
-> FromJSON NonFederatingBackends
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NonFederatingBackends
parseJSON :: Value -> Parser NonFederatingBackends
$cparseJSONList :: Value -> Parser [NonFederatingBackends]
parseJSONList :: Value -> Parser [NonFederatingBackends]
FromJSON, [NonFederatingBackends] -> Value
[NonFederatingBackends] -> Encoding
NonFederatingBackends -> Value
NonFederatingBackends -> Encoding
(NonFederatingBackends -> Value)
-> (NonFederatingBackends -> Encoding)
-> ([NonFederatingBackends] -> Value)
-> ([NonFederatingBackends] -> Encoding)
-> ToJSON NonFederatingBackends
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NonFederatingBackends -> Value
toJSON :: NonFederatingBackends -> Value
$ctoEncoding :: NonFederatingBackends -> Encoding
toEncoding :: NonFederatingBackends -> Encoding
$ctoJSONList :: [NonFederatingBackends] -> Value
toJSONList :: [NonFederatingBackends] -> Value
$ctoEncodingList :: [NonFederatingBackends] -> Encoding
toEncodingList :: [NonFederatingBackends] -> Encoding
ToJSON, Typeable NonFederatingBackends
Typeable NonFederatingBackends =>
(Proxy NonFederatingBackends
-> Declare (Definitions Schema) NamedSchema)
-> ToSchema NonFederatingBackends
Proxy NonFederatingBackends
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NonFederatingBackends
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NonFederatingBackends
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema NonFederatingBackends
instance APIError NonFederatingBackends where
toResponse :: NonFederatingBackends -> JSONResponse
toResponse NonFederatingBackends
e =
JSONResponse
{ $sel:status:JSONResponse :: Status
status = Status
nonFederatingBackendsStatus,
$sel:value:JSONResponse :: Value
value = NonFederatingBackends -> Value
forall a. ToJSON a => a -> Value
toJSON NonFederatingBackends
e
}
nonFederatingBackendsStatus :: HTTP.Status
nonFederatingBackendsStatus :: Status
nonFederatingBackendsStatus = Status
HTTP.status409
nonFederatingBackendsToList :: NonFederatingBackends -> [Domain]
nonFederatingBackendsToList :: NonFederatingBackends -> [Domain]
nonFederatingBackendsToList (NonFederatingBackends Domain
a Domain
b) = [Domain
a, Domain
b]
nonFederatingBackendsFromList :: (MonadFail m) => [Domain] -> m NonFederatingBackends
nonFederatingBackendsFromList :: forall (m :: * -> *).
MonadFail m =>
[Domain] -> m NonFederatingBackends
nonFederatingBackendsFromList [Domain
a, Domain
b] = NonFederatingBackends -> m NonFederatingBackends
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain -> Domain -> NonFederatingBackends
NonFederatingBackends Domain
a Domain
b)
nonFederatingBackendsFromList [Domain]
domains =
String -> m NonFederatingBackends
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m NonFederatingBackends)
-> String -> m NonFederatingBackends
forall a b. (a -> b) -> a -> b
$
String
"Expected 2 backends, found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Domain] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Domain]
domains)
instance ToSchema NonFederatingBackends where
schema :: ValueSchema NamedSwaggerDoc NonFederatingBackends
schema =
Text
-> SchemaP
SwaggerDoc
Object
[Pair]
NonFederatingBackends
NonFederatingBackends
-> ValueSchema NamedSwaggerDoc NonFederatingBackends
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"NonFederatingBackends" (SchemaP
SwaggerDoc
Object
[Pair]
NonFederatingBackends
NonFederatingBackends
-> ValueSchema NamedSwaggerDoc NonFederatingBackends)
-> SchemaP
SwaggerDoc
Object
[Pair]
NonFederatingBackends
NonFederatingBackends
-> ValueSchema NamedSwaggerDoc NonFederatingBackends
forall a b. (a -> b) -> a -> b
$
SchemaP SwaggerDoc Object [Pair] NonFederatingBackends [Domain]
-> ([Domain] -> Parser NonFederatingBackends)
-> SchemaP
SwaggerDoc
Object
[Pair]
NonFederatingBackends
NonFederatingBackends
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
withParser
(NonFederatingBackends -> [Domain]
nonFederatingBackendsToList (NonFederatingBackends -> [Domain])
-> SchemaP SwaggerDoc Object [Pair] [Domain] [Domain]
-> SchemaP SwaggerDoc Object [Pair] NonFederatingBackends [Domain]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Domain] [Domain]
-> SchemaP SwaggerDoc Object [Pair] [Domain] [Domain]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"non_federating_backends" (ValueSchema NamedSwaggerDoc Domain
-> SchemaP SwaggerDoc Value Value [Domain] [Domain]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Domain
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
[Domain] -> Parser NonFederatingBackends
forall (m :: * -> *).
MonadFail m =>
[Domain] -> m NonFederatingBackends
nonFederatingBackendsFromList
instance IsSwaggerError NonFederatingBackends where
addToOpenApi :: OpenApi -> OpenApi
addToOpenApi =
Int -> Response -> OpenApi -> OpenApi
addErrorResponseToSwagger (Status -> Int
HTTP.statusCode Status
nonFederatingBackendsStatus) (Response -> OpenApi -> OpenApi) -> Response -> OpenApi -> OpenApi
forall a b. (a -> b) -> a -> b
$
Response
forall a. Monoid a => a
mempty
Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
Lens' Response Text
S.description ((Text -> Identity Text) -> Response -> Identity Response)
-> Text -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"Adding members to the conversation is not possible because the backends involved do not form a fully connected graph"
Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap MediaType MediaTypeObject
-> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> Response -> Identity Response
forall s a. HasContent s a => Lens' s a
Lens' Response (InsOrdHashMap MediaType MediaTypeObject)
S.content ((InsOrdHashMap MediaType MediaTypeObject
-> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> Response -> Identity Response)
-> InsOrdHashMap MediaType MediaTypeObject -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MediaType
-> MediaTypeObject -> InsOrdHashMap MediaType MediaTypeObject
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
singleton MediaType
mediaType MediaTypeObject
mediaTypeObject
where
mediaType :: MediaType
mediaType = Proxy JSON -> MediaType
forall {k} (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType (Proxy JSON -> MediaType) -> Proxy JSON -> MediaType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @JSON
mediaTypeObject :: MediaTypeObject
mediaTypeObject =
MediaTypeObject
forall a. Monoid a => a
mempty
MediaTypeObject
-> (MediaTypeObject -> MediaTypeObject) -> MediaTypeObject
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject
forall s a. HasSchema s a => Lens' s a
Lens' MediaTypeObject (Maybe (Referenced Schema))
S.schema ((Maybe (Referenced Schema)
-> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject)
-> Referenced Schema -> MediaTypeObject -> MediaTypeObject
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Schema -> Referenced Schema
forall a. a -> Referenced a
S.Inline (Proxy NonFederatingBackends -> Schema
forall a. ToSchema a => Proxy a -> Schema
S.toSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @NonFederatingBackends))
type instance ErrorEffect NonFederatingBackends = Error NonFederatingBackends
instance (Member (Error JSONResponse) r) => ServerEffect (Error NonFederatingBackends) r where
interpretServerEffect :: forall a. Sem (Error NonFederatingBackends : r) a -> Sem r a
interpretServerEffect = (NonFederatingBackends -> JSONResponse)
-> Sem (Error NonFederatingBackends : r) a -> Sem r a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError NonFederatingBackends -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse
data UnreachableBackends = UnreachableBackends {UnreachableBackends -> [Domain]
backends :: [Domain]}
deriving stock (UnreachableBackends -> UnreachableBackends -> Bool
(UnreachableBackends -> UnreachableBackends -> Bool)
-> (UnreachableBackends -> UnreachableBackends -> Bool)
-> Eq UnreachableBackends
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnreachableBackends -> UnreachableBackends -> Bool
== :: UnreachableBackends -> UnreachableBackends -> Bool
$c/= :: UnreachableBackends -> UnreachableBackends -> Bool
/= :: UnreachableBackends -> UnreachableBackends -> Bool
Eq, Int -> UnreachableBackends -> ShowS
[UnreachableBackends] -> ShowS
UnreachableBackends -> String
(Int -> UnreachableBackends -> ShowS)
-> (UnreachableBackends -> String)
-> ([UnreachableBackends] -> ShowS)
-> Show UnreachableBackends
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnreachableBackends -> ShowS
showsPrec :: Int -> UnreachableBackends -> ShowS
$cshow :: UnreachableBackends -> String
show :: UnreachableBackends -> String
$cshowList :: [UnreachableBackends] -> ShowS
showList :: [UnreachableBackends] -> ShowS
Show, (forall x. UnreachableBackends -> Rep UnreachableBackends x)
-> (forall x. Rep UnreachableBackends x -> UnreachableBackends)
-> Generic UnreachableBackends
forall x. Rep UnreachableBackends x -> UnreachableBackends
forall x. UnreachableBackends -> Rep UnreachableBackends x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnreachableBackends -> Rep UnreachableBackends x
from :: forall x. UnreachableBackends -> Rep UnreachableBackends x
$cto :: forall x. Rep UnreachableBackends x -> UnreachableBackends
to :: forall x. Rep UnreachableBackends x -> UnreachableBackends
Generic)
deriving (Value -> Parser [UnreachableBackends]
Value -> Parser UnreachableBackends
(Value -> Parser UnreachableBackends)
-> (Value -> Parser [UnreachableBackends])
-> FromJSON UnreachableBackends
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UnreachableBackends
parseJSON :: Value -> Parser UnreachableBackends
$cparseJSONList :: Value -> Parser [UnreachableBackends]
parseJSONList :: Value -> Parser [UnreachableBackends]
FromJSON, [UnreachableBackends] -> Value
[UnreachableBackends] -> Encoding
UnreachableBackends -> Value
UnreachableBackends -> Encoding
(UnreachableBackends -> Value)
-> (UnreachableBackends -> Encoding)
-> ([UnreachableBackends] -> Value)
-> ([UnreachableBackends] -> Encoding)
-> ToJSON UnreachableBackends
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UnreachableBackends -> Value
toJSON :: UnreachableBackends -> Value
$ctoEncoding :: UnreachableBackends -> Encoding
toEncoding :: UnreachableBackends -> Encoding
$ctoJSONList :: [UnreachableBackends] -> Value
toJSONList :: [UnreachableBackends] -> Value
$ctoEncodingList :: [UnreachableBackends] -> Encoding
toEncodingList :: [UnreachableBackends] -> Encoding
ToJSON, Typeable UnreachableBackends
Typeable UnreachableBackends =>
(Proxy UnreachableBackends
-> Declare (Definitions Schema) NamedSchema)
-> ToSchema UnreachableBackends
Proxy UnreachableBackends
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UnreachableBackends
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UnreachableBackends
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema UnreachableBackends
instance APIError UnreachableBackends where
toResponse :: UnreachableBackends -> JSONResponse
toResponse UnreachableBackends
e =
JSONResponse
{ $sel:status:JSONResponse :: Status
status = Status
unreachableBackendsStatus,
$sel:value:JSONResponse :: Value
value = UnreachableBackends -> Value
forall a. ToJSON a => a -> Value
toJSON UnreachableBackends
e
}
unreachableBackendsStatus :: HTTP.Status
unreachableBackendsStatus :: Status
unreachableBackendsStatus = Int -> ByteString -> Status
HTTP.mkStatus Int
533 ByteString
"Unreachable backends"
instance ToSchema UnreachableBackends where
schema :: ValueSchema NamedSwaggerDoc UnreachableBackends
schema =
Text
-> SchemaP
SwaggerDoc Object [Pair] UnreachableBackends UnreachableBackends
-> ValueSchema NamedSwaggerDoc UnreachableBackends
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UnreachableBackends" (SchemaP
SwaggerDoc Object [Pair] UnreachableBackends UnreachableBackends
-> ValueSchema NamedSwaggerDoc UnreachableBackends)
-> SchemaP
SwaggerDoc Object [Pair] UnreachableBackends UnreachableBackends
-> ValueSchema NamedSwaggerDoc UnreachableBackends
forall a b. (a -> b) -> a -> b
$
[Domain] -> UnreachableBackends
UnreachableBackends
([Domain] -> UnreachableBackends)
-> SchemaP SwaggerDoc Object [Pair] UnreachableBackends [Domain]
-> SchemaP
SwaggerDoc Object [Pair] UnreachableBackends UnreachableBackends
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.backends) (UnreachableBackends -> [Domain])
-> SchemaP SwaggerDoc Object [Pair] [Domain] [Domain]
-> SchemaP SwaggerDoc Object [Pair] UnreachableBackends [Domain]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Domain] [Domain]
-> SchemaP SwaggerDoc Object [Pair] [Domain] [Domain]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"unreachable_backends" (ValueSchema NamedSwaggerDoc Domain
-> SchemaP SwaggerDoc Value Value [Domain] [Domain]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Domain
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
instance IsSwaggerError UnreachableBackends where
addToOpenApi :: OpenApi -> OpenApi
addToOpenApi =
Int -> Response -> OpenApi -> OpenApi
addErrorResponseToSwagger (Status -> Int
HTTP.statusCode Status
unreachableBackendsStatus) (Response -> OpenApi -> OpenApi) -> Response -> OpenApi -> OpenApi
forall a b. (a -> b) -> a -> b
$
Response
forall a. Monoid a => a
mempty
Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
Lens' Response Text
S.description ((Text -> Identity Text) -> Response -> Identity Response)
-> Text -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"Some domains are unreachable"
Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap MediaType MediaTypeObject
-> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> Response -> Identity Response
forall s a. HasContent s a => Lens' s a
Lens' Response (InsOrdHashMap MediaType MediaTypeObject)
S.content ((InsOrdHashMap MediaType MediaTypeObject
-> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> Response -> Identity Response)
-> InsOrdHashMap MediaType MediaTypeObject -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MediaType
-> MediaTypeObject -> InsOrdHashMap MediaType MediaTypeObject
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
singleton MediaType
mediaType MediaTypeObject
mediaTypeObject
where
mediaType :: MediaType
mediaType = Proxy JSON -> MediaType
forall {k} (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType (Proxy JSON -> MediaType) -> Proxy JSON -> MediaType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @JSON
mediaTypeObject :: MediaTypeObject
mediaTypeObject = MediaTypeObject
forall a. Monoid a => a
mempty MediaTypeObject
-> (MediaTypeObject -> MediaTypeObject) -> MediaTypeObject
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject
forall s a. HasSchema s a => Lens' s a
Lens' MediaTypeObject (Maybe (Referenced Schema))
S.schema ((Maybe (Referenced Schema)
-> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject)
-> Referenced Schema -> MediaTypeObject -> MediaTypeObject
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Schema -> Referenced Schema
forall a. a -> Referenced a
S.Inline (Proxy UnreachableBackends -> Schema
forall a. ToSchema a => Proxy a -> Schema
S.toSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @UnreachableBackends))
type instance ErrorEffect UnreachableBackends = Error UnreachableBackends
instance (Member (Error JSONResponse) r) => ServerEffect (Error UnreachableBackends) r where
interpretServerEffect :: forall a. Sem (Error UnreachableBackends : r) a -> Sem r a
interpretServerEffect = (UnreachableBackends -> JSONResponse)
-> Sem (Error UnreachableBackends : r) a -> Sem r a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError UnreachableBackends -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse
unreachableUsersToUnreachableBackends :: UnreachableUsers -> UnreachableBackends
unreachableUsersToUnreachableBackends :: UnreachableUsers -> UnreachableBackends
unreachableUsersToUnreachableBackends =
[Domain] -> UnreachableBackends
UnreachableBackends
([Domain] -> UnreachableBackends)
-> (UnreachableUsers -> [Domain])
-> UnreachableUsers
-> UnreachableBackends
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Domain] -> [Domain]
forall a. Ord a => [a] -> [a]
nubOrd
([Domain] -> [Domain])
-> (UnreachableUsers -> [Domain]) -> UnreachableUsers -> [Domain]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Qualified UserId -> Domain) -> [Qualified UserId] -> [Domain]
forall a b. (a -> b) -> [a] -> [b]
map Qualified UserId -> Domain
forall a. Qualified a -> Domain
qDomain
([Qualified UserId] -> [Domain])
-> (UnreachableUsers -> [Qualified UserId])
-> UnreachableUsers
-> [Domain]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Qualified UserId) -> [Qualified UserId]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
(NonEmpty (Qualified UserId) -> [Qualified UserId])
-> (UnreachableUsers -> NonEmpty (Qualified UserId))
-> UnreachableUsers
-> [Qualified UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnreachableUsers -> NonEmpty (Qualified UserId)
unreachableUsers
newtype UnreachableBackendsLegacy = UnreachableBackendsLegacy UnreachableBackends
deriving (OpenApi -> OpenApi
(OpenApi -> OpenApi) -> IsSwaggerError UnreachableBackendsLegacy
forall {k} (e :: k). (OpenApi -> OpenApi) -> IsSwaggerError e
$caddToOpenApi :: OpenApi -> OpenApi
addToOpenApi :: OpenApi -> OpenApi
IsSwaggerError)
instance APIError UnreachableBackendsLegacy where
toResponse :: UnreachableBackendsLegacy -> JSONResponse
toResponse UnreachableBackendsLegacy
_ =
Error -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse (Error -> JSONResponse) -> Error -> JSONResponse
forall a b. (a -> b) -> a -> b
$
Status -> LText -> LText -> Error
Wai.mkError
Status
unreachableBackendsStatus
LText
"federation-connection-refused"
LText
"Some backends are unreachable"
type instance ErrorEffect UnreachableBackendsLegacy = Error UnreachableBackendsLegacy
instance (Member (Error JSONResponse) r) => ServerEffect (Error UnreachableBackendsLegacy) r where
interpretServerEffect :: forall a. Sem (Error UnreachableBackendsLegacy : r) a -> Sem r a
interpretServerEffect = (UnreachableBackendsLegacy -> JSONResponse)
-> Sem (Error UnreachableBackendsLegacy : r) a -> Sem r a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError UnreachableBackendsLegacy -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse