-- 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 Wire.AppSubsystem.Interpreter where

import Data.ByteString.Conversion
import Data.Default
import Data.Id
import Data.Json.Util
import Data.LegalHold (UserLegalHoldStatus (..))
import Data.Misc
import Data.Qualified
import Data.RetryAfter
import Data.Set qualified as Set
import Data.ZAuth.Token (Token (..), Type (U))
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog (TinyLog)
import Polysemy.TinyLog qualified as Log
import System.Logger.Message qualified as Log
import Wire.API.Event.Team
import Wire.API.Team.Member qualified as T
import Wire.API.Team.Role qualified as R
import Wire.API.User
import Wire.API.User.Auth
import Wire.API.UserEvent hiding (UserLegalHoldDisabled)
import Wire.AppStore (AppStore, StoredApp (..))
import Wire.AppStore qualified as Store
import Wire.AppSubsystem
import Wire.AuthenticationSubsystem
import Wire.AuthenticationSubsystem.Cookie (revokeAllCookies)
import Wire.AuthenticationSubsystem.ZAuth
import Wire.Events
import Wire.GalleyAPIAccess
import Wire.NotificationSubsystem
import Wire.Sem.Now
import Wire.Sem.Random
import Wire.StoredUser
import Wire.TeamSubsystem
import Wire.TeamSubsystem.Util
import Wire.UserStore (UserStore)
import Wire.UserStore qualified as Store
import Wire.UserSubsystem (UserSubsystem, internalUpdateSearchIndex)

runAppSubsystem ::
  ( Member UserStore r,
    Member TinyLog r,
    Member (Error AppSubsystemError) r,
    Member (Input AppSubsystemConfig) r,
    Member GalleyAPIAccess r,
    Member AppStore r,
    Member Now r,
    Member TeamSubsystem r,
    Member NotificationSubsystem r,
    Member Random r,
    Member Events r
  ) =>
  InterpreterFor UserSubsystem (AuthenticationSubsystem ': r) ->
  InterpreterFor AuthenticationSubsystem r ->
  Sem (AppSubsystem ': r) a ->
  Sem r a
runAppSubsystem runUser runAuth =
  interpret $
    runAuth . runUser . \case
      CreateApp lusr tid new -> createAppImpl lusr tid new
      GetApp lusr tid uid -> getAppImpl lusr tid uid
      GetApps lusr tid -> getAppsImpl lusr tid
      UpdateApp lusr tid uid put -> updateAppImpl lusr tid uid put
      RefreshAppCookie lusr tid appId password -> runError $ refreshAppCookieImpl lusr tid appId password
      InternalDeleteApp tid appId -> internalDeleteAppImpl tid appId

createAppImpl ::
  ( Member UserStore r,
    Member AppStore r,
    Member TinyLog r,
    Member (Error AppSubsystemError) r,
    Member (Input AppSubsystemConfig) r,
    Member GalleyAPIAccess r,
    Member Now r,
    Member TeamSubsystem r,
    Member NotificationSubsystem r,
    Member AuthenticationSubsystem r,
    Member UserSubsystem r,
    Member Random r
  ) =>
  Local UserId ->
  TeamId ->
  NewApp ->
  Sem r CreatedApp
createAppImpl lusr tid newApp = do
  verifyUserPasswordError lusr newApp.password
  (creator, mem) <- ensureTeamMember lusr tid
  note AppSubsystemErrorNoPerm $ guard (T.hasPermission mem T.CreateApp)

  u <- appNewStoredUser creator newApp
  let app =
        StoredApp
          { id = u.id,
            teamId = tid,
            meta = mempty, -- unused, can be removed from postgres schema at some point.
            category = newApp.category,
            description = newApp.description,
            creator = tUnqualified lusr
          }

  Log.info $
    Log.field "app" (toByteString app.id)
      . Log.field "creator" (toByteString creator.id)
      . Log.msg (Log.val "Creating app")

  -- create app and user entries
  Store.createApp app
  Store.createUser u Nothing
  now <- toUTCTimeMillis <$> get
  void $ addTeamMember u.id tid (Just (tUnqualified lusr, now)) R.RoleMember
  internalUpdateSearchIndex u.id

  -- generate a team event
  generateTeamEvents creator.id tid [EdMemberJoin u.id]

  c :: Cookie (Token U) <- newCookie u.id Nothing PersistentCookie Nothing RevokeSameLabel
  pure
    CreatedApp
      { user =
          let usr :: User = newStoredUserToUser (tUntagged (qualifyAs lusr u))
              mbApp :: Maybe AppInfo = Just $ storedAppToAppInfo app
              lh = UserLegalHoldDisabled -- FUTUREWORK: this needs to be changed as soon as apps can be put under LH.
           in mkUserProfile EmailVisibleIfOnTeam usr mbApp lh,
        cookie = mkSomeToken c.cookieValue
      }

-- | Check that @lusr@ is member of team with @tid@.
ensureTeamMember ::
  ( Member UserStore r,
    Member (Error AppSubsystemError) r,
    Member GalleyAPIAccess r
  ) =>
  Local UserId ->
  TeamId ->
  Sem r (StoredUser, T.TeamMember)
ensureTeamMember lusr tid = do
  storedUser <- Store.getUser (tUnqualified lusr) >>= note AppSubsystemErrorNoUser
  teamMember <- getTeamMember storedUser.id tid >>= note AppSubsystemErrorNoPerm
  pure (storedUser, teamMember)

getAppImpl ::
  ( Member AppStore r,
    Member (Error AppSubsystemError) r,
    Member GalleyAPIAccess r,
    Member UserStore r
  ) =>
  Local UserId ->
  TeamId ->
  UserId ->
  Sem r AppInfo
getAppImpl lusr tid uid = do
  void $ ensureTeamMember lusr tid
  storedApp <- Store.getApp uid tid >>= note AppSubsystemErrorNoApp
  pure $ storedAppToAppInfo storedApp

storedAppToAppInfo :: StoredApp -> AppInfo
storedAppToAppInfo app =
  AppInfo
    { category = app.category,
      description = app.description
    }

getAppsImpl ::
  ( Member AppStore r,
    Member (Error AppSubsystemError) r,
    Member GalleyAPIAccess r,
    Member UserStore r
  ) =>
  Local UserId ->
  TeamId ->
  Sem r [(UserId, AppInfo)]
getAppsImpl lusr tid = do
  void $ ensureTeamMember lusr tid
  Store.getApps tid <&> map \storedApp -> (storedApp.id, storedAppToAppInfo storedApp)

updateAppImpl ::
  ( Member AppStore r,
    Member (Error AppSubsystemError) r,
    Member Events r,
    Member GalleyAPIAccess r,
    Member UserSubsystem r,
    Member UserStore r
  ) =>
  Local UserId ->
  TeamId ->
  UserId ->
  PutApp ->
  Sem r ()
updateAppImpl lusr tid appid upd = do
  (_updater, umem) <- ensureTeamMember lusr tid
  note AppSubsystemErrorNoPerm $ guard (T.hasPermission umem T.CreateApp)
  Store.updateApp tid appid (Store.MkStoredAppUpdate {category = upd.category, description = upd.description}) >>= \case
    Right () -> pure ()
    Left Store.NotFound -> throw AppSubsystemErrorNoApp
  Store.updateUser appid (def {Store.name = upd.name, Store.assets = upd.assets, Store.accentId = upd.accentId})
  internalUpdateSearchIndex appid
  generateUserEvent appid Nothing $
    UserUpdated $
      (emptyUserUpdatedData appid)
        { eupName = upd.name,
          eupAccentId = upd.accentId,
          eupAssets = upd.assets
        }

refreshAppCookieImpl ::
  ( Member AuthenticationSubsystem r,
    Member AppStore r,
    Member (Error RetryAfter) r,
    Member (Error AppSubsystemError) r,
    Member GalleyAPIAccess r
  ) =>
  Local UserId ->
  TeamId ->
  UserId ->
  Maybe PlainTextPassword6 ->
  Sem r SomeUserToken
refreshAppCookieImpl (tUnqualified -> uid) tid appId mbPassword = do
  reauthenticateEither uid mbPassword
    >>= either (const $ throw AppSubsystemErrorMissingAuth) (const $ pure ())

  mem <- getTeamMember uid tid >>= note AppSubsystemErrorNoPerm
  note AppSubsystemErrorNoPerm $ guard (T.hasPermission mem T.ManageApps)
  void $ Store.getApp appId tid >>= note AppSubsystemErrorNoApp

  revokeAllCookies appId
  c :: Cookie (Token U) <-
    newCookieLimited appId Nothing PersistentCookie Nothing RevokeSameLabel
      >>= either throw pure
  pure $ mkSomeToken c.cookieValue

appNewStoredUser ::
  (Member (Input AppSubsystemConfig) r, Member Random r) =>
  StoredUser ->
  NewApp ->
  Sem r NewStoredUser
appNewStoredUser creator new = do
  uid <- newId
  defLoc <- inputs defaultLocale
  let loc = toLocale defLoc (creator.language, creator.country)
  pure
    NewStoredUser
      { id = uid,
        userType = UserTypeApp,
        email = Nothing,
        ssoId = Nothing,
        name = new.name,
        textStatus = Nothing,
        pict = Pict [],
        assets = new.assets,
        accentId = new.accentId,
        password = Nothing,
        activated = True,
        status = Active,
        language = loc.lLanguage,
        country = loc.lCountry,
        providerId = Nothing,
        serviceId = Nothing,
        handle = Nothing,
        expires = Nothing,
        teamId = creator.teamId,
        managedBy = defaultManagedBy,
        supportedProtocols = defAppSupportedProtocols,
        searchable = True
      }

defAppSupportedProtocols :: Set BaseProtocolTag
defAppSupportedProtocols = Set.singleton BaseProtocolMLSTag

internalDeleteAppImpl ::
  (Member AppStore r) =>
  TeamId ->
  UserId ->
  Sem r ()
internalDeleteAppImpl teamId appId =
  Store.deleteApp appId teamId
