-- 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.PropertySubsystem.Interpreter where

import Data.Aeson (Value)
import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy qualified as LBS
import Data.Id
import Data.Map qualified as Map
import Data.Text qualified as Text
import Data.Text.Ascii qualified as Ascii
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.Properties
import Wire.API.UserEvent
import Wire.Events
import Wire.PropertyStore (PropertyStore)
import Wire.PropertyStore qualified as PropertyStore
import Wire.PropertySubsystem

data PropertySubsystemConfig = PropertySubsystemConfig
  { maxKeyLength :: Int64,
    maxValueLength :: Int64,
    maxProperties :: Int
  }

interpretPropertySubsystem ::
  ( Member PropertyStore r,
    Member (Error PropertySubsystemError) r,
    Member Events r,
    Member TinyLog r
  ) =>
  PropertySubsystemConfig ->
  InterpreterFor PropertySubsystem r
interpretPropertySubsystem cfg =
  interpret $
    runInputConst cfg . \case
      SetProperty uid connId key val -> setPropertyImpl uid connId key val
      DeleteProperty uid connId key -> deletePropertyImpl uid connId key
      ClearProperties uid connId -> clearPropertiesImpl uid connId
      OnUserDeleted uid -> onUserDeletdImpl uid
      LookupProperty uid key -> lookupPropertyImpl uid key
      GetPropertyKeys uid -> getPropertyKeysImpl uid
      GetAllProperties uid -> getAllPropertiesImpl uid

setPropertyImpl ::
  ( Member PropertyStore r,
    Member (Input PropertySubsystemConfig) r,
    Member (Error PropertySubsystemError) r,
    Member Events r
  ) =>
  UserId ->
  ConnId ->
  PropertyKey ->
  RawPropertyValue ->
  Sem r ()
setPropertyImpl uid connId key val = do
  validatePropertyKey key
  checkMaxProperties uid key
  parsedVal <- validatePropertyValue val
  PropertyStore.insertProperty uid key val
  generatePropertyEvent uid connId $ PropertySet key parsedVal

checkMaxProperties ::
  ( Member PropertyStore r,
    Member (Input PropertySubsystemConfig) r,
    Member (Error PropertySubsystemError) r
  ) =>
  UserId ->
  PropertyKey ->
  Sem r ()
checkMaxProperties uid key = do
  propExists <- isJust <$> PropertyStore.lookupProperty uid key
  unless propExists $ do
    cfg <- input
    count <- PropertyStore.countProperties uid
    when (count >= cfg.maxProperties) $
      throw TooManyProperties

validatePropertyKey ::
  ( Member (Input PropertySubsystemConfig) r,
    Member (Error PropertySubsystemError) r
  ) =>
  PropertyKey ->
  Sem r ()
validatePropertyKey key = do
  cfg <- input
  let keyText = Ascii.toText $ propertyKeyName key
  when (Text.compareLength keyText (fromIntegral cfg.maxKeyLength) == GT) $
    throw PropertyKeyTooLarge

validatePropertyValue ::
  ( Member (Input PropertySubsystemConfig) r,
    Member (Error PropertySubsystemError) r
  ) =>
  RawPropertyValue ->
  Sem r Value
validatePropertyValue (RawPropertyValue bs) = do
  cfg <- input
  when (LBS.compareLength bs cfg.maxValueLength == GT) $
    throw PropertyValueTooLarge

  case Aeson.eitherDecode @Value bs of
    Left e -> throw $ PropertyValueInvalid e
    Right val -> pure val

deletePropertyImpl :: (Member PropertyStore r, Member Events r) => UserId -> ConnId -> PropertyKey -> Sem r ()
deletePropertyImpl uid connId key = do
  PropertyStore.deleteProperty uid key
  generatePropertyEvent uid connId $ PropertyDeleted key

onUserDeletdImpl :: (Member PropertyStore r) => UserId -> Sem r ()
onUserDeletdImpl uid = do
  PropertyStore.clearProperties uid

clearPropertiesImpl :: (Member PropertyStore r, Member Events r) => UserId -> ConnId -> Sem r ()
clearPropertiesImpl uid connId = do
  PropertyStore.clearProperties uid
  generatePropertyEvent uid connId PropertiesCleared

lookupPropertyImpl :: (Member PropertyStore r) => UserId -> PropertyKey -> Sem r (Maybe RawPropertyValue)
lookupPropertyImpl uid key =
  PropertyStore.lookupProperty uid key

getPropertyKeysImpl :: (Member PropertyStore r) => UserId -> Sem r [PropertyKey]
getPropertyKeysImpl uid =
  PropertyStore.getPropertyKeys uid

getAllPropertiesImpl ::
  ( Member PropertyStore r,
    Member TinyLog r,
    Member (Error PropertySubsystemError) r
  ) =>
  UserId ->
  Sem r PropertyKeysAndValues
getAllPropertiesImpl uid = do
  rawProps <- Map.fromList <$> PropertyStore.getAllProperties uid
  PropertyKeysAndValues <$> traverse parseStoredPropertyValue rawProps

parseStoredPropertyValue :: (Member TinyLog r, Member (Error PropertySubsystemError) r) => RawPropertyValue -> Sem r Value
parseStoredPropertyValue raw = case Aeson.eitherDecode raw.rawPropertyBytes of
  Right value -> pure value
  Left e -> do
    Log.err $
      Log.msg (Log.val "Failed to parse a stored property value")
        . Log.field "raw_value" raw.rawPropertyBytes
        . Log.field "parse_error" e
    throw StoredPropertyValueInvalid
