-- 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.Provider where

import API.Brig
import API.BrigInternal
import qualified API.Cargohold as Cargohold
import API.Common
import qualified API.Nginz as Nginz
import Data.String.Conversions (cs)
import SetupHelpers
import Testlib.Prelude

testProviderUploadAsset :: (HasCallStack) => App ()
testProviderUploadAsset :: HasCallStack => App ()
testProviderUploadAsset = do
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  provider <- setupProvider alice def {newProviderPassword = Just defPassword}
  providerEmail <- provider %. "email" & asString
  pid <- provider %. "id" & asString
  -- test cargohold API
  bindResponse (Cargohold.uploadProviderAsset OwnDomain pid "profile pic") $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
  cookie <-
    loginProvider OwnDomain providerEmail defPassword `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      let hs :: [Header]
hs = Response -> [Header]
headers Response
resp
          setCookieHeader :: HeaderName
setCookieHeader = String -> HeaderName
forall a. IsString a => String -> a
fromString String
"Set-Cookie"
      ByteString -> App ByteString
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> App ByteString)
-> ([Header] -> ByteString) -> [Header] -> App ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString)
-> ([Header] -> Maybe ByteString) -> [Header] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> Maybe ByteString) -> [Header] -> Maybe ByteString
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(HeaderName
k, ByteString
v) -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (HeaderName
k HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
setCookieHeader) Maybe () -> ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ByteString
v) ([Header] -> App ByteString) -> [Header] -> App ByteString
forall a b. (a -> b) -> a -> b
$ [Header]
hs

  -- test Nginz API
  bindResponse (Nginz.uploadProviderAsset OwnDomain (cs cookie) "another profile pic") $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

testProviderPasswordReset :: (HasCallStack) => App ()
testProviderPasswordReset :: HasCallStack => App ()
testProviderPasswordReset = do
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def
      { brigCfg =
          -- Disable password hashing rate limiting, so we can create enable services quickly
          setField @_ @Int "optSettings.setPasswordHashingRateLimit.userLimit.inverseRate" 0
      }
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      provider <- String -> NewProvider -> App Value
forall user.
(HasCallStack, MakesValue user) =>
user -> NewProvider -> App Value
setupProvider String
domain NewProvider
forall a. Default a => a
def {newProviderPassword = Just defPassword}
      email <- asString $ provider %. "email"
      requestProviderPasswordResetCode domain email >>= assertSuccess
      resetCode <- getProviderPasswordResetCodeInternal domain email >>= getJSON 200

      completeProviderPasswordReset domain resetCode defPassword `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409
        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
"password-must-differ"

      completeProviderPasswordReset domain resetCode "shiny-new-password" >>= assertSuccess
      loginProvider domain email "shiny-new-password" >>= assertSuccess
      loginProvider domain email defPassword `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
"invalid-credentials"

testProviderPasswordResetAfterEmailUpdate :: (HasCallStack) => App ()
testProviderPasswordResetAfterEmailUpdate :: HasCallStack => App ()
testProviderPasswordResetAfterEmailUpdate = do
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def
      { brigCfg =
          -- Disable password hashing rate limiting, so we can create enable services quickly
          setField @_ @Int "optSettings.setPasswordHashingRateLimit.userLimit.inverseRate" 0
      }
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      provider <- String -> NewProvider -> App Value
forall user.
(HasCallStack, MakesValue user) =>
user -> NewProvider -> App Value
setupProvider String
domain NewProvider
forall a. Default a => a
def {newProviderPassword = Just defPassword}
      origEmail <- asString $ provider %. "email"
      pid <- asString $ provider %. "id"
      newEmail <- randomEmail
      requestProviderPasswordResetCode domain origEmail >>= assertSuccess
      requestProviderEmailUpdateCode domain pid newEmail >>= assertSuccess
      passwordResetCode <- getProviderPasswordResetCodeInternal domain origEmail >>= getJSON 200
      emailUpdateKeyCodePair <- getProviderActivationCodeInternal domain newEmail >>= getJSON 200
      emailUpdateKey <- asString $ emailUpdateKeyCodePair %. "key"
      emailUpdateCode <- asString $ emailUpdateKeyCodePair %. "code"

      activateProvider domain emailUpdateKey emailUpdateCode

      completeProviderPasswordReset domain passwordResetCode "shiny-new-password" `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
"invalid-code"

      loginProvider domain origEmail defPassword `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
"invalid-credentials"
      loginProvider domain newEmail defPassword >>= assertSuccess

      requestProviderPasswordResetCode domain newEmail >>= assertSuccess
      newPasswordResetCode <- getProviderPasswordResetCodeInternal domain newEmail >>= getJSON 200
      completeProviderPasswordReset domain newPasswordResetCode "shiny-new-password" >>= assertSuccess
      loginProvider domain newEmail "shiny-new-password" >>= assertSuccess

testProviderSearchWhitelist :: (HasCallStack) => App ()
testProviderSearchWhitelist :: HasCallStack => App ()
testProviderSearchWhitelist =
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def
      { brigCfg =
          -- Disable password hashing rate limiting, so we can create enable services quickly
          setField @_ @Int "optSettings.setPasswordHashingRateLimit.userLimit.inverseRate" 0
      }
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      (owner, tid, [user]) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
2
      provider <- setupProvider owner def {newProviderPassword = Just defPassword}
      pid <- asString $ provider %. "id"
      namePrefix <- randomString 10

      services <-
        forM (taggedServiceNames namePrefix) $ \(String
name, [String]
tags) -> do
          String -> Value -> String -> String -> NewService -> App Value
forall domain user.
(MakesValue domain, MakesValue user) =>
domain -> user -> String -> String -> NewService -> App Value
createAndEnableService String
domain Value
owner String
tid String
pid NewService
forall a. Default a => a
def {newServiceName = name, newServiceTags = tags}

      allServiceIds <- traverse (%. "id") services

      -- Searching with the common prefix shows all of them
      listTeamServiceProfilesByPrefix user tid (Just namePrefix) False 20 `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        (Value -> App Value)
-> MakesValue (App Value) => App Value -> App [Value]
forall b a.
HasCallStack =>
(Value -> App b) -> MakesValue a => a -> App [b]
asListOf (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services") App [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value]
allServiceIds

      -- Searching without filtering returns all of them because all are enabled
      listTeamServiceProfilesByPrefix user tid (Just namePrefix) True 20 `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        (Value -> App Value)
-> MakesValue (App Value) => App Value -> App [Value]
forall b a.
HasCallStack =>
(Value -> App b) -> MakesValue a => a -> App [b]
asListOf (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services") App [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value]
allServiceIds

      -- Search should yield services ordered by named
      zerosPrefixedService <- do
        serviceSuffix <- randomString 10
        createAndEnableService domain owner tid pid def {newServiceName = "0000000000|" <> serviceSuffix, newServiceTags = ["social"]}
      listTeamServiceProfilesByPrefix user tid Nothing True 20 `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        firstServiceId <- (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") (Value -> App Value) -> ([Value] -> Value) -> [Value] -> App Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
forall a. HasCallStack => [a] -> a
head ([Value] -> App Value) -> App [Value] -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services")
        firstServiceId `shouldMatch` (zerosPrefixedService %. "id")

      -- Search by exact name yields only one service
      forM_ (take 3 services) $ \Value
service -> do
        name <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value
service Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name"
        listTeamServiceProfilesByPrefix user tid (Just name) False 20 `bindResponse` \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"has_more" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
          (Value -> App Value)
-> MakesValue (App Value) => App Value -> App [Value]
forall b a.
HasCallStack =>
(Value -> App b) -> MakesValue a => a -> App [b]
asListOf (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services") App [Value] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
name]

      -- Search by prefix, case insensitve, doesn't asciify special characters
      -- like name search
      forM_ [("Bjø", "Bjørn"), ("Bjo", "bjorn"), ("chris", "CHRISTMAS")] $ \(String
searchTerm, String
hardcodedName) ->
        Value -> String -> Maybe String -> Bool -> Int -> App Response
forall user.
MakesValue user =>
user -> String -> Maybe String -> Bool -> Int -> App Response
listTeamServiceProfilesByPrefix Value
user String
tid (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
namePrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"|" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
searchTerm) Bool
False Int
20 App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"has_more" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
          (Value -> App Value)
-> MakesValue (App Value) => App Value -> App [Value]
forall b a.
HasCallStack =>
(Value -> App b) -> MakesValue a => a -> App [b]
asListOf (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services") App [Value] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [(String
namePrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"|" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
hardcodedName)]

      -- Search works even after changing name
      let alphaService = [Value] -> Value
forall a. HasCallStack => [a] -> a
head [Value]
services
          newAlphaName = String
namePrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"|" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"NotAlphaAnyMore"
      alphaServiceId <- alphaService %. "id"
      updateService domain pid alphaServiceId Nothing (Just newAlphaName)
        >>= assertSuccess
      listTeamServiceProfilesByPrefix user tid (Just newAlphaName) False 20 `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services.0.id" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
alphaServiceId
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services.0.name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newAlphaName

createAndEnableService ::
  (MakesValue domain, MakesValue user) =>
  domain ->
  user ->
  String ->
  String ->
  NewService ->
  App Value
createAndEnableService :: forall domain user.
(MakesValue domain, MakesValue user) =>
domain -> user -> String -> String -> NewService -> App Value
createAndEnableService domain
domain user
teamAdmin String
tid String
pid NewService
newSvc = do
  serviceId <- (domain -> String -> NewService -> App Value
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> NewService -> App Value
newService domain
domain String
pid NewService
newSvc) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  -- serviceId <- asString $ service %. "id"
  updateServiceConn domain pid serviceId (object ["password" .= defPassword, "enabled" .= True])
    >>= assertSuccess
  postServiceWhitelist teamAdmin tid (object ["id" .= serviceId, "provider" .= pid, "whitelisted" .= True])
    >>= assertSuccess
  getService domain pid serviceId >>= getJSON 200

-- | A list of 20 services ordered alphabetically, all having names that begin
-- with the given prefix.
--
-- NB: in some of the tests above, we depend on the fact that there are exactly
-- 20 services here and the fact that they are ordered alphabetically.
taggedServiceNames :: String -> [(String, [String])]
taggedServiceNames :: String -> [(String, [String])]
taggedServiceNames String
prefix =
  [ (String -> String
prefixed String
"Alpha", [String
"social", String
"quiz", String
"business"]),
    (String -> String
prefixed String
"Beta", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"bjorn", [String
"social", String
"quiz", String
"travel"]),
    (String -> String
prefixed String
"Bjørn", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"CHRISTMAS", [String
"social", String
"quiz", String
"weather"]),
    (String -> String
prefixed String
"Delta", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Epsilon", [String
"social", String
"quiz", String
"business"]),
    (String -> String
prefixed String
"Freer", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Gamma", [String
"social", String
"quiz", String
"weather"]),
    (String -> String
prefixed String
"Gramma", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Hera", [String
"social", String
"quiz", String
"travel"]),
    (String -> String
prefixed String
"Io", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Jojo", [String
"social", String
"quiz", String
"weather"]),
    (String -> String
prefixed String
"Kuba", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Lawn", [String
"social", String
"quiz", String
"travel"]),
    (String -> String
prefixed String
"Mango", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"North", [String
"social", String
"quiz", String
"weather"]),
    (String -> String
prefixed String
"Yak", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Zeta", [String
"social", String
"quiz", String
"travel"]),
    (String -> String
prefixed String
"Zulu", [String
"social", String
"music", String
"lifestyle"])
  ]
  where
    prefixed :: String -> String
prefixed String
n = (String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"|" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n)