-- 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 Test.Property where

import API.Brig
import API.Common
import qualified Data.Map as Map
import SetupHelpers
import Testlib.Prelude

testSetGetDeleteProperty :: App ()
testSetGetDeleteProperty :: App ()
testSetGetDeleteProperty = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  setProperty user "foo" "bar" `bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  getProperty user "foo" `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String -> Value
forall a. ToJSON a => a -> Value
toJSON String
"bar"

  deleteProperty user "foo" `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  getProperty user "foo" `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testGetProperties :: App ()
testGetProperties :: App ()
testGetProperties = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  -- Property names can only be printable ascii, using the handle function here
  -- as a little shortcut.
  propertyNames <- replicateM 16 $ randomHandleWithRange 8 20
  propertyVals <- replicateM 16 $ randomJSON
  let properties = [String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
propertyNames [Value]
propertyVals
  forM_ properties $ \(String
prop, Value
val) ->
    Value -> String -> Value -> App Response
forall user val.
(MakesValue user, ToJSON val) =>
user -> String -> val -> App Response
setProperty Value
user String
prop Value
val App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  getAllPropertyNames user `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String]
propertyNames

  getAllPropertyValues user `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> Map String Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [(String, Value)] -> Map String Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, Value)]
properties

testClearProperties :: App ()
testClearProperties :: App ()
testClearProperties = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  propertyNames <- replicateM 16 $ randomHandleWithRange 8 20
  propertyVals <- replicateM 16 $ randomJSON
  let properties = [String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
propertyNames [Value]
propertyVals
  forM_ properties $ \(String
prop, Value
val) ->
    Value -> String -> Value -> App Response
forall user val.
(MakesValue user, ToJSON val) =>
user -> String -> val -> App Response
setProperty Value
user String
prop Value
val App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  clearProperties user `bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  getAllPropertyNames user `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` forall a. Monoid a => a
mempty @[String]

  getAllPropertyValues user `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> Map String Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` forall k a. Map k a
Map.empty @String @Value

testMaxProperties :: App ()
testMaxProperties :: App ()
testMaxProperties = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  -- This is hardcoded in the prod code.
  let maxProperties = Int
16

  propertyNames <- replicateM maxProperties $ randomHandleWithRange 8 20
  propertyVals <- replicateM maxProperties $ randomJSON
  let properties = [String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
propertyNames [Value]
propertyVals
  forM_ properties $ \(String
prop, Value
val) ->
    Value -> String -> Value -> App Response
forall user val.
(MakesValue user, ToJSON val) =>
user -> String -> val -> App Response
setProperty Value
user String
prop Value
val App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  seventeenthPropName <- randomHandleWithRange 8 20
  seventeenthPropVal <- randomJSON

  -- cannot set seventeenth property
  setProperty user seventeenthPropName seventeenthPropVal `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"too-many-properties"

  -- Old properties are maintained
  getAllPropertyValues user `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> Map String Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [(String, Value)] -> Map String Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, Value)]
properties

  -- Can still update the old properties
  newPropertyVals <- replicateM 16 $ randomJSON
  let newProperties = [String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
propertyNames [Value]
newPropertyVals
  forM_ newProperties $ \(String
prop, Value
val) ->
    Value -> String -> Value -> App Response
forall user val.
(MakesValue user, ToJSON val) =>
user -> String -> val -> App Response
setProperty Value
user String
prop Value
val App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  getAllPropertyValues user `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> Map String Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [(String, Value)] -> Map String Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, Value)]
newProperties

testPropertyNameNotAscii :: App ()
testPropertyNameNotAscii :: App ()
testPropertyNameNotAscii = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  setProperty user "döner" "yes" `bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400

testMaxLength :: App ()
testMaxLength :: App ()
testMaxLength = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  maxKeyLength <- asInt $ readServiceConfig Brig %. "optSettings.setPropertyMaxKeyLen"
  maxValLength <- asInt $ readServiceConfig Brig %. "optSettings.setPropertyMaxValueLen"

  tooLongProperty <- randomHandleWithRange (maxKeyLength + 1) (maxKeyLength + 1)
  acceptableProperty <- randomHandleWithRange maxKeyLength maxKeyLength

  -- Two chars are taken by the quotes for string values.
  --
  -- We use the `randomHandleWithRange` function because having non-ascii
  -- characters or unprintable characters will increase the length of the JSON.
  tooLongValue <- randomHandleWithRange (maxValLength - 1) (maxValLength - 1)
  acceptableValue <- randomHandleWithRange (maxValLength - 2) (maxValLength - 2)

  setProperty user tooLongProperty acceptableValue `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"property-key-too-large"

  setProperty user acceptableProperty tooLongValue `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"property-value-too-large"

  setProperty user acceptableProperty acceptableValue `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  getProperty user acceptableProperty `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String -> Value
forall a. ToJSON a => a -> Value
toJSON String
acceptableValue