[WPB-25136] Do not count apps as paying users.

changelog.d/1-api-changes/WPB-25136-do-not-count-apps-as-paying-users

@@ -0,0 +1 @@
+`GET /teams/:tid/size` response body lists `teamSizeRegulars`, `teamSizeApps`.

changelog.d/3-bug-fixes/WPB-25136-do-not-count-apps-as-paying-users

@@ -0,0 +1 @@
+Do not count apps as paying users.

integration/test/API/Brig.hs

@@ -932,6 +932,12 @@ activateSend domain email locale = do
   req <- rawBaseRequest domain Brig Versioned $ joinHttpPath ["activate", "send"]
   submit "POST" $ req & addJSONObject (["email" .= email] <> maybeToList (((.=) "locale") <$> locale))
 
+-- https://staging-nginz-https.zinfra.io/v16/api/swagger-ui/#/default/get-team-size
+getTeamSize :: (HasCallStack, MakesValue user) => user -> String -> App Response
+getTeamSize user tid = do
+  req <- baseRequest user Brig Versioned $ joinHttpPath ["teams", tid, "size"]
+  submit "GET" req
+
 acceptTeamInvitation :: (HasCallStack, MakesValue user) => user -> String -> Maybe String -> App Response
 acceptTeamInvitation user code mPw = do
   req <- baseRequest user Brig Versioned $ joinHttpPath ["teams", "invitations", "accept"]

integration/test/API/BrigInternal.hs

@@ -186,6 +186,11 @@ refreshIndex domain = do
   res <- submit "POST" req
   res.status `shouldMatchInt` 200
 
+getTeamSize :: (HasCallStack, MakesValue caller) => caller -> String -> App Response
+getTeamSize caller tid = do
+  req <- baseRequest caller Brig Unversioned $ joinHttpPath ["i", "teams", tid, "size"]
+  submit "GET" req
+
 addFederationRemoteTeam :: (HasCallStack, MakesValue domain, MakesValue remoteDomain, MakesValue team) => domain -> remoteDomain -> team -> App ()
 addFederationRemoteTeam domain remoteDomain team = do
   void $ addFederationRemoteTeam' domain remoteDomain team >>= getBody 200

integration/test/Test/Apps.hs

@@ -19,7 +19,7 @@
 
 module Test.Apps where
 
-import API.Brig
+import API.Brig as Brig
 import qualified API.BrigInternal as BrigI
 import API.Common
 import API.Galley
@@ -28,6 +28,7 @@ import Data.Aeson.QQ.Simple
 import MLS.Util
 import Notifications
 import SetupHelpers
+import System.Random (randomRIO)
 import Testlib.Prelude
 
 testCreateGetApp :: (HasCallStack) => Domain -> App ()
@@ -561,3 +562,34 @@ testAppReceivesMemberJoinNotification = do
     memberJoinApp <- awaitMatch isTeamMemberJoinNotif wsApp
     memberJoinApp %. "payload.0.team" `shouldMatch` tid
     memberJoinApp %. "payload.0.data.user" `shouldMatch` objId newMember
+
+testTeamSizeWithApps :: (HasCallStack) => TaggedBool "test internal api" -> App ()
+testTeamSizeWithApps (TaggedBool testInternalApi) = do
+  domain <- make OwnDomain
+  numRegulars <- liftIO $ randomRIO (1 :: Int, 3)
+  numApps <- liftIO $ randomRIO (1 :: Int, 3)
+
+  (owner, tid, extraMembers) <- createTeam domain (numRegulars + 1)
+
+  apps <- replicateM numApps $ bindResponse (createApp owner tid def) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "user"
+
+  let checkSize :: (HasCallStack) => Int -> Int -> App ()
+      checkSize wantRegulars wantApps =
+        (if testInternalApi then BrigI.getTeamSize else Brig.getTeamSize) owner tid `bindResponse` \resp -> do
+          resp.status `shouldMatchInt` 200
+          resp.json %. "teamSize" `shouldMatchInt` (1 + wantRegulars + wantApps)
+          resp.json %. "teamSizeRegulars" `shouldMatchInt` (1 + wantRegulars)
+          resp.json %. "teamSizeApps" `shouldMatchInt` wantApps
+
+  BrigI.refreshIndex domain
+  eventually $ do
+    checkSize numRegulars numApps
+
+  deleteTeamMember tid owner (head apps) >>= assertSuccess
+  deleteTeamMember tid owner (head extraMembers) >>= assertSuccess
+
+  BrigI.refreshIndex domain
+  eventually $ do
+    checkSize (numRegulars - 1) (numApps - 1)

libs/types-common-journal/proto/TeamEvents.proto

@@ -13,6 +13,19 @@ message TeamEvent {
         required int32  member_count = 1;
         repeated bytes  billing_user = 2;
         optional string currency     = 3; // ISO_4217
+
+        // the following fields are at the end of the declaration
+        // for backwards compatibility.
+        //
+        // this declaration is used to generate producer code, so it
+        // is ok and desirable to make this fields mandatory (they
+        // are guaranteed to be present).
+        //
+        // for backwards compatibility, clients should make these
+        // fields optional, and fall back to using `member_count` if
+        // they are missing.
+        required int32  member_count_regular = 4;
+        required int32  member_count_app = 5;
     }
 
     enum EventType {

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

@@ -16,30 +16,67 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
 module Wire.API.Team.Size
-  ( TeamSize (TeamSize),
+  ( TeamSize (..),
+    teamSizeTotal,
+    updateTeamSize,
   )
 where
 
 import Control.Lens ((?~))
 import Data.Aeson qualified as A
+import Data.Aeson.Types qualified as A
 import Data.OpenApi qualified as S
 import Data.Schema
 import Imports
 import Numeric.Natural
 import Test.QuickCheck (arbitrarySizedNatural)
+import Wire.API.User.Search
 import Wire.Arbitrary
 
-newtype TeamSize = TeamSize Natural
+data TeamSize = TeamSize
+  { regulars :: Natural,
+    apps :: Natural
+  }
   deriving (Show, Eq)
   deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema TeamSize)
 
+-- | Total team members (regulars + apps).
+teamSizeTotal :: TeamSize -> Natural
+teamSizeTotal ts = ts.regulars + ts.apps
+
+-- Increase or decrease a team size component, depending on user type.
+
+-- If the result of a decrease is <0, it is set to 1 (regulars) or 0
+-- (apps).  This handles corner cases where ES reports lower numbers
+-- from the past.
+updateTeamSize :: UserTypeFilter -> TeamSize -> Int -> TeamSize
+updateTeamSize = go
+  where
+    go :: UserTypeFilter -> TeamSize -> Int -> TeamSize
+    go UserTypeFilterRegular (TeamSize rs as) n = TeamSize (upd 1 rs n) as
+    go UserTypeFilterApp (TeamSize rs as) n = TeamSize rs (upd 0 as n)
+
+    upd :: Int -> Natural -> Int -> Natural
+    upd low n i = fromIntegral . max low $ fromIntegral n + i
+
 instance ToSchema TeamSize where
   schema =
-    objectWithDocModifier (description ?~ "A simple object with a total number of team members.") $
-      TeamSize <$> (unTeamSize .= fieldWithDocModifier "teamSize" (description ?~ "Team size.") schema)
+    objectWithDocModifier (description ?~ "Team member counts broken down by user type.") $
+      fromTeamSize .= tripleSchema `withParser` validate
     where
-      unTeamSize :: TeamSize -> Natural
-      unTeamSize (TeamSize n) = n
+      fromTeamSize :: TeamSize -> (Natural, Natural, Maybe Natural)
+      fromTeamSize ts = (ts.regulars, ts.apps, Just (teamSizeTotal ts))
+      tripleSchema :: ObjectSchema SwaggerDoc (Natural, Natural, Maybe Natural)
+      tripleSchema =
+        (,,)
+          <$> (\(r, _, _) -> r) .= fieldWithDocModifier "teamSizeRegulars" (description ?~ "Number of regular users in team.") schema
+          <*> (\(_, a, _) -> a) .= fieldWithDocModifier "teamSizeApps" (description ?~ "Number of apps in team.") schema
+          <*> (\(_, _, t) -> t) .= maybe_ (optFieldWithDocModifier "teamSize" (description ?~ "Total team members (teamSizeRegulars + teamSizeApps).") schema)
+      validate :: (Natural, Natural, Maybe Natural) -> A.Parser TeamSize
+      validate (r, a, Nothing) = pure TeamSize {regulars = r, apps = a}
+      validate (r, a, Just t)
+        | r + a == t = pure TeamSize {regulars = r, apps = a}
+        | otherwise = fail $ "teamSize (" <> show t <> ") != regulars + apps (" <> show (r + a) <> ")"
 
 instance Arbitrary TeamSize where
-  arbitrary = TeamSize <$> arbitrarySizedNatural
+  arbitrary = TeamSize <$> arbitrarySizedNatural <*> arbitrarySizedNatural

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

@@ -317,6 +317,9 @@ instance FromByteString RoleFilter where
     parts <- C8.split ',' <$> parser
     RoleFilter <$> traverse (maybe (fail "Invalid role") pure . fromByteString) parts
 
+-- In some places, we don't have bots as an option, so we don't want
+-- to use 'UserType'.  Once bots are removed from the picture,
+-- 'UserType' and 'UserTypeFilter' will be the same ething.
 data UserTypeFilter = UserTypeFilterRegular | UserTypeFilterApp
   deriving (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UserTypeFilter)

libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/TeamSize.hs

@@ -21,10 +21,10 @@ import Imports
 import Wire.API.Team.Size
 
 testObject_TeamSize_1 :: TeamSize
-testObject_TeamSize_1 = TeamSize 0
+testObject_TeamSize_1 = TeamSize 0 0
 
 testObject_TeamSize_2 :: TeamSize
-testObject_TeamSize_2 = TeamSize 100
+testObject_TeamSize_2 = TeamSize 100 400
 
 testObject_TeamSize_3 :: TeamSize
-testObject_TeamSize_3 = TeamSize (fromIntegral $ maxBound @Word64)
+testObject_TeamSize_3 = TeamSize (fromIntegral $ maxBound @Word64) (fromIntegral $ maxBound @Word64)

libs/wire-api/test/golden/testObject_TeamSize_1.json

@@ -1,3 +1,5 @@
 {
-    "teamSize": 0
+    "teamSize": 0,
+    "teamSizeApps": 0,
+    "teamSizeRegulars": 0
 }

libs/wire-api/test/golden/testObject_TeamSize_2.json

@@ -1,3 +1,5 @@
 {
-    "teamSize": 100
+    "teamSize": 500,
+    "teamSizeApps": 400,
+    "teamSizeRegulars": 100
 }

libs/wire-api/test/golden/testObject_TeamSize_3.json

@@ -1,3 +1,5 @@
 {
-    "teamSize": 1.8446744073709551615e19
+    "teamSize": 3.689348814741910323e19,
+    "teamSizeApps": 1.8446744073709551615e19,
+    "teamSizeRegulars": 1.8446744073709551615e19
 }

libs/wire-subsystems/src/Wire/IndexedUserStore/ElasticSearch.hs

@@ -23,18 +23,21 @@ import Control.Error (lastMay)
 import Control.Exception (throwIO)
 import Data.Aeson
 import Data.Aeson.Key qualified as Key
+import Data.Aeson.Types (parseMaybe)
 import Data.ByteString qualified as LBS
 import Data.ByteString.Builder
 import Data.ByteString.Conversion
 import Data.Id
 import Data.List.NonEmpty (NonEmpty (..))
+import Data.Map.Strict qualified as M
 import Data.Text qualified as Text
 import Data.Text.Ascii
 import Data.Text.Encoding qualified as Text
 import Database.Bloodhound qualified as ES
 import Imports
 import Network.HTTP.Client
 import Network.HTTP.Types
+import Numeric.Natural (Natural)
 import Polysemy
 import Wire.API.Team.Role (roleName)
 import Wire.API.Team.Size (TeamSize (TeamSize))
@@ -81,18 +84,49 @@ getTeamSizeImpl ::
   TeamId ->
   Sem r TeamSize
 getTeamSizeImpl cfg tid = do
-  let indexName = cfg.conn.indexName
-  countResEither <- embed $ ES.runBH cfg.conn.env $ ES.countByIndex indexName (ES.CountQuery query)
-  countRes <- either (liftIO . throwIO . IndexLookupError) pure countResEither
-  pure . TeamSize $ ES.crCount countRes
+  r <- embed $ ES.runBH cfg.conn.env $ do
+    res <- ES.searchByType cfg.conn.indexName mappingName search
+    liftIO $ ES.parseEsResponse res
+  result <- either (embed . throwIO . IndexLookupError) pure (r :: Either ES.EsError (ES.SearchResult UserDoc))
+  let aggs = fromMaybe mempty (ES.aggregations result)
+      getCount name = maybe 0 (.filterDocCount) $ M.lookup name aggs >>= parseMaybe (parseJSON @FilterResult)
+  pure $ TeamSize (getCount "regulars") (getCount "apps")
   where
-    query =
-      ES.TermQuery
-        ES.Term
-          { ES.termField = "team",
-            ES.termValue = idToText tid
+    teamQ = termQ "team" (idToText tid)
+
+    -- Regular users: type = "regular" or type field absent (legacy documents)
+    regularQuery =
+      ES.QueryBoolQuery
+        boolQuery
+          { ES.boolQueryMustMatch =
+              [ teamQ,
+                ES.QueryBoolQuery
+                  boolQuery
+                    { ES.boolQueryShouldMatch =
+                        [ termQ "type" "regular",
+                          ES.QueryBoolQuery
+                            boolQuery
+                              { ES.boolQueryMustNotMatch = [ES.QueryExistsQuery (ES.FieldName "type")]
+                              }
+                        ]
+                    }
+              ]
           }
-        Nothing
+
+    appQuery =
+      ES.QueryBoolQuery
+        boolQuery
+          { ES.boolQueryMustMatch = [teamQ, termQ "type" "app"]
+          }
+
+    search =
+      (ES.mkSearch Nothing Nothing)
+        { ES.size = ES.Size 0,
+          ES.aggBody =
+            Just $
+              ES.mkAggregations "regulars" (ES.FilterAgg (ES.FilterAggregation (ES.Filter regularQuery) Nothing))
+                <> ES.mkAggregations "apps" (ES.FilterAgg (ES.FilterAggregation (ES.Filter appQuery) Nothing))
+        }
 
 upsertImpl ::
   forall r.
@@ -647,3 +681,9 @@ mappingName = ES.MappingName "user"
 
 boolQuery :: ES.BoolQuery
 boolQuery = ES.mkBoolQuery [] [] [] []
+
+-- | (or can something like this be found in bloodhound?)
+newtype FilterResult = FilterResult {filterDocCount :: Natural}
+
+instance FromJSON FilterResult where
+  parseJSON = withObject "FilterResult" $ \o -> FilterResult <$> o .: "doc_count"

libs/wire-subsystems/src/Wire/TeamJournal.hs

@@ -27,11 +27,11 @@ import Data.ProtoLens (defMessage)
 import Data.Text (pack)
 import Data.Time.Clock.POSIX
 import Imports hiding (head)
-import Numeric.Natural
 import Polysemy
 import Proto.TeamEvents (TeamEvent, TeamEvent'EventData, TeamEvent'EventType (..))
 import Proto.TeamEvents_Fields qualified as T
 import Wire.API.Team (TeamCreationTime (..))
+import Wire.API.Team.Size
 import Wire.Sem.Now
 import Wire.Sem.Now qualified as Now
 import Wire.TeamStore
@@ -52,7 +52,7 @@ teamActivate ::
     Member TeamJournal r
   ) =>
   TeamId ->
-  Natural ->
+  TeamSize ->
   Maybe Currency.Alpha ->
   Maybe TeamCreationTime ->
   Sem r ()
@@ -65,7 +65,7 @@ teamUpdate ::
     Member TeamJournal r
   ) =>
   TeamId ->
-  Natural ->
+  TeamSize ->
   [UserId] ->
   Sem r ()
 teamUpdate tid teamSize billingUserIds =
@@ -111,9 +111,15 @@ journalEvent typ tid dat tim = do
 ----------------------------------------------------------------------------
 -- utils
 
-evData :: Natural -> [UserId] -> Maybe Currency.Alpha -> TeamEvent'EventData
-evData memberCount billingUserIds cur =
+evData :: TeamSize -> [UserId] -> Maybe Currency.Alpha -> TeamEvent'EventData
+evData teamSize@(TeamSize regulars apps) billingUserIds cur =
   defMessage
-    & T.memberCount .~ fromIntegral memberCount
+    & T.memberCount .~ memberCountTotal
     & T.billingUser .~ (toBytes <$> billingUserIds)
     & T.maybe'currency .~ (pack . show <$> cur)
+    & T.memberCountRegular .~ memberCountRegulars
+    & T.memberCountApp .~ memberCountApps
+  where
+    memberCountTotal, memberCountRegulars, memberCountApps :: Int32
+    (memberCountTotal, memberCountRegulars, memberCountApps) =
+      (fromIntegral $ teamSizeTotal teamSize, fromIntegral regulars, fromIntegral apps)

libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs

@@ -66,7 +66,7 @@ import Wire.API.Team.Member.Info (TeamMemberInfo (..), TeamMemberInfoList (membe
 import Wire.API.Team.Permission qualified as Permission
 import Wire.API.Team.Role (Role, defaultRole, permissionsToRole)
 import Wire.API.Team.SearchVisibility
-import Wire.API.Team.Size (TeamSize (TeamSize))
+import Wire.API.Team.Size
 import Wire.API.User as User
 import Wire.API.User.RichInfo
 import Wire.API.User.Search
@@ -251,7 +251,7 @@ internalFindTeamInvitationImpl (Just e) c =
         NotAllowed -> throwGuardFailed TeamInviteSetToNotAllowed
 
       maxSize <- maxTeamSize <$> input
-      (TeamSize teamSize) <- IndexedUserStore.getTeamSize tid
+      teamSize <- teamSizeTotal <$> IndexedUserStore.getTeamSize tid
       when (teamSize >= fromIntegral maxSize) $
         throw UserSubsystemTooManyTeamMembers
       -- FUTUREWORK: The above can easily be done/tested in the intra call.