module Spec.Context (allTests) where
import Test.HUnit
import Control.Monad.Cont (liftIO)
import Data.Aeson (Value (..), decode, encode)
import Data.Function ((&))
import Data.Maybe (fromJust)
import qualified Data.Set as S
import Data.Text (Text)
import GHC.Exts (fromList)
import LaunchDarkly.AesonCompat (lookupKey)
import LaunchDarkly.Server.Config (configSetAllAttributesPrivate, makeConfig)
import LaunchDarkly.Server.Context
import LaunchDarkly.Server.Context.Internal (redactContext, redactContextRedactAnonymous, withoutAnonymousContexts)
import qualified LaunchDarkly.Server.Reference as R
confirmInvalidContext :: Context -> Text -> Assertion
confirmInvalidContext context expectedError =
liftIO $
( do
assertEqual "" False $ isValid context
assertEqual "" expectedError $ getError context
)
invalidKey :: Test
invalidKey =
TestCase $
confirmInvalidContext (makeContext "" "user") "context key must not be empty"
invalidKinds :: Test
invalidKinds =
TestCase $
( do
confirmInvalidContext (makeContext "user-key" "") "context kind must not be empty"
confirmInvalidContext (makeContext "user-key" "kind") "context kind cannot be 'kind'"
confirmInvalidContext (makeContext "user-key" "multi") "context kind cannot be 'multi'"
confirmInvalidContext (makeContext "user-key" "invalid*characters") "context kind contains disallowed characters"
)
multiKindRequiresOne :: Test
multiKindRequiresOne =
TestCase $
confirmInvalidContext (makeMultiContext []) "multi-kind contexts require at least one single-kind context"
multiKindRequiresUnique :: Test
multiKindRequiresUnique =
TestCase $
confirmInvalidContext (makeMultiContext [user1, user2]) "multi-kind contexts cannot contain two single-kind contexts with the same kind"
where
user1 = makeContext "user-key1" "user"
user2 = makeContext "user-key2" "user"
multiKindRequiresSingleContextsOnly :: Test
multiKindRequiresSingleContextsOnly =
TestCase $
confirmInvalidContext (makeMultiContext [user, org, multi]) "multi-kind contexts can only contain single-kind contexts"
where
user = makeContext "user-key" "user"
org = makeContext "org-key" "org"
multi = makeMultiContext [user, org]
multiKindWithSingleKindWillReturnSingleKind :: Test
multiKindWithSingleKindWillReturnSingleKind =
TestCase $
assertEqual "" user (makeMultiContext [user])
where
user = makeContext "user-key" "user"
multiKindCanOnlyRetrieveKindAttribute :: Test
multiKindCanOnlyRetrieveKindAttribute =
TestCase $
let user = makeContext "user-key" "user"
org = makeContext "org-key" "org"
multi = makeMultiContext [user, org]
in ( do
assertEqual "" "multi" $ getValue "kind" multi
assertEqual "" Null $ getValue "key" multi
assertEqual "" "multi" $ getValueForReference (R.makeReference "kind") multi
assertEqual "" Null $ getValueForReference (R.makeReference "key") multi
)
canRetrievalIndividualContextsFromMultiKindContext :: Test
canRetrievalIndividualContextsFromMultiKindContext =
TestCase $
let user = makeContext "user-key" "user"
org = makeContext "org-key" "org"
multi = makeMultiContext [user, org]
in ( do
assertEqual "" (Just user) $ getIndividualContext "user" multi
assertEqual "" (Just org) $ getIndividualContext "org" multi
assertEqual "" Nothing $ getIndividualContext "device" multi
)
canRetrievalIndividualContextsFromSingleKindContext :: Test
canRetrievalIndividualContextsFromSingleKindContext =
TestCase $
let context = makeContext "user-key" "user"
in ( do
assertEqual "" (Just context) $ getIndividualContext "user" context
assertEqual "" Nothing $ getIndividualContext "org" context
)
singleContextSupportsValueRetrieval :: Test
singleContextSupportsValueRetrieval =
TestCase $
let address = Object $ fromList [("city", "Chicago"), ("state", "IL")]
favorites = Object $ fromList [("food", "Pizza"), ("sport", "baseball")]
preferences = Object $ fromList [("favorites", favorites)]
user =
makeContext "user-key" "user"
& withName "Example"
& withAnonymous False
& withAttribute "groups" (Array $ fromList ["beta_testers"])
& withAttribute "address" address
& withAttribute "preferences" preferences
& withAttribute "complex/and-weird~attribute" "nailed it"
in ( do
assertEqual "" "user-key" $ getValue "key" user
assertEqual "" "user" $ getValue "kind" user
assertEqual "" "Example" $ getValue "name" user
assertEqual "" (Bool False) $ getValue "anonymous" user
assertEqual "" Null $ getValue "/address/city" user
assertEqual "" Null $ getValue "/preferences/favorites/sport" user
assertEqual "" Null $ getValue "/groups" user
assertEqual "" Null $ getValue "/groups/0" user
assertEqual "" "nailed it" $ getValue "complex/and-weird~attribute" user
assertEqual "" "user-key" $ getValueForReference (R.makeReference "key") user
assertEqual "" "user" $ getValueForReference (R.makeReference "kind") user
assertEqual "" "Example" $ getValueForReference (R.makeReference "name") user
assertEqual "" (Bool False) $ getValueForReference (R.makeReference "anonymous") user
assertEqual "" "Chicago" $ getValueForReference (R.makeReference "/address/city") user
assertEqual "" "baseball" $ getValueForReference (R.makeReference "/preferences/favorites/sport") user
assertEqual "" (Array $ fromList ["beta_testers"]) $ getValueForReference (R.makeReference "/groups") user
assertEqual "" Null $ getValueForReference (R.makeReference "/groups/0") user
assertEqual "" "nailed it" $ getValueForReference (R.makeReference "/complex~1and-weird~0attribute") user
)
invalidKindCannotRetrieveAnything :: Test
invalidKindCannotRetrieveAnything =
TestCase $
let invalid = makeContext "user-key" "multi" & withName "Sandy" & withAttribute "nickname" "Sam"
in ( do
assertEqual "" Null $ getValue "kind" invalid
assertEqual "" Null $ getValue "key" invalid
assertEqual "" Null $ getValue "name" invalid
assertEqual "" Null $ getValue "nickname" invalid
assertEqual "" Null $ getValueForReference (R.makeReference "kind") invalid
assertEqual "" Null $ getValueForReference (R.makeReference "key") invalid
assertEqual "" Null $ getValueForReference (R.makeReference "name") invalid
assertEqual "" Null $ getValueForReference (R.makeReference "nickname") invalid
)
setAndVerifyAttribute :: Text -> Value -> Value -> Context -> Assertion
setAndVerifyAttribute attribute attempted expected context =
assertEqual "" expected (withAttribute attribute attempted context & getValue attribute)
cannotUseWithAttributeToSetRestrictedAttributes :: Test
cannotUseWithAttributeToSetRestrictedAttributes =
TestCase $
let user =
makeContext "user-key" "user"
& withName "Sandy"
& withAnonymous True
& withAttribute "testing" "something"
invalid = makeContext "invalid-key" "kind"
multi = makeMultiContext [makeContext "org-key" "org", user]
in ( do
setAndVerifyAttribute "kind" "org" "user" user
setAndVerifyAttribute "key" "new-key" "user-key" user
setAndVerifyAttribute "name" "Jim" "Jim" user
setAndVerifyAttribute "name" (Bool True) "Sandy" user
setAndVerifyAttribute "anonymous" (Bool False) (Bool False) user
setAndVerifyAttribute "anonymous" "false" (Bool True) user
setAndVerifyAttribute "_meta" "anything" Null user
setAndVerifyAttribute "privateAttributeNames" (Array $ fromList ["name"]) Null user
setAndVerifyAttribute "kind" "org" "multi" multi
setAndVerifyAttribute "key" "new-key" Null multi
setAndVerifyAttribute "name" "Jim" Null multi
setAndVerifyAttribute "name" (Bool True) Null multi
setAndVerifyAttribute "anonymous" (Bool False) Null multi
setAndVerifyAttribute "anonymous" "false" Null multi
setAndVerifyAttribute "_meta" "anything" Null multi
setAndVerifyAttribute "privateAttributeNames" (Array $ fromList ["name"]) Null multi
setAndVerifyAttribute "kind" "org" Null invalid
setAndVerifyAttribute "key" "new-key" Null invalid
setAndVerifyAttribute "name" "Jim" Null invalid
setAndVerifyAttribute "name" (Bool True) Null invalid
setAndVerifyAttribute "anonymous" (Bool False) Null invalid
setAndVerifyAttribute "anonymous" "false" Null invalid
setAndVerifyAttribute "_meta" "anything" Null invalid
setAndVerifyAttribute "privateAttributeNames" (Array $ fromList ["name"]) Null invalid
)
canParseFromLegacyUserFormat :: Test
canParseFromLegacyUserFormat =
TestCase $
let jsonString = "{\"key\": \"user-key\", \"ip\": \"127.0.0.1\", \"custom\": {\"address\": {\"street\": \"123 Easy St\", \"city\": \"Anytown\"}, \"language\": \"Haskell\"}}"
context :: Context = fromJust $ decode jsonString
in ( do
assertBool "" $ isValid context
assertEqual "" "user" $ getValue "kind" context
assertEqual "" "user-key" $ getValue "key" context
assertEqual "" "127.0.0.1" $ getValue "ip" context
assertEqual "" "Haskell" $ getValue "language" context
assertEqual "" "123 Easy St" $ getValueForReference (R.makeReference "/address/street") context
assertEqual "" "Anytown" $ getValueForReference (R.makeReference "/address/city") context
)
canParseSingleKindFormat :: Test
canParseSingleKindFormat =
TestCase $
let jsonString = "{\"key\": \"org-key\", \"kind\": \"org\", \"ip\": \"127.0.0.1\", \"custom\": {\"address\": {\"street\": \"123 Easy St\", \"city\": \"Anytown\"}, \"language\": \"Haskell\"}}"
context :: Context = fromJust $ decode jsonString
in ( do
assertBool "" $ isValid context
assertEqual "" "org" $ getValue "kind" context
assertEqual "" "org-key" $ getValue "key" context
assertEqual "" "127.0.0.1" $ getValue "ip" context
assertEqual "" Null $ getValue "language" context
assertEqual "" "Haskell" $ getValueForReference (R.makeReference "/custom/language") context
assertEqual "" Null $ getValueForReference (R.makeReference "/address/street") context
assertEqual "" Null $ getValueForReference (R.makeReference "/address/city") context
assertEqual "" "123 Easy St" $ getValueForReference (R.makeReference "/custom/address/street") context
assertEqual "" "Anytown" $ getValueForReference (R.makeReference "/custom/address/city") context
)
canParseMultiKindFormat :: Test
canParseMultiKindFormat =
TestCase $
let jsonString = "{\"kind\": \"multi\", \"user\": {\"key\": \"user-key\", \"name\": \"Sandy\"}, \"org\": {\"key\": \"org-key\", \"name\": \"LaunchDarkly\"}}"
context :: Context = fromJust $ decode jsonString
userContext = fromJust $ getIndividualContext "user" context
orgContext = fromJust $ getIndividualContext "org" context
in ( do
assertBool "" $ isValid context
assertEqual "" "multi" $ getValue "kind" context
assertEqual "" "user" $ getValue "kind" userContext
assertEqual "" "user-key" $ getValue "key" userContext
assertEqual "" "Sandy" $ getValue "name" userContext
assertEqual "" "org" $ getValue "kind" orgContext
assertEqual "" "org-key" $ getValue "key" orgContext
assertEqual "" "LaunchDarkly" $ getValue "name" orgContext
)
canRedactAttributesCorrectly :: Test
canRedactAttributesCorrectly = TestCase $ do
assertEqual "" expectedRedacted (fromJust $ lookupKey "redactedAttributes" meta)
assertEqual "" "user" (fromJust $ lookupKey "kind" decodedIntoMap)
assertEqual "" "user-key" (fromJust $ lookupKey "key" decodedIntoMap)
assertEqual "" "Sandy" (fromJust $ lookupKey "firstName" decodedIntoMap)
assertEqual "" "Beaches" (fromJust $ lookupKey "lastName" decodedIntoMap)
assertEqual "" hobbies (fromJust $ lookupKey "hobbies" decodedIntoMap)
assertEqual "" expectedAddress (fromJust $ lookupKey "address" decodedIntoMap)
where
config = makeConfig "sdk-key"
address = Object $ fromList [("city", "Chicago"), ("state", "IL")]
hobbies = (Array $ fromList ["coding", "reading"])
context =
makeContext "user-key" "user"
& withAttribute "name" "Sandy"
& withAttribute "firstName" "Sandy"
& withAttribute "lastName" "Beaches"
& withAttribute "address" address
& withAttribute "hobbies" hobbies
& withPrivateAttributes (S.fromList [R.makeLiteral "key", R.makeLiteral "kind", R.makeLiteral "anonymous", R.makeLiteral "name", R.makeReference "/address/city", R.makeReference "/hobbies/0"])
jsonByteString = encode $ redactContext config context
decodedAsValue = fromJust $ decode jsonByteString :: Value
decodedIntoMap = case decodedAsValue of (Object o) -> o; _ -> error "expected object"
meta = case lookupKey "_meta" decodedIntoMap of (Just (Object o)) -> o; _ -> error "expected object"
expectedRedacted = Array $ fromList ["/address/city", "name"]
expectedAddress = Object $ fromList [("state", "IL")]
canRedactAllAttributesCorrectly :: Test
canRedactAllAttributesCorrectly = TestCase $ do
assertEqual "" expectedRedacted (fromJust $ lookupKey "redactedAttributes" meta)
assertEqual "" "user" (fromJust $ lookupKey "kind" decodedIntoMap)
assertEqual "" "user-key" (fromJust $ lookupKey "key" decodedIntoMap)
assertEqual "" Nothing (lookupKey "name" decodedIntoMap)
assertEqual "" Nothing (lookupKey "firstName" decodedIntoMap)
assertEqual "" Nothing (lookupKey "lastName" decodedIntoMap)
assertEqual "" Nothing (lookupKey "hobbies" decodedIntoMap)
assertEqual "" Nothing (lookupKey "address" decodedIntoMap)
where
config = makeConfig "sdk-key" & configSetAllAttributesPrivate True
address = Object $ fromList [("city", "Chicago"), ("state", "IL")]
context =
makeContext "user-key" "user"
& withAttribute "name" "Sandy"
& withAttribute "firstName" "Sandy"
& withAttribute "lastName" "Beaches"
& withAttribute "address" address
& withAttribute "hobbies" (Array $ fromList ["coding", "reading"])
jsonByteString = encode $ redactContext config context
decodedAsValue = fromJust $ decode jsonByteString :: Value
decodedIntoMap = case decodedAsValue of (Object o) -> o; _ -> error "expected object"
meta = case lookupKey "_meta" decodedIntoMap of (Just (Object o)) -> o; _ -> error "expected object"
expectedRedacted = Array $ fromList ["address", "firstName", "hobbies", "lastName", "name"]
expectedAddress = Object $ fromList [("state", "IL")]
canRedactSingleKindAnonymousContextAttributesCorrectly :: Test
canRedactSingleKindAnonymousContextAttributesCorrectly = TestCase $ do
assertEqual "" expectedRedacted (fromJust $ lookupKey "redactedAttributes" meta)
assertEqual "" "user" (fromJust $ lookupKey "kind" decodedIntoMap)
assertEqual "" "user-key" (fromJust $ lookupKey "key" decodedIntoMap)
assertEqual "" (Bool True) (fromJust $ lookupKey "anonymous" decodedIntoMap)
assertEqual "" Nothing (lookupKey "name" decodedIntoMap)
assertEqual "" Nothing (lookupKey "firstName" decodedIntoMap)
assertEqual "" Nothing (lookupKey "lastName" decodedIntoMap)
assertEqual "" Nothing (lookupKey "hobbies" decodedIntoMap)
assertEqual "" Nothing (lookupKey "address" decodedIntoMap)
where
config = makeConfig "sdk-key"
address = Object $ fromList [("city", "Chicago"), ("state", "IL")]
context =
makeContext "user-key" "user"
& withAnonymous True
& withAttribute "name" "Sandy"
& withAttribute "firstName" "Sandy"
& withAttribute "lastName" "Beaches"
& withAttribute "address" address
& withAttribute "hobbies" (Array $ fromList ["coding", "reading"])
jsonByteString = encode $ redactContextRedactAnonymous config context
decodedAsValue = fromJust $ decode jsonByteString :: Value
decodedIntoMap = case decodedAsValue of (Object o) -> o; _ -> error "expected object"
meta = case lookupKey "_meta" decodedIntoMap of (Just (Object o)) -> o; _ -> error "expected object"
expectedRedacted = Array $ fromList ["address", "firstName", "hobbies", "lastName", "name"]
canRedactMultiKindAnonymousContextAttributesCorrectly :: Test
canRedactMultiKindAnonymousContextAttributesCorrectly = TestCase $ do
assertEqual "" expectedRedacted (fromJust $ lookupKey "redactedAttributes" userMeta)
assertEqual "" "user-key" (fromJust $ lookupKey "key" userObj)
assertEqual "" (Bool True) (fromJust $ lookupKey "anonymous" userObj)
assertEqual "" Nothing (lookupKey "name" userObj)
assertEqual "" Nothing (lookupKey "firstName" userObj)
assertEqual "" Nothing (lookupKey "lastName" userObj)
assertEqual "" Nothing (lookupKey "hobbies" userObj)
assertEqual "" Nothing (lookupKey "address" userObj)
assertEqual "" "org-key" (fromJust $ lookupKey "key" orgObj)
assertEqual "" Nothing (lookupKey "anonymous" orgObj)
assertEqual "" "LaunchDarkly" (fromJust $ lookupKey "name" orgObj)
assertEqual "" "Launch" (fromJust $ lookupKey "firstName" orgObj)
assertEqual "" "Darkly" (fromJust $ lookupKey "lastName" orgObj)
assertEqual "" hobbies (fromJust $ lookupKey "hobbies" orgObj)
assertEqual "" address (fromJust $ lookupKey "address" orgObj)
where
config = makeConfig "sdk-key"
address = Object $ fromList [("city", "Chicago"), ("state", "IL")]
hobbies = Array $ fromList ["coding", "reading"]
userContext =
makeContext "user-key" "user"
& withAnonymous True
& withAttribute "name" "Sandy"
& withAttribute "firstName" "Sandy"
& withAttribute "lastName" "Beaches"
& withAttribute "address" address
& withAttribute "hobbies" hobbies
orgContext =
makeContext "org-key" "org"
& withAnonymous False
& withAttribute "name" "LaunchDarkly"
& withAttribute "firstName" "Launch"
& withAttribute "lastName" "Darkly"
& withAttribute "address" address
& withAttribute "hobbies" hobbies
multiContext = makeMultiContext [userContext, orgContext]
jsonByteString = encode $ redactContextRedactAnonymous config multiContext
decodedAsValue = fromJust $ decode jsonByteString :: Value
decodedIntoMap = case decodedAsValue of (Object o) -> o; _decodeFailure -> error "expected object"
userObj = case lookupKey "user" decodedIntoMap of (Just (Object o)) -> o; _decodeFailure -> error "expected object"
userMeta = case lookupKey "_meta" userObj of (Just (Object o)) -> o; _ -> error "expected object"
expectedRedacted = Array $ fromList ["address", "firstName", "hobbies", "lastName", "name"]
orgObj = case lookupKey "org" decodedIntoMap of (Just (Object o)) -> o; _decodeFailure -> error "expected object"
canRedactAnonymousContextsAsExpected :: Test
canRedactAnonymousContextsAsExpected =
TestCase $
let anonymousUser = makeContext "user-key" "user" & withAnonymous True
anonymousOrg = makeContext "org-key" "org" & withAnonymous True
device = makeContext "device-key" "device"
mc = makeMultiContext [anonymousUser, anonymousOrg, device]
anonMc = makeMultiContext [anonymousUser, anonymousOrg]
in ( do
-- Redacting an anonymous context should result in an invalid context
assertEqual "" False $ isValid $ withoutAnonymousContexts anonymousUser
-- Redacting a non-anonymous context should result in the same context
assertEqual "" device $ withoutAnonymousContexts device
-- Redacting a multi-context should result in a multi-context with only the non-anonymous contexts
assertEqual "" device $ withoutAnonymousContexts mc
-- Redacting a multi-context with only anonymous contexts should result in an invalid context
assertEqual "" False $ isValid $ withoutAnonymousContexts anonMc
)
allTests :: Test
allTests =
TestList
[ invalidKey
, invalidKinds
, multiKindRequiresOne
, multiKindRequiresUnique
, multiKindRequiresSingleContextsOnly
, multiKindWithSingleKindWillReturnSingleKind
, multiKindCanOnlyRetrieveKindAttribute
, canRetrievalIndividualContextsFromMultiKindContext
, canRetrievalIndividualContextsFromSingleKindContext
, singleContextSupportsValueRetrieval
, invalidKindCannotRetrieveAnything
, cannotUseWithAttributeToSetRestrictedAttributes
, canParseFromLegacyUserFormat
, canParseSingleKindFormat
, canParseMultiKindFormat
, canRedactAttributesCorrectly
, canRedactAllAttributesCorrectly
, canRedactSingleKindAnonymousContextAttributesCorrectly
, canRedactMultiKindAnonymousContextAttributesCorrectly
, canRedactAnonymousContextsAsExpected
]