diff --git a/changelog.d/4-docs/swagger-hacking b/changelog.d/4-docs/swagger-hacking new file mode 100644 index 00000000000..9d4c652c55b --- /dev/null +++ b/changelog.d/4-docs/swagger-hacking @@ -0,0 +1 @@ +Make schema-profunctor schema names derived and avoid name clashes between scopes. diff --git a/hack/bin/generate-clients.sh b/hack/bin/generate-clients.sh new file mode 100755 index 00000000000..0a998b86482 --- /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." >&2 + 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" diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs index a1a3d92a212..2e8c3ed8d1e 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 6364fe97797..0606a642319 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 93039ca76d7..8041b9bc70e 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 @@ -271,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)) @@ -291,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, @@ -312,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) @@ -346,9 +347,9 @@ 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" $ + Schema.object $ IdPConfig <$> (_idpId Schema..= Schema.field "id" Schema.schema) <*> (_idpMetadata Schema..= Schema.field "metadata" Schema.schema) diff --git a/libs/schema-profunctor/schema-profunctor.cabal b/libs/schema-profunctor/schema-profunctor.cabal index 45f2696a11b..ce04606f506 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 @@ -83,6 +84,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 3cb88657d5b..7e0c07fd9a9 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -50,8 +50,13 @@ module Data.Schema declareSwaggerSchema, getName, object, + namedObject, objectWithDocModifier, + namedObjectWithDocModifier, objectOver, + namedObjectOver, + mkSchemaName, + mkSchemaNameWith, jsonObject, jsonValue, field, @@ -67,6 +72,7 @@ module Data.Schema map_, mapWithKeys, enum, + namedEnum, maybe_, maybeWithDefault, bind, @@ -104,13 +110,19 @@ 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.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 type Declare = S.Declare (S.Definitions S.Schema) @@ -401,38 +413,138 @@ 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 = 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 -object = objectOver id +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 :: + forall doc doc' v' a b v. + (Typeable a, HasObject doc doc') => + Lens v v' A.Value A.Object -> + SchemaP doc v' [A.Pair] a b -> + SchemaP doc' v A.Value a b +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 -objectOver l name sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) +namedObjectOver l name sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) where 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, 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 = 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) + +-- | 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. +-- 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 = namedObjectWithDocModifier (mkSchemaName @a) + +-- | Version of 'objectWithDocModifier' that takes an explicit name. +namedObjectWithDocModifier :: (HasObject doc doc') => Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a -objectWithDocModifier name modify sch = over doc modify (object name sch) +namedObjectWithDocModifier name modify sch = over doc modify (namedObject name sch) -- | Turn a named schema into an unnamed one. -- @@ -557,13 +669,23 @@ 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 = 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 -enum name sch = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) +namedEnum name sch = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) where d = mkEnum @v name (schemaDoc sch) i x = @@ -653,7 +775,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 9164e4af3c1..29dfca66e7a 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" @@ -337,7 +339,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 +347,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 +378,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 +387,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 +412,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 +457,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 +475,7 @@ data User = User instance ToSchema User where schema = - object "User" $ + object $ User <$> userName .= field "name" schema <*> userHandle .= maybe_ (optField "handle" schema) @@ -517,16 +519,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 +556,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 +586,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 +618,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 +643,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 +655,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/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 00000000000..1f789addaab --- /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/types-common/src/Data/Code.hs b/libs/types-common/src/Data/Code.hs index 6bba1c5f087..c5b55a701b7 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 d04a020b7f2..8c38f3de986 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 ba6e6c21d2c..87b51358ae7 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 sch = object "Id" (field "id" sch) +idObjectSchema :: (Typeable a) => ValueSchemaP NamedSwaggerDoc a b -> ValueSchemaP NamedSwaggerDoc a b +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 247684fee78..f7666513ae1 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 fc59fd841cc..4c3da13f926 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -189,14 +189,13 @@ deprecatedSchema new = . (deprecated ?~ True) qualifiedSchema :: - (HasSchemaRef doc) => + (Typeable a, HasSchemaRef doc) => Text -> 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 qualifiedObjectSchema :: (HasSchemaRef d) => @@ -208,16 +207,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/wai-utilities/src/Network/Wai/Utilities/JSONResponse.hs b/libs/wai-utilities/src/Network/Wai/Utilities/JSONResponse.hs index c7238eaf9b0..318f5206804 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/API.hs b/libs/wire-api-federation/src/Wire/API/Federation/API.hs index 73dbbeded3b..704d8a3a0a0 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 2e780eab99f..ac1e0e03cd9 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 @@ -110,9 +110,9 @@ 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" $ + 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 4c141c20fe9..5e2f016901a 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 ac51bde02f9..d54acd2a80d 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 f0432d2f535..78f179ed955 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 6c82112f721..c2d4b576310 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 05554f34da6..cfb4623a1e6 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 e0fafcf1f6f..b58f82a5a33 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 607a1fc6619..079bdef2c81 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 d7843692c5e..0eba6606ea5 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 915fafd535e..ac954d93d98 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -244,14 +244,13 @@ 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 = Versioned <$> unVersioned .= object - "ConversationMetadata" (conversationMetadataObjectSchema accessRolesSchemaV2) instance HasCellsState ConversationMetadata where @@ -323,8 +322,8 @@ conversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc OwnConversation conversationSchema v = - objectWithDocModifier - ("OwnConversation" <> foldMap (Text.toUpper . versionText) v) + versionedObjectWithDocModifier + 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 @@ -373,13 +371,12 @@ 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) $ - 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 @@ -473,7 +467,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,12 +478,11 @@ 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 = 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,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 objectWithDocModifier - ("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)) @@ -581,7 +573,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 +718,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 +739,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 +773,7 @@ data ConvType instance ToSchema ConvType where schema = - enum @Integer "ConvType" $ + enum @Integer $ mconcat [ element 0 RegularConv, element 1 SelfConv, @@ -852,7 +844,7 @@ data GroupConvType = GroupConversation | Channel | MeetingConversation instance ToSchema GroupConvType where schema = - enum @Text "GroupConvType" $ + enum @Text $ mconcat [ element "group_conversation" GroupConversation, element "channel" Channel, @@ -910,8 +902,8 @@ newConvSchema :: ObjectSchema SwaggerDoc (Maybe (Set AccessRole)) -> ValueSchema NamedSwaggerDoc NewConv newConvSchema v sch = - objectWithDocModifier - ("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 @@ -1008,7 +1000,6 @@ managedDesc = instance ToSchema ConvTeamInfo where schema = objectWithDocModifier - "ConvTeamInfo" (DS.description ?~ "Team information") $ ConvTeamInfo <$> cnvTeamId .= field "teamid" schema @@ -1036,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) @@ -1085,7 +1075,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 +1093,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 +1108,7 @@ data InviteQualifiedInternal = InviteQualifiedInternal instance ToSchema InviteQualifiedInternal where schema = - object "InviteQualifiedInternal" $ + object $ InviteQualifiedInternal <$> (.actor) .= field "actor" schema <*> (.invite) .= field "invite" schema @@ -1135,7 +1125,7 @@ newtype ConversationRename = ConversationRename instance ToSchema ConversationRename where schema = - object "ConversationRename" $ + object $ ConversationRename <$> cupName .= fieldWithDocModifier @@ -1155,7 +1145,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 @@ -1175,7 +1165,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 @@ -1195,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) @@ -1210,7 +1199,7 @@ instance Default JoinType where instance ToSchema JoinType where schema = - enum @Text "JoinType" $ + enum @Text $ mconcat [ element "external_add" ExternalAdd, element "internal_add" InternalAdd @@ -1228,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) @@ -1246,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 @@ -1263,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) @@ -1290,7 +1276,7 @@ instance Default AddPermission where instance ToSchema AddPermission where schema = - enum @Text "AddPermission" $ + enum @Text $ mconcat [ element "admins" Admins, element "everyone" Everyone @@ -1318,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 @@ -1336,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) @@ -1350,7 +1334,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.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index 415bbeede91..0d480912b93 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/Conversation/Action/Tag.hs b/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs index 47488f460af..90aa92757e7 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 a6878f3835d..84d9f6ee7dc 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 b6084cb440d..fe327c06e12 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 c80b588c535..579562f3b28 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 6565fbd1d1e..b9617cc3175 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 e496b1708e0..7ed8bcce16b 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 034f508b501..faa674c2765 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 e41ad2f7207..fa46c8e9181 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 = @@ -231,7 +231,7 @@ protocolTag (ProtocolMixed _) = ProtocolMixedTag instance ToSchema ProtocolTag where schema = - enum @Text "Protocol" $ + enum @Text $ mconcat [ element "proteus" ProtocolProteusTag, element "mls" ProtocolMLSTag, @@ -254,10 +254,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 +275,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 076dbde5e47..82e5e93ac25 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 f7c12e0140d..42c7a0997e3 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 78e78da4a95..19aecc414bc 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 @@ -273,9 +273,9 @@ 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" $ + 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 a1899f9f6ca..76aa9c0517c 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 0ce4976f735..7c57f12f1ab 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 af2b35abf20..64195a8c8bf 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 = @@ -438,7 +438,6 @@ data OtrMessage = OtrMessage instance ToSchema OtrMessage where schema = objectWithDocModifier - "OtrMessage" (description ?~ "Encrypted message of a conversation") otrMessageObjectSchema @@ -475,7 +474,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 +517,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 +589,7 @@ data CellsEventType instance ToSchema CellsEventType where schema = - enum @Text "CellsEventType" $ + enum @Text $ mconcat [ element "conversation.create" CellsConvCreate ] @@ -599,7 +598,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 7817fe94a7b..b1762b07307 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 ) => @@ -75,7 +76,7 @@ data EventType = Update instance ToSchema EventType where schema = - enum @Text "EventType" $ + enum @Text $ mconcat [ element "feature-config.update" Update ] @@ -90,7 +91,7 @@ eventObjectSchema = instance ToSchema Event where schema = - object "Event" eventObjectSchema + object eventObjectSchema instance ToJSONObject Event where toJSONObject = @@ -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/Event/Federation.hs b/libs/wire-api/src/Wire/API/Event/Federation.hs index 82c3d7362d1..8db1c6da688 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 e01e7ab0290..c389f42e9e7 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 6c24a9f0147..e81b6e8b751 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 493e029cb09..9d726ddbb87 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 8fd4dc3acb8..b3aeccd5f66 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 2462741fb3a..59cd7247718 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 0ffb9eec618..3dc67c1177a 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 0226b913921..0beefd4621a 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 d369727f3e1..607729eb902 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 eb736de6ea5..1f3e97d1098 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 971b2866b11..c40ad6a2492 100644 --- a/libs/wire-api/src/Wire/API/MLS/Keys.hs +++ b/libs/wire-api/src/Wire/API/MLS/Keys.hs @@ -41,9 +41,9 @@ 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" $ + object $ MLSKeysByPurpose <$> (.removal) .= field "removal" schema @@ -56,9 +56,9 @@ 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" $ + 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 644e2743d45..544695bee96 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 be1199c8193..e3db83ca081 100644 --- a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs @@ -85,8 +85,8 @@ data PublicSubConversation = PublicSubConversation publicSubConversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc PublicSubConversation publicSubConversationSchema v = - objectWithDocModifier - ("PublicSubConversation" <> foldMap (T.toUpper . versionText) v) + versionedObjectWithDocModifier + v (description ?~ "An MLS subconversation") $ PublicSubConversation <$> pscParentConvId .= field "parent_qualified_id" schema @@ -150,7 +150,7 @@ convOrSubConvIdObjectSchema = instance ToSchema ConvOrSubConvId where schema = - object "ConvOrSubConvId" $ + object $ fromTagged <$> toTagged .= bind @@ -168,12 +168,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 @@ -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 6c1057efe30..44e2c956554 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 85cdda18909..183c2a272b7 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 @@ -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/Notification.hs b/libs/wire-api/src/Wire/API/Notification.hs index d3b5a40511d..69b53bd9c9f 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 97c8d0bc223..a3ff2db1537 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 8fae686b1fa..cfa9d158cd5 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 dfb16d1d250..8289725834b 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 561e3b92f90..427e0a0f8af 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 fbde37da2ce..2bc09542b05 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 e8a1f5b1c4a..58ab67e6ccc 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 979ae525e5c..2329ee4c102 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 b643e7f0052..49f8b25ca69 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 0d628c892e5..d1dde16e5c4 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 29560be5fe8..051647b5cb2 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 6b5463bfdb9..9bd072d3fd3 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 @@ -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 @@ -140,7 +139,7 @@ data FederationStrategy instance ToSchema FederationStrategy where schema = - enum @Text "FederationStrategy" $ + enum @Text $ mconcat [ element "allowNone" AllowNone, element "allowAll" AllowAll, @@ -156,6 +155,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 1317d0b93a5..893f4ea0524 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 7f3d76810cf..cdfb0512f96 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 fca44780100..c57a8ea5b8a 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 a25baa28b23..1cd39377d54 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 8bb68c6eb38..11d7cbb681b 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,9 +34,9 @@ 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" $ + 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 9398113741d..85c3b765248 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 2cdfaf692c9..d8390710146 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 @@ -90,7 +101,6 @@ instance (RequestSchemaConstraint name tables max def) => ToSchema (GetMultiTabl \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) (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) @@ -117,13 +127,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,11 +149,17 @@ 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 = - object (textFromSymbol @name <> "_Page") $ + object $ MultiTablePage <$> mtpResults .= field (textFromSymbol @resultsKey) (array schema) <*> mtpHasMore .= field "has_more" schema 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 4e7d5fdba14..2dbe0c784dc 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 [] 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 e7447c46a0a..e674e035fa9 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 @@ -177,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 ] @@ -225,7 +223,7 @@ data TeamInviteConfig = TeamInviteConfig instance ToSchema TeamInviteConfig where schema = - object "TeamInviteConfig" $ + object $ TeamInviteConfig <$> (.teamInvite) .= teamInviteObjectSchema <*> (maybeTeamDomainRedirectToTuple . (.domainRedirect)) .= maybeTeamDomainRedirectTargetObjectSchema @@ -244,7 +242,7 @@ data DomainVerificationChallenge = DomainVerificationChallenge instance ToSchema DomainVerificationChallenge where schema = - object "DomainVerificationChallenge" $ + object $ DomainVerificationChallenge <$> challengeId .= field "id" schema <*> token .= field "token" schema @@ -255,7 +253,7 @@ newtype ChallengeToken = ChallengeToken {unChallengeToken :: Token} instance ToSchema ChallengeToken where schema = - object "ChallengeToken" $ + object $ ChallengeToken <$> unChallengeToken .= field "challenge_token" schema @@ -264,16 +262,16 @@ newtype DomainOwnershipToken = DomainOwnershipToken {unDomainOwnershipToken :: T instance ToSchema DomainOwnershipToken where schema = - object "DomainOwnershipToken" $ + object $ DomainOwnershipToken <$> unDomainOwnershipToken .= field "domain_ownership_token" schema 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" $ + object $ RegisteredDomains <$> unRegisteredDomains .= field "registered_domains" (array schema) @@ -295,7 +293,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 +312,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 bc09fa549ac..d7637661df1 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 c8515b91068..c442cc975bc 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 ddf3e1c6b84..4e072cc0e3a 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 064e66929e2..497a2dcf612 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') @@ -179,7 +184,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 +211,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 +240,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 +312,7 @@ instance ToSchema VersionExp where <> tag _VersionExpDevelopment ( unnamed - (enum @Text "VersionExpDevelopment" (element "development" ())) + (enum @Text (element "development" ())) ) deriving via Schema VersionExp instance (FromJSON VersionExp) @@ -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) = mkSchemaNameWith @a (versionText v) +mkVersionedSchemaName Nothing = mkSchemaName @a diff --git a/libs/wire-api/src/Wire/API/SystemSettings.hs b/libs/wire-api/src/Wire/API/SystemSettings.hs index 6f78a123fd8..b41a17acc59 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 61be43b4b0c..f9c5dcf678c 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 c6d6e79a31a..d256ce92474 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 d3b240d9f54..53427886ce7 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 156f541e5ed..ca4b6160080 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 15117fde387..12185dbcc89 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -405,9 +405,9 @@ defUnlockedFeature = config = def } -instance (IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where +instance (Typeable cfg, IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where schema = - object name $ + object $ LockableFeature <$> (.status) .= field "status" schema <*> (.lockStatus) .= field "lockStatus" schema @@ -416,9 +416,6 @@ instance (IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where .= 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 @@ -439,9 +436,9 @@ 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 $ + object $ LockableFeaturePatch <$> (.status) .= maybe_ (optField "status" schema) <*> (.lockStatus) .= maybe_ (optField "lockStatus" schema) @@ -450,9 +447,6 @@ instance (ToSchema cfg) => ToSchema (LockableFeaturePatch cfg) where .= 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 @@ -476,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 (ToSchema cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where +instance (Typeable cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where schema = - object name $ + object $ Feature <$> (.status) .= field "status" schema <*> (.config) .= objectSchema @cfg @@ -486,12 +480,9 @@ instance (ToSchema cfg, ToObjectSchema cfg) => ToSchema (Feature cfg) where .= optField "ttl" (schema :: ValueSchema NamedSwaggerDoc FeatureTTL) - where - inner = schema @cfg - 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 (Feature cfg)) where schema = Versioned . fmap unVersioned <$> (fmap Versioned . unVersioned) .= schema @(Feature (Versioned v cfg)) @@ -605,7 +596,7 @@ instance FromHttpApiData LockStatus where instance ToSchema LockStatus where schema = - enum @Text "LockStatus" $ + enum @Text $ mconcat [ element "locked" LockStatusLocked, element "unlocked" LockStatusUnlocked @@ -655,7 +646,7 @@ newtype LockStatusResponse = LockStatusResponse {_unlockStatus :: LockStatus} instance ToSchema LockStatusResponse where schema = - object "LockStatusResponse" $ + object $ LockStatusResponse <$> _unlockStatus .= field "lockStatus" schema @@ -669,7 +660,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 +692,7 @@ instance IsFeatureConfig LegalholdConfig where featureSingleton = FeatureSingletonLegalholdConfig instance ToSchema LegalholdConfig where - schema = object "LegalholdConfig" objectSchema + schema = object objectSchema -------------------------------------------------------------------------------- -- SSO feature @@ -724,7 +715,7 @@ instance IsFeatureConfig SSOConfig where featureSingleton = FeatureSingletonSSOConfig instance ToSchema SSOConfig where - schema = object "SSOConfig" objectSchema + schema = object objectSchema -------------------------------------------------------------------------------- -- SearchVisibility available feature @@ -748,7 +739,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 +760,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 +797,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 @@ -875,9 +866,9 @@ 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" $ + object $ ConferenceCallingConfig <$> one2OneCalls .= fromOpt @@ -893,7 +884,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 +917,7 @@ instance IsFeatureConfig SearchVisibilityInboundConfig where featureSingleton = FeatureSingletonSearchVisibilityInboundConfig instance ToSchema SearchVisibilityInboundConfig where - schema = object "SearchVisibilityInboundConfig" objectSchema + schema = object objectSchema ---------------------------------------------------------------------- -- ClassifiedDomains feature @@ -952,7 +943,7 @@ deriving via (GenericUniform ClassifiedDomainsConfig) instance Arbitrary Classif instance ToSchema ClassifiedDomainsConfig where schema = - object "ClassifiedDomainsConfig" $ + object $ ClassifiedDomainsConfig <$> classifiedDomainsDomains .= field "domains" (array schema) @@ -998,9 +989,9 @@ 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" $ + object $ AppLockConfig <$> (.enforce) .= fieldF "enforceAppLock" schema <*> (.timeout) .= fieldF "inactivityTimeoutSecs" schema @@ -1046,7 +1037,7 @@ instance IsFeatureConfig FileSharingConfig where featureSingleton = FeatureSingletonFileSharingConfig instance ToSchema FileSharingConfig where - schema = object "FileSharingConfig" objectSchema + schema = object objectSchema ---------------------------------------------------------------------- -- SelfDeletingMessagesConfig @@ -1079,9 +1070,9 @@ 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" $ + object $ SelfDeletingMessagesConfig <$> sdmEnforcedTimeoutSeconds .= fieldF "enforcedTimeoutSeconds" schema @@ -1139,9 +1130,9 @@ 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" $ + object $ MLSConfig <$> mlsProtocolToggleUsers .= ( fieldWithDocModifierF @@ -1205,16 +1196,16 @@ data ChannelPermissions = TeamMembers | Everyone | Admins instance ToSchema ChannelPermissions where schema = - enum @Text "ChannelPermissions" $ + enum @Text $ mconcat [ element "team-members" TeamMembers, element "everyone" Everyone, element "admins" Admins ] -instance (FieldF f) => ToSchema (ChannelsConfigB Covered f) 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 +1240,7 @@ instance IsFeatureConfig ExposeInvitationURLsToTeamAdminConfig where featureSingleton = FeatureSingletonExposeInvitationURLsToTeamAdminConfig instance ToSchema ExposeInvitationURLsToTeamAdminConfig where - schema = object "ExposeInvitationURLsToTeamAdminConfig" objectSchema + schema = object objectSchema ---------------------------------------------------------------------- -- OutlookCalIntegrationConfig @@ -1273,7 +1264,7 @@ instance IsFeatureConfig OutlookCalIntegrationConfig where featureSingleton = FeatureSingletonOutlookCalIntegrationConfig instance ToSchema OutlookCalIntegrationConfig where - schema = object "OutlookCalIntegrationConfig" objectSchema + schema = object objectSchema ---------------------------------------------------------------------- -- MlsE2EIdConfig @@ -1329,9 +1320,9 @@ 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" $ + object $ MlsE2EIdConfig <$> ( (fmap toSeconds . verificationExpiration) .= fieldWithDocModifierF @@ -1414,9 +1405,9 @@ 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" $ + object $ MlsMigrationConfig <$> startTime .= nestedMaybeField "startTime" (unnamed utcTimeSchema) <*> finaliseRegardlessAfter .= nestedMaybeField "finaliseRegardlessAfter" (unnamed utcTimeSchema) @@ -1467,9 +1458,9 @@ 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" $ + object $ EnforceFileDownloadLocationConfig <$> enforcedDownloadLocation .= nestedMaybeField "enforcedDownloadLocation" (unnamed schema) @@ -1508,7 +1499,7 @@ instance IsFeatureConfig LimitedEventFanoutConfig where featureSingleton = FeatureSingletonLimitedEventFanoutConfig instance ToSchema LimitedEventFanoutConfig where - schema = object "LimitedEventFanoutConfig" objectSchema + schema = object objectSchema -------------------------------------------------------------------------------- -- DomainRegistration feature @@ -1521,7 +1512,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 +1534,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 +1551,7 @@ data CellsProperty = CellsProperty instance ToSchema CellsProperty where schema = - object "CellsProperty" $ + object $ CellsProperty <$> (.enabled) .= field "enabled" schema <*> (.default_) .= field "default" schema @@ -1575,7 +1566,7 @@ data CellsUsers = CellsUsers instance ToSchema CellsUsers where schema = - object "CellsUsers" $ + object $ CellsUsers <$> (.externals) .= field "externals" schema <*> (.guests) .= field "guests" schema @@ -1587,7 +1578,7 @@ newtype CellsCollaboraStatus = CellsCollaboraStatus {enabled :: Bool} instance ToSchema CellsCollaboraStatus where schema = - object "CellsCollaboraStatus" $ + object $ CellsCollaboraStatus <$> (.enabled) .= field "enabled" schema @@ -1604,7 +1595,7 @@ data CellsPublicLinks = CellsPublicLinks instance ToSchema CellsPublicLinks where schema = - object "CellsPublicLinks" $ + object $ CellsPublicLinks <$> enableFiles .= field "enableFiles" schema <*> enableFolders .= field "enableFolders" schema @@ -1623,7 +1614,7 @@ data CellsRecycle = CellsRecycle instance ToSchema CellsRecycle where schema = - object "CellsRecycle" $ + object $ CellsRecycle <$> autoPurgeDays .= field "autoPurgeDays" schema <*> disable .= field "disable" schema @@ -1639,7 +1630,7 @@ data CellsConfigStorage = CellsConfigStorage instance ToSchema CellsConfigStorage where schema = - object "CellsConfigStorage" $ + object $ CellsConfigStorage <$> perFileQuotaBytes .= field "perFileQuotaBytes" schema <*> recycle .= field "recycle" schema @@ -1654,7 +1645,7 @@ data CellsUserMetaTags = CellsUserMetaTags instance ToSchema CellsUserMetaTags where schema = - object "CellsUserMetaTags" $ + object $ CellsUserMetaTags <$> defaultValues .= field "defaultValues" (array schema) <*> allowFreeValues .= field "allowFreeValues" schema @@ -1666,7 +1657,7 @@ newtype CellsNamespaces = CellsNamespaces {usermetaTags :: CellsUserMetaTags} instance ToSchema CellsNamespaces where schema = - object "CellsNamespaces" $ + object $ CellsNamespaces <$> usermetaTags .= field "usermetaTags" schema @@ -1677,7 +1668,7 @@ newtype CellsMetadata = CellsMetadata {namespaces :: CellsNamespaces} instance ToSchema CellsMetadata where schema = - object "CellsMetadata" $ + object $ CellsMetadata <$> namespaces .= field "namespaces" schema @@ -1752,9 +1743,9 @@ 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)) $ + objectWithDocModifier (S.schema . S.example ?~ schemaToJSON (def @CellsConfig)) $ CellsConfig <$> channels .= fieldF "channels" schema <*> groups .= fieldF "groups" schema @@ -1766,7 +1757,7 @@ instance (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 +1782,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 +1798,7 @@ newtype CellsCollabora = CellsCollabora instance ToSchema CellsCollabora where schema = - object "CellsCollabora" $ + object $ CellsCollabora <$> edition .= field "edition" schema @@ -1819,7 +1810,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 +1840,7 @@ newtype CellsStorage = CellsStorage instance ToSchema CellsStorage where schema = - object "CellsStorage" $ + object $ CellsStorage <$> perUserQuotaBytes .= field "perUserQuotaBytes" schema @@ -1888,9 +1879,9 @@ 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" $ + object $ CellsInternalConfig <$> backend .= fieldF "backend" schema <*> (.collabora) .= fieldF "collabora" schema @@ -1927,7 +1918,7 @@ instance Default AllowedGlobalOperationsConfig where instance ToSchema AllowedGlobalOperationsConfig where schema = - object "AllowedGlobalOperationsConfig" $ + object $ AllowedGlobalOperationsConfig <$> mlsConversationReset .= field "mlsConversationReset" schema @@ -1958,7 +1949,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 +1975,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 +1997,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 +2019,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 +2044,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 +2066,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 +2091,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 +2116,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 +2157,7 @@ instance ToHttpApiData FeatureStatus where instance ToSchema FeatureStatus where schema = - enum @Text "FeatureStatus" $ + enum @Text $ mconcat [ element "enabled" FeatureStatusEnabled, element "disabled" FeatureStatusDisabled @@ -2268,15 +2259,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 + object $ 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 @@ -2438,7 +2432,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 b51e52a0eef..e5ca562ea1b 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) @@ -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 @@ -191,7 +190,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 +207,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 +222,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 c0bfa22047c..a7c65addd22 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 c49b6b196fc..e481f224466 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 7b269033d94..6e2fb5d545b 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 55453872d7c..7a0b09dbe07 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 @@ -313,9 +313,9 @@ 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") $ + 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 ccf19fc2054..96bf5960dbf 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 974ef98926c..3c6fdcfec48 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 c3dc0ca89ee..72b57d7e9ff 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 76d530f6f15..b55bcb25c3b 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 ce0d8fe6468..d2061137651 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 9435e0e4ad2..889e22a6191 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 3df4052062f..275aa5b4aca 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 7d592bdf2b9..bfa5a475f04 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 b1f20c416a8..00f49b844d7 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 0892089a90d..70a0c8bb3b3 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 0c9daa86859..c3d37d1ec54 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 0e490f0ff3c..04269f876eb 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) @@ -542,7 +542,7 @@ mlsPublicKeysSchema = clientSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc Client clientSchema mVersion = - object (versionedName mVersion "Client") $ + versionedObject mVersion $ Client <$> (.clientId) .= field "id" schema <*> clientType .= field "type" schema @@ -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 980e376e7fd..90b4494d0ba 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 379b34f9e44..86541a4685a 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 3db27ef8c12..29e37493bff 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 8a67a4b4921..df3125a0340 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 c3d44c7084e..326ed41e35e 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 33ad254da73..079ccde88fa 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 372e980cabf..3fba25d81c9 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 5309c4892d2..c53a1e611ea 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 174a4ef6b1b..8ca092eed10 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 @@ -172,7 +171,7 @@ instance ToHttpApiData ScimToken where instance ToSchema ScimTokenInfo where schema = - object "ScimTokenInfo" $ + object $ ScimTokenInfo <$> (.stiTeam) .= field "team" schema <*> (.stiId) .= field "id" schema @@ -201,7 +200,7 @@ data ScimTokenInfoV7 = ScimTokenInfoV7 instance ToSchema ScimTokenInfoV7 where schema = - object "ScimTokenInfoV7" $ + object $ ScimTokenInfoV7 <$> (.stiTeam) .= field "team" schema <*> (.stiId) .= field "id" schema @@ -434,7 +433,7 @@ data CreateScimToken = CreateScimToken createScimTokenSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc CreateScimToken createScimTokenSchema mVersion = - object ("CreateScimToken" <> foldMap (Text.toUpper . versionText) mVersion) $ + versionedObject mVersion $ CreateScimToken <$> (.description) .= field "description" schema <*> password .= optField "password" (maybeWithDefault A.Null schema) @@ -468,7 +467,7 @@ data CreateScimTokenResponse = CreateScimTokenResponse instance ToSchema CreateScimTokenResponse where schema = - object "CreateScimTokenResponse" $ + object $ CreateScimTokenResponse <$> (.token) .= field "token" schema <*> (.info) .= field "info" schema @@ -483,7 +482,7 @@ data CreateScimTokenResponseV7 = CreateScimTokenResponseV7 instance ToSchema CreateScimTokenResponseV7 where schema = - object "CreateScimTokenResponseV7" $ + object $ CreateScimTokenResponseV7 <$> (.token) .= field "token" schema <*> (.info) .= field "info" schema @@ -499,7 +498,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 +507,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 25ac61f78d6..07a5c27cd29 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 @@ -158,7 +157,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 +181,7 @@ data Sso = Sso instance ToSchema Sso where schema = - object "Sso" $ + object $ Sso <$> ssoIssuer .= field "issuer" schema <*> ssoNameId .= field "nameid" schema @@ -212,7 +211,7 @@ data TeamContact = TeamContact instance ToSchema TeamContact where schema = - object "TeamContact" $ + object $ TeamContact <$> teamContactUserId .= field "id" schema <*> teamContactUserType .= field "type" schema @@ -332,7 +331,7 @@ userTypeFilterToUserType UserTypeFilterApp = UserTypeApp instance ToSchema UserTypeFilter where schema = - enum @Text "UserTypeFilter" $ + enum @Text $ mconcat [ element "regular" UserTypeFilterRegular, element "app" UserTypeFilterApp @@ -363,7 +362,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 +388,7 @@ data EmailVerificationFilter instance ToSchema EmailVerificationFilter where schema = - enum @Text "EmailVerificationFilter" $ + enum @Text $ element "unverified" EmailUnverified <> element "verified" EmailVerified @@ -424,6 +423,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 4c9863d317b..d3fd240bb88 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, @@ -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) @@ -386,7 +383,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 +418,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 f4dfa28d941..a61be18db5d 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 9e8ed1bb333..7cda7a5c358 100644 --- a/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs +++ b/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs @@ -76,9 +76,9 @@ 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 $ + objectWithDocModifier addPageDocs $ UserGroupPage <$> page .= field "page" (array schema) <*> total .= field "total" schema diff --git a/services/background-worker/src/Wire/BackendNotificationPusher.hs b/services/background-worker/src/Wire/BackendNotificationPusher.hs index 938f5efdacb..cadce5c0270 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/brig/src/Brig/Effects/SFT.hs b/services/brig/src/Brig/Effects/SFT.hs index 04983783d5f..9eccfd3e4c5 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 91cf542e487..cd2ae315b0b 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 79126f484d3..e873acf3636 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/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 0e702ace164..e522df10992 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 3bd3c22eefc..2caa19112d0 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 dd1b104d67a..c2d343547c5 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/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index d3152fe4158..21c89c56b04 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/Intra.hs b/tools/stern/src/Stern/Intra.hs index 6daee4beffe..642df74aaa4 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 () diff --git a/tools/stern/src/Stern/Types.hs b/tools/stern/src/Stern/Types.hs index 24dde504caa..ccbf19cedd4 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"