Implement active flag in SCIM (#1158)

* Add active flag to SCIM user * Implement tests and calls to brig Involved exposing some types in brig that were internal before. * Remove misguided TODO. https://github.com/wireapp/wire-server/blob/b9a84f9b654a69c9a296761b36c042dc993236d3/services/brig/src/Brig/Team/API.hs#L306 * Promote NOTE to TODO; make it clear which line it belongs to. * Scim onboarding: handle all AccountStatus values reasonably. * Clarifying comment. * Fix test case docs. * Better mapping: scim active flag <-> AccountStatus. both more correct (does not fail on valid requests) and more readable, maintainable. * Cleanup. * Fix account status mapping for bogus ephemeral case. Co-authored-by: Matthias Fischmann <[email protected]>
wireapp · Jul 9, 2020 · 26f339b · 26f339b
1 parent d12b48b
commit 26f339b
Show file tree

Hide file tree

Showing 6 changed files with 219 additions and 39 deletions.
diff --git a/libs/brig-types/src/Brig/Types/Intra.hs b/libs/brig-types/src/Brig/Types/Intra.hs
@@ -23,6 +23,7 @@
 module Brig.Types.Intra
   ( AccountStatus (..),
     AccountStatusUpdate (..),
+    AccountStatusResp (..),
     ConnectionStatus (..),
     UserAccount (..),
     UserSet (..),
@@ -63,6 +64,15 @@ instance ToJSON AccountStatus where
   toJSON Deleted = String "deleted"
   toJSON Ephemeral = String "ephemeral"
 
+data AccountStatusResp = AccountStatusResp AccountStatus
+
+instance ToJSON AccountStatusResp where
+  toJSON (AccountStatusResp s) = object ["status" .= s]
+
+instance FromJSON AccountStatusResp where
+  parseJSON = withObject "account-status" $ \o ->
+    AccountStatusResp <$> o .: "status"
+
 newtype AccountStatusUpdate = AccountStatusUpdate
   {suStatus :: AccountStatus}
   deriving (Generic)

diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs
@@ -372,11 +372,6 @@ getAccountStatusH (_ ::: usr) = do
     Just s -> json $ AccountStatusResp s
     Nothing -> setStatus status404 empty
 
-data AccountStatusResp = AccountStatusResp AccountStatus
-
-instance ToJSON AccountStatusResp where
-  toJSON (AccountStatusResp s) = object ["status" .= s]
-
 getConnectionsStatusH ::
   JSON ::: JsonRequest ConnectionsStatusRequest ::: Maybe Relation ->
   Handler Response

diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs
@@ -44,6 +44,8 @@ module Spar.Intra.Brig
     parseResponse,
     MonadSparToBrig (..),
     isEmailValidationEnabledUser,
+    getStatus,
+    setStatus,
   )
 where
 
@@ -464,3 +466,24 @@ isEmailValidationEnabledUser uid = do
   case user >>= userTeam of
     Nothing -> pure False
     Just tid -> isEmailValidationEnabledTeam tid
+
+getStatus :: (HasCallStack, MonadSparToBrig m) => UserId -> m AccountStatus
+getStatus uid = do
+  resp <-
+    call $
+      method GET
+        . paths ["/i/users", toByteString' uid, "status"]
+  case statusCode resp of
+    200 -> (\(AccountStatusResp status) -> status) <$> parseResponse @AccountStatusResp resp
+    _ -> throwSpar (SparBrigErrorWith (responseStatus resp) "Could not retrieve account status")
+
+setStatus :: (HasCallStack, MonadSparToBrig m) => UserId -> AccountStatus -> m ()
+setStatus uid status = do
+  resp <-
+    call $
+      method PUT
+        . paths ["/i/users", toByteString' uid, "status"]
+        . json (AccountStatusUpdate status)
+  case statusCode resp of
+    200 -> pure ()
+    _ -> throwSpar (SparBrigErrorWith (responseStatus resp) "Could not set status")
diff --git a/services/spar/src/Spar/Scim/Types.hs b/services/spar/src/Spar/Scim/Types.hs
@@ -40,6 +40,7 @@
 -- * Request and response types for SCIM-related endpoints.
 module Spar.Scim.Types where
 
+import Brig.Types.Intra (AccountStatus (Active, Deleted, Ephemeral, Suspended))
 import Brig.Types.User as Brig
 import Control.Lens hiding ((#), (.=), Strict)
 import Data.Aeson as Aeson
@@ -185,11 +186,23 @@ instance Scim.Patchable ScimUserExtra where
     | otherwise = throwError $ Scim.badRequest Scim.InvalidValue $ Just "unknown schema, cannot patch"
   applyOperation _ _ = throwError $ Scim.badRequest Scim.InvalidValue $ Just "invalid patch op for rich info"
 
--- | SCIM user with 'SAML.UserRef' and mapping to 'Brig.User'.  Constructed by 'validateScimUser'.
+-- | SCIM user with all the data spar is actively processing.  Constructed by
+-- 'validateScimUser'.  The idea is that the type we get back from hscim is too general, and
+-- we need a second round of parsing (aka validation), of which 'ValidScimUser' is the result.
+--
+-- 'NeededInfo' is similar to this, but used for creating scim users rather than as a result
+-- of parsing them.  On second thought, we probably should only have one of the two, or at
+-- least they should look more closely related in the code: the only difference is that one is
+-- for post, the other for patch.
 --
 -- Data contained in '_vsuHandle' and '_vsuName' is guaranteed to a) correspond to the data in
 -- the 'Scim.User.User' and b) be valid in regard to our own user schema requirements (only
 -- certain characters allowed in handles, etc).
+--
+-- FUTUREWORK: eliminate '_vsuUser' and keep everything we need as parsed values rather than
+-- the raw input.
+--
+-- FUTUREWORK: move 'NeededInfo' closer to here.  perhaps we can make do with one of the two.
 data ValidScimUser = ValidScimUser
   { _vsuUser :: Scim.User.User SparTag,
     -- SAML SSO
@@ -201,12 +214,33 @@ data ValidScimUser = ValidScimUser
     -- mapping to 'Brig.User'
     _vsuHandle :: Handle,
     _vsuName :: Maybe Name,
-    _vsuRichInfo :: RichInfo
+    _vsuRichInfo :: RichInfo,
+    _vsuActive :: Maybe Bool
   }
   deriving (Eq, Show)
 
 makeLenses ''ValidScimUser
 
+scimActiveFlagFromAccountStatus :: AccountStatus -> Bool
+scimActiveFlagFromAccountStatus = \case
+  Active -> True
+  Suspended -> False
+  Deleted -> False
+  Ephemeral -> True -- do not treat ephemeral users any different from active ones.
+
+-- | The second argument is constructed from a (potentially missing) json object field, hence
+-- @Nothing@ has the same meaning as @Just True@.  This way, we stay consistent between the
+-- original status and one after an update.
+--
+-- FUTUREWORK: 'Ephemeral' shouldn't really be possible here, since there is no use case for
+-- it.  (If there was, this is most likely how we would have to implement it, but still.)  We
+-- should change the types so that the 'Ephemeral' case can be ruled out by the compiler.
+scimActiveFlagToAccountStatus :: AccountStatus -> Maybe Bool -> AccountStatus
+scimActiveFlagToAccountStatus oldstatus = \case
+  Nothing -> if oldstatus == Ephemeral then Ephemeral else Active
+  Just True -> if oldstatus == Ephemeral then Ephemeral else Active
+  Just False -> Suspended
+
 ----------------------------------------------------------------------------
 -- Request and response types
 

diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs
@@ -58,10 +58,9 @@ import Galley.Types.Teams as Galley
 import Imports
 import Network.URI
 import qualified SAML2.WebSSO as SAML
-import Spar.App (Env, Spar, getUser, sparCtxOpts, validateEmailIfExists, wrapMonadClient, wrapMonadClient)
+import Spar.App (Env, Spar, getUser, sparCtxOpts, validateEmailIfExists, wrapMonadClient)
 import qualified Spar.Data as Data
-import Spar.Intra.Brig as Brig
-import qualified Spar.Intra.Brig as Intra.Brig
+import qualified Spar.Intra.Brig as Brig
 import Spar.Intra.Galley as Galley
 import Spar.Scim.Auth ()
 import Spar.Scim.Types
@@ -105,7 +104,7 @@ instance Scim.UserDB SparTag Spar where
     -- but it would complicate this code a bit, instead of leaving it as is.
     members <- lift $ Galley.getTeamMembers stiTeam
     brigusers :: [User] <-
-      lift (Intra.Brig.getBrigUsers ((^. Galley.userId) <$> members))
+      lift (Brig.getBrigUsers ((^. Galley.userId) <$> members))
     scimusers :: [Scim.StoredUser SparTag] <-
       lift . wrapMonadClient . Data.getScimUsers $ BrigTypes.userId <$> brigusers
     pure $ Scim.fromList scimusers
@@ -118,12 +117,12 @@ instance Scim.UserDB SparTag Spar where
           x <- runMaybeT $ case attrName of
             "username" -> do
               handle <- MaybeT . pure . parseHandle . Text.toLower $ val
-              brigUser <- MaybeT . lift . Intra.Brig.getBrigUserByHandle $ handle
+              brigUser <- MaybeT . lift . Brig.getBrigUserByHandle $ handle
               getOrCreateScimUser stiTeam brigUser
             "externalid" -> do
               uref <- mkUserRef idpConfig (pure val)
               uid <- MaybeT . lift . wrapMonadClient . Data.getSAMLUser $ uref
-              brigUser <- MaybeT . lift . Intra.Brig.getBrigUser $ uid
+              brigUser <- MaybeT . lift . Brig.getBrigUser $ uid
               getOrCreateScimUser stiTeam brigUser
             _ -> throwError (Scim.badRequest Scim.InvalidFilter (Just "Unsupported attribute"))
           pure $ Scim.fromList (toList x)
@@ -138,11 +137,16 @@ instance Scim.UserDB SparTag Spar where
       brigUser <- getBrigUser' uid
       team' <- getUserTeam' brigUser
       guard $ stiTeam == team'
+      -- TODO: this is a consitency bug. If people change things in brig this
+      -- wont be reflected here. Fix:  Get rid of the scim table and just
+      -- always call synthesizeUser on whatever data we get from brig.
+      -- pure $ synthesizeScimUser brigUser
+      -- [see also](https://github.com/zinfra/backend-issues/issues/1006)
       getScimUser' uid
     maybe (throwError . Scim.notFound "User" $ idToText uid) pure user
     where
       -- pretty wrappers; should use some MTL instances to get rid of lifts
-      getBrigUser' = MaybeT . lift . Intra.Brig.getBrigUser
+      getBrigUser' = MaybeT . lift . Brig.getBrigUser
       getUserTeam' = MaybeT . pure . userTeam
       getScimUser' = MaybeT . lift . wrapMonadClient . Data.getScimUser
   postUser ::
@@ -232,7 +236,8 @@ validateScimUser' idp richInfoLimit user = do
   -- be a little less brittle.
   mbName <- mapM validateName (Scim.displayName user)
   richInfo <- validateRichInfo (Scim.extra user ^. sueRichInfo)
-  pure $ ValidScimUser user uref idp handl mbName richInfo
+  let active = Scim.active user
+  pure $ ValidScimUser user uref idp handl mbName richInfo active
   where
     -- Validate a name (@displayName@). It has to conform to standard Wire rules.
     validateName :: Text -> m Name
@@ -313,7 +318,7 @@ createValidScimUser ::
   (m ~ Scim.ScimHandler Spar) =>
   ValidScimUser ->
   m (Scim.StoredUser SparTag)
-createValidScimUser (ValidScimUser user uref idpConfig handl mbName richInfo) = do
+createValidScimUser (ValidScimUser user uref idpConfig handl mbName richInfo active) = do
   -- sanity check: do tenant of the URef and the Issuer of the IdP match?  (this is mostly
   -- here to make sure a refactoring we did in the past is sound: we removed a lookup by
   -- tenant and had the idp config already in context from an earlier lookup.)
@@ -334,25 +339,35 @@ createValidScimUser (ValidScimUser user uref idpConfig handl mbName richInfo) =
   -- This is the pain and the price you pay for the horribleness called MTL
   storedUser <- lift $ toScimStoredUser buid user
   let teamid = idpConfig ^. SAML.idpExtraInfo . wiTeam
-  buid' <- lift $ Intra.Brig.createBrigUser uref buid teamid mbName ManagedByScim
+  buid' <- lift $ Brig.createBrigUser uref buid teamid mbName ManagedByScim
   assert (buid == buid') $ pure ()
   -- If we crash now, we have an active user that cannot login. And can not
   -- be bound this will be a zombie user that needs to be manually cleaned
   -- up.  We should consider making setUserHandle part of createUser and
   -- making it transactional.  If the user redoes the POST A new standalone
   -- user will be created
-  lift $ Intra.Brig.setBrigUserHandle buid handl
+  lift $ Brig.setBrigUserHandle buid handl
   -- If we crash now,  a POST retry will fail with 409 user already exists.
   -- Azure at some point will retry with GET /Users?filter=userName eq handle
   -- and then issue a PATCH containing the rich info and the externalId
-  lift $ Intra.Brig.setBrigUserRichInfo buid richInfo
+  lift $ Brig.setBrigUserRichInfo buid richInfo
   -- If we crash now, same as above, but the PATCH will only contain externalId
 
   -- FUTUREWORK(arianvp): these two actions we probably want to make transactional
   lift . wrapMonadClient $ Data.insertScimUser buid storedUser
   lift . wrapMonadClient $ Data.insertSAMLUser uref buid
 
   lift $ validateEmailIfExists buid uref
+
+  -- TODO(fisx): suspension has yet another race condition: if we don't reach the following
+  -- line, the user will be active.
+  -- TODO(fisx): what happens with suspended users that have emails?  should emails still be
+  -- validated?  will that work on suspended users?  (i think it won't, but i haven't
+  -- checked.)
+  lift $
+    Brig.getStatus buid >>= \old -> do
+      let new = scimActiveFlagToAccountStatus old active
+      when (new /= old) $ Brig.setStatus buid new
   pure storedUser
 
 updateValidScimUser ::
@@ -397,27 +412,36 @@ updateValidScimUser tokinfo uid newScimUser = do
         lift . wrapMonadClient $ Data.deleteSAMLUser olduref
         lift . wrapMonadClient $ Data.insertSAMLUser newuref uid
       -- update 'SAML.UserRef' on brig
-      bindok <- lift $ Intra.Brig.bindBrigUser uid newuref
+      bindok <- lift $ Brig.bindBrigUser uid newuref
       unless bindok . throwError $
         Scim.serverError "Failed to update SAML UserRef on brig."
       -- this can only happen if user is found in spar.scim_user, but missing on brig.
       -- (internal error?  race condition?)
 
+      -- TODO: if the user has been suspended or unsuspended in brig since the last scim
+      -- write, we'll find the wrong information here.
+      -- [see also](https://github.com/zinfra/backend-issues/issues/1006)
       oldScimUser :: ValidScimUser <-
         validateScimUser tokinfo . Scim.value . Scim.thing $ oldScimStoredUser
       -- the old scim user from our db is already validated, but this also recovers
       -- the extra details not stored in the DB that we need here.
 
       lift $ do
         case newScimUser ^. vsuName of
-          Just nm | oldScimUser ^. vsuName /= Just nm -> Intra.Brig.setBrigUserName uid nm
+          Just nm | oldScimUser ^. vsuName /= Just nm -> Brig.setBrigUserName uid nm
           _ -> pure ()
         when (oldScimUser ^. vsuHandle /= newScimUser ^. vsuHandle)
-          $ Intra.Brig.setBrigUserHandle uid
+          $ Brig.setBrigUserHandle uid
           $ newScimUser ^. vsuHandle
         when (oldScimUser ^. vsuRichInfo /= newScimUser ^. vsuRichInfo)
-          $ Intra.Brig.setBrigUserRichInfo uid
+          $ Brig.setBrigUserRichInfo uid
           $ newScimUser ^. vsuRichInfo
+
+      lift $
+        Brig.getStatus uid >>= \old -> do
+          let new = scimActiveFlagToAccountStatus old (newScimUser ^. vsuActive)
+          when (new /= old) $ Brig.setStatus uid new
+
       -- store new user value to scim_user table (spar). (this must happen last, so in case
       -- of crash the client can repeat the operation and it won't be considered a noop.)
       lift . wrapMonadClient $ Data.insertScimUser uid newScimStoredUser
@@ -490,7 +514,7 @@ updScimStoredUser' (SAML.Time moddate) usr (Scim.WithMeta meta (Scim.WithId scim
 deleteScimUser ::
   ScimTokenInfo -> UserId -> Scim.ScimHandler Spar ()
 deleteScimUser ScimTokenInfo {stiTeam} uid = do
-  mbBrigUser <- lift (Intra.Brig.getBrigUser uid)
+  mbBrigUser <- lift (Brig.getBrigUser uid)
   case mbBrigUser of
     Nothing -> do
       -- double-deletion gets you a 404.
@@ -509,10 +533,10 @@ deleteScimUser ScimTokenInfo {stiTeam} uid = do
           (logThenServerError $ "no userSSOId for user " <> cs (idToText uid))
           pure
           $ BrigTypes.userSSOId brigUser
-      uref <- either logThenServerError pure $ Intra.Brig.fromUserSSOId ssoId
+      uref <- either logThenServerError pure $ Brig.fromUserSSOId ssoId
       lift . wrapMonadClient $ Data.deleteSAMLUser uref
       lift . wrapMonadClient $ Data.deleteScimUser uid
-      lift $ Intra.Brig.deleteBrigUser uid
+      lift $ Brig.deleteBrigUser uid
       return ()
   where
     logThenServerError :: String -> Scim.ScimHandler Spar b
@@ -580,11 +604,14 @@ assertHandleNotUsedElsewhere hndl uid = do
     assertHandleUnused' "userName does not match UserId" hndl uid
 
 -- | The information needed to synthesize a Scim user.
+--
+-- See haddocks on 'ValidScimUser'.
 data NeededInfo = NeededInfo
   { neededHandle :: Handle,
     neededName :: Name,
     neededExternalId :: Text,
-    neededRichInfo :: RichInfo
+    neededRichInfo :: RichInfo,
+    neededActive :: Maybe Bool
   }
 
 synthesizeScimUser :: NeededInfo -> Scim.User SparTag
@@ -593,7 +620,8 @@ synthesizeScimUser info =
       Name displayName = neededName info
    in (Scim.empty userSchemas userName (ScimUserExtra (neededRichInfo info)))
         { Scim.externalId = Just $ neededExternalId info,
-          Scim.displayName = Just displayName
+          Scim.displayName = Just displayName,
+          Scim.active = neededActive info
         }
 
 -- | Helper function that given a brig user, creates a scim user on the fly or returns
@@ -609,12 +637,14 @@ getOrCreateScimUser stiTeam brigUser = do
       handle <- getUserHandle' brigUser'
       let name = userDisplayName brigUser'
       richInfo <- getRichInfo' uid
-      -- NOTE: If user is not an SSO User; this returns Nothing
-      -- Hence; we should only set managedByScim if this _succeeds_
-      ssoIdentity' <- getSSOIdentity' brigUser'
+      isActive <- scimActiveFlagFromAccountStatus <$> getStatus' uid
+      ssoIdentity' <- do
+        -- TODO: If user is not an SSO User; @ssoIdentity'@ is Nothing
+        -- Hence; we should only set managedByScim if this _succeeds_
+        getSSOIdentity' brigUser'
       externalId <- toExternalId' ssoIdentity'
       setManagedBy' uid ManagedByScim
-      let neededInfo = NeededInfo handle name externalId richInfo
+      let neededInfo = NeededInfo handle name externalId richInfo (Just isActive)
       let user = synthesizeScimUser neededInfo
       storedUser <- toScimStoredUser'' uid user
       insertScimUser' uid storedUser
@@ -623,14 +653,13 @@ getOrCreateScimUser stiTeam brigUser = do
     getScimUser' = MaybeT . lift . wrapMonadClient . Data.getScimUser
     getUserTeam' = MaybeT . pure . userTeam
     getUserHandle' = MaybeT . pure . userHandle
-    setManagedBy' uid = lift . lift . Intra.Brig.setBrigUserManagedBy uid
-    getRichInfo' = lift . lift . Intra.Brig.getBrigUserRichInfo
+    setManagedBy' uid = lift . lift . Brig.setBrigUserManagedBy uid
+    getRichInfo' = lift . lift . Brig.getBrigUserRichInfo
+    getStatus' = lift . lift . Brig.getStatus
     getSSOIdentity' = MaybeT . pure . (userIdentity >=> ssoIdentity)
-    toExternalId' =
-      either
-        (const (throwError (Scim.badRequest Scim.InvalidFilter (Just "Invalid externalId"))))
-        pure
-        . toExternalId
+    toExternalId' = either err pure . Brig.toExternalId
+      where
+        err = const . throwError $ Scim.badRequest Scim.InvalidFilter (Just "Invalid externalId")
     toScimStoredUser'' uid = lift . lift . toScimStoredUser uid
     insertScimUser' uid = lift . lift . wrapMonadClient . Data.insertScimUser uid