Make schema-profunctor schema names derived and avoid name clashes between scopes.

changelog.d/4-docs/swagger-hacking

@@ -0,0 +1 @@
+Make schema-profunctor schema names derived and avoid name clashes between scopes.

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>
+
+SWAGGER_URL="${1:-https://staging-nginz-https.zinfra.io/v16/api/swagger.json}"
+OUTPUT_DIR="$(pwd)/generated"
+
+echo "==> Generating clients from: $SWAGGER_URL"
+echo "==> Output directory: $OUTPUT_DIR"
+
+# Clean up previous runs
+rm -rf "$OUTPUT_DIR"
+mkdir -p "$OUTPUT_DIR"
+
+# Download the spec
+echo "==> Downloading OpenAPI spec..."
+curl -s "$SWAGGER_URL" > "$OUTPUT_DIR/swagger.json"
+
+# Check if docker is available
+if ! command -v docker &> /dev/null; then
+    echo "Error: docker is not installed. Please install docker to use openapi-generator."
+    echo "Alternative: install openapi-generator-cli via npm: npm install -g @openapitools/openapi-generator-cli"
+    exit 1
+fi
+
+# Generate TypeScript client
+echo ""
+echo "==> Generating TypeScript client..."
+docker run --rm \
+    -v "$OUTPUT_DIR:/local" \
+    openapitools/openapi-generator-cli:latest generate \
+    -i /local/swagger.json \
+    -g typescript-axios \
+    -o /local/typescript \
+    --additional-properties=supportsES6=true,npmName=wire-api-client,npmVersion=1.0.0
+
+# Generate Kotlin client
+echo ""
+echo "==> Generating Kotlin client..."
+docker run --rm \
+    -v "$OUTPUT_DIR:/local" \
+    openapitools/openapi-generator-cli:latest generate \
+    -i /local/swagger.json \
+    -g kotlin \
+    -o /local/kotlin \
+    --additional-properties=packageName=com.wire.api.client,serializationLibrary=gson
+
+echo ""
+echo "==> Done! Generated clients:"
+echo "  TypeScript: $OUTPUT_DIR/typescript"
+echo "  Kotlin:     $OUTPUT_DIR/kotlin"

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)

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
 

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)

libs/schema-profunctor/src/Data/Schema.hs

@@ -50,8 +50,12 @@ module Data.Schema
     declareSwaggerSchema,
     getName,
     object,
+    namedObject,
     objectWithDocModifier,
+    namedObjectWithDocModifier,
     objectOver,
+    namedObjectOver,
+    mkSchemaName,
     jsonObject,
     jsonValue,
     field,
@@ -67,6 +71,7 @@ module Data.Schema
     map_,
     mapWithKeys,
     enum,
+    namedEnum,
     maybe_,
     maybeWithDefault,
     bind,
@@ -97,6 +102,7 @@ import Control.Monad.Trans.Cont
 import Data.Aeson.Key qualified as Key
 import Data.Aeson.Types qualified as A
 import Data.Bifunctor.Joker
+import Data.Typeable (typeRep)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Map qualified as Map
@@ -401,38 +407,75 @@ 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.  If that's not unique, we should probably
+-- change those type names.  This will avoid collisions in the hash
+-- table keeping track of all the schema references in openapi3.
+-- track of all the schema references in openapi3.
+mkSchemaName :: forall a. (Typeable a) => Text
+mkSchemaName = T.pack $ show $ typeRep (Proxy @a)
+
 -- | Like 'object', but apply an arbitrary function to the
 -- documentation of the resulting object.
+-- 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 +600,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 +706,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.