-- 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 API.GalleyInternal where

import qualified Data.Aeson as A
import qualified Data.Aeson as Aeson
import Data.String.Conversions (cs)
import qualified Data.Text as T
import qualified Data.Vector as Vector
import GHC.Stack
import Testlib.Prelude

putTeamMember :: (HasCallStack, MakesValue user, MakesValue team) => user -> team -> Int -> App Response
putTeamMember :: forall user team.
(HasCallStack, MakesValue user, MakesValue team) =>
user -> team -> Int -> App Response
putTeamMember user
user team
team Int
perms = do
  uid <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
user
  tid <- asString team
  req <-
    baseRequest
      user
      Galley
      Unversioned
      ("/i/teams/" <> tid <> "/members")

  submit
    "PUT"
    $ addJSONObject
      [ "member"
          .= object
            [ "user" .= uid,
              "permissions"
                .= object
                  [ "self" .= perms,
                    "copy" .= perms
                  ]
            ]
      ]
      req

getTeamFeature :: (HasCallStack, MakesValue domain_) => domain_ -> String -> String -> App Response
getTeamFeature :: forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
getTeamFeature domain_
domain_ String
tid String
featureName = do
  req <- domain_ -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain_
domain_ Service
Galley Versioned
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"teams", String
tid, String
"features", String
featureName]
  submit "GET" $ req

setTeamFeatureStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App Response
setTeamFeatureStatus :: forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus domain
domain team
team String
featureName String
status = do
  tid <- team -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString team
team
  req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
  submit "PATCH" $ req & addJSONObject ["status" .= status]

setTeamFeatureLockStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus :: forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus domain
domain team
team String
featureName String
status = do
  tid <- team -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString team
team
  req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName, status]
  bindResponse (submit "PUT" $ req) $ \Response
res ->
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

getFederationStatus ::
  ( HasCallStack,
    MakesValue user
  ) =>
  user ->
  [String] ->
  App Response
getFederationStatus :: forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
getFederationStatus user
user [String]
domains =
  let domainList :: Value
domainList = Array -> Value
Aeson.Array ([Value] -> Array
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ Text -> Value
Aeson.String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Value) -> [String] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
domains)
   in do
        req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"federation-status"]
        submit
          "GET"
          $ req
          & addJSONObject ["domains" .= domainList]

-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/put_i_legalhold_whitelisted_teams__tid_
legalholdWhitelistTeam :: (HasCallStack, MakesValue uid, MakesValue tid) => tid -> uid -> App Response
legalholdWhitelistTeam :: forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam tid
tid uid
uid = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  req <- baseRequest uid Galley Unversioned $ joinHttpPath ["i", "legalhold", "whitelisted-teams", tidStr]
  submit "PUT" req

-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/get_i_legalhold_whitelisted_teams__tid_
legalholdIsTeamInWhitelist :: (HasCallStack, MakesValue uid, MakesValue tid) => tid -> uid -> App Response
legalholdIsTeamInWhitelist :: forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist tid
tid uid
uid = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  req <- baseRequest uid Galley Unversioned $ joinHttpPath ["i", "legalhold", "whitelisted-teams", tidStr]
  submit "GET" req

-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/get_i_teams__tid__features_legalhold
legalholdIsEnabled :: (HasCallStack, MakesValue tid, MakesValue uid) => tid -> uid -> App Response
legalholdIsEnabled :: forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> App Response
legalholdIsEnabled tid
tid uid
uid = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  baseRequest uid Galley Unversioned do joinHttpPath ["i", "teams", tidStr, "features", "legalhold"]
    >>= submit "GET"

generateVerificationCode :: (HasCallStack, MakesValue domain, MakesValue email) => domain -> email -> App ()
generateVerificationCode :: forall domain email.
(HasCallStack, MakesValue domain, MakesValue email) =>
domain -> email -> App ()
generateVerificationCode domain
domain email
email = do
  res <- domain -> email -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> App Response
generateVerificationCode' domain
domain email
email
  res.status `shouldMatchInt` 200

generateVerificationCode' :: (HasCallStack, MakesValue domain, MakesValue email) => domain -> email -> App Response
generateVerificationCode' :: forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> App Response
generateVerificationCode' domain
domain email
email = do
  req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Brig Versioned
Versioned String
"/verification-code/send"
  emailStr <- asString email
  submit "POST" $ req & addJSONObject ["email" .= emailStr, "action" .= "login"]

setTeamFeatureConfig ::
  (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) =>
  domain ->
  team ->
  featureName ->
  payload ->
  App Response
setTeamFeatureConfig :: forall domain team featureName payload.
(HasCallStack, MakesValue domain, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
domain -> team -> featureName -> payload -> App Response
setTeamFeatureConfig domain
domain team
team featureName
featureName payload
payload = do
  tid <- team -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString team
team
  fn <- asString featureName
  p <- make payload
  req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", fn]
  submit "PUT" $ req & addJSON p

patchTeamFeatureConfig ::
  (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) =>
  domain ->
  team ->
  featureName ->
  payload ->
  App Response
patchTeamFeatureConfig :: forall domain team featureName payload.
(HasCallStack, MakesValue domain, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
domain -> team -> featureName -> payload -> App Response
patchTeamFeatureConfig domain
domain team
team featureName
featureName payload
payload = do
  tid <- team -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString team
team
  fn <- asString featureName
  p <- make payload
  req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", fn]
  submit "PATCH" $ req & addJSON p

patchTeamFeature :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> Value -> App Response
patchTeamFeature :: forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> Value -> App Response
patchTeamFeature domain
domain team
team String
featureName Value
payload = do
  tid <- team -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString team
team
  req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
  submit "PATCH" $ req & addJSON payload

getTeam :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
getTeam :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getTeam domain
domain String
tid = do
  req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Galley Versioned
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"teams", String
tid]
  submit "GET" $ req

setTeamFeatureMigrationState :: (HasCallStack, MakesValue domain) => domain -> String -> String -> App Response
setTeamFeatureMigrationState :: forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
setTeamFeatureMigrationState domain
domain String
tid String
state = do
  req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Galley Versioned
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"teams", String
tid, String
"feature-migration-state"]
  submit "PUT" $ req & addJSON (A.String (T.pack state))

setCellsState :: (MakesValue user, MakesValue conv) => user -> conv -> String -> App Response
setCellsState :: forall user conv.
(MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
setCellsState user
user conv
conv String
state = do
  convId <- (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String) -> App (String, String) -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  req <- baseRequest user Galley Unversioned $ joinHttpPath ["i", "conversations", convId, "cells-state"]
  submit "PUT" $ req & addJSON (toJSON state)

getConversation :: (HasCallStack, MakesValue conv) => conv -> App Response
getConversation :: forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
getConversation conv
conv = do
  (domain, convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "conversations", convId]
  submit "GET" $ req

selectTeamMembers :: (HasCallStack, MakesValue domain) => domain -> String -> [String] -> App Response
selectTeamMembers :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> [String] -> App Response
selectTeamMembers domain
domain String
tid [String]
uids = do
  req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Galley Versioned
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"teams", String
tid, String
"members", String
"by-ids"]
  submit "GET" $ req & addJSON (object ["ids" .= uids])

isConversationOutOfSync :: (HasCallStack, MakesValue conv) => conv -> App Response
isConversationOutOfSync :: forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
isConversationOutOfSync conv
conv = do
  (domain, convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  baseRequest
    domain
    Galley
    Unversioned
    (joinHttpPath ["i", "conversations", convId, "out-of-sync"])
    >>= submit "GET"