{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Reference is an attribute name or path expression identifying a value within
-- a Context.
--
-- This type is mainly intended to be used internally by LaunchDarkly SDK and
-- service code, where efficiency is a major concern so it's desirable to do
-- any parsing or preprocessing just once. Applications are unlikely to need to
-- use the Reference type directly.
--
-- It can be used to retrieve a value with
-- 'LaunchDarkly.Server.Context.getValueForReference' or to identify an
-- attribute or nested value that should be considered private.
--
-- Parsing and validation are done at the time that the Reference is
-- constructed. If a Reference instance was created from an invalid string, it
-- is considered invalid. The error can be inspected with 'getError'.
--
-- == Syntax
--
-- The string representation of an attribute reference in LaunchDarkly JSON
-- data uses the following syntax:
--
-- If the first character is not a slash, the string is interpreted literally
-- as an attribute name. An attribute name can contain any characters, but must
-- not be empty.
--
-- If the first character is a slash, the string is interpreted as a
-- slash-delimited path where the first path component is an attribute name,
-- and each subsequent path component is the name of a property in a JSON
-- object. Any instances of the characters "/" or "~" in a path component are
-- escaped as "~1" or "~0" respectively. This syntax deliberately resembles
-- JSON Pointer, but no JSON Pointer behaviors other than those mentioned here
-- are supported.
--
-- == Examples
--
-- Suppose there is a context whose JSON implementation looks like this:
--
-- 	{
-- 	  "kind": "user",
-- 	  "key": "value1",
-- 	  "address": {
-- 	    "street": {
-- 	      "line1": "value2",
-- 	      "line2": "value3"
-- 	    },
-- 	    "city": "value4"
-- 	  },
-- 	  "good/bad": "value5"
-- 	}
--
-- The attribute references "key" and "/key" would both point to "value1".
--
-- The attribute reference "/address/street/line1" would point to "value2".
--
-- The attribute references "good/bad" and "/good~1bad" would both point to
-- "value5".
module LaunchDarkly.Server.Reference
    ( Reference
    , makeReference
    , makeLiteral
    , isValid
    , getError
    , getComponents
    , getRawPath
    )
where

import Data.Aeson (ToJSON, Value (String), toJSON)
import Data.Text (Text)
import qualified Data.Text as T

-- | data record for the Reference type.
data Reference
    = Valid {Reference -> Text
rawPath :: !Text, Reference -> [Text]
components :: ![Text]}
    | Invalid {rawPath :: !Text, Reference -> Text
error :: !Text}
    deriving (Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> String
(Int -> Reference -> ShowS)
-> (Reference -> String)
-> ([Reference] -> ShowS)
-> Show Reference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reference] -> ShowS
$cshowList :: [Reference] -> ShowS
show :: Reference -> String
$cshow :: Reference -> String
showsPrec :: Int -> Reference -> ShowS
$cshowsPrec :: Int -> Reference -> ShowS
Show, Reference -> Reference -> Bool
(Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool) -> Eq Reference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reference -> Reference -> Bool
$c/= :: Reference -> Reference -> Bool
== :: Reference -> Reference -> Bool
$c== :: Reference -> Reference -> Bool
Eq)

instance Ord Reference where
    compare :: Reference -> Reference -> Ordering
compare (Invalid _ _) (Valid _ _) = Ordering
LT
    compare (Valid _ _) (Invalid _ _) = Ordering
GT
    compare (Valid lhsRaw :: Text
lhsRaw lhsComponents :: [Text]
lhsComponents) (Valid rhsRaw :: Text
rhsRaw rhsComponents :: [Text]
rhsComponents)
        | [Text]
lhsComponents [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
rhsComponents = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
lhsRaw Text
rhsRaw
        | Bool
otherwise = [Text] -> [Text] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Text]
lhsComponents [Text]
rhsComponents
    compare (Invalid lhsRaw :: Text
lhsRaw lhsError :: Text
lhsError) (Invalid rhsRaw :: Text
rhsRaw rhsError :: Text
rhsError)
        | Text
lhsRaw Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rhsRaw = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
lhsError Text
rhsError
        | Bool
otherwise = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
lhsRaw Text
rhsRaw

instance ToJSON Reference where
    toJSON :: Reference -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Reference -> Text) -> Reference -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Text
rawPath

-- |
-- Creates a Reference from a string. For the supported syntax and examples,
-- see comments on the "LaunchDarkly.Server.Reference" module.
--
-- This function always returns a Reference that preserves the original string,
-- even if validation fails, so that accessing 'getRawPath' (or serializing the
-- Reference to JSON) will produce the original string. If validation fails,
-- 'getError' will return an error and any SDK method that takes this Reference
-- as a parameter will consider it invalid.
makeReference :: Text -> Reference
makeReference :: Text -> Reference
makeReference "" = $WInvalid :: Text -> Text -> Reference
Invalid {$sel:rawPath:Valid :: Text
rawPath = "", $sel:error:Valid :: Text
error = "empty reference"}
makeReference "/" = $WInvalid :: Text -> Text -> Reference
Invalid {$sel:rawPath:Valid :: Text
rawPath = "/", $sel:error:Valid :: Text
error = "empty reference"}
makeReference value :: Text
value@(Text -> Text -> Maybe Text
T.stripPrefix "/" -> Maybe Text
Nothing) = $WValid :: Text -> [Text] -> Reference
Valid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:components:Valid :: [Text]
components = [Text
value]}
makeReference value :: Text
value@(Text -> Text -> Maybe Text
T.stripSuffix "/" -> Just _) = $WInvalid :: Text -> Text -> Reference
Invalid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:error:Valid :: Text
error = "trailing slash"}
makeReference value :: Text
value = (Text -> Reference -> Reference)
-> Reference -> [Text] -> Reference
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Reference -> Reference
addComponentToReference ($WValid :: Text -> [Text] -> Reference
Valid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:components:Valid :: [Text]
components = []}) (Text -> Text -> [Text]
T.splitOn "/" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop 1 Text
value)

-- |
-- makeLiteral is similar to 'makeReference' except that it always interprets
-- the string as a literal attribute name, never as a slash-delimited path
-- expression. There is no escaping or unescaping, even if the name contains
-- literal '/' or '~' characters. Since an attribute name can contain any
-- characters, this method always returns a valid Reference unless the name is
-- empty.
--
-- For example: @makeLiteral "name"@ is exactly equivalent to @makeReference
-- "name"@. @makeLiteral "a/b"@ is exactly equivalent to @makeReference "a/b"@
-- (since the syntax used by 'makeReference' treats the whole string as a
-- literal as long as it does not start with a slash), or to @makeReference
-- "/a~1b"@.
makeLiteral :: Text -> Reference
makeLiteral :: Text -> Reference
makeLiteral "" = $WInvalid :: Text -> Text -> Reference
Invalid {$sel:rawPath:Valid :: Text
rawPath = "", $sel:error:Valid :: Text
error = "empty reference"}
makeLiteral value :: Text
value@(Text -> Text -> Maybe Text
T.stripPrefix "/" -> Maybe Text
Nothing) = $WValid :: Text -> [Text] -> Reference
Valid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:components:Valid :: [Text]
components = [Text
value]}
makeLiteral value :: Text
value = $WValid :: Text -> [Text] -> Reference
Valid {$sel:rawPath:Valid :: Text
rawPath = "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> Text -> Text
T.replace "/" "~1" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace "~" "~0" Text
value), $sel:components:Valid :: [Text]
components = [Text
value]}

-- |
-- Returns True for a valid Reference; False otherwise.
--
-- A Reference is invalid if the input string is empty, or starts with a slash
-- but is not a valid slash-delimited path, or starts with a slash and contains
-- an invalid escape sequence.
--
-- Otherwise, the Reference is valid, but that does not guarantee that such an
-- attribute exists in any given Context. For instance, @makeReference "name"@
-- is a valid Reference, but a specific Context might or might not have a name.
--
-- See comments on the "LaunchDarkly.Server.Reference" module for more details
-- of the attribute reference syntax.
isValid :: Reference -> Bool
isValid :: Reference -> Bool
isValid (Invalid _ _) = Bool
False
isValid _ = Bool
True

-- |
-- Returns an empty string for a valid Reference, or a Text error description
-- for an invalid Reference.
--
-- See comments on the "LaunchDarkly.Server.Reference" module for more details
-- of the attribute reference syntax.
getError :: Reference -> Text
getError :: Reference -> Text
getError (Invalid {$sel:error:Valid :: Reference -> Text
error = Text
e}) = Text
e
getError _ = ""

-- |
-- Retrieves path components from the attribute reference.
--
-- Invalid references will return an empty list.
--
-- > makeReference "" & getComponents     -- returns []
-- > makeReference "a" & getComponents    -- returns ["a"]
-- > makeReference "/a/b" & getComponents -- returns ["a", "b"]
getComponents :: Reference -> [Text]
getComponents :: Reference -> [Text]
getComponents (Valid {[Text]
components :: [Text]
$sel:components:Valid :: Reference -> [Text]
components}) = [Text]
components
getComponents _ = []

-- |
-- Returns the attribute reference as a string, in the same format provided
-- to 'makeReference'.
--
-- If the Reference was created with 'makeReference', this value is identical
-- to the original string. If it was created with 'makeLiteral', the value may
-- be different due to unescaping (for instance, an attribute whose name is
-- "/a" would be represented as "~1a").
getRawPath :: Reference -> Text
getRawPath :: Reference -> Text
getRawPath = Reference -> Text
rawPath

-- Method intended to be used with a foldr. If you do not use this with a
-- foldr, the components will be in the wrong order as this method does
-- prepending.
--
-- This function helps assist in the construction of a Valid reference by
-- incrementally adding a new component to the Reference. If the component
-- cannot be added, or if the Reference is already invalid, we return an
-- Invalid reference with the appropriate error description.
addComponentToReference :: Text -> Reference -> Reference
addComponentToReference :: Text -> Reference -> Reference
addComponentToReference _ r :: Reference
r@(Invalid _ _) = Reference
r
addComponentToReference "" (Valid {Text
rawPath :: Text
$sel:rawPath:Valid :: Reference -> Text
rawPath}) = $WInvalid :: Text -> Text -> Reference
Invalid {Text
rawPath :: Text
$sel:rawPath:Valid :: Text
rawPath, $sel:error:Valid :: Text
error = "double slash"}
addComponentToReference component :: Text
component (Valid {Text
rawPath :: Text
$sel:rawPath:Valid :: Reference -> Text
rawPath, [Text]
components :: [Text]
$sel:components:Valid :: Reference -> [Text]
components}) = case Text -> Either Text Text
unescapePath Text
component of
    Left c :: Text
c -> $WValid :: Text -> [Text] -> Reference
Valid {Text
rawPath :: Text
$sel:rawPath:Valid :: Text
rawPath, $sel:components:Valid :: [Text]
components = (Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
components)}
    Right e :: Text
e -> $WInvalid :: Text -> Text -> Reference
Invalid {Text
rawPath :: Text
$sel:rawPath:Valid :: Text
rawPath, $sel:error:Valid :: Text
error = Text
e}

-- Performs unescaping of attribute reference path components:
--
-- "~1" becomes "/"
-- "~0" becomes "~"
-- "~" followed by any character other than "0" or "1" is invalid
--
-- This method returns an Either. Left Text is the path if unescaping was
-- valid; otherwise, Right Text will be a description error message.
unescapePath :: Text -> Either Text Text
unescapePath :: Text -> Either Text Text
unescapePath value :: Text
value@(Text -> Text -> Bool
T.isInfixOf "~" -> Bool
False) = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
value
unescapePath (Text -> Text -> Maybe Text
T.stripSuffix "~" -> Just _) = Text -> Either Text Text
forall a b. b -> Either a b
Right "invalid escape sequence"
unescapePath value :: Text
value =
    let component :: ComponentState
component = (ComponentState -> Char -> ComponentState)
-> ComponentState -> Text -> ComponentState
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl ComponentState -> Char -> ComponentState
unescapeComponent ($WComponentState :: String -> Bool -> Bool -> ComponentState
ComponentState {$sel:acc:ComponentState :: String
acc = [], $sel:valid:ComponentState :: Bool
valid = Bool
True, $sel:inEscape:ComponentState :: Bool
inEscape = Bool
False}) Text
value
     in case ComponentState
component of
            ComponentState {$sel:acc:ComponentState :: ComponentState -> String
acc = String
acc, $sel:valid:ComponentState :: ComponentState -> Bool
valid = Bool
True} -> Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
acc
            _ -> Text -> Either Text Text
forall a b. b -> Either a b
Right "invalid escape sequence"

-- Component state is a helper record to assist with unescaping a string.
--
-- When we are processing a string, we have to ensure that ~ is followed by 0
-- or 1. Any other value is invalid. To track this, we update this component
-- state through a fold operation.
data ComponentState = ComponentState
    { ComponentState -> String
acc :: ![Char] -- Container to hold the piece of the input that has been successfully parsed.
    , ComponentState -> Bool
valid :: !Bool -- Is the state currently valid?
    , ComponentState -> Bool
inEscape :: !Bool -- Was the last character seen a tilde?
    }

-- Intended to be used in a foldl operation to apply unescaping rules as
-- defined in 'unescapePath'.
--
-- Note that the 'ComponentState.acc' will be built backwards. This is because
-- prepending is faster in Haskell. Calling functions should reverse
-- accordingly.
unescapeComponent :: ComponentState -> Char -> ComponentState
-- Short circuit if we are already invalid
unescapeComponent :: ComponentState -> Char -> ComponentState
unescapeComponent component :: ComponentState
component@(ComponentState {$sel:valid:ComponentState :: ComponentState -> Bool
valid = Bool
False}) _ = ComponentState
component
-- Escape mode with a 0 or 1 means a valid escape sequence. We can append this
-- to the state's accumulator.
unescapeComponent component :: ComponentState
component@(ComponentState {String
acc :: String
$sel:acc:ComponentState :: ComponentState -> String
acc, $sel:inEscape:ComponentState :: ComponentState -> Bool
inEscape = Bool
True}) '0' = ComponentState
component {$sel:acc:ComponentState :: String
acc = '~' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc, $sel:valid:ComponentState :: Bool
valid = Bool
True, $sel:inEscape:ComponentState :: Bool
inEscape = Bool
False}
unescapeComponent component :: ComponentState
component@(ComponentState {String
acc :: String
$sel:acc:ComponentState :: ComponentState -> String
acc, $sel:inEscape:ComponentState :: ComponentState -> Bool
inEscape = Bool
True}) '1' = ComponentState
component {$sel:acc:ComponentState :: String
acc = '/' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc, $sel:valid:ComponentState :: Bool
valid = Bool
True, $sel:inEscape:ComponentState :: Bool
inEscape = Bool
False}
-- Any other character during an escape sequence isn't valid
unescapeComponent component :: ComponentState
component@(ComponentState {$sel:inEscape:ComponentState :: ComponentState -> Bool
inEscape = Bool
True}) _ = ComponentState
component {$sel:valid:ComponentState :: Bool
valid = Bool
False}
-- ~ means we should start escaping
unescapeComponent component :: ComponentState
component '~' = ComponentState
component {$sel:inEscape:ComponentState :: Bool
inEscape = Bool
True}
-- Regular characters can be added without issue
unescapeComponent component :: ComponentState
component@(ComponentState {String
acc :: String
$sel:acc:ComponentState :: ComponentState -> String
acc}) c :: Char
c = ComponentState
component {$sel:acc:ComponentState :: String
acc = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc}