packages feed

launchdarkly-server-sdk-4.0.0: test/Spec/Context.hs

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 qualified Data.Vector as V
import LaunchDarkly.AesonCompat (fromList, lookupKey)
import LaunchDarkly.Server.Config (configSetAllAttributesPrivate, makeConfig)
import LaunchDarkly.Server.Context
import LaunchDarkly.Server.Context.Internal (redactContext)
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 $ V.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 $ V.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 $ V.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 $ V.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 $ V.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 $ V.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 $ V.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 "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 $ V.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 $ V.fromList ["address", "firstName", "hobbies", "lastName", "name"]
    expectedAddress = Object $ fromList [("state", "IL")]

allTests :: Test
allTests =
    TestList
        [ invalidKey
        , invalidKinds
        , multiKindRequiresOne
        , multiKindRequiresUnique
        , multiKindRequiresSingleContextsOnly
        , multiKindWithSingleKindWillReturnSingleKind
        , multiKindCanOnlyRetrieveKindAttribute
        , canRetrievalIndividualContextsFromMultiKindContext
        , canRetrievalIndividualContextsFromSingleKindContext
        , singleContextSupportsValueRetrieval
        , invalidKindCannotRetrieveAnything
        , cannotUseWithAttributeToSetRestrictedAttributes
        , canParseFromLegacyUserFormat
        , canParseSingleKindFormat
        , canParseMultiKindFormat
        , canRedactAttributesCorrectly
        , canRedactAllAttributesCorrectly
        ]