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

import API.BrigCommon
import API.Common
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Pair)
import Data.Function
import Data.Maybe
import Testlib.Prelude

data CreateUser = CreateUser
  { CreateUser -> Maybe String
email :: Maybe String,
    CreateUser -> Maybe String
password :: Maybe String,
    CreateUser -> Maybe String
name :: Maybe String,
    CreateUser -> Bool
team :: Bool,
    CreateUser -> Bool
activate :: Bool,
    CreateUser -> Maybe [String]
supportedProtocols :: Maybe [String]
  }

instance Default CreateUser where
  def :: CreateUser
def =
    CreateUser
      { email :: Maybe String
email = Maybe String
forall a. Maybe a
Nothing,
        password :: Maybe String
password = Maybe String
forall a. Maybe a
Nothing,
        name :: Maybe String
name = Maybe String
forall a. Maybe a
Nothing,
        team :: Bool
team = Bool
False,
        activate :: Bool
activate = Bool
True,
        supportedProtocols :: Maybe [String]
supportedProtocols = Maybe [String]
forall a. Maybe a
Nothing
      }

createUser :: (HasCallStack, MakesValue domain) => domain -> CreateUser -> App Response
createUser :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Response
createUser domain
domain CreateUser
cu = do
  re <- App String
randomEmail
  let email :: Maybe String = guard cu.activate $> fromMaybe re cu.email
  let password = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defPassword CreateUser
cu.password
      name = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"default" (CreateUser
cu.name Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
email)
  req <- baseRequest domain Brig Unversioned "/i/users"
  submit "POST" $
    req
      & addJSONObject
        ( ["email" .= e | e <- toList email]
            <> [ "name" .= name,
                 "password" .= password,
                 "icon" .= "default"
               ]
            <> ["supported_protocols" .= prots | prots <- toList cu.supportedProtocols]
            <> [ "team"
                   .= object
                     [ "name" .= "integration test team",
                       "icon" .= "default"
                     ]
                 | cu.team
               ]
        )

-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/get_i_users
getUsersId :: (HasCallStack, MakesValue domain) => domain -> [String] -> App Response
getUsersId :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId domain
domain [String]
ids = 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
Unversioned String
"/i/users"
  submit "GET" $ req & addQueryParams [("ids", intercalate "," ids)]

getUsersByEmail :: (HasCallStack, MakesValue domain) => domain -> [String] -> App Response
getUsersByEmail :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail domain
domain [String]
emails = 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
Unversioned String
"/i/users"
  submit "GET" $ req & addQueryParams [("email", intercalate "," emails)]

data FedConn = FedConn
  { FedConn -> String
domain :: String,
    FedConn -> String
searchStrategy :: String,
    FedConn -> Maybe [String]
restriction :: Maybe [String]
  }
  deriving (FedConn -> FedConn -> Bool
(FedConn -> FedConn -> Bool)
-> (FedConn -> FedConn -> Bool) -> Eq FedConn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FedConn -> FedConn -> Bool
== :: FedConn -> FedConn -> Bool
$c/= :: FedConn -> FedConn -> Bool
/= :: FedConn -> FedConn -> Bool
Eq, Eq FedConn
Eq FedConn =>
(FedConn -> FedConn -> Ordering)
-> (FedConn -> FedConn -> Bool)
-> (FedConn -> FedConn -> Bool)
-> (FedConn -> FedConn -> Bool)
-> (FedConn -> FedConn -> Bool)
-> (FedConn -> FedConn -> FedConn)
-> (FedConn -> FedConn -> FedConn)
-> Ord FedConn
FedConn -> FedConn -> Bool
FedConn -> FedConn -> Ordering
FedConn -> FedConn -> FedConn
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FedConn -> FedConn -> Ordering
compare :: FedConn -> FedConn -> Ordering
$c< :: FedConn -> FedConn -> Bool
< :: FedConn -> FedConn -> Bool
$c<= :: FedConn -> FedConn -> Bool
<= :: FedConn -> FedConn -> Bool
$c> :: FedConn -> FedConn -> Bool
> :: FedConn -> FedConn -> Bool
$c>= :: FedConn -> FedConn -> Bool
>= :: FedConn -> FedConn -> Bool
$cmax :: FedConn -> FedConn -> FedConn
max :: FedConn -> FedConn -> FedConn
$cmin :: FedConn -> FedConn -> FedConn
min :: FedConn -> FedConn -> FedConn
Ord, Int -> FedConn -> ShowS
[FedConn] -> ShowS
FedConn -> String
(Int -> FedConn -> ShowS)
-> (FedConn -> String) -> ([FedConn] -> ShowS) -> Show FedConn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FedConn -> ShowS
showsPrec :: Int -> FedConn -> ShowS
$cshow :: FedConn -> String
show :: FedConn -> String
$cshowList :: [FedConn] -> ShowS
showList :: [FedConn] -> ShowS
Show)

instance ToJSON FedConn where
  toJSON :: FedConn -> Value
toJSON (FedConn String
d String
s Maybe [String]
r) =
    [Pair] -> Value
Aeson.object
      [ String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
d,
        String
"search_policy" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
s,
        String
"restriction"
          String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value -> ([String] -> Value) -> Maybe [String] -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            ([Pair] -> Value
Aeson.object [String
"tag" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"allow_all", String
"value" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
Aeson.Null])
            ( \[String]
teams ->
                [Pair] -> Value
Aeson.object [String
"tag" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"restrict_by_team", String
"value" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON [String]
teams]
            )
            Maybe [String]
r
      ]

instance MakesValue FedConn where
  make :: HasCallStack => FedConn -> App Value
make = Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> App Value) -> (FedConn -> Value) -> FedConn -> App Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FedConn -> Value
forall a. ToJSON a => a -> Value
toJSON

createFedConn :: (HasCallStack, MakesValue dom, MakesValue fedConn) => dom -> fedConn -> App Response
createFedConn :: forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
createFedConn dom
dom fedConn
fedConn = do
  App Response -> (Response -> App Response) -> App Response
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (dom -> fedConn -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
createFedConn' dom
dom fedConn
fedConn) ((Response -> App Response) -> App Response)
-> (Response -> App Response) -> App Response
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
    Response
res.status Int -> (Int, Int) -> App ()
forall a. (MakesValue a, HasCallStack) => a -> (Int, Int) -> App ()
`shouldMatchRange` (Int
200, Int
299)
    Response -> App Response
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
res

createFedConn' :: (HasCallStack, MakesValue dom, MakesValue fedConn) => dom -> fedConn -> App Response
createFedConn' :: forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
createFedConn' dom
dom fedConn
fedConn = do
  req <- dom -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
rawBaseRequest dom
dom Service
Brig Versioned
Unversioned String
"/i/federation/remotes"
  conn <- make fedConn
  submit "POST" $ req & addJSON conn

readFedConns :: (HasCallStack, MakesValue dom) => dom -> App Response
readFedConns :: forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
readFedConns dom
dom = do
  App Response -> (Response -> App Response) -> App Response
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (dom -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
readFedConns' dom
dom) ((Response -> App Response) -> App Response)
-> (Response -> App Response) -> App Response
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
    Response
res.status Int -> (Int, Int) -> App ()
forall a. (MakesValue a, HasCallStack) => a -> (Int, Int) -> App ()
`shouldMatchRange` (Int
200, Int
299)
    Response -> App Response
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
res

readFedConns' :: (HasCallStack, MakesValue dom) => dom -> App Response
readFedConns' :: forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
readFedConns' dom
dom = do
  req <- dom -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
rawBaseRequest dom
dom Service
Brig Versioned
Unversioned String
"/i/federation/remotes"
  submit "GET" req

updateFedConn :: (HasCallStack, MakesValue owndom, MakesValue fedConn) => owndom -> String -> fedConn -> App Response
updateFedConn :: forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
updateFedConn owndom
owndom String
dom fedConn
fedConn = do
  App Response -> (Response -> App Response) -> App Response
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (owndom -> String -> fedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
updateFedConn' owndom
owndom String
dom fedConn
fedConn) ((Response -> App Response) -> App Response)
-> (Response -> App Response) -> App Response
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
    Response
res.status Int -> (Int, Int) -> App ()
forall a. (MakesValue a, HasCallStack) => a -> (Int, Int) -> App ()
`shouldMatchRange` (Int
200, Int
299)
    Response -> App Response
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
res

updateFedConn' :: (HasCallStack, MakesValue owndom, MakesValue fedConn) => owndom -> String -> fedConn -> App Response
updateFedConn' :: forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
updateFedConn' owndom
owndom String
dom fedConn
fedConn = do
  req <- owndom -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
rawBaseRequest owndom
owndom Service
Brig Versioned
Unversioned (String
"/i/federation/remotes/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
dom)
  conn <- make fedConn
  submit "PUT" $ addJSON conn req

registerOAuthClient :: (HasCallStack, MakesValue user, MakesValue name, MakesValue url) => user -> name -> url -> App Response
registerOAuthClient :: forall user name url.
(HasCallStack, MakesValue user, MakesValue name, MakesValue url) =>
user -> name -> url -> App Response
registerOAuthClient user
user name
name url
url = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Brig Versioned
Unversioned String
"i/oauth/clients"
  applicationName <- asString name
  redirectUrl <- asString url
  submit "POST" (req & addJSONObject ["application_name" .= applicationName, "redirect_url" .= redirectUrl])

getOAuthClient :: (HasCallStack, MakesValue user, MakesValue cid) => user -> cid -> App Response
getOAuthClient :: forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
getOAuthClient user
user cid
cid = do
  clientId <- cid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId cid
cid
  req <- baseRequest user Brig Unversioned $ "i/oauth/clients/" <> clientId
  submit "GET" req

updateOAuthClient :: (HasCallStack, MakesValue user, MakesValue cid, MakesValue name, MakesValue url) => user -> cid -> name -> url -> App Response
updateOAuthClient :: forall user cid name url.
(HasCallStack, MakesValue user, MakesValue cid, MakesValue name,
 MakesValue url) =>
user -> cid -> name -> url -> App Response
updateOAuthClient user
user cid
cid name
name url
url = do
  clientId <- cid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId cid
cid
  req <- baseRequest user Brig Unversioned $ "i/oauth/clients/" <> clientId
  applicationName <- asString name
  redirectUrl <- asString url
  submit "PUT" (req & addJSONObject ["application_name" .= applicationName, "redirect_url" .= redirectUrl])

deleteOAuthClient :: (HasCallStack, MakesValue user, MakesValue cid) => user -> cid -> App Response
deleteOAuthClient :: forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
deleteOAuthClient user
user cid
cid = do
  clientId <- cid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId cid
cid
  req <- baseRequest user Brig Unversioned $ "i/oauth/clients/" <> clientId
  submit "DELETE" req

getInvitationCode :: (HasCallStack, MakesValue user, MakesValue inv) => user -> inv -> App Response
getInvitationCode :: forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
getInvitationCode user
user inv
inv = do
  tid <- user
user user -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" 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
  getInvitationCodeForTeam user tid inv

getInvitationCodeForTeam :: (HasCallStack, MakesValue domain, MakesValue inv) => domain -> String -> inv -> App Response
getInvitationCodeForTeam :: forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
getInvitationCodeForTeam domain
domain String
tid inv
inv = do
  invId <- inv
inv inv -> 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
  req <-
    baseRequest domain Brig Unversioned $
      "i/teams/invitation-code?team=" <> tid <> "&invitation_id=" <> invId
  submit "GET" req

refreshIndex :: (HasCallStack, MakesValue domain) => domain -> App ()
refreshIndex :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App ()
refreshIndex domain
domain = 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
Unversioned String
"i/index/refresh"
  res <- submit "POST" req
  res.status `shouldMatchInt` 200

addFederationRemoteTeam :: (HasCallStack, MakesValue domain, MakesValue remoteDomain, MakesValue team) => domain -> remoteDomain -> team -> App ()
addFederationRemoteTeam :: forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
addFederationRemoteTeam domain
domain remoteDomain
remoteDomain team
team = do
  App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ domain -> remoteDomain -> team -> App Response
forall user name url.
(HasCallStack, MakesValue user, MakesValue name, MakesValue url) =>
user -> name -> url -> App Response
addFederationRemoteTeam' domain
domain remoteDomain
remoteDomain team
team App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200

addFederationRemoteTeam' :: (HasCallStack, MakesValue domain, MakesValue remoteDomain, MakesValue team) => domain -> remoteDomain -> team -> App Response
addFederationRemoteTeam' :: forall user name url.
(HasCallStack, MakesValue user, MakesValue name, MakesValue url) =>
user -> name -> url -> App Response
addFederationRemoteTeam' domain
domain remoteDomain
remoteDomain team
team = do
  d <- remoteDomain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString remoteDomain
remoteDomain
  t <- make team
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "federation", "remotes", d, "teams"]
  submit "POST" (req & addJSONObject ["team_id" .= t])

getFederationRemoteTeams :: (HasCallStack, MakesValue domain, MakesValue remoteDomain) => domain -> remoteDomain -> App Response
getFederationRemoteTeams :: forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
getFederationRemoteTeams domain
domain remoteDomain
remoteDomain = do
  d <- remoteDomain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString remoteDomain
remoteDomain
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "federation", "remotes", d, "teams"]
  submit "GET" req

deleteFederationRemoteTeam :: (HasCallStack, MakesValue domain, MakesValue remoteDomain, MakesValue team) => domain -> remoteDomain -> team -> App ()
deleteFederationRemoteTeam :: forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
deleteFederationRemoteTeam domain
domain remoteDomain
remoteDomain team
team = do
  d <- remoteDomain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString remoteDomain
remoteDomain
  t <- asString team
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "federation", "remotes", d, "teams", t]
  res <- submit "DELETE" req
  res.status `shouldMatchInt` 200

getConnStatusForUsers :: (HasCallStack, MakesValue users) => users -> Domain -> App Response
getConnStatusForUsers :: forall users.
(HasCallStack, MakesValue users) =>
users -> Domain -> App Response
getConnStatusForUsers users
users Domain
domain = do
  usersList <-
    users -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList users
users App [Value] -> ([Value] -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Value]
us -> do
      dom <- [Value]
us [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
`for` (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.domain")
      dom `for_` (`shouldMatch` make domain)
      us `for` (%. "id")
  usersJSON <- make usersList
  getConnStatusInternal ["from" .= usersJSON] domain

getConnStatusInternal :: (HasCallStack) => [Pair] -> Domain -> App Response
getConnStatusInternal :: HasCallStack => [Pair] -> Domain -> App Response
getConnStatusInternal [Pair]
body Domain
dom = do
  req <- Domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest Domain
dom Service
Brig Versioned
Unversioned do
    [String] -> String
joinHttpPath [String
"i", String
"users", String
"connections-status", String
"v2"]
  submit "POST" do
    req & addJSONObject body

getProviderActivationCodeInternal ::
  (HasCallStack, MakesValue dom) =>
  dom ->
  String ->
  App Response
getProviderActivationCodeInternal :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
getProviderActivationCodeInternal dom
dom String
email = do
  d <- dom -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make dom
dom
  req <-
    rawBaseRequest d Brig Unversioned $
      joinHttpPath ["i", "provider", "activation-code"]
  submit "GET" (addQueryParams [("email", email)] req)

getProviderPasswordResetCodeInternal ::
  (HasCallStack, MakesValue dom) =>
  dom ->
  String ->
  App Response
getProviderPasswordResetCodeInternal :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
getProviderPasswordResetCodeInternal dom
dom String
email = do
  d <- dom -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make dom
dom
  req <-
    rawBaseRequest d Brig Unversioned $
      joinHttpPath ["i", "provider", "password-reset-code"]
  submit "GET" (addQueryParams [("email", email)] req)

-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_clients__uid_
addClient ::
  (HasCallStack, MakesValue user) =>
  user ->
  AddClient ->
  App Response
addClient :: forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient user
user AddClient
args = do
  uid <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
user
  req <- baseRequest user Brig Unversioned $ "/i/clients/" <> uid
  val <- mkAddClientValue args
  submit "POST" $ req & addJSONObject val

-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_clients_full
getClientsFull :: (HasCallStack, MakesValue users, MakesValue uid) => uid -> users -> App Response
getClientsFull :: forall users uid.
(HasCallStack, MakesValue users, MakesValue uid) =>
uid -> users -> App Response
getClientsFull uid
user users
users = do
  val <- users -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make users
users
  baseRequest user Brig Unversioned do joinHttpPath ["i", "clients", "full"]
    >>= submit "POST"
    . addJSONObject ["users" .= val]

-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_ejpd_request
getEJPDInfo :: (HasCallStack, MakesValue dom) => dom -> [String] -> String -> App Response
getEJPDInfo :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> [String] -> String -> App Response
getEJPDInfo dom
dom [String]
handles String
mode = do
  req <- dom -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
rawBaseRequest dom
dom Service
Brig Versioned
Unversioned String
"/i/ejpd-request"
  let query = case String
mode of
        String
"" -> []
        String
"include_contacts" -> [(String
"include_contacts", String
"true")]
        String
bad -> String -> [(String, String)]
forall a. HasCallStack => String -> a
error (String -> [(String, String)]) -> String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
bad
  submit "POST" $ req & addJSONObject ["EJPDRequest" .= handles] & addQueryParams query

-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/get_i_users__uid__verification_code__action_
getVerificationCode :: (HasCallStack, MakesValue user) => user -> String -> App Response
getVerificationCode :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
getVerificationCode user
user String
action = do
  uid <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
user
  domain <- objDomain user
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "users", uid, "verification-code", action]
  submit "GET" req

-- | http://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/get_i_users__uid__features_conferenceCalling
getFeatureForUser :: (HasCallStack, MakesValue user) => user -> String -> App Response
getFeatureForUser :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
getFeatureForUser user
user String
featureName = do
  uid <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
user
  req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "users", uid, "features", featureName]
  submit "GET" req

-- | http://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/put_i_users__uid__features_conferenceCalling
putFeatureForUser ::
  (HasCallStack, MakesValue user, MakesValue config) =>
  user ->
  String ->
  config ->
  App Response
putFeatureForUser :: forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
putFeatureForUser user
user String
featureName config
config = do
  uid <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
user
  req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "users", uid, "features", featureName]
  configValue <- make config
  submit "PUT" $ req & addJSON configValue

-- | http://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/delete_i_users__uid__features_conferenceCalling
deleteFeatureForUser :: (HasCallStack, MakesValue user) => user -> String -> App Response
deleteFeatureForUser :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
deleteFeatureForUser user
user String
featureName = do
  uid <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
user
  req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "users", uid, "features", featureName]
  submit "DELETE" req

-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_oauth_clients
createOAuthClient :: (HasCallStack, MakesValue user) => user -> String -> String -> App Response
createOAuthClient :: forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
createOAuthClient user
user String
name String
url = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Brig Versioned
Unversioned String
"i/oauth/clients"
  submit "POST" $ req & addJSONObject ["application_name" .= name, "redirect_url" .= url]

getInvitationByEmail :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
getInvitationByEmail :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
getInvitationByEmail domain
domain String
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
Unversioned String
"i/teams/invitations/by-email"
  submit "GET" $ req & addQueryParams [("email", email)]

getActivationCode :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
getActivationCode :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
getActivationCode domain
domain String
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
Unversioned String
"i/users/activation-code"
  submit "GET" $ req & addQueryParams [("email", email)]

getPasswordResetCode :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
getPasswordResetCode :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
getPasswordResetCode domain
domain String
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
Unversioned String
"i/users/password-reset-code"
  submit "GET" $ req & addQueryParams [("email", email)]

data PutSSOId = PutSSOId
  { PutSSOId -> Maybe String
scimExternalId :: Maybe String,
    PutSSOId -> Maybe String
subject :: Maybe String,
    PutSSOId -> Maybe String
tenant :: Maybe String
  }

instance Default PutSSOId where
  def :: PutSSOId
def =
    PutSSOId
      { scimExternalId :: Maybe String
scimExternalId = Maybe String
forall a. Maybe a
Nothing,
        subject :: Maybe String
subject = Maybe String
forall a. Maybe a
Nothing,
        tenant :: Maybe String
tenant = Maybe String
forall a. Maybe a
Nothing
      }

putSSOId :: (HasCallStack, MakesValue user) => user -> PutSSOId -> App Response
putSSOId :: forall user.
(HasCallStack, MakesValue user) =>
user -> PutSSOId -> App Response
putSSOId user
user PutSSOId
args = do
  uid <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
user
  req <- baseRequest user Brig Unversioned (joinHttpPath ["i", "users", uid, "sso-id"])
  submit "PUT" $
    req
      & addJSONObject
        [ "scim_external_id" .= args.scimExternalId,
          "subject" .= args.subject,
          "tenant" .= args.tenant
        ]

domainRegistrationLock :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
domainRegistrationLock :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
domainRegistrationLock domain
domain String
emailDomain = 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
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"domain-registration", String
emailDomain, String
"lock"]
  submit "POST" req

domainRegistrationUnlock :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
domainRegistrationUnlock :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
domainRegistrationUnlock domain
domain String
emailDomain = 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
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"domain-registration", String
emailDomain, String
"unlock"]
  submit "POST" req

domainRegistrationPreAuthorize :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
domainRegistrationPreAuthorize :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
domainRegistrationPreAuthorize domain
domain String
emailDomain = 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
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"domain-registration", String
emailDomain, String
"preauthorize"]
  submit "POST" req

domainRegistrationUnAuthorize :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
domainRegistrationUnAuthorize :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
domainRegistrationUnAuthorize domain
domain String
emailDomain = 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
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"domain-registration", String
emailDomain, String
"unauthorize"]
  submit "POST" req

updateDomainRegistration :: (HasCallStack, MakesValue domain) => domain -> String -> Value -> App Response
updateDomainRegistration :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Value -> App Response
updateDomainRegistration domain
domain String
emailDomain Value
payload = 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
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"domain-registration", String
emailDomain]
  submit "PUT" $ req & addJSON payload

deleteDomainRegistration :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
deleteDomainRegistration :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
deleteDomainRegistration domain
domain String
emailDomain = 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
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"domain-registration", String
emailDomain]
  submit "DELETE" req

getDomainRegistration :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
getDomainRegistration :: forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
getDomainRegistration domain
domain String
emailDomain = 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
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"domain-registration", String
emailDomain]
  submit "GET" req

legalholdLogin :: (HasCallStack, MakesValue domain) => domain -> String -> String -> App Response
legalholdLogin :: forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
legalholdLogin domain
domain String
uid String
password = do
  req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
rawBaseRequest domain
domain Service
Brig Versioned
Unversioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"i", String
"legalhold-login"]
  submit "POST" $
    req
      & addJSONObject
        [ "user" .= uid,
          "password" .= password
        ]

getMLSClients :: (HasCallStack, MakesValue user) => user -> Ciphersuite -> App Response
getMLSClients :: forall user.
(HasCallStack, MakesValue user) =>
user -> Ciphersuite -> App Response
getMLSClients user
user Ciphersuite
ciphersuite = do
  userId <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
user
  req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "mls", "clients", userId]
  submit "GET" $ req & addQueryParams [("ciphersuite", ciphersuite.code)]