-
Notifications
You must be signed in to change notification settings - Fork 325
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
* Migrate integration tests for user properties to the new suite * AsciiText: Write correct instance for FromHttpApiData * AsciiText: Write correct instance for FromJSONKey * Allow setting existing properties even if we have max properties * Rename UserEvents -> Events, also support PropertyEvent * Introduce PropertiesSubsystem
- Loading branch information
1 parent
8151fae
commit a9e8c5f
Showing
39 changed files
with
933 additions
and
492 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1 @@ | ||
Return HTTP 400 instead of 500 when property key is not printable ASCII |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1 @@ | ||
Allow setting existing properties even if we have max properties |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1 @@ | ||
Introduce proeprty subsytem |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,143 @@ | ||
module Test.Property where | ||
|
||
import API.Brig | ||
import API.Common | ||
import qualified Data.Map as Map | ||
import SetupHelpers | ||
import Testlib.Prelude | ||
|
||
testSetGetDeleteProperty :: App () | ||
testSetGetDeleteProperty = do | ||
user <- randomUser OwnDomain def | ||
setProperty user "foo" "bar" `bindResponse` \resp -> | ||
resp.status `shouldMatchInt` 200 | ||
|
||
getProperty user "foo" `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 200 | ||
resp.json `shouldMatch` toJSON "bar" | ||
|
||
deleteProperty user "foo" `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 200 | ||
|
||
getProperty user "foo" `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 404 | ||
|
||
testGetProperties :: App () | ||
testGetProperties = do | ||
user <- randomUser OwnDomain 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 = zip propertyNames propertyVals | ||
forM_ properties $ \(prop, val) -> | ||
setProperty user prop val `bindResponse` \resp -> | ||
resp.status `shouldMatchInt` 200 | ||
|
||
getAllPropertyNames user `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 200 | ||
resp.json `shouldMatchSet` propertyNames | ||
|
||
getAllPropertyValues user `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 200 | ||
resp.json `shouldMatch` Map.fromList properties | ||
|
||
testClearProperties :: App () | ||
testClearProperties = do | ||
user <- randomUser OwnDomain def | ||
|
||
propertyNames <- replicateM 16 $ randomHandleWithRange 8 20 | ||
propertyVals <- replicateM 16 $ randomJSON | ||
let properties = zip propertyNames propertyVals | ||
forM_ properties $ \(prop, val) -> | ||
setProperty user prop val `bindResponse` \resp -> | ||
resp.status `shouldMatchInt` 200 | ||
|
||
clearProperties user `bindResponse` \resp -> | ||
resp.status `shouldMatchInt` 200 | ||
|
||
getAllPropertyNames user `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 200 | ||
resp.json `shouldMatchSet` mempty @[String] | ||
|
||
getAllPropertyValues user `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 200 | ||
resp.json `shouldMatch` Map.empty @String @Value | ||
|
||
testMaxProperties :: App () | ||
testMaxProperties = do | ||
user <- randomUser OwnDomain def | ||
|
||
-- This is hardcoded in the prod code. | ||
let maxProperties = 16 | ||
|
||
propertyNames <- replicateM maxProperties $ randomHandleWithRange 8 20 | ||
propertyVals <- replicateM maxProperties $ randomJSON | ||
let properties = zip propertyNames propertyVals | ||
forM_ properties $ \(prop, val) -> | ||
setProperty user prop val `bindResponse` \resp -> | ||
resp.status `shouldMatchInt` 200 | ||
|
||
seventeenthPropName <- randomHandleWithRange 8 20 | ||
seventeenthPropVal <- randomJSON | ||
|
||
-- cannot set seventeenth property | ||
setProperty user seventeenthPropName seventeenthPropVal `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 403 | ||
resp.json %. "label" `shouldMatch` "too-many-properties" | ||
|
||
-- Old properties are maintained | ||
getAllPropertyValues user `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 200 | ||
resp.json `shouldMatch` Map.fromList properties | ||
|
||
-- Can still update the old properties | ||
newPropertyVals <- replicateM 16 $ randomJSON | ||
let newProperties = zip propertyNames newPropertyVals | ||
forM_ newProperties $ \(prop, val) -> | ||
setProperty user prop val `bindResponse` \resp -> | ||
resp.status `shouldMatchInt` 200 | ||
|
||
getAllPropertyValues user `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 200 | ||
resp.json `shouldMatch` Map.fromList newProperties | ||
|
||
testPropertyNameNotAscii :: App () | ||
testPropertyNameNotAscii = do | ||
user <- randomUser OwnDomain def | ||
setProperty user "döner" "yes" `bindResponse` \resp -> | ||
resp.status `shouldMatchInt` 400 | ||
|
||
testMaxLength :: App () | ||
testMaxLength = do | ||
user <- randomUser OwnDomain 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) | ||
|
||
putStrLn $ "acceptableValue= " <> acceptableValue | ||
|
||
setProperty user tooLongProperty acceptableValue `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 403 | ||
resp.json %. "label" `shouldMatch` "property-key-too-large" | ||
|
||
setProperty user acceptableProperty tooLongValue `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 403 | ||
resp.json %. "label" `shouldMatch` "property-value-too-large" | ||
|
||
setProperty user acceptableProperty acceptableValue `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 200 | ||
|
||
getProperty user acceptableProperty `bindResponse` \resp -> do | ||
resp.status `shouldMatchInt` 200 | ||
resp.json `shouldMatch` toJSON acceptableValue |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,14 @@ | ||
{-# LANGUAGE TemplateHaskell #-} | ||
|
||
module Wire.Events where | ||
|
||
import Data.Id | ||
import Imports | ||
import Polysemy | ||
import Wire.API.UserEvent | ||
|
||
data Events m a where | ||
GenerateUserEvent :: UserId -> Maybe ConnId -> UserEvent -> Events m () | ||
GeneratePropertyEvent :: UserId -> ConnId -> PropertyEvent -> Events m () | ||
|
||
makeSem ''Events |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,19 @@ | ||
{-# LANGUAGE TemplateHaskell #-} | ||
|
||
module Wire.PropertyStore where | ||
|
||
import Data.Id | ||
import Imports | ||
import Polysemy | ||
import Wire.API.Properties | ||
|
||
data PropertyStore m a where | ||
InsertProperty :: UserId -> PropertyKey -> RawPropertyValue -> PropertyStore m () | ||
LookupProperty :: UserId -> PropertyKey -> PropertyStore m (Maybe RawPropertyValue) | ||
CountProperties :: UserId -> PropertyStore m Int | ||
DeleteProperty :: UserId -> PropertyKey -> PropertyStore m () | ||
ClearProperties :: UserId -> PropertyStore m () | ||
GetPropertyKeys :: UserId -> PropertyStore m [PropertyKey] | ||
GetAllProperties :: UserId -> PropertyStore m [(PropertyKey, RawPropertyValue)] | ||
|
||
makeSem ''PropertyStore |
Oops, something went wrong.