wireapp · fisx · Oct 17, 2024 · Oct 21, 2024 · Oct 21, 2024 · Oct 22, 2024
@@ -85,7 +85,7 @@ cabal.project.local:
 c: treefmt c-fast
 
 .PHONY: c
-c-fast: 
+c-fast:
 	cabal build $(WIRE_CABAL_BUILD_OPTIONS) $(package) || ( make clean-hint; false )
 ifeq ($(test), 1)
 	./hack/bin/cabal-run-tests.sh $(package) $(testargs)
@@ -173,7 +173,7 @@ lint-all: formatc hlint-check-all lint-common
 # The extra 'hlint-check-pr' has been witnessed to be necessary due to
 # some bu in `hlint-inplace-pr`.  Details got lost in history.
 .PHONY: lint-all-shallow
-lint-all-shallow: lint-common formatf hlint-inplace-pr hlint-check-pr 
+lint-all-shallow: lint-common formatf hlint-inplace-pr hlint-check-pr
 
 .PHONY: lint-common
 lint-common: check-local-nix-derivations treefmt-check # weeder (does not work on CI yet)
@@ -602,3 +602,8 @@ upload-bombon:
 		--project-version $(HELM_SEMVER) \
 		--api-key $(DEPENDENCY_TRACK_API_KEY) \
 		--auto-create
+
+.PHONY: openapi-validate
+openapi-validate:
+	@echo -e "Make sure you are running the backend in another terminal (make cr)\n"
+	vacuum lint -a -d -w <(curl http://localhost:8082/v7/api/swagger.json)
@@ -0,0 +1 @@
+Fix openapi validation errors
@@ -4,8 +4,12 @@ import qualified API.Brig as BrigP
 import qualified Data.Set as Set
 import Data.String.Conversions
 import GHC.Stack
+import System.Exit
+import System.Process
 import Testlib.Assertions
 import Testlib.Prelude
+import UnliftIO.Directory
+import UnliftIO.Temporary
 
 existingVersions :: Set Int
 existingVersions = Set.fromList [0, 1, 2, 3, 4, 5, 6, 7]
@@ -80,3 +84,17 @@ testSwaggerToc = do
 
     html :: String
     html = "<html><head></head><body><h2>please pick an api version</h2><a href=\"/v0/api/swagger-ui/\">/v0/api/swagger-ui/</a><br><a href=\"/v1/api/swagger-ui/\">/v1/api/swagger-ui/</a><br><a href=\"/v2/api/swagger-ui/\">/v2/api/swagger-ui/</a><br><a href=\"/v3/api/swagger-ui/\">/v3/api/swagger-ui/</a><br><a href=\"/v4/api/swagger-ui/\">/v4/api/swagger-ui/</a><br><a href=\"/v5/api/swagger-ui/\">/v5/api/swagger-ui/</a><br><a href=\"/v6/api/swagger-ui/\">/v6/api/swagger-ui/</a><br><a href=\"/v7/api/swagger-ui/\">/v7/api/swagger-ui/</a><br></body>"
+
+-- | This runs the swagger linter [vacuum](https://quobix.com/vacuum/).  There is also a make
+-- rule that does this, for convenience in your develop flow.  In order to run vacuum on CI, we need a running brig (or at least but running this this test case
+-- makes it easier to do this in the integration test job on our CI.  vacuum
+testSwaggerLint :: (HasCallStack) => App ()
+testSwaggerLint = do
+  withSystemTempDirectory "testSwaggerLint-XXX.swagger.json" $ \swaggerFile ->
+    withCurrentDirectory swaggerFile $ do
+      let url = "http://localhost:8082/v" <> show (maximum existingVersions) <> "/api/swagger.json"
+          cmd = shell ("curl " <> url <> " > swagger.json && vacuum lint swagger.json 2>&1")
+      outcome@(exitCode, _out, _err) <- liftIO $ readCreateProcessWithExitCode cmd ""
+      case exitCode of
+        ExitSuccess -> pure ()
+        _ -> error (show outcome)
@@ -225,20 +225,20 @@ instance (ToParamSchema a, KnownNat n, KnownNat m) => ToParamSchema (Range n m [
 instance (KnownNat n, KnownNat m) => ToParamSchema (Range n m String) where
   toParamSchema _ =
     toParamSchema (Proxy @String)
-      & S.maxLength ?~ fromKnownNat (Proxy @n)
-      & S.minLength ?~ fromKnownNat (Proxy @m)
+      & S.minLength ?~ fromKnownNat (Proxy @n)
+      & S.maxLength ?~ fromKnownNat (Proxy @m)
 
 instance (KnownNat n, KnownNat m) => ToParamSchema (Range n m T.Text) where
   toParamSchema _ =
     toParamSchema (Proxy @T.Text)
-      & S.maxLength ?~ fromKnownNat (Proxy @n)
-      & S.minLength ?~ fromKnownNat (Proxy @m)
+      & S.minLength ?~ fromKnownNat (Proxy @n)
+      & S.maxLength ?~ fromKnownNat (Proxy @m)
 
 instance (KnownNat n, KnownNat m) => ToParamSchema (Range n m TL.Text) where
   toParamSchema _ =
     toParamSchema (Proxy @TL.Text)
-      & S.maxLength ?~ fromKnownNat (Proxy @n)
-      & S.minLength ?~ fromKnownNat (Proxy @m)
+      & S.minLength ?~ fromKnownNat (Proxy @n)
+      & S.maxLength ?~ fromKnownNat (Proxy @m)
 
 instance (KnownNat n, S.ToSchema a, KnownNat m) => S.ToSchema (Range n m a) where
   declareNamedSchema _ =

@@ -35,6 +35,7 @@ data Versioned v name
 
 instance {-# OVERLAPPING #-} (RenderableSymbol a) => RenderableSymbol (Versioned v a) where
   renderSymbol = renderSymbol @a
+  renderOperationId = renderOperationId @a
 
 type family FedPath (name :: k) :: Symbol
 

@@ -466,7 +466,7 @@ mkSFTUsername shared expires rnd =
     }
 
 instance ToSchema SFTUsername where
-  schema = toText .= parsedText "" fromText
+  schema = toText .= parsedText "SFTUsername" fromText
     where
       fromText :: Text -> Either String SFTUsername
       fromText = parseOnly (parseSFTUsername <* endOfInput)
@@ -543,7 +543,7 @@ turnUsername expires rnd =
     }
 
 instance ToSchema TurnUsername where
-  schema = toText .= parsedText "" fromText
+  schema = toText .= parsedText "TurnUsername" fromText
     where
       fromText :: Text -> Either String TurnUsername
       fromText = parseOnly (parseTurnUsername <* endOfInput)

@@ -108,7 +108,7 @@ optionalActiveMLSConversationDataSchema (Just v)
             (description ?~ "The epoch number of the corresponding MLS group")
             schema
         <*> fmap (.epochTimestamp)
-          .= field "epoch_timestamp" (named "Epoch Timestamp" . nullable . unnamed $ utcTimeSchema)
+          .= field "epoch_timestamp" (named "EpochTimestamp" . nullable . unnamed $ utcTimeSchema)
         <*> maybe MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 (.ciphersuite)
           .= fieldWithDocModifier
             "cipher_suite"

@@ -409,7 +409,7 @@ taggedEventDataSchema =
 
 memberLeaveSchema :: ValueSchema NamedSwaggerDoc (EdMemberLeftReason, QualifiedUserIdList)
 memberLeaveSchema =
-  object "QualifiedUserIdList with EdMemberLeftReason" $
+  object "QualifiedUserIdList_with_EdMemberLeftReason" $
     (,) <$> fst .= field "reason" schema <*> snd .= qualifiedUserIdListObjectSchema
 
 instance ToSchema Event where

@@ -282,7 +282,7 @@ data ServiceProfilePage = ServiceProfilePage
 
 instance ToSchema ServiceProfilePage where
   schema =
-    object "ServiceProfile" $
+    object "ServiceProfilePage" $
       ServiceProfilePage
         <$> serviceProfilePageHasMore .= field "has_more" schema
         <*> serviceProfilePageResults .= field "services" (array schema)

@@ -180,7 +180,7 @@ instance ToByteString ServiceTag where
   builder WeatherTag = "weather"
 
 instance ToSchema ServiceTag where
-  schema = enum @Text "" . mconcat $ (\a -> element (decodeUtf8With lenientDecode $ toStrict $ toByteString a) a) <$> [minBound ..]
+  schema = enum @Text "ServiceTag" . mconcat $ (\a -> element (decodeUtf8With lenientDecode $ toStrict $ toByteString a) a) <$> [minBound ..]
 
 instance S.ToParamSchema ServiceTag where
   toParamSchema _ =

@@ -19,7 +19,7 @@
 
 module Wire.API.Routes.Named where
 
-import Control.Lens ((%~))
+import Control.Lens ((%~), (?~))
 import Data.Kind
 import Data.Metrics.Servant
 import Data.OpenApi.Lens hiding (HasServer)
@@ -42,17 +42,22 @@ newtype Named name x = Named {unnamed :: x}
 -- types other than string literals in some places.
 class RenderableSymbol a where
   renderSymbol :: Text
+  renderOperationId :: Text
+  renderOperationId = renderSymbol @a
 
 instance (KnownSymbol a) => RenderableSymbol a where
   renderSymbol = T.pack . show $ symbolVal (Proxy @a)
+  renderOperationId = T.pack $ symbolVal (Proxy @a)
 
 instance (RenderableSymbol a, RenderableSymbol b) => RenderableSymbol '(a, b) where
   renderSymbol = "(" <> (renderSymbol @a) <> ", " <> (renderSymbol @b) <> ")"
+  renderOperationId = renderOperationId @a <> "_" <> renderOperationId @b
 
 newtype RenderableTypeName a = RenderableTypeName a
 
 instance (GRenderableSymbol (Rep a)) => RenderableSymbol (RenderableTypeName a) where
   renderSymbol = grenderSymbol @(Rep a)
+  renderOperationId = grenderSymbol @(Rep a)
 
 class GRenderableSymbol f where
   grenderSymbol :: Text
@@ -64,6 +69,7 @@ instance (HasOpenApi api, RenderableSymbol name) => HasOpenApi (Named name api)
   toOpenApi _ =
     toOpenApi (Proxy @api)
       & allOperations . description %~ (Just (dscr <> "\n\n") <>)
+      & allOperations . operationId ?~ renderOperationId @name
     where
       dscr :: Text
       dscr =

@@ -168,12 +168,26 @@ type UserAPI =
           :> QualifiedCaptureUserId "uid"
           :> GetUserVerb
       )
+    :<|> Named
+           "update-user-email@v6"
+           ( Summary "Resend email address validation email."
+               :> Until 'V7
+               :> Description "If the user has a pending email validation, the validation email will be resent."
+               :> ZUser
+               :> "users"
+               :> CaptureUserId "uid"
+               :> "email"
+               :> ReqBody '[JSON] EmailUpdate
+               :> Put '[JSON] ()
+           )
     :<|> Named
            "update-user-email"
            ( Summary "Resend email address validation email."
+               :> From 'V7
                :> Description "If the user has a pending email validation, the validation email will be resent."
                :> ZUser
                :> "users"
+               :> "uid"
                :> CaptureUserId "uid"
                :> "email"
                :> ReqBody '[JSON] EmailUpdate
@@ -254,12 +268,29 @@ type UserAPI =
                :> ReqBody '[JSON] SendVerificationCode
                :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Verification code sent."] ()
            )
+    :<|> Named
+           "get-rich-info@v6"
+           ( Summary "Get a user's rich info"
+               :> Until 'V7
+               :> CanThrow 'InsufficientTeamPermissions
+               :> ZLocalUser
+               :> "users"
+               :> CaptureUserId "uid"
+               :> "rich-info"
+               :> MultiVerb
+                    'GET
+                    '[JSON]
+                    '[Respond 200 "Rich info about the user" RichInfoAssocList]
+                    RichInfoAssocList
+           )
     :<|> Named
            "get-rich-info"
            ( Summary "Get a user's rich info"
+               :> From 'V7
                :> CanThrow 'InsufficientTeamPermissions
                :> ZLocalUser
                :> "users"
+               :> "uid"
                :> CaptureUserId "uid"
                :> "rich-info"
                :> MultiVerb

@@ -52,7 +52,7 @@ type BotAPI =
         :> ZAccess
         :> ZConn
         :> "conversations"
-        :> Capture "Conversation ID" ConvId
+        :> Capture "conv" ConvId
         :> "bots"
         :> ReqBody '[JSON] AddBot
         :> MultiVerb1 'POST '[JSON] (Respond 201 "" AddBotResponse)
@@ -65,9 +65,9 @@ type BotAPI =
                :> ZAccess
                :> ZConn
                :> "conversations"
-               :> Capture "Conversation ID" ConvId
+               :> Capture "conv" ConvId
                :> "bots"
-               :> Capture "Bot ID" BotId
+               :> Capture "bot" BotId
                :> MultiVerb 'DELETE '[JSON] DeleteResponses (Maybe RemoveBotResponse)
            )
     :<|> Named
@@ -178,7 +178,7 @@ type BotAPI =
                :> ZBot
                :> "bot"
                :> "users"
-               :> Capture "User ID" UserId
+               :> Capture "user" UserId
                :> "clients"
                :> Get '[JSON] [PubClient]
            )