...

services/spar/src/Spar/Scim/User.hs

@@ -51,7 +51,6 @@ import Crypto.Hash
 import Data.Aeson as Aeson
 import Data.Handle (Handle (Handle), parseHandle)
 import Data.Id
-import Data.Misc ((<$$>))
 import Data.Range
 import Data.String.Conversions
 import qualified Data.Text as Text
@@ -105,8 +104,9 @@ instance Scim.UserDB SparTag Spar where
     -- soon anyway. Please scream loudly in the review if you disagree with this,
     -- but it would complicate this code a bit, instead of leaving it as is.
     members <- lift $ Galley.getTeamMembers stiTeam
-    scimusers :: [Scim.StoredUser SparTag] <- synthesizeScimStoredUser <$$> do
-      lift (Brig.getBrigUsers ((^. Galley.userId) <$> members))
+    scimusers :: [Scim.StoredUser SparTag] <- do
+      users <- lift (Brig.getBrigUsers ((^. Galley.userId) <$> members))
+      synthesizeScimStoredUser `mapM` users
     pure $ Scim.fromList scimusers
   getUsers ScimTokenInfo {stiTeam, stiIdP} (Just filter') = do
     idp <- stiIdP ?? Scim.serverError "No IdP configured for the provisioning token"
@@ -137,7 +137,7 @@ instance Scim.UserDB SparTag Spar where
       brigUser <- getBrigUser' uid
       team' <- getUserTeam' brigUser
       guard $ stiTeam == team'
-      pure $ synthesizeScimStoredUser brigUser
+      lift $ synthesizeScimStoredUser brigUser
     maybe (throwError . Scim.notFound "User" $ idToText uid) pure user
     where
       -- pretty wrappers; should use some MTL instances to get rid of lifts
@@ -600,8 +600,45 @@ assertHandleNotUsedElsewhere hndl uid = do
   unless ((userHandle =<< musr) == Just hndl) $
     assertHandleUnused' "userName does not match UserId" hndl uid
 
-synthesizeScimStoredUser :: User -> Scim.StoredUser SparTag
-synthesizeScimStoredUser = undefined
+-- TODO: 'User' need to have `created_at`, `last_updated_at` fields of type `Maybe UTCTime`, then we can implement this.
+synthesizeScimStoredUser :: User -> Scim.ScimHandler Spar (Scim.StoredUser SparTag)
+synthesizeScimStoredUser _usr = do
+  _baseuri <- asks $ derivedOptsScimBaseURI . derivedOpts . sparCtxOpts
+  richInfo <- lift . lift . Brig.getBrigUserRichInfo _usr
+  idps :: [IdP] <- lift . lift . wrapMonadClient $ Data.getIdPConfigsByTeam stiTeam
+  accStatus <- _
+
+  -- ...  somehow call 'toScimStoredUser', 'updScimStoredUser'', 'synthesizeBrigScimUser', probably.
+  undefined
+
+synthesizeBrigScimUser :: User -> AccountStatus -> _ -> [IdP] -> Scim.User SparTag
+synthesizeBrigScimUser usr accStatus richInfo idps = do
+  let uid = BrigTypes.userId brigUser'
+      handle = BrigTypes.userHandle brigUser'
+      name = BrigTypes.userDisplayName brigUser'
+      isActive = scimActiveFlagFromAccountStatus accStatus
+
+  samlIdentity <- synthesizeSAMLIdentity usr idps
+  pure . synthesizeScimUser $ ValidScimUser samlIdentity handle (Just name) richInfo (Just isActive)
+
+synthesizeSAMLIdentity :: User -> [IdP] -> MonadError _ m => m SAMLIdentity
+synthesizeSAMLIdentity usr idps = do
+  ssoIdentity' <- do
+    -- TODO: If user is not an SSO User; @ssoIdentity'@ is Nothing
+    -- Hence; we should only set managedByScim if this _succeeds_
+    -- and only lookup idp conditionally.
+    maybe (throwError $ Scim.serverError "User has no SSO identity") pure (userIdentity >=> ssoIdentity $ usr)
+  samlIdentity <- do
+    idp :: IdP <- case idps of
+      [i] -> pure i
+      [] ->
+        throwError . Scim.serverError $
+          "No IdP configured for the provisioning token"
+      l@(_ : _ : _) ->
+        throwError . Scim.serverError . cs $
+          "SCIM is only supported for teams with exactly one IdP, you have " <> show (length l)
+    toSAMLIdentity' idp ssoIdentity'
+  undefined
 
 synthesizeScimUser :: ValidScimUser -> Scim.User SparTag
 synthesizeScimUser info =