-- 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
  { email :: Maybe String,
    password :: Maybe String,
    name :: Maybe String,
    team :: Bool,
    activate :: Bool,
    supportedProtocols :: Maybe [String]
  }

instance Default CreateUser where
  def =
    CreateUser
      { email = Nothing,
        password = Nothing,
        name = Nothing,
        team = False,
        activate = True,
        supportedProtocols = Nothing
      }

createUser :: (HasCallStack, MakesValue domain) => domain -> CreateUser -> App Response
createUser domain cu = do
  re <- randomEmail
  let email :: Maybe String = guard cu.activate $> fromMaybe re cu.email
  let password = fromMaybe defPassword cu.password
      name = fromMaybe "default" (cu.name <|> 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 domain ids = do
  req <- baseRequest domain Brig Unversioned "/i/users"
  submit "GET" $ req & addQueryParams [("ids", intercalate "," ids)]

getUsersIdIncludingPending :: (HasCallStack, MakesValue domain) => domain -> [String] -> App Response
getUsersIdIncludingPending domain ids = do
  req <- baseRequest domain Brig Unversioned "/i/users"
  submit "GET" $
    req
      & addQueryParams
        [ ("ids", intercalate "," ids),
          ("includePendingInvitations", "true")
        ]

getUsersByEmail :: (HasCallStack, MakesValue domain) => domain -> [String] -> App Response
getUsersByEmail domain emails = do
  req <- baseRequest domain Brig Unversioned "/i/users"
  submit "GET" $ req & addQueryParams [("email", intercalate "," emails)]

data FedConn = FedConn
  { domain :: String,
    searchStrategy :: String,
    restriction :: Maybe [String]
  }
  deriving (Eq, Ord, Show)

instance ToJSON FedConn where
  toJSON (FedConn d s r) =
    Aeson.object
      [ "domain" .= d,
        "search_policy" .= s,
        "restriction"
          .= maybe
            (Aeson.object ["tag" .= "allow_all", "value" .= Aeson.Null])
            ( \teams ->
                Aeson.object ["tag" .= "restrict_by_team", "value" .= Aeson.toJSON teams]
            )
            r
      ]

instance MakesValue FedConn where
  make = pure . toJSON

createFedConn :: (HasCallStack, MakesValue dom, MakesValue fedConn) => dom -> fedConn -> App Response
createFedConn dom fedConn = do
  bindResponse (createFedConn' dom fedConn) $ \res -> do
    res.status `shouldMatchRange` (200, 299)
    pure res

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

readFedConns :: (HasCallStack, MakesValue dom) => dom -> App Response
readFedConns dom = do
  bindResponse (readFedConns' dom) $ \res -> do
    res.status `shouldMatchRange` (200, 299)
    pure res

readFedConns' :: (HasCallStack, MakesValue dom) => dom -> App Response
readFedConns' dom = do
  req <- rawBaseRequest dom Brig Unversioned "/i/federation/remotes"
  submit "GET" req

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

updateFedConn' :: (HasCallStack, MakesValue owndom, MakesValue fedConn) => owndom -> String -> fedConn -> App Response
updateFedConn' owndom dom fedConn = do
  req <- rawBaseRequest owndom Brig Unversioned ("/i/federation/remotes/" <> dom)
  conn <- make fedConn
  submit "PUT" $ addJSON conn req

registerOAuthClient :: (HasCallStack, MakesValue user, MakesValue name, MakesValue url) => user -> name -> url -> App Response
registerOAuthClient user name url = do
  req <- baseRequest user Brig Unversioned "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 user cid = do
  clientId <- objId 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 user cid name url = do
  clientId <- objId 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 user cid = do
  clientId <- objId cid
  req <- baseRequest user Brig Unversioned $ "i/oauth/clients/" <> clientId
  submit "DELETE" req

getInvitationCode :: (HasCallStack, MakesValue user, MakesValue inv) => user -> inv -> App Response
getInvitationCode user inv = do
  tid <- user %. "team" & asString
  getInvitationCodeForTeam user tid inv

getInvitationCodeForTeam :: (HasCallStack, MakesValue domain, MakesValue inv) => domain -> String -> inv -> App Response
getInvitationCodeForTeam domain tid inv = do
  invId <- inv %. "id" & 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 domain = do
  req <- baseRequest domain Brig Unversioned "i/index/refresh"
  res <- submit "POST" req
  res.status `shouldMatchInt` 200

getTeamSize :: (HasCallStack, MakesValue caller) => caller -> String -> App Response
getTeamSize caller tid = do
  req <- baseRequest caller Brig Unversioned $ joinHttpPath ["i", "teams", tid, "size"]
  submit "GET" req

addFederationRemoteTeam :: (HasCallStack, MakesValue domain, MakesValue remoteDomain, MakesValue team) => domain -> remoteDomain -> team -> App ()
addFederationRemoteTeam domain remoteDomain team = do
  void $ addFederationRemoteTeam' domain remoteDomain team >>= getBody 200

addFederationRemoteTeam' :: (HasCallStack, MakesValue domain, MakesValue remoteDomain, MakesValue team) => domain -> remoteDomain -> team -> App Response
addFederationRemoteTeam' domain remoteDomain team = do
  d <- asString 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 domain remoteDomain = do
  d <- asString 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 domain remoteDomain team = do
  d <- asString 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 users domain = do
  usersList <-
    asList users >>= \us -> do
      dom <- us `for` (%. "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 body dom = do
  req <- baseRequest dom Brig Unversioned do
    joinHttpPath ["i", "users", "connections-status", "v2"]
  submit "POST" do
    req & addJSONObject body

getProviderActivationCodeInternal ::
  (HasCallStack, MakesValue dom) =>
  dom ->
  String ->
  App Response
getProviderActivationCodeInternal dom email = do
  d <- make 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 dom email = do
  d <- make 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 user args = do
  uid <- objId 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 user users = do
  val <- make 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 dom handles mode = do
  req <- rawBaseRequest dom Brig Unversioned "/i/ejpd-request"
  let query = case mode of
        "" -> []
        "include_contacts" -> [("include_contacts", "true")]
        bad -> error $ show 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 user action = do
  uid <- objId 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 user featureName = do
  uid <- objId 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 user featureName config = do
  uid <- objId 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 user featureName = do
  uid <- objId 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 user name url = do
  req <- baseRequest user Brig Unversioned "i/oauth/clients"
  submit "POST" $ req & addJSONObject ["application_name" .= name, "redirect_url" .= url]

getInvitationByEmail :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
getInvitationByEmail domain email = do
  req <- baseRequest domain Brig Unversioned "i/teams/invitations/by-email"
  submit "GET" $ req & addQueryParams [("email", email)]

getActivationCode :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
getActivationCode domain email = do
  req <- baseRequest domain Brig Unversioned "i/users/activation-code"
  submit "GET" $ req & addQueryParams [("email", email)]

getPasswordResetCode :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
getPasswordResetCode domain email = do
  req <- baseRequest domain Brig Unversioned "i/users/password-reset-code"
  submit "GET" $ req & addQueryParams [("email", email)]

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

instance Default PutSSOId where
  def =
    PutSSOId
      { scimExternalId = Nothing,
        subject = Nothing,
        tenant = Nothing
      }

putSSOId :: (HasCallStack, MakesValue user) => user -> PutSSOId -> App Response
putSSOId user args = do
  uid <- objId 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 domain emailDomain = do
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", emailDomain, "lock"]
  submit "POST" req

domainRegistrationUnlock :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
domainRegistrationUnlock domain emailDomain = do
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", emailDomain, "unlock"]
  submit "POST" req

domainRegistrationPreAuthorize :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
domainRegistrationPreAuthorize domain emailDomain = do
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", emailDomain, "preauthorize"]
  submit "POST" req

domainRegistrationUnAuthorize :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
domainRegistrationUnAuthorize domain emailDomain = do
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", emailDomain, "unauthorize"]
  submit "POST" req

updateDomainRegistration :: (HasCallStack, MakesValue domain) => domain -> String -> Value -> App Response
updateDomainRegistration domain emailDomain payload = do
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", emailDomain]
  submit "PUT" $ req & addJSON payload

deleteDomainRegistration :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
deleteDomainRegistration domain emailDomain = do
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", emailDomain]
  submit "DELETE" req

getDomainRegistration :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
getDomainRegistration domain emailDomain = do
  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", emailDomain]
  submit "GET" req

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

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

setAccountStatus :: (HasCallStack, MakesValue user) => user -> String -> App Response
setAccountStatus user status = do
  userId <- objId user
  req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "users", userId, "status"]
  submit "PUT" $ req & addJSONObject ["status" .= status]

getAccountStatus :: (HasCallStack, MakesValue user) => user -> App Response
getAccountStatus user = do
  userId <- objId user
  req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "users", userId, "status"]
  submit "GET" req
