content: -- | See also: "Test.DomainVerification"
  module Test.EnterpriseLogin where
  
  import API.BrigInternal
  import API.Common
  import Control.Monad.Trans.Maybe
  import Testlib.Prelude
  
  testDomainRegistrationLock :: App ()
  testDomainRegistrationLock = do
    domain <- randomDomain
    -- it should not yet exist
    assertStatus 404 =<< getDomainRegistration OwnDomain domain
    -- add to deny-list
    assertStatus 204 =<< domainRegistrationLock OwnDomain domain
    -- idempotent
    assertStatus 204 =<< domainRegistrationLock OwnDomain domain
    -- it got created
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "locked"
      resp.json %. "team_invite" `shouldMatch` "allowed"
    -- remove from deny-list
    assertStatus 204 =<< domainRegistrationUnlock OwnDomain domain
    -- check that it got removed
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "none"
      resp.json %. "team_invite" `shouldMatch` "allowed"
  
  testDomainRegistrationLockPreviousValueOverwritten :: App ()
  testDomainRegistrationLockPreviousValueOverwritten = do
    domain <- randomDomain
    -- pre-authorize
    assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "pre-authorized"
    -- lock
    assertStatus 204 =<< domainRegistrationLock OwnDomain domain
    -- check that it got overwritten
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "locked"
  
  testDomainRegistrationUnlockErrorIfNotLocked :: App ()
  testDomainRegistrationUnlockErrorIfNotLocked = do
    domain <- randomDomain
    -- pre-authorize
    assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "pre-authorized"
    -- attempt to unlock should fail
    bindResponse (domainRegistrationUnlock OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 403
      resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state"
  
  testDomainRegistrationPreAuthorize :: App ()
  testDomainRegistrationPreAuthorize = do
    domain <- randomDomain
    -- it should not yet exist
    assertStatus 404 =<< getDomainRegistration OwnDomain domain
    -- pre-authorize
    assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain
    -- idempotent
    assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain
    -- it got created
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "pre-authorized"
      resp.json %. "team_invite" `shouldMatch` "allowed"
  
  testDomainRegistrationPreAuthorizeFailsIfLocked :: App ()
  testDomainRegistrationPreAuthorizeFailsIfLocked = do
    domain <- randomDomain
    -- add to deny-list
    assertStatus 204 =<< domainRegistrationLock OwnDomain domain
    -- pre-authorize
    bindResponse (domainRegistrationPreAuthorize OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 403
      resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state"
    -- check that it was not set to pre-authorized
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "locked"
    -- remove from deny-list
    assertStatus 204 =<< domainRegistrationUnlock OwnDomain domain
    -- now it should work
    assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain
    -- domain redirect should be pre-authorized
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "pre-authorized"
      resp.json %. "team_invite" `shouldMatch` "allowed"
  
  testDomainRegistrationPreAuthorizeDoesNotAlterTeamInvite :: App ()
  testDomainRegistrationPreAuthorizeDoesNotAlterTeamInvite = do
    domain <- randomDomain
    -- it should not yet exist
    assertStatus 404 =<< getDomainRegistration OwnDomain domain
    let update =
          object
            [ "domain_redirect" .= "none",
              "team_invite" .= "team",
              "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db"
            ]
    assertStatus 204 =<< updateDomainRegistration OwnDomain domain update
    -- pre-authorize
    assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "pre-authorized"
      resp.json %. "team_invite" `shouldMatch` "team"
      resp.json %. "team" `shouldMatch` "3bc23f21-dc03-4922-9563-c3beedf895db"
      -- Check that neither the old nor the new fields are there.
      lookupField resp.json "backend" `shouldMatch` (Nothing :: Maybe Value)
      lookupField resp.json "backend_url" `shouldMatch` (Nothing :: Maybe Value)
  
  testDomainRegistrationQueriesDoNotCreateEntry :: App ()
  testDomainRegistrationQueriesDoNotCreateEntry = do
    domain <- randomDomain
    assertStatus 404 =<< getDomainRegistration OwnDomain domain
    assertStatus 404 =<< domainRegistrationUnlock OwnDomain domain
    assertStatus 404 =<< domainRegistrationUnAuthorize OwnDomain domain
    assertStatus 404 =<< getDomainRegistration OwnDomain domain
  
  testDomainRegistrationUpdate :: App ()
  testDomainRegistrationUpdate = do
    domain <- randomDomain
    -- it should not yet exist
    assertStatus 404 =<< getDomainRegistration OwnDomain domain
    updateDomain domain
      $ object
        [ "domain_redirect" .= "backend",
          "backend"
            .= object
              [ "config_url" .= "https://example.com",
                "webapp_url" .= "https://webapp.example.com"
              ],
          "team_invite" .= "not-allowed"
        ]
    updateDomain domain
      $ object
        [ "domain_redirect" .= "sso",
          "sso_code" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000",
          "team_invite" .= "allowed"
        ]
    updateDomain domain
      $ object
        [ "domain_redirect" .= "no-registration",
          "team_invite" .= "team",
          "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db"
        ]
    where
      updateDomain :: (HasCallStack) => String -> Value -> App ()
      updateDomain domain update = do
        -- update
        assertStatus 204 =<< updateDomainRegistration OwnDomain domain update
        -- idempotent
        assertStatus 204 =<< updateDomainRegistration OwnDomain domain update
        -- it got created
        bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
          resp.status `shouldMatchInt` 200
          resp.json %. "domain" `shouldMatch` domain
          resp.json %. "domain_redirect" `shouldMatch` (update %. "domain_redirect")
          resp.json %. "team_invite" `shouldMatch` (update %. "team_invite")
          getBackendCfgField resp.json "config_url" `shouldMatch` getBackendCfgField update "config_url"
          getBackendCfgField resp.json "webapp_url" `shouldMatch` getBackendCfgField update "webapp_url"
          lookupField resp.json "sso_code" `shouldMatch` lookupField update "sso_code"
          lookupField resp.json "team" `shouldMatch` lookupField update "team"
  
      getBackendCfgField :: (MakesValue a) => a -> String -> App (Maybe Value)
      getBackendCfgField cfg field =
        runMaybeT
          $ lookupFieldM cfg "backend"
          >>= flip lookupFieldM field
  
  testDomainRegistrationUpdateInvalidCases :: App ()
  testDomainRegistrationUpdateInvalidCases = do
    domain <- randomDomain
    checkUpdateFails domain $ object ["domain_redirect" .= "locked", "team_invite" .= "not-allowed"]
    checkUpdateFails domain $ object ["domain_redirect" .= "locked", "team_invite" .= "team", "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db"]
    checkUpdateFails domain
      $ object
        [ "domain_redirect" .= "backend",
          "backend"
            .= object
              [ "config_url" .= "https://example.com",
                "webapp_url" .= "https://webapp.example.com"
              ],
          "team_invite" .= "team",
          "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db"
        ]
    checkUpdateFails domain
      $ object
        [ "domain_redirect" .= "backend",
          "backend"
            .= object
              [ "config_url" .= "https://example.com",
                "webapp_url" .= "https://webapp.example.com"
              ],
          "team_invite" .= "allowed"
        ]
    where
      checkUpdateFails :: String -> Value -> App ()
      checkUpdateFails domain update = do
        bindResponse (updateDomainRegistration OwnDomain domain update) $ \resp -> do
          resp.status `shouldMatchInt` 403
          resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state"
  
  testDomainRegistrationPreAuthorizedToUnAuthorize :: App ()
  testDomainRegistrationPreAuthorizedToUnAuthorize = do
    domain <- randomDomain
    let update =
          object
            [ "domain_redirect" .= "pre-authorized",
              "team_invite" .= "allowed"
            ]
    assertStatus 204 =<< updateDomainRegistration OwnDomain domain update
    assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain
    assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "none"
      resp.json %. "team_invite" `shouldMatch` "allowed"
  
  testDomainRegistrationBackendToUnAuthorize :: App ()
  testDomainRegistrationBackendToUnAuthorize = do
    domain <- randomDomain
    let update =
          object
            [ "domain_redirect" .= "backend",
              "backend"
                .= object
                  [ "config_url" .= "https://example.com",
                    "webapp_url" .= "https://webapp.example.com"
                  ],
              "team_invite" .= "not-allowed"
            ]
    assertStatus 204 =<< updateDomainRegistration OwnDomain domain update
    assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "none"
      resp.json %. "team_invite" `shouldMatch` "not-allowed"
    assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain
  
  testDomainRegistrationNoRegistrationToUnAuthorize :: App ()
  testDomainRegistrationNoRegistrationToUnAuthorize = do
    domain <- randomDomain
    let update =
          object
            [ "domain_redirect" .= "no-registration",
              "team_invite" .= "allowed"
            ]
    assertStatus 204 =<< updateDomainRegistration OwnDomain domain update
    assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain
    assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "none"
      resp.json %. "team_invite" `shouldMatch` "allowed"
  
  testDomainRegistrationUnAuthorizeFailureWhenLocked :: App ()
  testDomainRegistrationUnAuthorizeFailureWhenLocked = do
    domain <- randomDomain
    let update =
          object
            [ "domain_redirect" .= "locked",
              "team_invite" .= "allowed"
            ]
    assertStatus 204 =<< updateDomainRegistration OwnDomain domain update
    assertStatus 403 =<< domainRegistrationUnAuthorize OwnDomain domain
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "locked"
      resp.json %. "team_invite" `shouldMatch` "allowed"
  
  testDomainRegistrationUnAuthorizeFailureWhenSso :: App ()
  testDomainRegistrationUnAuthorizeFailureWhenSso = do
    domain <- randomDomain
    let update =
          object
            [ "domain_redirect" .= "sso",
              "sso_code" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000",
              "team_invite" .= "team",
              "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db"
            ]
    assertStatus 204 =<< updateDomainRegistration OwnDomain domain update
    assertStatus 403 =<< domainRegistrationUnAuthorize OwnDomain domain
    bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain" `shouldMatch` domain
      resp.json %. "domain_redirect" `shouldMatch` "sso"
      resp.json %. "team_invite" `shouldMatch` "team"
  
  testDomainRegistrationDelete :: App ()
  testDomainRegistrationDelete = do
    domain <- randomDomain
    let update =
          object
            [ "domain_redirect" .= "sso",
              "sso_code" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000",
              "team_invite" .= "team",
              "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db"
            ]
    assertStatus 204 =<< updateDomainRegistration OwnDomain domain update
    assertStatus 204 =<< deleteDomainRegistration OwnDomain domain
    assertStatus 404 =<< getDomainRegistration OwnDomain domain
    assertStatus 204 =<< deleteDomainRegistration OwnDomain domain
  