{-# LANGUAGE TemplateHaskell #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 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 Wire.API.Routes.Internal.Brig
  ( API,
    BrigInternalClient,
    brigInternalClient,
    runBrigInternalClient,
    IStatusAPI,
    AccountAPI,
    MLSAPI,
    TeamsAPI,
    UserAPI,
    ClientAPI,
    AuthAPI,
    FederationRemotesAPI,
    EJPDRequest,
    ISearchIndexAPI,
    ProviderAPI,
    GetAccountConferenceCallingConfig,
    PutAccountConferenceCallingConfig,
    DeleteAccountConferenceCallingConfig,
    GetRichInfoMultiResponse (..),
    GetBy (..),
    getByNoFilters,
    CreateGroupInternalRequest (..),
    UpdateGroupInternalRequest (..),
    swaggerDoc,
    module Wire.API.Routes.Internal.Brig.EJPD,
    FoundInvitationCode (..),
    EnterpriseLoginApi,
    SAMLIdPAPI,
    DeleteApp,
    IdpChangedNotification (..),
  )
where

import Control.Lens (makePrisms, (.~), (?~), _1)
import Data.Aeson (FromJSON, ToJSON, Value (Null))
import Data.Code qualified as Code
import Data.CommaSeparatedList
import Data.Default (Default (..))
import Data.Domain (Domain)
import Data.Handle (Handle)
import Data.HavePendingInvitations (HavePendingInvitations (..))
import Data.Id as Id
import Data.Misc (PlainTextPassword8)
import Data.OpenApi (HasInfo (info), HasTitle (title), OpenApi)
import Data.OpenApi qualified as S
import Data.Qualified (Qualified, qualifiedSchema)
import Data.Schema hiding (swaggerDoc)
import Data.Sequence qualified as Seq
import Data.Text qualified as Text
import GHC.TypeLits
import Imports hiding (head)
import Network.HTTP.Client qualified as HTTP
import Network.Wai.Utilities.Server (defaultRequestIdHeaderName)
import Servant hiding (Handler, addHeader, respond)
import Servant.Client qualified as Servant
import Servant.Client.Core qualified as Servant
import Servant.OpenApi (HasOpenApi (toOpenApi))
import Servant.OpenApi.Internal.Orphans ()
import Util.Options
import Wire.API.Connection
import Wire.API.Error
import Wire.API.Error.Brig
import Wire.API.MLS.CipherSuite
import Wire.API.Routes.FederationDomainConfig
import Wire.API.Routes.Internal.Brig.Connection
import Wire.API.Routes.Internal.Brig.EJPD
import Wire.API.Routes.Internal.Brig.EnterpriseLogin (EnterpriseLoginApi)
import Wire.API.Routes.Internal.Brig.OAuth (OAuthAPI)
import Wire.API.Routes.Internal.Brig.SearchIndex (ISearchIndexAPI)
import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi
import Wire.API.Routes.MultiVerb
import Wire.API.Routes.Named
import Wire.API.Routes.Public (ZUser)
import Wire.API.Team.Export (TeamExportUser)
import Wire.API.Team.Feature
import Wire.API.Team.Invitation (Invitation)
import Wire.API.Team.LegalHold.Internal
import Wire.API.Team.Size qualified as Teamsize
import Wire.API.User hiding (InvitationCode)
import Wire.API.User qualified as User
import Wire.API.User.Auth
import Wire.API.User.Auth.LegalHold
import Wire.API.User.Auth.ReAuth
import Wire.API.User.Auth.Sso
import Wire.API.User.Client
import Wire.API.User.IdentityProvider
import Wire.API.User.Orphans ()
import Wire.API.User.RichInfo
import Wire.API.UserGroup
import Wire.API.UserGroup.Pagination
import Wire.Arbitrary

-- | Parameters for getting user accounts by various criteria
data GetBy = GetBy
  { includePendingInvitations :: HavePendingInvitations,
    includeUsersWithExpiredInvitations :: Bool,
    includeUsersWithoutIdentity :: Bool,
    getByUserId :: [UserId],
    getByHandle :: [Handle]
  }
  deriving stock (Eq, Ord, Show, Generic)
  deriving (Arbitrary) via GenericUniform GetBy
  deriving (FromJSON, ToJSON, S.ToSchema) via Schema GetBy

instance Default GetBy where
  def =
    GetBy
      { includePendingInvitations = NoPendingInvitations,
        includeUsersWithExpiredInvitations = False,
        includeUsersWithoutIdentity = False,
        getByUserId = [],
        getByHandle = []
      }

instance ToSchema GetBy where
  schema =
    object $
      GetBy
        <$> (.includePendingInvitations) .= field "include_pending_invitations" schema
        <*> (.includeUsersWithExpiredInvitations) .= field "include_users_with_expired_invitations" schema
        <*> (.includeUsersWithoutIdentity) .= field "include_users_without_identity" schema
        <*> (.getByUserId) .= field "ids" (array schema)
        <*> (.getByHandle) .= field "handles" (array schema)

instance ToSchema (Qualified GetBy) where
  schema = qualifiedSchema "GetBy" "get_by" schema

deriving via (Schema (Qualified GetBy)) instance FromJSON (Qualified GetBy)

deriving via (Schema (Qualified GetBy)) instance ToJSON (Qualified GetBy)

deriving via (Schema (Qualified GetBy)) instance S.ToSchema (Qualified GetBy)

getByNoFilters :: GetBy
getByNoFilters =
  GetBy
    { includePendingInvitations = WithPendingInvitations,
      includeUsersWithoutIdentity = True,
      includeUsersWithExpiredInvitations = True,
      getByUserId = [],
      getByHandle = []
    }

-- | Request type for creating user groups with full control
data CreateGroupInternalRequest = CreateGroupInternalRequest
  { managedBy :: ManagedBy,
    teamId :: TeamId,
    creatorUserId :: Maybe UserId,
    newGroup :: NewUserGroup
  }
  deriving stock (Eq, Show, Generic)
  deriving (FromJSON, ToJSON, S.ToSchema) via Schema CreateGroupInternalRequest

instance ToSchema CreateGroupInternalRequest where
  schema =
    object $
      CreateGroupInternalRequest
        <$> (.managedBy) .= field "managed_by" schema
        <*> (.teamId) .= field "team_id" schema
        <*> (.creatorUserId) .= optField "creator_user_id" (maybeWithDefault Null schema)
        <*> (.newGroup) .= field "new_group" schema

data UpdateGroupInternalRequest = UpdateGroupInternalRequest
  { teamId :: TeamId,
    groupId :: UserGroupId,
    -- | if name is Nothing, user group name will not be touched
    name :: Maybe UserGroupName,
    -- | if members is Nothing, member set will not be touched
    members :: Maybe [UserId]
  }
  deriving stock (Eq, Show, Generic)
  deriving (FromJSON, ToJSON, S.ToSchema) via Schema UpdateGroupInternalRequest

instance ToSchema UpdateGroupInternalRequest where
  schema =
    object $
      UpdateGroupInternalRequest
        <$> (.teamId) .= field "team_id" schema
        <*> (.groupId) .= field "group_id" schema
        <*> (.name) .= optField "name" (maybeWithDefault Null schema)
        <*> (.members) .= optField "members" (maybeWithDefault Null (array schema))

type EJPDRequest =
  Named
    "ejpd-request"
    ( Summary
        "Identify users for law enforcement.  Wire has legal requirements to cooperate \
        \with the authorities.  The wire backend operations team uses this to answer \
        \identification requests manually.  It is our best-effort representation of the \
        \minimum required information we need to hand over about targets and (in some \
        \cases) their communication peers.  For more information, consult ejpd.admin.ch."
        :> "ejpd-request"
        :> QueryParam'
             [ Optional,
               Strict,
               Description "Also provide information about all contacts of the identified users"
             ]
             "include_contacts"
             Bool
        :> Servant.ReqBody '[Servant.JSON] EJPDRequestBody
        :> Post '[Servant.JSON] EJPDResponseBody
    )

type GetAccountConferenceCallingConfig =
  Summary
    "Read cassandra field 'brig.user.feature_conference_calling'"
    :> "users"
    :> Capture "uid" UserId
    :> "features"
    :> "conferenceCalling"
    :> Get '[Servant.JSON] (Feature ConferenceCallingConfig)

type PutAccountConferenceCallingConfig =
  Summary
    "Write to cassandra field 'brig.user.feature_conference_calling'"
    :> "users"
    :> Capture "uid" UserId
    :> "features"
    :> "conferenceCalling"
    :> Servant.ReqBody '[Servant.JSON] (Feature ConferenceCallingConfig)
    :> Put '[Servant.JSON] NoContent

type DeleteAccountConferenceCallingConfig =
  Summary
    "Reset cassandra field 'brig.user.feature_conference_calling' to 'null'"
    :> "users"
    :> Capture "uid" UserId
    :> "features"
    :> "conferenceCalling"
    :> Delete '[Servant.JSON] NoContent

type GetAllConnectionsUnqualified =
  Summary "Get all connections of a given user"
    :> "users"
    :> "connections-status"
    :> ReqBody '[Servant.JSON] ConnectionsStatusRequest
    :> QueryParam'
         [ Optional,
           Strict,
           Description "Only returns connections with the given relation, if omitted, returns all connections"
         ]
         "filter"
         Relation
    :> Post '[Servant.JSON] [ConnectionStatus]

type GetAllConnections =
  Summary "Get all connections of a given user"
    :> "users"
    :> "connections-status"
    :> "v2"
    :> ReqBody '[Servant.JSON] ConnectionsStatusRequestV2
    :> Post '[Servant.JSON] [ConnectionStatusV2]

type GetAccountsByInternal =
  Named
    "i-get-accounts-by"
    ( Summary "Get user accounts by various criteria (internal)"
        :> "users"
        :> "accounts-by"
        :> ReqBody '[Servant.JSON] GetBy
        :> Post '[Servant.JSON] [User]
    )

type CreateGroupInternal =
  Named
    "i-create-group-full"
    ( Summary "Create user group with full control (internal)"
        :> "user-groups"
        :> "full"
        :> ReqBody '[Servant.JSON] CreateGroupInternalRequest
        :> Post '[Servant.JSON] UserGroup
    )

type GetGroupInternal =
  Named
    "i-get-group"
    ( Summary "Fetch user group (internal)"
        :> "user-groups"
        :> Capture "tid" TeamId
        :> Capture "gid" UserGroupId
        :> Capture "includeChannels" Bool
        :> Get '[Servant.JSON] (Maybe UserGroup)
    )

type GetGroupsInternal =
  Named
    "i-get-groups"
    ( Summary "Get user groups with filtering (internal)"
        :> "user-groups"
        :> Capture "tid" TeamId
        :> QueryParam' [Optional, Strict] "nameContains" Text.Text
        :> QueryParam' [Optional, Strict] "managedBy" ManagedBy
        :> QueryParam' [Required, Strict] "startIndex" Word
        :> QueryParam' [Optional, Strict] "count" Word
        :> Get '[Servant.JSON] UserGroupPageWithMembers
    )

type UpdateGroupInternal =
  Named
    "i-update-group"
    ( Summary "Overwrite user group (name and member set) (internal)"
        :> "user-groups"
        :> ReqBody '[Servant.JSON] UpdateGroupInternalRequest
        :> Put '[Servant.JSON] ()
    )

type DeleteGroupManagedInternal =
  Named
    "i-delete-group-managed"
    ( Summary "Delete a managed user group (internal)"
        :> "user-groups"
        :> Capture "tid" TeamId
        :> Capture "gid" UserGroupId
        :> "managed"
        :> Capture "managedBy" ManagedBy
        :> Delete '[Servant.JSON] NoContent
    )

type AccountAPI =
  Named "get-account-conference-calling-config" GetAccountConferenceCallingConfig
    :<|> Named "i-put-account-conference-calling-config" PutAccountConferenceCallingConfig
    :<|> Named "i-delete-account-conference-calling-config" DeleteAccountConferenceCallingConfig
    :<|> Named "i-get-all-connections-unqualified" GetAllConnectionsUnqualified
    :<|> Named "i-get-all-connections" GetAllConnections
    :<|> Named
           "createUserNoVerify"
           -- This endpoint can lead to the following events being sent:
           -- - UserActivated event to created user, if it is a team invitation or user has an SSO ID
           -- - UserIdentityUpdated event to created user, if email or phone get activated
           ( "users"
               :> ReqBody '[Servant.JSON] (NewUser PlainTextPassword8)
               :> MultiVerb 'POST '[Servant.JSON] RegisterInternalResponses (Either RegisterError SelfProfile)
           )
    :<|> Named
           "createUserNoVerifySpar"
           ( "users"
               :> "spar"
               :> ReqBody '[Servant.JSON] NewUserSpar
               :> MultiVerb 'POST '[Servant.JSON] CreateUserSparInternalResponses (Either CreateUserSparError SelfProfile)
           )
    :<|> Named
           "putSelfEmail"
           ( Summary
               "Internal email update and activation. Used in tests and in spar for validating emails \
               \obtained via scim or saml implicit user creation. If the `validate` query parameter is \
               \false or missing, only update the email and do not activate."
               :> ZUser
               :> "self"
               :> "email"
               :> ReqBody '[Servant.JSON] EmailUpdate
               :> QueryParam' [Optional, Strict] "email_activation" EmailActivation
               :> QueryParam'
                    [ Optional,
                      Strict,
                      Description
                        "[deprecated; use email_activation] Whether to send an activation email, defaults to false. \
                        \This parameter will be ignored if `activate=true`."
                    ]
                    "validate"
                    Bool
               :> QueryParam'
                    [ Optional,
                      Strict,
                      Description
                        "[deprecated; use email_activation] Whether to activate the email without sending an \
                        \activation email, default is false."
                    ]
                    "activate"
                    Bool
               :> MultiVerb
                    'PUT
                    '[Servant.JSON]
                    '[ Respond 202 "Update accepted and pending activation of the new email" (),
                       Respond 204 "No update, current and new email address are the same" (),
                       Respond 204 "Email address activated" ()
                     ]
                    ChangeEmailResponse
           )
    :<|> Named
           "iDeleteUser"
           ( Summary
               "This endpoint will lead to the following events being sent: UserDeleted event to all of \
               \its contacts, MemberLeave event to members for all conversations the user was in (via galley)"
               :> CanThrow 'UserNotFound
               :> "users"
               :> Capture "uid" UserId
               :> MultiVerb
                    'DELETE
                    '[Servant.JSON]
                    '[ Respond 200 "UserResponseAccountAlreadyDeleted" (),
                       Respond 202 "UserResponseAccountDeleted" ()
                     ]
                    DeleteUserResponse
           )
    :<|> Named
           "iPutUserStatus"
           ( -- FUTUREWORK: `CanThrow ... :>`
             "users"
               :> Capture "uid" UserId
               :> "status"
               :> ReqBody '[Servant.JSON] AccountStatusUpdate
               :> Put '[Servant.JSON] NoContent
           )
    :<|> Named
           "iGetUserStatus"
           ( CanThrow 'UserNotFound
               :> "users"
               :> Capture "uid" UserId
               :> "status"
               :> Get '[Servant.JSON] AccountStatusResp
           )
    :<|> Named
           "iGetUsersByVariousKeys"
           ( "users"
               :> QueryParam' [Optional, Strict] "ids" (CommaSeparatedList UserId)
               :> QueryParam' [Optional, Strict] "handles" (CommaSeparatedList Handle)
               :> QueryParam' [Optional, Strict] "email" (CommaSeparatedList EmailAddress) -- don't rename to `emails`, for backwards compat!
               :> QueryParam'
                    [ Optional,
                      Strict,
                      Description "Also return new accounts with team invitation pending"
                    ]
                    "includePendingInvitations"
                    Bool
               :> Get '[Servant.JSON] [User]
           )
    :<|> Named
           "iGetUserContacts"
           ( "users"
               :> Capture "uid" UserId
               :> "contacts"
               :> Get '[Servant.JSON] UserIds
           )
    :<|> Named
           "iGetUserActivationCode"
           ( "users"
               :> "activation-code"
               :> QueryParam' [Required, Strict] "email" EmailAddress
               :> Get '[Servant.JSON] GetActivationCodeResp
           )
    :<|> Named
           "iGetUserPasswordResetCode"
           ( "users"
               :> "password-reset-code"
               :> QueryParam' [Required, Strict] "email" EmailAddress
               :> Get '[Servant.JSON] GetPasswordResetCodeResp
           )
    :<|> Named
           "iRevokeIdentity"
           ( Summary "This endpoint can lead to the following events being sent: UserIdentityRemoved event to target user"
               :> "users"
               :> "revoke-identity"
               :> QueryParam' [Required, Strict] "email" EmailAddress
               :> Post '[Servant.JSON] NoContent
           )
    :<|> Named
           "iHeadBlacklist"
           ( "users"
               :> "blacklist"
               :> QueryParam' [Required, Strict] "email" EmailAddress
               :> MultiVerb
                    'GET
                    '[Servant.JSON]
                    '[ Respond 404 "Not blacklisted" (),
                       Respond 200 "Yes blacklisted" ()
                     ]
                    CheckBlacklistResponse
           )
    :<|> Named
           "iDeleteBlacklist"
           ( "users"
               :> "blacklist"
               :> QueryParam' [Required, Strict] "email" EmailAddress
               :> Delete '[Servant.JSON] NoContent
           )
    :<|> Named
           "iPostBlacklist"
           ( "users"
               :> "blacklist"
               :> QueryParam' [Required, Strict] "email" EmailAddress
               :> Post '[Servant.JSON] NoContent
           )
    :<|> Named
           "iPutUserSsoId"
           ( "users"
               :> Capture "uid" UserId
               :> "sso-id"
               :> ReqBody '[Servant.JSON] UserSSOId
               :> MultiVerb
                    'PUT
                    '[Servant.JSON]
                    '[ RespondEmpty 200 "UpdateSSOIdSuccess",
                       RespondEmpty 404 "UpdateSSOIdNotFound"
                     ]
                    UpdateSSOIdResponse
           )
    :<|> Named
           "iDeleteUserSsoId"
           ( "users"
               :> Capture "uid" UserId
               :> "sso-id"
               :> MultiVerb
                    'DELETE
                    '[Servant.JSON]
                    '[ RespondEmpty 200 "UpdateSSOIdSuccess",
                       RespondEmpty 404 "UpdateSSOIdNotFound"
                     ]
                    UpdateSSOIdResponse
           )
    :<|> Named
           "iPutManagedBy"
           ( "users"
               :> Capture "uid" UserId
               :> "managed-by"
               :> ReqBody '[Servant.JSON] ManagedByUpdate
               :> Put '[Servant.JSON] NoContent
           )
    :<|> Named
           "iDeletePendingEmailUpdate"
           ( Summary
               "Invalidate a pending email-address update for a user. \
               \Used by spar when a user is put under SCIM control, so that team \
               \settings no longer offers a 'resend verification' action that cannot \
               \succeed, and stale activation links cannot change a SCIM-managed \
               \user's email."
               :> "users"
               :> Capture "uid" UserId
               :> "pending-email-update"
               :> Delete '[Servant.JSON] NoContent
           )
    :<|> Named
           "iPutRichInfo"
           ( "users"
               :> Capture "uid" UserId
               :> "rich-info"
               :> ReqBody '[Servant.JSON] RichInfoUpdate
               :> Put '[Servant.JSON] NoContent
           )
    :<|> Named
           "iPutHandle"
           ( "users"
               :> Capture "uid" UserId
               :> "handle"
               :> ReqBody '[Servant.JSON] HandleUpdate
               :> Put '[Servant.JSON] NoContent
           )
    :<|> Named
           "iPutUserName"
           ( "users"
               :> Capture "uid" UserId
               :> "name"
               :> ReqBody '[Servant.JSON] NameUpdate
               :> Put '[Servant.JSON] NoContent
           )
    :<|> Named
           "iGetRichInfo"
           ( "users"
               :> Capture "uid" UserId
               :> "rich-info"
               :> Get '[Servant.JSON] RichInfo
           )
    :<|> Named
           "iHeadHandle"
           ( CanThrow 'InvalidHandle
               :> "handles"
               :> Capture "handle" Handle
               :> MultiVerb
                    'HEAD
                    '[Servant.JSON]
                    '[ RespondEmpty 200 "CheckHandleResponseFound",
                       RespondEmpty 404 "CheckHandleResponseNotFound"
                     ]
                    CheckHandleResponse
           )
    :<|> Named
           "iConnectionUpdate"
           ( "connections"
               :> "connection-update"
               :> ReqBody '[Servant.JSON] UpdateConnectionsInternal
               :> Put '[Servant.JSON] NoContent
           )
    :<|> Named
           "iListClients"
           ( "clients"
               :> ReqBody '[Servant.JSON] UserSet
               :> Post '[Servant.JSON] UserClients
           )
    :<|> Named
           "iListClientsFull"
           ( "clients"
               :> "full"
               :> ReqBody '[Servant.JSON] UserSet
               :> Post '[Servant.JSON] UserClientsFull
           )
    :<|> Named
           "iAddClient"
           ( Summary
               "This endpoint can lead to the following events being sent: ClientAdded event to the user; \
               \ClientRemoved event to the user, if removing old clients due to max number of clients; \
               \UserLegalHoldEnabled event to contacts of the user, if client type is legalhold."
               :> "clients"
               :> Capture "uid" UserId
               :> QueryParam' [Optional, Strict] "skip_reauth" Bool
               :> ReqBody '[Servant.JSON] NewClient
               :> Header' [Optional, Strict] "Z-Connection" ConnId
               :> Verb 'POST 201 '[Servant.JSON] Client
           )
    :<|> Named
           "iLegalholdAddClient"
           ( Summary
               "This endpoint can lead to the following events being sent: \
               \LegalHoldClientRequested event to contacts of the user"
               :> "clients"
               :> "legalhold"
               :> Capture "uid" UserId
               :> "request"
               :> ReqBody '[Servant.JSON] LegalHoldClientRequest
               :> Post '[Servant.JSON] NoContent
           )
    :<|> Named
           "iLegalholdDeleteClient"
           ( Summary
               "This endpoint can lead to the following events being sent: \
               \ClientRemoved event to the user; UserLegalHoldDisabled event \
               \to contacts of the user"
               :> "clients"
               :> "legalhold"
               :> Capture "uid" UserId
               :> Delete '[Servant.JSON] NoContent
           )
    :<|> GetAccountsByInternal
    :<|> CreateGroupInternal
    :<|> GetGroupInternal
    :<|> GetGroupsInternal
    :<|> UpdateGroupInternal
    :<|> DeleteGroupManagedInternal

-- | The missing ref is implicit by the capture
data NewKeyPackageRef = NewKeyPackageRef
  { nkprUserId :: Qualified UserId,
    nkprClientId :: ClientId,
    nkprConversation :: Qualified ConvId
  }
  deriving stock (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewKeyPackageRef)

instance ToSchema NewKeyPackageRef where
  schema =
    object $
      NewKeyPackageRef
        <$> nkprUserId .= field "user_id" schema
        <*> nkprClientId .= field "client_id" schema
        <*> nkprConversation .= field "conversation" schema

type MLSAPI = "mls" :> GetMLSClients

type GetMLSClients =
  Named
    "get-mls-clients"
    ( Summary "Return all clients and all MLS-capable clients of a user"
        :> "clients"
        :> CanThrow 'UserNotFound
        :> Capture "user" UserId
        :> QueryParam' '[Required, Strict] "ciphersuite" CipherSuite
        :> MultiVerb1
             'GET
             '[Servant.JSON]
             (Respond 200 "MLS clients" (Set ClientInfo))
    )
    :<|> Named
           "get-mls-client"
           ( Summary "Return information on a single MLS client"
               :> "client"
               :> CanThrow 'UserNotFound
               :> Capture "user" UserId
               :> Capture "client" ClientId
               :> QueryParam' '[Required, Strict] "ciphersuite" CipherSuite
               :> MultiVerb1
                    'GET
                    '[Servant.JSON]
                    (Respond 200 "MLS client" ClientInfo)
           )

type GetVerificationCode =
  Named
    "get-verification-code"
    ( Summary "Get verification code for a given email and action"
        :> "users"
        :> Capture "uid" UserId
        :> "verification-code"
        :> Capture "action" VerificationAction
        :> Get '[Servant.JSON] (Maybe Code.Value)
    )

type API =
  "i"
    :> ( IStatusAPI
           :<|> EJPDRequest
           :<|> AccountAPI
           :<|> MLSAPI
           :<|> GetVerificationCode
           :<|> TeamsAPI
           :<|> UserAPI
           :<|> ClientAPI
           :<|> AuthAPI
           :<|> OAuthAPI
           :<|> ISearchIndexAPI
           :<|> FederationRemotesAPI
           :<|> ProviderAPI
           :<|> EnterpriseLoginApi
           :<|> SAMLIdPAPI
           :<|> DeleteApp
           :<|> GetAppIds
       )

type SAMLIdPAPI =
  "idp"
    :> ( Named
           "send-idp-changed-email"
           ( Summary "Send an email about IdP creation, deletion or update to all team admins and owners"
               :> "send-idp-changed-email"
               :> ReqBody '[Servant.JSON] IdpChangedNotification
               :> Post '[Servant.JSON] ()
           )
       )

type DeleteApp =
  Named
    "i-delete-app"
    ( "teams"
        :> Capture "tid" TeamId
        :> "apps"
        :> Capture "uid" UserId
        :> Delete '[Servant.JSON] NoContent
    )

type GetAppIds =
  Named
    "i-get-app-ids"
    ( "teams"
        :> Capture "tid" TeamId
        :> "apps"
        :> Get '[Servant.JSON] [UserId]
    )

type IStatusAPI =
  Named
    "get-status"
    ( Summary "do nothing, just check liveness (NB: this works for both get, head)"
        :> "status"
        :> Get '[Servant.JSON] NoContent
    )

type TeamsAPI =
  Named
    "updateSearchVisibilityInbound"
    ( "teams"
        :> ReqBody '[Servant.JSON] (Multi.TeamStatus SearchVisibilityInboundConfig)
        :> Post '[Servant.JSON] ()
    )
    :<|> InvitationByEmail
    :<|> InvitationCode
    :<|> SuspendTeam
    :<|> UnsuspendTeam
    :<|> TeamSize
    :<|> TeamInvitations

type InvitationByEmail =
  Named
    "get-invitation-by-email"
    ( "teams"
        :> "invitations"
        :> "by-email"
        :> QueryParam' [Required, Strict] "email" EmailAddress
        :> Get '[Servant.JSON] Invitation
    )

type InvitationCode =
  Named
    "get-invitation-code"
    ( "teams"
        :> "invitation-code"
        :> QueryParam' [Required, Strict] "team" TeamId
        :> QueryParam' [Required, Strict] "invitation_id" InvitationId
        :> Get '[Servant.JSON] FoundInvitationCode
    )

newtype FoundInvitationCode = FoundInvitationCode {getFoundInvitationCode :: User.InvitationCode}
  deriving stock (Eq, Show, Generic)
  deriving (FromJSON, ToJSON, S.ToSchema) via (Schema FoundInvitationCode)

instance ToSchema FoundInvitationCode where
  schema =
    FoundInvitationCode
      <$> getFoundInvitationCode .= object (field "code" (schema @User.InvitationCode))

type SuspendTeam =
  Named
    "suspend-team"
    ( "teams"
        :> Capture "tid" TeamId
        :> "suspend"
        :> Post
             '[Servant.JSON]
             NoContent
    )

type UnsuspendTeam =
  Named
    "unsuspend-team"
    ( "teams"
        :> Capture "tid" TeamId
        :> "unsuspend"
        :> Post
             '[Servant.JSON]
             NoContent
    )

type TeamSize =
  Named
    "team-size"
    ( "teams"
        :> Capture "tid" TeamId
        :> "size"
        :> Get '[JSON] Teamsize.TeamSize
    )

type TeamInvitations =
  Named
    "create-invitations-via-scim"
    ( "teams"
        :> Capture "tid" TeamId
        :> "invitations"
        :> Servant.ReqBody '[JSON] NewUserScimInvitation
        :> Post '[JSON] User
    )

type UserAPI =
  Named "i-update-user-locale" UpdateUserLocale
    :<|> Named "i-delete-user-locale" DeleteUserLocale
    :<|> Named "i-get-default-locale" GetDefaultLocale
    :<|> Named
           "get-user-export-data"
           ( Summary "Get user export data"
               :> "users"
               :> Capture "uid" UserId
               :> "export-data"
               :> MultiVerb1 'GET '[JSON] (Respond 200 "User export data" (Maybe TeamExportUser))
           )
    :<|> Named
           "i-check-admin-get-team-id"
           ( Summary "Check if user is admin, return team ID"
               :> "users"
               :> Capture "uid" UserId
               :> "check-admin-get-team-id"
               :> Get '[Servant.JSON] TeamId
           )

type UpdateUserLocale =
  Summary
    "Set the user's locale"
    :> "users"
    :> Capture "uid" UserId
    :> "locale"
    :> ReqBody '[Servant.JSON] LocaleUpdate
    :> Put '[Servant.JSON] LocaleUpdate

type DeleteUserLocale =
  Summary
    "Delete the user's locale"
    :> "users"
    :> Capture "uid" UserId
    :> "locale"
    :> Delete '[Servant.JSON] NoContent

type GetDefaultLocale =
  Summary "Get the default locale"
    :> "users"
    :> "locale"
    :> Get '[Servant.JSON] LocaleUpdate

type ClientAPI =
  Named
    "update-client-last-active"
    ( Summary "Update last_active field of a client"
        :> "clients"
        :> Capture "uid" UserId
        :> Capture "client" ClientId
        :> "activity"
        :> MultiVerb1 'POST '[Servant.JSON] (RespondEmpty 200 "OK")
    )

type AuthAPI =
  Named
    "legalhold-login"
    ( "legalhold-login"
        :> ReqBody '[JSON] LegalHoldLogin
        :> MultiVerb1 'POST '[JSON] TokenResponse
    )
    :<|> Named
           "sso-login"
           ( "sso-login"
               :> ReqBody '[JSON] SsoLogin
               :> QueryParam' [Optional, Strict] "persist" Bool
               :> MultiVerb1 'POST '[JSON] TokenResponse
           )
    :<|> Named
           "login-code"
           ( "users"
               :> "login-code"
               :> QueryParam' [Required, Strict] "phone" Phone
               :> MultiVerb1 'GET '[JSON] (Respond 200 "Login code" PendingLoginCode)
           )
    :<|> Named
           "reauthenticate"
           ( "users"
               :> Capture "uid" UserId
               :> "reauthenticate"
               :> ReqBody '[JSON] ReAuthUser
               :> MultiVerb1 'GET '[JSON] (RespondEmpty 200 "OK")
           )

-- | This is located in brig, not in federator, because brig has a cassandra instance.  This
-- is not ideal, and other services could keep their local in-ram copy of this table up to date
-- via rabbitmq, but FUTUREWORK.
type FederationRemotesAPI =
  Named
    "add-federation-remotes"
    ( Description FederationRemotesAPIDescription
        :> "federation"
        :> "remotes"
        :> ReqBody '[JSON] FederationDomainConfig
        :> Post '[JSON] ()
    )
    :<|> Named
           "get-federation-remotes"
           ( Description FederationRemotesAPIDescription
               :> "federation"
               :> "remotes"
               :> Get '[JSON] FederationDomainConfigs
           )
    :<|> Named
           "update-federation-remotes"
           ( Description FederationRemotesAPIDescription
               :> "federation"
               :> "remotes"
               :> Capture "domain" Domain
               :> ReqBody '[JSON] FederationDomainConfig
               :> Put '[JSON] ()
           )
    :<|> Named
           "add-federation-remote-team"
           ( Description
               "Add a remote team to the list of teams that are allowed to federate with our domain"
               :> "federation"
               :> "remotes"
               :> Capture "domain" Domain
               :> "teams"
               :> ReqBody '[JSON] FederationRemoteTeam
               :> Post '[JSON] ()
           )
    :<|> Named
           "get-federation-remote-teams"
           ( Description
               "Get a list of teams from a remote domain that our backend is allowed to federate with."
               :> "federation"
               :> "remotes"
               :> Capture "domain" Domain
               :> "teams"
               :> Get '[JSON] [FederationRemoteTeam]
           )
    :<|> Named
           "delete-federation-remote-team"
           ( Description
               "Remove a remote team from the list of teams that are allowed to federate with our domain"
               :> "federation"
               :> "remotes"
               :> Capture "domain" Domain
               :> "teams"
               :> Capture "team" TeamId
               :> Delete '[JSON] ()
           )

type ProviderAPI =
  Named
    "get-provider-activation-code"
    ( Summary "Retrieve activation code via api instead of email (for testing only)"
        :> "provider"
        :> "activation-code"
        :> QueryParam' '[Required, Strict] "email" EmailAddress
        :> MultiVerb1 'GET '[JSON] (Respond 200 "" Code.KeyValuePair)
    )
    :<|> Named
           "get-provider-password-reset-code"
           ( Summary "Retrieve password-reset code via api instead of email (for testing only)"
               :> "provider"
               :> "password-reset-code"
               :> QueryParam' '[Required, Strict] "email" EmailAddress
               :> MultiVerb1 'GET '[JSON] (Respond 200 "" Code.KeyValuePair)
           )

type FederationRemotesAPIDescription =
  "See https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections for background. "

newtype GetRichInfoMultiResponse
  = GetRichInfoMultiResponse
      [(UserId, RichInfo)]
  deriving newtype (FromJSON, ToJSON)

instance S.ToSchema GetRichInfoMultiResponse where
  declareNamedSchema _ =
    pure $
      S.NamedSchema (Just $ "GetRichInfoMultiResponse") $
        mempty & S.description ?~ "List of pairs of UserId and RichInfo"

data IdpChangedNotificationTag = IdPCreatedTag | IdPDeletedTag | IdPUpdatedTag
  deriving (Eq, Enum, Bounded)

data IdpChangedNotification = IdPCreated (Maybe UserId) IdP | IdPDeleted UserId IdP | IdPUpdated UserId IdP IdP
  deriving (Eq, Show, Generic)

makePrisms ''IdpChangedNotification

instance Data.Schema.ToSchema IdpChangedNotification where
  schema =
    object $
      fromTagged
        <$> toTagged
          .= bind
            (fst .= field "tag" tagSchema)
            (snd .= fieldOver _1 "value" untaggedSchema)
    where
      toTagged :: IdpChangedNotification -> (IdpChangedNotificationTag, IdpChangedNotification)
      toTagged d@(IdPCreated {}) = (IdPCreatedTag, d)
      toTagged d@(IdPDeleted {}) = (IdPDeletedTag, d)
      toTagged d@(IdPUpdated {}) = (IdPUpdatedTag, d)

      fromTagged :: (IdpChangedNotificationTag, IdpChangedNotification) -> IdpChangedNotification
      fromTagged = snd

      untaggedSchema = dispatch $ \case
        IdPCreatedTag -> tag _IdPCreated (Data.Schema.unnamed createdSchema)
        IdPDeletedTag -> tag _IdPDeleted (Data.Schema.unnamed deletedSchema)
        IdPUpdatedTag -> tag _IdPUpdated (Data.Schema.unnamed updatedSchema)

      tagSchema :: ValueSchema NamedSwaggerDoc IdpChangedNotificationTag
      tagSchema =
        enum @Text $
          mconcat [element "created" IdPCreatedTag, element "deleted" IdPDeletedTag, element "updated" IdPUpdatedTag]

      createdSchema :: ValueSchema NamedSwaggerDoc (Maybe UserId, IdP)
      createdSchema =
        object $
          (,)
            <$> fst .= maybe_ (optField "user" schema)
            <*> snd .= field "idp" schema

      deletedSchema :: ValueSchema NamedSwaggerDoc (UserId, IdP)
      deletedSchema =
        object $
          (,)
            <$> fst .= field "user" schema
            <*> snd .= field "idp" schema

      updatedSchema :: ValueSchema NamedSwaggerDoc (UserId, IdP, IdP)
      updatedSchema =
        object $
          (,,)
            <$> fst3 .= field "user" schema
            <*> snd3 .= field "old" schema
            <*> thd3 .= field "new" schema

      fst3 (a, _, _) = a
      snd3 (_, b, _) = b
      thd3 (_, _, c) = c

deriving via (Schema IdpChangedNotification) instance FromJSON IdpChangedNotification

deriving via (Schema IdpChangedNotification) instance ToJSON IdpChangedNotification

deriving via (Schema IdpChangedNotification) instance S.ToSchema IdpChangedNotification

swaggerDoc :: OpenApi
swaggerDoc = brigSwaggerDoc

brigSwaggerDoc :: OpenApi
brigSwaggerDoc =
  ( toOpenApi (Proxy @API)
      & info . title .~ "Wire-Server internal brig API"
  )

newtype BrigInternalClient a = BrigInternalClient (Servant.ClientM a)
  deriving newtype (Functor, Applicative, Monad, Servant.RunClient)

brigInternalClient :: forall (name :: Symbol) endpoint. (HasEndpoint API endpoint name, Servant.HasClient BrigInternalClient endpoint) => Servant.Client BrigInternalClient endpoint
brigInternalClient = namedClient @API @name @BrigInternalClient

runBrigInternalClient :: HTTP.Manager -> Endpoint -> RequestId -> BrigInternalClient a -> IO (Either Servant.ClientError a)
runBrigInternalClient httpMgr (Endpoint brigHost brigPort) reqId (BrigInternalClient action) = do
  let baseUrl = Servant.BaseUrl Servant.Http (Text.unpack brigHost) (fromIntegral brigPort) ""
      clientEnv =
        (Servant.mkClientEnv httpMgr baseUrl)
          { Servant.middleware = \app req -> app req {Servant.requestHeaders = (defaultRequestIdHeaderName, unRequestId reqId) Seq.<| Servant.requestHeaders req}
          }
  Servant.runClientM action clientEnv
