From 061a0277d2756794c6182787db7f3aacf432c396 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 23 Mar 2026 14:17:16 +0100 Subject: [PATCH 01/17] Script for generating kotlin and typescript code from swagger.json. --- hack/bin/generate-clients.sh | 53 ++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100755 hack/bin/generate-clients.sh diff --git a/hack/bin/generate-clients.sh b/hack/bin/generate-clients.sh new file mode 100755 index 0000000000..0cfef72269 --- /dev/null +++ b/hack/bin/generate-clients.sh @@ -0,0 +1,53 @@ +#!/usr/bin/env bash +set -euo pipefail + +# Simple OpenAPI client generator using openapi-generator +# Usage: ./generate-clients.sh + +SWAGGER_URL="${1:-https://staging-nginz-https.zinfra.io/v16/api/swagger.json}" +OUTPUT_DIR="$(pwd)/generated" + +echo "==> Generating clients from: $SWAGGER_URL" +echo "==> Output directory: $OUTPUT_DIR" + +# Clean up previous runs +rm -rf "$OUTPUT_DIR" +mkdir -p "$OUTPUT_DIR" + +# Download the spec +echo "==> Downloading OpenAPI spec..." +curl -s "$SWAGGER_URL" > "$OUTPUT_DIR/swagger.json" + +# Check if docker is available +if ! command -v docker &> /dev/null; then + echo "Error: docker is not installed. Please install docker to use openapi-generator." + echo "Alternative: install openapi-generator-cli via npm: npm install -g @openapitools/openapi-generator-cli" + exit 1 +fi + +# Generate TypeScript client +echo "" +echo "==> Generating TypeScript client..." +docker run --rm \ + -v "$OUTPUT_DIR:/local" \ + openapitools/openapi-generator-cli:latest generate \ + -i /local/swagger.json \ + -g typescript-axios \ + -o /local/typescript \ + --additional-properties=supportsES6=true,npmName=wire-api-client,npmVersion=1.0.0 + +# Generate Kotlin client +echo "" +echo "==> Generating Kotlin client..." +docker run --rm \ + -v "$OUTPUT_DIR:/local" \ + openapitools/openapi-generator-cli:latest generate \ + -i /local/swagger.json \ + -g kotlin \ + -o /local/kotlin \ + --additional-properties=packageName=com.wire.api.client,serializationLibrary=gson + +echo "" +echo "==> Done! Generated clients:" +echo " TypeScript: $OUTPUT_DIR/typescript" +echo " Kotlin: $OUTPUT_DIR/kotlin" From a9eecc81970782b4ff457298f414e700950759b0 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 23 Mar 2026 14:32:59 +0100 Subject: [PATCH 02/17] openapi3 aka swagger: Make schema names unique(r). With this change, schema name is the fully qualified name of the haskell type. If that's not unique, we should probably change those type names. This will avoid collisions in the hash table keeping track of all the schema references in openapi3. --- libs/schema-profunctor/src/Data/Schema.hs | 30 ++++++++++++++++------- libs/types-common/src/Data/Id.hs | 4 +-- 2 files changed, 23 insertions(+), 11 deletions(-) diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index 3cb88657d5..626dd001e3 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -97,6 +97,7 @@ import Control.Monad.Trans.Cont import Data.Aeson.Key qualified as Key import Data.Aeson.Types qualified as A import Data.Bifunctor.Joker +import Data.Data (typeRep) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map @@ -402,8 +403,8 @@ tag f = rmap runIdentity . f . rmap Identity -- This can be used to convert a combination of schemas obtained using -- 'field' into a single schema for a JSON object. object :: - (HasObject doc doc') => - Text -> + (Typeable a, HasObject doc doc') => + Text -> -- TODO: remove schema name, it's generated now! SchemaP doc A.Object [A.Pair] a b -> SchemaP doc' A.Value A.Value a b object = objectOver id @@ -412,22 +413,32 @@ object = objectOver id -- -- Just like 'fieldOver', but for 'object'. objectOver :: - (HasObject doc doc') => + forall doc doc' v' a b v. + (Typeable a, HasObject doc doc') => Lens v v' A.Value A.Object -> - Text -> + Text -> -- TODO: remove schema name, it's generated now! SchemaP doc v' [A.Pair] a b -> SchemaP doc' v A.Value a b -objectOver l name sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) +objectOver l _name sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) where + name = mkSchemaName @a parseObject val = ContT $ \k -> A.withObject (T.unpack name) k val r v = runContT (l parseObject v) (schemaIn sch) w x = A.object <$> schemaOut sch x s = mkObject name (schemaDoc sch) +-- | Object and enum schema names by default are the fully qualified +-- name of the haskell type. If that's not unique, we should probably +-- change those type names. This will avoid collisions in the hash +-- table keeping track of all the schema references in openapi3. +-- track of all the schema references in openapi3. +mkSchemaName :: forall a. (Typeable a) => Text +mkSchemaName = T.pack $ show $ typeRep (Proxy @a) + -- | Like 'object', but apply an arbitrary function to the -- documentation of the resulting object. objectWithDocModifier :: - (HasObject doc doc') => + (Typeable a, HasObject doc doc') => Text -> (doc' -> doc') -> ObjectSchema doc a -> @@ -559,12 +570,13 @@ element label value = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) -- 'element' into a single schema for a JSON string. enum :: forall v doc a b. - (With v, HasEnum v doc) => - Text -> + (Typeable a, With v, HasEnum v doc) => + Text -> -- TODO: remove schema name, it's generated now! SchemaP [A.Value] v (Alt Maybe v) a b -> SchemaP doc A.Value A.Value a b -enum name sch = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) +enum _name sch = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) where + name = mkSchemaName @a d = mkEnum @v name (schemaDoc sch) i x = with (T.unpack name) (schemaIn sch) x diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index ba6e6c21d2..9ffa4cc8bd 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/libs/types-common/src/Data/Id.hs @@ -484,8 +484,8 @@ newtype IdObject a = IdObject {fromIdObject :: a} deriving (Eq, Show, Generic) deriving (ToJSON, FromJSON, S.ToSchema) via Schema (IdObject a) -instance (ToSchema a) => ToSchema (IdObject a) where +instance (Typeable a, ToSchema a) => ToSchema (IdObject a) where schema = idObjectSchema (IdObject <$> fromIdObject .= schema) -idObjectSchema :: ValueSchemaP NamedSwaggerDoc a b -> ValueSchemaP NamedSwaggerDoc a b +idObjectSchema :: (Typeable a) => ValueSchemaP NamedSwaggerDoc a b -> ValueSchemaP NamedSwaggerDoc a b idObjectSchema sch = object "Id" (field "id" sch) From 18df1acdf32afdb710c2fee85626bf9cf606645d Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 23 Mar 2026 15:34:18 +0100 Subject: [PATCH 03/17] Add missing Typeable constraints. --- libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs | 3 +- libs/types-common/src/Data/Qualified.hs | 8 ++-- .../src/Wire/API/Federation/API.hs | 5 ++- .../API/Federation/BackendNotifications.hs | 2 +- libs/wire-api/src/Wire/API/Conversation.hs | 6 +-- libs/wire-api/src/Wire/API/EnterpriseLogin.hs | 2 +- .../src/Wire/API/Event/FeatureConfig.hs | 7 ++-- libs/wire-api/src/Wire/API/MLS/Keys.hs | 4 +- .../Galley/TeamFeatureNoConfigMulti.hs | 2 +- .../src/Wire/API/Routes/MultiTablePaging.hs | 35 +++++++++++++++--- .../Routes/Public/Brig/DomainVerification.hs | 2 +- libs/wire-api/src/Wire/API/Team/Feature.hs | 37 ++++++++++--------- libs/wire-api/src/Wire/API/Team/Member.hs | 2 +- .../src/Wire/API/UserGroup/Pagination.hs | 2 +- .../src/Wire/BackendNotificationPusher.hs | 2 +- .../galley/src/Galley/API/Teams/Features.hs | 15 +++++--- .../test/integration/API/Util/TeamFeature.hs | 3 +- tools/stern/src/Stern/API.hs | 2 +- tools/stern/src/Stern/Intra.hs | 4 +- 19 files changed, 89 insertions(+), 54 deletions(-) diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs index 93039ca76d..63dd1c54ae 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs @@ -166,6 +166,7 @@ import Data.Aeson import Data.Aeson.TH import Data.Bifunctor (first) import Data.CaseInsensitive qualified as CI +import Data.Data (Typeable) import Data.List qualified as L import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NL @@ -346,7 +347,7 @@ data IdPConfig extra = IdPConfig deriving (Eq, Show, Generic) deriving (FromJSON, ToJSON, S.ToSchema) via (Schema.Schema (IdPConfig extra)) -instance (Schema.ToSchema extra) => Schema.ToSchema (IdPConfig extra) where +instance (Typeable (IdPConfig extra), Schema.ToSchema extra) => Schema.ToSchema (IdPConfig extra) where schema = Schema.object "IdPConfig" $ IdPConfig diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index fc59fd841c..e0e0a5e489 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -189,7 +189,7 @@ deprecatedSchema new = . (deprecated ?~ True) qualifiedSchema :: - (HasSchemaRef doc) => + (Typeable a, HasSchemaRef doc) => Text -> Text -> ValueSchema doc a -> @@ -208,16 +208,16 @@ qualifiedObjectSchema fieldName sch = <$> qDomain .= field "domain" schema <*> qUnqualified .= field fieldName sch -instance (KnownIdTag t) => ToSchema (Qualified (Id t)) where +instance (Typeable t, KnownIdTag t) => ToSchema (Qualified (Id t)) where schema = qualifiedSchema (idTagName (idTagValue @t) <> "Id") "id" schema instance ToSchema (Qualified Handle) where schema = qualifiedSchema "Handle" "handle" schema -instance (KnownIdTag t) => ToJSON (Qualified (Id t)) where +instance (Typeable t, KnownIdTag t) => ToJSON (Qualified (Id t)) where toJSON = schemaToJSON -instance (KnownIdTag t) => FromJSON (Qualified (Id t)) where +instance (Typeable t, KnownIdTag t) => FromJSON (Qualified (Id t)) where parseJSON = schemaParseJSON instance (Typeable t, KnownIdTag t) => S.ToSchema (Qualified (Id t)) where diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API.hs b/libs/wire-api-federation/src/Wire/API/Federation/API.hs index 73dbbeded3..704d8a3a0a 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API.hs @@ -128,7 +128,7 @@ fedClientIn :: fedClientIn = clientIn (Proxy @api) (Proxy @m) sendBundle :: - (KnownComponent c) => + (Typeable c, KnownComponent c) => PayloadBundle c -> FedQueueClient c () sendBundle bundle = do @@ -147,7 +147,8 @@ sendBundle bundle = do fedQueueClient :: forall {k} (tag :: k) c. - ( HasNotificationEndpoint tag, + ( Typeable c, + HasNotificationEndpoint tag, HasVersionRange tag, HasFedPath tag, KnownComponent (NotificationComponent k), diff --git a/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs index 2e780eab99..5ec776c6ce 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs @@ -110,7 +110,7 @@ newtype PayloadBundle (c :: Component) = PayloadBundle deriving (A.ToJSON, A.FromJSON) via (Schema (PayloadBundle c)) deriving newtype (Semigroup) -instance ToSchema (PayloadBundle c) where +instance (Typeable c) => ToSchema (PayloadBundle c) where schema = object "PayloadBundle" $ PayloadBundle diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 915fafd535..0c9dac8348 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -373,7 +373,7 @@ data MLSOne2OneConversation a = MLSOne2OneConversation } deriving (ToJSON, FromJSON, S.ToSchema) via (Schema (MLSOne2OneConversation a)) -instance (ToSchema a) => ToSchema (MLSOne2OneConversation a) where +instance (Typeable a, ToSchema a) => ToSchema (MLSOne2OneConversation a) where schema = let aName = maybe "" ("_" <>) $ getName (schemaDoc (schema @a)) in object ("MLSOne2OneConversation" <> aName) $ @@ -473,7 +473,7 @@ instance ConversationListItem ConvId where instance ConversationListItem OwnConversation where convListItemName _ = "conversations" -instance (ConversationListItem a, ToSchema a) => ToSchema (ConversationList a) where +instance (Typeable a, ConversationListItem a, ToSchema a) => ToSchema (ConversationList a) where schema = conversationListSchema schema instance ToSchema (Versioned 'V2 (ConversationList OwnConversation)) where @@ -484,7 +484,7 @@ instance ToSchema (Versioned 'V2 (ConversationList OwnConversation)) where conversationListSchema :: forall a. - (ConversationListItem a) => + (Typeable a, ConversationListItem a) => ValueSchema NamedSwaggerDoc a -> ValueSchema NamedSwaggerDoc (ConversationList a) conversationListSchema sch = diff --git a/libs/wire-api/src/Wire/API/EnterpriseLogin.hs b/libs/wire-api/src/Wire/API/EnterpriseLogin.hs index 78e78da4a9..567de7155c 100644 --- a/libs/wire-api/src/Wire/API/EnterpriseLogin.hs +++ b/libs/wire-api/src/Wire/API/EnterpriseLogin.hs @@ -273,7 +273,7 @@ data DomainRegistrationResponse (v :: Version) = DomainRegistrationResponse mkDomainRegistrationResponse :: DomainRegistration -> DomainRegistrationResponse v mkDomainRegistrationResponse DomainRegistration {..} = DomainRegistrationResponse {..} -instance (SingI v) => ToSchema (DomainRegistrationResponse v) where +instance (Typeable v, SingI v) => ToSchema (DomainRegistrationResponse v) where schema = object "DomainRegistrationResponse" $ DomainRegistrationResponse diff --git a/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs b/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs index 7817fe94a7..86e899acfa 100644 --- a/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs +++ b/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs @@ -43,7 +43,7 @@ data Event = Event deriving (Eq, Show, Generic) deriving (A.ToJSON, A.FromJSON) via Schema Event -arbitraryFeature :: forall cfg. (IsFeatureConfig cfg, Arbitrary cfg) => Gen A.Value +arbitraryFeature :: forall cfg. (Typeable cfg, IsFeatureConfig cfg, Arbitrary cfg) => Gen A.Value arbitraryFeature = toJSON <$> arbitrary @(LockableFeature cfg) class AllArbitraryFeatures cfgs where @@ -53,7 +53,8 @@ instance AllArbitraryFeatures '[] where allArbitraryFeatures = [] instance - ( IsFeatureConfig cfg, + ( Typeable cfg, + IsFeatureConfig cfg, Arbitrary cfg, AllArbitraryFeatures cfgs ) => @@ -101,7 +102,7 @@ instance ToJSONObject Event where instance S.ToSchema Event where declareNamedSchema = schemaToSwagger -mkUpdateEvent :: forall cfg. (IsFeatureConfig cfg) => TeamId -> LockableFeature cfg -> Event +mkUpdateEvent :: forall cfg. (Typeable cfg, IsFeatureConfig cfg) => TeamId -> LockableFeature cfg -> Event mkUpdateEvent tid ws = Event { _eventType = Update, diff --git a/libs/wire-api/src/Wire/API/MLS/Keys.hs b/libs/wire-api/src/Wire/API/MLS/Keys.hs index 971b2866b1..238a3f12d1 100644 --- a/libs/wire-api/src/Wire/API/MLS/Keys.hs +++ b/libs/wire-api/src/Wire/API/MLS/Keys.hs @@ -41,7 +41,7 @@ data MLSKeysByPurpose a = MLSKeysByPurpose deriving (Eq, Show, Functor, Foldable, Traversable) deriving (FromJSON, ToJSON, S.ToSchema) via Schema (MLSKeysByPurpose a) -instance (ToSchema a) => ToSchema (MLSKeysByPurpose a) where +instance (Typeable a, ToSchema a) => ToSchema (MLSKeysByPurpose a) where schema = object "MLSKeysByPurpose" $ MLSKeysByPurpose @@ -56,7 +56,7 @@ data MLSKeys a = MLSKeys deriving (Eq, Show, Functor, Foldable, Traversable) deriving (FromJSON, ToJSON, S.ToSchema) via Schema (MLSKeys a) -instance (ToSchema a) => ToSchema (MLSKeys a) where +instance (Typeable a, ToSchema a) => ToSchema (MLSKeys a) where schema = object "MLSKeys" $ MLSKeys diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamFeatureNoConfigMulti.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamFeatureNoConfigMulti.hs index 8bb68c6eb3..b721ad2706 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamFeatureNoConfigMulti.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamFeatureNoConfigMulti.hs @@ -34,7 +34,7 @@ data TeamStatus cfg = TeamStatus deriving (Show, Eq) deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema (TeamStatus cfg) -instance ToSchema (TeamStatus cfg) where +instance forall k (cfg :: k). (Typeable k, Typeable cfg) => ToSchema (TeamStatus cfg) where schema = object "TeamStatus" $ TeamStatus diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs index 2cdfaf692c..2a9ce3077d 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs @@ -67,12 +67,18 @@ type RequestSchemaConstraint name tables max def = (KnownNat max, KnownNat def, deriving via Schema (GetMultiTablePageRequest name tables max def) instance - (RequestSchemaConstraint name tables max def) => ToJSON (GetMultiTablePageRequest name tables max def) + ( Typeable tables, + RequestSchemaConstraint name tables max def + ) => + ToJSON (GetMultiTablePageRequest name tables max def) deriving via Schema (GetMultiTablePageRequest name tables max def) instance - (RequestSchemaConstraint name tables max def) => FromJSON (GetMultiTablePageRequest name tables max def) + ( Typeable tables, + RequestSchemaConstraint name tables max def + ) => + FromJSON (GetMultiTablePageRequest name tables max def) deriving via Schema (GetMultiTablePageRequest name tables max def) @@ -82,7 +88,12 @@ deriving via ) => S.ToSchema (GetMultiTablePageRequest name tables max def) -instance (RequestSchemaConstraint name tables max def) => ToSchema (GetMultiTablePageRequest name tables max def) where +instance + ( Typeable tables, + RequestSchemaConstraint name tables max def + ) => + ToSchema (GetMultiTablePageRequest name tables max def) + where schema = let addPagingStateDoc = description @@ -117,13 +128,19 @@ type PageSchemaConstraints name resultsKey tables a = (KnownSymbol resultsKey, K deriving via (Schema (MultiTablePage name resultsKey tables a)) instance - (PageSchemaConstraints name resultsKey tables a) => + ( Typeable tables, + Typeable a, + PageSchemaConstraints name resultsKey tables a + ) => ToJSON (MultiTablePage name resultsKey tables a) deriving via (Schema (MultiTablePage name resultsKey tables a)) instance - (PageSchemaConstraints name resultsKey tables a) => + ( Typeable tables, + Typeable a, + PageSchemaConstraints name resultsKey tables a + ) => FromJSON (MultiTablePage name resultsKey tables a) deriving via @@ -133,7 +150,13 @@ deriving via S.ToSchema (MultiTablePage name resultsKey tables a) instance - (KnownSymbol resultsKey, KnownSymbol name, ToSchema a, PagingTable tables) => + ( KnownSymbol resultsKey, + KnownSymbol name, + Typeable a, + ToSchema a, + Typeable tables, + PagingTable tables + ) => ToSchema (MultiTablePage name resultsKey tables a) where schema = diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs index e7447c46a0..819964e818 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs @@ -271,7 +271,7 @@ instance ToSchema DomainOwnershipToken where newtype RegisteredDomains (v :: Version) = RegisteredDomains {unRegisteredDomains :: [DomainRegistrationResponse v]} deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema (RegisteredDomains v) -instance (SingI v) => ToSchema (RegisteredDomains v) where +instance (Typeable v, SingI v) => ToSchema (RegisteredDomains v) where schema = object "RegisteredDomains" $ RegisteredDomains diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 15117fde38..05416fcd3d 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -405,7 +405,7 @@ defUnlockedFeature = config = def } -instance (IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where +instance (Typeable cfg, IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where schema = object name $ LockableFeature @@ -439,7 +439,7 @@ instance Default (LockableFeaturePatch cfg) where -- | The ToJSON implementation of `LockableFeaturePatch` will encode the trivial config as `"config": {}` -- when the value is a `Just`, if it's `Nothing` it will be omitted, which is the important part. -instance (ToSchema cfg) => ToSchema (LockableFeaturePatch cfg) where +instance (Typeable cfg, ToSchema cfg) => ToSchema (LockableFeaturePatch cfg) where schema = object name $ LockableFeaturePatch @@ -476,7 +476,7 @@ forgetLock ws = Feature ws.status ws.config withLockStatus :: LockStatus -> Feature a -> LockableFeature a withLockStatus ls (Feature s c) = LockableFeature s ls c -instance (ToSchema cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where +instance (Typeable cfg, ToSchema cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where schema = object name $ Feature @@ -491,7 +491,7 @@ instance (ToSchema cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where name = fromMaybe "" (getName (schemaDoc inner)) <> ".Feature" instance - (ToObjectSchema (Versioned v cfg), ToSchema (Versioned v cfg)) => + (Typeable cfg, Typeable v, ToObjectSchema (Versioned v cfg), ToSchema (Versioned v cfg)) => ToSchema (Versioned v (Feature cfg)) where schema = Versioned . fmap unVersioned <$> (fmap Versioned . unVersioned) .= schema @(Feature (Versioned v cfg)) @@ -875,7 +875,7 @@ instance IsFeatureConfig ConferenceCallingConfig where type FeatureSymbol ConferenceCallingConfig = "conferenceCalling" featureSingleton = FeatureSingletonConferenceCallingConfig -instance (OptWithDefault f) => ToSchema (ConferenceCallingConfigB Covered f) where +instance (Typeable f, OptWithDefault f) => ToSchema (ConferenceCallingConfigB Covered f) where schema = object "ConferenceCallingConfig" $ ConferenceCallingConfig @@ -998,7 +998,7 @@ deriving via (BarbieFeature AppLockConfigB) instance ToSchema AppLockConfig instance Default AppLockConfig where def = AppLockConfig (EnforceAppLock False) 60 -instance (FieldF f) => ToSchema (AppLockConfigB Covered f) where +instance (Typeable f, FieldF f) => ToSchema (AppLockConfigB Covered f) where schema = object "AppLockConfig" $ AppLockConfig @@ -1079,7 +1079,7 @@ deriving via (BarbieFeature SelfDeletingMessagesConfigB) instance (ToSchema Self instance Default SelfDeletingMessagesConfig where def = SelfDeletingMessagesConfig 0 -instance (FieldF f) => ToSchema (SelfDeletingMessagesConfigB Covered f) where +instance (Typeable f, FieldF f) => ToSchema (SelfDeletingMessagesConfigB Covered f) where schema = object "SelfDeletingMessagesConfig" $ SelfDeletingMessagesConfig @@ -1139,7 +1139,7 @@ instance Default MLSConfig where mlsGroupInfoDiagnostics = Any False } -instance (FieldF f) => ToSchema (MLSConfigB Covered f) where +instance (Typeable f, FieldF f) => ToSchema (MLSConfigB Covered f) where schema = object "MLSConfig" $ MLSConfig @@ -1212,7 +1212,7 @@ instance ToSchema ChannelPermissions where element "admins" Admins ] -instance (FieldF f) => ToSchema (ChannelsConfigB Covered f) where +instance (Typeable f, FieldF f) => ToSchema (ChannelsConfigB Covered f) where schema = object "ChannelsConfig" $ ChannelsConfig @@ -1329,7 +1329,7 @@ instance Arbitrary MlsE2EIdConfig where <*> fmap (Alt . pure) arbitrary <*> arbitrary -instance (FieldF f) => ToSchema (MlsE2EIdConfigB Covered f) where +instance (Typeable f, FieldF f) => ToSchema (MlsE2EIdConfigB Covered f) where schema = object "MlsE2EIdConfig" $ MlsE2EIdConfig @@ -1414,7 +1414,7 @@ instance Arbitrary MlsMigrationConfig where finaliseRegardlessAfter = finaliseRegardlessAfter } -instance (NestedMaybe f) => ToSchema (MlsMigrationConfigB Covered f) where +instance (Typeable f, NestedMaybe f) => ToSchema (MlsMigrationConfigB Covered f) where schema = object "MlsMigration" $ MlsMigrationConfig @@ -1467,7 +1467,7 @@ instance Default EnforceFileDownloadLocationConfig where instance Arbitrary EnforceFileDownloadLocationConfig where arbitrary = EnforceFileDownloadLocationConfig . fmap (T.pack . getPrintableString) <$> arbitrary -instance (NestedMaybe f) => ToSchema (EnforceFileDownloadLocationConfigB Covered f) where +instance (Typeable f, NestedMaybe f) => ToSchema (EnforceFileDownloadLocationConfigB Covered f) where schema = object "EnforceFileDownloadLocation" $ EnforceFileDownloadLocationConfig @@ -1752,7 +1752,7 @@ instance Default CellsConfig where } } -instance (FieldF f) => ToSchema (CellsConfigB Covered f) where +instance (Typeable f, FieldF f) => ToSchema (CellsConfigB Covered f) where schema = objectWithDocModifier "CellsConfig" (S.schema . S.example ?~ schemaToJSON (def @CellsConfig)) $ CellsConfig @@ -1888,7 +1888,7 @@ instance Default CellsInternalConfig where storage = CellsStorage $ NumBytes $ BigIntString 1000000000000 -- 1 TB } -instance (FieldF f) => ToSchema (CellsInternalConfigB Covered f) where +instance (Typeable f, FieldF f) => ToSchema (CellsInternalConfigB Covered f) where schema = object "CellsInternalConfig" $ CellsInternalConfig @@ -2268,15 +2268,18 @@ instance (HObjectSchema c xs, c x) => HObjectSchema c ((x :: Type) : xs) where hobjectSchema f = (:*) <$> hd .= f <*> tl .= hobjectSchema @c @xs f -- | constraint synonym for 'ToSchema' 'AllTeamFeatures' -class (IsFeatureConfig cfg, ToSchema cfg) => FeatureFieldConstraints cfg +class (Typeable cfg, IsFeatureConfig cfg, ToSchema cfg) => FeatureFieldConstraints cfg -instance (IsFeatureConfig cfg, ToSchema cfg) => FeatureFieldConstraints cfg +instance (Typeable cfg, IsFeatureConfig cfg, ToSchema cfg) => FeatureFieldConstraints cfg instance ToSchema AllTeamFeatures where schema = object "AllTeamFeatures" $ hobjectSchema @FeatureFieldConstraints featureField where - featureField :: forall cfg. (FeatureFieldConstraints cfg) => ObjectSchema SwaggerDoc (LockableFeature cfg) + featureField :: + forall cfg. + (FeatureFieldConstraints cfg) => + ObjectSchema SwaggerDoc (LockableFeature cfg) featureField = field (T.pack (symbolVal (Proxy @(FeatureSymbol cfg)))) schema class (Arbitrary cfg, IsFeatureConfig cfg) => ArbitraryFeatureConfig cfg diff --git a/libs/wire-api/src/Wire/API/Team/Member.hs b/libs/wire-api/src/Wire/API/Team/Member.hs index 55453872d7..8795e58f18 100644 --- a/libs/wire-api/src/Wire/API/Team/Member.hs +++ b/libs/wire-api/src/Wire/API/Team/Member.hs @@ -313,7 +313,7 @@ deriving via newTeamMemberList :: [TeamMember] -> ListType -> TeamMemberList newTeamMemberList = TeamMemberList -instance (ToSchema (TeamMember' tag)) => ToSchema (TeamMemberList' tag) where +instance (Typeable tag, ToSchema (TeamMember' tag)) => ToSchema (TeamMemberList' tag) where schema = objectWithDocModifier "TeamMemberList" (description ?~ "list of team member") $ TeamMemberList diff --git a/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs b/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs index 9e8ed1bb33..ded74ed0ae 100644 --- a/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs +++ b/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs @@ -76,7 +76,7 @@ data UserGroupPage_ a = UserGroupPage deriving (Eq, Show, Generic) deriving (A.FromJSON, A.ToJSON, S.ToSchema) via Schema (UserGroupPage_ a) -instance (ToSchema a) => ToSchema (UserGroupPage_ a) where +instance (Typeable a, ToSchema a) => ToSchema (UserGroupPage_ a) where schema = objectWithDocModifier "UserGroupPage" addPageDocs $ UserGroupPage diff --git a/services/background-worker/src/Wire/BackendNotificationPusher.hs b/services/background-worker/src/Wire/BackendNotificationPusher.hs index 938f5efdac..cadce5c027 100644 --- a/services/background-worker/src/Wire/BackendNotificationPusher.hs +++ b/services/background-worker/src/Wire/BackendNotificationPusher.hs @@ -136,7 +136,7 @@ pushNotification runningFlag targetDomain (msg, envelope) = do UnliftIO.bracket_ (takeMVar runningFlag) (putMVar runningFlag ()) go where go :: AppT IO () - go = case A.eitherDecode @(PayloadBundle _) (Q.msgBody msg) of + go = case A.eitherDecode @(PayloadBundle 'Brig) (Q.msgBody msg) of Left e -> do case A.eitherDecode @BackendNotification (Q.msgBody msg) of Left eBN -> do diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 0e702ace16..e522df1099 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -95,7 +95,8 @@ type ComputeFeatureConstraints cfg r = (Member FeaturesConfigSubsystem r) patchFeatureInternal :: forall cfg r. - ( SetFeatureConfig cfg, + ( Typeable cfg, + SetFeatureConfig cfg, ComputeFeatureConstraints cfg r, SetFeatureForTeamConstraints cfg r, Member (ErrorS 'TeamNotFound) r, @@ -132,7 +133,8 @@ patchFeatureInternal tid patch = do setFeature :: forall cfg r. - ( SetFeatureConfig cfg, + ( Typeable cfg, + SetFeatureConfig cfg, ComputeFeatureConstraints cfg r, SetFeatureForTeamConstraints cfg r, Member (ErrorS 'NotATeamMember) r, @@ -155,7 +157,8 @@ setFeature uid tid feat = do setFeatureInternal :: forall cfg r. - ( SetFeatureConfig cfg, + ( Typeable cfg, + SetFeatureConfig cfg, ComputeFeatureConstraints cfg r, SetFeatureForTeamConstraints cfg r, Member (ErrorS 'TeamNotFound) r, @@ -176,7 +179,8 @@ setFeatureInternal tid feat = do setFeatureUnchecked :: forall cfg r. - ( SetFeatureConfig cfg, + ( Typeable cfg, + SetFeatureConfig cfg, ComputeFeatureConstraints cfg r, SetFeatureForTeamConstraints cfg r, Member (Error TeamFeatureError) r, @@ -258,7 +262,8 @@ guardLockStatus = \case setFeatureForTeam :: forall cfg r. - ( SetFeatureConfig cfg, + ( Typeable cfg, + SetFeatureConfig cfg, SetFeatureForTeamConstraints cfg r, ComputeFeatureConstraints cfg r, Member P.TinyLog r, diff --git a/services/galley/test/integration/API/Util/TeamFeature.hs b/services/galley/test/integration/API/Util/TeamFeature.hs index 3bd3c22eef..2caa19112d 100644 --- a/services/galley/test/integration/API/Util/TeamFeature.hs +++ b/services/galley/test/integration/API/Util/TeamFeature.hs @@ -60,6 +60,7 @@ putTeamFeatureInternal :: HasGalley m, MonadHttp m, HasCallStack, + Typeable cfg, IsFeatureConfig cfg ) => (Request -> Request) -> @@ -76,7 +77,7 @@ putTeamFeatureInternal reqmod tid status = do putTeamFeature :: forall cfg. - (HasCallStack, IsFeatureConfig cfg) => + (HasCallStack, Typeable cfg, IsFeatureConfig cfg) => UserId -> TeamId -> Feature cfg -> diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index dd1b104d67..c2d343547c 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -362,7 +362,7 @@ mkFeatureGetRoute = Intra.getTeamFeatureFlag @cfg mkFeaturePutRoute :: forall cfg. - (IsFeatureConfig cfg) => + (Typeable cfg, IsFeatureConfig cfg) => TeamId -> Feature cfg -> Handler NoContent diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 6daee4beff..642df74aaa 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -529,7 +529,7 @@ getTeamFeatureFlag tid = do setTeamFeatureFlag :: forall cfg. - (IsFeatureConfig cfg) => + (Typeable cfg, IsFeatureConfig cfg) => TeamId -> Public.Feature cfg -> Handler () @@ -543,7 +543,7 @@ setTeamFeatureFlag tid status = do patchTeamFeatureFlag :: forall cfg. - (IsFeatureConfig cfg) => + (Typeable cfg, IsFeatureConfig cfg) => TeamId -> Public.LockableFeaturePatch cfg -> Handler () From 289edfdd855ff85e1bae330633b57ebf1b77fb89 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Tue, 24 Mar 2026 07:44:07 +0100 Subject: [PATCH 04/17] Remove now unused name arguemnts from object, enum. --- libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs | 4 +- .../saml2-web-sso/src/SAML2/WebSSO/Orphans.hs | 2 +- libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs | 8 +- libs/schema-profunctor/src/Data/Schema.hs | 14 +-- .../test/unit/Test/Data/Schema.hs | 36 +++--- libs/types-common/src/Data/Code.hs | 2 +- .../src/Data/HavePendingInvitations.hs | 2 +- libs/types-common/src/Data/Id.hs | 2 +- libs/types-common/src/Data/LegalHold.hs | 2 +- libs/types-common/src/Data/Qualified.hs | 5 +- .../src/Network/Wai/Utilities/JSONResponse.hs | 2 +- .../API/Federation/BackendNotifications.hs | 4 +- .../src/Wire/API/Federation/Version.hs | 6 +- libs/wire-api/src/Wire/API/Asset.hs | 8 +- libs/wire-api/src/Wire/API/BackgroundJobs.hs | 10 +- libs/wire-api/src/Wire/API/Bot.hs | 4 +- libs/wire-api/src/Wire/API/Bot/Service.hs | 2 +- libs/wire-api/src/Wire/API/Call/Config.hs | 16 +-- libs/wire-api/src/Wire/API/Component.hs | 2 +- libs/wire-api/src/Wire/API/Connection.hs | 10 +- libs/wire-api/src/Wire/API/Conversation.hs | 28 ++--- .../src/Wire/API/Conversation/Action/Tag.hs | 2 +- .../wire-api/src/Wire/API/Conversation/Bot.hs | 8 +- .../src/Wire/API/Conversation/CellsState.hs | 2 +- .../src/Wire/API/Conversation/Code.hs | 4 - .../src/Wire/API/Conversation/Config.hs | 2 +- .../src/Wire/API/Conversation/Member.hs | 11 +- .../src/Wire/API/Conversation/Pagination.hs | 4 +- .../src/Wire/API/Conversation/Protocol.hs | 18 +-- .../src/Wire/API/Conversation/Typing.hs | 4 +- libs/wire-api/src/Wire/API/CustomBackend.hs | 2 +- libs/wire-api/src/Wire/API/EnterpriseLogin.hs | 14 +-- libs/wire-api/src/Wire/API/Error.hs | 6 +- libs/wire-api/src/Wire/API/Error/Galley.hs | 10 +- .../src/Wire/API/Event/Conversation.hs | 22 ++-- .../src/Wire/API/Event/FeatureConfig.hs | 4 +- .../wire-api/src/Wire/API/Event/Federation.hs | 4 +- .../src/Wire/API/Event/LeaveReason.hs | 2 +- libs/wire-api/src/Wire/API/Event/Team.hs | 6 +- .../src/Wire/API/Event/WebSocketProtocol.hs | 14 +-- .../wire-api/src/Wire/API/FederationStatus.hs | 2 +- libs/wire-api/src/Wire/API/History.hs | 2 +- .../src/Wire/API/Internal/BulkPush.hs | 12 +- .../src/Wire/API/Internal/Notification.hs | 2 +- libs/wire-api/src/Wire/API/MLS/Credential.hs | 2 +- libs/wire-api/src/Wire/API/MLS/KeyPackage.hs | 10 +- libs/wire-api/src/Wire/API/MLS/Keys.hs | 8 +- libs/wire-api/src/Wire/API/MLS/Message.hs | 2 +- .../src/Wire/API/MLS/SubConversation.hs | 4 +- libs/wire-api/src/Wire/API/Meeting.hs | 12 +- libs/wire-api/src/Wire/API/Message.hs | 8 +- libs/wire-api/src/Wire/API/Notification.hs | 6 +- libs/wire-api/src/Wire/API/OAuth.hs | 28 ++--- libs/wire-api/src/Wire/API/Pagination.hs | 4 +- libs/wire-api/src/Wire/API/Password.hs | 2 +- libs/wire-api/src/Wire/API/Presence.hs | 2 +- libs/wire-api/src/Wire/API/Provider.hs | 22 ++-- libs/wire-api/src/Wire/API/Provider/Bot.hs | 4 +- .../wire-api/src/Wire/API/Provider/Service.hs | 24 ++-- .../src/Wire/API/Provider/Service/Tag.hs | 2 +- libs/wire-api/src/Wire/API/Push/V2.hs | 8 +- libs/wire-api/src/Wire/API/Push/V2/Token.hs | 6 +- .../Wire/API/Routes/FederationDomainConfig.hs | 10 +- .../src/Wire/API/Routes/Internal/Brig.hs | 20 +-- .../API/Routes/Internal/Brig/Connection.hs | 8 +- .../src/Wire/API/Routes/Internal/Brig/EJPD.hs | 14 +-- .../Internal/Galley/ConversationsIntra.hs | 6 +- .../Galley/TeamFeatureNoConfigMulti.hs | 2 +- .../API/Routes/Internal/Galley/TeamsIntra.hs | 10 +- .../src/Wire/API/Routes/MultiTablePaging.hs | 5 +- .../Routes/Public/Brig/DomainVerification.hs | 27 ++-- .../src/Wire/API/Routes/Public/Galley/MLS.hs | 2 +- .../src/Wire/API/Routes/Public/Galley/Team.hs | 2 +- .../src/Wire/API/Routes/Public/Spar.hs | 4 +- libs/wire-api/src/Wire/API/Routes/Version.hs | 8 +- libs/wire-api/src/Wire/API/SystemSettings.hs | 6 +- libs/wire-api/src/Wire/API/Team.hs | 12 +- .../src/Wire/API/Team/Collaborator.hs | 6 +- .../src/Wire/API/Team/Conversation.hs | 2 - libs/wire-api/src/Wire/API/Team/Export.hs | 2 +- libs/wire-api/src/Wire/API/Team/Feature.hs | 118 +++++++++--------- libs/wire-api/src/Wire/API/Team/Invitation.hs | 8 +- libs/wire-api/src/Wire/API/Team/LegalHold.hs | 16 +-- .../src/Wire/API/Team/LegalHold/External.hs | 16 +-- .../src/Wire/API/Team/LegalHold/Internal.hs | 5 +- libs/wire-api/src/Wire/API/Team/Member.hs | 18 +-- .../wire-api/src/Wire/API/Team/Member/Info.hs | 4 +- libs/wire-api/src/Wire/API/Team/Permission.hs | 2 +- libs/wire-api/src/Wire/API/Team/Role.hs | 2 +- .../src/Wire/API/Team/SearchVisibility.hs | 7 +- libs/wire-api/src/Wire/API/Team/Size.hs | 2 +- libs/wire-api/src/Wire/API/User.hs | 86 ++++++------- libs/wire-api/src/Wire/API/User/Activation.hs | 6 +- libs/wire-api/src/Wire/API/User/Auth.hs | 18 ++- .../src/Wire/API/User/Auth/LegalHold.hs | 2 +- .../wire-api/src/Wire/API/User/Auth/ReAuth.hs | 2 +- libs/wire-api/src/Wire/API/User/Auth/Sso.hs | 2 +- libs/wire-api/src/Wire/API/User/Client.hs | 24 ++-- .../Wire/API/User/Client/DPoPAccessToken.hs | 4 +- .../src/Wire/API/User/Client/Prekey.hs | 6 +- libs/wire-api/src/Wire/API/User/Handle.hs | 4 +- .../src/Wire/API/User/IdentityProvider.hs | 3 +- libs/wire-api/src/Wire/API/User/Orphans.hs | 2 +- libs/wire-api/src/Wire/API/User/Password.hs | 6 +- libs/wire-api/src/Wire/API/User/Profile.hs | 10 +- libs/wire-api/src/Wire/API/User/RichInfo.hs | 2 +- libs/wire-api/src/Wire/API/User/Scim.hs | 14 +-- libs/wire-api/src/Wire/API/User/Search.hs | 14 +-- libs/wire-api/src/Wire/API/UserEvent.hs | 6 +- libs/wire-api/src/Wire/API/UserGroup.hs | 18 +-- .../src/Wire/API/UserGroup/Pagination.hs | 2 +- services/brig/src/Brig/Effects/SFT.hs | 2 +- services/brig/src/Brig/Options.hs | 2 +- services/cargohold/src/CargoHold/S3.hs | 2 +- tools/stern/src/Stern/API/Routes.hs | 2 +- tools/stern/src/Stern/Types.hs | 10 +- 116 files changed, 525 insertions(+), 548 deletions(-) diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs index a1a3d92a21..2e8c3ed8d1 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs @@ -88,7 +88,7 @@ data ConfigRaw = ConfigRaw instance ToSchema ConfigRaw where schema = - object "ConfigRaw" $ + object $ ConfigRaw <$> (_cfgRawLogLevel .= field "logLevel" schema) <*> (_cfgRawSPHost .= field "spHost" schema) @@ -100,7 +100,7 @@ instance ToSchema ConfigRaw where instance ToSchema MultiIngressDomainConfig where schema = - object "MultiIngressDomainConfig" $ + object $ MultiIngressDomainConfig <$> (_cfgSPAppURI .= field "spAppUri" schema) <*> (_cfgSPSsoURI .= field "spSsoUri" schema) diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs index 6364fe9779..0606a64231 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs @@ -66,7 +66,7 @@ instance ToSchema URI where $ (parseURI strictURIParserOptions . Text.encodeUtf8) uriText instance ToSchema Level where - schema = assert exhaustive $ enum @Text "Level" $ mconcat $ el <$> [minBound ..] + schema = assert exhaustive $ enum @Text $ mconcat $ el <$> [minBound ..] where el l = element (Text.pack (show l)) l diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs index 63dd1c54ae..8041b9bc70 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs @@ -272,7 +272,7 @@ data ContactPerson = ContactPerson -- (We may want to replace old template-haskell'ed ToJSON and FromJSON instances in hsaml2, but how?) instance Schema.ToSchema ContactPerson where schema = - Schema.object "ContactPerson" $ + Schema.object $ ContactPerson <$> (_cntType Schema..= Schema.field "type" Schema.schema) <*> (_cntCompany Schema..= Schema.maybe_ (Schema.optField "company" Schema.schema)) @@ -292,7 +292,7 @@ data ContactType -- (We may want to replace old template-haskell'ed ToJSON and FromJSON instances in hsaml2, but how?) instance Schema.ToSchema ContactType where schema = - Schema.enum @ST.Text "ContactType" $ + Schema.enum @ST.Text $ mconcat [ Schema.element "ContactTechnical" ContactTechnical, Schema.element "ContactSupport" ContactSupport, @@ -313,7 +313,7 @@ data IdPMetadata = IdPMetadata instance Schema.ToSchema IdPMetadata where schema = - Schema.object "IdPMetadata" $ + Schema.object $ IdPMetadata <$> (_edIssuer Schema..= Schema.field "issuer" Schema.schema) <*> (_edRequestURI Schema..= Schema.field "requestURI" Schema.schema) @@ -349,7 +349,7 @@ data IdPConfig extra = IdPConfig instance (Typeable (IdPConfig extra), Schema.ToSchema extra) => Schema.ToSchema (IdPConfig extra) where schema = - Schema.object "IdPConfig" $ + Schema.object $ IdPConfig <$> (_idpId Schema..= Schema.field "id" Schema.schema) <*> (_idpMetadata Schema..= Schema.field "metadata" Schema.schema) diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index 626dd001e3..eedfd4c382 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -403,8 +403,8 @@ tag f = rmap runIdentity . f . rmap Identity -- This can be used to convert a combination of schemas obtained using -- 'field' into a single schema for a JSON object. object :: + forall doc doc' a b. (Typeable a, HasObject doc doc') => - Text -> -- TODO: remove schema name, it's generated now! SchemaP doc A.Object [A.Pair] a b -> SchemaP doc' A.Value A.Value a b object = objectOver id @@ -416,10 +416,9 @@ objectOver :: forall doc doc' v' a b v. (Typeable a, HasObject doc doc') => Lens v v' A.Value A.Object -> - Text -> -- TODO: remove schema name, it's generated now! SchemaP doc v' [A.Pair] a b -> SchemaP doc' v A.Value a b -objectOver l _name sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) +objectOver l sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) where name = mkSchemaName @a parseObject val = ContT $ \k -> A.withObject (T.unpack name) k val @@ -438,12 +437,12 @@ mkSchemaName = T.pack $ show $ typeRep (Proxy @a) -- | Like 'object', but apply an arbitrary function to the -- documentation of the resulting object. objectWithDocModifier :: + forall doc doc' a. (Typeable a, HasObject doc doc') => - Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a -objectWithDocModifier name modify sch = over doc modify (object name sch) +objectWithDocModifier modify sch = over doc modify (object sch) -- | Turn a named schema into an unnamed one. -- @@ -571,10 +570,9 @@ element label value = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) enum :: forall v doc a b. (Typeable a, With v, HasEnum v doc) => - Text -> -- TODO: remove schema name, it's generated now! SchemaP [A.Value] v (Alt Maybe v) a b -> SchemaP doc A.Value A.Value a b -enum _name sch = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) +enum sch = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) where name = mkSchemaName @a d = mkEnum @v name (schemaDoc sch) @@ -665,7 +663,7 @@ parsedTextWithDoc desc name parser = appendDescr (text name) `withParser` (eithe -- | A schema for an arbitrary JSON object. jsonObject :: ValueSchema SwaggerDoc A.Object jsonObject = - unnamed . object "Object" $ + unnamed . object $ mkSchema (pure (mempty & S.type_ ?~ S.OpenApiObject)) pure (pure . (^.. ifolded . withIndex)) -- | A schema for an arbitrary JSON value. diff --git a/libs/schema-profunctor/test/unit/Test/Data/Schema.hs b/libs/schema-profunctor/test/unit/Test/Data/Schema.hs index 9164e4af3c..031903afe0 100644 --- a/libs/schema-profunctor/test/unit/Test/Data/Schema.hs +++ b/libs/schema-profunctor/test/unit/Test/Data/Schema.hs @@ -337,7 +337,7 @@ testEnumType :: TestTree testEnumType = testCase "Enum Swagger schema has the correct type" $ do let e1 :: ValueSchema NamedSwaggerDoc Text - e1 = enum @Text "TextEnum" (element "hello" "hello") + e1 = enum @Text (element "hello" "hello") (_, s1) = S.runDeclare (declareSwaggerSchema e1) mempty assertEqual "Text enum has Swagger type \"string\"" @@ -345,7 +345,7 @@ testEnumType = (Just S.OpenApiString) let e2 :: ValueSchema NamedSwaggerDoc Integer - e2 = enum @Integer "IntEnum" (element (3 :: Integer) (3 :: Integer)) + e2 = enum @Integer (element (3 :: Integer) (3 :: Integer)) (_, s2) = S.runDeclare (declareSwaggerSchema e2) mempty assertEqual "Integer enum has Swagger type \"integer\"" @@ -376,7 +376,7 @@ data A = A {thing :: Text, other :: Int} instance ToSchema A where schema = - object "A" $ + object $ A <$> thing .= field "thing" schema <*> other .= field "other" schema @@ -385,7 +385,7 @@ newtype B = B {bThing :: Int} deriving (Eq, Show) instance ToSchema B where - schema = object "B" $ B <$> bThing .= field "b_thing" schema + schema = object $ B <$> bThing .= field "b_thing" schema data Foo = Foo {fooA :: A, fooB :: B, fooStr :: Text} deriving stock (Eq, Show) @@ -410,7 +410,7 @@ exampleFooInvalidJSON = instance ToSchema Foo where schema = (doc . description ?~ "A Foo object") - . object "Foo" + . object $ Foo <$> fooA .= field "a" schema <* (thing . fooA) .= optional (field "a_thing" (unnamed schema)) @@ -455,7 +455,7 @@ data Access = Public | Private | Link | Code instance ToSchema Access where schema = - enum @Text "Access" $ + enum @Text $ element "public" Public <> element "private" Private <> element "link" Link @@ -473,7 +473,7 @@ data User = User instance ToSchema User where schema = - object "User" $ + object $ User <$> userName .= field "name" schema <*> userHandle .= maybe_ (optField "handle" schema) @@ -517,16 +517,16 @@ _Obj2 = prism' Obj2 $ \case _ -> Nothing instance ToSchema Tag where - schema = enum @Text "Tag" (element "tag1" Tag1 <> element "tag2" Tag2) + schema = enum @Text (element "tag1" Tag1 <> element "tag2" Tag2) instance ToSchema TaggedObject where schema = - object "TaggedObject" $ + object $ uncurry TO <$> (toTag &&& toObj) .= bind (fst .= field "tag" schema) - (snd .= fieldOver _1 "obj" (objectOver _1 "UntaggedObject" untaggedSchema)) + (snd .= fieldOver _1 "obj" (objectOver _1 untaggedSchema)) where untaggedSchema = dispatch $ \case Tag1 -> tag _Obj1 (field "tag1_data" schema) @@ -554,14 +554,14 @@ newtype NonEmptyTest = NonEmptyTest {nl :: NonEmpty Text} deriving (ToJSON, FromJSON, S.ToSchema) via Schema NonEmptyTest instance ToSchema NonEmptyTest where - schema = object "NonEmptyTest" $ NonEmptyTest <$> nl .= field "nl" (nonEmptyArray schema) + schema = object $ NonEmptyTest <$> nl .= field "nl" (nonEmptyArray schema) -- references newtype Named = Named {getName :: Text} instance ToSchema Named where - schema = Named <$> getName .= object "Named" (field "name" (text "Name")) + schema = Named <$> getName .= object (field "name" (text "Name")) instance S.ToSchema Named where declareNamedSchema = schemaToSwagger @@ -584,13 +584,13 @@ passwordSchema = schema `withParser` validate -- this is "wrong", because it succeeds even if password validation fails rmClientSchema :: ValueSchema NamedSwaggerDoc RmClient rmClientSchema = - object "RmClient" $ + object $ RmClient <$> rmPassword .= optional (field "password" (maybeWithDefault Null passwordSchema)) instance ToSchema RmClient where schema = - object "RmClient" $ + object $ RmClient <$> rmPassword .= maybe_ (optField "password" passwordSchema) @@ -616,12 +616,12 @@ data DetailTag = NameTag | AgeTag tagSchema :: ValueSchema NamedSwaggerDoc DetailTag tagSchema = - enum @Text "Detail Tag" $ + enum @Text $ mconcat [element "name" NameTag, element "age" AgeTag] detailSchema :: ValueSchema NamedSwaggerDoc Detail detailSchema = - object "Detail" $ + object $ fromTagged <$> toTagged .= bind @@ -641,7 +641,7 @@ detailSchema = userSchemaWithDefaultName' :: ValueSchema NamedSwaggerDoc User userSchemaWithDefaultName' = - object "User" $ + object $ User <$> (getOptText . userName) .= maybe_ (fromMaybe "" <$> optField "name" schema) <*> userHandle .= maybe_ (optField "handle" schema) @@ -653,7 +653,7 @@ userSchemaWithDefaultName' = userSchemaWithDefaultName :: ValueSchema NamedSwaggerDoc User userSchemaWithDefaultName = - object "User" $ + object $ User <$> userName .= (field "name" schema <|> pure "") <*> userHandle .= maybe_ (optField "handle" schema) diff --git a/libs/types-common/src/Data/Code.hs b/libs/types-common/src/Data/Code.hs index 6bba1c5f08..c5b55a701b 100644 --- a/libs/types-common/src/Data/Code.hs +++ b/libs/types-common/src/Data/Code.hs @@ -125,7 +125,7 @@ data KeyValuePair = KeyValuePair instance ToSchema KeyValuePair where schema = - object "KeyValuePair" $ + object $ KeyValuePair <$> key .= field "key" schema <*> code .= field "code" schema diff --git a/libs/types-common/src/Data/HavePendingInvitations.hs b/libs/types-common/src/Data/HavePendingInvitations.hs index d04a020b7f..8c38f3de98 100644 --- a/libs/types-common/src/Data/HavePendingInvitations.hs +++ b/libs/types-common/src/Data/HavePendingInvitations.hs @@ -31,7 +31,7 @@ data HavePendingInvitations deriving (FromJSON, ToJSON, S.ToSchema) via Schema HavePendingInvitations instance ToSchema HavePendingInvitations where - schema = enum @Bool "HavePendingInvitations" $ mconcat [element True WithPendingInvitations, element False NoPendingInvitations] + schema = enum @Bool $ mconcat [element True WithPendingInvitations, element False NoPendingInvitations] fromBool :: Bool -> HavePendingInvitations fromBool True = WithPendingInvitations diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index 9ffa4cc8bd..87b51358ae 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/libs/types-common/src/Data/Id.hs @@ -488,4 +488,4 @@ instance (Typeable a, ToSchema a) => ToSchema (IdObject a) where schema = idObjectSchema (IdObject <$> fromIdObject .= schema) idObjectSchema :: (Typeable a) => ValueSchemaP NamedSwaggerDoc a b -> ValueSchemaP NamedSwaggerDoc a b -idObjectSchema sch = object "Id" (field "id" sch) +idObjectSchema sch = object (field "id" sch) diff --git a/libs/types-common/src/Data/LegalHold.hs b/libs/types-common/src/Data/LegalHold.hs index 247684fee7..f7666513ae 100644 --- a/libs/types-common/src/Data/LegalHold.hs +++ b/libs/types-common/src/Data/LegalHold.hs @@ -40,7 +40,7 @@ data UserLegalHoldStatus instance ToSchema UserLegalHoldStatus where schema = (S.schema . description ?~ desc) $ - enum @Text "UserLegalHoldStatus" $ + enum @Text $ element "enabled" UserLegalHoldEnabled <> element "pending" UserLegalHoldPending <> element "disabled" UserLegalHoldDisabled diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index e0e0a5e489..ebf440d9b1 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -194,9 +194,8 @@ qualifiedSchema :: Text -> ValueSchema doc a -> ValueSchema NamedSwaggerDoc (Qualified a) -qualifiedSchema name fieldName sch = - object ("Qualified_" <> name) $ - qualifiedObjectSchema fieldName sch +qualifiedSchema _name fieldName sch = + object $ qualifiedObjectSchema fieldName sch -- TODO!### qualifiedObjectSchema :: (HasSchemaRef d) => diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/JSONResponse.hs b/libs/wai-utilities/src/Network/Wai/Utilities/JSONResponse.hs index c7238eaf9b..318f520680 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/JSONResponse.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/JSONResponse.hs @@ -50,7 +50,7 @@ data JSONResponse = JSONResponse instance ToSchema JSONResponse where schema = - object "JSONResponse" $ + object $ JSONResponse <$> status .= field "status" (toEnum <$> (fromEnum .= schema)) <*> value .= field "value" jsonValue diff --git a/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs index 5ec776c6ce..ac1e0e03cd 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs @@ -65,7 +65,7 @@ data BackendNotification = BackendNotification instance ToSchema BackendNotification where schema = - object "BackendNotification" $ + object $ BackendNotification <$> ownDomain .= field "ownDomain" schema <*> targetComponent .= field "targetComponent" schema @@ -112,7 +112,7 @@ newtype PayloadBundle (c :: Component) = PayloadBundle instance (Typeable c) => ToSchema (PayloadBundle c) where schema = - object "PayloadBundle" $ + object $ PayloadBundle <$> notifications .= field "notifications" (nonEmptyArray schema) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Version.hs b/libs/wire-api-federation/src/Wire/API/Federation/Version.hs index 4c141c20fe..5e2f016901 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Version.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Version.hs @@ -79,7 +79,7 @@ intToVersion intV = find (\v -> versionInt v == intV) [minBound ..] instance ToSchema Version where schema = - enum @Integer "Version" . mconcat $ + enum @Integer . mconcat $ [ element 0 V0, element 1 V1, element 2 V2, @@ -96,7 +96,7 @@ data VersionInfo = VersionInfo instance ToSchema VersionInfo where schema = - objectWithDocModifier "VersionInfo" (S.schema . S.example ?~ toJSON example) $ + objectWithDocModifier (S.schema . S.example ?~ toJSON example) $ VersionInfo -- if the supported_versions field does not exist, assume an old backend -- that only supports V0 @@ -147,7 +147,7 @@ deriving instance Ord VersionRange instance ToSchema VersionRange where schema = - object "VersionRange" $ + object $ VersionRange <$> _fromVersion .= field "from" schema <*> (versionFromUpperBound . _toVersionExcl) diff --git a/libs/wire-api/src/Wire/API/Asset.hs b/libs/wire-api/src/Wire/API/Asset.hs index ac51bde02f..d54acd2a80 100644 --- a/libs/wire-api/src/Wire/API/Asset.hs +++ b/libs/wire-api/src/Wire/API/Asset.hs @@ -127,7 +127,7 @@ mkAsset k = Asset k Nothing Nothing instance ToSchema Asset where schema = - object "Asset" $ + object $ Asset <$> _assetKey .= ( Qualified @@ -231,7 +231,7 @@ newtype NewAssetToken = NewAssetToken instance ToSchema NewAssetToken where schema = - object "NewAssetToken" $ + object $ NewAssetToken <$> newAssetToken .= field "token" schema -------------------------------------------------------------------------------- @@ -308,7 +308,7 @@ defAssetSettings = AssetSettings False Nothing Nothing Nothing Nothing instance ToSchema AssetSettings where schema = - object "AssetSettings" $ + object $ AssetSettings <$> _setAssetPublic .= (fromMaybe False <$> optField "public" schema) <*> _setAssetRetention .= maybe_ (optField "retention" schema) @@ -389,7 +389,7 @@ retentionToTextRep AssetExpiring = "expiring" instance ToSchema AssetRetention where schema = - enum @Text "AssetRetention" $ + enum @Text $ foldMap (\value -> element (retentionToTextRep value) value) [minBound .. maxBound] diff --git a/libs/wire-api/src/Wire/API/BackgroundJobs.hs b/libs/wire-api/src/Wire/API/BackgroundJobs.hs index f0432d2f53..78f179ed95 100644 --- a/libs/wire-api/src/Wire/API/BackgroundJobs.hs +++ b/libs/wire-api/src/Wire/API/BackgroundJobs.hs @@ -51,7 +51,7 @@ data JobPayloadTag instance ToSchema JobPayloadTag where schema = - enum @Text "JobPayloadTag" $ + enum @Text $ mconcat [ element "sync-user-group-and-channel" JobSyncUserGroupAndChannelTag, element "sync-user-group" JobSyncUserGroupTag @@ -78,7 +78,7 @@ data SyncUserGroupAndChannel = SyncUserGroupAndChannel instance ToSchema SyncUserGroupAndChannel where schema = - object "SyncUserGroupAndChannel" $ + object $ SyncUserGroupAndChannel <$> (.teamId) .= field "team_id" schema <*> (.userGroupId) .= field "user_group_id" schema @@ -96,7 +96,7 @@ data SyncUserGroup = SyncUserGroup instance ToSchema SyncUserGroup where schema = - object "SyncUserGroup" $ + object $ SyncUserGroup <$> (.teamId) .= field "team_id" schema <*> (.userGroupId) .= field "user_group_id" schema @@ -118,7 +118,7 @@ jobPayloadObjectSchema = JobSyncUserGroupTag -> tag _JobSyncUserGroup (field "payload" schema) instance ToSchema JobPayload where - schema = object "JobPayload" jobPayloadObjectSchema + schema = object jobPayloadObjectSchema deriving via (Schema JobPayload) instance Aeson.FromJSON JobPayload @@ -138,7 +138,7 @@ data Job = Job instance ToSchema Job where schema = - object "Job" $ + object $ Job <$> jobId .= field "id" schema <*> requestId .= field "requestId" schema diff --git a/libs/wire-api/src/Wire/API/Bot.hs b/libs/wire-api/src/Wire/API/Bot.hs index 6c82112f72..c2d4b57631 100644 --- a/libs/wire-api/src/Wire/API/Bot.hs +++ b/libs/wire-api/src/Wire/API/Bot.hs @@ -54,7 +54,7 @@ addBot = AddBot instance ToSchema AddBot where schema = - object "AddBot" $ + object $ AddBot <$> _addBotService .= field "service" schema <*> _addBotConv .= field "conversation" schema @@ -74,7 +74,7 @@ removeBot = RemoveBot instance ToSchema RemoveBot where schema = - object "RemoveBot" $ + object $ RemoveBot <$> _rmBotConv .= field "conversation" schema <*> _rmBotId .= field "bot" schema diff --git a/libs/wire-api/src/Wire/API/Bot/Service.hs b/libs/wire-api/src/Wire/API/Bot/Service.hs index 05554f34da..cfb4623a1e 100644 --- a/libs/wire-api/src/Wire/API/Bot/Service.hs +++ b/libs/wire-api/src/Wire/API/Bot/Service.hs @@ -53,7 +53,7 @@ newService ref url tok fps = Service ref url tok fps True instance ToSchema Service where schema = - object "BotService" $ + object $ Service <$> _serviceRef .= field "ref" schema <*> _serviceUrl .= field "base_url" schema diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs index e0fafcf1f6..b58f82a5a3 100644 --- a/libs/wire-api/src/Wire/API/Call/Config.hs +++ b/libs/wire-api/src/Wire/API/Call/Config.hs @@ -138,7 +138,7 @@ rtcConfiguration = RTCConfiguration instance ToSchema RTCConfiguration where schema = - objectWithDocModifier "RTCConfiguration" (description ?~ "A subset of the WebRTC 'RTCConfiguration' dictionary") $ + objectWithDocModifier (description ?~ "A subset of the WebRTC 'RTCConfiguration' dictionary") $ RTCConfiguration <$> _rtcConfIceServers .= fieldWithDocModifier "ice_servers" (description ?~ "Array of 'RTCIceServer' objects") (nonEmptyArray schema) @@ -163,7 +163,7 @@ newtype SFTServer = SFTServer instance ToSchema SFTServer where schema = - objectWithDocModifier "SftServer" (description ?~ "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers") $ + objectWithDocModifier (description ?~ "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers") $ SFTServer <$> (pure . _sftURL) .= fieldWithDocModifier "urls" (description ?~ "Array containing exactly one SFT server address of the form 'https://:'") (withParser (array schema) p) @@ -189,7 +189,7 @@ data AuthSFTServer = AuthSFTServer instance ToSchema AuthSFTServer where schema = - objectWithDocModifier "SftServer" (description ?~ "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers") $ + objectWithDocModifier (description ?~ "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers") $ AuthSFTServer <$> (pure . _authURL) .= fieldWithDocModifier "urls" (description ?~ "Array containing exactly one SFT server address of the form 'https://:'") (withParser (array schema) p) @@ -228,7 +228,7 @@ rtcIceServer = RTCIceServer instance ToSchema RTCIceServer where schema = - objectWithDocModifier "RTCIceServer" (description ?~ "A subset of the WebRTC 'RTCIceServer' object") $ + objectWithDocModifier (description ?~ "A subset of the WebRTC 'RTCIceServer' object") $ RTCIceServer <$> _iceURLs .= fieldWithDocModifier "urls" (description ?~ "Array of TURN server addresses of the form 'turn::'") (nonEmptyArray schema) @@ -323,7 +323,7 @@ instance BC.FromByteString Scheme where instance ToSchema Scheme where schema = - enum @Text "Scheme" $ + enum @Text $ mconcat [ element "turn" SchemeTurn, element "turns" SchemeTurns @@ -343,7 +343,7 @@ data TurnHostTag = TurnHostIpTag | TurnHostNameTag tagSchema :: ValueSchema NamedSwaggerDoc TurnHostTag tagSchema = - enum @Text "TurnHostTag" $ + enum @Text $ mconcat [ element "TurnHostIp" TurnHostIpTag, element "TurnHostName" TurnHostNameTag @@ -351,7 +351,7 @@ tagSchema = turnHostSchema :: ValueSchema NamedSwaggerDoc TurnHost turnHostSchema = - object "TurnHost" $ + object $ fromTagged <$> toTagged .= bind @@ -431,7 +431,7 @@ instance BC.FromByteString Transport where instance ToSchema Transport where schema = - enum @Text "Transport" $ + enum @Text $ mconcat [ element "udp" TransportUDP, element "tcp" TransportTCP diff --git a/libs/wire-api/src/Wire/API/Component.hs b/libs/wire-api/src/Wire/API/Component.hs index 607a1fc661..079bdef2c8 100644 --- a/libs/wire-api/src/Wire/API/Component.hs +++ b/libs/wire-api/src/Wire/API/Component.hs @@ -58,7 +58,7 @@ data Component instance ToSchema Component where schema = - enum @Text "Component" $ + enum @Text $ mconcat [ element "brig" Brig, element "galley" Galley, diff --git a/libs/wire-api/src/Wire/API/Connection.hs b/libs/wire-api/src/Wire/API/Connection.hs index d7843692c5..0eba6606ea 100644 --- a/libs/wire-api/src/Wire/API/Connection.hs +++ b/libs/wire-api/src/Wire/API/Connection.hs @@ -86,7 +86,7 @@ data UserConnectionList = UserConnectionList instance ToSchema UserConnectionList where schema = - object "UserConnectionList" $ + object $ UserConnectionList <$> clConnections .= field "connections" (array schema) <*> clHasMore .= fieldWithDocModifier "has_more" (description ?~ "Indicator that the server has more connections than returned.") schema @@ -113,7 +113,7 @@ data UserConnection = UserConnection instance ToSchema UserConnection where schema = - object "UserConnection" $ + object $ UserConnection <$> ucFrom .= field "from" schema <*> ucTo .= field "qualified_to" schema @@ -197,7 +197,7 @@ relationDropHistory = \case instance ToSchema Relation where schema = - enum @Text "Relation" $ + enum @Text $ mconcat [ element "accepted" Accepted, element "blocked" Blocked, @@ -282,7 +282,7 @@ data ConnectionRequest = ConnectionRequest instance ToSchema ConnectionRequest where schema = - object "ConnectionRequest" $ + object $ ConnectionRequest <$> crUser .= fieldWithDocModifier "user" (description ?~ "user ID of the user to request a connection with") schema <*> crName .= fieldWithDocModifier "name" (description ?~ "Name of the (pending) conversation being initiated (1 - 256) characters)") schema @@ -297,6 +297,6 @@ newtype ConnectionUpdate = ConnectionUpdate instance ToSchema ConnectionUpdate where schema = - object "ConnectionUpdate" $ + object $ ConnectionUpdate <$> cuStatus .= fieldWithDocModifier "status" (description ?~ "New relation status") schema diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 0c9dac8348..59c8c4a7a4 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -244,7 +244,7 @@ conversationMetadataObjectSchema sch = <*> cnvmHistory .= (fromMaybe def <$> optField "history" schema) instance ToSchema ConversationMetadata where - schema = object "ConversationMetadata" (conversationMetadataObjectSchema accessRolesSchema) + schema = object (conversationMetadataObjectSchema accessRolesSchema) instance ToSchema (Versioned 'V2 ConversationMetadata) where schema = @@ -581,7 +581,7 @@ data Access instance ToSchema Access where schema = (S.schema . DS.description ?~ "How users can join conversations") $ - enum @Text "Access" $ + enum @Text $ mconcat [ element "private" PrivateAccess, element "invite" InviteAccess, @@ -726,7 +726,7 @@ toAccessRoleLegacy accessRoles = do instance ToSchema AccessRole where schema = (S.schema . DS.description ?~ desc) $ - enum @Text "AccessRole" $ + enum @Text $ mconcat [ element "team_member" TeamMemberAccessRole, element "non_team_member" NonTeamMemberAccessRole, @@ -747,7 +747,7 @@ instance ToSchema AccessRoleLegacy where schema = (S.schema . S.deprecated ?~ True) $ (S.schema . DS.description ?~ desc) $ - enum @Text "AccessRoleLegacy" $ + enum @Text $ mconcat [ element "private" PrivateAccessRole, element "team" TeamAccessRole, @@ -781,7 +781,7 @@ data ConvType instance ToSchema ConvType where schema = - enum @Integer "ConvType" $ + enum @Integer $ mconcat [ element 0 RegularConv, element 1 SelfConv, @@ -852,7 +852,7 @@ data GroupConvType = GroupConversation | Channel | MeetingConversation instance ToSchema GroupConvType where schema = - enum @Text "GroupConvType" $ + enum @Text $ mconcat [ element "group_conversation" GroupConversation, element "channel" Channel, @@ -1085,7 +1085,7 @@ data Invite = Invite -- Deprecated, use InviteQualified (and maybe rename?) instance ToSchema Invite where schema = - object "Invite" $ + object $ Invite <$> (.invUsers) .= field "users" (nonEmptyArray schema) @@ -1103,7 +1103,7 @@ data InviteQualified = InviteQualified instance ToSchema InviteQualified where schema = - object "InviteQualified" $ + object $ InviteQualified <$> (.users) .= field "qualified_users" (nonEmptyArray schema) <*> roleName .= (fromMaybe roleNameWireAdmin <$> optField "conversation_role" schema) @@ -1118,7 +1118,7 @@ data InviteQualifiedInternal = InviteQualifiedInternal instance ToSchema InviteQualifiedInternal where schema = - object "InviteQualifiedInternal" $ + object $ InviteQualifiedInternal <$> (.actor) .= field "actor" schema <*> (.invite) .= field "invite" schema @@ -1135,7 +1135,7 @@ newtype ConversationRename = ConversationRename instance ToSchema ConversationRename where schema = - object "ConversationRename" $ + object $ ConversationRename <$> cupName .= fieldWithDocModifier @@ -1175,7 +1175,7 @@ data ConversationReceiptModeUpdate = ConversationReceiptModeUpdate instance ToSchema ConversationReceiptModeUpdate where schema = - objectWithDocModifier "ConversationReceiptModeUpdate" (DS.description ?~ desc) $ + objectWithDocModifier (DS.description ?~ desc) $ ConversationReceiptModeUpdate <$> cruReceiptMode .= field "receipt_mode" (unnamed schema) where @@ -1210,7 +1210,7 @@ instance Default JoinType where instance ToSchema JoinType where schema = - enum @Text "JoinType" $ + enum @Text $ mconcat [ element "external_add" ExternalAdd, element "internal_add" InternalAdd @@ -1290,7 +1290,7 @@ instance Default AddPermission where instance ToSchema AddPermission where schema = - enum @Text "AddPermission" $ + enum @Text $ mconcat [ element "admins" Admins, element "everyone" Everyone @@ -1350,7 +1350,7 @@ data ConversationHistoryUpdate = ConversationHistoryUpdate instance ToSchema ConversationHistoryUpdate where schema = - object "ConversationHistoryUpdate" $ + object $ ConversationHistoryUpdate <$> (.history) .= field "history" schema diff --git a/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs b/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs index 47488f460a..90aa92757e 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs @@ -67,7 +67,7 @@ instance Arbitrary ConversationActionTag where instance ToSchema ConversationActionTag where schema = - enum @Text "ConversationActionTag" $ + enum @Text $ mconcat [ element "ConversationJoinTag" ConversationJoinTag, element "ConversationLeaveTag" ConversationLeaveTag, diff --git a/libs/wire-api/src/Wire/API/Conversation/Bot.hs b/libs/wire-api/src/Wire/API/Conversation/Bot.hs index a6878f3835..84d9f6ee7d 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Bot.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Bot.hs @@ -52,7 +52,7 @@ data AddBot = AddBot instance ToSchema AddBot where schema = - object "AddBot" $ + object $ AddBot <$> addBotProvider .= field "provider" schema <*> addBotService .= field "service" schema @@ -72,7 +72,7 @@ data AddBotResponse = AddBotResponse instance ToSchema AddBotResponse where schema = - object "AddBotResponse" $ + object $ AddBotResponse <$> rsAddBotId .= field "id" schema <*> rsAddBotClient .= field "client" schema @@ -95,7 +95,7 @@ newtype RemoveBotResponse = RemoveBotResponse instance ToSchema RemoveBotResponse where schema = - object "RemoveBotResponse" $ + object $ RemoveBotResponse <$> rsRemoveBotEvent .= field "event" schema @@ -111,6 +111,6 @@ newtype UpdateBotPrekeys = UpdateBotPrekeys instance ToSchema UpdateBotPrekeys where schema = - object "UpdateBotPrekeys" $ + object $ UpdateBotPrekeys <$> updateBotPrekeyList .= field "prekeys" (array schema) diff --git a/libs/wire-api/src/Wire/API/Conversation/CellsState.hs b/libs/wire-api/src/Wire/API/Conversation/CellsState.hs index b6084cb440..fe327c06e1 100644 --- a/libs/wire-api/src/Wire/API/Conversation/CellsState.hs +++ b/libs/wire-api/src/Wire/API/Conversation/CellsState.hs @@ -43,7 +43,7 @@ instance Default CellsState where instance ToSchema CellsState where schema = - enum @Text "CellsState" $ + enum @Text $ mconcat [ element "disabled" CellsDisabled, element "pending" CellsPending, diff --git a/libs/wire-api/src/Wire/API/Conversation/Code.hs b/libs/wire-api/src/Wire/API/Conversation/Code.hs index c80b588c53..579562f3b2 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Code.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Code.hs @@ -57,7 +57,6 @@ instance ToSchema CreateConversationCodeRequest where schema :: ValueSchema NamedSwaggerDoc CreateConversationCodeRequest schema = objectWithDocModifier - "CreateConversationCodeRequest" (description ?~ "Request body for creating a conversation code") $ CreateConversationCodeRequest <$> (.password) .= maybe_ (optFieldWithDocModifier "password" desc schema) @@ -75,7 +74,6 @@ data JoinConversationByCode = JoinConversationByCode instance ToSchema JoinConversationByCode where schema = objectWithDocModifier - "JoinConversationByCode" (description ?~ "Request body for joining a conversation by code") $ JoinConversationByCode <$> (.code) .= conversationCodeObjectSchema @@ -106,7 +104,6 @@ conversationCodeObjectSchema = instance ToSchema ConversationCode where schema = objectWithDocModifier - "ConversationCode" (description ?~ "Contains conversation properties to update") conversationCodeObjectSchema @@ -122,7 +119,6 @@ data ConversationCodeInfo = ConversationCodeInfo instance ToSchema ConversationCodeInfo where schema = objectWithDocModifier - "ConversationCodeInfo" (description ?~ "Contains conversation properties to update") $ ConversationCodeInfo <$> (.code) .= conversationCodeObjectSchema diff --git a/libs/wire-api/src/Wire/API/Conversation/Config.hs b/libs/wire-api/src/Wire/API/Conversation/Config.hs index 6565fbd1d1..b9617cc317 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Config.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Config.hs @@ -40,7 +40,7 @@ data ConversationSubsystemConfig = ConversationSubsystemConfig instance ToSchema ConversationSubsystemConfig where schema = - object "ConversationSubsystemConfig" $ + object $ ConversationSubsystemConfig <$> (.mlsKeys) .= maybe_ (optField "mls_keys" schema) <*> (.federationProtocols) .= maybe_ (optField "federation_protocols" (array schema)) diff --git a/libs/wire-api/src/Wire/API/Conversation/Member.hs b/libs/wire-api/src/Wire/API/Conversation/Member.hs index e496b1708e..7ed8bcce16 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Member.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Member.hs @@ -64,7 +64,7 @@ data OwnConvMembers = OwnConvMembers instance ToSchema OwnConvMembers where schema = - objectWithDocModifier "OwnConvMembers" (description ?~ "Users of a conversation") $ + objectWithDocModifier (description ?~ "Users of a conversation") $ OwnConvMembers <$> cmSelf .= fieldWithDocModifier @@ -90,7 +90,7 @@ data ConvMembers = ConvMembers instance ToSchema ConvMembers where schema = - objectWithDocModifier "ConvMembers" (description ?~ "Users of a conversation") $ + objectWithDocModifier (description ?~ "Users of a conversation") $ ConvMembers <$> self .= maybe_ (optFieldWithDocModifier "self" selfDesc schema) <*> others .= fieldWithDocModifier "others" othersDesc (array schema) @@ -132,7 +132,7 @@ defMember uid = instance ToSchema Member where schema = - object "Member" $ + object $ Member <$> memId .= field "qualified_id" schema <* (qUnqualified . memId) @@ -177,7 +177,7 @@ data OtherMember = OtherMember instance ToSchema OtherMember where schema = - object "OtherMember" $ + object $ OtherMember <$> omQualifiedId .= field "qualified_id" schema <* (qUnqualified . omQualifiedId) .= optional (field "id" schema) @@ -212,7 +212,7 @@ memberUpdate = MemberUpdate Nothing Nothing Nothing Nothing Nothing Nothing instance ToSchema MemberUpdate where schema = (`withParser` (either fail pure . validateMemberUpdate)) - . object "MemberUpdate" + . object $ MemberUpdate <$> mupOtrMuteStatus .= maybe_ (optField "otr_muted_status" schema) <*> mupOtrMuteRef .= maybe_ (optField "otr_muted_ref" schema) @@ -255,7 +255,6 @@ instance ToSchema OtherMemberUpdate where schema = (`withParser` (either fail pure . validateOtherMemberUpdate)) . objectWithDocModifier - "OtherMemberUpdate" (description ?~ "Update user properties of other members relative to a conversation") $ OtherMemberUpdate <$> omuConvRoleName .= maybe_ (optField "conversation_role" schema) diff --git a/libs/wire-api/src/Wire/API/Conversation/Pagination.hs b/libs/wire-api/src/Wire/API/Conversation/Pagination.hs index 034f508b50..faa674c276 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Pagination.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Pagination.hs @@ -33,7 +33,7 @@ newtype ConversationPage = ConversationPage {page :: [ConversationSearchResult]} instance ToSchema ConversationPage where schema = - objectWithDocModifier "ConversationPage" addPageDocs $ + objectWithDocModifier addPageDocs $ ConversationPage <$> page .= field "page" (array schema) instance Arbitrary ConversationPage where @@ -52,7 +52,7 @@ data ConversationSearchResult = ConversationSearchResult instance ToSchema ConversationSearchResult where schema = - object "ConversationSearchResult" $ + object $ ConversationSearchResult <$> (.convId) .= field "id" schema <*> (.name) .= maybe_ (optField "name" schema) diff --git a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs index e41ad2f720..4f1f3f1271 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs @@ -174,10 +174,10 @@ optionalActiveMLSConversationDataSchema _ = mk epoch ts cs = ActiveMLSConversationData epoch <$> ts <*> cs instance ToSchema ConversationMLSData where - schema = object "ConversationMLSData" (mlsDataSchema Nothing) + schema = object (mlsDataSchema Nothing) instance ToSchema (Versioned 'V5 ConversationMLSData) where - schema = Versioned <$> object "ConversationMLSDataV5" (unVersioned .= mlsDataSchema (Just V5)) + schema = Versioned <$> object (unVersioned .= mlsDataSchema (Just V5)) -- TODO: Fix API compatibility data ActiveMLSConversationData = ActiveMLSConversationData @@ -193,7 +193,7 @@ data ActiveMLSConversationData = ActiveMLSConversationData deriving (ToJSON, FromJSON) via Schema ActiveMLSConversationData instance ToSchema ActiveMLSConversationData where - schema = object "ActiveMLSConversationData" activeMLSConversationDataSchema + schema = object activeMLSConversationDataSchema activeMLSConversationDataSchema :: ObjectSchema SwaggerDoc ActiveMLSConversationData activeMLSConversationDataSchema = @@ -229,9 +229,13 @@ protocolTag ProtocolProteus = ProtocolProteusTag protocolTag (ProtocolMLS _) = ProtocolMLSTag protocolTag (ProtocolMixed _) = ProtocolMixedTag +-- TODO!### interesting, we intentionally made 3 different schemas all +-- have the name "Protocol" here until now. was there a reason? +-- maybe a good one? + instance ToSchema ProtocolTag where schema = - enum @Text "Protocol" $ + enum @Text $ mconcat [ element "proteus" ProtocolProteusTag, element "mls" ProtocolMLSTag, @@ -254,10 +258,10 @@ protocolSchema v = (snd .= dispatch (protocolDataSchema v)) instance ToSchema Protocol where - schema = object "Protocol" (protocolSchema Nothing) + schema = object (protocolSchema Nothing) instance ToSchema (Versioned 'V5 Protocol) where - schema = object "Protocol" (Versioned <$> unVersioned .= protocolSchema (Just V5)) + schema = object (Versioned <$> unVersioned .= protocolSchema (Just V5)) deriving via (Schema Protocol) instance FromJSON Protocol @@ -275,7 +279,7 @@ newtype ProtocolUpdate = ProtocolUpdate {unProtocolUpdate :: ProtocolTag} deriving (Arbitrary) via GenericUniform ProtocolUpdate instance ToSchema ProtocolUpdate where - schema = object "ProtocolUpdate" (ProtocolUpdate <$> unProtocolUpdate .= protocolTagSchema) + schema = object (ProtocolUpdate <$> unProtocolUpdate .= protocolTagSchema) deriving via (Schema ProtocolUpdate) instance FromJSON ProtocolUpdate diff --git a/libs/wire-api/src/Wire/API/Conversation/Typing.hs b/libs/wire-api/src/Wire/API/Conversation/Typing.hs index 076dbde5e4..82e5e93ac2 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Typing.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Typing.hs @@ -35,11 +35,11 @@ data TypingStatus instance ToSchema TypingStatus where schema = - object "TypingData" $ + object $ field "status" typingStatusSchema typingStatusSchema :: ValueSchema NamedSwaggerDoc TypingStatus typingStatusSchema = - enum @Text "TypingStatus" $ + enum @Text $ element "started" StartedTyping <> element "stopped" StoppedTyping diff --git a/libs/wire-api/src/Wire/API/CustomBackend.hs b/libs/wire-api/src/Wire/API/CustomBackend.hs index f7c12e0140..42c7a0997e 100644 --- a/libs/wire-api/src/Wire/API/CustomBackend.hs +++ b/libs/wire-api/src/Wire/API/CustomBackend.hs @@ -40,7 +40,7 @@ data CustomBackend = CustomBackend instance ToSchema CustomBackend where schema = - objectWithDocModifier "CustomBackend" (description ?~ "Description of a custom backend") $ + objectWithDocModifier (description ?~ "Description of a custom backend") $ CustomBackend <$> backendConfigJsonUrl .= fieldWithDocModifier "config_json_url" (description ?~ "the location of the custom backend's config.json file") schema <*> backendWebappWelcomeUrl .= fieldWithDocModifier "webapp_welcome_url" (description ?~ "the location of the custom webapp") schema diff --git a/libs/wire-api/src/Wire/API/EnterpriseLogin.hs b/libs/wire-api/src/Wire/API/EnterpriseLogin.hs index 567de7155c..19aecc414b 100644 --- a/libs/wire-api/src/Wire/API/EnterpriseLogin.hs +++ b/libs/wire-api/src/Wire/API/EnterpriseLogin.hs @@ -87,7 +87,7 @@ domainRedirectTag PreAuthorized = PreAuthorizedTag instance ToSchema DomainRedirectTag where schema = - enum @Text "DomainRedirect Tag" $ + enum @Text $ mconcat [ element "none" NoneTag, element "locked" LockedTag, @@ -146,7 +146,7 @@ domainRedirectSchema v = backendConfigObjectSchema :: ValueSchema NamedSwaggerDoc (HttpsUrl, Maybe HttpsUrl) backendConfigObjectSchema = - object "BackendConfig" $ + object $ (,) <$> fst .= field "config_url" schema <*> snd .= maybe_ (optField "webapp_url" schema) @@ -155,7 +155,7 @@ samlIdPIdObjectSchema :: ObjectSchema SwaggerDoc SAML.IdPId samlIdPIdObjectSchema = SAML.IdPId <$> SAML.fromIdPId .= field "sso_code" uuidSchema instance ToSchema DomainRedirect where - schema = object "DomainRedirect " (domainRedirectSchema V10) + schema = object (domainRedirectSchema V10) deriving via (Schema DomainRedirect) instance FromJSON DomainRedirect @@ -184,7 +184,7 @@ data TeamInviteTag instance ToSchema TeamInviteTag where schema = - enum @Text "TeamInvite Tag" $ + enum @Text $ mconcat [ element "allowed" AllowedTag, element "not-allowed" NotAllowedTag, @@ -214,7 +214,7 @@ teamInviteObjectSchema = TeamTag -> tag _Team (field "team" schema) instance ToSchema TeamInvite where - schema = object "TeamInvite" teamInviteObjectSchema + schema = object teamInviteObjectSchema deriving via (Schema TeamInvite) instance FromJSON TeamInvite @@ -255,7 +255,7 @@ instance Arbitrary DomainRegistrationUpdate where instance ToSchema DomainRegistrationUpdate where schema = - object "DomainRegistrationUpdate" $ + object $ DomainRegistrationUpdate <$> (.domainRedirect) .= domainRedirectSchema V10 <*> (.teamInvite) .= teamInviteObjectSchema @@ -275,7 +275,7 @@ mkDomainRegistrationResponse DomainRegistration {..} = DomainRegistrationRespons instance (Typeable v, SingI v) => ToSchema (DomainRegistrationResponse v) where schema = - object "DomainRegistrationResponse" $ + object $ DomainRegistrationResponse <$> (.domain) .= field "domain" schema <*> (.authorizedTeam) .= maybe_ (optField "authorized_team" schema) diff --git a/libs/wire-api/src/Wire/API/Error.hs b/libs/wire-api/src/Wire/API/Error.hs index a1899f9f6c..76aa9c0517 100644 --- a/libs/wire-api/src/Wire/API/Error.hs +++ b/libs/wire-api/src/Wire/API/Error.hs @@ -144,7 +144,7 @@ dynError = dynError' $ seSing @e staticErrorSchema :: SStaticError e -> ValueSchema NamedSwaggerDoc (SStaticError e) staticErrorSchema e@(SStaticError c l m) = - objectWithDocModifier "Error" addExample $ + objectWithDocModifier addExample $ SStaticError <$> (c <$ (const code .= field "code" codeSchema)) <*> (l <$ (const label .= field "label" labelSchema)) @@ -157,9 +157,9 @@ staticErrorSchema e@(SStaticError c l m) = addExample = S.schema . S.example ?~ A.toJSON e labelSchema :: ValueSchema SwaggerDoc Text - labelSchema = unnamed $ enum @Text "Label" (element label label) + labelSchema = unnamed $ enum @Text (element label label) codeSchema :: ValueSchema SwaggerDoc Natural - codeSchema = unnamed $ enum @Natural "Status" (element code code) + codeSchema = unnamed $ enum @Natural (element code code) instance (KnownError e) => ToSchema (SStaticError e) where schema = staticErrorSchema seSing diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index 0ce4976f73..7c57f12f1a 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -531,7 +531,7 @@ nonFederatingBackendsFromList domains = instance ToSchema NonFederatingBackends where schema = - object "NonFederatingBackends" $ + object $ withParser (nonFederatingBackendsToList .= field "non_federating_backends" (array schema)) nonFederatingBackendsFromList @@ -575,7 +575,7 @@ unreachableBackendsStatus = HTTP.mkStatus 533 "Unreachable backends" instance ToSchema UnreachableBackends where schema = - object "UnreachableBackends" $ + object $ UnreachableBackends <$> (.backends) .= field "unreachable_backends" (array schema) @@ -651,14 +651,14 @@ instance APIError GroupInfoDiagnostics where indexedClientSchema :: ValueSchema NamedSwaggerDoc (Int, ClientIdentity) indexedClientSchema = - object "IndexedClient" $ + object $ (,) <$> fst .= field "index" schema <*> snd .= field "client" schema instance ToSchema GroupInfoDiagnostics where schema = - object "GroupInfoDiagnostics" $ + object $ GroupInfoDiagnostics <$> (.commit) .= field "commit" base64Schema <*> (.groupInfo) .= field "group_info" base64Schema @@ -717,7 +717,7 @@ mlsOutOfSyncErrorObjectSchema = <$> (.missingUsers) .= field "missing_users" (array schema) instance ToSchema MLSOutOfSyncError where - schema = object "MLSOutOfSyncError" mlsOutOfSyncErrorObjectSchema + schema = object mlsOutOfSyncErrorObjectSchema instance IsSwaggerError MLSOutOfSyncError where addToOpenApi = diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index af2b35abf2..513831b56c 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -119,7 +119,7 @@ data EventVia = EventViaUserAction | EventViaSCIM instance ToSchema EventVia where schema = - enum @Text "EventVia" $ + enum @Text $ mconcat [ element "scim" EventViaSCIM, element "user" EventViaUserAction @@ -197,7 +197,7 @@ data EventType instance ToSchema EventType where schema = - enum @Text "EventType" $ + enum @Text $ mconcat [ element "conversation.member-join" MemberJoin, element "conversation.member-leave" MemberLeave, @@ -326,7 +326,7 @@ data MembersJoin = MembersJoin instance ToSchema MembersJoin where schema = - object "MembersJoin" $ + object $ MembersJoin <$> mMembers .= field "users" (array schema) <* (fmap smId . mMembers) @@ -353,7 +353,7 @@ smId = qUnqualified . smQualifiedId instance ToSchema SimpleMember where schema = - object "SimpleMember" $ + object $ SimpleMember <$> smQualifiedId .= field "qualified_id" schema <* smId .= optional (field "id" schema) @@ -374,7 +374,7 @@ data Connect = Connect deriving (FromJSON, ToJSON, S.ToSchema) via Schema Connect instance ToSchema Connect where - schema = object "Connect" connectObjectSchema + schema = object connectObjectSchema connectObjectSchema :: ObjectSchema SwaggerDoc Connect connectObjectSchema = @@ -406,7 +406,7 @@ data MemberUpdateData = MemberUpdateData deriving (FromJSON, ToJSON, S.ToSchema) via Schema MemberUpdateData instance ToSchema MemberUpdateData where - schema = object "MemberUpdateData" memberUpdateDataObjectSchema + schema = object memberUpdateDataObjectSchema memberUpdateDataObjectSchema :: ObjectSchema SwaggerDoc MemberUpdateData memberUpdateDataObjectSchema = @@ -475,7 +475,7 @@ data ConversationReset = ConversationReset instance ToSchema ConversationReset where schema = - object "ConversationReset" $ + object $ ConversationReset <$> (.groupId) .= field "group_id" schema <*> (.newGroupId) .= maybe_ (optField "new_group_id" schema) @@ -518,11 +518,11 @@ taggedEventDataSchema = memberLeaveSchema :: ValueSchema NamedSwaggerDoc (EdMemberLeftReason, QualifiedUserIdList) memberLeaveSchema = - object "QualifiedUserIdList_with_EdMemberLeftReason" $ + object $ (,) <$> fst .= field "reason" schema <*> snd .= qualifiedUserIdListObjectSchema instance ToSchema Event where - schema = object "Event" eventObjectSchema + schema = object eventObjectSchema eventObjectSchema :: ObjectSchema SwaggerDoc Event eventObjectSchema = @@ -590,7 +590,7 @@ data CellsEventType instance ToSchema CellsEventType where schema = - enum @Text "CellsEventType" $ + enum @Text $ mconcat [ element "conversation.create" CellsConvCreate ] @@ -599,7 +599,7 @@ makePrisms ''CellsEventData instance ToSchema CellsEvent where schema = - object "CellsEvent" $ + object $ mk <$> (cellsEventType &&& cellsEventData) .= taggedCellsEventDataSchema <*> convId .= field "qualified_conversation" schema diff --git a/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs b/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs index 86e899acfa..b1762b0730 100644 --- a/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs +++ b/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs @@ -76,7 +76,7 @@ data EventType = Update instance ToSchema EventType where schema = - enum @Text "EventType" $ + enum @Text $ mconcat [ element "feature-config.update" Update ] @@ -91,7 +91,7 @@ eventObjectSchema = instance ToSchema Event where schema = - object "Event" eventObjectSchema + object eventObjectSchema instance ToJSONObject Event where toJSONObject = diff --git a/libs/wire-api/src/Wire/API/Event/Federation.hs b/libs/wire-api/src/Wire/API/Event/Federation.hs index 82c3d7362d..8db1c6da68 100644 --- a/libs/wire-api/src/Wire/API/Event/Federation.hs +++ b/libs/wire-api/src/Wire/API/Event/Federation.hs @@ -51,7 +51,7 @@ data EventType instance ToSchema EventType where schema = - enum @Text "EventType" $ + enum @Text $ mconcat [ element "federation.delete" FederationDelete ] @@ -63,7 +63,7 @@ eventObjectSchema = <*> _eventDomain .= field "domain" schema instance ToSchema Event where - schema = object "Event" eventObjectSchema + schema = object eventObjectSchema instance ToJSONObject Event where toJSONObject = diff --git a/libs/wire-api/src/Wire/API/Event/LeaveReason.hs b/libs/wire-api/src/Wire/API/Event/LeaveReason.hs index e01e7ab029..c389f42e9e 100644 --- a/libs/wire-api/src/Wire/API/Event/LeaveReason.hs +++ b/libs/wire-api/src/Wire/API/Event/LeaveReason.hs @@ -38,7 +38,7 @@ data EdMemberLeftReason instance ToSchema EdMemberLeftReason where schema = - enum @Text "EdMemberLeftReason" $ + enum @Text $ mconcat [ element "left" EdReasonLeft, element "user-deleted" EdReasonDeleted, diff --git a/libs/wire-api/src/Wire/API/Event/Team.hs b/libs/wire-api/src/Wire/API/Event/Team.hs index 6c24a9f014..e81b6e8b75 100644 --- a/libs/wire-api/src/Wire/API/Event/Team.hs +++ b/libs/wire-api/src/Wire/API/Event/Team.hs @@ -64,7 +64,7 @@ data Event = Event instance ToSchema Event where schema = - object "Event" $ + object $ Event <$> _eventTeam .= field "team" schema <*> _eventTime .= field "time" utcTimeSchema @@ -132,7 +132,7 @@ data EventType instance ToSchema EventType where schema = - enum @Text "EventType" $ + enum @Text $ mconcat [ element "team.create" TeamCreate, element "team.delete" TeamDelete, @@ -167,7 +167,7 @@ data EventData -- FUTUREWORK: this is outright wrong; see "Wire.API.Event.Conversation" on how to do this properly. instance ToSchema EventData where schema = - object "EventData" $ + object $ EdTeamCreate <$> (undefined :: EventData -> Team) .= field "team" schema diff --git a/libs/wire-api/src/Wire/API/Event/WebSocketProtocol.hs b/libs/wire-api/src/Wire/API/Event/WebSocketProtocol.hs index 493e029cb0..9d726ddbb8 100644 --- a/libs/wire-api/src/Wire/API/Event/WebSocketProtocol.hs +++ b/libs/wire-api/src/Wire/API/Event/WebSocketProtocol.hs @@ -42,7 +42,7 @@ data AckData = AckData instance ToSchema AckData where schema = - object "AckData" $ + object $ AckData <$> (.deliveryTag) .= field "delivery_tag" schema <*> multiple .= field "multiple" schema @@ -57,7 +57,7 @@ data EventData = EventData instance ToSchema EventData where schema = - object "EventData" $ + object $ EventData <$> event .= field "event" schema <*> (.deliveryTag) .= field "delivery_tag" schema @@ -72,7 +72,7 @@ data SynchronizationData = SynchronizationData instance ToSchema SynchronizationData where schema = - object "SynchronizationData " $ + object $ SynchronizationData <$> markerId .= field "marker_id" schema <*> (.deliveryTag) .= field "delivery_tag" schema @@ -103,7 +103,7 @@ data MessageTypeServerToClient = MsgTypeEventMessage | MsgTypeEventFullSync | Ms msgTypeSchemaServerToClient :: ValueSchema NamedSwaggerDoc MessageTypeServerToClient msgTypeSchemaServerToClient = - enum @Text "MessageTypeServerToClient" $ + enum @Text $ mconcat $ [ element "event" MsgTypeEventMessage, element "notifications_missed" MsgTypeEventFullSync, @@ -112,7 +112,7 @@ msgTypeSchemaServerToClient = instance ToSchema MessageServerToClient where schema = - object "MessageServerToClient" $ + object $ fromTagged <$> toTagged .= bind (fst .= field "type" msgTypeSchemaServerToClient) (snd .= untaggedSchema) where toTagged :: MessageServerToClient -> (MessageTypeServerToClient, MessageServerToClient) @@ -142,7 +142,7 @@ data MessageTypeClientToServer = MsgTypeAckMessage | MsgTypeAckFullSync msgTypeSchemaClientToServer :: ValueSchema NamedSwaggerDoc MessageTypeClientToServer msgTypeSchemaClientToServer = - enum @Text "MessageTypeClientToServer" $ + enum @Text $ mconcat $ [ element "ack" MsgTypeAckMessage, element "ack_full_sync" MsgTypeAckFullSync @@ -150,7 +150,7 @@ msgTypeSchemaClientToServer = instance ToSchema MessageClientToServer where schema = - object "MessageClientToServer" $ + object $ fromTagged <$> toTagged .= bind (fst .= field "type" msgTypeSchemaClientToServer) (snd .= untaggedSchema) where toTagged :: MessageClientToServer -> (MessageTypeClientToServer, MessageClientToServer) diff --git a/libs/wire-api/src/Wire/API/FederationStatus.hs b/libs/wire-api/src/Wire/API/FederationStatus.hs index 8fd4dc3acb..b3aeccd5f6 100644 --- a/libs/wire-api/src/Wire/API/FederationStatus.hs +++ b/libs/wire-api/src/Wire/API/FederationStatus.hs @@ -43,7 +43,7 @@ newtype RemoteDomains = RemoteDomains instance ToSchema RemoteDomains where schema = - objectWithDocModifier "RemoteDomains" (description ?~ "A set of remote domains") $ + objectWithDocModifier (description ?~ "A set of remote domains") $ RemoteDomains <$> (Set.map tDomain . rdDomains) .= field "domains" (Set.map (flip toRemoteUnsafe ()) <$> set schema) diff --git a/libs/wire-api/src/Wire/API/History.hs b/libs/wire-api/src/Wire/API/History.hs index 2462741fb3..59cd724771 100644 --- a/libs/wire-api/src/Wire/API/History.hs +++ b/libs/wire-api/src/Wire/API/History.hs @@ -109,7 +109,7 @@ instance ToSchema History where instance ToSchema HistorySharingConfig where schema = - object "HistorySharingConfig" $ + object $ HistorySharingConfig <$> (.depth) .= field "depth" schema diff --git a/libs/wire-api/src/Wire/API/Internal/BulkPush.hs b/libs/wire-api/src/Wire/API/Internal/BulkPush.hs index 0ffb9eec61..3dc67c1177 100644 --- a/libs/wire-api/src/Wire/API/Internal/BulkPush.hs +++ b/libs/wire-api/src/Wire/API/Internal/BulkPush.hs @@ -40,7 +40,7 @@ data PushTarget = PushTarget instance S.ToSchema PushTarget where schema = - S.object "PushTarget" $ + S.object $ PushTarget <$> ptUserId S..= S.field "user_id" S.schema <*> ptConnId S..= S.field "conn_id" S.schema @@ -57,13 +57,13 @@ newtype BulkPushRequest = BulkPushRequest instance S.ToSchema BulkPushRequest where schema = - S.object "BulkPushRequest" $ + S.object $ BulkPushRequest <$> fromBulkPushRequest S..= S.field "bulkpush_req" (S.array bulkpushReqItemSchema) where bulkpushReqItemSchema :: ValueSchema S.NamedSwaggerDoc (Notification, [PushTarget]) bulkpushReqItemSchema = - S.object "(Notification, [PushTarget])" $ + S.object $ (,) <$> fst S..= S.field "notification" S.schema <*> snd S..= S.field "targets" (S.array S.schema) @@ -74,7 +74,7 @@ data PushStatus = PushStatusOk | PushStatusGone instance S.ToSchema PushStatus where schema = - S.enum @Text "PushStatus" $ + S.enum @Text $ mconcat [ S.element "push_status_ok" PushStatusOk, S.element "push_status_gone" PushStatusGone @@ -92,13 +92,13 @@ newtype BulkPushResponse = BulkPushResponse instance S.ToSchema BulkPushResponse where schema = - S.object "BulkPushResponse" $ + S.object $ BulkPushResponse <$> fromBulkPushResponse S..= S.field "bulkpush_resp" (S.array bulkPushResponseSchema) where bulkPushResponseSchema :: ValueSchema S.NamedSwaggerDoc (NotificationId, PushTarget, PushStatus) bulkPushResponseSchema = - S.object "(NotificationId, PushTarget, PushStatus)" $ + S.object $ (,,) <$> view _1 S..= S.field "notif_id" S.schema <*> view _2 S..= S.field "target" S.schema diff --git a/libs/wire-api/src/Wire/API/Internal/Notification.hs b/libs/wire-api/src/Wire/API/Internal/Notification.hs index 0226b91392..0beefd4621 100644 --- a/libs/wire-api/src/Wire/API/Internal/Notification.hs +++ b/libs/wire-api/src/Wire/API/Internal/Notification.hs @@ -63,7 +63,7 @@ data Notification = Notification instance S.ToSchema Notification where schema = - S.object "Notification" $ + S.object $ Notification <$> ntfId S..= S.field "id" S.schema <*> ntfTransient S..= (fromMaybe False <$> S.optField "transient" S.schema) diff --git a/libs/wire-api/src/Wire/API/MLS/Credential.hs b/libs/wire-api/src/Wire/API/MLS/Credential.hs index d369727f3e..607729eb90 100644 --- a/libs/wire-api/src/Wire/API/MLS/Credential.hs +++ b/libs/wire-api/src/Wire/API/MLS/Credential.hs @@ -103,7 +103,7 @@ cidQualifiedUser = fmap fst . cidQualifiedClient instance ToSchema ClientIdentity where schema = - object "ClientIdentity" $ + object $ ClientIdentity <$> ciDomain .= field "domain" schema <*> ciUser .= field "user_id" schema diff --git a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs index eb736de6ea..1f3e97d109 100644 --- a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs +++ b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs @@ -69,7 +69,7 @@ data KeyPackageUpload = KeyPackageUpload instance ToSchema KeyPackageUpload where schema = - object "KeyPackageUpload" $ + object $ KeyPackageUpload <$> keyPackages .= field "key_packages" (array rawKeyPackageSchema) @@ -100,7 +100,7 @@ data KeyPackageBundleEntry = KeyPackageBundleEntry instance ToSchema KeyPackageBundleEntry where schema = - object "KeyPackageBundleEntry" $ + object $ KeyPackageBundleEntry <$> (.user) .= qualifiedObjectSchema "user" schema <*> (.client) .= field "client" schema @@ -113,7 +113,7 @@ newtype KeyPackageBundle = KeyPackageBundle {entries :: Set KeyPackageBundleEntr instance ToSchema KeyPackageBundle where schema = - object "KeyPackageBundle" $ + object $ KeyPackageBundle <$> (.entries) .= field "key_packages" (set schema) @@ -123,7 +123,7 @@ newtype KeyPackageCount = KeyPackageCount {unKeyPackageCount :: Int} instance ToSchema KeyPackageCount where schema = - object "OwnKeyPackages" $ + object $ KeyPackageCount <$> unKeyPackageCount .= field "count" schema newtype DeleteKeyPackages = DeleteKeyPackages @@ -133,7 +133,7 @@ newtype DeleteKeyPackages = DeleteKeyPackages instance ToSchema DeleteKeyPackages where schema = - object "DeleteKeyPackages" $ + object $ DeleteKeyPackages <$> unDeleteKeyPackages .= field diff --git a/libs/wire-api/src/Wire/API/MLS/Keys.hs b/libs/wire-api/src/Wire/API/MLS/Keys.hs index 238a3f12d1..c40ad6a249 100644 --- a/libs/wire-api/src/Wire/API/MLS/Keys.hs +++ b/libs/wire-api/src/Wire/API/MLS/Keys.hs @@ -43,7 +43,7 @@ data MLSKeysByPurpose a = MLSKeysByPurpose instance (Typeable a, ToSchema a) => ToSchema (MLSKeysByPurpose a) where schema = - object "MLSKeysByPurpose" $ + object $ MLSKeysByPurpose <$> (.removal) .= field "removal" schema @@ -58,7 +58,7 @@ data MLSKeys a = MLSKeys instance (Typeable a, ToSchema a) => ToSchema (MLSKeys a) where schema = - object "MLSKeys" $ + object $ MLSKeys <$> ed25519 .= field "ed25519" schema <*> ecdsa_secp256r1_sha256 .= field "ecdsa_secp256r1_sha256" schema @@ -74,7 +74,7 @@ data MLSPrivateKeys = MLSPrivateKeys instance ToSchema MLSPrivateKeys where schema = - object "MLSPrivateKeys" $ + object $ MLSPrivateKeys <$> (.mlsKeyPair_ed25519) .= field @NamedSwaggerDoc "ed25519" (opaqueSchema "KeyPair Ed25519") <*> (.mlsKeyPair_ecdsa_secp256r1_sha256) .= field @NamedSwaggerDoc "ecdsa_secp256r1_sha256" (opaqueSchema "KeyPair Ecdsa_secp256r1_sha256") @@ -137,7 +137,7 @@ data JWK = JWK instance ToSchema JWK where schema = - object "JWK" $ + object $ JWK <$> (.keyType) .= field "kty" schema <*> (.curve) .= field "crv" schema diff --git a/libs/wire-api/src/Wire/API/MLS/Message.hs b/libs/wire-api/src/Wire/API/MLS/Message.hs index 644e2743d4..544695bee9 100644 --- a/libs/wire-api/src/Wire/API/MLS/Message.hs +++ b/libs/wire-api/src/Wire/API/MLS/Message.hs @@ -370,7 +370,7 @@ data MLSMessageSendingStatus = MLSMessageSendingStatus instance ToSchema MLSMessageSendingStatus where schema = - object "MLSMessageSendingStatus" $ + object $ MLSMessageSendingStatus <$> mmssEvents .= fieldWithDocModifier diff --git a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs index be1199c819..6fbce937da 100644 --- a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs @@ -150,7 +150,7 @@ convOrSubConvIdObjectSchema = instance ToSchema ConvOrSubConvId where schema = - object "ConvOrSubConvId" $ + object $ fromTagged <$> toTagged .= bind @@ -182,7 +182,7 @@ instance ToSchema ConvOrSubConvId where tagSchema :: ValueSchema NamedSwaggerDoc ConvOrSubTag tagSchema = - enum @Text "ConvOrSubTag" $ + enum @Text $ mconcat [ element "conv" ConvTag, element "subconv" SubConvTag diff --git a/libs/wire-api/src/Wire/API/Meeting.hs b/libs/wire-api/src/Wire/API/Meeting.hs index 6c1057efe3..44e2c95655 100644 --- a/libs/wire-api/src/Wire/API/Meeting.hs +++ b/libs/wire-api/src/Wire/API/Meeting.hs @@ -52,7 +52,7 @@ data Meeting = Meeting instance ToSchema Meeting where schema = - objectWithDocModifier "Meeting" (description ?~ "A scheduled meeting") $ + objectWithDocModifier (description ?~ "A scheduled meeting") $ Meeting <$> (.id) .= field "qualified_id" schema <*> (.title) .= field "title" schema @@ -95,7 +95,7 @@ data Frequency = Daily | Weekly | Monthly | Yearly instance ToSchema Frequency where schema = - enum @Text "Frequency" $ + enum @Text $ mconcat [ element "daily" Daily, element "weekly" Weekly, @@ -105,7 +105,7 @@ instance ToSchema Frequency where instance ToSchema NewMeeting where schema = - objectWithDocModifier "NewMeeting" (description ?~ "Request to create a new meeting") $ + objectWithDocModifier (description ?~ "Request to create a new meeting") $ NewMeeting <$> (.startTime) .= field "start_time" utcTimeSchema <*> (.endTime) .= field "end_time" utcTimeSchema @@ -127,7 +127,7 @@ data UpdateMeeting = UpdateMeeting instance ToSchema UpdateMeeting where schema = - objectWithDocModifier "UpdateMeeting" (description ?~ "Request to update a meeting") $ + objectWithDocModifier (description ?~ "Request to update a meeting") $ UpdateMeeting <$> (.startTime) .= maybe_ (optField "start_time" utcTimeSchema) <*> (.endTime) .= maybe_ (optField "end_time" utcTimeSchema) @@ -136,7 +136,7 @@ instance ToSchema UpdateMeeting where instance ToSchema Recurrence where schema = - objectWithDocModifier "Recurrence" (description ?~ "Recurrence pattern for meetings") $ + objectWithDocModifier (description ?~ "Recurrence pattern for meetings") $ Recurrence <$> (.freq) .= field "frequency" schema <*> (.interval) .= (fromMaybe 1 <$> optField "interval" schema) @@ -152,7 +152,7 @@ newtype MeetingEmailsInvitation = MeetingEmailsInvitation instance ToSchema MeetingEmailsInvitation where schema = - objectWithDocModifier "MeetingEmailsInvitation" (description ?~ "Emails invitation") $ + objectWithDocModifier (description ?~ "Emails invitation") $ MeetingEmailsInvitation <$> (.emails) .= field "emails" (array schema) diff --git a/libs/wire-api/src/Wire/API/Message.hs b/libs/wire-api/src/Wire/API/Message.hs index 85cdda1890..c5f98ce553 100644 --- a/libs/wire-api/src/Wire/API/Message.hs +++ b/libs/wire-api/src/Wire/API/Message.hs @@ -108,7 +108,7 @@ messageMetadataObjectSchema = <*> mmData .= maybe_ (optField "data" schema) instance ToSchema MessageMetadata where - schema = object "MessageMetadata" messageMetadataObjectSchema + schema = object messageMetadataObjectSchema defMessageMetadata :: MessageMetadata defMessageMetadata = @@ -146,7 +146,7 @@ newOtrMessageMetadata msg = instance ToSchema NewOtrMessage where schema = - object "new-otr-message" $ + object $ mk <$> newOtrSender .= field "sender" schema <*> newOtrRecipients .= field "recipients" schema @@ -298,7 +298,7 @@ data Priority = LowPriority | HighPriority instance ToSchema Priority where schema = - enum @Text "Priority" $ + enum @Text $ mconcat [ element "low" LowPriority, element "high" HighPriority @@ -487,7 +487,7 @@ instance Arbitrary ClientMismatch where instance ToSchema ClientMismatch where schema = - object "ClientMismatch" $ + object $ ClientMismatch <$> cmismatchTime .= field "time" schema <*> missingClients .= field "missing" schema diff --git a/libs/wire-api/src/Wire/API/Notification.hs b/libs/wire-api/src/Wire/API/Notification.hs index d3b5a40511..69b53bd9c9 100644 --- a/libs/wire-api/src/Wire/API/Notification.hs +++ b/libs/wire-api/src/Wire/API/Notification.hs @@ -134,7 +134,7 @@ queuedNotification = QueuedNotification instance ToSchema QueuedNotification where schema = - objectWithDocModifier "QueuedNotification" queuedNotificationDoc $ + objectWithDocModifier queuedNotificationDoc $ QueuedNotification <$> _queuedNotificationId .= field "id" schema @@ -160,7 +160,7 @@ queuedNotificationList = QueuedNotificationList instance ToSchema QueuedNotificationList where schema = - objectWithDocModifier "QueuedNotificationList" queuedNotificationListDoc $ + objectWithDocModifier queuedNotificationListDoc $ QueuedNotificationList <$> _queuedNotifications .= fieldWithDocModifier "notifications" notificationsDoc (array schema) @@ -205,7 +205,7 @@ newtype ServerTime = ServerTime {getServerTime :: UTCTime} instance ToSchema ServerTime where schema = - objectWithDocModifier "ServerTime" serverTimeDoc $ + objectWithDocModifier serverTimeDoc $ ServerTime <$> getServerTime .= field "time" utcTimeSchema where diff --git a/libs/wire-api/src/Wire/API/OAuth.hs b/libs/wire-api/src/Wire/API/OAuth.hs index 97c8d0bc22..a3ff2db153 100644 --- a/libs/wire-api/src/Wire/API/OAuth.hs +++ b/libs/wire-api/src/Wire/API/OAuth.hs @@ -107,7 +107,7 @@ data OAuthClientConfig = OAuthClientConfig instance ToSchema OAuthClientConfig where schema = - object "OAuthClientConfig" $ + object $ OAuthClientConfig <$> applicationName .= fieldWithDocModifier "application_name" applicationNameDescription schema @@ -146,7 +146,7 @@ data OAuthClientCredentials = OAuthClientCredentials instance ToSchema OAuthClientCredentials where schema = - object "OAuthClientCredentials" $ + object $ OAuthClientCredentials <$> (.clientId) .= fieldWithDocModifier "client_id" clientIdDescription schema @@ -167,7 +167,7 @@ data OAuthClient = OAuthClient instance ToSchema OAuthClient where schema = - object "OAuthClient" $ + object $ OAuthClient <$> (.clientId) .= field "client_id" schema @@ -184,7 +184,7 @@ data OAuthResponseType = OAuthResponseTypeCode instance ToSchema OAuthResponseType where schema :: ValueSchema NamedSwaggerDoc OAuthResponseType schema = - enum @Text "OAuthResponseType" $ + enum @Text $ mconcat [ element "code" OAuthResponseTypeCode ] @@ -263,7 +263,7 @@ data CodeChallengeMethod = S256 instance ToSchema CodeChallengeMethod where schema :: ValueSchema NamedSwaggerDoc CodeChallengeMethod schema = - enum @Text "CodeChallengeMethod" $ + enum @Text $ mconcat [ element "S256" S256 ] @@ -326,7 +326,7 @@ data CreateOAuthAuthorizationCodeRequest = CreateOAuthAuthorizationCodeRequest instance ToSchema CreateOAuthAuthorizationCodeRequest where schema = - object "CreateOAuthAuthorizationCodeRequest" $ + object $ CreateOAuthAuthorizationCodeRequest <$> (.clientId) .= fieldWithDocModifier "client_id" clientIdDescription schema @@ -379,7 +379,7 @@ data OAuthGrantType = OAuthGrantTypeAuthorizationCode | OAuthGrantTypeRefreshTok instance ToSchema OAuthGrantType where schema = - enum @Text "OAuthGrantType" $ + enum @Text $ mconcat [ element "authorization_code" OAuthGrantTypeAuthorizationCode, element "refresh_token" OAuthGrantTypeRefreshToken @@ -417,7 +417,7 @@ data OAuthAccessTokenRequest = OAuthAccessTokenRequest instance ToSchema OAuthAccessTokenRequest where schema = - object "OAuthAccessTokenRequest" $ + object $ OAuthAccessTokenRequest <$> (.grantType) .= fieldWithDocModifier "grant_type" grantTypeDescription schema @@ -462,7 +462,7 @@ data OAuthAccessTokenType = OAuthAccessTokenTypeBearer instance ToSchema OAuthAccessTokenType where schema = - enum @Text "OAuthAccessTokenType" $ + enum @Text $ mconcat [ element "Bearer" OAuthAccessTokenTypeBearer ] @@ -516,7 +516,7 @@ data OAuthAccessTokenResponse = OAuthAccessTokenResponse instance ToSchema OAuthAccessTokenResponse where schema = - object "OAuthAccessTokenResponse" $ + object $ OAuthAccessTokenResponse <$> accessToken .= fieldWithDocModifier "access_token" accessTokenDescription schema @@ -593,7 +593,7 @@ data OAuthRefreshAccessTokenRequest = OAuthRefreshAccessTokenRequest instance ToSchema OAuthRefreshAccessTokenRequest where schema :: ValueSchema NamedSwaggerDoc OAuthRefreshAccessTokenRequest schema = - object "OAuthRefreshAccessTokenRequest" $ + object $ OAuthRefreshAccessTokenRequest <$> (.grantType) .= fieldWithDocModifier "grant_type" grantTypeDescription schema @@ -640,7 +640,7 @@ data OAuthRevokeRefreshTokenRequest = OAuthRevokeRefreshTokenRequest instance ToSchema OAuthRevokeRefreshTokenRequest where schema = - object "OAuthRevokeRefreshTokenRequest" $ + object $ OAuthRevokeRefreshTokenRequest <$> (.clientId) .= fieldWithDocModifier "client_id" clientIdDescription schema @@ -660,7 +660,7 @@ data OAuthSession = OAuthSession instance ToSchema OAuthSession where schema = - object "OAuthSession" $ + object $ OAuthSession <$> (.refreshTokenId) .= fieldWithDocModifier "refresh_token_id" refreshTokenIdDescription schema <*> (.createdAt) .= fieldWithDocModifier "created_at" createdAtDescription schema @@ -679,7 +679,7 @@ data OAuthApplication = OAuthApplication instance ToSchema OAuthApplication where schema = - object "OAuthApplication" $ + object $ OAuthApplication <$> applicationId .= fieldWithDocModifier "id" idDescription schema <*> (.name) .= fieldWithDocModifier "name" nameDescription schema diff --git a/libs/wire-api/src/Wire/API/Pagination.hs b/libs/wire-api/src/Wire/API/Pagination.hs index 8fae686b1f..cfa9d158cd 100644 --- a/libs/wire-api/src/Wire/API/Pagination.hs +++ b/libs/wire-api/src/Wire/API/Pagination.hs @@ -52,7 +52,7 @@ instance Arbitrary SortOrder where instance ToSchema SortOrder where schema = - enum @Text "SortOrder" $ + enum @Text $ mconcat [ element "asc" Asc, element "desc" Desc @@ -127,7 +127,7 @@ instance Default SortBy where instance ToSchema SortBy where schema = - enum @Text "SortBy" $ + enum @Text $ mconcat [ element "name" SortByName, element "created_at" SortByCreatedAt diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index dfb16d1d25..8289725834 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -106,7 +106,7 @@ newtype PasswordReqBody = PasswordReqBody instance ToSchema PasswordReqBody where schema = - object "PasswordReqBody" $ + object $ PasswordReqBody <$> fromPasswordReqBody .= maybe_ (optField "password" schema) diff --git a/libs/wire-api/src/Wire/API/Presence.hs b/libs/wire-api/src/Wire/API/Presence.hs index 561e3b92f9..427e0a0f8a 100644 --- a/libs/wire-api/src/Wire/API/Presence.hs +++ b/libs/wire-api/src/Wire/API/Presence.hs @@ -86,7 +86,7 @@ data Presence = Presence instance ToSchema Presence where schema = - object "Presence" $ + object $ ( Presence <$> userId .= field "user_id" schema <*> connId .= field "device_id" schema diff --git a/libs/wire-api/src/Wire/API/Provider.hs b/libs/wire-api/src/Wire/API/Provider.hs index fbde37da2c..2bc09542b0 100644 --- a/libs/wire-api/src/Wire/API/Provider.hs +++ b/libs/wire-api/src/Wire/API/Provider.hs @@ -82,7 +82,7 @@ data Provider = Provider instance ToSchema Provider where schema = - object "Provider" $ + object $ Provider <$> providerId .= field "id" schema <*> providerName .= field "name" schema @@ -115,7 +115,7 @@ data NewProvider = NewProvider instance ToSchema NewProvider where schema = - object "NewProvider" $ + object $ NewProvider <$> newProviderName .= field "name" schema <*> newProviderEmail .= field "email" schema @@ -136,7 +136,7 @@ data NewProviderResponse = NewProviderResponse instance ToSchema NewProviderResponse where schema = - object "NewProviderResponse" $ + object $ NewProviderResponse <$> rsNewProviderId .= field "id" schema <*> rsNewProviderPassword .= maybe_ (optField "password" schema) @@ -156,7 +156,7 @@ data UpdateProvider = UpdateProvider instance ToSchema UpdateProvider where schema = - object "UpdateProvider" $ + object $ UpdateProvider <$> updateProviderName .= maybe_ (optField "name" schema) <*> updateProviderUrl .= maybe_ (optField "url" schema) @@ -175,7 +175,7 @@ newtype ProviderActivationResponse = ProviderActivationResponse instance ToSchema ProviderActivationResponse where schema = - object "ProviderActivationResponse" $ + object $ ProviderActivationResponse <$> activatedProviderIdentity .= field "email" schema @@ -193,7 +193,7 @@ data ProviderLogin = ProviderLogin instance ToSchema ProviderLogin where schema = - object "ProviderLogin" $ + object $ ProviderLogin <$> providerLoginEmail .= field "email" schema <*> providerLoginPassword .= field "password" schema @@ -211,7 +211,7 @@ newtype DeleteProvider = DeleteProvider instance ToSchema DeleteProvider where schema = - object "DeleteProvider" $ + object $ DeleteProvider <$> deleteProviderPassword .= field "password" schema @@ -226,7 +226,7 @@ newtype PasswordReset = PasswordReset {email :: EmailAddress} instance ToSchema PasswordReset where schema = - object "PasswordReset" $ + object $ PasswordReset <$> (.email) .= field "email" schema @@ -242,7 +242,7 @@ data CompletePasswordReset = CompletePasswordReset instance ToSchema CompletePasswordReset where schema = - object "CompletePasswordReset" $ + object $ CompletePasswordReset <$> key .= field "key" schema <*> (.code) .= field "code" schema @@ -259,7 +259,7 @@ data PasswordChange = PasswordChange instance ToSchema PasswordChange where schema = - object "PasswordChange" $ + object $ PasswordChange <$> oldPassword .= field "old_password" schema <*> newPassword .= field "new_password" schema @@ -272,6 +272,6 @@ newtype EmailUpdate = EmailUpdate {email :: EmailAddress} instance ToSchema EmailUpdate where schema = - object "EmailUpdate" $ + object $ EmailUpdate <$> (.email) .= field "email" schema diff --git a/libs/wire-api/src/Wire/API/Provider/Bot.hs b/libs/wire-api/src/Wire/API/Provider/Bot.hs index e8a1f5b1c4..58ab67e6cc 100644 --- a/libs/wire-api/src/Wire/API/Provider/Bot.hs +++ b/libs/wire-api/src/Wire/API/Provider/Bot.hs @@ -56,7 +56,7 @@ data BotConvView = BotConvView instance ToSchema BotConvView where schema = - object "BotConvView" $ + object $ BotConvView <$> _botConvId .= field "id" schema <*> _botConvName .= maybe_ (optField "name" schema) @@ -81,7 +81,7 @@ data BotUserView = BotUserView instance ToSchema BotUserView where schema = - object "BotUserView" $ + object $ BotUserView <$> botUserViewId .= field "id" schema <*> botUserViewName .= field "name" schema diff --git a/libs/wire-api/src/Wire/API/Provider/Service.hs b/libs/wire-api/src/Wire/API/Provider/Service.hs index 979ae525e5..2329ee4c10 100644 --- a/libs/wire-api/src/Wire/API/Provider/Service.hs +++ b/libs/wire-api/src/Wire/API/Provider/Service.hs @@ -90,7 +90,7 @@ data ServiceRef = ServiceRef instance ToSchema ServiceRef where schema = - object "ServiceRef" $ + object $ ServiceRef <$> _serviceRefId .= field "id" schema <*> _serviceRefProvider .= field "provider" schema @@ -118,7 +118,7 @@ data ServiceKey = ServiceKey instance ToSchema ServiceKey where schema = - object "ServiceKey" $ + object $ ServiceKey <$> serviceKeyType .= field "type" schema <*> serviceKeySize .= field "size" schema @@ -167,7 +167,7 @@ data ServiceKeyType instance ToSchema ServiceKeyType where schema = - enum @Text "ServiceKeyType" (element "rsa" RsaServiceKey) + enum @Text (element "rsa" RsaServiceKey) newtype ServiceKeyPEM = ServiceKeyPEM {unServiceKeyPEM :: PEM} deriving stock (Eq, Show) @@ -257,7 +257,7 @@ data Service = Service instance ToSchema Service where schema = - object "Service" $ + object $ Service <$> serviceId .= field "id" schema <*> serviceName .= field "name" schema @@ -304,7 +304,7 @@ data ServiceProfile = ServiceProfile instance ToSchema ServiceProfile where schema = - object "ServiceProfile" $ + object $ ServiceProfile <$> serviceProfileId .= field "id" schema <*> serviceProfileProvider .= field "provider" schema @@ -328,7 +328,7 @@ data ServiceProfilePage = ServiceProfilePage instance ToSchema ServiceProfilePage where schema = - object "ServiceProfilePage" $ + object $ ServiceProfilePage <$> serviceProfilePageHasMore .= field "has_more" schema <*> serviceProfilePageResults .= field "services" (array schema) @@ -353,7 +353,7 @@ data NewService = NewService instance ToSchema NewService where schema = - object "NewService" $ + object $ NewService <$> newServiceName .= field "name" schema <*> newServiceSummary .= field "summary" schema @@ -378,7 +378,7 @@ data NewServiceResponse = NewServiceResponse instance ToSchema NewServiceResponse where schema = - object "NewServiceResponse" $ + object $ NewServiceResponse <$> rsNewServiceId .= field "id" schema <*> rsNewServiceToken .= maybe_ (optField "auth_token" schema) @@ -400,7 +400,7 @@ data UpdateService = UpdateService instance ToSchema UpdateService where schema = - object "UpdateService" $ + object $ UpdateService <$> updateServiceName .= maybe_ (optField "name" schema) <*> updateServiceSummary .= maybe_ (optField "summary" schema) @@ -426,7 +426,7 @@ data UpdateServiceConn = UpdateServiceConn instance ToSchema UpdateServiceConn where schema = - object "UpdateServiceConn" $ + object $ UpdateServiceConn <$> updateServiceConnPassword .= field "password" schema <*> updateServiceConnUrl .= maybe_ (optField "base_url" schema) @@ -449,7 +449,7 @@ newtype DeleteService = DeleteService instance ToSchema DeleteService where schema = - object "DeleteService" $ + object $ DeleteService <$> deleteServicePassword .= field "password" schema @@ -467,7 +467,7 @@ data UpdateServiceWhitelist = UpdateServiceWhitelist instance ToSchema UpdateServiceWhitelist where schema = - object "UpdateServiceWhitelist" $ + object $ UpdateServiceWhitelist <$> updateServiceWhitelistProvider .= field "provider" schema <*> updateServiceWhitelistService .= field "id" schema diff --git a/libs/wire-api/src/Wire/API/Provider/Service/Tag.hs b/libs/wire-api/src/Wire/API/Provider/Service/Tag.hs index b643e7f005..49f8b25ca6 100644 --- a/libs/wire-api/src/Wire/API/Provider/Service/Tag.hs +++ b/libs/wire-api/src/Wire/API/Provider/Service/Tag.hs @@ -191,7 +191,7 @@ instance ToByteString ServiceTag where builder WeatherTag = "weather" instance ToSchema ServiceTag where - schema = enum @Text "ServiceTag" . mconcat $ (\a -> element (decodeUtf8With lenientDecode $ toStrict $ toByteString a) a) <$> [minBound ..] + schema = enum @Text . mconcat $ (\a -> element (decodeUtf8With lenientDecode $ toStrict $ toByteString a) a) <$> [minBound ..] instance S.ToParamSchema ServiceTag where toParamSchema _ = diff --git a/libs/wire-api/src/Wire/API/Push/V2.hs b/libs/wire-api/src/Wire/API/Push/V2.hs index 0d628c892e..d1dde16e5c 100644 --- a/libs/wire-api/src/Wire/API/Push/V2.hs +++ b/libs/wire-api/src/Wire/API/Push/V2.hs @@ -104,7 +104,7 @@ data Route instance ToSchema Route where schema = - enum @Text "Route" $ + enum @Text $ mconcat [ element "any" RouteAny, element "direct" RouteDirect @@ -144,7 +144,7 @@ instance Arbitrary RecipientClients where instance ToSchema Recipient where schema = - object "Recipient" $ + object $ Recipient <$> _recipientId .= field "user_id" schema <*> _recipientRoute .= field "route" schema @@ -224,7 +224,7 @@ apsData lk la = ApsData lk la Nothing True instance ToSchema ApsData where schema = - object "ApsData" $ + object $ ApsData <$> _apsLocKey .= field "loc_key" schema <*> withDefault "loc_args" _apsLocArgs (array schema) [] @@ -305,7 +305,7 @@ singletonPayload = NonEmpty.singleton . toJSONObject instance ToSchema Push where schema = - object "Push" $ + object $ Push <$> _pushRecipients .= field "recipients" (set schema) <*> _pushOrigin .= maybe_ (optField "origin" schema) diff --git a/libs/wire-api/src/Wire/API/Push/V2/Token.hs b/libs/wire-api/src/Wire/API/Push/V2/Token.hs index 29560be5fe..051647b5cb 100644 --- a/libs/wire-api/src/Wire/API/Push/V2/Token.hs +++ b/libs/wire-api/src/Wire/API/Push/V2/Token.hs @@ -71,7 +71,7 @@ newtype PushTokenList = PushTokenList instance ToSchema PushTokenList where schema = - objectWithDocModifier "PushTokenList" (description ?~ "List of Native Push Tokens") $ + objectWithDocModifier (description ?~ "List of Native Push Tokens") $ PushTokenList <$> pushTokens .= fieldWithDocModifier "tokens" (description ?~ "Push tokens") (array schema) @@ -91,7 +91,7 @@ pushToken = PushToken instance ToSchema PushToken where schema = - objectWithDocModifier "PushToken" desc $ + objectWithDocModifier desc $ PushToken <$> _tokenTransport .= fieldWithDocModifier "transport" transDesc schema @@ -123,7 +123,7 @@ data Transport instance ToSchema Transport where schema = - enum @Text "Transport" $ + enum @Text $ mconcat [ element "GCM" GCM, element "APNS" APNS, diff --git a/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs b/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs index 6b5463bfdb..54628fc6dc 100644 --- a/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs +++ b/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs @@ -56,12 +56,12 @@ deriving via Schema FederationRestriction instance (ToJSON FederationRestriction tagSchema :: ValueSchema NamedSwaggerDoc FederationRestrictionTag tagSchema = - enum @Text "FederationRestrictionTag" $ + enum @Text $ mconcat [element "allow_all" FederationRestrictionAllowAllTag, element "restrict_by_team" FederationRestrictionByTeamTag] instance ToSchema FederationRestriction where schema = - object "FederationRestriction" $ + object $ fromTagged <$> toTagged .= bind @@ -93,7 +93,7 @@ data FederationDomainConfig = FederationDomainConfig instance ToSchema FederationDomainConfig where schema = - object "FederationDomainConfig" $ + object $ FederationDomainConfig <$> domain .= field "domain" schema <*> searchPolicy .= field "search_policy" schema @@ -140,7 +140,7 @@ data FederationStrategy instance ToSchema FederationStrategy where schema = - enum @Text "FederationStrategy" $ + enum @Text $ mconcat [ element "allowNone" AllowNone, element "allowAll" AllowAll, @@ -156,6 +156,6 @@ newtype FederationRemoteTeam = FederationRemoteTeam instance ToSchema FederationRemoteTeam where schema = - object "FederationRemoteTeam" $ + object $ FederationRemoteTeam <$> teamId .= field "team_id" schema diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 1317d0b93a..893f4ea052 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -134,7 +134,7 @@ instance Default GetBy where instance ToSchema GetBy where schema = - object "GetBy" $ + object $ GetBy <$> (.includePendingInvitations) .= field "include_pending_invitations" schema <*> (.includeUsersWithExpiredInvitations) .= field "include_users_with_expired_invitations" schema @@ -173,7 +173,7 @@ data CreateGroupInternalRequest = CreateGroupInternalRequest instance ToSchema CreateGroupInternalRequest where schema = - object "CreateGroupInternalRequest" $ + object $ CreateGroupInternalRequest <$> (.managedBy) .= field "managed_by" schema <*> (.teamId) .= field "team_id" schema @@ -193,7 +193,7 @@ data UpdateGroupInternalRequest = UpdateGroupInternalRequest instance ToSchema UpdateGroupInternalRequest where schema = - object "UpdateGroupInternalRequest" $ + object $ UpdateGroupInternalRequest <$> (.teamId) .= field "team_id" schema <*> (.groupId) .= field "group_id" schema @@ -660,7 +660,7 @@ data NewKeyPackageRef = NewKeyPackageRef instance ToSchema NewKeyPackageRef where schema = - object "NewKeyPackageRef" $ + object $ NewKeyPackageRef <$> nkprUserId .= field "user_id" schema <*> nkprClientId .= field "client_id" schema @@ -796,7 +796,7 @@ newtype FoundInvitationCode = FoundInvitationCode {getFoundInvitationCode :: Use instance ToSchema FoundInvitationCode where schema = FoundInvitationCode - <$> getFoundInvitationCode .= object "FoundInvitationCode" (field "code" (schema @User.InvitationCode)) + <$> getFoundInvitationCode .= object (field "code" (schema @User.InvitationCode)) type SuspendTeam = Named @@ -1027,7 +1027,7 @@ makePrisms ''IdpChangedNotification instance Data.Schema.ToSchema IdpChangedNotification where schema = - object "IdpChangedNotification" $ + object $ fromTagged <$> toTagged .= bind @@ -1049,26 +1049,26 @@ instance Data.Schema.ToSchema IdpChangedNotification where tagSchema :: ValueSchema NamedSwaggerDoc IdpChangedNotificationTag tagSchema = - enum @Text "Detail Tag" $ + enum @Text $ mconcat [element "created" IdPCreatedTag, element "deleted" IdPDeletedTag, element "updated" IdPUpdatedTag] createdSchema :: ValueSchema NamedSwaggerDoc (Maybe UserId, IdP) createdSchema = - object "IdPCreated" $ + object $ (,) <$> fst .= maybe_ (optField "user" schema) <*> snd .= field "idp" schema deletedSchema :: ValueSchema NamedSwaggerDoc (UserId, IdP) deletedSchema = - object "IdPDeleted" $ + object $ (,) <$> fst .= field "user" schema <*> snd .= field "idp" schema updatedSchema :: ValueSchema NamedSwaggerDoc (UserId, IdP, IdP) updatedSchema = - object "IdPUpdated" $ + object $ (,,) <$> fst3 .= field "user" schema <*> snd3 .= field "old" schema diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig/Connection.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/Connection.hs index 7f3d76810c..cdfb0512f9 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig/Connection.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/Connection.hs @@ -36,7 +36,7 @@ data ConnectionsStatusRequest = ConnectionsStatusRequest instance ToSchema ConnectionsStatusRequest where schema = - object "ConnectionsStatusRequest" $ + object $ ConnectionsStatusRequest <$> csrFrom .= field "from" (array schema) <*> csrTo .= maybe_ (optField "to" (array schema)) @@ -51,7 +51,7 @@ data ConnectionsStatusRequestV2 = ConnectionsStatusRequestV2 instance ToSchema ConnectionsStatusRequestV2 where schema = - object "ConnectionsStatusRequestV2" $ + object $ ConnectionsStatusRequestV2 <$> csrv2From .= field "from" (array schema) <*> csrv2To .= maybe_ (optField "to" (array schema)) @@ -67,7 +67,7 @@ data ConnectionStatus = ConnectionStatus instance ToSchema ConnectionStatus where schema = - object "ConnectionStatus" $ + object $ ConnectionStatus <$> csFrom .= field "from" schema <*> csTo .= field "to" schema @@ -83,7 +83,7 @@ data ConnectionStatusV2 = ConnectionStatusV2 instance ToSchema ConnectionStatusV2 where schema = - object "ConnectionStatusV2" $ + object $ ConnectionStatusV2 <$> csv2From .= field "from" schema <*> csv2To .= field "qualified_to" schema diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs index fca4478010..c57a8ea5b8 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs @@ -128,15 +128,15 @@ toEJPDResponseItemLeaf EJPDResponseItemRoot {..} = ---------------------------------------------------------------------- instance ToSchema EJPDRequestBody where - schema = object "EJPDRequestBody" do + schema = object do EJPDRequestBody <$> ejpdRequestBody .= field "EJPDRequest" (array schema) instance ToSchema EJPDResponseBody where - schema = object "EJPDResponseBody" do + schema = object do EJPDResponseBody <$> ejpdResponseBody .= field "EJPDResponse" (array schema) instance ToSchema EJPDResponseItemRoot where - schema = object "EJPDResponseItemRoot" do + schema = object do EJPDResponseItemRoot <$> ejpdResponseRootUserId .= field "UserId" schema <*> ejpdResponseRootTeamId .= maybe_ (optField "TeamId" schema) @@ -151,7 +151,7 @@ instance ToSchema EJPDResponseItemRoot where <*> (fmap Set.toList . ejpdResponseRootAssets) .= (Set.fromList <$$> maybe_ (optField "Assets" (array schema))) instance ToSchema EJPDResponseItemLeaf where - schema = object "EJPDResponseItemLeaf" do + schema = object do EJPDResponseItemLeaf <$> ejpdResponseLeafUserId .= field "UserId" schema <*> ejpdResponseLeafTeamId .= maybe_ (optField "TeamId" schema) @@ -165,20 +165,20 @@ instance ToSchema EJPDResponseItemLeaf where instance ToSchema EJPDContact where schema = - object "EJDPContact" do + object do EJPDContactFound <$> ejpdContactRelation .= field "contact_relation" schema <*> ejpdContactFound .= field "contact_item" schema instance ToSchema EJPDTeamContacts where - schema = object "EJPDTeamContacts" do + schema = object do EJPDTeamContacts <$> (Set.toList . ejpdTeamContacts) .= (Set.fromList <$> field "TeamContacts" (array schema)) <*> ejpdTeamContactsListType .= field "ListType" schema instance ToSchema EJPDConvInfo where schema = - object "EJPDConvInfo" $ + object $ EJPDConvInfo <$> ejpdConvName .= field "conv_name" schema <*> ejpdConvId .= field "conv_id" schema diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley/ConversationsIntra.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley/ConversationsIntra.hs index a25baa28b2..1cd39377d5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley/ConversationsIntra.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley/ConversationsIntra.hs @@ -30,7 +30,7 @@ data DesiredMembership = Included | Excluded instance ToSchema DesiredMembership where schema = - enum @Text "DesiredMembership" $ + enum @Text $ mconcat [ element "included" Included, element "excluded" Excluded @@ -42,7 +42,7 @@ data Actor = LocalActor | RemoteActor instance ToSchema Actor where schema = - enum @Text "Actor" $ + enum @Text $ mconcat [ element "local_actor" LocalActor, element "remote_actor" RemoteActor @@ -60,7 +60,7 @@ data UpsertOne2OneConversationRequest = UpsertOne2OneConversationRequest instance ToSchema UpsertOne2OneConversationRequest where schema = - object "UpsertOne2OneConversationRequest" $ + object $ UpsertOne2OneConversationRequest <$> (tUntagged . uooLocalUser) .= field "local_user" (qTagUnsafe <$> schema) <*> (tUntagged . uooRemoteUser) .= field "remote_user" (qTagUnsafe <$> schema) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamFeatureNoConfigMulti.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamFeatureNoConfigMulti.hs index b721ad2706..11d7cbb681 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamFeatureNoConfigMulti.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamFeatureNoConfigMulti.hs @@ -36,7 +36,7 @@ data TeamStatus cfg = TeamStatus instance forall k (cfg :: k). (Typeable k, Typeable cfg) => ToSchema (TeamStatus cfg) where schema = - object "TeamStatus" $ + object $ TeamStatus <$> team .= field "team" schema <*> status .= field "status" schema diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamsIntra.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamsIntra.hs index 9398113741..85c3b76524 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamsIntra.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamsIntra.hs @@ -69,7 +69,7 @@ data TeamStatus instance S.ToSchema TeamStatus where schema = - S.enum @Text "TeamStatus" $ + S.enum @Text $ mconcat [ S.element "active" Active, S.element "pending_delete" PendingDelete, @@ -89,7 +89,7 @@ data TeamData = TeamData instance S.ToSchema TeamData where schema = - S.object "TeamData" $ + S.object $ TeamData <$> tdTeam S..= S.field "team" S.schema <*> tdStatus S..= S.field "status" S.schema @@ -105,7 +105,7 @@ data TeamStatusUpdate = TeamStatusUpdate instance S.ToSchema TeamStatusUpdate where schema = - S.object "TeamStatusUpdate" $ + S.object $ TeamStatusUpdate <$> tuStatus S..= S.field "status" S.schema <*> tuCurrency S..= S.maybe_ (S.optField "currency" S.genericToSchema) @@ -118,7 +118,7 @@ newtype TeamName = TeamName instance S.ToSchema TeamName where schema = - S.object "TeamName" $ + S.object $ TeamName <$> tnName S..= S.field "name" S.schema @@ -132,7 +132,7 @@ data GuardLegalholdPolicyConflicts = GuardLegalholdPolicyConflicts instance S.ToSchema GuardLegalholdPolicyConflicts where schema = - S.object "GuardLegalholdPolicyConflicts" $ + S.object $ GuardLegalholdPolicyConflicts <$> glhProtectee S..= S.field "glhProtectee" S.schema <*> glhUserClients S..= S.field "glhUserClients" S.schema diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs index 2a9ce3077d..e1fa3207f2 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs @@ -100,8 +100,7 @@ instance ?~ "optional, when not specified, the first page will be returned.\ \Every returned page contains a paging_state, this should be supplied to retrieve the next page." addSizeDoc = description ?~ ("optional, must be <= " <> textFromNat @max <> ", defaults to " <> textFromNat @def <> ".") - in objectWithDocModifier - ("GetPaginated_" <> textFromSymbol @name) + in objectWithDocModifier -- TODO!### (description ?~ "A request to list some or all of a user's " <> textFromSymbol @name <> ", including remote ones") $ GetMultiTablePageRequest <$> gmtprSize .= (fromMaybe (toRange (Proxy @def)) <$> optFieldWithDocModifier "size" addSizeDoc schema) @@ -160,7 +159,7 @@ instance ToSchema (MultiTablePage name resultsKey tables a) where schema = - object (textFromSymbol @name <> "_Page") $ + object $ -- TODO!### MultiTablePage <$> mtpResults .= field (textFromSymbol @resultsKey) (array schema) <*> mtpHasMore .= field "has_more" schema diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs index 819964e818..f7420169de 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs @@ -69,9 +69,8 @@ data DomainRedirectConfigTag instance ToSchema DomainRedirectConfigTag where schema = - enum @Text - "DomainRedirectConfigTag" - $ mconcat + enum @Text $ + mconcat [ element "remove" DomainRedirectConfigRemoveTag, element "backend" DomainRedirectConfigBackendTag, element "no-registration" DomainRedirectConfigNoRegistrationTag @@ -102,7 +101,7 @@ domainRedirectConfigV9Schema = DomainRedirectConfigRemoveTag -> tag _DomainRedirectConfigRemoveV9 (pure ()) instance ToSchema DomainRedirectConfigV9 where - schema = object "DomainRedirectConfigV9" domainRedirectConfigV9Schema + schema = object domainRedirectConfigV9Schema data DomainRedirectConfig = DomainRedirectConfigRemove @@ -141,7 +140,7 @@ domainRedirectConfigSchema = backendConfigObjectSchema :: ValueSchema NamedSwaggerDoc (HttpsUrl, HttpsUrl) backendConfigObjectSchema = - object "backend_config" $ + object $ (,) <$> fst .= field "config_url" schema <*> snd .= field "webapp_url" schema @@ -153,14 +152,14 @@ domainRedirectConfigToTag = \case DomainRedirectConfigNoRegistration -> DomainRedirectConfigNoRegistrationTag instance ToSchema DomainRedirectConfig where - schema = object "DomainRedirectConfig" domainRedirectConfigSchema + schema = object domainRedirectConfigSchema newtype GetDomainRegistrationRequest = GetDomainRegistrationRequest {domainRegistrationRequestEmail :: EmailAddress} deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema GetDomainRegistrationRequest) instance ToSchema GetDomainRegistrationRequest where schema = - object "GetDomainRegistrationRequest" $ + object $ GetDomainRegistrationRequest <$> domainRegistrationRequestEmail .= field "email" schema @@ -225,7 +224,7 @@ data TeamInviteConfig = TeamInviteConfig instance ToSchema TeamInviteConfig where schema = - object "TeamInviteConfig" $ + object $ TeamInviteConfig <$> (.teamInvite) .= teamInviteObjectSchema <*> (maybeTeamDomainRedirectToTuple . (.domainRedirect)) .= maybeTeamDomainRedirectTargetObjectSchema @@ -244,7 +243,7 @@ data DomainVerificationChallenge = DomainVerificationChallenge instance ToSchema DomainVerificationChallenge where schema = - object "DomainVerificationChallenge" $ + object $ DomainVerificationChallenge <$> challengeId .= field "id" schema <*> token .= field "token" schema @@ -255,7 +254,7 @@ newtype ChallengeToken = ChallengeToken {unChallengeToken :: Token} instance ToSchema ChallengeToken where schema = - object "ChallengeToken" $ + object $ ChallengeToken <$> unChallengeToken .= field "challenge_token" schema @@ -264,7 +263,7 @@ newtype DomainOwnershipToken = DomainOwnershipToken {unDomainOwnershipToken :: T instance ToSchema DomainOwnershipToken where schema = - object "DomainOwnershipToken" $ + object $ DomainOwnershipToken <$> unDomainOwnershipToken .= field "domain_ownership_token" schema @@ -273,7 +272,7 @@ newtype RegisteredDomains (v :: Version) = RegisteredDomains {unRegisteredDomain instance (Typeable v, SingI v) => ToSchema (RegisteredDomains v) where schema = - object "RegisteredDomains" $ + object $ RegisteredDomains <$> unRegisteredDomains .= field "registered_domains" (array schema) @@ -295,7 +294,7 @@ deriving via Schema DomainRedirectResponseV9 instance S.ToSchema DomainRedirectR instance ToSchema DomainRedirectResponseV9 where schema = - object "DomainRedirectResponseV9" $ + object $ DomainRedirectResponse <$> (\r -> True <$ guard r.propagateUserExists) .= maybe_ @@ -314,7 +313,7 @@ deriving via Schema DomainRedirectResponseV10 instance S.ToSchema DomainRedirect instance ToSchema DomainRedirectResponseV10 where schema = - object "DomainRedirectResponseV10" $ + object $ DomainRedirectResponse <$> (\r -> True <$ guard r.propagateUserExists) .= maybe_ diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs index bc09fa549a..d7637661df 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs @@ -50,7 +50,7 @@ data MLSReset = MLSReset instance ToSchema MLSReset where schema = - object "MLSReset" $ + object $ MLSReset <$> (.groupId) .= field "group_id" schema <*> (.epoch) .= field "epoch" schema diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs index c8515b9106..c442cc975b 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs @@ -50,7 +50,7 @@ data NonBindingNewTeam = NonBindingNewTeam instance ToSchema NonBindingNewTeam where schema = - object "NonBindingNewTeam" $ + object $ NonBindingNewTeam <$> (.teamName) .= fieldWithDocModifier "name" (description ?~ "team name") schema <*> (.teamIcon) .= fieldWithDocModifier "icon" (description ?~ "team icon (asset ID)") schema diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs index ddf3e1c6b8..4e072cc0e3 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs @@ -109,7 +109,7 @@ newtype GetByEmailReq = GetByEmailReq {email :: EmailAddress} instance ToSchema GetByEmailReq where schema = - object "GetByEmailReq" $ + object $ GetByEmailReq <$> email .= field "email" schema newtype GetByEmailResp = GetByEmailResp {ssoCode :: Maybe SAML.IdPId} @@ -118,7 +118,7 @@ newtype GetByEmailResp = GetByEmailResp {ssoCode :: Maybe SAML.IdPId} instance ToSchema GetByEmailResp where schema = - object "GetByEmailResp" $ + object $ GetByEmailResp <$> (fmap fromIdPId . ssoCode) .= maybe_ (optField "sso_code" (IdPId <$> uuidSchema)) diff --git a/libs/wire-api/src/Wire/API/Routes/Version.hs b/libs/wire-api/src/Wire/API/Routes/Version.hs index 064e66929e..656349dc5b 100644 --- a/libs/wire-api/src/Wire/API/Routes/Version.hs +++ b/libs/wire-api/src/Wire/API/Routes/Version.hs @@ -179,7 +179,7 @@ versionByteString :: Version -> ByteString versionByteString = ("v" <>) . toByteString' . versionInt @Int instance ToSchema Version where - schema = enum @Text "Version" . mconcat $ (\v -> element (versionText v) v) <$> [minBound ..] + schema = enum @Text . mconcat $ (\v -> element (versionText v) v) <$> [minBound ..] instance FromHttpApiData Version where parseQueryParam v = note ("Unknown version: " <> v) $ @@ -206,7 +206,7 @@ newtype VersionNumber = VersionNumber {fromVersionNumber :: Version} instance ToSchema VersionNumber where schema = - enum @Integer "VersionNumber" . mconcat $ (\v -> element (versionInt v) (VersionNumber v)) <$> [minBound ..] + enum @Integer . mconcat $ (\v -> element (versionInt v) (VersionNumber v)) <$> [minBound ..] instance FromHttpApiData VersionNumber where parseHeader = first Text.pack . Aeson.eitherDecode . LBS.fromStrict @@ -235,7 +235,7 @@ data VersionInfo = VersionInfo instance ToSchema VersionInfo where schema = - objectWithDocModifier "VersionInfo" (S.schema . S.example ?~ toJSON example) $ + objectWithDocModifier (S.schema . S.example ?~ toJSON example) $ VersionInfo <$> vinfoSupported .= vinfoObjectSchema schema @@ -307,7 +307,7 @@ instance ToSchema VersionExp where <> tag _VersionExpDevelopment ( unnamed - (enum @Text "VersionExpDevelopment" (element "development" ())) + (enum @Text (element "development" ())) ) deriving via Schema VersionExp instance (FromJSON VersionExp) diff --git a/libs/wire-api/src/Wire/API/SystemSettings.hs b/libs/wire-api/src/Wire/API/SystemSettings.hs index 6f78a123fd..b41a17acc5 100644 --- a/libs/wire-api/src/Wire/API/SystemSettings.hs +++ b/libs/wire-api/src/Wire/API/SystemSettings.hs @@ -40,7 +40,7 @@ data SystemSettingsPublic = SystemSettingsPublic instance ToSchema SystemSettingsPublic where schema = - object "SystemSettingsPublic" $ settingsPublicObjectSchema + object $ settingsPublicObjectSchema settingsPublicObjectSchema :: ObjectSchema SwaggerDoc SystemSettingsPublic settingsPublicObjectSchema = @@ -64,7 +64,7 @@ data SystemSettingsInternal = SystemSettingsInternal instance ToSchema SystemSettingsInternal where schema = - object "SystemSettingsInternal" $ settingsInternalObjectSchema + object $ settingsInternalObjectSchema settingsInternalObjectSchema :: ObjectSchema SwaggerDoc SystemSettingsInternal settingsInternalObjectSchema = @@ -81,7 +81,7 @@ data SystemSettings = SystemSettings instance ToSchema SystemSettings where schema = - object "SystemSettings" $ + object $ SystemSettings <$> ssPublic .= settingsPublicObjectSchema <*> ssInternal .= settingsInternalObjectSchema diff --git a/libs/wire-api/src/Wire/API/Team.hs b/libs/wire-api/src/Wire/API/Team.hs index 61be43b4b0..f9c5dcf678 100644 --- a/libs/wire-api/src/Wire/API/Team.hs +++ b/libs/wire-api/src/Wire/API/Team.hs @@ -105,7 +105,7 @@ newTeam tid uid nme ico tb = Team tid uid nme ico Nothing tb DefaultIcon instance ToSchema Team where schema = - objectWithDocModifier "Team" desc $ + objectWithDocModifier desc $ Team <$> _teamId .= field "id" schema <*> _teamCreator .= field "creator" schema @@ -147,7 +147,7 @@ data TeamBinding instance ToSchema TeamBinding where schema = over doc (deprecated ?~ True) $ - enum @Bool "TeamBinding" $ + enum @Bool $ mconcat [element True Binding, element False NonBinding] -------------------------------------------------------------------------------- @@ -166,7 +166,7 @@ newTeamList = TeamList instance ToSchema TeamList where schema = - object "TeamList" $ + object $ TeamList <$> _teamListTeams .= field "teams" (array schema) <*> _teamListHasMore .= field "has_more" schema @@ -191,7 +191,7 @@ newTeamObjectSchema = <*> newTeamIconKey .= maybe_ (optFieldWithDocModifier "icon_key" (description ?~ "The decryption key for the team icon S3 asset") schema) instance ToSchema NewTeam where - schema = object "NewTeam" newTeamObjectSchema + schema = object newTeamObjectSchema newNewTeam :: Range 1 256 Text -> Icon -> NewTeam newNewTeam nme ico = NewTeam nme ico Nothing @@ -260,7 +260,7 @@ validateTeamUpdateData u = instance ToSchema TeamUpdateData where schema = (`withParser` validateTeamUpdateData) - . object "TeamUpdateData" + . object $ TeamUpdateData <$> _nameUpdate .= maybe_ (optField "name" schema) <*> _iconUpdate .= maybe_ (optField "icon" schema) @@ -288,7 +288,7 @@ newTeamDeleteDataWithCode = TeamDeleteData instance ToSchema TeamDeleteData where schema = - object "TeamDeleteData" $ + object $ TeamDeleteData <$> _tdAuthPassword .= optField "password" (maybeWithDefault Null schema) <*> _tdVerificationCode .= maybe_ (optField "verification_code" schema) diff --git a/libs/wire-api/src/Wire/API/Team/Collaborator.hs b/libs/wire-api/src/Wire/API/Team/Collaborator.hs index c6d6e79a31..d256ce9247 100644 --- a/libs/wire-api/src/Wire/API/Team/Collaborator.hs +++ b/libs/wire-api/src/Wire/API/Team/Collaborator.hs @@ -33,7 +33,7 @@ data CollaboratorPermission = CreateTeamConversation | ImplicitConnection instance ToSchema CollaboratorPermission where schema = - enum @Text "CollaboratorPermission" $ + enum @Text $ mconcat [ element "create_team_conversation" CreateTeamConversation, element "implicit_connection" ImplicitConnection @@ -54,7 +54,7 @@ data NewTeamCollaborator = NewTeamCollaborator instance ToSchema NewTeamCollaborator where schema = - object "NewTeamCollaborator" $ + object $ NewTeamCollaborator <$> (aUser .= field "user" schema) <*> (aPermissions .= field "permissions" (set schema)) @@ -69,7 +69,7 @@ data TeamCollaborator = TeamCollaborator instance ToSchema TeamCollaborator where schema = - object "TeamCollaborator" $ + object $ TeamCollaborator <$> (gUser .= field "user" schema) <*> (gTeam .= field "team" schema) diff --git a/libs/wire-api/src/Wire/API/Team/Conversation.hs b/libs/wire-api/src/Wire/API/Team/Conversation.hs index d3b240d9f5..53427886ce 100644 --- a/libs/wire-api/src/Wire/API/Team/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Team/Conversation.hs @@ -58,7 +58,6 @@ managedDesc = instance ToSchema TeamConversation where schema = objectWithDocModifier - "TeamConversation" (description ?~ "Team conversation data") $ TeamConversation <$> _conversationId .= field "conversation" schema @@ -86,7 +85,6 @@ newtype TeamConversationList = TeamConversationList {teamConversations :: [TeamC instance ToSchema TeamConversationList where schema = objectWithDocModifier - "TeamConversationList" (description ?~ "Team conversation list") $ TeamConversationList <$> teamConversations .= field "conversations" (array schema) diff --git a/libs/wire-api/src/Wire/API/Team/Export.hs b/libs/wire-api/src/Wire/API/Team/Export.hs index 156f541e5e..ca4b616008 100644 --- a/libs/wire-api/src/Wire/API/Team/Export.hs +++ b/libs/wire-api/src/Wire/API/Team/Export.hs @@ -70,7 +70,7 @@ data TeamExportUser = TeamExportUser instance ToSchema TeamExportUser where schema = - object "TeamExportUser" $ + object $ TeamExportUser <$> tExportDisplayName .= field "display_name" schema <*> tExportHandle .= maybe_ (optField "handle" schema) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 05416fcd3d..38f6aecacf 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -407,7 +407,7 @@ defUnlockedFeature = instance (Typeable cfg, IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where schema = - object name $ + object $ -- TODO!### LockableFeature <$> (.status) .= field "status" schema <*> (.lockStatus) .= field "lockStatus" schema @@ -416,9 +416,6 @@ instance (Typeable cfg, IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) w .= optField "ttl" (schema :: ValueSchema NamedSwaggerDoc FeatureTTL) - where - inner = schema @cfg - name = fromMaybe "" (getName (schemaDoc inner)) <> ".LockableFeature" instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (LockableFeature cfg) where arbitrary = LockableFeature <$> arbitrary <*> arbitrary <*> arbitrary @@ -441,7 +438,7 @@ instance Default (LockableFeaturePatch cfg) where -- when the value is a `Just`, if it's `Nothing` it will be omitted, which is the important part. instance (Typeable cfg, ToSchema cfg) => ToSchema (LockableFeaturePatch cfg) where schema = - object name $ + object $ -- TODO!### LockableFeaturePatch <$> (.status) .= maybe_ (optField "status" schema) <*> (.lockStatus) .= maybe_ (optField "lockStatus" schema) @@ -450,9 +447,6 @@ instance (Typeable cfg, ToSchema cfg) => ToSchema (LockableFeaturePatch cfg) whe .= optField "ttl" (schema :: ValueSchema NamedSwaggerDoc FeatureTTL) - where - inner = schema @cfg - name = fromMaybe "" (getName (schemaDoc inner)) <> ".LockableFeaturePatch" instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (LockableFeaturePatch cfg) where arbitrary = LockableFeaturePatch <$> arbitrary <*> arbitrary <*> arbitrary @@ -605,7 +599,7 @@ instance FromHttpApiData LockStatus where instance ToSchema LockStatus where schema = - enum @Text "LockStatus" $ + enum @Text $ mconcat [ element "locked" LockStatusLocked, element "unlocked" LockStatusUnlocked @@ -655,7 +649,7 @@ newtype LockStatusResponse = LockStatusResponse {_unlockStatus :: LockStatus} instance ToSchema LockStatusResponse where schema = - object "LockStatusResponse" $ + object $ LockStatusResponse <$> _unlockStatus .= field "lockStatus" schema @@ -669,7 +663,7 @@ data GuestLinksConfig = GuestLinksConfig deriving (ParseDbFeature, Default) via TrivialFeature GuestLinksConfig instance ToSchema GuestLinksConfig where - schema = object "GuestLinksConfig" objectSchema + schema = object objectSchema instance Default (LockableFeature GuestLinksConfig) where def = defUnlockedFeature @@ -701,7 +695,7 @@ instance IsFeatureConfig LegalholdConfig where featureSingleton = FeatureSingletonLegalholdConfig instance ToSchema LegalholdConfig where - schema = object "LegalholdConfig" objectSchema + schema = object objectSchema -------------------------------------------------------------------------------- -- SSO feature @@ -724,7 +718,7 @@ instance IsFeatureConfig SSOConfig where featureSingleton = FeatureSingletonSSOConfig instance ToSchema SSOConfig where - schema = object "SSOConfig" objectSchema + schema = object objectSchema -------------------------------------------------------------------------------- -- SearchVisibility available feature @@ -748,7 +742,7 @@ instance IsFeatureConfig SearchVisibilityAvailableConfig where featureSingleton = FeatureSingletonSearchVisibilityAvailableConfig instance ToSchema SearchVisibilityAvailableConfig where - schema = object "SearchVisibilityAvailableConfig" objectSchema + schema = object objectSchema type instance DeprecatedFeatureName V2 SearchVisibilityAvailableConfig = "search-visibility" @@ -769,7 +763,7 @@ data RequireExternalEmailVerificationConfig = RequireExternalEmailVerificationCo deriving (ParseDbFeature, Default) via (TrivialFeature RequireExternalEmailVerificationConfig) instance ToSchema RequireExternalEmailVerificationConfig where - schema = object "RequireExternalEmailVerificationConfig" objectSchema + schema = object objectSchema instance Default (LockableFeature RequireExternalEmailVerificationConfig) where def = defUnlockedFeature @@ -806,7 +800,7 @@ instance IsFeatureConfig DigitalSignaturesConfig where type instance DeprecatedFeatureName V2 DigitalSignaturesConfig = "digital-signatures" instance ToSchema DigitalSignaturesConfig where - schema = object "DigitalSignaturesConfig" objectSchema + schema = object objectSchema -------------------------------------------------------------------------------- -- ConferenceCalling feature @@ -877,7 +871,7 @@ instance IsFeatureConfig ConferenceCallingConfig where instance (Typeable f, OptWithDefault f) => ToSchema (ConferenceCallingConfigB Covered f) where schema = - object "ConferenceCallingConfig" $ + object $ ConferenceCallingConfig <$> one2OneCalls .= fromOpt @@ -893,7 +887,7 @@ data SndFactorPasswordChallengeConfig = SndFactorPasswordChallengeConfig deriving (ParseDbFeature, Default) via (TrivialFeature SndFactorPasswordChallengeConfig) instance ToSchema SndFactorPasswordChallengeConfig where - schema = object "SndFactorPasswordChallengeConfig" objectSchema + schema = object objectSchema instance Default (LockableFeature SndFactorPasswordChallengeConfig) where def = defLockedFeature @@ -926,7 +920,7 @@ instance IsFeatureConfig SearchVisibilityInboundConfig where featureSingleton = FeatureSingletonSearchVisibilityInboundConfig instance ToSchema SearchVisibilityInboundConfig where - schema = object "SearchVisibilityInboundConfig" objectSchema + schema = object objectSchema ---------------------------------------------------------------------- -- ClassifiedDomains feature @@ -952,7 +946,7 @@ deriving via (GenericUniform ClassifiedDomainsConfig) instance Arbitrary Classif instance ToSchema ClassifiedDomainsConfig where schema = - object "ClassifiedDomainsConfig" $ + object $ ClassifiedDomainsConfig <$> classifiedDomainsDomains .= field "domains" (array schema) @@ -1000,7 +994,7 @@ instance Default AppLockConfig where instance (Typeable f, FieldF f) => ToSchema (AppLockConfigB Covered f) where schema = - object "AppLockConfig" $ + object $ AppLockConfig <$> (.enforce) .= fieldF "enforceAppLock" schema <*> (.timeout) .= fieldF "inactivityTimeoutSecs" schema @@ -1046,7 +1040,7 @@ instance IsFeatureConfig FileSharingConfig where featureSingleton = FeatureSingletonFileSharingConfig instance ToSchema FileSharingConfig where - schema = object "FileSharingConfig" objectSchema + schema = object objectSchema ---------------------------------------------------------------------- -- SelfDeletingMessagesConfig @@ -1081,7 +1075,7 @@ instance Default SelfDeletingMessagesConfig where instance (Typeable f, FieldF f) => ToSchema (SelfDeletingMessagesConfigB Covered f) where schema = - object "SelfDeletingMessagesConfig" $ + object $ SelfDeletingMessagesConfig <$> sdmEnforcedTimeoutSeconds .= fieldF "enforcedTimeoutSeconds" schema @@ -1141,7 +1135,7 @@ instance Default MLSConfig where instance (Typeable f, FieldF f) => ToSchema (MLSConfigB Covered f) where schema = - object "MLSConfig" $ + object $ MLSConfig <$> mlsProtocolToggleUsers .= ( fieldWithDocModifierF @@ -1205,7 +1199,7 @@ data ChannelPermissions = TeamMembers | Everyone | Admins instance ToSchema ChannelPermissions where schema = - enum @Text "ChannelPermissions" $ + enum @Text $ mconcat [ element "team-members" TeamMembers, element "everyone" Everyone, @@ -1214,7 +1208,7 @@ instance ToSchema ChannelPermissions where instance (Typeable f, FieldF f) => ToSchema (ChannelsConfigB Covered f) where schema = - object "ChannelsConfig" $ + object $ ChannelsConfig <$> allowedToCreateChannels .= fieldF "allowed_to_create_channels" schema <*> allowedToOpenChannels .= fieldF "allowed_to_open_channels" schema @@ -1249,7 +1243,7 @@ instance IsFeatureConfig ExposeInvitationURLsToTeamAdminConfig where featureSingleton = FeatureSingletonExposeInvitationURLsToTeamAdminConfig instance ToSchema ExposeInvitationURLsToTeamAdminConfig where - schema = object "ExposeInvitationURLsToTeamAdminConfig" objectSchema + schema = object objectSchema ---------------------------------------------------------------------- -- OutlookCalIntegrationConfig @@ -1273,7 +1267,7 @@ instance IsFeatureConfig OutlookCalIntegrationConfig where featureSingleton = FeatureSingletonOutlookCalIntegrationConfig instance ToSchema OutlookCalIntegrationConfig where - schema = object "OutlookCalIntegrationConfig" objectSchema + schema = object objectSchema ---------------------------------------------------------------------- -- MlsE2EIdConfig @@ -1331,7 +1325,7 @@ instance Arbitrary MlsE2EIdConfig where instance (Typeable f, FieldF f) => ToSchema (MlsE2EIdConfigB Covered f) where schema = - object "MlsE2EIdConfig" $ + object $ MlsE2EIdConfig <$> ( (fmap toSeconds . verificationExpiration) .= fieldWithDocModifierF @@ -1416,7 +1410,7 @@ instance Arbitrary MlsMigrationConfig where instance (Typeable f, NestedMaybe f) => ToSchema (MlsMigrationConfigB Covered f) where schema = - object "MlsMigration" $ + object $ MlsMigrationConfig <$> startTime .= nestedMaybeField "startTime" (unnamed utcTimeSchema) <*> finaliseRegardlessAfter .= nestedMaybeField "finaliseRegardlessAfter" (unnamed utcTimeSchema) @@ -1469,7 +1463,7 @@ instance Arbitrary EnforceFileDownloadLocationConfig where instance (Typeable f, NestedMaybe f) => ToSchema (EnforceFileDownloadLocationConfigB Covered f) where schema = - object "EnforceFileDownloadLocation" $ + object $ EnforceFileDownloadLocationConfig <$> enforcedDownloadLocation .= nestedMaybeField "enforcedDownloadLocation" (unnamed schema) @@ -1508,7 +1502,7 @@ instance IsFeatureConfig LimitedEventFanoutConfig where featureSingleton = FeatureSingletonLimitedEventFanoutConfig instance ToSchema LimitedEventFanoutConfig where - schema = object "LimitedEventFanoutConfig" objectSchema + schema = object objectSchema -------------------------------------------------------------------------------- -- DomainRegistration feature @@ -1521,7 +1515,7 @@ data DomainRegistrationConfig = DomainRegistrationConfig deriving (Default, ParseDbFeature) via (TrivialFeature DomainRegistrationConfig) instance ToSchema DomainRegistrationConfig where - schema = object "DomainRegistrationConfig" objectSchema + schema = object objectSchema instance Default (LockableFeature DomainRegistrationConfig) where def = defLockedFeature @@ -1543,7 +1537,7 @@ data CellsPropertyStatus = Enabled | Disabled | Enforced instance ToSchema CellsPropertyStatus where schema = - enum @Text "CellsPropertyStatus" $ + enum @Text $ mconcat [ element "enabled" Enabled, element "disabled" Disabled, @@ -1560,7 +1554,7 @@ data CellsProperty = CellsProperty instance ToSchema CellsProperty where schema = - object "CellsProperty" $ + object $ CellsProperty <$> (.enabled) .= field "enabled" schema <*> (.default_) .= field "default" schema @@ -1575,7 +1569,7 @@ data CellsUsers = CellsUsers instance ToSchema CellsUsers where schema = - object "CellsUsers" $ + object $ CellsUsers <$> (.externals) .= field "externals" schema <*> (.guests) .= field "guests" schema @@ -1587,7 +1581,7 @@ newtype CellsCollaboraStatus = CellsCollaboraStatus {enabled :: Bool} instance ToSchema CellsCollaboraStatus where schema = - object "CellsCollaboraStatus" $ + object $ CellsCollaboraStatus <$> (.enabled) .= field "enabled" schema @@ -1604,7 +1598,7 @@ data CellsPublicLinks = CellsPublicLinks instance ToSchema CellsPublicLinks where schema = - object "CellsPublicLinks" $ + object $ CellsPublicLinks <$> enableFiles .= field "enableFiles" schema <*> enableFolders .= field "enableFolders" schema @@ -1623,7 +1617,7 @@ data CellsRecycle = CellsRecycle instance ToSchema CellsRecycle where schema = - object "CellsRecycle" $ + object $ CellsRecycle <$> autoPurgeDays .= field "autoPurgeDays" schema <*> disable .= field "disable" schema @@ -1639,7 +1633,7 @@ data CellsConfigStorage = CellsConfigStorage instance ToSchema CellsConfigStorage where schema = - object "CellsConfigStorage" $ + object $ CellsConfigStorage <$> perFileQuotaBytes .= field "perFileQuotaBytes" schema <*> recycle .= field "recycle" schema @@ -1654,7 +1648,7 @@ data CellsUserMetaTags = CellsUserMetaTags instance ToSchema CellsUserMetaTags where schema = - object "CellsUserMetaTags" $ + object $ CellsUserMetaTags <$> defaultValues .= field "defaultValues" (array schema) <*> allowFreeValues .= field "allowFreeValues" schema @@ -1666,7 +1660,7 @@ newtype CellsNamespaces = CellsNamespaces {usermetaTags :: CellsUserMetaTags} instance ToSchema CellsNamespaces where schema = - object "CellsNamespaces" $ + object $ CellsNamespaces <$> usermetaTags .= field "usermetaTags" schema @@ -1677,7 +1671,7 @@ newtype CellsMetadata = CellsMetadata {namespaces :: CellsNamespaces} instance ToSchema CellsMetadata where schema = - object "CellsMetadata" $ + object $ CellsMetadata <$> namespaces .= field "namespaces" schema @@ -1754,7 +1748,7 @@ instance Default CellsConfig where instance (Typeable f, FieldF f) => ToSchema (CellsConfigB Covered f) where schema = - objectWithDocModifier "CellsConfig" (S.schema . S.example ?~ schemaToJSON (def @CellsConfig)) $ + objectWithDocModifier (S.schema . S.example ?~ schemaToJSON (def @CellsConfig)) $ CellsConfig <$> channels .= fieldF "channels" schema <*> groups .= fieldF "groups" schema @@ -1766,7 +1760,7 @@ instance (Typeable f, FieldF f) => ToSchema (CellsConfigB Covered f) where <*> metadata .= fieldF "metadata" schema instance ToSchema (Versioned V13 CellsConfig) where - schema = object "CellsConfigV13" objectSchema + schema = object objectSchema instance ToObjectSchema (Versioned V13 CellsConfig) where objectSchema = pure $ Versioned def @@ -1791,7 +1785,7 @@ data CollaboraEdition = No | Code | Cool instance ToSchema CollaboraEdition where schema = - enum @Text "CollaboraEdition" $ + enum @Text $ mconcat [ element "NO" No, element "CODE" Code, @@ -1807,7 +1801,7 @@ newtype CellsCollabora = CellsCollabora instance ToSchema CellsCollabora where schema = - object "CellsCollabora" $ + object $ CellsCollabora <$> edition .= field "edition" schema @@ -1819,7 +1813,7 @@ newtype CellsBackend = CellsBackend deriving newtype (Arbitrary) instance ToSchema CellsBackend where - schema = object "CellsBackend" $ CellsBackend <$> url .= field "url" schema + schema = object $ CellsBackend <$> url .= field "url" schema newtype NumBytes = NumBytes {unNumBytes :: BigIntString} deriving newtype (Show, Eq) @@ -1849,7 +1843,7 @@ newtype CellsStorage = CellsStorage instance ToSchema CellsStorage where schema = - object "CellsStorage" $ + object $ CellsStorage <$> perUserQuotaBytes .= field "perUserQuotaBytes" schema @@ -1890,7 +1884,7 @@ instance Default CellsInternalConfig where instance (Typeable f, FieldF f) => ToSchema (CellsInternalConfigB Covered f) where schema = - object "CellsInternalConfig" $ + object $ CellsInternalConfig <$> backend .= fieldF "backend" schema <*> (.collabora) .= fieldF "collabora" schema @@ -1927,7 +1921,7 @@ instance Default AllowedGlobalOperationsConfig where instance ToSchema AllowedGlobalOperationsConfig where schema = - object "AllowedGlobalOperationsConfig" $ + object $ AllowedGlobalOperationsConfig <$> mlsConversationReset .= field "mlsConversationReset" schema @@ -1958,7 +1952,7 @@ instance ParseDbFeature AssetAuditLogConfig where serialiseDbConfig = DbConfig . schemaToJSON instance ToSchema AssetAuditLogConfig where - schema = object "AssetAuditLogConfig" objectSchema + schema = object objectSchema instance Default AssetAuditLogConfig where def = AssetAuditLogConfig @@ -1984,7 +1978,7 @@ data ConsumableNotificationsConfig = ConsumableNotificationsConfig deriving (Default, ParseDbFeature) via (TrivialFeature ConsumableNotificationsConfig) instance ToSchema ConsumableNotificationsConfig where - schema = object "ConsumableNotificationsConfig" objectSchema + schema = object objectSchema instance Default (LockableFeature ConsumableNotificationsConfig) where def = defLockedFeature @@ -2006,7 +2000,7 @@ data ChatBubblesConfig = ChatBubblesConfig deriving (ParseDbFeature, Default) via TrivialFeature ChatBubblesConfig instance ToSchema ChatBubblesConfig where - schema = object "ChatBubblesConfig" objectSchema + schema = object objectSchema instance Default (LockableFeature ChatBubblesConfig) where def = defLockedFeature @@ -2028,7 +2022,7 @@ data AppsConfig = AppsConfig deriving (ParseDbFeature, Default) via TrivialFeature AppsConfig instance ToSchema AppsConfig where - schema = object "AppsConfig" objectSchema + schema = object objectSchema instance Default (LockableFeature AppsConfig) where def = defLockedFeature @@ -2053,7 +2047,7 @@ data SimplifiedUserConnectionRequestQRCodeConfig = SimplifiedUserConnectionReque deriving (ParseDbFeature, Default) via TrivialFeature SimplifiedUserConnectionRequestQRCodeConfig instance ToSchema SimplifiedUserConnectionRequestQRCodeConfig where - schema = object "SimplifiedUserConnectionRequestQRCode" objectSchema + schema = object objectSchema instance Default (LockableFeature SimplifiedUserConnectionRequestQRCodeConfig) where def = defUnlockedFeature @@ -2075,7 +2069,7 @@ data StealthUsersConfig = StealthUsersConfig deriving (ParseDbFeature, Default) via TrivialFeature StealthUsersConfig instance ToSchema StealthUsersConfig where - schema = object "StealthUsersConfig" objectSchema + schema = object objectSchema instance Default (LockableFeature StealthUsersConfig) where def = defLockedFeature @@ -2100,7 +2094,7 @@ data MeetingsConfig = MeetingsConfig deriving (ParseDbFeature, Default) via TrivialFeature MeetingsConfig instance ToSchema MeetingsConfig where - schema = object "MeetingsConfig" objectSchema + schema = object objectSchema instance Default (LockableFeature MeetingsConfig) where def = defUnlockedFeature @@ -2125,7 +2119,7 @@ data MeetingsPremiumConfig = MeetingsPremiumConfig deriving (ParseDbFeature, Default) via TrivialFeature MeetingsPremiumConfig instance ToSchema MeetingsPremiumConfig where - schema = object "MeetingsPremiumConfig" objectSchema + schema = object objectSchema instance Default (LockableFeature MeetingsPremiumConfig) where def = defLockedFeature @@ -2166,7 +2160,7 @@ instance ToHttpApiData FeatureStatus where instance ToSchema FeatureStatus where schema = - enum @Text "FeatureStatus" $ + enum @Text $ mconcat [ element "enabled" FeatureStatusEnabled, element "disabled" FeatureStatusDisabled @@ -2274,7 +2268,7 @@ instance (Typeable cfg, IsFeatureConfig cfg, ToSchema cfg) => FeatureFieldConstr instance ToSchema AllTeamFeatures where schema = - object "AllTeamFeatures" $ hobjectSchema @FeatureFieldConstraints featureField + object $ hobjectSchema @FeatureFieldConstraints featureField where featureField :: forall cfg. @@ -2441,7 +2435,7 @@ instance Default TeamFeatureMigrationState where instance ToSchema TeamFeatureMigrationState where schema = - enum @Text "TeamFeatureMigrationState" $ + enum @Text $ mconcat [ element "not_started" MigrationNotStarted, element "in_progress" MigrationInProgress, diff --git a/libs/wire-api/src/Wire/API/Team/Invitation.hs b/libs/wire-api/src/Wire/API/Team/Invitation.hs index b51e52a0ee..d658069b2c 100644 --- a/libs/wire-api/src/Wire/API/Team/Invitation.hs +++ b/libs/wire-api/src/Wire/API/Team/Invitation.hs @@ -74,7 +74,7 @@ instance ToSchema InvitationRequest where invitationRequestSchema :: Bool -> ValueSchema NamedSwaggerDoc InvitationRequest invitationRequestSchema allowExisting = - objectWithDocModifier "InvitationRequest" (DS.description ?~ "A request to join a team on Wire.") $ + objectWithDocModifier (DS.description ?~ "A request to join a team on Wire.") $ InvitationRequest <$> locale .= optFieldWithDocModifier "locale" (DS.description ?~ "Locale to use for the invitation.") (maybeWithDefault A.Null schema) @@ -191,7 +191,7 @@ data InvitationList = InvitationList instance ToSchema InvitationList where schema = - objectWithDocModifier "InvitationList" (DS.description ?~ "A list of sent team invitations.") $ + objectWithDocModifier (DS.description ?~ "A list of sent team invitations.") $ InvitationList <$> ilInvitations .= field "invitations" (array schema) <*> ilHasMore .= fieldWithDocModifier "has_more" (DS.description ?~ "Indicator that the server has more invitations than returned.") schema @@ -208,7 +208,7 @@ data AcceptTeamInvitation = AcceptTeamInvitation instance ToSchema AcceptTeamInvitation where schema = - objectWithDocModifier "AcceptTeamInvitation" (DS.description ?~ "Accept an invitation to join a team on Wire.") $ + objectWithDocModifier (DS.description ?~ "Accept an invitation to join a team on Wire.") $ AcceptTeamInvitation <$> (.code) .= fieldWithDocModifier "code" (DS.description ?~ "Invitation code to accept.") schema <*> (.password) .= fieldWithDocModifier "password" (DS.description ?~ "The user account password.") schema @@ -223,7 +223,7 @@ data InvitationUserView = InvitationUserView instance ToSchema InvitationUserView where schema = - object "InvitationUserView" $ + object $ InvitationUserView <$> invitation .= invitationObjectSchema <*> inviterEmail .= maybe_ (optField "created_by_email" schema) diff --git a/libs/wire-api/src/Wire/API/Team/LegalHold.hs b/libs/wire-api/src/Wire/API/Team/LegalHold.hs index c0bfa22047..a7c65addd2 100644 --- a/libs/wire-api/src/Wire/API/Team/LegalHold.hs +++ b/libs/wire-api/src/Wire/API/Team/LegalHold.hs @@ -60,7 +60,7 @@ data NewLegalHoldService = NewLegalHoldService instance ToSchema NewLegalHoldService where schema = - object "NewLegalHoldService" $ + object $ NewLegalHoldService <$> newLegalHoldServiceUrl .= field "base_url" schema <*> newLegalHoldServiceKey .= field "public_key" schema @@ -84,7 +84,7 @@ data LHServiceStatus = Configured | NotConfigured | Disabled instance ToSchema LHServiceStatus where schema = - enum @Text "LHServiceStatus" $ + enum @Text $ mconcat [ element "configured" Configured, element "not_configured" NotConfigured, @@ -93,7 +93,7 @@ instance ToSchema LHServiceStatus where instance ToSchema ViewLegalHoldService where schema = - object "ViewLegalHoldService" $ + object $ toOutput .= recordSchema `withParser` validateViewLegalHoldService @@ -132,7 +132,7 @@ data ViewLegalHoldServiceInfo = ViewLegalHoldServiceInfo instance ToSchema ViewLegalHoldServiceInfo where schema = - object "ViewLegalHoldServiceInfo" $ + object $ ViewLegalHoldServiceInfo <$> viewLegalHoldServiceTeam .= field "team_id" schema <*> viewLegalHoldServiceUrl .= field "base_url" schema @@ -156,7 +156,7 @@ data UserLegalHoldStatusResponse = UserLegalHoldStatusResponse instance ToSchema UserLegalHoldStatusResponse where schema = - object "UserLegalHoldStatusResponse" $ + object $ UserLegalHoldStatusResponse <$> ulhsrStatus .= field "status" schema <*> ulhsrLastPrekey .= maybe_ (optField "last_prekey" schema) @@ -174,7 +174,7 @@ data RemoveLegalHoldSettingsRequest = RemoveLegalHoldSettingsRequest instance ToSchema RemoveLegalHoldSettingsRequest where schema = - object "RemoveLegalHoldSettingsRequest" $ + object $ RemoveLegalHoldSettingsRequest <$> rmlhsrPassword .= maybe_ (optField "password" schema) @@ -190,7 +190,7 @@ data DisableLegalHoldForUserRequest = DisableLegalHoldForUserRequest instance ToSchema DisableLegalHoldForUserRequest where schema = - object "DisableLegalHoldForUserRequest" $ + object $ DisableLegalHoldForUserRequest <$> dlhfuPassword .= maybe_ (optField "password" schema) @@ -206,7 +206,7 @@ data ApproveLegalHoldForUserRequest = ApproveLegalHoldForUserRequest instance ToSchema ApproveLegalHoldForUserRequest where schema = - object "ApproveLegalHoldForUserRequest" $ + object $ ApproveLegalHoldForUserRequest <$> alhfuPassword .= maybe_ (optField "password" schema) diff --git a/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs b/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs index c49b6b196f..e481f22446 100644 --- a/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs +++ b/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs @@ -60,7 +60,7 @@ data RequestNewLegalHoldClientV0 = RequestNewLegalHoldClientV0 instance ToSchema RequestNewLegalHoldClientV0 where schema = - object "RequestNewLegalHoldClientV0" $ + object $ RequestNewLegalHoldClientV0 <$> (.userId) .= field "user_id" schema <*> (.teamId) .= field "team_id" schema @@ -75,7 +75,7 @@ data RequestNewLegalHoldClient = RequestNewLegalHoldClient instance ToSchema RequestNewLegalHoldClient where schema = - object "RequestNewLegalHoldClient" $ + object $ RequestNewLegalHoldClient <$> (.userId) .= field "qualified_user_id" schema <*> (.teamId) .= field "team_id" schema @@ -102,7 +102,7 @@ instance OpenApi.ToSchema NewLegalHoldClient where instance ToSchema NewLegalHoldClient where schema = - object "NewLegalHoldClient" $ + object $ NewLegalHoldClient <$> (.newLegalHoldClientPrekeys) .= field "prekeys" (array schema) <*> (.newLegalHoldClientLastKey) .= field "last_prekey" schema @@ -124,7 +124,7 @@ data LegalHoldServiceConfirm = LegalHoldServiceConfirm instance ToSchema LegalHoldServiceConfirm where schema = - object "LegalHoldServiceConfirm" $ + object $ LegalHoldServiceConfirm <$> (.clientId) .= field "client_id" schema <*> (.userId) .= field "qualified_user_id" schema @@ -144,7 +144,7 @@ data LegalHoldServiceConfirmV0 = LegalHoldServiceConfirmV0 instance ToSchema LegalHoldServiceConfirmV0 where schema = - object "LegalHoldServiceConfirmV0" $ + object $ LegalHoldServiceConfirmV0 <$> (.lhcClientId) .= field "client_id" schema <*> (.lhcUserId) .= field "user_id" schema @@ -165,7 +165,7 @@ data LegalHoldServiceRemove = LegalHoldServiceRemove instance ToSchema LegalHoldServiceRemove where schema = - object "LegalHoldServiceRemove" $ + object $ LegalHoldServiceRemove <$> (.userId) .= field "qualified_user_id" schema <*> (.teamId) .= field "team_id" schema @@ -180,7 +180,7 @@ data LegalHoldServiceRemoveV0 = LegalHoldServiceRemoveV0 instance ToSchema LegalHoldServiceRemoveV0 where schema = - object "LegalHoldServiceRemoveV0" $ + object $ LegalHoldServiceRemoveV0 <$> (.lhrUserId) .= field "user_id" schema <*> (.lhrTeamId) .= field "team_id" schema @@ -193,7 +193,7 @@ newtype SupportedVersions = SupportedVersions {supported :: [Int]} instance ToSchema SupportedVersions where schema = - object "SupportedVersions " $ + object $ SupportedVersions <$> supported .= field "supported" (array schema) diff --git a/libs/wire-api/src/Wire/API/Team/LegalHold/Internal.hs b/libs/wire-api/src/Wire/API/Team/LegalHold/Internal.hs index 7b269033d9..6e2fb5d545 100644 --- a/libs/wire-api/src/Wire/API/Team/LegalHold/Internal.hs +++ b/libs/wire-api/src/Wire/API/Team/LegalHold/Internal.hs @@ -92,8 +92,7 @@ data LegalHoldClientRequest = LegalHoldClientRequest instance Schema.ToSchema LegalHoldClientRequest where schema = - Schema.object - "LegalHoldClientRequest" - $ LegalHoldClientRequest + Schema.object $ + LegalHoldClientRequest <$> lhcrRequester Schema..= Schema.field "requester" Schema.schema <*> lhcrLastPrekey Schema..= Schema.field "last_prekey" Schema.schema diff --git a/libs/wire-api/src/Wire/API/Team/Member.hs b/libs/wire-api/src/Wire/API/Team/Member.hs index 8795e58f18..7a0b09dbe0 100644 --- a/libs/wire-api/src/Wire/API/Team/Member.hs +++ b/libs/wire-api/src/Wire/API/Team/Member.hs @@ -181,7 +181,7 @@ mkTeamMember :: mkTeamMember uid perms inv = TeamMember (NewTeamMember uid perms inv) instance ToSchema TeamMember where - schema = object "TeamMember" teamMemberObjectSchema + schema = object teamMemberObjectSchema teamMemberObjectSchema :: ObjectSchema SwaggerDoc TeamMember teamMemberObjectSchema = @@ -193,7 +193,7 @@ teamMemberObjectSchema = instance ToSchema (TeamMember' 'Optional) where schema = - objectWithDocModifier "TeamMember" (description ?~ "team member data") $ + objectWithDocModifier (description ?~ "team member data") $ TeamMember <$> _newTeamMember .= ( NewTeamMember @@ -249,7 +249,7 @@ mkSingleTeamMembersPage members = instance ToSchema TeamMembersPage where schema = - object "TeamMembersPage" $ + object $ TeamMembersPage <$> unTeamMembersPage .= ( MultiTablePage @@ -315,7 +315,7 @@ newTeamMemberList = TeamMemberList instance (Typeable tag, ToSchema (TeamMember' tag)) => ToSchema (TeamMemberList' tag) where schema = - objectWithDocModifier "TeamMemberList" (description ?~ "list of team member") $ + objectWithDocModifier (description ?~ "list of team member") $ TeamMemberList <$> _teamMembers .= fieldWithDocModifier "members" (description ?~ "the array of team members") (array schema) @@ -332,7 +332,7 @@ data NewListType instance ToSchema NewListType where schema = - enum @Text "NewListType" $ + enum @Text $ mconcat [ element "list_complete" NewListComplete, element "list_truncated" NewListTruncated @@ -353,7 +353,7 @@ data ListType -- though we do want this to remain true/false instance ToSchema ListType where schema = - enum @Bool "ListType" $ + enum @Bool $ mconcat [element True ListTruncated, element False ListComplete] -------------------------------------------------------------------------------- @@ -428,9 +428,9 @@ invitedSchema' = withParser invitedSchema $ \(invby, invat) -> instance ToSchema NewTeamMember where schema = - objectWithDocModifier "NewTeamMember" (description ?~ "Required data when creating new team members") $ + objectWithDocModifier (description ?~ "Required data when creating new team members") $ fieldWithDocModifier "member" (description ?~ "the team member to add (the legalhold_status field must be null or missing!)") $ - unnamed (object "Unnamed" newTeamMemberSchema) + unnamed (object newTeamMemberSchema) -------------------------------------------------------------------------------- -- TeamMemberDeleteData @@ -444,7 +444,7 @@ newtype TeamMemberDeleteData = TeamMemberDeleteData instance ToSchema TeamMemberDeleteData where schema = - objectWithDocModifier "TeamMemberDeleteData" (description ?~ "Data for a team member deletion request in case of binding teams.") $ + objectWithDocModifier (description ?~ "Data for a team member deletion request in case of binding teams.") $ TeamMemberDeleteData <$> _tmdAuthPassword .= optFieldWithDocModifier "password" (description ?~ "The account password to authorise the deletion.") (maybeWithDefault Null schema) newTeamMemberDeleteData :: Maybe PlainTextPassword6 -> TeamMemberDeleteData diff --git a/libs/wire-api/src/Wire/API/Team/Member/Info.hs b/libs/wire-api/src/Wire/API/Team/Member/Info.hs index ccf19fc205..96bf5960db 100644 --- a/libs/wire-api/src/Wire/API/Team/Member/Info.hs +++ b/libs/wire-api/src/Wire/API/Team/Member/Info.hs @@ -35,7 +35,7 @@ data TeamMemberInfo = TeamMemberInfo instance ToSchema TeamMemberInfo where schema = - object "TeamMemberInfo" $ + object $ TeamMemberInfo <$> (.userId) .= field "userId" schema <*> (.permissions) .= field "permissions" schema @@ -49,6 +49,6 @@ newtype TeamMemberInfoList = TeamMemberInfoList instance ToSchema TeamMemberInfoList where schema = - object "TeamMemberInfoList" $ + object $ TeamMemberInfoList <$> (.members) .= field "members" (array schema) diff --git a/libs/wire-api/src/Wire/API/Team/Permission.hs b/libs/wire-api/src/Wire/API/Team/Permission.hs index 974ef98926..3c6fdcfec4 100644 --- a/libs/wire-api/src/Wire/API/Team/Permission.hs +++ b/libs/wire-api/src/Wire/API/Team/Permission.hs @@ -69,7 +69,7 @@ data Permissions = Permissions permissionsSchema :: ValueSchema NamedSwaggerDoc Permissions permissionsSchema = - objectWithDocModifier "Permissions" (description ?~ docs) $ + objectWithDocModifier (description ?~ docs) $ Permissions <$> (permsToInt . self) .= fieldWithDocModifier "self" selfDoc (intToPerms <$> schema) <*> (permsToInt . copy) .= fieldWithDocModifier "copy" copyDoc (intToPerms <$> schema) diff --git a/libs/wire-api/src/Wire/API/Team/Role.hs b/libs/wire-api/src/Wire/API/Team/Role.hs index c3dc0ca89e..72b57d7e9f 100644 --- a/libs/wire-api/src/Wire/API/Team/Role.hs +++ b/libs/wire-api/src/Wire/API/Team/Role.hs @@ -88,7 +88,7 @@ data Role = RoleOwner | RoleAdmin | RoleMember | RoleExternalPartner instance ToSchema Role where schema = - enum @Text "Role" $ + enum @Text $ flip foldMap [minBound .. maxBound] $ \r -> element (roleName r) r diff --git a/libs/wire-api/src/Wire/API/Team/SearchVisibility.hs b/libs/wire-api/src/Wire/API/Team/SearchVisibility.hs index 76d530f6f1..b55bcb25c3 100644 --- a/libs/wire-api/src/Wire/API/Team/SearchVisibility.hs +++ b/libs/wire-api/src/Wire/API/Team/SearchVisibility.hs @@ -63,9 +63,8 @@ data TeamSearchVisibility instance ToSchema TeamSearchVisibility where schema = - enum @Text - "TeamSearchVisibility" - $ mconcat + enum @Text $ + mconcat [ element "standard" SearchVisibilityStandard, element "no-name-outside-team" SearchVisibilityNoNameOutsideTeam ] @@ -80,7 +79,7 @@ newtype TeamSearchVisibilityView = TeamSearchVisibilityView TeamSearchVisibility instance ToSchema TeamSearchVisibilityView where schema = - objectWithDocModifier "TeamSearchVisibilityView" (description ?~ "Search visibility value for the team") $ + objectWithDocModifier (description ?~ "Search visibility value for the team") $ TeamSearchVisibilityView <$> unwrap .= fieldWithDocModifier "search_visibility" (description ?~ "value of visibility") schema where diff --git a/libs/wire-api/src/Wire/API/Team/Size.hs b/libs/wire-api/src/Wire/API/Team/Size.hs index ce0d8fe646..d206113765 100644 --- a/libs/wire-api/src/Wire/API/Team/Size.hs +++ b/libs/wire-api/src/Wire/API/Team/Size.hs @@ -33,7 +33,7 @@ newtype TeamSize = TeamSize Natural instance ToSchema TeamSize where schema = - objectWithDocModifier "TeamSize" (description ?~ "A simple object with a total number of team members.") $ + objectWithDocModifier (description ?~ "A simple object with a total number of team members.") $ TeamSize <$> (unTeamSize .= fieldWithDocModifier "teamSize" (description ?~ "Team size.") schema) where unTeamSize :: TeamSize -> Natural diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 9435e0e4ad..889e22a619 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -244,7 +244,7 @@ newtype UserIdList = UserIdList {mUsers :: [UserId]} instance ToSchema UserIdList where schema = - object "UserIdList" $ + object $ UserIdList <$> mUsers .= field "user_ids" (array schema) @@ -263,7 +263,7 @@ newtype UserIds = UserIds instance ToSchema UserIds where schema = - object "UserIds" $ + object $ UserIds <$> cUsers .= field "ids" (array schema) @@ -278,7 +278,7 @@ newtype GetActivationCodeResp = GetActivationCodeResp {fromGetActivationCodeResp instance ToSchema GetActivationCodeResp where schema = - object "GetActivationCodeResp" $ + object $ curry GetActivationCodeResp <$> (fst . fromGetActivationCodeResp) .= field "key" schema <*> (snd . fromGetActivationCodeResp) .= field "code" schema @@ -290,7 +290,7 @@ newtype GetPasswordResetCodeResp = GetPasswordResetCodeResp {fromGetPasswordRese instance ToSchema GetPasswordResetCodeResp where schema = - object "GetPasswordResetCodeResp" $ + object $ curry GetPasswordResetCodeResp <$> (fst . fromGetPasswordResetCodeResp) .= field "key" schema <*> (snd . fromGetPasswordResetCodeResp) .= field "code" schema @@ -317,7 +317,7 @@ newtype ManagedByUpdate = ManagedByUpdate {mbuManagedBy :: ManagedBy} instance ToSchema ManagedByUpdate where schema = - object "ManagedByUpdate" $ + object $ ManagedByUpdate <$> mbuManagedBy .= field "managed_by" schema @@ -328,7 +328,7 @@ newtype RichInfoUpdate = RichInfoUpdate {riuRichInfo :: RichInfoAssocList} instance ToSchema RichInfoUpdate where schema = - object "RichInfoUpdate" $ + object $ RichInfoUpdate <$> riuRichInfo .= field "rich_info" schema @@ -396,14 +396,14 @@ updateConnectionsInternalTag (CreateConnectionForTest _ _) = CreateConnectionFor instance ToSchema UpdateConnectionsInternalTag where schema = - enum @Text "UpdateConnectionsInternalTag" $ + enum @Text $ element "BlockForMissingLHConsent" BlockForMissingLHConsentTag <> element "RemoveLHBlocksInvolving" RemoveLHBlocksInvolvingTag <> element "CreateConnectionForTest" CreateConnectionForTestTag instance ToSchema UpdateConnectionsInternal where schema = - object "UpdateConnectionsInternal" $ + object $ snd <$> (updateConnectionsInternalTag &&& id) .= bind @@ -446,7 +446,7 @@ newtype QualifiedUserIdList = QualifiedUserIdList {qualifiedUserIdList :: [Quali instance ToSchema QualifiedUserIdList where schema = - object "QualifiedUserIdList" qualifiedUserIdListObjectSchema + object qualifiedUserIdListObjectSchema qualifiedUserIdListObjectSchema :: ObjectSchema SwaggerDoc QualifiedUserIdList qualifiedUserIdListObjectSchema = @@ -489,7 +489,7 @@ instance Default UserType where instance ToSchema UserType where schema = - Schema.enum @Text "UserType" $ + Schema.enum @Text $ mconcat [ Schema.element "regular" UserTypeRegular, Schema.element "app" UserTypeApp, @@ -543,7 +543,7 @@ data UserProfile = UserProfile deriving (FromJSON, ToJSON, S.ToSchema) via (Schema UserProfile) instance ToSchema UserProfile where - schema = object "UserProfile" userProfileObjectSchema + schema = object userProfileObjectSchema userProfileObjectSchema :: ObjectSchema SwaggerDoc UserProfile userProfileObjectSchema = @@ -657,7 +657,7 @@ userDeleted u = userStatus u == Deleted -- -- FUTUREWORK: -- -- disentangle json serializations for 'User', 'NewUser', 'UserIdentity', 'NewUserOrigin'. instance ToSchema User where - schema = object "User" userObjectSchema + schema = object userObjectSchema userObjectSchema :: ObjectSchema SwaggerDoc User userObjectSchema = @@ -850,7 +850,7 @@ data CreateUserTeam = CreateUserTeam instance ToSchema CreateUserTeam where schema = - object "CreateUserTeam" $ + object $ CreateUserTeam <$> createdTeamId .= field "team_id" schema <*> createdTeamName .= field "team_name" schema @@ -1016,7 +1016,7 @@ data NewUserSpar = NewUserSpar instance ToSchema NewUserSpar where schema = - object "NewUserSpar" $ + object $ NewUserSpar <$> newUserSparUUID .= field "newUserSparUUID" genericToSchema @@ -1169,7 +1169,7 @@ newUserRawObjectSchema = instance ToSchema (NewUser PlainTextPassword8) where schema = - object "NewUser" $ newUserToRaw .= withParser newUserRawObjectSchema newUserFromRaw + object $ newUserToRaw .= withParser newUserRawObjectSchema newUserFromRaw newUserToRaw :: NewUser PlainTextPassword8 -> NewUserRaw newUserToRaw NewUser {..} = @@ -1385,7 +1385,7 @@ data BindingNewTeamUser = BindingNewTeamUser instance ToSchema BindingNewTeamUser where schema = - object "BindingNewTeamUser" $ + object $ BindingNewTeamUser <$> bnuTeam .= newTeamObjectSchema @@ -1405,7 +1405,7 @@ data ScimUserInfo = ScimUserInfo instance ToSchema ScimUserInfo where schema = - object "ScimUserInfo" $ + object $ ScimUserInfo <$> suiUserId .= field "id" schema @@ -1426,7 +1426,7 @@ newtype UserSet = UserSet instance ToSchema UserSet where schema = - object "UserSet" $ + object $ UserSet <$> usUsrs .= field "users" (set schema) @@ -1448,7 +1448,7 @@ data UserUpdate = UserUpdate instance ToSchema UserUpdate where schema = - object "UserUpdate" $ + object $ UserUpdate <$> uupName .= maybe_ (optField "name" schema) @@ -1494,7 +1494,7 @@ instance ToSchema PasswordChange where ?~ "Data to change a password. The old password is required if \ \a password already exists." ) - . object "PasswordChange" + . object $ PasswordChange <$> oldPassword .= maybe_ (optField "old_password" schema) @@ -1530,7 +1530,7 @@ newtype LocaleUpdate = LocaleUpdate {luLocale :: Locale} instance ToSchema LocaleUpdate where schema = - object "LocaleUpdate" $ + object $ LocaleUpdate <$> luLocale .= field "locale" schema @@ -1542,7 +1542,7 @@ newtype EmailUpdate = EmailUpdate {euEmail :: EmailAddress} instance ToSchema EmailUpdate where schema = - object "EmailUpdate" $ + object $ EmailUpdate <$> euEmail .= field "email" schema @@ -1596,7 +1596,7 @@ newtype PhoneUpdate = PhoneUpdate {puPhone :: Phone} instance ToSchema PhoneUpdate where schema = - object "PhoneUpdate" $ + object $ PhoneUpdate <$> puPhone .= field "phone" schema @@ -1648,7 +1648,7 @@ newtype HandleUpdate = HandleUpdate {huHandle :: Text} instance ToSchema HandleUpdate where schema = - object "HandleUpdate" $ + object $ HandleUpdate <$> huHandle .= field "handle" schema data ChangeHandleError @@ -1682,7 +1682,7 @@ newtype NameUpdate = NameUpdate {nuHandle :: Text} instance ToSchema NameUpdate where schema = - object "NameUpdate" $ + object $ NameUpdate <$> nuHandle .= field "name" schema data ChangeEmailResponse @@ -1720,7 +1720,7 @@ newtype DeleteUser = DeleteUser instance ToSchema DeleteUser where schema = - object "DeleteUser" $ + object $ DeleteUser <$> deleteUserPassword .= maybe_ (optField "password" schema) @@ -1750,7 +1750,7 @@ data VerifyDeleteUser = VerifyDeleteUser instance ToSchema VerifyDeleteUser where schema = - objectWithDocModifier "VerifyDeleteUser" (Schema.description ?~ "Data for verifying an account deletion.") $ + objectWithDocModifier (Schema.description ?~ "Data for verifying an account deletion.") $ VerifyDeleteUser <$> verifyDeleteUserKey .= fieldWithDocModifier "key" (Schema.description ?~ "The identifying key of the account (i.e. user ID).") schema @@ -1766,7 +1766,7 @@ newtype DeletionCodeTimeout = DeletionCodeTimeout instance ToSchema DeletionCodeTimeout where schema = - object "DeletionCodeTimeout" $ + object $ DeletionCodeTimeout <$> fromDeletionCodeTimeout .= field "expires_in" schema @@ -1858,7 +1858,7 @@ data AccountStatus instance Schema.ToSchema AccountStatus where schema = - Schema.enum @Text "AccountStatus" $ + Schema.enum @Text $ mconcat [ Schema.element "active" Active, Schema.element "suspended" Suspended, @@ -1892,7 +1892,7 @@ data AccountStatusResp = AccountStatusResp {fromAccountStatusResp :: AccountStat instance Schema.ToSchema AccountStatusResp where schema = - object "AccountStatusResp" $ + object $ AccountStatusResp <$> fromAccountStatusResp .= field "status" schema newtype AccountStatusUpdate = AccountStatusUpdate {suStatus :: AccountStatus} @@ -1902,7 +1902,7 @@ newtype AccountStatusUpdate = AccountStatusUpdate {suStatus :: AccountStatus} instance Schema.ToSchema AccountStatusUpdate where schema = - object "AccountStatusUpdate" $ + object $ AccountStatusUpdate <$> suStatus .= field "status" schema ------------------------------------------------------------------------------- @@ -1927,7 +1927,7 @@ data NewUserScimInvitation = NewUserScimInvitation instance Schema.ToSchema NewUserScimInvitation where schema = - Schema.object "NewUserScimInvitation" $ + Schema.object $ NewUserScimInvitation <$> newUserScimInvTeamId Schema..= Schema.field "team_id" Schema.schema <*> newUserScimInvUserId Schema..= Schema.field "user_id" Schema.schema @@ -1950,7 +1950,7 @@ data VerificationAction instance ToSchema VerificationAction where schema = - enum @Text "VerificationAction" $ + enum @Text $ mconcat [ element "create_scim_token" CreateScimToken, element "login" Login, @@ -1998,7 +1998,7 @@ data SendVerificationCode = SendVerificationCode instance ToSchema SendVerificationCode where schema = - object "SendVerificationCode" $ + object $ SendVerificationCode <$> svcAction .= field "action" schema @@ -2034,7 +2034,7 @@ baseProtocolToProtocol BaseProtocolMLSTag = ProtocolMLSTag instance ToSchema BaseProtocolTag where schema = - enum @Text "BaseProtocol" $ + enum @Text $ mconcat [ element "proteus" BaseProtocolProteusTag, element "mls" BaseProtocolMLSTag @@ -2066,7 +2066,7 @@ newtype SupportedProtocolUpdate = SupportedProtocolUpdate instance ToSchema SupportedProtocolUpdate where schema = - object "SupportedProtocolUpdate" $ + object $ SupportedProtocolUpdate <$> unSupportedProtocolUpdate .= field "supported_protocols" (set schema) @@ -2081,7 +2081,7 @@ data ListUsersById = ListUsersById instance ToSchema ListUsersById where schema = - object "ListUsersById" $ + object $ ListUsersById <$> listUsersByIdFound .= field "found" (array schema) <*> listUsersByIdFailed .= maybe_ (optField "failed" $ nonEmptyArray schema) @@ -2133,7 +2133,7 @@ instance ToSchema Category where instance ToSchema NewApp where schema = - object "NewApp" $ + object $ NewApp <$> (.name) .= field "name" schema <*> (.assets) .= (fromMaybe [] <$> optField "assets" (array schema)) @@ -2143,7 +2143,7 @@ instance ToSchema NewApp where <*> (.password) .= field "password" schema instance ToSchema AppInfo where - schema = object "AppInfo" appInfoObjectSchema + schema = object appInfoObjectSchema appInfoObjectSchema :: ObjectSchema SwaggerDoc AppInfo appInfoObjectSchema = @@ -2153,7 +2153,7 @@ appInfoObjectSchema = instance ToSchema PutApp where schema = - object "PutApp" $ + object $ PutApp <$> (.name) .= maybe_ (optField "name" schema) <*> (.assets) .= maybe_ (optField "assets" (array schema)) @@ -2170,7 +2170,7 @@ data CreatedApp = CreatedApp instance ToSchema CreatedApp where schema = - object "CreatedApp" $ + object $ CreatedApp <$> (.user) .= field "user" schema <*> (.cookie) .= field "cookie" schema @@ -2182,7 +2182,7 @@ newtype RefreshAppCookieRequest = RefreshAppCookieRequest instance ToSchema RefreshAppCookieRequest where schema = - object "RefreshAppCookieRequest" $ + object $ RefreshAppCookieRequest <$> (.password) .= optFieldWithDocModifier @@ -2199,5 +2199,5 @@ newtype RefreshAppCookieResponse = RefreshAppCookieResponse instance ToSchema RefreshAppCookieResponse where schema = - object "RefreshAppCookieResponse" $ + object $ RefreshAppCookieResponse <$> (.cookie) .= field "cookie" schema diff --git a/libs/wire-api/src/Wire/API/User/Activation.hs b/libs/wire-api/src/Wire/API/User/Activation.hs index 3df4052062..275aa5b4ac 100644 --- a/libs/wire-api/src/Wire/API/User/Activation.hs +++ b/libs/wire-api/src/Wire/API/User/Activation.hs @@ -119,7 +119,7 @@ data Activate = Activate instance ToSchema Activate where schema = - objectWithDocModifier "Activate" objectDocs $ + objectWithDocModifier objectDocs $ Activate <$> (maybeActivationTargetToTuple . activateTarget) .= maybeActivationTargetObjectSchema <*> activateCode .= fieldWithDocModifier "code" codeDocs schema @@ -182,7 +182,7 @@ data ActivationResponse = ActivationResponse instance ToSchema ActivationResponse where schema = - objectWithDocModifier "ActivationResponse" (description ?~ "Response body of a successful activation request") $ + objectWithDocModifier (description ?~ "Response body of a successful activation request") $ ActivationResponse <$> activatedIdentity .= userIdentityObjectSchema <*> activatedFirst .= (fromMaybe False <$> optFieldWithDocModifier "first" (description ?~ "Whether this is the first successful activation (i.e. account activation).") schema) @@ -202,7 +202,7 @@ data SendActivationCode = SendActivationCode instance ToSchema SendActivationCode where schema = - objectWithDocModifier "SendActivationCode" objectDesc $ + objectWithDocModifier objectDesc $ SendActivationCode <$> emailKey .= field "email" schema <*> locale diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index 7d592bdf2b..bfa5a475f0 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -103,7 +103,7 @@ data LoginId -- NB. this should fail if (e.g.) the email is present but unparseable even if -- the JSON contains a valid handle. instance ToSchema LoginId where - schema = object "LoginId" loginObjectSchema + schema = object loginObjectSchema loginObjectSchema :: ObjectSchema SwaggerDoc LoginId loginObjectSchema = @@ -149,7 +149,7 @@ data PendingLoginCode = PendingLoginCode instance ToSchema PendingLoginCode where schema = - object "PendingLoginCode" $ + object $ PendingLoginCode <$> pendingLoginCode .= field "code" schema <*> pendingLoginTimeout .= field "expires_in" schema @@ -170,7 +170,6 @@ data SendLoginCode = SendLoginCode instance ToSchema SendLoginCode where schema = objectWithDocModifier - "SendLoginCode" (description ?~ "Payload for requesting a login code to be sent") $ SendLoginCode <$> lcPhone @@ -201,7 +200,6 @@ newtype LoginCodeTimeout = LoginCodeTimeout instance ToSchema LoginCodeTimeout where schema = objectWithDocModifier - "LoginCodeTimeout" (description ?~ "A response for a successfully sent login code") $ LoginCodeTimeout <$> fromLoginCodeTimeout @@ -223,7 +221,6 @@ data CookieList = CookieList instance ToSchema CookieList where schema = objectWithDocModifier - "CookieList" (description ?~ "List of cookie information") $ CookieList <$> cookieList .= field "cookies" (array schema) @@ -244,7 +241,7 @@ data Cookie a = Cookie instance ToSchema (Cookie ()) where schema = - object "Cookie" $ + object $ Cookie <$> cookieId .= field "id" schema <*> cookieType .= field "type" schema @@ -326,7 +323,7 @@ instance Cql CookieType where instance ToSchema CookieType where schema = - enum @Text "CookieType" $ + enum @Text $ element "session" SessionCookie <> element "persistent" PersistentCookie @@ -348,7 +345,7 @@ data Login = MkLogin instance ToSchema Login where schema = - object "Login" $ + object $ MkLogin <$> lId .= loginObjectSchema <*> lPassword .= field "password" schema @@ -370,7 +367,6 @@ data RemoveCookies = RemoveCookies instance ToSchema RemoveCookies where schema = objectWithDocModifier - "RemoveCookies" (description ?~ "Data required to remove cookies") $ RemoveCookies <$> rmCookiesPassword @@ -411,7 +407,7 @@ data AccessToken = AccessToken instance ToSchema AccessToken where schema = - object "AccessToken" $ + object $ AccessToken <$> user .= field "user" schema <*> @@ -448,7 +444,7 @@ data TokenType = Bearer deriving (FromJSON, ToJSON, S.ToSchema) via Schema TokenType instance ToSchema TokenType where - schema = enum @Text "TokenType" $ element "Bearer" Bearer + schema = enum @Text $ element "Bearer" Bearer -------------------------------------------------------------------------------- -- Access diff --git a/libs/wire-api/src/Wire/API/User/Auth/LegalHold.hs b/libs/wire-api/src/Wire/API/User/Auth/LegalHold.hs index b1f20c416a..00f49b844d 100644 --- a/libs/wire-api/src/Wire/API/User/Auth/LegalHold.hs +++ b/libs/wire-api/src/Wire/API/User/Auth/LegalHold.hs @@ -38,7 +38,7 @@ data LegalHoldLogin = LegalHoldLogin instance ToSchema LegalHoldLogin where schema = - object "LegalHoldLogin" $ + object $ LegalHoldLogin <$> lhlUserId .= field "user" schema <*> lhlPassword .= optField "password" (maybeWithDefault A.Null schema) diff --git a/libs/wire-api/src/Wire/API/User/Auth/ReAuth.hs b/libs/wire-api/src/Wire/API/User/Auth/ReAuth.hs index 0892089a90..70a0c8bb3b 100644 --- a/libs/wire-api/src/Wire/API/User/Auth/ReAuth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth/ReAuth.hs @@ -42,7 +42,7 @@ data ReAuthUser = ReAuthUser instance ToSchema ReAuthUser where schema = - object "ReAuthUser" $ + object $ ReAuthUser <$> reAuthPassword .= optField "password" (maybeWithDefault A.Null schema) <*> reAuthCode .= optField "verification_code" (maybeWithDefault A.Null schema) diff --git a/libs/wire-api/src/Wire/API/User/Auth/Sso.hs b/libs/wire-api/src/Wire/API/User/Auth/Sso.hs index 0c9daa8685..c3d37d1ec5 100644 --- a/libs/wire-api/src/Wire/API/User/Auth/Sso.hs +++ b/libs/wire-api/src/Wire/API/User/Auth/Sso.hs @@ -34,7 +34,7 @@ data SsoLogin = SsoLogin instance ToSchema SsoLogin where schema = - object "SsoLogin" $ + object $ SsoLogin <$> ssoUserId .= field "user" schema <*> ssoLabel .= optField "label" (maybeWithDefault A.Null schema) diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index 0e490f0ff3..ce2577ff69 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -154,7 +154,7 @@ data ClientCapability instance ToSchema ClientCapability where schema = - enum @Text "ClientCapability" $ + enum @Text $ element "legalhold-implicit-consent" ClientSupportsLegalholdImplicitConsent <> element "consumable-notifications" ClientSupportsConsumableNotifications @@ -163,7 +163,7 @@ data ClientCapabilityV7 = ClientSupportsLegalholdImplicitConsentV7 capabilitySchemaV7 :: ValueSchema NamedSwaggerDoc ClientCapabilityV7 capabilitySchemaV7 = - enum @Text "ClientCapabilityV7" $ + enum @Text $ element "legalhold-implicit-consent" ClientSupportsLegalholdImplicitConsentV7 clientCapabilityFromV7 :: ClientCapabilityV7 -> ClientCapability @@ -193,7 +193,7 @@ instance ToSchema ClientCapabilityList where instance ToSchema (Versioned V6 ClientCapabilityList) where schema = - object "ClientCapabilityListV6Wrapper" $ + object $ Versioned <$> unVersioned .= field "capabilities" (capabilitiesSchema (Just V6)) @@ -333,7 +333,7 @@ instance Arbitrary QualifiedUserClientPrekeyMapV4 where instance ToSchema QualifiedUserClientPrekeyMapV4 where schema = - object "QualifiedUserClientPrekeyMapV4" $ + object $ QualifiedUserClientPrekeyMapV4 <$> fmap to' (from' .= field "qualified_user_client_prekeys" (map_ schema)) <*> failedToList .= maybe_ (optField "failed_to_list" (array schema)) @@ -385,7 +385,7 @@ data ClientInfo = ClientInfo instance ToSchema ClientInfo where schema = - object "ClientInfo" $ + object $ ClientInfo <$> (.clientId) .= field "id" schema <*> (.mlsSignatureKey) .= maybe_ (optField "mls_signature_key" base64Schema) @@ -604,7 +604,7 @@ data ClientList = ClientList {clClients :: [ClientId]} instance ToSchema ClientList where schema = - object "ClientList" $ + object $ ClientList <$> clClients .= field "client_ids" (array schema) @@ -623,7 +623,7 @@ data PubClient = PubClient instance ToSchema PubClient where schema = - object "PubClient" $ + object $ PubClient <$> pubClientId .= field "id" schema <*> pubClientClass .= maybe_ (optField "class" schema) @@ -659,7 +659,7 @@ data ClientType instance ToSchema ClientType where schema = - enum @Text "ClientType" $ + enum @Text $ element "temporary" TemporaryClientType <> element "permanent" PermanentClientType <> element "legalhold" LegalHoldClientType @@ -686,7 +686,7 @@ data ClientClass instance ToSchema ClientClass where schema = - enum @Text "ClientClass" $ + enum @Text $ element "phone" PhoneClient <> element "tablet" TabletClient <> element "desktop" DesktopClient @@ -727,7 +727,7 @@ data NewClient = NewClient newClientSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc NewClient newClientSchema mVersion = - object "NewClient" $ + object $ NewClient <$> newClientPrekeys .= fieldWithDocModifier @@ -846,7 +846,7 @@ defUpdateClient = updateClientSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc UpdateClient updateClientSchema mVersion = - object "UpdateClient" $ + object $ UpdateClient <$> updateClientPrekeys .= ( fromMaybe [] @@ -899,7 +899,7 @@ newtype RmClient = RmClient instance ToSchema RmClient where schema = - object "DeleteClient" $ + object $ RmClient <$> rmPassword .= optFieldWithDocModifier diff --git a/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs b/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs index 980e376e7f..90b4494d0b 100644 --- a/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs +++ b/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs @@ -77,7 +77,7 @@ data AccessTokenType = DPoP instance ToSchema AccessTokenType where schema = - enum @Text "AccessTokenType" $ + enum @Text $ mconcat [ element "DPoP" DPoP ] @@ -92,7 +92,7 @@ data DPoPAccessTokenResponse = DPoPAccessTokenResponse instance ToSchema DPoPAccessTokenResponse where schema = - object "DPoPAccessTokenResponse" $ + object $ DPoPAccessTokenResponse <$> datrToken .= field "token" schema <*> datrType .= field "type" schema diff --git a/libs/wire-api/src/Wire/API/User/Client/Prekey.hs b/libs/wire-api/src/Wire/API/User/Client/Prekey.hs index 379b34f9e4..86541a4685 100644 --- a/libs/wire-api/src/Wire/API/User/Client/Prekey.hs +++ b/libs/wire-api/src/Wire/API/User/Client/Prekey.hs @@ -147,7 +147,7 @@ data UncheckedPrekeyBundle = UncheckedPrekeyBundle instance ToSchema UncheckedPrekeyBundle where schema = - object "UncheckedPrekeyBundle" $ + object $ UncheckedPrekeyBundle <$> prekeyId .= field "id" schema <*> prekeyKey .= field "key" schema @@ -285,7 +285,7 @@ data PrekeyBundle = PrekeyBundle instance ToSchema PrekeyBundle where schema = - object "PrekeyBundle" $ + object $ PrekeyBundle <$> prekeyUser .= field "user" schema <*> prekeyClients .= field "clients" (array schema) @@ -303,7 +303,7 @@ data ClientPrekey = ClientPrekey instance ToSchema ClientPrekey where schema = - object "ClientPrekey" $ + object $ ClientPrekey <$> prekeyClient .= field "client" schema <*> prekeyData .= field "prekey" schema diff --git a/libs/wire-api/src/Wire/API/User/Handle.hs b/libs/wire-api/src/Wire/API/User/Handle.hs index 3db27ef8c1..29e37493bf 100644 --- a/libs/wire-api/src/Wire/API/User/Handle.hs +++ b/libs/wire-api/src/Wire/API/User/Handle.hs @@ -45,7 +45,7 @@ newtype UserHandleInfo = UserHandleInfo {userHandleId :: Qualified UserId} instance ToSchema UserHandleInfo where schema = - object "UserHandleInfo" $ + object $ UserHandleInfo <$> userHandleId .= field "qualified_user" schema <* (qUnqualified . userHandleId) @@ -80,7 +80,7 @@ instance FromJSON CheckHandles where instance ToSchema CheckHandles where schema = - object "CheckHandles" $ + object $ CheckHandles <$> checkHandlesList .= field "handles" (fromRange .= rangedSchema (array schema)) <*> checkHandlesNum .= field "return" schema diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index 8a67a4b492..df3125a034 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -91,7 +91,6 @@ data WireIdP = WireIdP instance Schema.ToSchema WireIdP where schema = Schema.object - "WireIdP" ( WireIdP <$> _team Schema..= Schema.field "team" Schema.schema <*> _apiVersion Schema..= Schema.field "apiVersion" (Schema.nullable (Schema.unnamed Schema.schema)) @@ -112,7 +111,7 @@ data WireIdPAPIVersion instance Schema.ToSchema WireIdPAPIVersion where schema = - Schema.enum @Text "WireIdPAPIVersion" $ + Schema.enum @Text $ mconcat [ Schema.element "WireIdPAPIV1" WireIdPAPIV1, Schema.element "WireIdPAPIV2" WireIdPAPIV2 diff --git a/libs/wire-api/src/Wire/API/User/Orphans.hs b/libs/wire-api/src/Wire/API/User/Orphans.hs index c3d44c7084..326ed41e35 100644 --- a/libs/wire-api/src/Wire/API/User/Orphans.hs +++ b/libs/wire-api/src/Wire/API/User/Orphans.hs @@ -128,7 +128,7 @@ instance O.ToSchema X509.SignedCertificate where declareNamedSchema _ = declareNamedSchema (Proxy @String) instance S.ToSchema Currency.Alpha where - schema = S.enum @Text "Currency.Alpha" cases & S.doc' . O.schema %~ swaggerTweaks + schema = S.enum @Text cases & S.doc' . O.schema %~ swaggerTweaks where cases :: SchemaP [A.Value] Text (Alt Maybe Text) Currency.Alpha Currency.Alpha cases = mconcat ((\cur -> S.element (T.pack (show cur)) cur) <$> [minBound @Currency.Alpha ..]) diff --git a/libs/wire-api/src/Wire/API/User/Password.hs b/libs/wire-api/src/Wire/API/User/Password.hs index 33ad254da7..079ccde88f 100644 --- a/libs/wire-api/src/Wire/API/User/Password.hs +++ b/libs/wire-api/src/Wire/API/User/Password.hs @@ -70,7 +70,7 @@ data NewPasswordReset instance ToSchema NewPasswordReset where schema = - objectWithDocModifier "NewPasswordReset" objectDesc $ + objectWithDocModifier objectDesc $ (toTuple .= newPasswordResetTupleObjectSchema) `withParser` fromTuple where objectDesc :: NamedSwaggerDoc -> NamedSwaggerDoc @@ -115,7 +115,7 @@ data CompletePasswordReset = CompletePasswordReset instance ToSchema CompletePasswordReset where schema = - objectWithDocModifier "CompletePasswordReset" objectDocs $ + objectWithDocModifier objectDocs $ CompletePasswordReset <$> (maybePasswordResetIdentityToTuple . cpwrIdent) .= maybePasswordResetIdentityObjectSchema <*> cpwrCode .= fieldWithDocModifier "code" codeDocs schema @@ -219,7 +219,7 @@ data PasswordReset = PasswordReset instance ToSchema PasswordReset where schema = - objectWithDocModifier "PasswordReset" objectDocs $ + objectWithDocModifier objectDocs $ PasswordReset <$> pwrCode .= fieldWithDocModifier "code" codeDocs schema <*> pwrPassword .= fieldWithDocModifier "password" pwDocs schema diff --git a/libs/wire-api/src/Wire/API/User/Profile.hs b/libs/wire-api/src/Wire/API/User/Profile.hs index 372e980cab..3fba25d81c 100644 --- a/libs/wire-api/src/Wire/API/User/Profile.hs +++ b/libs/wire-api/src/Wire/API/User/Profile.hs @@ -127,16 +127,14 @@ data Asset = ImageAsset instance ToSchema Asset where schema = - object "UserAsset" $ + object $ ImageAsset <$> assetKey .= field "key" schema <*> assetSize .= maybe_ (optField "size" schema) <* const () .= field "type" typeSchema where typeSchema :: ValueSchema NamedSwaggerDoc () - typeSchema = - enum @Text @NamedSwaggerDoc "AssetType" $ - element "image" () + typeSchema = enum @Text $ element "image" () instance C.Cql Asset where -- Note: Type name and column names and types must match up with the @@ -184,7 +182,7 @@ data AssetSize = AssetComplete | AssetPreview instance ToSchema AssetSize where schema = - enum @Text "AssetSize" $ + enum @Text $ mconcat [ element "preview" AssetPreview, element "complete" AssetComplete @@ -226,7 +224,7 @@ data ManagedBy instance ToSchema ManagedBy where schema = - enum @Text "ManagedBy" $ + enum @Text $ mconcat [ element "wire" ManagedByWire, element "scim" ManagedByScim diff --git a/libs/wire-api/src/Wire/API/User/RichInfo.hs b/libs/wire-api/src/Wire/API/User/RichInfo.hs index 5309c4892d..c53a1e611e 100644 --- a/libs/wire-api/src/Wire/API/User/RichInfo.hs +++ b/libs/wire-api/src/Wire/API/User/RichInfo.hs @@ -342,7 +342,7 @@ instance ToSchema RichField where -- "value": ...}@ is how all other SCIM payloads are formatted, so it's quite possible -- that some provisioning agent would support "type" but not "name". schema = - object "RichField" $ + object $ RichField <$> richFieldType .= field "type" (CI.original .= (CI.mk <$> schema)) <*> richFieldValue .= field "value" schema diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index 174a4ef6b1..a0782f785e 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -172,7 +172,7 @@ instance ToHttpApiData ScimToken where instance ToSchema ScimTokenInfo where schema = - object "ScimTokenInfo" $ + object $ ScimTokenInfo <$> (.stiTeam) .= field "team" schema <*> (.stiId) .= field "id" schema @@ -201,7 +201,7 @@ data ScimTokenInfoV7 = ScimTokenInfoV7 instance ToSchema ScimTokenInfoV7 where schema = - object "ScimTokenInfoV7" $ + object $ ScimTokenInfoV7 <$> (.stiTeam) .= field "team" schema <*> (.stiId) .= field "id" schema @@ -468,7 +468,7 @@ data CreateScimTokenResponse = CreateScimTokenResponse instance ToSchema CreateScimTokenResponse where schema = - object "CreateScimTokenResponse" $ + object $ CreateScimTokenResponse <$> (.token) .= field "token" schema <*> (.info) .= field "info" schema @@ -483,7 +483,7 @@ data CreateScimTokenResponseV7 = CreateScimTokenResponseV7 instance ToSchema CreateScimTokenResponseV7 where schema = - object "CreateScimTokenResponseV7" $ + object $ CreateScimTokenResponseV7 <$> (.token) .= field "token" schema <*> (.info) .= field "info" schema @@ -499,7 +499,7 @@ data ScimTokenList = ScimTokenList deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema ScimTokenList) instance ToSchema ScimTokenList where - schema = object "ScimTokenList" $ ScimTokenList <$> (.scimTokenListTokens) .= field "tokens" (array schema) + schema = object $ ScimTokenList <$> (.scimTokenListTokens) .= field "tokens" (array schema) data ScimTokenListV7 = ScimTokenListV7 { scimTokenListTokens :: [ScimTokenInfoV7] @@ -508,11 +508,11 @@ data ScimTokenListV7 = ScimTokenListV7 deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema ScimTokenListV7) instance ToSchema ScimTokenListV7 where - schema = object "ScimTokenListV7" $ ScimTokenListV7 <$> (.scimTokenListTokens) .= field "tokens" (array schema) + schema = object $ ScimTokenListV7 <$> (.scimTokenListTokens) .= field "tokens" (array schema) newtype ScimTokenName = ScimTokenName {fromScimTokenName :: Text} deriving (Eq, Show) deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema ScimTokenName) instance ToSchema ScimTokenName where - schema = object "ScimTokenName" $ ScimTokenName <$> fromScimTokenName .= field "name" schema + schema = object $ ScimTokenName <$> fromScimTokenName .= field "name" schema diff --git a/libs/wire-api/src/Wire/API/User/Search.hs b/libs/wire-api/src/Wire/API/User/Search.hs index 25ac61f78d..808b4050d0 100644 --- a/libs/wire-api/src/Wire/API/User/Search.hs +++ b/libs/wire-api/src/Wire/API/User/Search.hs @@ -158,7 +158,7 @@ data Contact = Contact instance ToSchema Contact where schema = - objectWithDocModifier "Contact" (description ?~ "Contact discovered through search") $ + objectWithDocModifier (description ?~ "Contact discovered through search") $ Contact <$> contactQualifiedId .= field "qualified_id" schema <* (qUnqualified . contactQualifiedId) .= optField "id" schema @@ -182,7 +182,7 @@ data Sso = Sso instance ToSchema Sso where schema = - object "Sso" $ + object $ Sso <$> ssoIssuer .= field "issuer" schema <*> ssoNameId .= field "nameid" schema @@ -212,7 +212,7 @@ data TeamContact = TeamContact instance ToSchema TeamContact where schema = - object "TeamContact" $ + object $ TeamContact <$> teamContactUserId .= field "id" schema <*> teamContactUserType .= field "type" schema @@ -332,7 +332,7 @@ userTypeFilterToUserType UserTypeFilterApp = UserTypeApp instance ToSchema UserTypeFilter where schema = - enum @Text "UserTypeFilter" $ + enum @Text $ mconcat [ element "regular" UserTypeFilterRegular, element "app" UserTypeFilterApp @@ -363,7 +363,7 @@ data FederatedUserSearchPolicy instance ToSchema FederatedUserSearchPolicy where schema = - enum @Text "FederatedUserSearchPolicy" $ + enum @Text $ element "no_search" NoSearch <> element "exact_handle_search" ExactHandleSearch <> element "full_search" FullSearch @@ -389,7 +389,7 @@ data EmailVerificationFilter instance ToSchema EmailVerificationFilter where schema = - enum @Text "EmailVerificationFilter" $ + enum @Text $ element "unverified" EmailUnverified <> element "verified" EmailVerified @@ -424,6 +424,6 @@ data SetSearchable = SetSearchable instance ToSchema SetSearchable where schema = - object "SetSearchable" $ + object $ SetSearchable <$> setSearchable .= field "set_searchable" schema diff --git a/libs/wire-api/src/Wire/API/UserEvent.hs b/libs/wire-api/src/Wire/API/UserEvent.hs index 4c9863d317..eab02b0124 100644 --- a/libs/wire-api/src/Wire/API/UserEvent.hs +++ b/libs/wire-api/src/Wire/API/UserEvent.hs @@ -95,7 +95,7 @@ data EventType instance ToSchema EventType where schema = - enum @Text "EventType" $ + enum @Text $ mconcat [ element "user.new" EventTypeUserCreated, element "user.activate" EventTypeUserActivated, @@ -386,7 +386,7 @@ eventObjectSchema = _ConnectionEvent ( ConnectionUpdated <$> ucConn .= field "connection" schema - <*> ucName .= maybe_ (optField "user" (object "UserName" (field "name" schema))) + <*> ucName .= maybe_ (optField "user" (object (field "name" schema))) ) EventTypeUserGroupCreated -> tag @@ -421,7 +421,7 @@ instance ToJSONObject Event where toJSONObject = KM.fromList . fold . schemaOut eventObjectSchema instance ToSchema Event where - schema = object "UserEvent" eventObjectSchema + schema = object eventObjectSchema deriving via (Schema Event) instance A.ToJSON Event diff --git a/libs/wire-api/src/Wire/API/UserGroup.hs b/libs/wire-api/src/Wire/API/UserGroup.hs index f4dfa28d94..a61be18db5 100644 --- a/libs/wire-api/src/Wire/API/UserGroup.hs +++ b/libs/wire-api/src/Wire/API/UserGroup.hs @@ -69,7 +69,7 @@ data NewUserGroup = NewUserGroup instance ToSchema NewUserGroup where schema = - object "NewUserGroup" $ + object $ NewUserGroup <$> (.name) .= field "name" schema <*> (.members) .= field "members" (vector schema) @@ -83,7 +83,7 @@ data UserGroupUpdate = UserGroupUpdate instance ToSchema UserGroupUpdate where schema = - object "UserGroupUpdate" $ + object $ UserGroupUpdate <$> (.name) .= field "name" schema @@ -96,7 +96,7 @@ newtype UserGroupAddUsers = UserGroupAddUsers instance ToSchema UserGroupAddUsers where schema = - object "UserGroupAddUsers" $ + object $ UserGroupAddUsers <$> (.members) .= field "members" (vector schema) @@ -145,7 +145,7 @@ deriving via Schema (UserGroup_ (Const ())) instance OpenApi.ToSchema (UserGroup instance ToSchema (UserGroup_ (Const ())) where schema = - object "UserGroupMeta" $ + object $ UserGroup_ <$> (.id_) .= field "id" schema <*> (.name) .= field "name" schema @@ -172,7 +172,7 @@ deriving via Schema (UserGroup_ Identity) instance OpenApi.ToSchema (UserGroup_ instance ToSchema (UserGroup_ Identity) where schema = - object "UserGroup" $ + object $ UserGroup_ <$> (.id_) .= field "id" schema <*> (.name) .= field "name" schema @@ -192,7 +192,7 @@ newtype UpdateUserGroupMembers = UpdateUserGroupMembers instance ToSchema UpdateUserGroupMembers where schema = - object "UpdateUserGroupMembers" $ + object $ UpdateUserGroupMembers <$> (.members) .= field "members" (vector schema) @@ -205,7 +205,7 @@ newtype UpdateUserGroupChannels = UpdateUserGroupChannels instance ToSchema UpdateUserGroupChannels where schema = - object "UpdateUserGroupChannels" $ + object $ UpdateUserGroupChannels <$> (.channels) .= field "channels" (vector schema) @@ -218,7 +218,7 @@ newtype CheckUserGroupName = CheckUserGroupName instance ToSchema CheckUserGroupName where schema = - object "CheckUserGroupName" $ + object $ CheckUserGroupName <$> (.name) .= field "name" schema @@ -231,6 +231,6 @@ newtype UserGroupNameAvailability = UserGroupNameAvailability instance ToSchema UserGroupNameAvailability where schema = - object "UserGroupNameAvailability" $ + object $ UserGroupNameAvailability <$> (.available) .= field "name_available" schema diff --git a/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs b/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs index ded74ed0ae..7cda7a5c35 100644 --- a/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs +++ b/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs @@ -78,7 +78,7 @@ data UserGroupPage_ a = UserGroupPage instance (Typeable a, ToSchema a) => ToSchema (UserGroupPage_ a) where schema = - objectWithDocModifier "UserGroupPage" addPageDocs $ + objectWithDocModifier addPageDocs $ UserGroupPage <$> page .= field "page" (array schema) <*> total .= field "total" schema diff --git a/services/brig/src/Brig/Effects/SFT.hs b/services/brig/src/Brig/Effects/SFT.hs index 04983783d5..9eccfd3e4c 100644 --- a/services/brig/src/Brig/Effects/SFT.hs +++ b/services/brig/src/Brig/Effects/SFT.hs @@ -80,7 +80,7 @@ newtype AllURLs = AllURLs {unAllURLs :: [HttpsUrl]} instance ToSchema AllURLs where schema = - object "AllURLs" $ + object $ AllURLs <$> unAllURLs .= field "sft_servers_all" (array schema) diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 91cf542e48..cd2ae315b0 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -348,7 +348,7 @@ data ListAllSFTServers instance ToSchema ListAllSFTServers where schema = - enum @Text "ListSFTServers" $ + enum @Text $ mconcat [ element "enabled" ListAllSFTServers, element "disabled" HideAllSFTServers diff --git a/services/cargohold/src/CargoHold/S3.hs b/services/cargohold/src/CargoHold/S3.hs index 79126f484d..e873acf363 100644 --- a/services/cargohold/src/CargoHold/S3.hs +++ b/services/cargohold/src/CargoHold/S3.hs @@ -92,7 +92,7 @@ data AssetAuditLogMetadata = AssetAuditLogMetadata instance S.ToSchema AssetAuditLogMetadata where schema = - S.object "AssetAuditLogMetadata" $ + S.object $ AssetAuditLogMetadata <$> convId S..= S.field "convId" S.schema <*> filename S..= S.field "filename" S.schema diff --git a/tools/stern/src/Stern/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index d3152fe415..21c89c56b0 100644 --- a/tools/stern/src/Stern/API/Routes.hs +++ b/tools/stern/src/Stern/API/Routes.hs @@ -515,7 +515,7 @@ data UserConnectionGroups = UserConnectionGroups instance Schema.ToSchema UserConnectionGroups where schema = - Schema.object "UserConnectionGroups" $ + Schema.object $ UserConnectionGroups <$> ucgAccepted Schema..= Schema.field "ucgAccepted" Schema.schema <*> ucgSent Schema..= Schema.field "ucgSent" Schema.schema diff --git a/tools/stern/src/Stern/Types.hs b/tools/stern/src/Stern/Types.hs index 24dde504ca..ccbf19cedd 100644 --- a/tools/stern/src/Stern/Types.hs +++ b/tools/stern/src/Stern/Types.hs @@ -47,7 +47,7 @@ newtype TeamMemberInfo = TeamMemberInfo {tm :: TeamMember} instance S.ToSchema TeamMemberInfo where schema = - S.object "TeamMemberInfo" $ + S.object $ TeamMemberInfo <$> tm S..= teamMemberObjectSchema <* ((`hasPermission` SetBilling) . tm) S..= S.field "can_update_billing" S.schema @@ -62,7 +62,7 @@ data TeamInfo = TeamInfo instance S.ToSchema TeamInfo where schema = - S.object "TeamInfo" $ + S.object $ TeamInfo <$> tiData S..= S.field "info" S.schema <*> tiMembers S..= S.field "members" (S.array S.schema) @@ -78,7 +78,7 @@ data TeamAdminInfo = TeamAdminInfo instance S.ToSchema TeamAdminInfo where schema = - S.object "TeamAdminInfo" $ + S.object $ TeamAdminInfo <$> taData S..= S.field "data" S.schema <*> taOwners S..= S.field "owners" (S.array S.schema) @@ -193,7 +193,7 @@ data TeamBillingInfo = TeamBillingInfo instance S.ToSchema TeamBillingInfo where schema = - S.object "TeamBillingInfo" $ + S.object $ TeamBillingInfo <$> tbiFirstname S..= S.field "firstname" S.schema <*> tbiLastname S..= S.field "lastname" S.schema @@ -219,7 +219,7 @@ data TeamBillingInfoUpdate = TeamBillingInfoUpdate instance S.ToSchema TeamBillingInfoUpdate where schema = - S.object "TeamBillingInfoUpdate" $ + S.object $ TeamBillingInfoUpdate <$> tbiuFirstname S..= tbiuField "firstname" <*> tbiuLastname S..= tbiuField "lastname" From 9b6c2fb8c7210aaf8b9aff72b79aed8ce6fdfe9a Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Tue, 24 Mar 2026 08:57:10 +0100 Subject: [PATCH 05/17] Keep named variants of object, enum, ... around for corner cases. --- libs/schema-profunctor/src/Data/Schema.hs | 54 ++++++++++++++++++++--- 1 file changed, 48 insertions(+), 6 deletions(-) diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index eedfd4c382..625163d5ba 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -50,8 +50,11 @@ module Data.Schema declareSwaggerSchema, getName, object, + namedObject, objectWithDocModifier, + namedObjectWithDocModifier, objectOver, + namedObjectOver, jsonObject, jsonValue, field, @@ -67,6 +70,7 @@ module Data.Schema map_, mapWithKeys, enum, + namedEnum, maybe_, maybeWithDefault, bind, @@ -402,14 +406,24 @@ tag f = rmap runIdentity . f . rmap Identity -- -- This can be used to convert a combination of schemas obtained using -- 'field' into a single schema for a JSON object. +-- Uses the Typeable instance to automatically generate the schema name. object :: forall doc doc' a b. (Typeable a, HasObject doc doc') => SchemaP doc A.Object [A.Pair] a b -> SchemaP doc' A.Value A.Value a b -object = objectOver id +object = namedObject (mkSchemaName @a) + +-- | Version of 'object' that takes an explicit name. +namedObject :: + (HasObject doc doc') => + Text -> + SchemaP doc A.Object [A.Pair] a b -> + SchemaP doc' A.Value A.Value a b +namedObject name = namedObjectOver id name -- | A version of 'object' for more general input values. +-- Uses the Typeable instance to automatically generate the schema name. -- -- Just like 'fieldOver', but for 'object'. objectOver :: @@ -418,9 +432,17 @@ objectOver :: Lens v v' A.Value A.Object -> SchemaP doc v' [A.Pair] a b -> SchemaP doc' v A.Value a b -objectOver l sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) +objectOver l = namedObjectOver l (mkSchemaName @a) + +-- | Version of 'objectOver' that takes an explicit name. +namedObjectOver :: + (HasObject doc doc') => + Lens v v' A.Value A.Object -> + Text -> + SchemaP doc v' [A.Pair] a b -> + SchemaP doc' v A.Value a b +namedObjectOver l name sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) where - name = mkSchemaName @a parseObject val = ContT $ \k -> A.withObject (T.unpack name) k val r v = runContT (l parseObject v) (schemaIn sch) w x = A.object <$> schemaOut sch x @@ -436,13 +458,23 @@ mkSchemaName = T.pack $ show $ typeRep (Proxy @a) -- | Like 'object', but apply an arbitrary function to the -- documentation of the resulting object. +-- Uses the Typeable instance to automatically generate the schema name. objectWithDocModifier :: forall doc doc' a. (Typeable a, HasObject doc doc') => (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a -objectWithDocModifier modify sch = over doc modify (object sch) +objectWithDocModifier = namedObjectWithDocModifier (mkSchemaName @a) + +-- | Version of 'objectWithDocModifier' that takes an explicit name. +namedObjectWithDocModifier :: + (HasObject doc doc') => + Text -> + (doc' -> doc') -> + ObjectSchema doc a -> + ValueSchema doc' a +namedObjectWithDocModifier name modify sch = over doc modify (namedObject name sch) -- | Turn a named schema into an unnamed one. -- @@ -567,14 +599,24 @@ element label value = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) -- -- This is used to convert a combination of schemas obtained using -- 'element' into a single schema for a JSON string. +-- | A schema for an enumeration. +-- Uses the Typeable instance to automatically generate the schema name. enum :: forall v doc a b. (Typeable a, With v, HasEnum v doc) => SchemaP [A.Value] v (Alt Maybe v) a b -> SchemaP doc A.Value A.Value a b -enum sch = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) +enum = namedEnum (mkSchemaName @a) + +-- | Version of 'enum' that takes an explicit name. +namedEnum :: + forall v doc a b. + (With v, HasEnum v doc) => + Text -> + SchemaP [A.Value] v (Alt Maybe v) a b -> + SchemaP doc A.Value A.Value a b +namedEnum name sch = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) where - name = mkSchemaName @a d = mkEnum @v name (schemaDoc sch) i x = with (T.unpack name) (schemaIn sch) x From 1f6e998a97aa6e1582ef43b6e9769a2159130c02 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Tue, 24 Mar 2026 11:31:42 +0100 Subject: [PATCH 06/17] Remove now unused name arguments from object, enum (cont.). --- libs/wire-api/src/Wire/API/Conversation.hs | 22 ++++++------------- .../src/Wire/API/MLS/SubConversation.hs | 7 +++--- libs/wire-api/src/Wire/API/Message.hs | 1 - .../Wire/API/Routes/FederationDomainConfig.hs | 1 - .../Routes/Public/Brig/DomainVerification.hs | 5 ++--- libs/wire-api/src/Wire/API/Team/Feature.hs | 7 ++---- libs/wire-api/src/Wire/API/Team/Invitation.hs | 1 - libs/wire-api/src/Wire/API/User/Client.hs | 3 ++- libs/wire-api/src/Wire/API/User/Scim.hs | 3 ++- libs/wire-api/src/Wire/API/User/Search.hs | 3 +-- libs/wire-api/src/Wire/API/UserEvent.hs | 3 --- 11 files changed, 20 insertions(+), 36 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 59c8c4a7a4..15e7144be2 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -251,7 +251,6 @@ instance ToSchema (Versioned 'V2 ConversationMetadata) where Versioned <$> unVersioned .= object - "ConversationMetadata" (conversationMetadataObjectSchema accessRolesSchemaV2) instance HasCellsState ConversationMetadata where @@ -323,7 +322,7 @@ conversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc OwnConversation conversationSchema v = - objectWithDocModifier + namedObjectWithDocModifier -- TODO!### ("OwnConversation" <> foldMap (Text.toUpper . versionText) v) (DS.description ?~ "A conversation object as returned from the server") (ownConversationObjectSchema v) @@ -355,7 +354,6 @@ data Conversation = Conversation instance ToSchema Conversation where schema = objectWithDocModifier - "Conversation" (DS.description ?~ "A conversation object as returned from the server") $ conversationObjectSchema @@ -375,11 +373,10 @@ data MLSOne2OneConversation a = MLSOne2OneConversation instance (Typeable a, ToSchema a) => ToSchema (MLSOne2OneConversation a) where schema = - let aName = maybe "" ("_" <>) $ getName (schemaDoc (schema @a)) - in object ("MLSOne2OneConversation" <> aName) $ - MLSOne2OneConversation - <$> (.conversation) .= field "conversation" schema - <*> publicKeys .= field "public_keys" schema + object $ + MLSOne2OneConversation + <$> (.conversation) .= field "conversation" schema + <*> publicKeys .= field "public_keys" schema -- | The public-facing conversation type extended with information on which -- remote users could not be added when creating the conversation. @@ -402,7 +399,6 @@ instance (SingI v) => ToSchema (Versioned v CreateGroupOwnConversation) where createGroupConversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc CreateGroupOwnConversation createGroupConversationSchema v = objectWithDocModifier - "CreateGroupOwnConversation" (DS.description ?~ "A created group-conversation object extended with a list of failed-to-add users") $ CreateGroupOwnConversation <$> cgcConversation .= ownConversationObjectSchema v @@ -427,7 +423,6 @@ data CreateGroupConversation = CreateGroupConversation instance ToSchema CreateGroupConversation where schema = objectWithDocModifier - "CreateGroupConversation" (DS.description ?~ "A created group-conversation object extended with a list of failed-to-add users") $ CreateGroupConversation <$> (.conversation) .= conversationObjectSchema @@ -449,7 +444,6 @@ data ConversationCoverView = ConversationCoverView instance ToSchema ConversationCoverView where schema = objectWithDocModifier - "ConversationCoverView" (DS.description ?~ "Limited view of Conversation.") $ ConversationCoverView <$> cnvCoverConvId .= field "id" schema @@ -489,7 +483,6 @@ conversationListSchema :: ValueSchema NamedSwaggerDoc (ConversationList a) conversationListSchema sch = objectWithDocModifier - "ConversationList" (DS.description ?~ "Object holding a list of " <> convListItemName (Proxy @a)) $ ConversationList <$> convList .= field "conversations" (array sch) @@ -528,7 +521,6 @@ newtype ListConversations = ListConversations instance ToSchema ListConversations where schema = objectWithDocModifier - "ListConversations" (DS.description ?~ "A request to list some of a user's conversations, including remote ones. Maximum 1000 qualified conversation IDs") $ ListConversations <$> (fromRange . lcQualifiedIds) .= field "qualified_ids" (rangedSchema (array schema)) @@ -547,7 +539,7 @@ conversationsResponseSchema :: conversationsResponseSchema v = let notFoundDoc = DS.description ?~ "These conversations either don't exist or are deleted." failedDoc = DS.description ?~ "The server failed to fetch these conversations, most likely due to network issues while contacting a remote server" - in objectWithDocModifier + in namedObjectWithDocModifier -- TODO!### ("ConversationsResponse" <> foldMap (Text.toUpper . versionText) v) (DS.description ?~ "Response object for getting metadata of a list of conversations") $ ConversationsResponse @@ -910,7 +902,7 @@ newConvSchema :: ObjectSchema SwaggerDoc (Maybe (Set AccessRole)) -> ValueSchema NamedSwaggerDoc NewConv newConvSchema v sch = - objectWithDocModifier + namedObjectWithDocModifier -- TODO!### we probably want versionedObject etc. as well? just pass the maybe-version and do the same thing every time? ("NewConv" <> foldMap (Text.toUpper . versionText) v) (DS.description ?~ "JSON object to create a new conversation. When using 'qualified_users' (preferred), you can omit 'users'") $ NewConv diff --git a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs index 6fbce937da..57867970c5 100644 --- a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs @@ -85,7 +85,8 @@ data PublicSubConversation = PublicSubConversation publicSubConversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc PublicSubConversation publicSubConversationSchema v = - objectWithDocModifier + -- TODO!### + namedObjectWithDocModifier ("PublicSubConversation" <> foldMap (T.toUpper . versionText) v) (description ?~ "An MLS subconversation") $ PublicSubConversation @@ -168,12 +169,12 @@ instance ToSchema ConvOrSubConvId where ConvTag -> tag _Conv - (unnamed $ object "" $ field "conv_id" schema) + (unnamed $ object $ field "conv_id" schema) SubConvTag -> tag _SubConv ( unnamed $ - object "" $ + object $ ( (,) <$> fst .= field "conv_id" schema <*> snd .= field "subconv_id" schema diff --git a/libs/wire-api/src/Wire/API/Message.hs b/libs/wire-api/src/Wire/API/Message.hs index c5f98ce553..183c2a272b 100644 --- a/libs/wire-api/src/Wire/API/Message.hs +++ b/libs/wire-api/src/Wire/API/Message.hs @@ -508,7 +508,6 @@ data MessageSendingStatus = MessageSendingStatus instance ToSchema MessageSendingStatus where schema = objectWithDocModifier - "MessageSendingStatus" (description ?~ combinedDesc) $ MessageSendingStatus <$> mssTime .= field "time" schema diff --git a/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs b/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs index 54628fc6dc..9bd072d3fd 100644 --- a/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs +++ b/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs @@ -119,7 +119,6 @@ defFederationDomainConfigs = instance ToSchema FederationDomainConfigs where schema = objectWithDocModifier - "FederationDomainConfigs" (description ?~ "See https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections.") $ FederationDomainConfigs <$> strategy .= field "strategy" schema diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs index f7420169de..e674e035fa 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs @@ -176,9 +176,8 @@ data TeamDomainRedirectTag = TeamNoRegistrationTag | TeamNoneTag instance ToSchema TeamDomainRedirectTag where schema = - enum @Text - "TeamDomainRedirectTag" - $ mconcat + enum @Text $ + mconcat [ element "no-registration" TeamNoRegistrationTag, element "none" TeamNoneTag ] diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 38f6aecacf..826a5d944f 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -470,9 +470,9 @@ forgetLock ws = Feature ws.status ws.config withLockStatus :: LockStatus -> Feature a -> LockableFeature a withLockStatus ls (Feature s c) = LockableFeature s ls c -instance (Typeable cfg, ToSchema cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where +instance (ToSchema cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where schema = - object name $ + object $ Feature <$> (.status) .= field "status" schema <*> (.config) .= objectSchema @cfg @@ -480,9 +480,6 @@ instance (Typeable cfg, ToSchema cfg, ToObjectSchema cfg) => ToSchema (Feature c .= optField "ttl" (schema :: ValueSchema NamedSwaggerDoc FeatureTTL) - where - inner = schema @cfg - name = fromMaybe "" (getName (schemaDoc inner)) <> ".Feature" instance (Typeable cfg, Typeable v, ToObjectSchema (Versioned v cfg), ToSchema (Versioned v cfg)) => diff --git a/libs/wire-api/src/Wire/API/Team/Invitation.hs b/libs/wire-api/src/Wire/API/Team/Invitation.hs index d658069b2c..e5ca562ea1 100644 --- a/libs/wire-api/src/Wire/API/Team/Invitation.hs +++ b/libs/wire-api/src/Wire/API/Team/Invitation.hs @@ -111,7 +111,6 @@ data Invitation = Invitation instance ToSchema Invitation where schema = objectWithDocModifier - "Invitation" (DS.description ?~ "An invitation to join a team on Wire. If invitee is invited from an existing personal account, inviter email is included.") invitationObjectSchema diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index ce2577ff69..9787528dbc 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -542,7 +542,8 @@ mlsPublicKeysSchema = clientSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc Client clientSchema mVersion = - object (versionedName mVersion "Client") $ + -- TODO!### + namedObject (versionedName mVersion "Client") $ Client <$> (.clientId) .= field "id" schema <*> clientType .= field "type" schema diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index a0782f785e..a91f7451b8 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -434,7 +434,8 @@ data CreateScimToken = CreateScimToken createScimTokenSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc CreateScimToken createScimTokenSchema mVersion = - object ("CreateScimToken" <> foldMap (Text.toUpper . versionText) mVersion) $ + -- TODO!### interesting! + namedObject ("CreateScimToken" <> foldMap (Text.toUpper . versionText) mVersion) $ CreateScimToken <$> (.description) .= field "description" schema <*> password .= optField "password" (maybeWithDefault A.Null schema) diff --git a/libs/wire-api/src/Wire/API/User/Search.hs b/libs/wire-api/src/Wire/API/User/Search.hs index 808b4050d0..07a5c27cd2 100644 --- a/libs/wire-api/src/Wire/API/User/Search.hs +++ b/libs/wire-api/src/Wire/API/User/Search.hs @@ -58,7 +58,6 @@ import Data.Schema import Data.Text qualified as T import Data.Text.Ascii (AsciiBase64Url, toText, validateBase64Url) import Data.Text.Encoding qualified as TE -import Data.Typeable (typeRep) import Imports import Servant.API (FromHttpApiData, ToHttpApiData (..)) import Web.Internal.HttpApiData (parseQueryParam) @@ -117,7 +116,7 @@ instance Traversable SearchResult where instance (ToSchema a, Typeable a) => ToSchema (SearchResult a) where schema = - object ("SearchResult_" <> T.pack (show $ typeRep $ Proxy @a)) $ + object $ SearchResult <$> searchFound .= fieldWithDocModifier "found" (S.description ?~ "Total number of hits") schema <*> searchReturned .= fieldWithDocModifier "returned" (S.description ?~ "Total number of hits returned") schema diff --git a/libs/wire-api/src/Wire/API/UserEvent.hs b/libs/wire-api/src/Wire/API/UserEvent.hs index eab02b0124..d3fd240bb8 100644 --- a/libs/wire-api/src/Wire/API/UserEvent.hs +++ b/libs/wire-api/src/Wire/API/UserEvent.hs @@ -260,7 +260,6 @@ eventObjectSchema = ( field "user" ( object - "UserUpdatedData" ( UserUpdatedData <$> eupId .= field "id" schema <*> eupName .= maybe_ (optField "name" schema) @@ -283,7 +282,6 @@ eventObjectSchema = ( field "user" ( object - "UserIdentityUpdatedData" ( UserIdentityUpdatedData <$> eiuId .= field "id" schema <*> eiuEmail .= maybe_ (optField "email" schema) @@ -300,7 +298,6 @@ eventObjectSchema = ( field "user" ( object - "UserIdentityRemovedData" ( UserIdentityRemovedData <$> eirId .= field "id" schema <*> eirEmail .= maybe_ (optField "email" schema) From f0210f74674cf35c4cefd04ecc7145526f07a60f Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 25 Mar 2026 13:32:13 +0100 Subject: [PATCH 07/17] Versioned schemas. --- libs/schema-profunctor/src/Data/Schema.hs | 1 + libs/wire-api/src/Wire/API/Conversation.hs | 10 ++++---- libs/wire-api/src/Wire/API/Routes/Version.hs | 26 ++++++++++++++++++++ 3 files changed, 32 insertions(+), 5 deletions(-) diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index 625163d5ba..55326b4386 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -55,6 +55,7 @@ module Data.Schema namedObjectWithDocModifier, objectOver, namedObjectOver, + mkSchemaName, jsonObject, jsonValue, field, diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 15e7144be2..ce9a238131 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -322,8 +322,8 @@ conversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc OwnConversation conversationSchema v = - namedObjectWithDocModifier -- TODO!### - ("OwnConversation" <> foldMap (Text.toUpper . versionText) v) + versionedObjectWithDocModifier + v (DS.description ?~ "A conversation object as returned from the server") (ownConversationObjectSchema v) @@ -539,8 +539,8 @@ conversationsResponseSchema :: conversationsResponseSchema v = let notFoundDoc = DS.description ?~ "These conversations either don't exist or are deleted." failedDoc = DS.description ?~ "The server failed to fetch these conversations, most likely due to network issues while contacting a remote server" - in namedObjectWithDocModifier -- TODO!### - ("ConversationsResponse" <> foldMap (Text.toUpper . versionText) v) + in versionedObjectWithDocModifier + v (DS.description ?~ "Response object for getting metadata of a list of conversations") $ ConversationsResponse <$> crFound .= field "found" (array (conversationSchema v)) @@ -1147,7 +1147,7 @@ data ConversationAccessData = ConversationAccessData conversationAccessDataSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc ConversationAccessData conversationAccessDataSchema v = - object ("ConversationAccessData" <> foldMap (Text.toUpper . versionText) v) $ + versionedObject v $ ConversationAccessData <$> cupAccess .= field "access" (set schema) <*> cupAccessRoles .= accessRolesVersionedSchema v diff --git a/libs/wire-api/src/Wire/API/Routes/Version.hs b/libs/wire-api/src/Wire/API/Routes/Version.hs index 656349dc5b..8a10386d31 100644 --- a/libs/wire-api/src/Wire/API/Routes/Version.hs +++ b/libs/wire-api/src/Wire/API/Routes/Version.hs @@ -62,6 +62,10 @@ module Wire.API.Routes.Version Until, From, + -- * Versioned schema-profunctor things. + versionedObject, + versionedObjectWithDocModifier, + -- * Swagger module Wire.API.Routes.SpecialiseToVersion, ) @@ -71,6 +75,7 @@ import Control.Error (note) import Control.Lens (makePrisms, (?~)) import Data.Aeson (FromJSON, ToJSON (..)) import Data.Aeson qualified as Aeson +import Data.Aeson.Types qualified as Aeson import Data.Bifunctor import Data.Binary.Builder qualified as Builder import Data.ByteString.Conversion (ToByteString (builder), toByteString') @@ -320,3 +325,24 @@ expandVersionExp (VersionExpConst v) = Set.singleton v expandVersionExp VersionExpDevelopment = Set.fromList developmentVersions $(promoteOrdInstances [''Version]) + +versionedObject :: + forall doc doc' a b. + (Typeable a, HasObject doc doc') => + Maybe Version -> + SchemaP doc Aeson.Object [Aeson.Pair] a b -> + SchemaP doc' Aeson.Value Aeson.Value a b +versionedObject version = namedObject (mkVersionedSchemaName @a version) + +versionedObjectWithDocModifier :: + forall doc doc' a. + (Typeable a, HasObject doc doc') => + Maybe Version -> + (doc' -> doc') -> + ObjectSchema doc a -> + ValueSchema doc' a +versionedObjectWithDocModifier v = namedObjectWithDocModifier (mkVersionedSchemaName @a v) + +mkVersionedSchemaName :: forall a. (Typeable a) => Maybe Version -> Text +mkVersionedSchemaName (Just v) = versionText v <> "/" <> mkSchemaName @a +mkVersionedSchemaName Nothing = mkSchemaName @a From a9f12d386b6429539f7cbe380884fb26fb34f006 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 25 Mar 2026 13:33:08 +0100 Subject: [PATCH 08/17] Fix compiler errors. --- libs/wire-api/src/Wire/API/Conversation.hs | 8 -------- libs/wire-api/src/Wire/API/Conversation/Action.hs | 2 -- libs/wire-api/src/Wire/API/Event/Conversation.hs | 1 - libs/wire-api/src/Wire/API/Routes/Public/Brig.hs | 1 - 4 files changed, 12 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index ce9a238131..ed10efd11a 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -1000,7 +1000,6 @@ managedDesc = instance ToSchema ConvTeamInfo where schema = objectWithDocModifier - "ConvTeamInfo" (DS.description ?~ "Team information") $ ConvTeamInfo <$> cnvTeamId .= field "teamid" schema @@ -1028,7 +1027,6 @@ data NewOne2OneConv = NewOne2OneConv instance ToSchema NewOne2OneConv where schema = objectWithDocModifier - "NewOne2OneConv" (DS.description ?~ "JSON object to create a new 1:1 conversation. When using 'qualified_users' (preferred), you can omit 'users'") $ NewOne2OneConv <$> (.users) @@ -1187,7 +1185,6 @@ data ConversationMessageTimerUpdate = ConversationMessageTimerUpdate instance ToSchema ConversationMessageTimerUpdate where schema = objectWithDocModifier - "ConversationMessageTimerUpdate" (DS.description ?~ "Contains conversation properties to update") $ ConversationMessageTimerUpdate <$> cupMessageTimer .= optField "message_timer" (maybeWithDefault A.Null schema) @@ -1220,7 +1217,6 @@ data ConversationJoin = ConversationJoin instance ToSchema ConversationJoin where schema = objectWithDocModifier - "ConversationJoin" (DS.description ?~ "The action of some users joining a conversation") $ ConversationJoin <$> (.users) .= field "users" (nonEmptyArray schema) @@ -1238,7 +1234,6 @@ data ConversationMemberUpdate = ConversationMemberUpdate instance ToSchema ConversationMemberUpdate where schema = objectWithDocModifier - "ConversationMemberUpdate" (DS.description ?~ "The action of promoting/demoting a member of a conversation") $ ConversationMemberUpdate <$> cmuTarget .= field "target" schema @@ -1255,7 +1250,6 @@ data ConversationRemoveMembers = ConversationRemoveMembers instance ToSchema ConversationRemoveMembers where schema = objectWithDocModifier - "ConversationRemoveMembers" (DS.description ?~ "The action of removing members from a conversation") $ ConversationRemoveMembers <$> crmTargets .= field "targets" (nonEmptyArray schema) @@ -1310,7 +1304,6 @@ newtype AddPermissionUpdate = AddPermissionUpdate instance ToSchema AddPermissionUpdate where schema = objectWithDocModifier - "AddPermissionUpdate" (DS.description ?~ "The action of changing the permission to add members to a channel") $ AddPermissionUpdate <$> addPermission .= field "add_permission" schema @@ -1328,7 +1321,6 @@ instance Default ExtraConversationData where instance ToSchema ExtraConversationData where schema = objectWithDocModifier - "ExtraConversationData" (DS.description ?~ "Extra conversation data, used for group conversations") $ ExtraConversationData <$> newGroupId .= optField "group_id" (maybeWithDefault A.Null schema) diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index 415bbeede9..0d480912b9 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -150,14 +150,12 @@ conversationActionSchema :: forall tag. Sing tag -> ValueSchema NamedSwaggerDoc conversationActionSchema SConversationJoinTag = schema @ConversationJoin conversationActionSchema SConversationLeaveTag = objectWithDocModifier - "ConversationLeave" (S.description ?~ "The action of some users leaving a conversation on their own") $ pure () conversationActionSchema SConversationRemoveMembersTag = schema conversationActionSchema SConversationMemberUpdateTag = schema @ConversationMemberUpdate conversationActionSchema SConversationDeleteTag = objectWithDocModifier - "ConversationDelete" (S.description ?~ "The action of deleting a conversation") (pure ()) conversationActionSchema SConversationRenameTag = schema diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 513831b56c..64195a8c8b 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -438,7 +438,6 @@ data OtrMessage = OtrMessage instance ToSchema OtrMessage where schema = objectWithDocModifier - "OtrMessage" (description ?~ "Encrypted message of a conversation") otrMessageObjectSchema diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 4e7d5fdba1..2dbe0c784d 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -805,7 +805,6 @@ data DeprecatedMatchingResult = DeprecatedMatchingResult instance ToSchema DeprecatedMatchingResult where schema = objectWithDocModifier - "DeprecatedMatchingResult" (S.deprecated ?~ True) $ DeprecatedMatchingResult <$ const [] From 9fd11c809a3365610d9b16672e6111aa425d99d2 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 25 Mar 2026 13:33:35 +0100 Subject: [PATCH 09/17] Fix type constraints. --- libs/wire-api/src/Wire/API/Team/Feature.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 826a5d944f..94d1e78a82 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -470,7 +470,7 @@ forgetLock ws = Feature ws.status ws.config withLockStatus :: LockStatus -> Feature a -> LockableFeature a withLockStatus ls (Feature s c) = LockableFeature s ls c -instance (ToSchema cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where +instance (Typeable cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where schema = object $ Feature @@ -482,7 +482,7 @@ instance (ToSchema cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where (schema :: ValueSchema NamedSwaggerDoc FeatureTTL) instance - (Typeable cfg, Typeable v, ToObjectSchema (Versioned v cfg), ToSchema (Versioned v cfg)) => + (Typeable cfg, Typeable v, ToObjectSchema (Versioned v cfg)) => ToSchema (Versioned v (Feature cfg)) where schema = Versioned . fmap unVersioned <$> (fmap Versioned . unVersioned) .= schema @(Feature (Versioned v cfg)) From 35edfdb58ccfc8bd31732190399717d31661b7c3 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 25 Mar 2026 13:49:04 +0100 Subject: [PATCH 10/17] Changelog. --- changelog.d/4-docs/swagger-hacking | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/4-docs/swagger-hacking diff --git a/changelog.d/4-docs/swagger-hacking b/changelog.d/4-docs/swagger-hacking new file mode 100644 index 0000000000..9d4c652c55 --- /dev/null +++ b/changelog.d/4-docs/swagger-hacking @@ -0,0 +1 @@ +Make schema-profunctor schema names derived and avoid name clashes between scopes. From 9b45a35d2b167605a5e05fc2170456ad128430a5 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 25 Mar 2026 17:17:44 +0100 Subject: [PATCH 11/17] Cleanup remaining TODOs. --- libs/wire-api/src/Wire/API/Conversation.hs | 4 ++-- libs/wire-api/src/Wire/API/Conversation/Protocol.hs | 4 ---- libs/wire-api/src/Wire/API/MLS/SubConversation.hs | 5 ++--- libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs | 4 ++-- libs/wire-api/src/Wire/API/Team/Feature.hs | 4 ++-- libs/wire-api/src/Wire/API/User/Client.hs | 3 +-- libs/wire-api/src/Wire/API/User/Scim.hs | 3 +-- 7 files changed, 10 insertions(+), 17 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index ed10efd11a..ac954d93d9 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -902,8 +902,8 @@ newConvSchema :: ObjectSchema SwaggerDoc (Maybe (Set AccessRole)) -> ValueSchema NamedSwaggerDoc NewConv newConvSchema v sch = - namedObjectWithDocModifier -- TODO!### we probably want versionedObject etc. as well? just pass the maybe-version and do the same thing every time? - ("NewConv" <> foldMap (Text.toUpper . versionText) v) + versionedObjectWithDocModifier + v (DS.description ?~ "JSON object to create a new conversation. When using 'qualified_users' (preferred), you can omit 'users'") $ NewConv <$> newConvUsers diff --git a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs index 4f1f3f1271..fa46c8e918 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs @@ -229,10 +229,6 @@ protocolTag ProtocolProteus = ProtocolProteusTag protocolTag (ProtocolMLS _) = ProtocolMLSTag protocolTag (ProtocolMixed _) = ProtocolMixedTag --- TODO!### interesting, we intentionally made 3 different schemas all --- have the name "Protocol" here until now. was there a reason? --- maybe a good one? - instance ToSchema ProtocolTag where schema = enum @Text $ diff --git a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs index 57867970c5..e3db83ca08 100644 --- a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs @@ -85,9 +85,8 @@ data PublicSubConversation = PublicSubConversation publicSubConversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc PublicSubConversation publicSubConversationSchema v = - -- TODO!### - namedObjectWithDocModifier - ("PublicSubConversation" <> foldMap (T.toUpper . versionText) v) + versionedObjectWithDocModifier + v (description ?~ "An MLS subconversation") $ PublicSubConversation <$> pscParentConvId .= field "parent_qualified_id" schema diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs index e1fa3207f2..d839071014 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs @@ -100,7 +100,7 @@ instance ?~ "optional, when not specified, the first page will be returned.\ \Every returned page contains a paging_state, this should be supplied to retrieve the next page." addSizeDoc = description ?~ ("optional, must be <= " <> textFromNat @max <> ", defaults to " <> textFromNat @def <> ".") - in objectWithDocModifier -- TODO!### + in objectWithDocModifier (description ?~ "A request to list some or all of a user's " <> textFromSymbol @name <> ", including remote ones") $ GetMultiTablePageRequest <$> gmtprSize .= (fromMaybe (toRange (Proxy @def)) <$> optFieldWithDocModifier "size" addSizeDoc schema) @@ -159,7 +159,7 @@ instance ToSchema (MultiTablePage name resultsKey tables a) where schema = - object $ -- TODO!### + object $ MultiTablePage <$> mtpResults .= field (textFromSymbol @resultsKey) (array schema) <*> mtpHasMore .= field "has_more" schema diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 94d1e78a82..12185dbcc8 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -407,7 +407,7 @@ defUnlockedFeature = instance (Typeable cfg, IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where schema = - object $ -- TODO!### + object $ LockableFeature <$> (.status) .= field "status" schema <*> (.lockStatus) .= field "lockStatus" schema @@ -438,7 +438,7 @@ instance Default (LockableFeaturePatch cfg) where -- when the value is a `Just`, if it's `Nothing` it will be omitted, which is the important part. instance (Typeable cfg, ToSchema cfg) => ToSchema (LockableFeaturePatch cfg) where schema = - object $ -- TODO!### + object $ LockableFeaturePatch <$> (.status) .= maybe_ (optField "status" schema) <*> (.lockStatus) .= maybe_ (optField "lockStatus" schema) diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index 9787528dbc..04269f876e 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -542,8 +542,7 @@ mlsPublicKeysSchema = clientSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc Client clientSchema mVersion = - -- TODO!### - namedObject (versionedName mVersion "Client") $ + versionedObject mVersion $ Client <$> (.clientId) .= field "id" schema <*> clientType .= field "type" schema diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index a91f7451b8..4db4f2a1a7 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -434,8 +434,7 @@ data CreateScimToken = CreateScimToken createScimTokenSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc CreateScimToken createScimTokenSchema mVersion = - -- TODO!### interesting! - namedObject ("CreateScimToken" <> foldMap (Text.toUpper . versionText) mVersion) $ + versionedObject mVersion $ CreateScimToken <$> (.description) .= field "description" schema <*> password .= optField "password" (maybeWithDefault A.Null schema) From 1dc9b365633bc42190bfe750ef6c6b6798016de0 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 25 Mar 2026 17:19:29 +0100 Subject: [PATCH 12/17] Make imports more consistent Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- libs/schema-profunctor/src/Data/Schema.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index 55326b4386..b68393bb77 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -102,7 +102,7 @@ import Control.Monad.Trans.Cont import Data.Aeson.Key qualified as Key import Data.Aeson.Types qualified as A import Data.Bifunctor.Joker -import Data.Data (typeRep) +import Data.Typeable (typeRep) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map From 1327a1cc55004d13461f1290a2a23e7e82ad8ba1 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 25 Mar 2026 19:58:36 +0100 Subject: [PATCH 13/17] Fix compiler warning. --- libs/wire-api/src/Wire/API/User/Scim.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index 4db4f2a1a7..8ca092eed1 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -62,7 +62,6 @@ import Data.Misc (PlainTextPassword6) import Data.OpenApi qualified as S import Data.Schema as Schema import Data.Text qualified as T -import Data.Text qualified as Text import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.These import Data.These.Combinators From aa9d606a0b1b02f4b64e63a0fab3e7871e56c929 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 26 Mar 2026 15:43:13 +0100 Subject: [PATCH 14/17] Fix: mkSchemaName. --- .../schema-profunctor/schema-profunctor.cabal | 1 + libs/schema-profunctor/src/Data/Schema.hs | 51 +++++++-- .../test/unit/Test/Data/Schema.hs | 6 +- .../test/unit/Test/Data/Schema/Names.hs | 108 ++++++++++++++++++ libs/wire-api/src/Wire/API/Routes/Version.hs | 2 +- 5 files changed, 158 insertions(+), 10 deletions(-) create mode 100644 libs/schema-profunctor/test/unit/Test/Data/Schema/Names.hs diff --git a/libs/schema-profunctor/schema-profunctor.cabal b/libs/schema-profunctor/schema-profunctor.cabal index 45f2696a11..5c4c72637b 100644 --- a/libs/schema-profunctor/schema-profunctor.cabal +++ b/libs/schema-profunctor/schema-profunctor.cabal @@ -83,6 +83,7 @@ test-suite schemas-tests other-modules: Paths_schema_profunctor Test.Data.Schema + Test.Data.Schema.Names hs-source-dirs: test/unit default-extensions: diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index b68393bb77..87ef4aae95 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -56,6 +56,7 @@ module Data.Schema objectOver, namedObjectOver, mkSchemaName, + mkSchemaNameWith, jsonObject, jsonValue, field, @@ -102,7 +103,6 @@ import Control.Monad.Trans.Cont import Data.Aeson.Key qualified as Key import Data.Aeson.Types qualified as A import Data.Bifunctor.Joker -import Data.Typeable (typeRep) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map @@ -110,13 +110,15 @@ import Data.Monoid hiding (Product) import Data.OpenApi qualified as S import Data.OpenApi.Declare qualified as S import Data.Profunctor (Star (..)) -import Data.Proxy (Proxy (..)) import Data.Set qualified as Set import Data.Text qualified as T import Data.Text.Lazy qualified as TL +import Data.Typeable (Proxy (..), typeRep) import Data.Vector qualified as V import Imports hiding (Product) import Numeric.Natural +import Type.Reflection (SomeTypeRep (..), tyConModule, tyConName) +import Type.Reflection qualified as TR type Declare = S.Declare (S.Definitions S.Schema) @@ -450,12 +452,47 @@ namedObjectOver l name sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) s = mkObject name (schemaDoc sch) -- | Object and enum schema names by default are the fully qualified --- name of the haskell type. If that's not unique, we should probably --- change those type names. This will avoid collisions in the hash --- table keeping track of all the schema references in openapi3. --- track of all the schema references in openapi3. +-- name of the haskell type, including type parameters. If that's not +-- unique, we should probably change those type names. This will avoid +-- collisions in the hash table keeping track of all the schema references +-- in the openapi3 package. +-- +-- See test suite for examples. mkSchemaName :: forall a. (Typeable a) => Text -mkSchemaName = T.pack $ show $ typeRep (Proxy @a) +mkSchemaName = T.pack $ sanitizeSchemaName $ mkSchemaNameInternal @a + +mkSchemaNameWith :: forall a. (Typeable a) => Text -> Text +mkSchemaNameWith extra = T.pack $ sanitizeSchemaName $ T.unpack extra <> " " <> (mkSchemaNameInternal @a) + +-- | Vacuum's yaml parser chokes on '/', ':' etc in schema names. +-- Let's indulge it, and use a conservative positive filter. +sanitizeSchemaName :: String -> String +sanitizeSchemaName = + mconcat + . map + ( \c -> + if c `elem` ("_,.()[]" ++ ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] :: [Char]) + then [c] + else "_" ++ show (ord c) ++ "_" + ) + +mkSchemaNameInternal :: forall a. (Typeable a) => String +mkSchemaNameInternal = humanReadable ++ " (" <> unique ++ ")" + where + humanReadable = show $ typeRep (Proxy @a) + unique = renderTypeRep (TR.typeRep @a) + + renderTypeRep :: forall t. TR.TypeRep t -> String + renderTypeRep tr = + case TR.splitApps tr of + (tyCon, []) -> + -- Simple type with no arguments + tyConModule tyCon <> "." <> tyConName tyCon + (tyCon, args) -> + -- Type constructor applied to arguments + let conName = tyConModule tyCon <> "." <> tyConName tyCon + argNames = map (\(SomeTypeRep arg) -> renderTypeRep arg) args + in conName <> " " <> intercalate " " argNames -- | Like 'object', but apply an arbitrary function to the -- documentation of the resulting object. diff --git a/libs/schema-profunctor/test/unit/Test/Data/Schema.hs b/libs/schema-profunctor/test/unit/Test/Data/Schema.hs index 031903afe0..29dfca66e7 100644 --- a/libs/schema-profunctor/test/unit/Test/Data/Schema.hs +++ b/libs/schema-profunctor/test/unit/Test/Data/Schema.hs @@ -33,6 +33,7 @@ import Data.Proxy import Data.Schema hiding (getName) import Data.Text qualified as Text import Imports +import Test.Data.Schema.Names import Test.Tasty import Test.Tasty.HUnit @@ -69,7 +70,8 @@ tests = testRmClientWrong, testRmClient, testEnumType, - testNullable + testNullable, + testSchemaNames ] testFooToJSON :: TestTree @@ -112,7 +114,7 @@ testFooSchema = (s ^. S.required) assertEqual "Schema for \"a\" should be referenced" - (Just (S.Ref (S.Reference "A"))) + (Just (S.Ref (S.Reference "A (Test.Data.Schema.A)"))) (s ^. S.properties . at "a") case s ^. S.properties . at "str" of Nothing -> assertFailure "\"str\" field should be present" diff --git a/libs/schema-profunctor/test/unit/Test/Data/Schema/Names.hs b/libs/schema-profunctor/test/unit/Test/Data/Schema/Names.hs new file mode 100644 index 0000000000..1f789addaa --- /dev/null +++ b/libs/schema-profunctor/test/unit/Test/Data/Schema/Names.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- 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 . + +module Test.Data.Schema.Names where + +import Data.Schema hiding (getName) +import Imports +import Test.Tasty +import Test.Tasty.HUnit + +newtype UserId = UserId Text + deriving (Eq, Show) + +newtype Qualified a = Qualified a + deriving (Eq, Show) + +testSchemaNames :: TestTree +testSchemaNames = + testGroup + "mkSchemaName" + [ testSimpleType, + testSimpleTypeFromStdLib, + testParameterizedTypeOne, + testParameterizedTypeTwo, + testNestedParameterizedType, + testTupleType, + testListType + ] + +testSimpleType :: TestTree +testSimpleType = + testCase "Simple type from current module" $ + assertEqual + "Should be fully qualified with module name" + "UserId (Test.Data.Schema.Names.UserId)" + (mkSchemaName @UserId) + +testSimpleTypeFromStdLib :: TestTree +testSimpleTypeFromStdLib = + testCase "Simple type from standard library" $ + assertEqual + "Should be fully qualified" + "Int (GHC.Types.Int)" + (mkSchemaName @Int) + +testParameterizedTypeOne :: TestTree +testParameterizedTypeOne = + testCase "Parameterized type with one parameter" $ do + assertEqual + "Maybe Int should include both type and parameter" + "Maybe Int (GHC.Internal.Maybe.Maybe GHC.Types.Int)" + (mkSchemaName @(Maybe Int)) + assertEqual + "Qualified UserId should include both type and parameter" + "Qualified UserId (Test.Data.Schema.Names.Qualified Test.Data.Schema.Names.UserId)" + (mkSchemaName @(Qualified UserId)) + +testParameterizedTypeTwo :: TestTree +testParameterizedTypeTwo = + testCase "Parameterized type with two parameters" $ + assertEqual + "Either should include all type parameters" + "Either Int UserId (GHC.Internal.Data.Either.Either GHC.Types.Int Test.Data.Schema.Names.UserId)" + (mkSchemaName @(Either Int UserId)) + +testNestedParameterizedType :: TestTree +testNestedParameterizedType = + testCase "Nested parameterized types" $ do + assertEqual + "Maybe (Qualified UserId) should be fully expanded" + "Maybe (Qualified UserId) (GHC.Internal.Maybe.Maybe Test.Data.Schema.Names.Qualified Test.Data.Schema.Names.UserId)" + (mkSchemaName @(Maybe (Qualified UserId))) + assertEqual + "Qualified (Maybe Int) should be fully expanded" + "Qualified (Maybe Int) (Test.Data.Schema.Names.Qualified GHC.Internal.Maybe.Maybe GHC.Types.Int)" + (mkSchemaName @(Qualified (Maybe Int))) + +testTupleType :: TestTree +testTupleType = + testCase "Tuple types" $ + assertEqual + "Tuple should include all element types" + "(Int,UserId) (GHC.Tuple.Tuple2 GHC.Types.Int Test.Data.Schema.Names.UserId)" + (mkSchemaName @(Int, UserId)) + +testListType :: TestTree +testListType = + testCase "List type" $ + assertEqual + "List should include element type" + "[UserId] (GHC.Types.List Test.Data.Schema.Names.UserId)" + (mkSchemaName @[UserId]) diff --git a/libs/wire-api/src/Wire/API/Routes/Version.hs b/libs/wire-api/src/Wire/API/Routes/Version.hs index 8a10386d31..497a2dcf61 100644 --- a/libs/wire-api/src/Wire/API/Routes/Version.hs +++ b/libs/wire-api/src/Wire/API/Routes/Version.hs @@ -344,5 +344,5 @@ versionedObjectWithDocModifier :: versionedObjectWithDocModifier v = namedObjectWithDocModifier (mkVersionedSchemaName @a v) mkVersionedSchemaName :: forall a. (Typeable a) => Maybe Version -> Text -mkVersionedSchemaName (Just v) = versionText v <> "/" <> mkSchemaName @a +mkVersionedSchemaName (Just v) = mkSchemaNameWith @a (versionText v) mkVersionedSchemaName Nothing = mkSchemaName @a From 0e5ac8cab9729a1ee968543b71777a2446639c69 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 26 Mar 2026 22:22:52 +0100 Subject: [PATCH 15/17] Drop dangling TODO. this is fine because the new derived name is at least as unique as this one. --- libs/types-common/src/Data/Qualified.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index ebf440d9b1..4c3da13f92 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -195,7 +195,7 @@ qualifiedSchema :: ValueSchema doc a -> ValueSchema NamedSwaggerDoc (Qualified a) qualifiedSchema _name fieldName sch = - object $ qualifiedObjectSchema fieldName sch -- TODO!### + object $ qualifiedObjectSchema fieldName sch qualifiedObjectSchema :: (HasSchemaRef d) => From 0819cc2b08c946125c0547471b0d5c97e859a5b8 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 26 Mar 2026 23:08:44 +0100 Subject: [PATCH 16/17] [stash] --- .../schema-profunctor/schema-profunctor.cabal | 1 + libs/schema-profunctor/src/Data/Schema.hs | 36 +++++++++++++++++-- 2 files changed, 35 insertions(+), 2 deletions(-) diff --git a/libs/schema-profunctor/schema-profunctor.cabal b/libs/schema-profunctor/schema-profunctor.cabal index 5c4c72637b..ce04606f50 100644 --- a/libs/schema-profunctor/schema-profunctor.cabal +++ b/libs/schema-profunctor/schema-profunctor.cabal @@ -73,6 +73,7 @@ library , profunctors , text , transformers + , uuid , vector default-language: GHC2021 diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index 87ef4aae95..7e0c07fd9a 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -114,9 +114,13 @@ import Data.Set qualified as Set import Data.Text qualified as T import Data.Text.Lazy qualified as TL import Data.Typeable (Proxy (..), typeRep) +import Data.UUID qualified as UUID +import Data.UUID.V4 qualified as UUID import Data.Vector qualified as V +import Debug.Trace import Imports hiding (Product) import Numeric.Natural +import System.IO.Unsafe import Type.Reflection (SomeTypeRep (..), tyConModule, tyConName) import Type.Reflection qualified as TR @@ -459,7 +463,35 @@ namedObjectOver l name sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) -- -- See test suite for examples. mkSchemaName :: forall a. (Typeable a) => Text -mkSchemaName = T.pack $ sanitizeSchemaName $ mkSchemaNameInternal @a +mkSchemaName = traceShow ("***************** " :: String, (mkSchemaNameInternal @a), result) $ result + where + result = T.pack $ sanitizeSchemaName $ UUID.toString $ unsafePerformIO UUID.nextRandom + +{- + +# Two problems: + +## internal galley and public api + +without commit [stash] (this commit), these two (not others) get this error: + +Unable to process spec '/tmp/swagger665666/swagger.json': unable to parse specification: yaml: did not find expected ',' or '}' + +it's completely unclear where this is coming from. vacuum bug? + +## public api + +(with this stash) + +curl -X 'GET' 'http://127.0.0.1:8082/v16/api/swagger.json' -H 'Z-Connection: conn' -H 'Z-User: example.com' | jq . > swagger3.json && vacuum lint -a -d -e swagger3.json +[...] +swagger3.json:21258:32 ✗ error component `#/components/schemas/6f9654bc-22a0-44f9-84e7-787c49115a98` does not exist in the specification resolving-references Schemas $.components.schemas['6f9654bc-22a0-44f9-84e7-787c49115a98'] + +[brig@example.com] ("***************** ","Qualified (Id IdTag 'User) (Data.Qualified.Qualified Data.Id.Id Data.Id.'User)","6f9654bc-22a0-44f9-84e7-787c49115a98") + +so it looks like this one data type does not make it into the openapi3 hashtable of schema declarations. what's different about it? + +-} mkSchemaNameWith :: forall a. (Typeable a) => Text -> Text mkSchemaNameWith extra = T.pack $ sanitizeSchemaName $ T.unpack extra <> " " <> (mkSchemaNameInternal @a) @@ -471,7 +503,7 @@ sanitizeSchemaName = mconcat . map ( \c -> - if c `elem` ("_,.()[]" ++ ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] :: [Char]) + if c `elem` (['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ " _-,.!?:()[]@$^&*" :: [Char]) then [c] else "_" ++ show (ord c) ++ "_" ) From 67b77737168243a67fa8e78e2cf8a0fd9c08824e Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 26 Mar 2026 23:21:22 +0100 Subject: [PATCH 17/17] generate-clients.sh: feed errors to stderr, not stdout. Co-authored-by: Gautier DI FOLCO --- hack/bin/generate-clients.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hack/bin/generate-clients.sh b/hack/bin/generate-clients.sh index 0cfef72269..0a998b8648 100755 --- a/hack/bin/generate-clients.sh +++ b/hack/bin/generate-clients.sh @@ -20,7 +20,7 @@ curl -s "$SWAGGER_URL" > "$OUTPUT_DIR/swagger.json" # Check if docker is available if ! command -v docker &> /dev/null; then - echo "Error: docker is not installed. Please install docker to use openapi-generator." + echo "Error: docker is not installed. Please install docker to use openapi-generator." >&2 echo "Alternative: install openapi-generator-cli via npm: npm install -g @openapitools/openapi-generator-cli" exit 1 fi