{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Test.Spar.APISpec (spec) where

import Bilge
import Bilge.Assert
import Cassandra as Cas hiding (Client, Value)
import Control.Lens hiding ((.=))
import Control.Monad.Catch (MonadThrow)
import Control.Monad.Error.Class
import Control.Monad.Random.Class (getRandomR)
import Data.Aeson as Aeson
import Data.Aeson.Lens
import Data.ByteString.Conversion
import Data.Handle (fromHandle)
import Data.Id
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Misc
import Data.Proxy
import Data.String.Conversions
import qualified Data.Text as ST
import Data.Text.Ascii (decodeBase64, validateBase64)
import qualified Data.Text.Lazy as LT
import Data.Typeable (typeRep)
import qualified Data.UUID as UUID hiding (fromByteString, null)
import qualified Data.UUID.V4 as UUID (nextRandom)
import qualified Data.Vector as Vec
import qualified Data.ZAuth.Token as ZAuth
import Imports hiding (head)
import Network.HTTP.Types (status200, status202)
import SAML2.WebSSO
  ( AuthnResponse,
    IdPId (..),
    Issuer (..),
    NameID,
    SimpleSetCookie (..),
    UserRef (..),
    edCertAuthnResponse,
    edIssuer,
    edRequestURI,
    fromIssuer,
    idPIdToST,
    idpExtraInfo,
    idpId,
    idpMetadata,
    mkNameID,
    parseFromDocument,
    rqIssuer,
    (-/),
  )
import qualified SAML2.WebSSO as SAML
import SAML2.WebSSO.API.Example (SimpleSP)
import SAML2.WebSSO.Test.Lenses
import SAML2.WebSSO.Test.MockResponse
import SAML2.WebSSO.Test.Util
import Spar.Error
import qualified Spar.Intra.RpcApp as Intra
import Spar.Options
import qualified Spar.Sem.AReqIDStore as AReqIDStore
import Text.XML.DSig (SignPrivCreds, mkSignCredsWithCert)
import qualified URI.ByteString as URI
import URI.ByteString.QQ (uri)
import Util.Core
import Util.Scim (createUser, filterBy, listUsers, randomScimUserWithEmail, randomScimUserWithNick, registerScimToken)
import qualified Util.Scim as ScimT
import Util.Types
import qualified Web.Cookie as Cky
import qualified Web.Scim.Class.User as Scim
import qualified Web.Scim.Schema.Common as Scim
import qualified Web.Scim.Schema.Meta as Scim
import qualified Web.Scim.Schema.User as Scim
import qualified Web.Scim.Schema.User.Email as Scim
import Wire.API.Team.Member (newTeamMemberDeleteData, rolePermissions)
import Wire.API.Team.Permission hiding (self)
import Wire.API.Team.Role
import Wire.API.User
import Wire.API.User.Client
import Wire.API.User.Client.Prekey
import Wire.API.User.IdentityProvider
import Wire.API.User.Scim hiding (handle)
import qualified Wire.BrigAPIAccess as BrigAPIAccess
import qualified Wire.IdPConfigStore as IdPEffect

spec :: SpecWith TestEnv
spec = do
  specMisc
  specMetadata
  specInitiateLogin
  specFinalizeLogin
  specCRUDIdentityProvider
  specDeleteCornerCases
  specScimAndSAML
  specProvisionScimAndSAMLUserWithRole
  specAux
  specSsoSettings
  specSparUserMigration
  specReAuthSsoUserWithPassword

specMisc :: SpecWith TestEnv
specMisc = do
  describe "CORS" $ do
    it "is disabled" $ do
      -- I put this there because I was playing with a CORS middleware to make swagger browsing more
      -- convenient, but went for a simpler work flow that didn't require that in the end.  I left
      -- it in so if we ever start adding CORS headers, whether by accident or intentionally, we
      -- will fall over this test and will have to extend it to document the new behavior.
      env <- ask
      get ((env ^. teSpar) . path "/i/status" . expect2xx)
        `shouldRespondWith` (\(responseHeaders -> hdrs) -> isNothing $ lookup "Access-Control-Allow-Origin" hdrs)
  describe "status" $ do
    it "brig /i/status" $ do
      env <- ask
      ping (env ^. teBrig) `shouldRespondWith` (== ())
    it "spar /i/status" $ do
      env <- ask
      ping (env ^. teSpar) `shouldRespondWith` (== ())
  describe "rule do disallow http idp urls." $ do
    let check :: Bool -> TestSpar ()
        check isHttps = do
          somemeta <- do
            issuer <- makeIssuer
            let nonfresh = either (error . show) id $ SAML.decode ("<?xml version=\"1.0\" encoding=\"UTF-8\"?><md:EntityDescriptor xmlns:md=\"urn:oasis:names:tc:SAML:2.0:metadata\" entityID=\"" <> (if isHttps then "https" else "http") <> "://www.okta.com/exkgxxperpx1txfkY0h7\"><md:IDPSSODescriptor WantAuthnRequestsSigned=\"false\" protocolSupportEnumeration=\"urn:oasis:names:tc:SAML:2.0:protocol\"><md:KeyDescriptor use=\"signing\"><ds:KeyInfo xmlns:ds=\"http://www.w3.org/2000/09/xmldsig#\"><ds:X509Data><ds:X509Certificate>MIIDpDCCAoygAwIBAgIGAWSx7x1HMA0GCSqGSIb3DQEBCwUAMIGSMQswCQYDVQQGEwJVUzETMBEG\nA1UECAwKQ2FsaWZvcm5pYTEWMBQGA1UEBwwNU2FuIEZyYW5jaXNjbzENMAsGA1UECgwET2t0YTEU\nMBIGA1UECwwLU1NPUHJvdmlkZXIxEzARBgNVBAMMCmRldi01MDA1MDgxHDAaBgkqhkiG9w0BCQEW\nDWluZm9Ab2t0YS5jb20wHhcNMTgwNzE5MDk0NTM1WhcNMjgwNzE5MDk0NjM0WjCBkjELMAkGA1UE\nBhMCVVMxEzARBgNVBAgMCkNhbGlmb3JuaWExFjAUBgNVBAcMDVNhbiBGcmFuY2lzY28xDTALBgNV\nBAoMBE9rdGExFDASBgNVBAsMC1NTT1Byb3ZpZGVyMRMwEQYDVQQDDApkZXYtNTAwNTA4MRwwGgYJ\nKoZIhvcNAQkBFg1pbmZvQG9rdGEuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA\nhUaQm/3dgPws1A5IjFK9ZQpj170vIqENuDG0tapAzkvk6+9vyhduGckHTeZF3k5MMlW9iix2Eg0q\na1oS/Wrq/aBf7+BH6y1MJlQnaKQ3hPL+OFvYzbnrN8k2uC2LivP7Y90dXwtN3P63rA4QSyDPYEMv\ndKSubUKX/HNsUg4I2PwHmpfWBNgoMkqe0bxQILBv+84L62IYSd6k77XXnCFb/usHpG/gY6sJsTQ2\naFl9FuJ51uf67AOj8RzPXstgtUaXbdJI0kAqKIb3j9Zv3mpPCy/GHnyB3PMalvtc1uaz1ZnwO2el\niqhwB6/8W6CPutFo1Bhq1glQIX+1OD7906iORwIDAQABMA0GCSqGSIb3DQEBCwUAA4IBAQB0h6vK\nAywJwH3g0RnocOpBvT42QW57TZ3Wzm9gbg6dQL0rB+NHDx2V0VIh51E3YHL1os9W09MreM7I74D/\nfX27r1Q3+qAsL1v3CN8WIVh9eYitBCtF7DwZmL2UXTia+GWPrabO14qAztFmTXfqNuCZej7gJd/K\n2r0KBiZtZ6o58WBREW2F70a6nN6Nk1yjzBkDTJMMf8OMXHphTaalMBXojN9W6HEDpGBE0qY7c70P\nqvfUEzd8wHWcDxo6+3jajajelk0V4rg7Cqxccr+WwjYtENEuQypNG2mbI52iPZked0QWKy0WzhSM\nw5wjJ+QDG31vJInAB2769C2KmhPDyNhU</ds:X509Certificate></ds:X509Data></ds:KeyInfo></md:KeyDescriptor><md:NameIDFormat>urn:oasis:names:tc:SAML:1.1:nameid-format:unspecified</md:NameIDFormat><md:NameIDFormat>urn:oasis:names:tc:SAML:1.1:nameid-format:emailAddress</md:NameIDFormat><md:SingleSignOnService Binding=\"urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST\" Location=\"" <> (if isHttps then "https" else "http") <> "://dev-500508.oktapreview.com/app/wireswissgmbhdev500508_z1tejapsbeyonce_1/exkgxxperpx1txfkY0h7/sso/saml\"/><md:SingleSignOnService Binding=\"urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect\" Location=\"" <> (if isHttps then "https" else "http") <> "://dev-500508.oktapreview.com/app/wireswissgmbhdev500508_z1tejapsbeyonce_1/exkgxxperpx1txfkY0h7/sso/saml\"/></md:IDPSSODescriptor></md:EntityDescriptor>")
            pure $ nonfresh & edIssuer .~ issuer
          env <- ask
          uid <- fst <$> call (createUserWithTeam (env ^. teBrig) (env ^. teGalley))
          resp <- call $ callIdpCreate' (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just uid) somemeta
          liftIO $ statusCode resp `shouldBe` if isHttps then 201 else 400
    it "does not trigger on https urls" $ check True
    it "does trigger on http urls" $ check False

-- | auxiliary function to create a team
callCreateUserWithTeam :: TestSpar (UserId, TeamId)
callCreateUserWithTeam = do
  env <- ask
  call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)

specMetadata :: SpecWith TestEnv
specMetadata = do
  describe "metadata" $ do
    let mkit :: String -> String -> SpecWith TestEnv
        mkit mdpath finalizepath = do
          it ("metadata (" <> mdpath <> ")") $ do
            env <- ask
            let sparHost = env ^. teOpts . to saml . SAML.cfgDomainConfigs . _Left . SAML.cfgSPSsoURI . to (cs . SAML.renderURI)
                fragments =
                  [ "md:SPSSODescriptor",
                    "validUntil",
                    "WantAssertionsSigned=\"true\"",
                    "<md:AssertionConsumerService Binding=\"urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST\" Location=\""
                      <> sparHost
                      <> finalizepath
                      <> "\" index=\"0\" isDefault=\"true\"/>"
                  ]
            get ((env ^. teSpar) . path (cs mdpath) . expect2xx)
              `shouldRespondWith` (\(responseBody -> Just (cs -> bdy)) -> all (`isInfixOf` bdy) fragments)

    mkit "/sso/metadata" "/finalize-login"
    mkit "/sso/metadata/208f5cc4-14cd-11ec-b969-db4fdf0173d5" "/finalize-login/208f5cc4-14cd-11ec-b969-db4fdf0173d5"

specInitiateLogin :: SpecWith TestEnv
specInitiateLogin = do
  describe "HEAD /sso/initiate-login/:idp" $ do
    context "unknown IdP" $ do
      it "responds with 404" $ do
        env <- ask
        let uuid = cs $ UUID.toText UUID.nil
        void . call $ head ((env ^. teSpar) . path (cs $ "/sso/initiate-login/" -/ uuid) . expect4xx)
    context "known IdP" $ do
      it "responds with 200" $ do
        env <- ask
        (user, _tid) <- callCreateUserWithTeam
        (idPIdToST . (^. idpId) -> idp) <- registerTestIdP user
        void . call $ head ((env ^. teSpar) . path (cs $ "/sso/initiate-login/" -/ idp) . expect2xx)
  describe "GET /sso/initiate-login/:idp" $ do
    context "unknown IdP" $ do
      it "responds with 'not found'" $ do
        env <- ask
        let uuid = cs $ UUID.toText UUID.nil
        get ((env ^. teSpar) . path (cs $ "/sso/initiate-login/" -/ uuid))
          `shouldRespondWith` ((== 404) . statusCode)
    let checkRespBody :: (HasCallStack) => ResponseLBS -> Bool
        checkRespBody (responseBody -> Just (cs -> bdy)) =
          all
            (`isInfixOf` bdy)
            [ "<html xml:lang=\"en\" xmlns=\"http://www.w3.org/1999/xhtml\">",
              "<body onload=\"document.forms[0].submit()\">",
              "<input name=\"SAMLRequest\" type=\"hidden\" "
            ]
        checkRespBody bad = error $ show bad
    context "known IdP" $ do
      it "responds with authentication request" $ do
        env <- ask
        (user, _tid) <- callCreateUserWithTeam
        (idPIdToST . (^. idpId) -> idp) <- registerTestIdP user
        resp <- call $ get ((env ^. teSpar) . path (cs $ "/sso/initiate-login/" -/ idp) . expect2xx)
        liftIO $ do
          resp `shouldSatisfy` checkRespBody

specFinalizeLogin :: SpecWith TestEnv
specFinalizeLogin = do
  describe "POST /sso/finalize-login" $ do
    context "not granted" $ do
      it "testRejectsSAMLResponseSayingAccessNotGranted - responds with a very peculiar 'forbidden' HTTP response" $
        testRejectsSAMLResponseSayingAccessNotGranted

    context "access granted" $ do
      let loginSuccess :: (HasCallStack) => ResponseLBS -> TestSpar ()
          loginSuccess sparresp = liftIO $ do
            statusCode sparresp `shouldBe` 200
            let bdy = maybe "" (cs @LByteString @String) (responseBody sparresp)
            bdy `shouldContain` "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
            bdy `shouldContain` "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"
            bdy `shouldContain` "<title>wire:sso:success</title>"
            bdy `shouldContain` "window.opener.postMessage({type: 'AUTH_SUCCESS'}, receiverOrigin)"
            hasPersistentCookieHeader sparresp `shouldBe` Right ()

      let loginFailure :: (HasCallStack) => ResponseLBS -> TestSpar ()
          loginFailure sparresp = liftIO $ do
            statusCode sparresp `shouldBe` 200
            let bdy = maybe "" (cs @LByteString @String) (responseBody sparresp)
            bdy `shouldContain` "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
            bdy `shouldContain` "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"
            bdy `shouldNotContain` "<title>wire:sso:error:success</title>"
            bdy `shouldContain` "<title>wire:sso:error:bad-team</title>"
            bdy `shouldContain` "window.opener.postMessage({"
            bdy `shouldContain` "\"type\":\"AUTH_ERROR\""
            bdy `shouldContain` "\"payload\":{"
            bdy `shouldContain` "\"label\":\"forbidden\""
            bdy `shouldContain` "}, receiverOrigin)"
            hasPersistentCookieHeader sparresp `shouldBe` Left "no set-cookie header"

      context "happy flow" $ do
        it "responds with a very peculiar 'allowed' HTTP response" $ do
          env <- ask
          let apiVer = env ^. teWireIdPAPIVersion
          (user, tid) <- callCreateUserWithTeam
          (idp, (_, privcreds)) <- registerTestIdPWithMeta user
          liftIO $ fromMaybe defWireIdPAPIVersion (idp ^. idpExtraInfo . apiVersion) `shouldBe` apiVer
          spmeta <- getTestSPMetadata tid
          authnreq <- negotiateAuthnRequest idp
          let audiencePath = case apiVer of
                WireIdPAPIV1 -> "/sso/finalize-login"
                WireIdPAPIV2 -> "/sso/finalize-login/" <> toByteString' tid
          liftIO $ authnreq ^. rqIssuer . fromIssuer . to URI.uriPath `shouldBe` audiencePath
          authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp spmeta (Just authnreq) True
          loginSuccess =<< submitAuthnResponse tid authnresp

      context "happy flow (two teams, fixed IdP entityID)" $ do
        it "works" $ do
          skipIdPAPIVersions
            [ WireIdPAPIV1
            -- (In fact, to get this to work was the reason to introduce 'WireIdPAPIVesion'.)
            ]
          env <- ask
          (user, tid1) <- callCreateUserWithTeam
          (idp1, (IdPMetadataValue _ metadata, privcreds)) <- registerTestIdPWithMeta user
          (tid2, idp2) <- liftIO . runHttpT (env ^. teMgr) $ do
            (owner2, tid2) <- createUserWithTeam (env ^. teBrig) (env ^. teGalley)
            idp2 :: IdP <- callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner2) metadata
            pure (tid2, idp2)
          (tid3, idp3) <- liftIO . runHttpT (env ^. teMgr) $ do
            (owner3, tid3) <- createUserWithTeam (env ^. teBrig) (env ^. teGalley)
            idp3 :: IdP <- callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner3) metadata
            pure (tid3, idp3)
          do
            spmeta <- getTestSPMetadata tid1
            authnreq <- negotiateAuthnRequest idp1
            authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp1 spmeta (Just authnreq) True
            loginSuccess =<< submitAuthnResponse tid1 authnresp
          do
            spmeta <- getTestSPMetadata tid2
            authnreq <- negotiateAuthnRequest idp2
            authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp2 spmeta (Just authnreq) True
            loginSuccess =<< submitAuthnResponse tid2 authnresp
          do
            spmeta <- getTestSPMetadata tid3
            authnreq <- negotiateAuthnRequest idp3
            authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp3 spmeta (Just authnreq) True
            loginSuccess =<< submitAuthnResponse tid3 authnresp

      -- @SF.Channel @TSFI.RESTfulAPI @S2 @S3
      -- Do not authenticate if SSO IdP response is for different team
      context "rejectsSAMLResponseInWrongTeam" $ do
        it "fails" $ do
          skipIdPAPIVersions
            [ WireIdPAPIV1
            -- (In fact, to get this to work was the reason to introduce 'WireIdPAPIVesion'.)
            ]
          env <- ask
          (user, tid1) <- callCreateUserWithTeam
          (idp1, (IdPMetadataValue _ metadata, privcreds)) <- registerTestIdPWithMeta user
          (tid2, idp2) <- liftIO . runHttpT (env ^. teMgr) $ do
            (owner2, tid2) <- createUserWithTeam (env ^. teBrig) (env ^. teGalley)
            idp2 :: IdP <- callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner2) metadata
            pure (tid2, idp2)
          subj <- liftIO $ SAML.unspecifiedNameID . UUID.toText <$> UUID.nextRandom
          do
            spmeta <- getTestSPMetadata tid1
            authnreq <- negotiateAuthnRequest idp1
            authnresp <- runSimpleSP $ mkAuthnResponseWithSubj subj privcreds idp1 spmeta (Just authnreq) True
            loginSuccess =<< submitAuthnResponse tid1 authnresp
          do
            spmeta <- getTestSPMetadata tid2
            authnreq <- negotiateAuthnRequest idp2
            authnresp <- runSimpleSP $ mkAuthnResponseWithSubj subj privcreds idp2 spmeta (Just authnreq) True
            loginFailure =<< submitAuthnResponse tid2 authnresp

      -- @END

      context "user is created once, then deleted in team settings, then can login again." $ do
        it "responds with 'allowed'" $ do
          (ownerid, teamid) <- callCreateUserWithTeam
          (idp, (_, privcreds)) <- registerTestIdPWithMeta ownerid
          spmeta <- getTestSPMetadata teamid
          -- first login
          newUserAuthnResp :: SignedAuthnResponse <- do
            authnreq <- negotiateAuthnRequest idp
            authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp spmeta (Just authnreq) True
            loginSuccess =<< submitAuthnResponse teamid authnresp
            pure $ authnresp
          let newUserRef@(UserRef _ subj) =
                either (error . show) (^. userRefL) $
                  parseFromDocument (fromSignedAuthnResponse newUserAuthnResp)
          newUserId <- getUserIdViaRef newUserRef

          do
            checkChangeRoleOfTeamMember teamid ownerid newUserId

          -- remove user from team settings
          do
            env <- ask
            _ <-
              call . get $
                ( (env ^. teGalley)
                    . header "Z-User" (toByteString' ownerid)
                    . header "Z-Connection" "fake"
                    . paths ["teams", toByteString' teamid, "members"]
                    . expect2xx
                )
            void . call . delete $
              ( (env ^. teGalley)
                  . header "Z-User" (toByteString' ownerid)
                  . header "Z-Connection" "fake"
                  . paths ["teams", toByteString' teamid, "members", toByteString' newUserId]
                  . Bilge.json (newTeamMemberDeleteData (Just defPassword))
                  . expect2xx
              )
            liftIO $ threadDelay 100000 -- make sure deletion is done.  if we don't want to take
            -- the time, we should find another way to robustly
            -- confirm that deletion has completed in the background.
          do
            -- second login
            authnreq <- negotiateAuthnRequest idp
            authnresp <- runSimpleSP $ mkAuthnResponseWithSubj subj privcreds idp spmeta (Just authnreq) True
            loginSuccess =<< submitAuthnResponse teamid authnresp

      context "unknown user" $ do
        it "creates the user" $ do
          pending

      context "known user A, but client device (probably a browser?) is already authenticated as another (probably non-sso) user B" $ do
        it "logs out user B, logs in user A" $ do
          -- TODO(arianvp): Ask Matthias what this even means
          pending

      context "more than one dsig cert" $ do
        it "accepts the first of two certs for signatures" $ do
          pending
        it "accepts the second of two certs for signatures" $ do
          pending

    context "bad AuthnResponse" $ do
      it "testRejectsSAMLResponseFromWrongIssuer" testRejectsSAMLResponseFromWrongIssuer
      it "testRejectsSAMLResponseSignedWithWrongKey" testRejectsSAMLResponseSignedWithWrongKey
      it "testRejectsSAMLResponseIfRequestIsStale" testRejectsSAMLResponseIfRequestIsStale
      it "testRejectsSAMLResponseIfResponseIsStale" testRejectsSAMLResponseIfResponseIsStale

    context "IdP changes response format" $ do
      it "treats NameId case-insensitively" $ do
        (ownerid, tid) <- callCreateUserWithTeam
        (idp, (_, privcreds)) <- registerTestIdPWithMeta ownerid
        spmeta <- getTestSPMetadata tid

        let loginSuccess :: (HasCallStack) => ResponseLBS -> TestSpar ()
            loginSuccess sparresp = liftIO $ do
              statusCode sparresp `shouldBe` 200

        let loginWithSubject subj = do
              authnreq <- negotiateAuthnRequest idp
              authnresp <- runSimpleSP $ mkAuthnResponseWithSubj subj privcreds idp spmeta (Just authnreq) True
              loginSuccess =<< submitAuthnResponse tid authnresp
              ssoid <- getSsoidViaAuthResp authnresp
              ssoToUidSpar tid ssoid

        let createEmailSubject email = do
              uname <- either (error . show) pure (SAML.mkUNameIDEmail email)
              let subj = either (error . show) id $ SAML.mkNameID uname Nothing Nothing Nothing
              pure subj

        suffix <- cs <$> replicateM 7 (getRandomR ('a', 'z'))
        let randEmail = "email_" <> suffix <> "@example.com"

        subj <- createEmailSubject randEmail
        mbId1 <- loginWithSubject subj

        subjUpper <- createEmailSubject (ST.toUpper randEmail)
        mbId2 <- loginWithSubject subjUpper

        liftIO $ do
          mbId1 `shouldSatisfy` isJust
          mbId2 `shouldSatisfy` isJust
          mbId1 `shouldBe` mbId2

testGetPutDelete :: (HasCallStack) => (SparReq -> Maybe UserId -> IdPId -> IdPMetadataInfo -> Http ResponseLBS) -> SpecWith TestEnv
testGetPutDelete whichone = do
  context "unknown IdP" $ do
    it "responds with 'not found'" $ do
      env <- ask
      (ownerid, _tid) <- callCreateUserWithTeam
      (_, (idpmeta, _)) <- registerTestIdPWithMeta ownerid
      whichone (env ^. teSpar) Nothing (IdPId UUID.nil) idpmeta
        `shouldRespondWith` checkErrHspec 404 "not-found"
  context "no zuser" $ do
    it "responds with 'insufficient permissions'" $ do
      env <- ask
      (ownerid, _tid) <- callCreateUserWithTeam
      ((^. idpId) -> idpid, (idpmeta, _)) <- registerTestIdPWithMeta ownerid
      whichone (env ^. teSpar) Nothing idpid idpmeta
        `shouldRespondWith` checkErrHspec 403 "insufficient-permissions"

  context "zuser has no team" $ do
    it "responds with 'insufficient permissions'" $ do
      env <- ask
      (ownerid, _tid) <- callCreateUserWithTeam
      ((^. idpId) -> idpid, (idpmeta, _)) <- registerTestIdPWithMeta ownerid
      uid <- call $ userId <$> randomUser (env ^. teBrig)
      whichone (env ^. teSpar) (Just uid) idpid idpmeta
        `shouldRespondWith` checkErrHspec 403 "insufficient-permissions"
  context "zuser is a team member, but not a team owner" $ do
    it "responds with 'insufficient-permissions' and a helpful message" $ do
      env <- ask
      (ownerid, teamid) <- callCreateUserWithTeam
      ((^. idpId) -> idpid, (idpmeta, _)) <- registerTestIdPWithMeta ownerid
      newmember <-
        let perms = noPermissions
         in call $ createTeamMember (env ^. teBrig) (env ^. teGalley) teamid perms
      whichone (env ^. teSpar) (Just newmember) idpid idpmeta
        `shouldRespondWith` checkErrHspec 403 "insufficient-permissions"

-- Authenticate via sso, and assign owner status to the thus created user.  (This doesn't work
-- via the cookie, since we don't talk to nginz here, so we assume there is only one user in
-- the team, which is the original owner.)
mkSsoOwner :: UserId -> TeamId -> IdP -> SignPrivCreds -> TestSpar UserId
mkSsoOwner firstOwner tid idp privcreds = do
  spmeta <- getTestSPMetadata tid
  authnreq <- negotiateAuthnRequest idp
  authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp spmeta (Just authnreq) True
  loginresp <- submitAuthnResponse tid authnresp
  liftIO $ responseStatus loginresp `shouldBe` status200
  [ssoOwner] <- filter (/= firstOwner) <$> getTeamMemberIds firstOwner tid
  promoteTeamMember firstOwner tid ssoOwner
  pure ssoOwner

specCRUDIdentityProvider :: SpecWith TestEnv
specCRUDIdentityProvider = do
  describe "GET /identity-providers/:idp" $ do
    testGetPutDelete (\o t i _ -> callIdpGet' o t i)
    context "zuser has wrong team" $ do
      it "responds with 'insufficient permissions'" $ do
        env <- ask
        (ownerid, _teamid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid) <- registerTestIdP ownerid
        (uid, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
        callIdpGet' (env ^. teSpar) (Just uid) idpid
          `shouldRespondWith` checkErrHspec 403 "insufficient-permissions"
    context "known IdP, client is team owner" $ do
      it "responds with 2xx and IdP" $ do
        env <- ask
        (owner, _teamid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid) <- registerTestIdP owner
        void . call $ callIdpGet (env ^. teSpar) (Just owner) idpid
    context "known IdP, client is team owner (authenticated via sso, user without email)" $ do
      it "responds with 2xx and IdP" $ do
        env <- ask
        (firstOwner, tid) <- callCreateUserWithTeam
        (idp, (_, privcreds)) <- registerTestIdPWithMeta firstOwner
        ssoOwner <- mkSsoOwner firstOwner tid idp privcreds
        void . call $ callIdpGet (env ^. teSpar) (Just ssoOwner) (idp ^. idpId)
  describe "GET /identity-providers" $ do
    context "client is not team owner" $ do
      it "rejects" $ do
        env <- ask
        (_owner :: UserId, teamid :: TeamId) <-
          call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
        member :: UserId <-
          let perms = noPermissions
           in call $ createTeamMember (env ^. teBrig) (env ^. teGalley) teamid perms
        callIdpGetAll' (env ^. teSpar) (Just member)
          `shouldRespondWith` checkErrHspec 403 "insufficient-permissions"
    context "no idps registered" $ do
      context "client is team owner" $ do
        it "returns an empty list" $ do
          env <- ask
          (owner :: UserId, _teamid :: TeamId) <-
            call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
          callIdpGetAll (env ^. teSpar) (Just owner)
            `shouldRespondWith` (null . providers)
    context "some idps are registered" $ do
      context "client is team owner with email" $ do
        it "returns a non-empty empty list" $ do
          env <- ask
          (SampleIdP metadata _ _ _) <- makeSampleIdPMetadata
          (owner, _tid) <- callCreateUserWithTeam
          _ <- registerTestIdPFrom metadata (env ^. teMgr) owner (env ^. teSpar)
          callIdpGetAll (env ^. teSpar) (Just owner)
            `shouldRespondWith` (not . null . providers)
      context "client is team owner without email" $ do
        it "returns a non-empty empty list" $ do
          env <- ask
          (SampleIdP metadata privcreds _ _) <- makeSampleIdPMetadata
          (firstOwner, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
          idp <- registerTestIdPFrom metadata (env ^. teMgr) firstOwner (env ^. teSpar)
          ssoOwner <- mkSsoOwner firstOwner tid idp privcreds
          callIdpGetAll (env ^. teSpar) (Just ssoOwner)
            `shouldRespondWith` (not . null . providers)
  describe "DELETE /identity-providers/:idp" $ do
    testGetPutDelete (\o t i _ -> callIdpDelete' o t i)
    context "zuser has wrong team" $ do
      it "responds with 'no team member'" $ do
        env <- ask
        (owner, _tid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid) <- registerTestIdP owner
        (uid, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
        callIdpDelete' (env ^. teSpar) (Just uid) idpid
          `shouldRespondWith` checkErrHspec 403 "insufficient-permissions"
    context "zuser is admin resp. member" $ do
      it "responds 204 resp. 403" $ do
        env <- ask
        (owner, tid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid) <- registerTestIdP owner
        admin <- mkUser RoleAdmin env tid
        member <- mkUser RoleMember env tid
        callIdpDelete' (env ^. teSpar) (Just member) idpid
          `shouldRespondWith` checkErrHspec 403 "insufficient-permissions"
        callIdpDelete' (env ^. teSpar) (Just admin) idpid
          `shouldRespondWith` ((== 204) . statusCode)
    context "known IdP, IdP empty, client is team owner, without email" $ do
      it "responds with 2xx and removes IdP" $ do
        env <- ask
        (userid, _tid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid) <- registerTestIdP userid
        callIdpDelete' (env ^. teSpar) (Just userid) idpid
          `shouldRespondWith` \resp -> statusCode resp < 300
        callIdpGet' (env ^. teSpar) (Just userid) idpid
          `shouldRespondWith` checkErrHspec 404 "not-found"
        callIdpGetRaw' (env ^. teSpar) (Just userid) idpid
          `shouldRespondWith` checkErrHspec 404 "not-found"
    context "with email, idp non-empty, purge=false" $ do
      it "responds with 412 and does not remove IdP" $ do
        env <- ask
        (firstOwner, tid) <- callCreateUserWithTeam
        (idp, (_, privcreds)) <- registerTestIdPWithMeta firstOwner
        _ <- mkSsoOwner firstOwner tid idp privcreds
        callIdpDelete' (env ^. teSpar) (Just firstOwner) (idp ^. idpId)
          `shouldRespondWith` checkErrHspec 412 "idp-has-bound-users"
        callIdpGet' (env ^. teSpar) (Just firstOwner) (idp ^. idpId)
          `shouldRespondWith` \resp -> statusCode resp < 300
    context "with email, idp non-empty, purge=true" $ do
      it "responds with 2xx and removes IdP and users *synchronously*" $ do
        env <- ask
        (firstOwner, tid) <- callCreateUserWithTeam
        (idp, (_, privcreds)) <- registerTestIdPWithMeta firstOwner
        ssoOwner <- mkSsoOwner firstOwner tid idp privcreds
        callIdpDeletePurge' (env ^. teSpar) (Just firstOwner) (idp ^. idpId)
          `shouldRespondWith` \resp -> statusCode resp < 300
        _ <- aFewTimes (getUserBrig ssoOwner) isNothing
        ssoOwner' <- userId <$$> getUserBrig ssoOwner
        firstOwner' <- userId <$$> getUserBrig firstOwner
        liftIO $ do
          ssoOwner' `shouldBe` Nothing
          firstOwner' `shouldBe` Just firstOwner
        callIdpGet' (env ^. teSpar) (Just firstOwner) (idp ^. idpId)
          `shouldRespondWith` checkErrHspec 404 "not-found"
    context "with email, user who tries to delete is authenticated by the IdP, purge=true" $ do
      it "responds with 409 'cannot-delete-own-idp'" $ do
        env <- ask
        (firstOwner, tid) <- callCreateUserWithTeam
        (idp, (_, privcreds)) <- registerTestIdPWithMeta firstOwner
        ssoOwner <- mkSsoOwner firstOwner tid idp privcreds
        callIdpDeletePurge' (env ^. teSpar) (Just ssoOwner) (idp ^. idpId)
          `shouldRespondWith` checkErrHspec 409 "cannot-delete-own-idp"

  describe "PUT /identity-providers/:idp" $ do
    testGetPutDelete callIdpUpdate
    context "known IdP, client is team owner" $ do
      it "responds with 2xx and updates IdP" $ do
        env <- ask
        (owner, _tid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid, (IdPMetadataValue _ idpmeta, _)) <- registerTestIdPWithMeta owner
        (_, _, cert1) <- liftIO $ mkSignCredsWithCert Nothing 96
        (_, _, cert2) <- liftIO $ mkSignCredsWithCert Nothing 96
        let idpmeta' = idpmeta & edCertAuthnResponse .~ (cert1 :| [cert2])
        callIdpUpdate (env ^. teSpar) (Just owner) idpid (IdPMetadataValue (cs $ SAML.encode idpmeta') undefined)
          `shouldRespondWith` ((== 200) . statusCode)
        callIdpGet (env ^. teSpar) (Just owner) idpid
          `shouldRespondWith` ((== idpmeta') . view idpMetadata)
      it "updates the handle" $ do
        env <- ask
        (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
        (SampleIdP metadata _ _ _) <- makeSampleIdPMetadata
        idp <- call $ callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner) metadata
        callIdpGet (env ^. teSpar) (Just owner) (idp ^. idpId)
          `shouldRespondWith` ((== IdPHandle "IdP 1") . (\idp' -> idp' ^. (SAML.idpExtraInfo . handle)))
        let expected = IdPHandle "kukku mukku"
        callIdpUpdateWithHandle (env ^. teSpar) (Just owner) (idp ^. idpId) (IdPMetadataValue (cs $ SAML.encode metadata) undefined) expected
          `shouldRespondWith` ((== 200) . statusCode)
        callIdpGet (env ^. teSpar) (Just owner) (idp ^. idpId)
          `shouldRespondWith` ((== expected) . (\idp' -> idp' ^. (SAML.idpExtraInfo . handle)))
      it "updates IdP metadata and creates a new IdP with the first metadata" $ do
        env <- ask
        (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
        -- create new idp
        (SampleIdP metadata1 _ _ _) <- makeSampleIdPMetadata
        idp1 <- call $ callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner) metadata1
        -- update the idp metadata
        (SampleIdP metadata2 _ _ _) <- makeSampleIdPMetadata
        callIdpUpdate (env ^. teSpar) (Just owner) (idp1 ^. idpId) (IdPMetadataValue (cs $ SAML.encode metadata2) undefined)
          `shouldRespondWith` ((== 200) . statusCode)
        -- create a new idp with the first metadata (should succeed)
        callIdpCreate' (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner) metadata1
          `shouldRespondWith` ((== 201) . statusCode)

      context "invalid body" $ do
        it "rejects" $ do
          env <- ask
          (owner, _tid) <- callCreateUserWithTeam
          ((^. idpId) -> idpid) <- registerTestIdP owner
          callIdpUpdate (env ^. teSpar) (Just owner) idpid (IdPMetadataValue "<NotSAML>bloo</NotSAML>" undefined)
            `shouldRespondWith` checkErrHspec 400 "invalid-metadata"
    describe "issuer changed to one that already exists in *another* team" $ do
      it "rejects if V1, succeeds if V2" $ do
        env <- ask
        (owner1, _tid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid1) <- registerTestIdP owner1
        (owner2, _tid) <- callCreateUserWithTeam
        (_, (IdPMetadataValue _ idpmeta2, _)) <- registerTestIdPWithMeta owner2
        callIdpUpdate (env ^. teSpar) (Just owner1) idpid1 (IdPMetadataValue (cs $ SAML.encode idpmeta2) undefined)
          `shouldRespondWith` ( case env ^. teWireIdPAPIVersion of
                                  WireIdPAPIV1 -> checkErrHspec 400 "idp-issuer-in-use"
                                  WireIdPAPIV2 -> (== 200) . statusCode
                              )
    describe "issuer changed to one that already exists in *the same* team" $ do
      it "rejects" $ do
        env <- ask
        (owner1, _tid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid1, (IdPMetadataValue _ idpmeta1, _)) <- registerTestIdPWithMeta owner1
        (SampleIdP idpmeta2 _ _ _) <- makeSampleIdPMetadata
        _ <- call $ callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner1) idpmeta2
        let idpmeta1' = idpmeta1 & edIssuer .~ (idpmeta2 ^. edIssuer)

        -- An IdP is unambiguously identified by teamid plus issuer, so a team cannot have
        -- multiple IdPs with the same issuer, regardless of the API version.
        callIdpUpdate (env ^. teSpar) (Just owner1) idpid1 (IdPMetadataValue (cs $ SAML.encode idpmeta1') undefined)
          `shouldRespondWith` checkErrHspec 400 "idp-issuer-in-use"
    describe "issuer changed to one that already existed in the same team in the past (but has been updated away)" $ do
      it "changes back to the old one and keeps the new in the `old_issuers` list." $ do
        env <- ask
        (owner1, _tid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid1, (IdPMetadataValue _ idpmeta1, _)) <- registerTestIdPWithMeta owner1
        idpmeta1' <- do
          (SampleIdP idpmeta2 _ _ _) <- makeSampleIdPMetadata
          pure $ idpmeta1 & edIssuer .~ (idpmeta2 ^. edIssuer)
        idpmeta1'' <- do
          (SampleIdP idpmeta3 _ _ _) <- makeSampleIdPMetadata
          pure $ idpmeta1 & edIssuer .~ (idpmeta3 ^. edIssuer)

        do
          idp <- runSpar $ IdPEffect.getConfig idpid1
          liftIO $ do
            (idp ^. idpMetadata . edIssuer) `shouldBe` (idpmeta1 ^. edIssuer)
            (idp ^. idpExtraInfo . oldIssuers) `shouldBe` []
            (idp ^. idpExtraInfo . replacedBy) `shouldBe` Nothing

        let -- change idp metadata (only issuer, to be precise), and look at new issuer and
            -- old issuers.
            change :: SAML.IdPMetadata -> [SAML.IdPMetadata] -> TestSpar ()
            change new olds = do
              resp <- call $ callIdpUpdate (env ^. teSpar) (Just owner1) idpid1 (IdPMetadataValue (cs $ SAML.encode new) undefined)
              liftIO $ statusCode resp `shouldBe` 200

              idp <- runSpar $ IdPEffect.getConfig idpid1
              liftIO $ do
                (idp ^. idpMetadata . edIssuer) `shouldBe` (new ^. edIssuer)
                sort (idp ^. idpExtraInfo . oldIssuers) `shouldBe` sort (olds <&> (^. edIssuer))
                (idp ^. idpExtraInfo . replacedBy) `shouldBe` Nothing

        -- update the name a few times, ending up with the original one.
        change idpmeta1' [idpmeta1]
        change idpmeta1'' [idpmeta1, idpmeta1']
        -- change it back to the original one. in this case the original issuer should be removed from old issuers
        change idpmeta1 [idpmeta1', idpmeta1'']

    describe "issuer changed to one that is new" $ do
      it "updates old idp, updating both issuer and old_issuers" $ do
        env <- ask
        (owner1, _tid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid1, (IdPMetadataValue _ idpmeta1, _)) <- registerTestIdPWithMeta owner1
        issuer2 <- makeIssuer
        resp <-
          let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
              metadata2 = IdPMetadataValue (cs $ SAML.encode idpmeta2) undefined
           in call $ callIdpUpdate (env ^. teSpar) (Just owner1) idpid1 metadata2
        let idp :: IdP = responseJsonUnsafe resp
        liftIO $ do
          statusCode resp `shouldBe` 200
          idp ^. idpMetadata . edIssuer `shouldBe` issuer2
          idp ^. idpExtraInfo . oldIssuers `shouldBe` [idpmeta1 ^. edIssuer]
      it "migrates old users to new idp on their next login (auto-prov)" $ do
        env <- ask
        (owner1, _tid) <- callCreateUserWithTeam
        (idp1@((^. idpId) -> idpid1), (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta owner1
        issuer2 <- makeIssuer
        let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
            privkey2 = privkey1
            idp2 = idp1 & SAML.idpMetadata .~ idpmeta2
        let userSubject = SAML.unspecifiedNameID "bloob"
        olduref <- tryLogin privkey1 idp1 userSubject
        getUserIdViaRef' olduref >>= \es -> liftIO $ es `shouldSatisfy` isJust
        _ <-
          let metadata2 = IdPMetadataValue (cs $ SAML.encode idpmeta2) undefined
           in call $ callIdpUpdate (env ^. teSpar) (Just owner1) idpid1 metadata2
        getUserIdViaRef' olduref >>= \es -> liftIO $ es `shouldSatisfy` isJust
        newuref <- tryLogin privkey2 idp2 userSubject
        getUserIdViaRef' olduref >>= \es -> liftIO $ es `shouldBe` Nothing
        getUserIdViaRef' newuref >>= \es -> liftIO $ es `shouldSatisfy` isJust

      it "migrates old users to new idp on their next login (scim)" $ do
        -- even scim users are automatically updated to a changed IdP issuer.  (this is for
        -- high-availability; otherwise we could also require the scim peer to push the
        -- update, and block the old users from logging in until then.)
        env <- ask
        (tok, (owner1, _, idp1@((^. idpId) -> idpid1), (IdPMetadataValue _ idpmeta1, privkey1))) <- ScimT.registerIdPAndScimTokenWithMeta
        issuer2 <- makeIssuer
        let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
            privkey2 = privkey1
            idp2 = idp1 & SAML.idpMetadata .~ idpmeta2
        let userSubject = SAML.unspecifiedNameID extId
            extId = "bloob"
        void $ do
          -- provision scim user (this is the difference to the above test case)
          scimusr <- ScimT.randomScimUser
          ScimT.createUser tok (scimusr {Scim.externalId = Just extId})
        olduref <- tryLogin privkey1 idp1 userSubject
        getUserIdViaRef' olduref >>= \es -> liftIO $ es `shouldSatisfy` isJust
        _ <-
          let metadata2 = IdPMetadataValue (cs $ SAML.encode idpmeta2) undefined
           in call $ callIdpUpdate (env ^. teSpar) (Just owner1) idpid1 metadata2
        getUserIdViaRef' olduref >>= \es -> liftIO $ es `shouldSatisfy` isJust
        newuref <- tryLogin privkey2 idp2 userSubject
        getUserIdViaRef' olduref >>= \es -> liftIO $ es `shouldBe` Nothing
        getUserIdViaRef' newuref >>= \es -> liftIO $ es `shouldSatisfy` isJust

      it "creates non-existent users" $ do
        env <- ask
        (owner1, _tid) <- callCreateUserWithTeam
        (idp1@((^. idpId) -> idpid1), (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta owner1
        issuer2 <- makeIssuer
        let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
            privkey2 = privkey1
            idp2 = idp1 & SAML.idpMetadata .~ idpmeta2
        _ <-
          let metadata2 = IdPMetadataValue (cs $ SAML.encode idpmeta2) undefined
           in call $ callIdpUpdate (env ^. teSpar) (Just owner1) idpid1 metadata2
        userSubject <- SAML.unspecifiedNameID . UUID.toText <$> liftIO UUID.nextRandom
        newuref <- tryLogin privkey2 idp2 userSubject
        getUserIdViaRef' newuref >>= \es -> liftIO $ es `shouldSatisfy` isJust
      it "logs in users that have already been moved or created in the new idp" $ do
        env <- ask
        (owner1, _tid) <- callCreateUserWithTeam
        (idp1@((^. idpId) -> idpid1), (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta owner1
        issuer2 <- makeIssuer
        let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
            privkey2 = privkey1
            idp2 = idp1 & SAML.idpMetadata .~ idpmeta2
        _ <-
          let metadata2 = IdPMetadataValue (cs $ SAML.encode idpmeta2) undefined
           in call $ callIdpUpdate (env ^. teSpar) (Just owner1) idpid1 metadata2
        let userSubject = SAML.unspecifiedNameID "bloob"
        newuref <- tryLogin privkey2 idp2 userSubject
        newuref' <- tryLogin privkey2 idp2 userSubject
        liftIO $ newuref `shouldBe` newuref'
    describe "new request uri" $ do
      it "uses it on next auth handshake" $ do
        env <- ask
        (owner, _tid) <- callCreateUserWithTeam
        ((^. idpId) -> idpid, (IdPMetadataValue _ idpmeta, _)) <- registerTestIdPWithMeta owner
        let idpmeta' = idpmeta & edRequestURI .~ [uri|https://www.example.com|]
        callIdpUpdate (env ^. teSpar) (Just owner) idpid (IdPMetadataValue (cs $ SAML.encode idpmeta') undefined)
          `shouldRespondWith` ((== 200) . statusCode)
        (requri, _) <- call $ callAuthnReq (env ^. teSpar) idpid
        liftIO $ requri `shouldBe` idpmeta' ^. edRequestURI
    describe "new certs" $ do
      let -- Create a team, idp, and update idp with 'sampleIdPCert2'.
          initidp :: (HasCallStack) => TestSpar (IdP, SignPrivCreds, SignPrivCreds)
          initidp = do
            env <- ask
            (owner, _tid) <- callCreateUserWithTeam
            (idp, (IdPMetadataValue _ idpmeta, oldPrivKey)) <- registerTestIdPWithMeta owner
            (SampleIdP _ newPrivKey _ sampleIdPCert2) <- makeSampleIdPMetadata
            let idpmeta' = idpmeta & edCertAuthnResponse .~ (NonEmpty.singleton sampleIdPCert2)
            callIdpUpdate (env ^. teSpar) (Just owner) (idp ^. idpId) (IdPMetadataValue (cs $ SAML.encode idpmeta') undefined)
              `shouldRespondWith` ((== 200) . statusCode)
            pure (idp, oldPrivKey, newPrivKey)
          -- Sign authn response with a given private key (which may be the one matching
          -- 'sampleIdPCert2' or not), and check the status of spars response.
          check :: (HasCallStack) => Bool -> Int -> String -> Either String () -> TestSpar ()
          check useNewPrivKey expectedStatus expectedHtmlTitle expectedCookie = do
            (idp, oldPrivKey, newPrivKey) <- initidp
            let tid = idp ^. idpExtraInfo . team
            env <- ask
            (_, authnreq) <- call $ callAuthnReq (env ^. teSpar) (idp ^. idpId)
            spmeta <- getTestSPMetadata tid
            let privkey = if useNewPrivKey then newPrivKey else oldPrivKey
            idpresp <- runSimpleSP $ mkAuthnResponse privkey idp spmeta (Just authnreq) True
            sparresp <- submitAuthnResponse tid idpresp
            liftIO $ do
              statusCode sparresp `shouldBe` expectedStatus
              let bdy = maybe "" (cs @LByteString @String) (responseBody sparresp)
              bdy `shouldContain` expectedHtmlTitle
              hasPersistentCookieHeader sparresp `shouldBe` expectedCookie
      it "uses those certs on next auth handshake" $ do
        check
          True
          200
          "<title>wire:sso:success</title>"
          (Right ())
      it "removes all old certs (even if there were more before)" $ do
        check
          False
          400
          "<title>wire:sso:error:bad-response-signature</title>"
          (Left "no set-cookie header")
  describe "POST /identity-providers" $ do
    context "sso disabled for team" $ do
      it "responds with 403 forbidden" $ do
        env <- ask
        (uid, _tid) <- call $ createUserWithTeamDisableSSO (env ^. teBrig) (env ^. teGalley)
        (SampleIdP metadata _ _ _) <- makeSampleIdPMetadata
        callIdpCreate' (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just uid) metadata
          `shouldRespondWith` checkErrHspec 403 "sso-disabled"
    context "bad xml" $ do
      it "responds with a 'client error'" $ do
        env <- ask
        (_owner, tid) <- callCreateUserWithTeam
        admin <- mkUser RoleAdmin env tid
        callIdpCreateRaw' (env ^. teSpar) (Just admin) "application/xml" "@@ bad xml ###"
          `shouldRespondWith` checkErrHspec 400 "invalid-metadata"
    context "no zuser" $ do
      it "responds with 'client error'" $ do
        env <- ask
        (SampleIdP idpmeta _ _ _) <- makeSampleIdPMetadata
        callIdpCreate' (env ^. teWireIdPAPIVersion) (env ^. teSpar) Nothing idpmeta
          `shouldRespondWith` checkErrHspec 400 "client-error"
    context "zuser has no team" $ do
      it "responds with 'no team member'" $ do
        env <- ask
        uid <- call $ userId <$> randomUser (env ^. teBrig)
        (SampleIdP idpmeta _ _ _) <- makeSampleIdPMetadata
        callIdpCreate' (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just uid) idpmeta
          `shouldRespondWith` checkErrHspec 403 "insufficient-permissions"
    context "zuser is a team member, but not a team owner" $ do
      it "responds with 'insufficient-permissions' and a helpful message" $ do
        env <- ask
        (owner, tid) <- callCreateUserWithTeam
        idp <- registerTestIdP owner
        newmember <-
          let perms = noPermissions
           in call $ createTeamMember (env ^. teBrig) (env ^. teGalley) tid perms
        callIdpCreate' (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just newmember) (idp ^. idpMetadata)
          `shouldRespondWith` checkErrHspec 403 "insufficient-permissions"
    context "idp (identified by issuer) is in use by other team" $ do
      it "rejects" $ do
        env <- ask
        (SampleIdP newMetadata _ _ _) <- makeSampleIdPMetadata
        (uid1, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
        (uid2, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
        -- first idp
        resp1 <- call $ callIdpCreate' (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just uid1) newMetadata
        -- same idp issuer, same team
        resp2 <- call $ callIdpCreate' (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just uid1) newMetadata
        -- same idp issuer, different team
        resp3 <- call $ callIdpCreate' (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just uid2) newMetadata
        liftIO $ do
          statusCode resp1 `shouldBe` 201
          do
            -- always fail if we're trying same (SP entityID, IdP entityID, team)
            statusCode resp2 `shouldBe` 400
            responseJsonEither resp2 `shouldBe` Right (TestErrorLabel "idp-already-in-use")
          case env ^. teWireIdPAPIVersion of
            -- fail in the old api only if we're trying same (SP entityID, IdP entityID) on different teams
            WireIdPAPIV1 -> do
              statusCode resp3 `shouldBe` 400
              responseJsonEither resp3 `shouldBe` Right (TestErrorLabel "idp-already-in-use")
            WireIdPAPIV2 -> do
              statusCode resp3 `shouldBe` 201
    context "client is owner with email" $ do
      it "responds with 2xx; makes IdP available for GET /identity-providers/" $ do
        env <- ask
        (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
        (SampleIdP metadata _ _ _) <- makeSampleIdPMetadata
        idp <- call $ callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner) metadata
        idp' <- call $ callIdpGet (env ^. teSpar) (Just owner) (idp ^. idpId)
        rawmeta <- call $ callIdpGetRaw (env ^. teSpar) (Just owner) (idp ^. idpId)
        liftIO $ do
          idp `shouldBe` idp'
          let prefix = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><EntityDescriptor xmlns:samlp=\"urn:oasis:names:tc:SAML:2.0:protocol\" xmlns:samla=\"urn:oasis:names"
          ST.take (ST.length prefix) rawmeta `shouldBe` prefix
      it "first IdP gets handle 'IdP 1', second gets 'IdP 2'" $ do
        env <- ask
        (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
        (SampleIdP metadata1 _ _ _) <- makeSampleIdPMetadata
        (SampleIdP metadata2 _ _ _) <- makeSampleIdPMetadata
        idp1 <- call $ callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner) metadata1
        idp2 <- call $ callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner) metadata2
        idp1' <- call $ callIdpGet (env ^. teSpar) (Just owner) (idp1 ^. idpId)
        idp2' <- call $ callIdpGet (env ^. teSpar) (Just owner) (idp2 ^. idpId)
        liftIO $ do
          idp1 `shouldBe` idp1'
          idp2 `shouldBe` idp2'
          (idp1 ^. (SAML.idpExtraInfo . handle)) `shouldBe` IdPHandle "IdP 1"
          (idp2 ^. (SAML.idpExtraInfo . handle)) `shouldBe` IdPHandle "IdP 2"
      it "explicitly set handle on IdP create" $ do
        env <- ask
        (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
        (SampleIdP metadata _ _ _) <- makeSampleIdPMetadata
        let expected = IdPHandle "kukku mukku"
        actual <- (\idp -> idp ^. (SAML.idpExtraInfo . handle)) <$> call (callIdpCreateWithHandle (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner) metadata expected)
        liftIO $ actual `shouldBe` expected
    context "client is owner without email" $ do
      it "responds with 2xx; makes IdP available for GET /identity-providers/" $ do
        pending
    describe "with json body" $ do
      context "bad json" $ do
        it "responds with a 'client error'" $ do
          env <- ask
          (_owner, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
          admin <- mkUser RoleAdmin env tid
          callIdpCreateRaw' (env ^. teSpar) (Just admin) "application/json" "@@ bad json ###"
            `shouldRespondWith` checkErrHspec 400 "invalid-metadata"
      context "good json" $ do
        it "responds with 2xx; makes IdP available for GET /identity-providers/" $ do
          env <- ask
          (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
          metadata <- Aeson.encode . IdPMetadataValue mempty . sampleIdPMetadata <$> makeSampleIdPMetadata
          idp <- call $ callIdpCreateRaw (env ^. teSpar) (Just owner) "application/json" metadata
          idp' <- call $ callIdpGet (env ^. teSpar) (Just owner) (idp ^. idpId)
          rawmeta <- call $ callIdpGetRaw (env ^. teSpar) (Just owner) (idp ^. idpId)
          liftIO $ do
            idp `shouldBe` idp'
            let prefix = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><EntityDescriptor xmlns:samlp=\"urn:oasis:names:tc:SAML:2.0:protocol\" xmlns:samla=\"urn:oasis:names"
            ST.take (ST.length prefix) rawmeta `shouldBe` prefix

    describe "replaces an existing idp"
      $ forM_
        [ (u, e)
        | u <- [False, True], -- do we use update-by-put or update-by-post?  (see below)
          e <- [False, True] -- is the externalId an email address?  (if not, it's a uuidv4, and the email address is stored in `emails`)
        ]
      $ \(updateNotReplace, externalIdIsEmail) -> do
        let updateOrReplaceIdps :: (UserId, IdP, SAML.IdPMetadata) -> TestSpar ()
            updateOrReplaceIdps (owner1, idp1, idpmeta1) = do
              env <- ask
              issuer2 <- makeIssuer
              idp2 <- do
                let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
                 in call $
                      -- There are two mechanisms for re-aligning your team when your IdP metadata
                      -- has changed: POST (create a new one, and mark it as replacing the old one),
                      -- and PUT (updating the existing IdP's metadata).  The reason for having two
                      -- ways to do this has been lost in history, but we're testing both here.
                      --
                      -- FUTUREWORK: deprecate POST!
                      if updateNotReplace
                        then callIdpUpdate' (env ^. teSpar) (Just owner1) (idp1 ^. SAML.idpId) (idPMetadataToInfo idpmeta2)
                        else callIdpCreateReplace (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner1) idpmeta2 (idp1 ^. SAML.idpId)

              idp1' <- call $ callIdpGet (env ^. teSpar) (Just owner1) (idp1 ^. SAML.idpId)
              idp2' <- call $ callIdpGet (env ^. teSpar) (Just owner1) (idp2 ^. SAML.idpId)
              liftIO $ do
                let updateIdp1 = updateCurrentIssuer . updateOldIssuers
                      where
                        updateCurrentIssuer = idpMetadata . edIssuer .~ (idp2' ^. idpMetadata . edIssuer)
                        updateOldIssuers = idpExtraInfo . oldIssuers .~ [idp1 ^. idpMetadata . edIssuer]
                    replaceIdp1 =
                      idpExtraInfo . replacedBy .~ idp1' ^. idpExtraInfo . replacedBy
                 in idp1' `shouldBe` (idp1 & if updateNotReplace then updateIdp1 else replaceIdp1)

                idp2' `shouldBe` idp2
                idp1 ^. idpMetadata . SAML.edIssuer `shouldBe` (idpmeta1 ^. SAML.edIssuer)
                idp2 ^. idpMetadata . SAML.edIssuer `shouldBe` issuer2

                if updateNotReplace
                  then idp2 ^. idpId `shouldBe` idp1 ^. idpId
                  else idp2 ^. idpId `shouldNotBe` idp1 ^. idpId

                idp2 ^. idpExtraInfo . oldIssuers `shouldBe` [idpmeta1 ^. edIssuer]
                idp1' ^. idpExtraInfo . replacedBy `shouldBe` if updateNotReplace then Nothing else Just (idp2 ^. idpId)

                -- erase everything that is supposed to be different between idp1, idp2, and make
                -- sure the result is equal.
                let erase :: IdP -> IdP
                    erase =
                      (idpId .~ (idp1 ^. idpId))
                        . (idpMetadata . edIssuer .~ (idp1 ^. idpMetadata . edIssuer))
                        . (idpExtraInfo . oldIssuers .~ (idp1 ^. idpExtraInfo . oldIssuers))
                        . (idpExtraInfo . replacedBy .~ (idp1 ^. idpExtraInfo . replacedBy))
                        . (idpExtraInfo . handle .~ (idp1 ^. idpExtraInfo . handle))
                 in erase idp1 `shouldBe` erase idp2

        -- scim doesn't work with more than one idp, so we can't test the post variant
        -- that creates a second idp (https://wearezeta.atlassian.net/browse/WPB-689)
        when updateNotReplace . it ("creates new idp, setting old_issuer; sets replaced_by in old idp; scim user search still works: provisionViaScim=True, updateNotReplace=" <> show updateNotReplace <> ", externalIdIsEmail=" <> show externalIdIsEmail) $ do
          (owner1, teamid) <- callCreateUserWithTeam
          (idp1, (IdPMetadataValue _ idpmeta1, _)) <- registerTestIdPWithMeta owner1
          let idp1id = idp1 ^. idpId

          tok <- registerScimToken teamid (Just idp1id)
          scimUser <-
            if externalIdIsEmail
              then fst <$> randomScimUserWithEmail
              else fst <$> randomScimUserWithNick
          scimStoredUser <- createUser tok scimUser

          let checkScimSearch ::
                (HasCallStack) =>
                Scim.StoredUser SparTag ->
                Scim.User SparTag ->
                ReaderT TestEnv IO ()
              checkScimSearch target searchKeys = do
                let Just externalId = Scim.externalId searchKeys
                    handle' = Scim.userName searchKeys
                respId <- listUsers tok (Just (filterBy "externalId" externalId))
                respHandle <- listUsers tok (Just (filterBy "userName" handle'))
                liftIO $ do
                  let patched = case target of
                        Scim.WithMeta _m (Scim.WithId i u) ->
                          let u' :: Scim.User SparTag
                              u' = case emailAddress (cs externalId) of
                                -- if the externalId is an email, and the email field was
                                -- empty, the scim response from spar contains the externalId
                                -- (parsed) in the emails field.
                                Just e -> u {Scim.emails = [Scim.Email Nothing (Scim.EmailAddress e) Nothing]}
                                Nothing -> u
                           in -- don't compare meta, or you need to update the ETag in version because email may have changed.
                              Scim.WithId i u'
                  (Scim.thing <$> respId) `shouldBe` [patched]
                  (Scim.thing <$> respHandle) `shouldBe` [patched]

          checkScimSearch scimStoredUser scimUser
          updateOrReplaceIdps (owner1, idp1, idpmeta1)
          checkScimSearch scimStoredUser scimUser

        it ("creates new idp, setting old_issuer; sets replaced_by in old idp; scim user search still works: provisionViaScim=False, updateNotReplace=" <> show updateNotReplace <> ", externalIdIsEmail=" <> show externalIdIsEmail) $ do
          (owner1, teamid) <- callCreateUserWithTeam
          (idp1, (IdPMetadataValue _ idpmeta1, privcreds)) <- registerTestIdPWithMeta owner1
          let idp1id = idp1 ^. idpId

          (uid, mbEmail, hdl) :: (UserId, Maybe Text, Text) <- do
            spmeta <- getTestSPMetadata teamid
            authnreq <- negotiateAuthnRequest idp1
            authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp1 spmeta (Just authnreq) True
            sparresp <- submitAuthnResponse teamid authnresp
            liftIO $ statusCode sparresp `shouldBe` 200
            ssoid <- getSsoidViaAuthResp authnresp
            Just uid <- ssoToUidSpar teamid ssoid
            setRandomHandleBrig uid
            Just usr <- getUserBrig uid
            let eml = fromEmail <$> (emailIdentity =<< userIdentity usr)
                Just hdl = fromHandle <$> userHandle usr
            pure (uid, eml, hdl)

          -- if user is created via saml, don't call checkScimSearch here until we have
          -- updated the idp; otherwise, the interesting second call would only find a
          -- scim-imported user and this test would be redundant..
          updateOrReplaceIdps (owner1, idp1, idpmeta1)

          -- checkScimSearch
          tok <- registerScimToken teamid (Just idp1id)
          respHandle <- listUsers tok (Just (filterBy "userName" hdl))
          liftIO $ ((Scim.id . Scim.thing) <$> respHandle) `shouldBe` [uid]
          (`mapM_` mbEmail) $ \eml -> do
            respId <- listUsers tok (Just (filterBy "externalId" eml))
            liftIO $ ((Scim.id . Scim.thing) <$> respId) `shouldBe` [uid]

    describe "replaces an existing idp (cont.)" $ do
      it "users can still login on old idp as before" $ do
        env <- ask
        (owner1, _teamid) <- callCreateUserWithTeam
        (idp1, (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta owner1
        let userSubject = SAML.unspecifiedNameID "bloob"
            issuer1 = idpmeta1 ^. edIssuer
        olduref <- tryLogin privkey1 idp1 userSubject
        olduid <- getUserIdViaRef' olduref
        issuer2 <- makeIssuer
        _ <-
          let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
           in call $ callIdpCreateReplace (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner1) idpmeta2 (idp1 ^. SAML.idpId)
        newuref <- tryLogin privkey1 idp1 userSubject
        newuid <- getUserIdViaRef' newuref
        liftIO $ do
          olduid `shouldSatisfy` isJust
          olduid `shouldBe` newuid
          (olduref ^. SAML.uidTenant) `shouldBe` issuer1
          (newuref ^. SAML.uidTenant) `shouldBe` issuer1

      it "migrates old users to new idp on their next login on new idp; after that, login on old won't work any more" $ do
        env <- ask
        (owner1, _teamid) <- callCreateUserWithTeam
        (idp1, (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta owner1
        let userSubject = SAML.unspecifiedNameID "bloob"
            issuer1 = idpmeta1 ^. edIssuer
            privkey2 = privkey1
        olduref <- tryLogin privkey1 idp1 userSubject
        olduid <- getUserIdViaRef' olduref
        issuer2 <- makeIssuer
        idp2 <-
          let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
           in call $ callIdpCreateReplace (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner1) idpmeta2 (idp1 ^. SAML.idpId)
        newuref <- tryLogin privkey2 idp2 userSubject
        newuid <- getUserIdViaRef' newuref
        liftIO $ do
          olduid `shouldSatisfy` isJust
          olduid `shouldBe` newuid
          (olduref ^. SAML.uidTenant) `shouldBe` issuer1
          (newuref ^. SAML.uidTenant) `shouldBe` issuer2
        tryLoginFail privkey1 idp1 userSubject "cannont-provision-on-replaced-idp"

      it "creates non-existent users on new idp" $ do
        env <- ask
        (owner1, _teamid) <- callCreateUserWithTeam
        (idp1, (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta owner1
        let userSubject = SAML.unspecifiedNameID "bloob"
            privkey2 = privkey1
        issuer2 <- makeIssuer
        idp2 <-
          let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
           in call $ callIdpCreateReplace (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner1) idpmeta2 (idp1 ^. SAML.idpId)
        newuref <- tryLogin privkey2 idp2 userSubject
        newuid <- getUserIdViaRef' newuref
        liftIO $ do
          newuid `shouldSatisfy` isJust
          (newuref ^. SAML.uidTenant) `shouldBe` issuer2

specDeleteCornerCases :: SpecWith TestEnv
specDeleteCornerCases = describe "delete corner cases" $ do
  it "deleting the replacing idp2 before it has users does not block logins on idp1" $ do
    env <- ask
    (owner1, _teamid) <- callCreateUserWithTeam
    (idp1, (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta owner1
    let issuer1 = idpmeta1 ^. edIssuer
    issuer2 <- makeIssuer
    let userSubject = SAML.unspecifiedNameID "bloob"
    uref <- tryLogin privkey1 idp1 userSubject
    uid <- getUserIdViaRef' uref
    liftIO $ do
      uid `shouldSatisfy` isJust
      uref `shouldBe` SAML.UserRef issuer1 userSubject
    idp2 <-
      let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
       in call $ callIdpCreateReplace (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner1) idpmeta2 (idp1 ^. SAML.idpId)
    call $ callIdpDelete (env ^. teSpar) (pure owner1) (idp2 ^. idpId)
    uref' <- tryLogin privkey1 idp1 userSubject
    uid' <- getUserIdViaRef' uref'
    liftIO $ do
      uid' `shouldBe` uid
      uref' `shouldBe` SAML.UserRef issuer1 userSubject
  it "deleting the replacing idp2 before it has users does not block registrations on idp1" $ do
    env <- ask
    (owner1, _teamid) <- callCreateUserWithTeam
    (idp1, (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta owner1
    let issuer1 = idpmeta1 ^. edIssuer
    issuer2 <- makeIssuer
    idp2 <-
      let idpmeta2 = idpmeta1 & edIssuer .~ issuer2
       in call $ callIdpCreateReplace (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner1) idpmeta2 (idp1 ^. SAML.idpId)
    call $ callIdpDelete (env ^. teSpar) (pure owner1) (idp2 ^. idpId)
    let userSubject = SAML.unspecifiedNameID "bloob"
    uref <- tryLogin privkey1 idp1 userSubject
    uid <- getUserIdViaRef' uref
    liftIO $ do
      uid `shouldSatisfy` isJust
      uref `shouldBe` SAML.UserRef issuer1 userSubject
  it "create user1 via idp1 (saml); delete user1; create user via newly created idp2 (saml)" $ do
    pending
  it "create user1 via saml; delete user1; create via scim (in same team)" $ do
    pending
  it "create user1 via saml; delete user1; create via password (outside team)" $ do
    pending
  it "delete idp; create idp with same issuer id" $ do
    pending
  -- clone of 'testScimCreateVsUserRef', without the scim part: Create a user implicitly via
  -- saml login; remove it via brig leaving a dangling entry in @spar.user@; create it via saml
  -- login once more.  This should work despite the dangling database entry.
  it "re-create previously deleted, dangling users" $ do
    -- TODO: https://github.com/zinfra/backend-issues/issues/1200
    (owner, _teamid) <- callCreateUserWithTeam
    (idp, (_, privcreds)) <- registerTestIdPWithMeta owner
    uname :: SAML.UnqualifiedNameID <- do
      suffix <- cs <$> replicateM 7 (getRandomR ('0', '9'))
      either (error . show) pure $
        SAML.mkUNameIDEmail ("email_" <> suffix <> "@example.com")
    let uref = SAML.UserRef tenant subj
        subj = either (error . show) id $ SAML.mkNameID uname Nothing Nothing Nothing
        tenant = idp ^. SAML.idpMetadata . SAML.edIssuer
    (Just !uid) <- createViaSaml idp privcreds uref
    samlUserShouldSatisfy uref isJust
    deleteViaBrig uid
    samlUserShouldSatisfy uref isJust -- brig doesn't talk to spar right now when users
    -- are deleted there.  we need to work around this
    -- fact for now.  (if the test fails here, this may
    -- mean that you fixed the behavior and can
    -- change this to 'isNothing'.)
    (Just _) <- createViaSaml idp privcreds uref
    samlUserShouldSatisfy uref isJust
  where
    samlUserShouldSatisfy :: (HasCallStack) => SAML.UserRef -> (Maybe UserId -> Bool) -> TestSpar ()
    samlUserShouldSatisfy uref property = do
      muid <- getUserIdViaRef' uref
      liftIO $ muid `shouldSatisfy` property

    createViaSamlResp :: (HasCallStack) => IdP -> SignPrivCreds -> SAML.UserRef -> TestSpar ResponseLBS
    createViaSamlResp idp privCreds (SAML.UserRef _ subj) = do
      let tid = idp ^. idpExtraInfo . team
      authnReq <- negotiateAuthnRequest idp
      spmeta <- getTestSPMetadata tid
      authnResp <- runSimpleSP $ mkAuthnResponseWithSubj subj privCreds idp spmeta (Just authnReq) True
      createResp <- submitAuthnResponse tid authnResp
      liftIO $ responseStatus createResp `shouldBe` status200
      pure createResp

    createViaSaml :: (HasCallStack) => IdP -> SignPrivCreds -> SAML.UserRef -> TestSpar (Maybe UserId)
    createViaSaml idp privcreds uref = do
      resp <- createViaSamlResp idp privcreds uref
      liftIO $ do
        maybe (error "no body") cs (responseBody resp)
          `shouldContain` "<title>wire:sso:success</title>"
      getUserIdViaRef' uref

    deleteViaBrig :: UserId -> TestSpar ()
    deleteViaBrig uid = do
      brig <- view teBrig
      resp <- call . delete $ brig . paths ["i", "users", toByteString' uid]
      liftIO $ responseStatus resp `shouldBe` status202
      void $ aFewTimes (runSpar $ BrigAPIAccess.getStatus uid) (== Deleted)

specScimAndSAML :: SpecWith TestEnv
specScimAndSAML = do
  it "SCIM and SAML work together and SCIM-created users can login" $ do
    env <- ask
    -- create a user via scim
    (tok, (_, tid, idp, (_, privcreds))) <- ScimT.registerIdPAndScimTokenWithMeta
    (usr, subj) <- ScimT.randomScimUserWithSubject
    scimStoredUser <- ScimT.createUser tok usr
    let userid :: UserId = ScimT.scimUserId scimStoredUser
        userref :: UserRef = UserRef tenant subject
        tenant :: Issuer = idp ^. idpMetadata . edIssuer
        subject :: NameID =
          either (error . show) id $
            mkNameID subj Nothing Nothing Nothing
    -- UserRef maps onto correct UserId in spar (and back).
    userid' <- getUserIdViaRef' userref
    liftIO $ ('i', userid') `shouldBe` ('i', Just userid)
    userssoid <- getSsoidViaSelf' userid
    liftIO $ ('r', veidUref <$$> ((`Intra.veidFromUserSSOId` Nothing) <$> userssoid)) `shouldBe` ('r', Just (Right (Just userref)))
    -- login a user for the first time with the scim-supplied credentials
    authnreq <- negotiateAuthnRequest idp
    spmeta <- getTestSPMetadata tid
    authnresp :: SignedAuthnResponse <- runSimpleSP $ mkAuthnResponseWithSubj subject privcreds idp spmeta (Just authnreq) True
    sparresp :: ResponseLBS <- submitAuthnResponse tid authnresp
    -- user should receive a cookie
    liftIO $ statusCode sparresp `shouldBe` 200
    setcky :: SAML.SimpleSetCookie "zuid" <-
      either error pure $ Util.Core.getCookie (Proxy @"zuid") sparresp
    -- /access with that cookie should give us a token
    let ckyraw = cookieRaw (Cky.setCookieName setcky') (Cky.setCookieValue setcky')
        setcky' = fromSimpleSetCookie setcky
    accessresp <- call . post $ (env ^. teBrig) . path "/access" . ckyraw
    token :: Text <- liftIO $ do
      statusCode accessresp `shouldBe` 200
      bdy :: LByteString <- maybe (error "no body") pure $ responseBody accessresp
      val :: Value <- either error pure $ eitherDecode bdy
      maybe (error "no access token") pure $ val ^? key "access_token" . _String
    -- token should contain the expected userid
    userid'' <- do
      parsed :: ZAuth.Token ZAuth.A <-
        maybe (error "bad access token") pure . fromByteString . cs $ token
      pure $ Id parsed.body.userId
    liftIO $ userid'' `shouldBe` userid
    -- /self should contain the expected UserSSOId
    self :: ResponseLBS <-
      call . get $
        (env ^. teBrig)
          . path "/self"
          . header "Z-User" (toByteString' userid'')
    selfbdy :: SelfProfile <-
      do
        bdy :: LByteString <- maybe (error "no self body") pure $ responseBody self
        either error pure $ eitherDecode bdy
    liftIO $ userId (selfUser selfbdy) `shouldBe` userid
  it "SCIM-provisioned users can login with any qualifiers to NameId" $ do
    (tok, (_, tid, idp, (_, privcreds))) <- ScimT.registerIdPAndScimTokenWithMeta
    (usr, subj) <- ScimT.randomScimUserWithSubject
    scimStoredUser <- ScimT.createUser tok usr
    let subjectWithQualifier :: NameID =
          either (error . show) id $
            mkNameID subj (Just "https://federation.foobar.com/nidp/saml2/metadata") (Just "https://prod-nginz-https.wire.com/sso/finalize-login") Nothing

    authnreq <- negotiateAuthnRequest idp
    spmeta <- getTestSPMetadata (idp ^. idpExtraInfo . team)
    authnresp :: SignedAuthnResponse <- runSimpleSP $ mkAuthnResponseWithSubj subjectWithQualifier privcreds idp spmeta (Just authnreq) True

    ssoid <- getSsoidViaAuthResp authnresp
    mid <- ssoToUidSpar tid ssoid

    liftIO $ mid `shouldBe` Just (ScimT.scimUserId scimStoredUser)

specProvisionScimAndSAMLUserWithRole :: SpecWith TestEnv
specProvisionScimAndSAMLUserWithRole = do
  describe "provision scim user with SAML with role" $ do
    it "create user" $ do
      (tok, (owner, tid, _idp, (_, _privcreds))) <- ScimT.registerIdPAndScimTokenWithMeta
      let testCreateUserWithRole role = do
            scimUser <- do
              u <- ScimT.randomScimUser
              pure $ u {Scim.roles = [cs $ toByteString $ role]}
            uid <- ScimT.scimUserId <$> ScimT.createUser tok scimUser
            ScimT.checkTeamMembersRole tid owner uid role
      mapM_ testCreateUserWithRole [minBound .. maxBound]
    it "create user - default to member if no role given" $ do
      (tok, (owner, tid, _idp, (_, _privcreds))) <- ScimT.registerIdPAndScimTokenWithMeta
      scimUser <- do
        u <- ScimT.randomScimUser
        pure $ u {Scim.roles = []}
      uid <- ScimT.scimUserId <$> ScimT.createUser tok scimUser
      ScimT.checkTeamMembersRole tid owner uid RoleMember
    it "create user - fail if more than one role given" $ do
      (tok, _) <- ScimT.registerIdPAndScimTokenWithMeta
      scimUser <- do
        u <- ScimT.randomScimUser
        pure $ u {Scim.roles = ["member", "admin"]}
      ScimT.createUser' tok scimUser !!! do
        const 400 === statusCode
        const (Just "A user cannot have more than one role.") =~= responseBody
    it "create user - fail if role name cannot be parsed correctly" $ do
      (tok, _) <- ScimT.registerIdPAndScimTokenWithMeta
      scimUser <- do
        u <- ScimT.randomScimUser
        pure $ u {Scim.roles = ["president"]}
      ScimT.createUser' tok scimUser !!! do
        const 400 === statusCode
        const (Just "The role 'president' is not valid. Valid roles are owner, admin, member, partner.") =~= responseBody
    it "update user" $ do
      (tok, (owner, tid, _idp, (_, _privcreds))) <- ScimT.registerIdPAndScimTokenWithMeta
      scimUserWithDefaultRole <- ScimT.randomScimUser
      uid <- ScimT.scimUserId <$> ScimT.createUser tok scimUserWithDefaultRole
      let testUpdateUserWithRole role = do
            let scimUserWithRole = scimUserWithDefaultRole {Scim.roles = [cs $ toByteString $ role]}
            _ <- ScimT.updateUser tok uid scimUserWithRole
            ScimT.checkTeamMembersRole tid owner uid role
      mapM_ testUpdateUserWithRole [minBound .. maxBound]
    it "update user - do not change current role if no role given" $ do
      (tok, (owner, tid, _idp, (_, _privcreds))) <- ScimT.registerIdPAndScimTokenWithMeta
      let testUpdateUserWithDefaultRole :: Role -> TestSpar ()
          testUpdateUserWithDefaultRole role = do
            scimUser <- do
              u <- ScimT.randomScimUser
              pure $ u {Scim.roles = [cs $ toByteString $ role]}
            uid <- ScimT.scimUserId <$> ScimT.createUser tok scimUser
            _ <- ScimT.updateUser tok uid (scimUser {Scim.roles = []})
            ScimT.checkTeamMembersRole tid owner uid role
      mapM_ testUpdateUserWithDefaultRole [minBound .. maxBound]
    it "updated user - fail if more than one role given" $ do
      (tok, _) <- ScimT.registerIdPAndScimTokenWithMeta
      scimUser <- ScimT.randomScimUser
      uid <- ScimT.scimUserId <$> ScimT.createUser tok scimUser
      ScimT.updateUser' tok uid (scimUser {Scim.roles = ["admin", "member"]}) !!! do
        const 400 === statusCode
        const (Just "A user cannot have more than one role.") =~= responseBody
    it "updated user - fail if role name cannot be parsed correctly" $ do
      (tok, _) <- ScimT.registerIdPAndScimTokenWithMeta
      scimUser <- ScimT.randomScimUser
      uid <- ScimT.scimUserId <$> ScimT.createUser tok scimUser
      ScimT.updateUser' tok uid (scimUser {Scim.roles = ["hamlet"]}) !!! do
        const 400 === statusCode
        const (Just "The role 'hamlet' is not valid. Valid roles are owner, admin, member, partner.") =~= responseBody

specAux :: SpecWith TestEnv
specAux = do
  describe "test helper functions" $ do
    describe "createTeamMember" $ do
      let check :: (HasCallStack) => Bool -> Int -> SpecWith TestEnv
          check tryowner permsix =
            it ("works: tryowner == " <> show (tryowner, permsix)) $ do
              env <- ask
              (owner, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
              newmember <-
                if tryowner
                  then pure undefined
                  else call $ createTeamMember (env ^. teBrig) (env ^. teGalley) tid (permses !! permsix)
              rawResp <-
                call $
                  get
                    ( (env ^. teBrig)
                        . path "/self"
                        . header "Z-User" (toByteString' $ if tryowner then owner else newmember)
                        . expect2xx
                    )
              parsedResp <- either (error . show) (pure . selfUser) (parseResponse @SelfProfile "brig" rawResp)
              liftIO $ userTeam parsedResp `shouldSatisfy` isJust

          parseResponse :: forall a m. (FromJSON a, MonadError SparError m, Typeable a) => LText -> ResponseLBS -> m a
          parseResponse serviceName resp = do
            let typeinfo :: LText
                typeinfo = LT.pack $ show (typeRep ([] @a)) <> ": "

                err :: forall a'. LText -> m a'
                err = throwSpar . SparCouldNotParseRfcResponse serviceName . (typeinfo <>)

            bdy <- maybe (err "no body") pure $ responseBody resp
            either (err . LT.pack) pure $ eitherDecode' bdy

          permses :: [Permissions]
          permses =
            [ fullPermissions,
              noPermissions
            ]
      sequence_ [check tryowner perms | tryowner <- [minBound ..], perms <- [0 .. (length permses - 1)]]

specSsoSettings :: SpecWith TestEnv
specSsoSettings = do
  describe "SSO settings endpoint" $ do
    it "does not allow setting non-existing SSO code" $ do
      env <- ask
      (owner, _teamid) <- callCreateUserWithTeam
      _idp <- registerTestIdP owner
      nonExisting <- IdPId <$> liftIO UUID.nextRandom
      callSetDefaultSsoCode (env ^. teSpar) nonExisting
        `shouldRespondWith` \resp ->
          statusCode resp == 404 -- not quite right, see `internalPutSsoSettings`
    it "allows setting a default SSO code" $ do
      env <- ask
      (userid1, _teamid) <- callCreateUserWithTeam
      ((^. idpId) -> idpid1) <- registerTestIdP userid1
      (userid2, _teamid) <- callCreateUserWithTeam
      ((^. idpId) -> idpid2) <- registerTestIdP userid2
      -- set 1
      -- TODO: authorization?
      callSetDefaultSsoCode (env ^. teSpar) idpid1
        `shouldRespondWith` \resp ->
          statusCode resp == 200
      -- check it is set
      callGetDefaultSsoCode (env ^. teSpar)
        `shouldRespondWith` \resp ->
          (statusCode resp == 200)
            && (responseJsonEither resp == Right (ssoSettings (Just idpid1)))
      -- update to 2
      callSetDefaultSsoCode (env ^. teSpar) idpid2
        `shouldRespondWith` \resp ->
          statusCode resp == 200
      -- check it is set
      callGetDefaultSsoCode (env ^. teSpar)
        `shouldRespondWith` \resp ->
          (statusCode resp == 200)
            && (responseJsonEither resp == Right (ssoSettings (Just idpid2)))
    it "allows removing the default SSO code" $ do
      env <- ask
      (userid, _teamid) <- callCreateUserWithTeam
      ((^. idpId) -> idpid) <- registerTestIdP userid
      -- set
      callSetDefaultSsoCode (env ^. teSpar) idpid
        `shouldRespondWith` \resp ->
          statusCode resp == 200
      -- remove
      callDeleteDefaultSsoCode (env ^. teSpar)
        `shouldRespondWith` \resp ->
          statusCode resp == 200
      -- check it is not set anymore
      callGetDefaultSsoCode (env ^. teSpar)
        `shouldRespondWith` \resp ->
          (statusCode resp == 200)
            && (responseJsonEither resp == Right (ssoSettings Nothing))
    it "removes the default SSO code if the IdP gets removed" $ do
      env <- ask
      (userid, _teamid) <- callCreateUserWithTeam
      ((^. idpId) -> idpid) <- registerTestIdP userid
      -- set
      callSetDefaultSsoCode (env ^. teSpar) idpid
        `shouldRespondWith` \resp ->
          statusCode resp == 200
      -- remove IdP
      callIdpDelete' (env ^. teSpar) (Just userid) idpid
        `shouldRespondWith` \resp -> statusCode resp < 300
      -- check it is not set anymore
      callGetDefaultSsoCode (env ^. teSpar)
        `shouldRespondWith` \resp ->
          (statusCode resp == 200)
            && (responseJsonEither resp == Right (ssoSettings Nothing))
  where
    ssoSettings maybeCode =
      object
        [ "default_sso_code" .= case maybeCode of
            Nothing -> Aeson.Null
            Just code -> Aeson.toJSON (SAML.fromIdPId code)
        ]

-- TODO: go through DataSpec, APISpec and check that all the tests still make sense with the new implicit mock idp.
-- TODO: what else needs to be tested, beyond the pending tests listed here?
-- TODO: what tests can go to saml2-web-sso package?

getSsoidViaAuthResp :: (HasCallStack) => SignedAuthnResponse -> TestSpar UserSSOId
getSsoidViaAuthResp aresp = do
  parsed :: AuthnResponse <-
    either error pure . parseFromDocument $ fromSignedAuthnResponse aresp
  either (error . show) (pure . UserSSOId) $ SAML.assertionsToUserRef (parsed ^. SAML.rspPayload)

specSparUserMigration :: SpecWith TestEnv
specSparUserMigration = do
  describe "online migration from spar.user to spar.user_v2" $
    it "online migration - user in legacy table can log in" $ do
      env <- ask

      (owner, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
      (idp, (_, privcreds)) <- registerTestIdPWithMeta owner
      spmeta <- getTestSPMetadata tid

      (issuer, subject) <- do
        suffix <- cs <$> replicateM 7 (getRandomR ('a', 'z'))
        let randEmail = "email_" <> suffix <> "@example.com"
        uname <- either (error . show) pure (SAML.mkUNameIDEmail randEmail)
        let subj = either (error . show) id $ SAML.mkNameID uname Nothing Nothing Nothing
        let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer
        pure (issuer, subj)

      memberUid <- call $ createTeamMember (env ^. teBrig) (env ^. teGalley) tid (rolePermissions RoleMember)

      do
        -- insert to legacy tale
        client <- asks (^. teCql)
        let insert :: PrepQuery W (SAML.Issuer, SAML.NameID, UserId) ()
            insert = "INSERT INTO user (issuer, sso_id, uid) VALUES (?, ?, ?)"
        runClient client $
          retry x5 $
            write insert (params LocalQuorum (issuer, subject, memberUid))

      mbUserId <- do
        authnreq <- negotiateAuthnRequest idp
        authnresp <- runSimpleSP $ mkAuthnResponseWithSubj subject privcreds idp spmeta (Just authnreq) True
        sparresp <- submitAuthnResponse tid authnresp
        liftIO $ statusCode sparresp `shouldBe` 200
        ssoid <- getSsoidViaAuthResp authnresp
        ssoToUidSpar tid ssoid

      liftIO $ mbUserId `shouldBe` Just memberUid

specReAuthSsoUserWithPassword :: SpecWith TestEnv
specReAuthSsoUserWithPassword =
  describe "Re-auth for SSO users" $ do
    it "password user that was upgraded to SCIM has to provide password" $ do
      env <- ask
      let withoutIdp = False
      (uid, cid) <- setup env withoutIdp
      -- attempt to delete client again without password should still fail
      deleteClient (env ^. teBrig) uid cid Nothing 403
      -- attempt to delete client with correct password should succeed
      deleteClient (env ^. teBrig) uid cid (Just (fromPlainTextPassword defPassword)) 200
    it "password user that was upgraded to SAML does not need to provide password" $ do
      env <- ask
      let withIdp = True
      (uid, cid) <- setup env withIdp
      -- attempt to delete client again without password should now succeed
      deleteClient (env ^. teBrig) uid cid Nothing 200
  where
    setup :: TestEnv -> Bool -> TestSpar (UserId, ClientId)
    setup env withIdp = do
      -- user has been invited via TM and has a password
      (owner, tid) <- call (createUserWithTeam (env ^. teBrig) (env ^. teGalley))
      email <- randomEmail
      user <- call $ inviteAndRegisterUser (env ^. teBrig) owner tid email
      -- user adds a client
      cid <- addClientInternal (env ^. teBrig) (userId user) (defNewClient PermanentClientType [prekey] lPrekey)
      checkNumClients (env ^. teBrig) (userId user) 1
      -- attempt to delete the client without password fails
      deleteClient (env ^. teBrig) (userId user) cid Nothing 403
      -- attempt to delete the client with wrong password fails
      deleteClient (env ^. teBrig) (userId user) cid (Just "wrong password") 403
      -- maybe idp is created
      maybeIdpId <-
        if withIdp
          then do
            SampleIdP idpmeta _privkey _ _ <- makeSampleIdPMetadata
            apiVer <- view teWireIdPAPIVersion
            idp <- call $ callIdpCreate apiVer (env ^. teSpar) (Just owner) idpmeta
            pure $ Just (idp ^. idpId)
          else pure Nothing
      -- then user gets upgraded to scim with or without SAML
      tok <- registerScimToken tid maybeIdpId
      _ <- listUsers tok (Just (filterBy "externalId" (fromEmail email)))
      -- attempt to delete the client with wrong password still fails
      deleteClient (env ^. teBrig) (userId user) cid (Just "wrong password") 403
      pure (userId user, cid)

    checkNumClients :: BrigReq -> UserId -> Int -> TestSpar ()
    checkNumClients brig u expected = do
      r <-
        call $
          get $
            brig
              . path "clients"
              . zUser u
      let actual = Vec.length <$> (preview _Array =<< responseJsonMaybe @Value r)
      lift $ actual `shouldBe` Just expected

    prekey :: UncheckedPrekeyBundle
    prekey = UncheckedPrekeyBundle (PrekeyId 1) "pQABAQECoQBYIOjl7hw0D8YRNqkkBQETCxyr7/ywE/2R5RWcUPM+GJACA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY="

    lPrekey :: LastPrekey
    lPrekey = lastPrekey "pQABARn//wKhAFggnCcZIK1pbtlJf4wRQ44h4w7/sfSgj5oWXMQaUGYAJ/sDoQChAFgglacihnqg/YQJHkuHNFU7QD6Pb3KN4FnubaCF2EVOgRkE9g=="

    addClientInternal :: (HasCallStack, MonadIO m, MonadReader TestEnv m, MonadThrow m) => BrigReq -> UserId -> NewClient -> m ClientId
    addClientInternal brig uid new = do
      c :: Client <-
        responseJsonError
          =<< call
            ( post $
                brig
                  . paths ["i", "clients", toByteString' uid]
                  . contentJson
                  . body (RequestBodyLBS $ encode new)
                  . expect2xx
            )
      pure $ c.clientId

    defNewClient :: ClientType -> [UncheckedPrekeyBundle] -> LastPrekey -> NewClient
    defNewClient ty pks lpk =
      (newClient ty lpk)
        { newClientPassword = Just defPassword,
          newClientPrekeys = pks,
          newClientLabel = Just "Test Device",
          newClientModel = Just "Test Model",
          newClientVerificationCode = Nothing
        }

    deleteClient :: (MonadIO m, MonadReader TestEnv m) => BrigReq -> UserId -> ClientId -> Maybe Text -> Int -> m ()
    deleteClient brig u c pw expectedStatus =
      void $
        call $
          delete $
            brig
              . paths ["clients", toByteString' c]
              . zUser u
              . zConn "conn"
              . contentJson
              . body payload
              . expectStatus ((==) expectedStatus)
      where
        payload =
          RequestBodyLBS . encode . object . maybeToList $
            fmap ("password" .=) pw

----------------------------------------------------------------------
-- tests for bsi audit

-- @SF.Channel @TSFI.RESTfulAPI @S2 @S3
testRejectsSAMLResponseSayingAccessNotGranted :: TestSpar ()
testRejectsSAMLResponseSayingAccessNotGranted = do
  (user, tid) <- callCreateUserWithTeam
  (idp, (_, privcreds)) <- registerTestIdPWithMeta user
  authnreq <- negotiateAuthnRequest idp
  spmeta <- getTestSPMetadata tid
  authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp spmeta (Just authnreq) False
  sparresp <- submitAuthnResponse tid authnresp
  liftIO $ do
    statusCode sparresp `shouldBe` 200
    let bdy = maybe "" (cs @LByteString @String) (responseBody sparresp)
    bdy `shouldContain` "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
    bdy `shouldContain` "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"
    bdy `shouldContain` "<title>wire:sso:error:forbidden</title>"
    bdy `shouldContain` "window.opener.postMessage({"
    bdy `shouldContain` "\"type\":\"AUTH_ERROR\""
    bdy `shouldContain` "\"payload\":{"
    bdy `shouldContain` "\"label\":\"forbidden\""
    bdy `shouldContain` "}, receiverOrigin)"
    hasPersistentCookieHeader sparresp `shouldBe` Left "no set-cookie header"

-- @END

-- @SF.Channel @TSFI.RESTfulAPI @S2 @S3
--
-- Do not authenticate if SSO IdP response is for unknown issuer
testRejectsSAMLResponseFromWrongIssuer :: (HasCallStack) => TestSpar ()
testRejectsSAMLResponseFromWrongIssuer = do
  let mkareq = negotiateAuthnRequest
      mkaresp privcreds idp spmeta mbauthnreq =
        mkAuthnResponse
          privcreds
          (idp & idpMetadata . edIssuer .~ Issuer [uri|http://unknown-issuer/|])
          spmeta
          mbauthnreq
          True
      submitaresp = submitAuthnResponse
      checkresp sparresp = do
        statusCode sparresp `shouldBe` 404
        -- body should contain the error label in the title, the verbatim haskell error, and the request:
        (cs . fromJust . responseBody $ sparresp) `shouldContain` "<title>wire:sso:error:not-found</title>"
        (cs . fromJust . responseBody $ sparresp) `shouldContainInBase64` "(CustomError (IdpDbError IdpNotFound)"
        (cs . fromJust . responseBody $ sparresp) `shouldContainInBase64` "Input {iName = \"SAMLResponse\""
  checkSamlFlow
    mkareq
    mkaresp
    submitaresp
    checkresp

-- @END

-- @SF.Channel @TSFI.RESTfulAPI @S2 @S3
--
-- Do not authenticate if SSO IdP response is signed with wrong key
testRejectsSAMLResponseSignedWithWrongKey :: TestSpar ()
testRejectsSAMLResponseSignedWithWrongKey = do
  (ownerid, _teamid) <- callCreateUserWithTeam
  (_, (_, badprivcreds)) <- registerTestIdPWithMeta ownerid
  let mkareq = negotiateAuthnRequest
      mkaresp _ idp spmeta authnreq =
        mkAuthnResponse
          badprivcreds
          idp
          spmeta
          authnreq
          True
      submitaresp = submitAuthnResponse
      checkresp sparresp = statusCode sparresp `shouldBe` 400
  checkSamlFlow mkareq mkaresp submitaresp checkresp

-- @END

-- @SF.Channel @TSFI.RESTfulAPI @S2 @S3
--
-- Do not authenticate if SSO IdP response has no corresponding request anymore
testRejectsSAMLResponseIfRequestIsStale :: TestSpar ()
testRejectsSAMLResponseIfRequestIsStale = do
  let mkareq idp = do
        req <- negotiateAuthnRequest idp
        runSpar $ AReqIDStore.unStore (req ^. SAML.rqID)
        pure req
      mkaresp privcreds idp spmeta authnreq = mkAuthnResponse privcreds idp spmeta authnreq True
      submitaresp = submitAuthnResponse
      checkresp sparresp = do
        statusCode sparresp `shouldBe` 200
        (cs . fromJust . responseBody $ sparresp) `shouldContain` "<title>wire:sso:error:forbidden</title>"
        (cs . fromJust . responseBody $ sparresp) `shouldContain` "bad InResponseTo attribute(s)"
  checkSamlFlow mkareq mkaresp submitaresp checkresp

-- @END

-- @SF.Channel @TSFI.RESTfulAPI @S2 @S3
--
-- Do not authenticate if SSO IdP response is gone missing
testRejectsSAMLResponseIfResponseIsStale :: TestSpar ()
testRejectsSAMLResponseIfResponseIsStale = do
  let mkareq = negotiateAuthnRequest
      mkaresp privcreds idp spmeta authnreq = mkAuthnResponse privcreds idp spmeta authnreq True
      submitaresp teamid authnresp = do
        _ <- submitAuthnResponse teamid authnresp
        submitAuthnResponse teamid authnresp
      checkresp sparresp = do
        statusCode sparresp `shouldBe` 200
        (cs . fromJust . responseBody $ sparresp) `shouldContain` "<title>wire:sso:error:forbidden</title>"
  checkSamlFlow mkareq mkaresp submitaresp checkresp

-- @END

----------------------------------------------------------------------
-- Helpers

shouldContainInBase64 :: String -> String -> Expectation
shouldContainInBase64 hay needle = cs hay'' `shouldContain` needle
  where
    Right (Just hay'') = decodeBase64 <$> validateBase64 hay'
    hay' = cs $ f hay
      where
        -- exercise to the reader: do this more idiomatically!
        f (splitAt 5 -> ("<pre>", s)) = g s
        f (_ : s) = f s
        f "" = ""
        g (splitAt 6 -> ("</pre>", _)) = ""
        g (c : s) = c : g s
        g "" = ""

checkSamlFlow ::
  (HasCallStack) =>
  (IdP -> TestSpar SAML.AuthnRequest) ->
  (SignPrivCreds -> IdP -> SAML.SPMetadata -> Maybe SAML.AuthnRequest -> SimpleSP SignedAuthnResponse) ->
  (TeamId -> SignedAuthnResponse -> TestSpar (Response (Maybe LByteString))) ->
  (ResponseLBS -> IO ()) ->
  TestSpar ()
checkSamlFlow mkareq mkaresp submitaresp checkresp = do
  (ownerid, teamid) <- callCreateUserWithTeam
  (idp, (_, privcreds)) <- registerTestIdPWithMeta ownerid
  authnreq <- mkareq idp
  spmeta <- getTestSPMetadata teamid
  authnresp <-
    runSimpleSP $
      mkaresp
        privcreds
        idp
        spmeta
        (Just authnreq)
  sparresp <- submitaresp teamid authnresp
  liftIO $ checkresp sparresp

mkUser :: Role -> TestEnv -> TeamId -> TestSpar UserId
mkUser role env tid = do
  let perms = rolePermissions role
  call $ createTeamMember (env ^. teBrig) (env ^. teGalley) tid perms
