content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  
  -- 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/>.
  
  -- | SCIM API authentication and SCIM token tests.
  --
  -- Note: we create a new team in each test, so we don't have to do any kind of cleanup.
  module Test.Spar.Scim.AuthSpec
    ( spec,
    )
  where
  
  import Bilge
  import Bilge.Assert
  import Cassandra as Cas
  import Control.Lens
  import Data.Aeson (encode)
  import qualified Data.ByteString.Base64 as ES
  import Data.ByteString.Conversion (toByteString')
  import qualified Data.Code as Code
  import Data.Id (ScimTokenId, TeamId, UserId, randomId)
  import Data.Misc
  import Data.Range (unsafeRange)
  import Data.String.Conversions
  import Data.Text.Ascii (AsciiChars (validate))
  import Data.Time (UTCTime)
  import Data.Time.Clock (getCurrentTime)
  import Imports
  import OpenSSL.Random (randBytes)
  import qualified SAML2.WebSSO as SAML
  import qualified SAML2.WebSSO.Test.Util as SAML
  import Spar.Scim
  import Text.RawString.QQ (r)
  import Util
  import Wire.API.Team.Feature (featureNameBS)
  import qualified Wire.API.Team.Feature as Public
  import Wire.API.Team.Member (rolePermissions)
  import Wire.API.Team.Role
  import Wire.API.User (userEmail)
  import qualified Wire.API.User as Public
  import Wire.API.User.Identity
  
  -- | Tests for authentication and operations with provisioning tokens ('ScimToken's).
  spec :: SpecWith TestEnv
  spec = do
    specCreateToken
    specDeleteToken
    specListTokens
    describe "Miscellaneous" $ do
      it "testAuthIsNeeded - doesn't allow SCIM operations with invalid or missing SCIM token" testAuthIsNeeded
  
  ----------------------------------------------------------------------------
  -- Token creation
  
  -- | Tests for @POST /auth-tokens@.
  specCreateToken :: SpecWith TestEnv
  specCreateToken = describe "POST /auth-tokens" $ do
    it "works" testCreateToken
    it "requires the team to have no more than one IdP" testNumIdPs
    it "testCreateTokenAuthorizesOnlyAdmins - authorizes only admins and owners" testCreateTokenAuthorizesOnlyAdmins
    it "requires a password" testCreateTokenRequiresPassword
    it "testCreateTokenWithVerificationCode - works with verification code" testCreateTokenWithVerificationCode
  
  -- FUTUREWORK: we should also test that for a password-less user, e.g. for an SSO user,
  -- reauthentication is not required. We currently (2019-03-05) can't test that because
  -- only team owners with an email address can do SCIM token operations (which is something
  -- we should change in the future).
  
  -- | Test that token creation is sane:
  --
  -- * Token can be created.
  -- * SCIM API can be used with that token.
  testCreateToken :: TestSpar ()
  testCreateToken = do
    env <- ask
    -- Create a token
    (owner, _tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
    _ <- registerTestIdP owner
    CreateScimTokenResponseV7 token _ <-
      createToken
        owner
        CreateScimToken
          { description = "testCreateToken",
            password = Just defPassword,
            verificationCode = Nothing,
            name = Nothing,
            idp = Nothing
          }
    -- Try to do @GET /Users@ and check that it succeeds
    let fltr = filterBy "externalId" "67c196a0-cd0e-11ea-93c7-ef550ee48502"
    listUsers_ (Just token) (Just fltr) (env ^. teSpar)
      !!! const 200 === statusCode
  
  -- @SF.Channel @TSFI.RESTfulAPI @S2
  --
  -- Test positive case but also that a SCIM token cannot be created with wrong
  -- or missing second factor email verification code when this feature is enabled
  testCreateTokenWithVerificationCode :: TestSpar ()
  testCreateTokenWithVerificationCode = do
    env <- ask
    (owner, teamId) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
    _ <- registerTestIdP owner
    unlockFeature (env ^. teGalley) teamId
    setSndFactorPasswordChallengeStatus (env ^. teGalley) teamId Public.FeatureStatusEnabled
    user <- getUserBrig owner
    let email = fromMaybe undefined (userEmail =<< user)
  
    let reqMissingCode = CreateScimToken "testCreateToken" (Just defPassword) Nothing Nothing Nothing
    createTokenFailsWith owner reqMissingCode 403 "code-authentication-required"
  
    void $ requestVerificationCode (env ^. teBrig) email Public.CreateScimToken
    let wrongCode = Code.Value $ unsafeRange (fromRight undefined (validate "123456"))
    let reqWrongCode = CreateScimToken "testCreateToken" (Just defPassword) (Just wrongCode) Nothing Nothing
    createTokenFailsWith owner reqWrongCode 403 "code-authentication-failed"
  
    void $ retryNUntil 6 ((==) 200 . statusCode) $ requestVerificationCode (env ^. teBrig) email Public.CreateScimToken
    code <- getVerificationCode (env ^. teBrig) owner Public.CreateScimToken
    let reqWithCode = CreateScimToken "testCreateToken" (Just defPassword) (Just code) Nothing Nothing
    CreateScimTokenResponseV7 token _ <- createToken owner reqWithCode
  
    -- Try to do @GET /Users@ and check that it succeeds
    let fltr = filterBy "externalId" "67c196a0-cd0e-11ea-93c7-ef550ee48502"
    listUsers_ (Just token) (Just fltr) (env ^. teSpar)
      !!! const 200 === statusCode
    where
      requestVerificationCode :: BrigReq -> EmailAddress -> Public.VerificationAction -> TestSpar ResponseLBS
      requestVerificationCode brig email action = do
        call $
          post (brig . paths ["verification-code", "send"] . contentJson . json (Public.SendVerificationCode action email))
  
  -- @END
  
  unlockFeature :: GalleyReq -> TeamId -> TestSpar ()
  unlockFeature galley tid =
    call $ put (galley . paths ["i", "teams", toByteString' tid, "features", featureNameBS @Public.SndFactorPasswordChallengeConfig, toByteString' Public.LockStatusUnlocked]) !!! const 200 === statusCode
  
  setSndFactorPasswordChallengeStatus :: GalleyReq -> TeamId -> Public.FeatureStatus -> TestSpar ()
  setSndFactorPasswordChallengeStatus galley tid status = do
    let js = RequestBodyLBS $ encode $ Public.Feature @Public.SndFactorPasswordChallengeConfig status Public.SndFactorPasswordChallengeConfig
    call $
      put (galley . paths ["i", "teams", toByteString' tid, "features", featureNameBS @Public.SndFactorPasswordChallengeConfig] . contentJson . body js)
        !!! const 200 === statusCode
  
  getVerificationCode :: BrigReq -> UserId -> Public.VerificationAction -> TestSpar Code.Value
  getVerificationCode brig uid action = do
    resp <-
      call $
        get (brig . paths ["i", "users", toByteString' uid, "verification-code", toByteString' action])
          <!! const 200 === statusCode
    pure $ responseJsonUnsafe @Code.Value resp
  
  testNumIdPs :: TestSpar ()
  testNumIdPs = do
    env <- ask
    (owner, _) <-
      runHttpT (env ^. teMgr) $
        createUserWithTeam (env ^. teBrig) (env ^. teGalley)
  
    let addSomeIdP :: TestSpar ()
        addSomeIdP = do
          let spar = env ^. teSpar
              apiversion = env ^. teWireIdPAPIVersion
          SAML.SampleIdP metadata _ _ _ <- SAML.makeSampleIdPMetadata
          void $ call $ Util.callIdpCreate apiversion spar (Just owner) metadata
  
    createToken owner (CreateScimToken "eins" (Just defPassword) Nothing Nothing Nothing)
      >>= deleteToken owner . (.stiId) . (.info)
    addSomeIdP
    createToken owner (CreateScimToken "zwei" (Just defPassword) Nothing Nothing Nothing)
      >>= deleteToken owner . (.stiId) . (.info)
    addSomeIdP
    createToken_ owner (CreateScimToken "drei" (Just defPassword) Nothing Nothing Nothing) (env ^. teSpar)
      !!! checkErr 400 (Just "more-than-one-idp")
  
  -- @SF.Provisioning @TSFI.RESTfulAPI @S2
  -- Test that a token can only be created as a team owner
  testCreateTokenAuthorizesOnlyAdmins :: TestSpar ()
  testCreateTokenAuthorizesOnlyAdmins = do
    env <- ask
    (owner, teamId) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
    _ <- registerTestIdP owner
  
    let mkUser :: Role -> TestSpar UserId
        mkUser role = do
          runHttpT (env ^. teMgr) $
            createTeamMember
              (env ^. teBrig)
              (env ^. teGalley)
              teamId
              (rolePermissions role)
  
    let createToken' uid =
          createToken_
            uid
            CreateScimToken
              { description = "testCreateToken",
                password = Just defPassword,
                verificationCode = Nothing,
                name = Nothing,
                idp = Nothing
              }
            (env ^. teSpar)
  
    (mkUser RoleMember >>= createToken')
      !!! checkErr 403 (Just "insufficient-permissions")
  
    (mkUser RoleAdmin >>= createToken')
      !!! const 200 === statusCode
  
  -- @END
  
  -- | Test that for a user with a password, token creation requires reauthentication (i.e. the
  -- field @"password"@ should be provided).
  --
  -- Checks both the "password not provided" and "wrong password is provided" cases.
  testCreateTokenRequiresPassword :: TestSpar ()
  testCreateTokenRequiresPassword = do
    env <- ask
    -- Create a new team
    (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
    _ <- registerTestIdP owner
    -- Creating a token doesn't work without a password
    createToken_
      owner
      CreateScimToken
        { description = "testCreateTokenRequiresPassword",
          password = Nothing,
          verificationCode = Nothing,
          name = Nothing,
          idp = Nothing
        }
      (env ^. teSpar)
      !!! checkErr 403 (Just "access-denied")
    -- Creating a token doesn't work with a wrong password
    createToken_
      owner
      CreateScimToken
        { description = "testCreateTokenRequiresPassword",
          password = Just (plainTextPassword6Unsafe "wrong password"),
          verificationCode = Nothing,
          name = Nothing,
          idp = Nothing
        }
      (env ^. teSpar)
      !!! checkErr 403 (Just "access-denied")
  
  ----------------------------------------------------------------------------
  -- Token listing
  
  -- | Tests for @GET /auth-tokens@.
  specListTokens :: SpecWith TestEnv
  specListTokens = describe "GET /auth-tokens" $ do
    it "works" $ testListTokens
    it "converts legacy plaintext tokens" $ testPlaintextTokensAreConverted
  
  -- | Test that existing tokens can be listed.
  testListTokens :: TestSpar ()
  testListTokens = do
    -- Create two tokens
    env <- ask
    (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
    _ <- registerTestIdP owner
    _ <-
      createToken
        owner
        CreateScimToken
          { description = "testListTokens / #1",
            password = Just defPassword,
            verificationCode = Nothing,
            name = Nothing,
            idp = Nothing
          }
    _ <-
      createToken
        owner
        CreateScimToken
          { description = "testListTokens / #2",
            password = Just defPassword,
            verificationCode = Nothing,
            name = Nothing,
            idp = Nothing
          }
    -- Check that the token is on the list
    list <- (.scimTokenListTokens) <$> listTokens owner
    liftIO $
      map (.stiDescr) list
        `shouldBe` ["testListTokens / #1", "testListTokens / #2"]
  
  testPlaintextTokensAreConverted :: TestSpar ()
  testPlaintextTokensAreConverted = do
    env <- ask
    (owner, teamId) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
    _ <- registerTestIdP owner
  
    -- create a legacy plaintext token in the DB
    token <- createLegacyPlaintextToken teamId
    countTokensInDB (ScimTokenLookupKeyPlaintext token) >>= liftIO . (`shouldBe` 1)
  
    -- scim token can be used.
    -- This use causes the plaintext token to be converted to a hashed version
    void $ listUsers token (Just (filterBy "userName" $ "foo"))
  
    -- The previous use of the token causes its DB entry to be hashed
    -- The plaintext entry is gone
    countTokensInDB (ScimTokenLookupKeyPlaintext token) >>= liftIO . (`shouldBe` 0)
  
    -- The hashed entry can be found
    let hashedToken = hashScimToken token
    countTokensInDB (ScimTokenLookupKeyHashed hashedToken) >>= liftIO . (`shouldBe` 1)
  
    -- token can still be used
    void $ listUsers token (Just (filterBy "userName" $ "foo"))
    where
      wrapMonadClient :: Cas.Client a -> TestSpar a
      wrapMonadClient action = do
        env <- ask
        let clientState = env ^. teCql
        runClient clientState action
  
      createLegacyPlaintextToken :: TeamId -> TestSpar ScimToken
      createLegacyPlaintextToken teamId = do
        token <- ScimToken . cs . ES.encode <$> liftIO (randBytes 32)
        tokenId <- randomId
        now <- liftIO $ getCurrentTime
        let descr = "legacy test token"
        wrapMonadClient $ do
          retry x5 . batch $ do
            setType BatchLogged
            setConsistency LocalQuorum
            addPrepQuery insByToken (ScimTokenLookupKeyPlaintext token, teamId, tokenId, now, Nothing, descr)
            addPrepQuery insByTeam (ScimTokenLookupKeyPlaintext token, teamId, tokenId, now, Nothing, descr)
        pure token
  
      insByToken, insByTeam :: PrepQuery W (ScimTokenLookupKey, TeamId, ScimTokenId, UTCTime, Maybe SAML.IdPId, Text) ()
      insByToken =
        [r|
        INSERT INTO team_provisioning_by_token
          (token_, team, id, created_at, idp, descr)
          VALUES (?, ?, ?, ?, ?, ?)
        |]
      insByTeam =
        [r|
        INSERT INTO team_provisioning_by_team
          (token_, team, id, created_at, idp, descr)
          VALUES (?, ?, ?, ?, ?, ?)
        |]
  
      countTokensInDB :: ScimTokenLookupKey -> TestSpar Int64
      countTokensInDB key =
        wrapMonadClient $ do
          count <- runIdentity <$$> (retry x1 . query1 selByKey $ params LocalQuorum (Identity key))
          pure $ fromMaybe 0 count
  
      selByKey :: PrepQuery R (Identity ScimTokenLookupKey) (Identity Int64)
      selByKey =
        [r|
        SELECT COUNT(*) FROM team_provisioning_by_token WHERE token_ = ?
        |]
  
  ----------------------------------------------------------------------------
  -- Token deletion
  
  -- | Tests for @DELETE /auth-tokens/:id@.
  specDeleteToken :: SpecWith TestEnv
  specDeleteToken = describe "DELETE /auth-tokens/:id" $ do
    it "makes the token unusable" $ testDeletedTokensAreUnusable
    it "makes the token unlistable" $ testDeletedTokensAreUnlistable
  
  -- | Test that when a token is deleted, it's no longer usable.
  testDeletedTokensAreUnusable :: TestSpar ()
  testDeletedTokensAreUnusable = do
    env <- ask
    -- Create a token
    (owner, _teamId) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
    _ <- registerTestIdP owner
    CreateScimTokenResponseV7 token tokenInfo <-
      createToken
        owner
        CreateScimToken
          { description = "testDeletedTokensAreUnusable",
            password = Just defPassword,
            verificationCode = Nothing,
            name = Nothing,
            idp = Nothing
          }
    -- An operation with the token should succeed
    let fltr = filterBy "externalId" "67c196a0-cd0e-11ea-93c7-ef550ee48502"
    listUsers_ (Just token) (Just fltr) (env ^. teSpar)
      !!! const 200 === statusCode
    -- Delete the token and now the operation should fail
    deleteToken owner tokenInfo.stiId
    listUsers_ (Just token) Nothing (env ^. teSpar)
      !!! checkErr 401 Nothing
  
  -- | Test that when a token is deleted, it no longer appears in the result of @GET
  -- /auth-tokens@.
  testDeletedTokensAreUnlistable :: TestSpar ()
  testDeletedTokensAreUnlistable = do
    -- Create a token
    env <- ask
    (owner, _teamId) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
    _ <- registerTestIdP owner
    CreateScimTokenResponseV7 _ tokenInfo <-
      createToken
        owner
        CreateScimToken
          { description = "testDeletedTokensAreUnlistable",
            password = Just defPassword,
            verificationCode = Nothing,
            name = Nothing,
            idp = Nothing
          }
    -- Delete the token
    deleteToken owner tokenInfo.stiId
    -- Check that the token is not on the list
    list <- (.scimTokenListTokens) <$> listTokens owner
    liftIO $ list `shouldBe` []
  
  ----------------------------------------------------------------------------
  -- Miscellaneous tests
  
  -- @SF.Provisioning @TSFI.RESTfulAPI @S2
  -- This test verifies that the SCIM API responds with an authentication error
  -- and can't be used if it receives an invalid secret token
  -- or if no token is provided at all
  testAuthIsNeeded :: TestSpar ()
  testAuthIsNeeded = do
    env <- ask
    -- Try to do @GET /Users@ with an invalid token and check that it fails
    let invalidToken = ScimToken "this-is-an-invalid-token"
    listUsers_ (Just invalidToken) Nothing (env ^. teSpar) !!! checkErr 401 Nothing
    -- Try to do @GET /Users@ without a token and check that it fails
    listUsers_ Nothing Nothing (env ^. teSpar) !!! checkErr 401 Nothing
  
  -- @END
  