Add a few more swagger descriptions and examples. (#4323)

changelog.d/4-docs/fix-swagger-2024-10-31

@@ -0,0 +1 @@
+Add a few more swagger descriptions and examples.

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

@@ -73,6 +73,7 @@ module Data.Schema
     dispatch,
     text,
     parsedText,
+    parsedTextWithDoc,
     null_,
     nullable,
     element,
@@ -638,6 +639,17 @@ parsedText ::
   SchemaP NamedSwaggerDoc A.Value A.Value Text a
 parsedText name parser = text name `withParser` (either fail pure . parser)
 
+-- | A schema for a textual value with possible failure.
+parsedTextWithDoc ::
+  Text ->
+  Text ->
+  (Text -> Either String a) ->
+  SchemaP NamedSwaggerDoc A.Value A.Value Text a
+parsedTextWithDoc desc name parser = appendDescr (text name) `withParser` (either fail pure . parser)
+  where
+    appendDescr :: ValueSchema NamedSwaggerDoc Text -> ValueSchema NamedSwaggerDoc Text
+    appendDescr = (doc . S.description) %~ (Just . maybe desc (<> ("\n" <> desc)))
+
 -- | A schema for an arbitrary JSON object.
 jsonObject :: ValueSchema SwaggerDoc A.Object
 jsonObject =

libs/wire-api/src/Wire/API/Asset.hs

@@ -177,8 +177,11 @@ assetKeyToText = T.decodeUtf8 . toByteString'
 instance ToSchema AssetKey where
   schema =
     assetKeyToText
-      .= parsedText "AssetKey" (runParser parser . T.encodeUtf8)
+      .= parsedTextWithDoc desc "AssetKey" (runParser parser . T.encodeUtf8)
       & doc' . S.schema . S.example ?~ toJSON ("3-1-47de4580-ae51-4650-acbb-d10c028cb0ac" :: Text)
+    where
+      desc =
+        "S3 asset key for an icon image with retention information."
 
 instance S.ToParamSchema AssetKey where
   toParamSchema _ = S.toParamSchema (Proxy @Text)

libs/wire-api/src/Wire/API/Routes/Internal/Galley/TeamsIntra.hs

@@ -27,7 +27,6 @@ module Wire.API.Routes.Internal.Galley.TeamsIntra
   )
 where
 
-import Control.Lens ((?~))
 import Data.Aeson
 import Data.Currency qualified as Currency
 import Data.Json.Util
@@ -82,7 +81,6 @@ instance S.ToSchema TeamData where
 data TeamStatusUpdate = TeamStatusUpdate
   { tuStatus :: !TeamStatus,
     tuCurrency :: !(Maybe Currency.Alpha)
-    -- TODO: Remove Currency selection once billing supports currency changes after team creation
   }
   deriving (Eq, Show, Generic)
   deriving (Arbitrary) via GenericUniform TeamStatusUpdate
@@ -93,15 +91,7 @@ instance S.ToSchema TeamStatusUpdate where
     S.object "TeamStatusUpdate" $
       TeamStatusUpdate
         <$> tuStatus S..= S.field "status" S.schema
-        <*> tuCurrency S..= S.maybe_ (S.optField "currency" currencyAlphaSchema)
-    where
-      currencyAlphaSchema :: S.ValueSchema S.NamedSwaggerDoc Currency.Alpha
-      currencyAlphaSchema = S.mkSchema docs parseJSON (pure . toJSON)
-        where
-          docs =
-            S.swaggerDoc @Text
-              & Swagger.schema . Swagger.description ?~ "ISO 4217 alphabetic codes"
-              & Swagger.schema . Swagger.example ?~ "EUR"
+        <*> tuCurrency S..= S.maybe_ (S.optField "currency" S.genericToSchema)
 
 newtype TeamName = TeamName
   {tnName :: Text}

libs/wire-api/src/Wire/API/Team.hs

@@ -62,7 +62,7 @@ module Wire.API.Team
 where
 
 import Control.Lens (makeLenses, over, (?~))
-import Data.Aeson (FromJSON, ToJSON, Value (..))
+import Data.Aeson (FromJSON, ToJSON, Value (..), toJSON)
 import Data.Aeson.Types (Parser)
 import Data.Attoparsec.ByteString qualified as Atto (Parser, string)
 import Data.Attoparsec.Combinator (choice)
@@ -183,8 +183,8 @@ newTeamObjectSchema :: ObjectSchema SwaggerDoc NewTeam
 newTeamObjectSchema =
   NewTeam
     <$> newTeamName .= fieldWithDocModifier "name" (description ?~ "team name") schema
-    <*> newTeamIcon .= fieldWithDocModifier "icon" (description ?~ "team icon (asset ID)") schema
-    <*> newTeamIconKey .= maybe_ (optFieldWithDocModifier "icon_key" (description ?~ "team icon asset key") schema)
+    <*> newTeamIcon .= field "icon" schema
+    <*> newTeamIconKey .= maybe_ (optFieldWithDocModifier "icon_key" (description ?~ "The decryption key for the team icon S3 asset") schema)
 
 instance ToSchema NewTeam where
   schema = object "NewTeam" newTeamObjectSchema
@@ -214,7 +214,11 @@ instance ToByteString Icon where
 instance ToSchema Icon where
   schema =
     (T.decodeUtf8 . toByteString')
-      .= parsedText "Icon" (runParser parser . T.encodeUtf8)
+      .= parsedTextWithDoc desc "Icon" (runParser parser . T.encodeUtf8)
+      & doc' . S.schema . S.example ?~ toJSON ("3-1-47de4580-ae51-4650-acbb-d10c028cb0ac" :: Text)
+    where
+      desc =
+        "S3 asset key for an icon image with retention information. Allows special value 'default'."
 
 data TeamUpdateData = TeamUpdateData
   { _nameUpdate :: Maybe (Range 1 256 Text),

libs/wire-api/src/Wire/API/User.hs

@@ -1305,8 +1305,6 @@ newTeamUserTeamId = \case
 data BindingNewTeamUser = BindingNewTeamUser
   { bnuTeam :: NewTeam,
     bnuCurrency :: Maybe Currency.Alpha
-    -- FUTUREWORK:
-    -- Remove Currency selection once billing supports currency changes after team creation
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform BindingNewTeamUser)

libs/wire-api/src/Wire/API/User/Orphans.hs

@@ -26,8 +26,10 @@ import Data.Char
 import Data.Currency qualified as Currency
 import Data.ISO3166_CountryCodes
 import Data.LanguageCodes
-import Data.OpenApi
+import Data.OpenApi as O
 import Data.Proxy
+import Data.Schema as S
+import Data.Text qualified as T
 import Data.UUID
 import Data.X509 as X509
 import Imports
@@ -42,9 +44,9 @@ deriving instance Generic ISO639_1
 
 -- Swagger instances
 
-instance ToSchema ISO639_1
+instance O.ToSchema ISO639_1
 
-instance ToSchema CountryCode
+instance O.ToSchema CountryCode
 
 -- FUTUREWORK: push orphans upstream to saml2-web-sso, servant-multipart
 -- FUTUREWORK: maybe avoid orphans altogether by defining schema instances manually
@@ -69,19 +71,19 @@ samlSchemaOptions =
 
 -- This type comes from a seperate repo, so we're keeping the prefix dropping
 -- for the moment.
-instance ToSchema SAML.XmlText where
+instance O.ToSchema SAML.XmlText where
   declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions
 
 instance ToParamSchema SAML.IdPId where
   toParamSchema _ = toParamSchema (Proxy @UUID)
 
-instance ToSchema SAML.AuthnRequest where
+instance O.ToSchema SAML.AuthnRequest where
   declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions
 
-instance ToSchema SAML.NameIdPolicy where
+instance O.ToSchema SAML.NameIdPolicy where
   declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions
 
-instance ToSchema SAML.NameIDFormat where
+instance O.ToSchema SAML.NameIDFormat where
   declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions
 
 -- The generic schema breaks on this type, so we define it by hand.
@@ -92,7 +94,7 @@ instance ToSchema SAML.NameIDFormat where
 -- and this results in an array whose underlying type which is at the same time
 -- marked as a string, and referring to the schema for AuthnRequest, which is of
 -- course invalid.
-instance ToSchema (SAML.FormRedirect SAML.AuthnRequest) where
+instance O.ToSchema (SAML.FormRedirect SAML.AuthnRequest) where
   declareNamedSchema _ = do
     authnReqSchema <- declareSchemaRef (Proxy @SAML.AuthnRequest)
     pure $
@@ -102,45 +104,58 @@ instance ToSchema (SAML.FormRedirect SAML.AuthnRequest) where
           & properties . at "uri" ?~ Inline (toSchema (Proxy @Text))
           & properties . at "xml" ?~ authnReqSchema
 
-instance ToSchema (SAML.ID SAML.AuthnRequest) where
+instance O.ToSchema (SAML.ID SAML.AuthnRequest) where
   declareNamedSchema =
     genericDeclareNamedSchema
       samlSchemaOptions
         { datatypeNameModifier = const "Id_AuthnRequest"
         }
 
-instance ToSchema SAML.Time where
+instance O.ToSchema SAML.Time where
   declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions
 
-instance ToSchema SAML.SPMetadata where
+instance O.ToSchema SAML.SPMetadata where
   declareNamedSchema _ = declareNamedSchema (Proxy @String)
 
-instance ToSchema Void where
+instance O.ToSchema Void where
   declareNamedSchema _ = declareNamedSchema (Proxy @String)
 
 instance (HasOpenApi route) => HasOpenApi (SM.MultipartForm SM.Mem resp :> route) where
   toOpenApi _proxy = toOpenApi (Proxy @route)
 
-instance ToSchema SAML.IdPId where
+instance O.ToSchema SAML.IdPId where
   declareNamedSchema _ = declareNamedSchema (Proxy @UUID)
 
-instance (ToSchema a) => ToSchema (SAML.IdPConfig a) where
+instance (O.ToSchema a) => O.ToSchema (SAML.IdPConfig a) where
   declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions
 
-instance ToSchema SAML.Issuer where
+instance O.ToSchema SAML.Issuer where
   declareNamedSchema _ = declareNamedSchema (Proxy @String)
 
-instance ToSchema URI where
+instance O.ToSchema URI where
   declareNamedSchema _ = declareNamedSchema (Proxy @String)
 
-instance ToParamSchema URI where
+instance O.ToParamSchema URI where
   toParamSchema _ = toParamSchema (Proxy @String)
 
-instance ToSchema X509.SignedCertificate where
+instance O.ToSchema X509.SignedCertificate where
   declareNamedSchema _ = declareNamedSchema (Proxy @String)
 
-instance ToSchema SAML.IdPMetadata where
+instance O.ToSchema SAML.IdPMetadata where
   declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions
 
-instance ToSchema Currency.Alpha where
-  declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
+instance S.ToSchema Currency.Alpha where
+  schema = S.enum @Text "Currency.Alpha" 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 ..])
+
+      swaggerTweaks :: O.Schema -> O.Schema
+      swaggerTweaks =
+        ( O.description
+            ?~ "ISO 4217 alphabetic codes. This is only stored by the backend, not processed. \
+               \It can be removed once billing supports currency changes after team creation."
+        )
+          . (O.example ?~ "EUR")
+
+deriving via (S.Schema Currency.Alpha) instance O.ToSchema Currency.Alpha

services/brig/src/Brig/API/User.hs

@@ -720,7 +720,6 @@ activateWithCurrency ::
   -- | The user for whom to activate the key.
   Maybe UserId ->
   -- | Potential currency update.
-  -- ^ TODO: to be removed once billing supports currency changes after team creation
   Maybe Currency.Alpha ->
   ExceptT ActivationError (AppT r) ActivationResult
 activateWithCurrency tgt code usr cur = do

services/brig/src/Brig/Version.hs

@@ -26,7 +26,7 @@ import Wire.API.Routes.Named
 import Wire.API.Routes.Version
 
 versionAPI :: ServerT VersionAPI (Handler r)
-versionAPI = Named $ do
+versionAPI = Named @"get-version" $ do
   fed <- asks (.federator)
   dom <- viewFederationDomain
   disabled <- asks (.disabledVersions)