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) 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" allTests :: Test allTests = TestList [ invalidKey , invalidKinds , multiKindRequiresOne , multiKindRequiresUnique , multiKindRequiresSingleContextsOnly , multiKindWithSingleKindWillReturnSingleKind , multiKindCanOnlyRetrieveKindAttribute , canRetrievalIndividualContextsFromMultiKindContext , canRetrievalIndividualContextsFromSingleKindContext , singleContextSupportsValueRetrieval , invalidKindCannotRetrieveAnything , cannotUseWithAttributeToSetRestrictedAttributes , canParseFromLegacyUserFormat , canParseSingleKindFormat , canParseMultiKindFormat , canRedactAttributesCorrectly , canRedactAllAttributesCorrectly , canRedactSingleKindAnonymousContextAttributesCorrectly , canRedactMultiKindAnonymousContextAttributesCorrectly ]