module LaunchDarkly.Server.Operators
    ( Op(..)
    , getOperation
    ) where

import Data.Maybe            (fromMaybe, isJust)
import Data.Either           (fromRight)
import Data.Text as          T
import Data.Text             (Text, isPrefixOf, isInfixOf, isSuffixOf, unpack)
import Data.Char             (isDigit)
import Data.Text.Encoding    (encodeUtf8)
import Data.Scientific       (Scientific, toRealFloat)
import Data.Aeson.Types      (Value(..), FromJSON, ToJSON(..), withText, parseJSON)
import Data.Time.ISO8601     (parseISO8601)
import Data.Time.Clock       (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)
import Data.SemVer           (Version, fromText, toText, metadata)
import Control.Monad         (liftM2)
import Control.Lens          ((.~))
import GHC.Generics          (Generic)
import Text.Regex.PCRE.Light (compileM, match)

data Op =
      OpIn
    | OpEndsWith
    | OpStartsWith
    | OpMatches
    | OpContains
    | OpLessThan
    | OpLessThanOrEqual
    | OpGreaterThan
    | OpGreaterThanOrEqual
    | OpBefore
    | OpAfter
    | OpSemVerEqual
    | OpSemVerLessThan
    | OpSemVerGreaterThan
    | OpSegmentMatch
    | OpUnknown
    deriving (forall x. Rep Op x -> Op
forall x. Op -> Rep Op x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Op x -> Op
$cfrom :: forall x. Op -> Rep Op x
Generic, Int -> Op -> ShowS
[Op] -> ShowS
Op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Op] -> ShowS
$cshowList :: [Op] -> ShowS
show :: Op -> String
$cshow :: Op -> String
showsPrec :: Int -> Op -> ShowS
$cshowsPrec :: Int -> Op -> ShowS
Show, Op -> Op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Op -> Op -> Bool
$c/= :: Op -> Op -> Bool
== :: Op -> Op -> Bool
$c== :: Op -> Op -> Bool
Eq)

instance FromJSON Op where
    parseJSON :: Value -> Parser Op
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Op" forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
        Text
"in"                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpIn
        Text
"endsWith"           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpEndsWith
        Text
"startsWith"         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpStartsWith
        Text
"matches"            -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpMatches
        Text
"contains"           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpContains
        Text
"lessThan"           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpLessThan
        Text
"lessThanOrEqual"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpLessThanOrEqual
        Text
"greaterThan"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpGreaterThan
        Text
"greaterThanOrEqual" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpGreaterThanOrEqual
        Text
"before"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpBefore
        Text
"after"              -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpAfter
        Text
"semVerEqual"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpSemVerEqual
        Text
"semVerLessThan"     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpSemVerLessThan
        Text
"semVerGreaterThan"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpSemVerGreaterThan
        Text
"segmentMatch"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpSegmentMatch
        Text
_                    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpUnknown

instance ToJSON Op where
    toJSON :: Op -> Value
toJSON Op
op = Text -> Value
String forall a b. (a -> b) -> a -> b
$ case Op
op of
        Op
OpIn                 -> Text
"in"
        Op
OpEndsWith           -> Text
"endsWith"
        Op
OpStartsWith         -> Text
"startsWith"
        Op
OpMatches            -> Text
"matches"
        Op
OpContains           -> Text
"contains"
        Op
OpLessThan           -> Text
"lessThan"
        Op
OpLessThanOrEqual    -> Text
"lessThanOrEqual"
        Op
OpGreaterThan        -> Text
"greaterThan"
        Op
OpGreaterThanOrEqual -> Text
"greaterThanOrEqual"
        Op
OpBefore             -> Text
"before"
        Op
OpAfter              -> Text
"after"
        Op
OpSemVerEqual        -> Text
"semVerEqual"
        Op
OpSemVerLessThan     -> Text
"semVerLessThan"
        Op
OpSemVerGreaterThan  -> Text
"semVerGreaterThan"
        Op
OpSegmentMatch       -> Text
"segmentMatch"
        Op
OpUnknown            -> Text
"unknown"

checkString :: (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString :: (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString Text -> Text -> Bool
op (String Text
x) (String Text
y) = Text -> Text -> Bool
op Text
x Text
y
checkString Text -> Text -> Bool
_ Value
_ Value
_                    = Bool
False

checkNumber :: (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool
checkNumber :: (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool
checkNumber Scientific -> Scientific -> Bool
op (Number Scientific
x) (Number Scientific
y) = Scientific -> Scientific -> Bool
op Scientific
x Scientific
y
checkNumber Scientific -> Scientific -> Bool
_ Value
_ Value
_                    = Bool
False

doubleToPOSIXTime :: Double -> POSIXTime
doubleToPOSIXTime :: Double -> POSIXTime
doubleToPOSIXTime = forall a b. (Real a, Fractional b) => a -> b
realToFrac

parseTime :: Value -> Maybe UTCTime
parseTime :: Value -> Maybe UTCTime
parseTime (Number Scientific
x) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime forall a b. (a -> b) -> a -> b
$ Double -> POSIXTime
doubleToPOSIXTime forall a b. (a -> b) -> a -> b
$ (forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
x) forall a. Fractional a => a -> a -> a
/ Double
1000
parseTime (String Text
x) = String -> Maybe UTCTime
parseISO8601 forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
x
parseTime Value
_          = forall a. Maybe a
Nothing

compareTime :: (UTCTime -> UTCTime -> Bool) -> Value -> Value -> Bool
compareTime :: (UTCTime -> UTCTime -> Bool) -> Value -> Value -> Bool
compareTime UTCTime -> UTCTime -> Bool
op Value
x Value
y = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 UTCTime -> UTCTime -> Bool
op (Value -> Maybe UTCTime
parseTime Value
x) (Value -> Maybe UTCTime
parseTime Value
y)

padSemVer :: Text -> Text
padSemVer :: Text -> Text
padSemVer Text
text = [Text] -> Text
T.concat [Text
l, Text
padding, Text
r] where
    (Text
l, Text
r) = (Char -> Bool) -> Text -> (Text, Text)
T.span (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.') Text
text
    dots :: Int
dots = Text -> Text -> Int
T.count Text
"." Text
l
    padding :: Text
padding = if Int
dots forall a. Ord a => a -> a -> Bool
< Int
2 then Int -> Text -> Text
T.replicate (Int
2 forall a. Num a => a -> a -> a
- Int
dots) Text
".0" else Text
""

parseSemVer :: Text -> Either String Version
parseSemVer :: Text -> Either String Version
parseSemVer Text
raw = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *).
Functor f =>
([Identifier] -> f [Identifier]) -> Version -> f Version
metadata forall s t a b. ASetter s t a b -> b -> s -> t
.~ []) (Text -> Either String Version
fromText forall a b. (a -> b) -> a -> b
$ Text -> Text
padSemVer Text
raw) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Version
x ->
    if Text -> Text -> Bool
T.isPrefixOf (Version -> Text
toText Version
x) (Text -> Text
padSemVer Text
raw) then forall a b. b -> Either a b
Right Version
x else forall a b. a -> Either a b
Left String
"mismatch" where

compareSemVer :: (Version -> Version -> Bool) -> Text -> Text -> Bool
compareSemVer :: (Version -> Version -> Bool) -> Text -> Text -> Bool
compareSemVer Version -> Version -> Bool
op Text
x Text
y = forall b a. b -> Either a b -> b
fromRight Bool
False forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Version -> Version -> Bool
op (Text -> Either String Version
parseSemVer Text
x) (Text -> Either String Version
parseSemVer Text
y)

matches :: Text -> Text -> Bool
matches :: Text -> Text -> Bool
matches Text
text Text
pattern = case ByteString -> [PCREOption] -> Either String Regex
compileM (Text -> ByteString
encodeUtf8 Text
pattern) [] of
    Left String
_         -> Bool
False
    Right Regex
compiled -> forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
compiled (Text -> ByteString
encodeUtf8 Text
text) []

getOperation :: Op -> (Value -> Value -> Bool)
getOperation :: Op -> Value -> Value -> Bool
getOperation Op
op = case Op
op of
    Op
OpIn                 -> forall a. Eq a => a -> a -> Bool
(==)
    Op
OpEndsWith           -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString (forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
isSuffixOf)
    Op
OpStartsWith         -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString (forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
isPrefixOf)
    Op
OpContains           -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString (forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
isInfixOf)
    Op
OpMatches            -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString Text -> Text -> Bool
matches
    Op
OpLessThan           -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool
checkNumber forall a. Ord a => a -> a -> Bool
(<)
    Op
OpLessThanOrEqual    -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool
checkNumber forall a. Ord a => a -> a -> Bool
(<=)
    Op
OpGreaterThan        -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool
checkNumber forall a. Ord a => a -> a -> Bool
(>)
    Op
OpGreaterThanOrEqual -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool
checkNumber forall a. Ord a => a -> a -> Bool
(>=)
    Op
OpBefore             -> (UTCTime -> UTCTime -> Bool) -> Value -> Value -> Bool
compareTime forall a. Ord a => a -> a -> Bool
(<)
    Op
OpAfter              -> (UTCTime -> UTCTime -> Bool) -> Value -> Value -> Bool
compareTime forall a. Ord a => a -> a -> Bool
(>)
    Op
OpSemVerEqual        -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString forall a b. (a -> b) -> a -> b
$ (Version -> Version -> Bool) -> Text -> Text -> Bool
compareSemVer forall a. Eq a => a -> a -> Bool
(==)
    Op
OpSemVerLessThan     -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString forall a b. (a -> b) -> a -> b
$ (Version -> Version -> Bool) -> Text -> Text -> Bool
compareSemVer forall a. Ord a => a -> a -> Bool
(<)
    Op
OpSemVerGreaterThan  -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString forall a b. (a -> b) -> a -> b
$ (Version -> Version -> Bool) -> Text -> Text -> Bool
compareSemVer forall a. Ord a => a -> a -> Bool
(>)
    Op
OpSegmentMatch       -> forall a. HasCallStack => String -> a
error String
"cannot get operation for OpSegmentMatch"
    Op
OpUnknown            -> forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
False