SQSERVICES 1011 Servantify Gally Team API (GET /teams)

changelog.d/1-api-changes/pr-2027

@@ -0,0 +1 @@
+The deprecated endpoint `GET /teams` now ignores query parameters `ids`, `start`

changelog.d/5-internal/pr-2008

@@ -1 +1 @@
-Servantify Galley Teams API. (#2008, #2010)
+Servantify Galley Teams API. (#2008, #2010, #2027)

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

@@ -49,6 +49,8 @@ import Wire.API.Team.Conversation
 import Wire.API.Team.Feature
 import Wire.API.Team.Permission (Perm (..))
 
+-- import Wire.API.Team.Permission (Perm (..))
+
 instance AsHeaders '[ConvId] Conversation Conversation where
   toHeaders c = (I (qUnqualified (cnvQualifiedId c)) :* Nil, c)
   fromHeaders = snd
@@ -741,10 +743,17 @@ data Api routes = Api
              'PUT
              '[JSON]
              '[RespondEmpty 200 "Team updated"]
-             ()
+             (),
+    getTeams :: routes :- GetTeams
   }
   deriving (Generic)
 
+type GetTeams =
+  Summary "Get teams (deprecated)"
+    :> ZUser
+    :> "teams"
+    :> Get '[JSON] TeamList
+
 type ServantAPI = ToServantApi Api
 
 type FeatureStatusGet featureName =

services/galley/src/Galley/API/Public.hs

@@ -189,32 +189,14 @@ servantSitemap =
         GalleyAPI.featureConfigSelfDeletingMessagesGet = Features.getFeatureConfig @'Public.WithLockStatus @'Public.TeamFeatureSelfDeletingMessages Features.getSelfDeletingMessagesInternal,
         GalleyAPI.featureConfigGuestLinksGet = Features.getFeatureConfig @'Public.WithLockStatus @'Public.TeamFeatureGuestLinks Features.getGuestLinkInternal,
         GalleyAPI.createNonBindingTeam = Teams.createNonBindingTeamH,
-        GalleyAPI.updateTeam = Teams.updateTeamH
+        GalleyAPI.updateTeam = Teams.updateTeamH,
+        GalleyAPI.getTeams = Teams.getManyTeams
       }
 
 sitemap :: Routes ApiBuilder (Sem GalleyEffects) ()
 sitemap = do
   -- Team API -----------------------------------------------------------
 
-  get "/teams" (continue Teams.getManyTeamsH) $
-    zauthUserId
-      .&. opt (query "ids" ||| query "start")
-      .&. def (unsafeRange 100) (query "size")
-      .&. accept "application" "json"
-  document "GET" "getManyTeams" $ do
-    parameter Query "ids" (array string') $ do
-      optional
-      description "At most 32 team IDs per request. Mutually exclusive with `start`."
-    parameter Query "start" string' $ do
-      optional
-      description "Team ID to start from (exclusive). Mutually exclusive with `ids`."
-    parameter Query "size" (int32Between 1 100) $ do
-      optional
-      description "Max. number of teams to return"
-    summary "Get teams"
-    returns (ref Public.modelTeamList)
-    response 200 "Teams list" end
-
   get "/teams/:tid" (continue Teams.getTeamH) $
     zauthUserId
       .&. capture "tid"

services/galley/src/Galley/API/Teams.hs

@@ -25,7 +25,7 @@ module Galley.API.Teams
     getTeamNameInternalH,
     getBindingTeamIdH,
     getBindingTeamMembersH,
-    getManyTeamsH,
+    getManyTeams,
     deleteTeamH,
     uncheckedDeleteTeam,
     addTeamMemberH,
@@ -73,6 +73,7 @@ import Data.List1 (list1)
 import qualified Data.Map as Map
 import qualified Data.Map.Strict as M
 import Data.Misc (HttpsUrl, mkHttpsUrl)
+import Data.Proxy
 import Data.Qualified
 import Data.Range as Range
 import qualified Data.Set as Set
@@ -170,21 +171,25 @@ getTeamNameInternalH (tid ::: _) =
 getTeamNameInternal :: Member TeamStore r => TeamId -> Sem r (Maybe TeamName)
 getTeamNameInternal = fmap (fmap TeamName) . E.getTeamName
 
-getManyTeamsH ::
-  (Members '[TeamStore, Queue DeleteItem, ListItems LegacyPaging TeamId] r) =>
-  UserId ::: Maybe (Either (Range 1 32 (List TeamId)) TeamId) ::: Range 1 100 Int32 ::: JSON ->
-  Sem r Response
-getManyTeamsH (zusr ::: range ::: size ::: _) =
-  json <$> getManyTeams zusr range size
-
+-- | DEPRECATED.
+--
+-- The endpoint was designed to query non-binding teams. However, non-binding teams is a feature
+-- that has never been adopted by clients, but the endpoint also returns the binding team of a user and it is
+-- possible that this is being used by a client, even though unlikely.
+--
+-- The following functionality has been changed: query parameters will be ignored, which has the effect
+-- that regardless of the parameters the response will always contain the binding team of the user if
+-- it exists. Even though they are ignored, the use of query parameters will not result in an error.
+--
+-- (If you want to be pedantic, the `size` parameter is still honored: its allowed range is
+-- between 1 and 100, and that will always be an upper bound of the result set of size 0 or
+-- one.)
 getManyTeams ::
   (Members '[TeamStore, Queue DeleteItem, ListItems LegacyPaging TeamId] r) =>
   UserId ->
-  Maybe (Either (Range 1 32 (List TeamId)) TeamId) ->
-  Range 1 100 Int32 ->
   Sem r Public.TeamList
-getManyTeams zusr range size =
-  withTeamIds zusr range size $ \more ids -> do
+getManyTeams zusr =
+  withTeamIds zusr Nothing (toRange (Proxy @100)) $ \more ids -> do
     teams <- mapM (lookupTeam zusr) ids
     pure (Public.newTeamList (catMaybes teams) more)
 

services/galley/test/integration/API/Teams.hs

@@ -83,7 +83,8 @@ tests :: IO TestSetup -> TestTree
 tests s =
   testGroup "Teams API" $
     [ test s "create team" testCreateTeam,
-      test s "create multiple binding teams fail" testCreateMulitpleBindingTeams,
+      test s "get teams 12123" testGetTeams,
+      test s "create multiple binding teams fail" testCreateMultipleBindingTeams,
       test s "create binding team with currency" testCreateBindingTeamWithCurrency,
       test s "create team with members" testCreateTeamWithMembers,
       testGroup "List Team Members" $
@@ -164,8 +165,30 @@ testCreateTeam = do
         e ^. eventData @?= Just (EdTeamCreate team)
       void $ WS.assertSuccess eventChecks
 
-testCreateMulitpleBindingTeams :: TestM ()
-testCreateMulitpleBindingTeams = do
+testGetTeams :: TestM ()
+testGetTeams = do
+  owner <- Util.randomUser
+  Util.getTeams owner [] >>= checkTeamList Nothing
+  tid <- Util.createBindingTeamInternal "foo" owner <* assertQueue "create team" tActivate
+  wrongTid <- (Util.randomUser >>= Util.createBindingTeamInternal "foobar") <* assertQueue "create team" tActivate
+  Util.getTeams owner [] >>= checkTeamList (Just tid)
+  Util.getTeams owner [("size", "1")] >>= checkTeamList (Just tid)
+  Util.getTeams owner [("ids", show tid)] >>= checkTeamList (Just tid)
+  Util.getTeams owner [("ids", show tid <> "," <> show wrongTid)] >>= checkTeamList (Just tid)
+  -- these two queries do not yield responses that are equivalent to the odl wai route API
+  Util.getTeams owner [("ids", show wrongTid)] >>= checkTeamList (Just tid)
+  Util.getTeams owner [("start", show tid)] >>= checkTeamList (Just tid)
+  where
+    checkTeamList :: Maybe TeamId -> TeamList -> TestM ()
+    checkTeamList mbTid tl = liftIO $ do
+      let teams = tl ^. teamListTeams
+      assertEqual "teamListHasMore" False (tl ^. teamListHasMore)
+      case mbTid of
+        Just tid -> assertEqual "teamId" tid (Imports.head teams ^. teamId)
+        Nothing -> assertEqual "teams size" 0 (length teams)
+
+testCreateMultipleBindingTeams :: TestM ()
+testCreateMultipleBindingTeams = do
   g <- view tsGalley
   owner <- Util.randomUser
   _ <- Util.createBindingTeamInternal "foo" owner

services/galley/test/integration/API/Util.hs

@@ -149,7 +149,7 @@ symmPermissions p = let s = Set.fromList p in fromJust (newPermissions s s)
 createBindingTeam :: HasCallStack => TestM (UserId, TeamId)
 createBindingTeam = do
   ownerid <- randomTeamCreator
-  teams <- getTeams ownerid
+  teams <- getTeams ownerid []
   let [team] = view teamListTeams teams
   let tid = view teamId team
   SQS.assertQueue "create team" SQS.tActivate
@@ -176,19 +176,23 @@ createBindingTeamWithQualifiedMembers num = do
   (tid, owner, users) <- createBindingTeamWithMembers num
   pure (tid, Qualified owner localDomain, map (`Qualified` localDomain) users)
 
-getTeams :: UserId -> TestM TeamList
-getTeams u = do
+getTeams :: UserId -> [(String, String)] -> TestM TeamList
+getTeams u queryItems = do
   g <- view tsGalley
   r <-
     get
       ( g
           . paths ["teams"]
+          . mkQueryItems queryItems
           . zUser u
           . zConn "conn"
           . zType "access"
           . expect2xx
       )
   return $ responseJsonUnsafe r
+  where
+    mkQueryItems :: [(String, String)] -> Request -> Request
+    mkQueryItems = foldl (\f (n, v) -> f . queryItem (C.pack n) (C.pack v)) id
 
 createBindingTeamWithNMembers :: Int -> TestM (UserId, TeamId, [UserId])
 createBindingTeamWithNMembers = createBindingTeamWithNMembersWithHandles False