{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
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 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
$cshowsPrec :: Int -> Reference -> ShowS
showsPrec :: Int -> Reference -> ShowS
$cshow :: Reference -> String
show :: Reference -> String
$cshowList :: [Reference] -> ShowS
showList :: [Reference] -> ShowS
Show, Reference -> Reference -> Bool
(Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool) -> Eq Reference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reference -> Reference -> Bool
== :: Reference -> Reference -> Bool
$c/= :: Reference -> Reference -> Bool
/= :: Reference -> Reference -> Bool
Eq)
instance Ord Reference where
compare :: Reference -> Reference -> Ordering
compare (Invalid Text
_ Text
_) (Valid Text
_ [Text]
_) = Ordering
LT
compare (Valid Text
_ [Text]
_) (Invalid Text
_ Text
_) = Ordering
GT
compare (Valid Text
lhsRaw [Text]
lhsComponents) (Valid Text
rhsRaw [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 Text
lhsRaw Text
lhsError) (Invalid Text
rhsRaw 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
makeReference :: Text -> Reference
makeReference :: Text -> Reference
makeReference Text
"" = Invalid {$sel:rawPath:Valid :: Text
rawPath = Text
"", $sel:error:Valid :: Text
error = Text
"empty reference"}
makeReference Text
"/" = Invalid {$sel:rawPath:Valid :: Text
rawPath = Text
"/", $sel:error:Valid :: Text
error = Text
"empty reference"}
makeReference value :: Text
value@(Text -> Text -> Maybe Text
T.stripPrefix Text
"/" -> Maybe Text
Nothing) = 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 Text
"/" -> Just Text
_) = Invalid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:error:Valid :: Text
error = Text
"trailing slash"}
makeReference Text
value = (Text -> Reference -> Reference)
-> Reference -> [Text] -> Reference
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Reference -> Reference
addComponentToReference (Valid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:components:Valid :: [Text]
components = []}) (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
value)
makeLiteral :: Text -> Reference
makeLiteral :: Text -> Reference
makeLiteral Text
"" = Invalid {$sel:rawPath:Valid :: Text
rawPath = Text
"", $sel:error:Valid :: Text
error = Text
"empty reference"}
makeLiteral value :: Text
value@(Text -> Text -> Maybe Text
T.stripPrefix Text
"/" -> Maybe Text
Nothing) = Valid {$sel:rawPath:Valid :: Text
rawPath = Text
value, $sel:components:Valid :: [Text]
components = [Text
value]}
makeLiteral Text
value = Valid {$sel:rawPath:Valid :: Text
rawPath = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"/" Text
"~1" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"~" Text
"~0" Text
value), $sel:components:Valid :: [Text]
components = [Text
value]}
isValid :: Reference -> Bool
isValid :: Reference -> Bool
isValid (Invalid Text
_ Text
_) = Bool
False
isValid Reference
_ = Bool
True
getError :: Reference -> Text
getError :: Reference -> Text
getError (Invalid {$sel:error:Valid :: Reference -> Text
error = Text
e}) = Text
e
getError Reference
_ = Text
""
getComponents :: Reference -> [Text]
getComponents :: Reference -> [Text]
getComponents (Valid {[Text]
$sel:components:Valid :: Reference -> [Text]
components :: [Text]
components}) = [Text]
components
getComponents Reference
_ = []
getRawPath :: Reference -> Text
getRawPath :: Reference -> Text
getRawPath = Reference -> Text
rawPath
addComponentToReference :: Text -> Reference -> Reference
addComponentToReference :: Text -> Reference -> Reference
addComponentToReference Text
_ r :: Reference
r@(Invalid Text
_ Text
_) = Reference
r
addComponentToReference Text
"" (Valid {Text
$sel:rawPath:Valid :: Reference -> Text
rawPath :: Text
rawPath}) = Invalid {Text
$sel:rawPath:Valid :: Text
rawPath :: Text
rawPath, $sel:error:Valid :: Text
error = Text
"double slash"}
addComponentToReference Text
component (Valid {Text
$sel:rawPath:Valid :: Reference -> Text
rawPath :: Text
rawPath, [Text]
$sel:components:Valid :: Reference -> [Text]
components :: [Text]
components}) = case Text -> Either Text Text
unescapePath Text
component of
Left Text
c -> Valid {Text
$sel:rawPath:Valid :: Text
rawPath :: Text
rawPath, $sel:components:Valid :: [Text]
components = (Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
components)}
Right Text
e -> Invalid {Text
$sel:rawPath:Valid :: Text
rawPath :: Text
rawPath, $sel:error:Valid :: Text
error = Text
e}
unescapePath :: Text -> Either Text Text
unescapePath :: Text -> Either Text Text
unescapePath value :: Text
value@(Text -> Text -> Bool
T.isInfixOf Text
"~" -> Bool
False) = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
value
unescapePath (Text -> Text -> Maybe Text
T.stripSuffix Text
"~" -> Just Text
_) = Text -> Either Text Text
forall a b. b -> Either a b
Right Text
"invalid escape sequence"
unescapePath 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 (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
ComponentState
_ -> Text -> Either Text Text
forall a b. b -> Either a b
Right Text
"invalid escape sequence"
data ComponentState = ComponentState
{ ComponentState -> String
acc :: ![Char]
, ComponentState -> Bool
valid :: !Bool
, ComponentState -> Bool
inEscape :: !Bool
}
unescapeComponent :: ComponentState -> Char -> ComponentState
unescapeComponent :: ComponentState -> Char -> ComponentState
unescapeComponent component :: ComponentState
component@(ComponentState {$sel:valid:ComponentState :: ComponentState -> Bool
valid = Bool
False}) Char
_ = ComponentState
component
unescapeComponent component :: ComponentState
component@(ComponentState {String
$sel:acc:ComponentState :: ComponentState -> String
acc :: String
acc, $sel:inEscape:ComponentState :: ComponentState -> Bool
inEscape = Bool
True}) Char
'0' = ComponentState
component {acc = '~' : acc, valid = True, inEscape = False}
unescapeComponent component :: ComponentState
component@(ComponentState {String
$sel:acc:ComponentState :: ComponentState -> String
acc :: String
acc, $sel:inEscape:ComponentState :: ComponentState -> Bool
inEscape = Bool
True}) Char
'1' = ComponentState
component {acc = '/' : acc, valid = True, inEscape = False}
unescapeComponent component :: ComponentState
component@(ComponentState {$sel:inEscape:ComponentState :: ComponentState -> Bool
inEscape = Bool
True}) Char
_ = ComponentState
component {valid = False}
unescapeComponent ComponentState
component Char
'~' = ComponentState
component {inEscape = True}
unescapeComponent component :: ComponentState
component@(ComponentState {String
$sel:acc:ComponentState :: ComponentState -> String
acc :: String
acc}) Char
c = ComponentState
component {acc = c : acc}