From d6eade4b3c46c987500243cd9e7201236657eb8b Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 4 Nov 2024 15:08:13 +0100 Subject: [PATCH] Add a few more swagger descriptions and examples. (#4323) --- changelog.d/4-docs/fix-swagger-2024-10-31 | 1 + libs/schema-profunctor/src/Data/Schema.hs | 12 ++++ libs/wire-api/src/Wire/API/Asset.hs | 5 +- .../API/Routes/Internal/Galley/TeamsIntra.hs | 12 +--- libs/wire-api/src/Wire/API/Team.hs | 12 ++-- libs/wire-api/src/Wire/API/User.hs | 2 - libs/wire-api/src/Wire/API/User/Orphans.hs | 57 ++++++++++++------- services/brig/src/Brig/API/User.hs | 1 - services/brig/src/Brig/Version.hs | 2 +- 9 files changed, 63 insertions(+), 41 deletions(-) create mode 100644 changelog.d/4-docs/fix-swagger-2024-10-31 diff --git a/changelog.d/4-docs/fix-swagger-2024-10-31 b/changelog.d/4-docs/fix-swagger-2024-10-31 new file mode 100644 index 00000000000..46b2dbd3f93 --- /dev/null +++ b/changelog.d/4-docs/fix-swagger-2024-10-31 @@ -0,0 +1 @@ +Add a few more swagger descriptions and examples. \ No newline at end of file diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index 9f6104e07a9..87fdee9075e 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/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 = diff --git a/libs/wire-api/src/Wire/API/Asset.hs b/libs/wire-api/src/Wire/API/Asset.hs index d2a53bad442..a5496f42746 100644 --- a/libs/wire-api/src/Wire/API/Asset.hs +++ b/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) 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 0bc3ae5a593..90ca36342c1 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 @@ -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} diff --git a/libs/wire-api/src/Wire/API/Team.hs b/libs/wire-api/src/Wire/API/Team.hs index a1fc3c99b8a..283dbaff55b 100644 --- a/libs/wire-api/src/Wire/API/Team.hs +++ b/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), diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 25cf9e88172..75387c76429 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/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) diff --git a/libs/wire-api/src/Wire/API/User/Orphans.hs b/libs/wire-api/src/Wire/API/User/Orphans.hs index 316889c115a..bfaaff37b40 100644 --- a/libs/wire-api/src/Wire/API/User/Orphans.hs +++ b/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 diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 46c3e658e30..7ff8e0f22b1 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/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 diff --git a/services/brig/src/Brig/Version.hs b/services/brig/src/Brig/Version.hs index 86f3a33b937..606639c9830 100644 --- a/services/brig/src/Brig/Version.hs +++ b/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)