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
  Value
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value -> String -> String -> App Response
forall user val.
(MakesValue user, ToJSON val) =>
user -> String -> val -> App Response
setProperty Value
user String
"foo" String
"bar" 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

  Value -> String -> App Response
forall user. MakesValue user => user -> String -> App Response
getProperty Value
user String
"foo" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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"

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

  Value -> String -> App Response
forall user. MakesValue user => user -> String -> App Response
getProperty Value
user String
"foo" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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
  Value
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.
  [String]
propertyNames <- Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 (App String -> App [String]) -> App String -> App [String]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> App String
randomHandleWithRange Int
8 Int
20
  [Value]
propertyVals <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 (App Value -> App [Value]) -> App Value -> App [Value]
forall a b. (a -> b) -> a -> b
$ App Value
randomJSON
  let properties :: [(String, Value)]
properties = [String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
propertyNames [Value]
propertyVals
  [(String, Value)] -> ((String, Value) -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Value)]
properties (((String, Value) -> App ()) -> App ())
-> ((String, Value) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(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

  Value -> App Response
forall user. MakesValue user => user -> App Response
getAllPropertyNames Value
user App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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

  Value -> App Response
forall user. MakesValue user => user -> App Response
getAllPropertyValues Value
user App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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
  Value
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  [String]
propertyNames <- Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 (App String -> App [String]) -> App String -> App [String]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> App String
randomHandleWithRange Int
8 Int
20
  [Value]
propertyVals <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 (App Value -> App [Value]) -> App Value -> App [Value]
forall a b. (a -> b) -> a -> b
$ App Value
randomJSON
  let properties :: [(String, Value)]
properties = [String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
propertyNames [Value]
propertyVals
  [(String, Value)] -> ((String, Value) -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Value)]
properties (((String, Value) -> App ()) -> App ())
-> ((String, Value) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(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

  Value -> App Response
forall user. MakesValue user => user -> App Response
clearProperties Value
user 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

  Value -> App Response
forall user. MakesValue user => user -> App Response
getAllPropertyNames Value
user App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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]

  Value -> App Response
forall user. MakesValue user => user -> App Response
getAllPropertyValues Value
user App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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
  Value
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
maxProperties = Int
16

  [String]
propertyNames <- Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
maxProperties (App String -> App [String]) -> App String -> App [String]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> App String
randomHandleWithRange Int
8 Int
20
  [Value]
propertyVals <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
maxProperties (App Value -> App [Value]) -> App Value -> App [Value]
forall a b. (a -> b) -> a -> b
$ App Value
randomJSON
  let properties :: [(String, Value)]
properties = [String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
propertyNames [Value]
propertyVals
  [(String, Value)] -> ((String, Value) -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Value)]
properties (((String, Value) -> App ()) -> App ())
-> ((String, Value) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(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

  String
seventeenthPropName <- Int -> Int -> App String
randomHandleWithRange Int
8 Int
20
  Value
seventeenthPropVal <- App Value
randomJSON

  -- cannot set seventeenth property
  Value -> String -> Value -> App Response
forall user val.
(MakesValue user, ToJSON val) =>
user -> String -> val -> App Response
setProperty Value
user String
seventeenthPropName Value
seventeenthPropVal App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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
  Value -> App Response
forall user. MakesValue user => user -> App Response
getAllPropertyValues Value
user App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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
  [Value]
newPropertyVals <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 (App Value -> App [Value]) -> App Value -> App [Value]
forall a b. (a -> b) -> a -> b
$ App Value
randomJSON
  let newProperties :: [(String, Value)]
newProperties = [String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
propertyNames [Value]
newPropertyVals
  [(String, Value)] -> ((String, Value) -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Value)]
newProperties (((String, Value) -> App ()) -> App ())
-> ((String, Value) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(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

  Value -> App Response
forall user. MakesValue user => user -> App Response
getAllPropertyValues Value
user App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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
  Value
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value -> String -> String -> App Response
forall user val.
(MakesValue user, ToJSON val) =>
user -> String -> val -> App Response
setProperty Value
user String
"döner" String
"yes" 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
400

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

  Int
maxKeyLength <- App Value -> App Int
forall a. (HasCallStack, MakesValue a) => a -> App Int
asInt (App Value -> App Int) -> App Value -> App Int
forall a b. (a -> b) -> a -> b
$ Service -> App Value
readServiceConfig Service
Brig App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"optSettings.setPropertyMaxKeyLen"
  Int
maxValLength <- App Value -> App Int
forall a. (HasCallStack, MakesValue a) => a -> App Int
asInt (App Value -> App Int) -> App Value -> App Int
forall a b. (a -> b) -> a -> b
$ Service -> App Value
readServiceConfig Service
Brig App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"optSettings.setPropertyMaxValueLen"

  String
tooLongProperty <- Int -> Int -> App String
randomHandleWithRange (Int
maxKeyLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
maxKeyLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  String
acceptableProperty <- Int -> Int -> App String
randomHandleWithRange Int
maxKeyLength Int
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.
  String
tooLongValue <- Int -> Int -> App String
randomHandleWithRange (Int
maxValLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
maxValLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  String
acceptableValue <- Int -> Int -> App String
randomHandleWithRange (Int
maxValLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Int
maxValLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)

  Value -> String -> String -> App Response
forall user val.
(MakesValue user, ToJSON val) =>
user -> String -> val -> App Response
setProperty Value
user String
tooLongProperty String
acceptableValue App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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"

  Value -> String -> String -> App Response
forall user val.
(MakesValue user, ToJSON val) =>
user -> String -> val -> App Response
setProperty Value
user String
acceptableProperty String
tooLongValue App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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"

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

  Value -> String -> App Response
forall user. MakesValue user => user -> String -> App Response
getProperty Value
user String
acceptableProperty App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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