Improve IdP invariants

changelog.d/5-internal/idp-invariants

@@ -0,0 +1 @@
+Enforce some IdP invariants

deploy/services-demo/create_test_team_scim.sh

@@ -6,7 +6,7 @@ BRIG_HOST="http://localhost:8082"
 SPAR_HOST="http://localhost:8088"
 
 USAGE="
-This bash script craates
+This bash script creates
 1) team
 2) team admin
 3) scim token

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

@@ -66,7 +66,10 @@ data WireIdPAPIVersion
   deriving stock (Eq, Show, Enum, Bounded, Generic)
   deriving (Arbitrary) via (GenericUniform WireIdPAPIVersion)
 
--- | (Internal issue for making v2 the default: https://wearezeta.atlassian.net/browse/SQSERVICES-781)
+-- | (Internal issue for making v2 the default:
+-- https://wearezeta.atlassian.net/browse/SQSERVICES-781.  BEWARE: We probably shouldn't ever
+-- do this, but remove V1 entirely instead.  which requires migrating away from the old table
+-- on all on-prem installations.  which takes time.)
 defWireIdPAPIVersion :: WireIdPAPIVersion
 defWireIdPAPIVersion = WireIdPAPIV1
 

services/spar/spar.cabal

@@ -51,7 +51,6 @@ library
       Spar.Sem.IdPConfigStore
       Spar.Sem.IdPConfigStore.Cassandra
       Spar.Sem.IdPConfigStore.Mem
-      Spar.Sem.IdPConfigStore.Spec
       Spar.Sem.IdPRawMetadataStore
       Spar.Sem.IdPRawMetadataStore.Cassandra
       Spar.Sem.IdPRawMetadataStore.Mem
@@ -716,7 +715,6 @@ test-suite spec
       Test.Spar.Roundtrip.ByteString
       Test.Spar.ScimSpec
       Test.Spar.Sem.DefaultSsoCodeSpec
-      Test.Spar.Sem.IdPConfigStoreSpec
       Test.Spar.Sem.IdPRawMetadataStoreSpec
       Test.Spar.Sem.NowSpec
       Test.Spar.Sem.ScimExternalIdStoreSpec

services/spar/src/Spar/API.hs

@@ -44,7 +44,9 @@ module Spar.API
   )
 where
 
+import Brig.Types.Intra
 import Brig.Types.User (HavePendingInvitations (NoPendingInvitations))
+import Cassandra as Cas
 import Control.Lens
 import Control.Monad.Except
 import qualified Data.ByteString as SBS
@@ -75,7 +77,7 @@ import Spar.Sem.DefaultSsoCode (DefaultSsoCode)
 import qualified Spar.Sem.DefaultSsoCode as DefaultSsoCode
 import Spar.Sem.GalleyAccess (GalleyAccess)
 import qualified Spar.Sem.GalleyAccess as GalleyAccess
-import Spar.Sem.IdPConfigStore (GetIdPResult (..), IdPConfigStore, Replaced (..), Replacing (..))
+import Spar.Sem.IdPConfigStore (IdPConfigStore, Replaced (..), Replacing (..))
 import qualified Spar.Sem.IdPConfigStore as IdPConfigStore
 import Spar.Sem.IdPRawMetadataStore (IdPRawMetadataStore)
 import qualified Spar.Sem.IdPRawMetadataStore as IdPRawMetadataStore
@@ -95,7 +97,7 @@ import qualified Spar.Sem.VerdictFormatStore as VerdictFormatStore
 import System.Logger (Msg)
 import qualified URI.ByteString as URI
 import Wire.API.Routes.Public.Spar
-import Wire.API.User (userIssuer)
+import Wire.API.User
 import Wire.API.User.IdentityProvider
 import Wire.API.User.Saml
 import Wire.Sem.Logger (Logger)
@@ -230,8 +232,8 @@ authreqPrecheck ::
   Sem r NoContent
 authreqPrecheck msucc merr idpid =
   validateAuthreqParams msucc merr
-    *> getIdPConfig idpid
-    *> pure NoContent
+    *> IdPConfigStore.getConfig idpid
+    $> NoContent
 
 authreq ::
   Members
@@ -255,7 +257,7 @@ authreq ::
 authreq authreqttl msucc merr idpid = do
   vformat <- validateAuthreqParams msucc merr
   form@(SAML.FormRedirect _ ((^. SAML.rqID) -> reqid)) <- do
-    idp :: IdP <- IdPConfigStore.getConfig idpid >>= maybe (throwSparSem (SparIdPNotFound (cs $ show idpid))) pure
+    idp :: IdP <- IdPConfigStore.getConfig idpid
     let mbtid :: Maybe TeamId
         mbtid = case fromMaybe defWireIdPAPIVersion (idp ^. SAML.idpExtraInfo . wiApiVersion) of
           WireIdPAPIV1 -> Nothing
@@ -342,7 +344,7 @@ idpGet ::
   SAML.IdPId ->
   Sem r IdP
 idpGet zusr idpid = withDebugLog "idpGet" (Just . show . (^. SAML.idpId)) $ do
-  idp <- getIdPConfig idpid
+  idp <- IdPConfigStore.getConfig idpid
   _ <- authorizeIdP zusr idp
   pure idp
 
@@ -359,7 +361,7 @@ idpGetRaw ::
   SAML.IdPId ->
   Sem r RawIdPMetadata
 idpGetRaw zusr idpid = do
-  idp <- getIdPConfig idpid
+  idp <- IdPConfigStore.getConfig idpid
   _ <- authorizeIdP zusr idp
   IdPRawMetadataStore.get idpid >>= \case
     Just txt -> pure $ RawIdPMetadata txt
@@ -408,25 +410,12 @@ idpDelete ::
   SAML.IdPId ->
   Maybe Bool ->
   Sem r NoContent
-idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (const Nothing) $ do
-  idp <- getIdPConfig idpid
-  _ <- authorizeIdP zusr idp
+idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (const Nothing) $ do
+  idp <- IdPConfigStore.getConfig idpid
+  (zusr, team) <- authorizeIdP mbzusr idp
   let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer
-      team = idp ^. SAML.idpExtraInfo . wiTeam
-  -- if idp is not empty: fail or purge
-  let doPurge :: Sem r ()
-      doPurge = do
-        some <- SAMLUserStore.getSomeByIssuer issuer
-        forM_ some $ \(uref, uid) -> do
-          BrigAccess.delete uid
-          SAMLUserStore.delete uid uref
-        unless (null some) doPurge
-  idpIsEmpty <- isNothing <$> SAMLUserStore.getAnyByIssuer issuer
-  whenM (maybe (pure False) (idpDoesAuthSelf idp) zusr) $ throwSparSem SparIdPCannotDeleteOwnIdp
-  unless idpIsEmpty $
-    if purge
-      then doPurge
-      else throwSparSem SparIdPHasBoundUsers
+  whenM (idpDoesAuthSelf idp zusr) $ throwSparSem SparIdPCannotDeleteOwnIdp
+  SAMLUserStore.getAllByIssuerPaginated issuer >>= assertEmptyOrPurge team
   updateOldIssuers idp
   updateReplacingIdP idp
   -- Delete tokens associated with given IdP (we rely on the fact that
@@ -441,23 +430,37 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
     IdPRawMetadataStore.delete idpid
   pure NoContent
   where
+    assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r ()
+    assertEmptyOrPurge team page = do
+      forM_ (Cas.result page) $ \(uref, uid) -> do
+        mAccount <- BrigAccess.getAccount NoPendingInvitations uid
+        let mUserTeam = userTeam . accountUser =<< mAccount
+        when (mUserTeam == Just team) $ do
+          if purge
+            then do
+              BrigAccess.delete uid
+              SAMLUserStore.delete uid uref
+            else do
+              throwSparSem SparIdPHasBoundUsers
+      when (Cas.hasMore page) $
+        SAMLUserStore.nextPage page >>= assertEmptyOrPurge team
+
     updateOldIssuers :: IdP -> Sem r ()
     updateOldIssuers _ = pure ()
     -- we *could* update @idp ^. SAML.idpExtraInfo . wiReplacedBy@ to not keep the idp about
     -- to be deleted in its old issuers list, but it's tricky to avoid race conditions, and
     -- there is little to be gained here: we only use old issuers to find users that have not
     -- been migrated yet, and if an old user points to a deleted idp, it just means that we
-    -- won't find any users to migrate.  still, doesn't hurt much to look either.  so we
+    -- won't find any users to migrate.  still, doesn't hurt mucht to look either.  so we
     -- leave old issuers dangling for now.
 
     updateReplacingIdP :: IdP -> Sem r ()
-    updateReplacingIdP idp = forM_ (idp ^. SAML.idpExtraInfo . wiOldIssuers) $ \oldIssuer ->
-      getIdPIdByIssuer oldIssuer (idp ^. SAML.idpExtraInfo . wiTeam) >>= \case
-        GetIdPFound iid -> IdPConfigStore.clearReplacedBy $ Replaced iid
-        GetIdPNotFound -> pure ()
-        GetIdPDanglingId _ -> pure ()
-        GetIdPNonUnique _ -> pure ()
-        GetIdPWrongTeam _ -> pure ()
+    updateReplacingIdP idp = forM_ (idp ^. SAML.idpExtraInfo . wiOldIssuers) $ \oldIssuer -> do
+      iid <-
+        view SAML.idpId <$> case fromMaybe defWireIdPAPIVersion $ idp ^. SAML.idpExtraInfo . wiApiVersion of
+          WireIdPAPIV1 -> IdPConfigStore.getIdPByIssuerV1 oldIssuer
+          WireIdPAPIV2 -> IdPConfigStore.getIdPByIssuerV2 oldIssuer (idp ^. SAML.idpExtraInfo . wiTeam)
+      IdPConfigStore.clearReplacedBy $ Replaced iid
 
     idpDoesAuthSelf :: IdP -> UserId -> Sem r Bool
     idpDoesAuthSelf idp uid = do
@@ -505,13 +508,13 @@ idpCreateXML ::
   Maybe SAML.IdPId ->
   Maybe WireIdPAPIVersion ->
   Sem r IdP
-idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) = withDebugLog "idpCreate" (Just . show . (^. SAML.idpId)) $ do
+idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) = withDebugLog "idpCreateXML" (Just . show . (^. SAML.idpId)) $ do
   teamid <- Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp
   GalleyAccess.assertSSOEnabled teamid
   assertNoScimOrNoIdP teamid
   idp <- validateNewIdP apiversion idpmeta teamid mReplaces
   IdPRawMetadataStore.store (idp ^. SAML.idpId) raw
-  storeIdPConfig idp
+  IdPConfigStore.insertConfig idp
   forM_ mReplaces $ \replaces ->
     IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId))
   pure idp
@@ -577,35 +580,26 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate
   oldIssuers :: [SAML.Issuer] <- case mReplaces of
     Nothing -> pure []
     Just replaces -> do
-      idp <- IdPConfigStore.getConfig replaces >>= maybe (throwSparSem (SparIdPNotFound (cs $ show mReplaces))) pure
+      idp <- IdPConfigStore.getConfig replaces
       pure $ (idp ^. SAML.idpMetadata . SAML.edIssuer) : (idp ^. SAML.idpExtraInfo . wiOldIssuers)
   let requri = _idpMetadata ^. SAML.edRequestURI
       _idpExtraInfo = WireIdP teamId (Just apiversion) oldIssuers Nothing
   enforceHttps requri
-  idp <- getIdPConfigByIssuer (_idpMetadata ^. SAML.edIssuer) teamId
+  mbIdp <- case apiversion of
+    WireIdPAPIV1 -> IdPConfigStore.getIdPByIssuerV1Maybe (_idpMetadata ^. SAML.edIssuer)
+    WireIdPAPIV2 -> IdPConfigStore.getIdPByIssuerV2Maybe (_idpMetadata ^. SAML.edIssuer) teamId
   Logger.log Logger.Debug $ show (apiversion, _idpMetadata, teamId, mReplaces)
-  Logger.log Logger.Debug $ show (_idpId, oldIssuers, idp)
-
-  let handleIdPClash :: Either id idp -> m ()
-      -- (HINT: using type vars above instead of the actual types constitutes a proof that
-      -- we're not using any properties of the arguments in this function.)
-      handleIdPClash = case apiversion of
-        WireIdPAPIV1 -> const $ do
-          throwSparSem $ SparNewIdPAlreadyInUse "you can't create an IdP with api_version v1 if the issuer is already in use on the wire instance."
-        WireIdPAPIV2 -> \case
-          (Right _) -> do
-            -- idp' was found by lookup with teamid, so it's in the same team.
-            throwSparSem $ SparNewIdPAlreadyInUse "if the exisitng IdP is registered for a team, the new one can't have it."
-          (Left _) -> do
-            -- this idp *id* is from a different team, and we're in the 'WireIdPAPIV2' case, so this is fine.
-            pure ()
-
-  case idp of
-    GetIdPFound idp' {- same team -} -> handleIdPClash (Right idp')
-    GetIdPNotFound -> pure ()
-    res@(GetIdPDanglingId _) -> throwSparSem . SparIdPNotFound . ("validateNewIdP: " <>) . cs . show $ res -- database inconsistency
-    GetIdPNonUnique ids' {- same team didn't yield anything, but there are at least two other teams with this issuer already -} -> handleIdPClash (Left ids')
-    GetIdPWrongTeam id' {- different team -} -> handleIdPClash (Left id')
+  Logger.log Logger.Debug $ show (_idpId, oldIssuers, mbIdp)
+
+  let failWithIdPClash :: m ()
+      failWithIdPClash = throwSparSem . SparNewIdPAlreadyInUse $ case apiversion of
+        WireIdPAPIV1 ->
+          "you can't create an IdP with api_version v1 if the issuer is already in use on the wire instance."
+        WireIdPAPIV2 ->
+          -- idp was found by lookup with teamid, so it's in the same team.
+          "you can't create an IdP with api_version v1 if the issuer is already in use in your team."
+
+  unless (isNothing mbIdp) failWithIdPClash
 
   pure SAML.IdPConfig {..}
 
@@ -645,17 +639,20 @@ idpUpdateXML ::
   SAML.IdPMetadata ->
   SAML.IdPId ->
   Sem r IdP
-idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^. SAML.idpId)) $ do
+idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdateXML" (Just . show . (^. SAML.idpId)) $ do
   (teamid, idp) <- validateIdPUpdate zusr idpmeta idpid
   GalleyAccess.assertSSOEnabled teamid
   IdPRawMetadataStore.store (idp ^. SAML.idpId) raw
   -- (if raw metadata is stored and then spar goes out, raw metadata won't match the
   -- structured idp config.  since this will lead to a 5xx response, the client is expected to
   -- try again, which would clean up cassandra state.)
-  storeIdPConfig idp
+  IdPConfigStore.insertConfig idp
   -- if the IdP issuer is updated, the old issuer must be removed explicitly.
   -- if this step is ommitted (due to a crash) resending the update request should fix the inconsistent state.
-  forM_ (idp ^. SAML.idpExtraInfo . wiOldIssuers) IdPConfigStore.deleteIssuer
+  let mbteamid = case fromMaybe defWireIdPAPIVersion $ idp ^. SAML.idpExtraInfo . wiApiVersion of
+        WireIdPAPIV1 -> Nothing
+        WireIdPAPIV2 -> Just teamid
+  forM_ (idp ^. SAML.idpExtraInfo . wiOldIssuers) (flip IdPConfigStore.deleteIssuer mbteamid)
   pure idp
 
 -- | Check that: idp id is valid; calling user is admin in that idp's home team; team id in
@@ -678,30 +675,32 @@ validateIdPUpdate ::
   SAML.IdPMetadata ->
   SAML.IdPId ->
   m (TeamId, IdP)
-validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just . show . (_2 %~ (^. SAML.idpId))) $ do
-  previousIdP <-
-    IdPConfigStore.getConfig _idpId >>= \case
-      Nothing -> throw errUnknownIdPId
-      Just idp -> pure idp
-  teamId <- authorizeIdP zusr previousIdP
+validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (Just . show . (_2 %~ (^. SAML.idpId))) $ do
+  previousIdP <- IdPConfigStore.getConfig _idpId
+  (_, teamId) <- authorizeIdP zusr previousIdP
   unless (previousIdP ^. SAML.idpExtraInfo . wiTeam == teamId) $
     throw errUnknownIdP
   _idpExtraInfo <- do
     let previousIssuer = previousIdP ^. SAML.idpMetadata . SAML.edIssuer
         newIssuer = _idpMetadata ^. SAML.edIssuer
     if previousIssuer == newIssuer
-      then pure $ previousIdP ^. SAML.idpExtraInfo
+      then do
+        -- idempotency
+        pure $ previousIdP ^. SAML.idpExtraInfo
       else do
-        foundConfig <- getIdPConfigByIssuerAllowOld newIssuer (Just teamId)
-        notInUseByOthers <- case foundConfig of
-          GetIdPFound c -> pure $ c ^. SAML.idpId == _idpId
-          GetIdPNotFound -> pure True
-          res@(GetIdPDanglingId _) -> throwSparSem . SparIdPNotFound . ("validateIdPUpdate: " <>) . cs . show $ res -- impossible
-          res@(GetIdPNonUnique _) -> throwSparSem . SparIdPNotFound . ("validateIdPUpdate: " <>) . cs . show $ res -- impossible (because team id was used in lookup)
-          GetIdPWrongTeam _ -> pure False
-        if notInUseByOthers
-          then pure $ previousIdP ^. SAML.idpExtraInfo & wiOldIssuers %~ nub . (previousIssuer :)
-          else throwSparSem SparIdPIssuerInUse
+        idpIssuerInUse <-
+          ( case fromMaybe defWireIdPAPIVersion $ previousIdP ^. SAML.idpExtraInfo . wiApiVersion of
+              WireIdPAPIV1 -> IdPConfigStore.getIdPByIssuerV1Maybe newIssuer
+              WireIdPAPIV2 -> IdPConfigStore.getIdPByIssuerV2Maybe newIssuer teamId
+            )
+            <&> ( \case
+                    Just idpFound -> idpFound ^. SAML.idpId /= _idpId
+                    Nothing -> False
+                )
+        if idpIssuerInUse
+          then throwSparSem SparIdPIssuerInUse
+          else pure $ previousIdP ^. SAML.idpExtraInfo & wiOldIssuers %~ nub . (previousIssuer :)
+
   let requri = _idpMetadata ^. SAML.edRequestURI
   enforceHttps requri
   pure (teamId, SAML.IdPConfig {..})
@@ -710,7 +709,6 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just
       where
         enc = cs . toLazyByteString . URI.serializeURIRef
         uri = _idpMetadata ^. SAML.edIssuer . SAML.fromIssuer
-    errUnknownIdPId = SAML.UnknownIdP . cs . SAML.idPIdToST $ _idpId
 
 withDebugLog :: Member (Logger String) r => String -> (a -> Maybe String) -> Sem r a -> Sem r a
 withDebugLog msg showval action = do
@@ -724,12 +722,12 @@ authorizeIdP ::
   (HasCallStack, Members '[GalleyAccess, BrigAccess, Error SparError] r) =>
   Maybe UserId ->
   IdP ->
-  Sem r TeamId
+  Sem r (UserId, TeamId)
 authorizeIdP Nothing _ = throw (SAML.CustomError $ SparNoPermission (cs $ show CreateUpdateDeleteIdp))
 authorizeIdP (Just zusr) idp = do
   let teamid = idp ^. SAML.idpExtraInfo . wiTeam
   GalleyAccess.assertHasPermission teamid CreateUpdateDeleteIdp zusr
-  pure teamid
+  pure (zusr, teamid)
 
 enforceHttps :: Member (Error SparError) r => URI.URI -> Sem r ()
 enforceHttps uri =
@@ -762,12 +760,9 @@ internalPutSsoSettings SsoSettings {defaultSsoCode = Nothing} = do
   DefaultSsoCode.delete
   pure NoContent
 internalPutSsoSettings SsoSettings {defaultSsoCode = Just code} =
-  IdPConfigStore.getConfig code >>= \case
-    Nothing ->
-      -- this will return a 404, which is not quite right,
-      -- but it's an internal endpoint and the message clearly says
-      -- "Could not find IdP".
-      throwSparSem $ SparIdPNotFound mempty
-    Just _ -> do
-      DefaultSsoCode.store code
-      pure NoContent
+  -- this can throw a 404, which is not quite right,
+  -- but it's an internal endpoint and the message clearly says
+  -- "Could not find IdP".
+  IdPConfigStore.getConfig code
+    *> DefaultSsoCode.store code
+    $> NoContent