WPB-20054 SCIM get group

changelog.d/2-features/get-scim-groups

@@ -0,0 +1 @@
+Get scim groups by id with scim.

integration/test/API/Spar.hs

@@ -97,6 +97,11 @@ createScimUserGroup domain token scimUserGroup = do
   body <- make scimUserGroup
   submit "POST" $ req & addJSON body . addHeader "Authorization" ("Bearer " <> token)
 
+getScimUserGroup :: (HasCallStack, MakesValue domain) => domain -> String -> String -> App Response
+getScimUserGroup domain token gid = do
+  req <- baseRequest domain Spar Versioned $ joinHttpPath ["/scim/v2/Groups", gid]
+  submit "GET" $ req & addHeader "Authorization" ("Bearer " <> token)
+
 -- | https://staging-nginz-https.zinfra.io/v12/api/swagger-ui/#/default/idp-create
 createIdp :: (HasCallStack, MakesValue user) => user -> SAML.IdPMetadata -> App Response
 createIdp user metadata = do

integration/test/Test/Spar.hs

@@ -365,8 +365,8 @@ testSparCreateScimTokenWithName = do
 ----------------------------------------------------------------------
 -- scim group stuff
 
-testSparScimCreateUserGroup :: (HasCallStack) => App ()
-testSparScimCreateUserGroup = do
+testSparScimCreateGetUserGroup :: (HasCallStack) => App ()
+testSparScimCreateGetUserGroup = do
   (owner, tid, _) <- createTeam OwnDomain 1
   tok <- createScimTokenV6 owner def >>= \resp -> resp.json %. "token" >>= asString
 
@@ -418,7 +418,12 @@ testSparScimCreateUserGroup = do
                      ]
                  ]
           ]
-  createScimUserGroup OwnDomain tok scimUserGroup >>= assertSuccess
+  resp <- createScimUserGroup OwnDomain tok scimUserGroup
+  assertSuccess resp
+
+  gid <- resp.json %. "id" & asString
+  resp2 <- getScimUserGroup OwnDomain tok gid
+  resp.json `shouldMatch` resp2.json
 
 ----------------------------------------------------------------------
 -- saml stuff

integration/test/Testlib/ModService.hs

@@ -549,9 +549,7 @@ retryRequestUntilDebug mProcessDebug reqAction err = do
         mPh <- liftIO $ readIORef phRef
         let stdOutStr = List.intercalate "\n" stdOut'
             stdErrStr = List.intercalate "\n" stdErr'
-        mExitCode <- liftIO $ case mPh of
-          Nothing -> pure Nothing
-          Just ph -> Just <$> getProcessExitCode ph
+        mExitCode <- maybe (pure Nothing) (liftIO . getProcessExitCode) mPh
         let msg =
               "Timed out waiting for service "
                 <> err

libs/hscim/default.nix

@@ -125,7 +125,7 @@ mkDerivation {
     wai-extra
   ];
   testToolDepends = [ hspec-discover ];
-  homepage = "https://github.com/wireapp/wire-server/libs/hscim/README.md";
+  homepage = "https://github.com/wireapp/wire-server/blob/develop/libs/hscim/README.md";
   description = "hscim json schema and server implementation";
   license = lib.licenses.agpl3Only;
   mainProgram = "hscim-server";

libs/hscim/hscim.cabal

@@ -6,7 +6,9 @@ description:
   The README file will answer all the questions you might have
 
 category:           Web
-homepage:           https://github.com/wireapp/wire-server/libs/hscim/README.md
+homepage:
+  https://github.com/wireapp/wire-server/blob/develop/libs/hscim/README.md
+
 bug-reports:        https://github.com/wireapp/wire-server/issues
 author:             Wire Swiss GmbH
 maintainer:         Wire Swiss GmbH <backend@wire.com>
@@ -21,7 +23,7 @@ extra-source-files:
 source-repository head
   type:     git
   location: https://github.com/wireapp/wire-server
-  subdir:   hscim
+  subdir:   libs/hscim
 
 library
   exposed-modules:

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

@@ -243,6 +243,17 @@ type CreateGroupFullInternal =
         :> Post '[Servant.JSON] UserGroup
     )
 
+type GetGroupInternal =
+  Named
+    "i-get-group"
+    ( Summary "Create user group with full control (internal)"
+        :> "user-groups"
+        :> Capture "tid" TeamId
+        :> Capture "gid" UserGroupId
+        :> Capture "includeChannels" Bool
+        :> Get '[Servant.JSON] (Maybe UserGroup)
+    )
+
 type AccountAPI =
   Named "get-account-conference-calling-config" GetAccountConferenceCallingConfig
     :<|> Named "i-put-account-conference-calling-config" PutAccountConferenceCallingConfig
@@ -551,6 +562,7 @@ type AccountAPI =
            )
     :<|> GetAccountsByInternal
     :<|> CreateGroupFullInternal
+    :<|> GetGroupInternal
 
 -- | The missing ref is implicit by the capture
 data NewKeyPackageRef = NewKeyPackageRef

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

@@ -318,7 +318,7 @@ type UserGroupAPI =
     )
     :<|> Named
            "get-user-group"
-           ( Summary "Fetch a group accessible from the logged-in user"
+           ( Summary "Fetch a group accessible to the logged-in user"
                :> From 'V10
                :> ZLocalUser
                :> CanThrow 'UserGroupNotFound
@@ -335,7 +335,7 @@ type UserGroupAPI =
            )
     :<|> Named
            "get-user-groups"
-           ( Summary "Fetch groups accessible from the logged-in user"
+           ( Summary "Fetch groups accessible to the logged-in user"
                :> From 'V10
                :> ZLocalUser
                :> "user-groups"

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

@@ -47,6 +47,7 @@ module Wire.BrigAPIAccess
 
     -- * User Groups
     createGroupFull,
+    getGroupUnsafe,
   )
 where
 
@@ -132,6 +133,7 @@ data BrigAPIAccess m a where
   UpdateSearchIndex :: UserId -> BrigAPIAccess m ()
   GetAccountsBy :: GetBy -> BrigAPIAccess m [User]
   CreateGroupFull :: ManagedBy -> TeamId -> Maybe UserId -> NewUserGroup -> BrigAPIAccess m UserGroup
+  GetGroupUnsafe :: TeamId -> UserGroupId -> Bool -> BrigAPIAccess m (Maybe UserGroup)
 
 makeSem ''BrigAPIAccess
 

libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs

@@ -105,6 +105,8 @@ interpretBrigAccess brigEndpoint =
         getAccountsBy localGetBy
       CreateGroupFull managedBy teamId creatorUserId newGroup ->
         createGroupFull managedBy teamId creatorUserId newGroup
+      GetGroupUnsafe tid gid includeChannels ->
+        getGroupUnsafe tid gid includeChannels
 
 brigRequest :: (Member Rpc r, Member (Input Endpoint) r) => (Request -> Request) -> Sem r (Response (Maybe LByteString))
 brigRequest req = do
@@ -554,3 +556,17 @@ createGroupFull managedBy teamId creatorUserId newGroup = do
         . json req
         . expect2xx
   decodeBodyOrThrow "brig" r
+
+getGroupUnsafe ::
+  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
+  TeamId ->
+  UserGroupId ->
+  Bool ->
+  Sem r (Maybe UserGroup)
+getGroupUnsafe tid gid includeChannels = do
+  r <-
+    brigRequest $
+      method GET
+        . paths ["i", "user-groups", toByteString' tid, toByteString' gid, toByteString' includeChannels]
+        . expect2xx
+  decodeBodyOrThrow "brig" r

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

@@ -9,5 +9,6 @@ import Wire.API.User.Scim (SparTag)
 
 data ScimSubsystem m a where
   ScimCreateUserGroup :: TeamId -> SCG.Group -> ScimSubsystem m (SCG.StoredGroup SparTag)
+  ScimGetUserGroup :: TeamId -> UserGroupId -> ScimSubsystem m (SCG.StoredGroup SparTag)
 
 makeSem ''ScimSubsystem

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

@@ -4,6 +4,7 @@ import Data.Default
 import Data.Id
 import Data.Json.Util
 import Data.Text qualified as Text
+import Data.UUID qualified as UUID
 import Data.Vector qualified as V
 import Imports
 import Network.URI (parseURI)
@@ -35,6 +36,7 @@ interpretScimSubsystem ::
   InterpreterFor ScimSubsystem r
 interpretScimSubsystem = interpret $ \case
   ScimCreateUserGroup teamId scimGroup -> createScimGroupImpl teamId scimGroup
+  ScimGetUserGroup tid gid -> scimGetUserGroupImpl tid gid
 
 data ScimSubsystemError
   = ScimSubsystemError ScimError
@@ -83,6 +85,24 @@ createScimGroupImpl teamId grp = do
   ScimSubsystemConfig scimBaseUri <- input
   pure $ toStoredGroup scimBaseUri ug
 
+scimGetUserGroupImpl ::
+  forall r.
+  ( Member (Input ScimSubsystemConfig) r,
+    Member (Error ScimSubsystemError) r,
+    Member BrigAPIAccess r
+  ) =>
+  TeamId ->
+  UserGroupId ->
+  Sem r (SCG.StoredGroup SparTag)
+scimGetUserGroupImpl tid gid = do
+  let includeChannels = False -- SCIM has no notion of channels.
+  maybe groupNotFound returnStoredGroup =<< BrigAPI.getGroupUnsafe tid gid includeChannels
+  where
+    groupNotFound = scimThrow $ notFound "Group" $ UUID.toText $ toUUID gid
+    returnStoredGroup g = do
+      ScimSubsystemConfig scimBaseUri <- input
+      pure $ toStoredGroup scimBaseUri g
+
 toStoredGroup :: Common.URI -> UserGroup -> SCG.StoredGroup SparTag
 toStoredGroup scimBaseUri ug = Meta.WithMeta meta (Common.WithId ug.id_ sg)
   where

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

@@ -44,6 +44,7 @@ data UserGroupSubsystem m a where
   CreateGroup :: UserId -> NewUserGroup -> UserGroupSubsystem m UserGroup
   CreateGroupFull :: ManagedBy -> TeamId -> Maybe UserId -> NewUserGroup -> UserGroupSubsystem r UserGroup
   GetGroup :: UserId -> UserGroupId -> Bool -> UserGroupSubsystem m (Maybe UserGroup)
+  GetGroupUnsafe :: TeamId -> UserGroupId -> Bool -> UserGroupSubsystem m (Maybe UserGroup)
   GetGroups :: UserId -> GroupSearch -> UserGroupSubsystem m UserGroupPage
   UpdateGroup :: UserId -> UserGroupId -> UserGroupUpdate -> UserGroupSubsystem m ()
   DeleteGroup :: UserId -> UserGroupId -> UserGroupSubsystem m ()

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

@@ -47,6 +47,7 @@ interpretUserGroupSubsystem = interpret $ \case
   CreateGroup creator newGroup -> createUserGroup creator newGroup
   CreateGroupFull managedBy team mbCreator newGroup -> createUserGroupFullImpl managedBy team mbCreator newGroup
   GetGroup getter gid includeChannels -> getUserGroup getter gid includeChannels
+  GetGroupUnsafe tid gid includeChannels -> getUserGroupUnsafe tid gid includeChannels
   GetGroups getter search -> getUserGroups getter search
   UpdateGroup updater groupId groupUpdate -> updateGroup updater groupId groupUpdate
   DeleteGroup deleter groupId -> deleteGroup deleter groupId
@@ -180,11 +181,20 @@ getUserGroup ::
 getUserGroup getter gid includeChannels = runMaybeT $ do
   team <- MaybeT $ getUserTeam getter
   getterCanSeeAll <- mkGetterCanSeeAll getter team
-  userGroup <- MaybeT $ Store.getUserGroup team gid includeChannels
+  userGroup <- MaybeT $ getUserGroupUnsafe team gid includeChannels
   if getterCanSeeAll || getter `elem` (toList (runIdentity userGroup.members))
     then pure userGroup
     else MaybeT $ pure Nothing
 
+getUserGroupUnsafe ::
+  (Member Store.UserGroupStore r) =>
+  TeamId ->
+  UserGroupId ->
+  Bool ->
+  Sem r (Maybe UserGroup)
+getUserGroupUnsafe tid gid includeChannels = runMaybeT $ do
+  MaybeT $ Store.getUserGroup tid gid includeChannels
+
 mkGetterCanSeeAll ::
   forall r.
   (Member TeamSubsystem r) =>

libs/wire-subsystems/test/unit/Wire/ScimSubsystem/InterpreterSpec.hs

@@ -4,6 +4,7 @@
 module Wire.ScimSubsystem.InterpreterSpec (spec) where
 
 import Data.Id
+import Data.Json.Util
 import Data.Text qualified as Text
 import Imports
 import Network.URI
@@ -15,6 +16,7 @@ import Test.Hspec
 import Test.Hspec.QuickCheck
 import Test.QuickCheck
 import Web.Scim.Class.Group qualified as Group
+import Web.Scim.Class.Group qualified as SCG
 import Web.Scim.Schema.Common qualified as Common
 import Web.Scim.Schema.Meta qualified as Common
 import Wire.API.Routes.Internal.Brig (GetBy (..))
@@ -68,6 +70,8 @@ runDependencies initialUsers initialTeams =
         UGS.createGroupFull managedBy teamId creatorUserId newGroup
       GetAccountsBy getBy -> do
         pure $ filter (\u -> User.userId u `elem` getBy.getByUserId) users
+      GetGroupUnsafe tid gid False -> do
+        UGS.getGroupUnsafe tid gid False
       _ -> error "Unimplemented BrigAPIAccess operation in mock"
 
 instance Arbitrary Group.Group where
@@ -88,7 +92,7 @@ mkScimGroupMember (idToText . User.userId -> value) =
 
 spec :: Spec
 spec = UGS.timeoutHook $ describe "ScimSubsystem.Interpreter" $ do
-  describe "scimCreateUserGroup" $ do
+  describe "scimCreateUserGroup, scimGetUserGroup" $ do
     prop "creates a group returns it" $ \(team :: UGS.ArbitraryTeam) (newScimGroup_ :: Group.Group) ->
       let newScimGroup =
             newScimGroup_
@@ -99,12 +103,29 @@ spec = UGS.timeoutHook $ describe "ScimSubsystem.Interpreter" $ do
           resultOrError = do
             runDependencies (UGS.allUsers team) (UGS.galleyTeam team) $ do
               createdGroup :: Group.StoredGroup SparTag <- scimCreateUserGroup team.tid newScimGroup
-              retrievedGroup :: Maybe UserGroup <- UGS.getGroup (UGS.ownerId team) createdGroup.thing.id False
-              pure (createdGroup, retrievedGroup)
+              retrievedGroupScimAPI :: SCG.StoredGroup SparTag <- scimGetUserGroup team.tid createdGroup.thing.id
+              retrievedGroupPublicAPI :: Maybe UserGroup <- UGS.getGroup (UGS.ownerId team) createdGroup.thing.id False
+              pure (createdGroup, retrievedGroupScimAPI, retrievedGroupPublicAPI)
        in case resultOrError of
             Left err -> counterexample ("Left: " ++ show err) False
-            Right (createdGroup, retrievedGroup) ->
-              Just createdGroup.thing.id === ((.id_) <$> retrievedGroup)
+            Right (createdGroup, retrievedGroupScimAPI, retrievedGroupPublicAPI) ->
+              createdGroup === retrievedGroupScimAPI
+                .&&. case retrievedGroupPublicAPI of
+                  Nothing -> counterexample "*** group not found over public api" False
+                  Just grp ->
+                    createdGroup.thing.id === grp.id_
+                      .&&. createdGroup.thing.value.displayName === userGroupNameToText grp.name
+                      .&&. Nothing === grp.channels
+                      .&&. Nothing === grp.membersCount
+                      .&&. Nothing === grp.channelsCount
+                      .&&. ManagedByScim === grp.managedBy
+                      .&&. toUTCTimeMillis createdGroup.meta.created === grp.createdAt
+                      .&&. ( nub ((.typ) <$> createdGroup.thing.value.members)
+                               === ["User" | not $ null createdGroup.thing.value.members]
+                           )
+                      .&&. ( sort ((.value) <$> createdGroup.thing.value.members)
+                               === sort (toList $ idToText <$> runIdentity grp.members)
+                           )
 
     prop "does not allow non-scim members" $ \team newScimGroup_ -> do
       let newScimGroup = newScimGroup_ {Group.members = mkScimGroupMember <$> groupMembers}
@@ -119,7 +140,3 @@ spec = UGS.timeoutHook $ describe "ScimSubsystem.Interpreter" $ do
               else isLeft
       unless (want have) do
         expectationFailure . show $ ((.userManagedBy) <$> UGS.allUsers team)
-
-  describe "getScimGroup" $ do
-    it "retrieves metadata intact" $ do
-      pendingWith "we actually haven't implemented metadata storage in store, because it was weird to test it without get."