{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 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.Register where

import API.Brig
import API.BrigInternal
import API.Common
import API.GalleyInternal (setTeamFeatureLockStatus, setTeamFeatureStatus)
import SetupHelpers
import Testlib.Prelude

testDisallowRegistrationWhenEmailDomainIsClaimedByOtherBackend :: (HasCallStack) => App ()
testDisallowRegistrationWhenEmailDomainIsClaimedByOtherBackend :: HasCallStack => App ()
testDisallowRegistrationWhenEmailDomainIsClaimedByOtherBackend = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  domain <- App String
randomDomain
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  setup <- setupOwnershipTokenForBackend OwnDomain domain

  -- [customer admin] post no-registration config
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (mkDomainRedirectBackend version "https://example.com" "https://webapp.example.com")
    >>= assertStatus 200

  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  addUser OwnDomain def {email = Just email} `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

testDisallowRegistrationWhenEmailDomainDoesNotAllowRegistration :: (HasCallStack) => App ()
testDisallowRegistrationWhenEmailDomainDoesNotAllowRegistration :: HasCallStack => App ()
testDisallowRegistrationWhenEmailDomainDoesNotAllowRegistration = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  domain <- App String
randomDomain

  -- [backoffice] preauth
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  setup <- setupOwnershipTokenForBackend OwnDomain domain

  -- [customer admin] post no-registration config
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (object ["domain_redirect" .= "no-registration"])
    >>= assertStatus 200

  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  addUser OwnDomain def {email = Just email} `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

  addUser OwnDomain def {email = Just email, newTeamName = Just "new test team"} `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

testAllowRegistrationWhenEmailDomainIsTakenByATeamButRedirectIsNone :: (HasCallStack) => App ()
testAllowRegistrationWhenEmailDomainIsTakenByATeamButRedirectIsNone :: HasCallStack => App ()
testAllowRegistrationWhenEmailDomainIsTakenByATeamButRedirectIsNone = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  -- enable domain registration feature
  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  domain <- randomDomain
  setup <- setupOwnershipTokenForTeam owner domain
  authorizeTeam owner domain setup.ownershipToken >>= assertStatus 200

  -- [customer admin] post no-registration config
  updateTeamInvite
    owner
    domain
    (object ["team_invite" .= "team", "team" .= tid])
    >>= assertStatus 200

  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  addUser OwnDomain def {email = Just email} >>= assertSuccess

testDisallowRegistrationWhenEmailDomainIsTakenByATeamWithSSO :: (HasCallStack) => App ()
testDisallowRegistrationWhenEmailDomainIsTakenByATeamWithSSO :: HasCallStack => App ()
testDisallowRegistrationWhenEmailDomainIsTakenByATeamWithSSO = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  -- enable domain registration feature
  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  domain <- randomDomain
  setup <- setupOwnershipTokenForTeam owner domain
  authorizeTeam owner domain setup.ownershipToken >>= assertStatus 200

  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (idp, idpMeta) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"

  updateTeamInvite owner domain (object ["team_invite" .= "not-allowed", "sso" .= idpId])
    >>= assertStatus 200

  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  addUser OwnDomain def {email = Just email} `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

  -- Registering with SSO works
  void $ loginWithSamlEmail True tid ("sso@" <> domain) (idpId, idpMeta)

  (owner2, _, _) <- createTeam OwnDomain 1

  -- TODO: Do we have to block SSO and SCIM regsitrations for other teams here?

  -- Inviting a user to another team doesn't work
  postInvitation owner2 def {email = Just email} `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

  -- Inviting a user to the same team also doesn't work
  postInvitation owner def {email = Just email} `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

  updateTeamInvite owner domain (object ["team_invite" .= "allowed", "sso" .= idpId])
    >>= assertStatus 200

  -- Now invitation to any teams works
  invitationToTeam2 <- postInvitation owner2 def {email = Just email} >>= getJSON 201
  invitationCodeToTeam2 <- (getInvitationCode owner2 invitationToTeam2 >>= getJSON 200) %. "code" & asString
  assertSuccess
    =<< addUser
      owner2
      def
        { email = Just email,
          teamCode = Just invitationCodeToTeam2
        }

  let email2 = String
"user2@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  invitationToOrigTeam <- postInvitation owner def {email = Just email2} >>= getJSON 201
  invitationCodeToOrigTeam <- (getInvitationCode owner invitationToOrigTeam >>= getJSON 200) %. "code" & asString
  assertSuccess
    =<< addUser
      owner
      def
        { email = Just email2,
          teamCode = Just invitationCodeToOrigTeam
        }

  updateTeamInvite owner domain (object ["team_invite" .= "team", "sso" .= idpId, "team" .= tid])
    >>= assertStatus 200

  -- Now invitaions only work for the orig team
  let email3 = String
"user3@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  postInvitation owner2 def {email = Just email3} `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

  invitation2ToOrigTeam <- postInvitation owner def {email = Just email3} >>= getJSON 201
  invitation2CodeToOrigTeam <- (getInvitationCode owner invitation2ToOrigTeam >>= getJSON 200) %. "code" & asString
  assertSuccess
    =<< addUser
      owner
      def
        { email = Just email3,
          teamCode = Just invitation2CodeToOrigTeam
        }

testDisallowAcceptingInvitesAfterDomainIsClaimed :: (HasCallStack) => App ()
testDisallowAcceptingInvitesAfterDomainIsClaimed :: HasCallStack => App ()
testDisallowAcceptingInvitesAfterDomainIsClaimed = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  domain <- App String
randomDomain
  (owner, _, _) <- createTeam OwnDomain 1
  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  invitation <- postInvitation owner def {email = Just email} >>= getJSON 201
  invitationCode <- (getInvitationCode owner invitation >>= getJSON 200) %. "code" & asString

  -- [backoffice] preauth
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  setup <- setupOwnershipTokenForBackend OwnDomain domain

  -- [customer admin] post no-registration config
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (mkDomainRedirectBackend version "https:/example.com" "https://webapp.example.com")
    >>= assertStatus 200

  addUser owner def {email = Just email, teamCode = Just invitationCode} `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"