{-# LANGUAGE NoPatternSynonyms #-}

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

import Control.Lens ((.~))
import Control.Monad (liftM2)
import Data.Aeson.Types (FromJSON, ToJSON (..), Value (..), parseJSON, withText)
import Data.Char (isDigit)
import Data.Either (fromRight)
import Data.Maybe (fromMaybe, isJust)
import Data.Scientific (Scientific, toRealFloat)
import Data.SemVer (Version, fromText, metadata, toText)
import Data.Text (Text, isInfixOf, isPrefixOf, isSuffixOf, unpack)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)
import Data.Time.ISO8601 (parseISO8601)
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. Op -> Rep Op x)
-> (forall x. Rep Op x -> Op) -> Generic Op
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
(Int -> Op -> ShowS)
-> (Op -> String) -> ([Op] -> ShowS) -> Show Op
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
(Op -> Op -> Bool) -> (Op -> Op -> Bool) -> Eq Op
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 = String -> (Text -> Parser Op) -> Value -> Parser Op
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Op" ((Text -> Parser Op) -> Value -> Parser Op)
-> (Text -> Parser Op) -> Value -> Parser Op
forall a b. (a -> b) -> a -> b
$ \v :: Text
v -> case Text
v of
        "in" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpIn
        "endsWith" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpEndsWith
        "startsWith" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpStartsWith
        "matches" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpMatches
        "contains" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpContains
        "lessThan" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpLessThan
        "lessThanOrEqual" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpLessThanOrEqual
        "greaterThan" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpGreaterThan
        "greaterThanOrEqual" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpGreaterThanOrEqual
        "before" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpBefore
        "after" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpAfter
        "semVerEqual" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpSemVerEqual
        "semVerLessThan" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpSemVerLessThan
        "semVerGreaterThan" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpSemVerGreaterThan
        "segmentMatch" -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpSegmentMatch
        _ -> Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
OpUnknown

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

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

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

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

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

compareTime :: (UTCTime -> UTCTime -> Bool) -> Value -> Value -> Bool
compareTime :: (UTCTime -> UTCTime -> Bool) -> Value -> Value -> Bool
compareTime op :: UTCTime -> UTCTime -> Bool
op x :: Value
x y :: Value
y = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (UTCTime -> UTCTime -> Bool)
-> Maybe UTCTime -> Maybe UTCTime -> Maybe Bool
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] -> Text
T.concat [Text
l, Text
padding, Text
r]
  where
    (l :: Text
l, r :: Text
r) = (Char -> Bool) -> Text -> (Text, Text)
T.span (\c :: Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.') Text
text
    dots :: Int
dots = Text -> Text -> Int
T.count "." Text
l
    padding :: Text
padding = if Int
dots Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 then Int -> Text -> Text
T.replicate (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dots) ".0" else ""

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

compareSemVer :: (Version -> Version -> Bool) -> Text -> Text -> Bool
compareSemVer :: (Version -> Version -> Bool) -> Text -> Text -> Bool
compareSemVer op :: Version -> Version -> Bool
op x :: Text
x y :: Text
y = Bool -> Either String Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Either String Bool -> Bool) -> Either String Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Version -> Version -> Bool)
-> Either String Version
-> Either String Version
-> Either String Bool
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 :: Text
pattern = case ByteString -> [PCREOption] -> Either String Regex
compileM (Text -> ByteString
encodeUtf8 Text
pattern) [] of
    Left _ -> Bool
False
    Right compiled :: Regex
compiled -> Maybe [ByteString] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [ByteString] -> Bool) -> Maybe [ByteString] -> Bool
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
op = case Op
op of
    OpIn -> Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(==)
    OpEndsWith -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString ((Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
isSuffixOf)
    OpStartsWith -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString ((Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
isPrefixOf)
    OpContains -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString ((Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
isInfixOf)
    OpMatches -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString Text -> Text -> Bool
matches
    OpLessThan -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool
checkNumber Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(<)
    OpLessThanOrEqual -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool
checkNumber Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
    OpGreaterThan -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool
checkNumber Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(>)
    OpGreaterThanOrEqual -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool
checkNumber Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
    OpBefore -> (UTCTime -> UTCTime -> Bool) -> Value -> Value -> Bool
compareTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
(<)
    OpAfter -> (UTCTime -> UTCTime -> Bool) -> Value -> Value -> Bool
compareTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
(>)
    OpSemVerEqual -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString ((Text -> Text -> Bool) -> Value -> Value -> Bool)
-> (Text -> Text -> Bool) -> Value -> Value -> Bool
forall a b. (a -> b) -> a -> b
$ (Version -> Version -> Bool) -> Text -> Text -> Bool
compareSemVer Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
(==)
    OpSemVerLessThan -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString ((Text -> Text -> Bool) -> Value -> Value -> Bool)
-> (Text -> Text -> Bool) -> Value -> Value -> Bool
forall a b. (a -> b) -> a -> b
$ (Version -> Version -> Bool) -> Text -> Text -> Bool
compareSemVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
(<)
    OpSemVerGreaterThan -> (Text -> Text -> Bool) -> Value -> Value -> Bool
checkString ((Text -> Text -> Bool) -> Value -> Value -> Bool)
-> (Text -> Text -> Bool) -> Value -> Value -> Bool
forall a b. (a -> b) -> a -> b
$ (Version -> Version -> Bool) -> Text -> Text -> Bool
compareSemVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
(>)
    OpSegmentMatch -> String -> Value -> Value -> Bool
forall a. HasCallStack => String -> a
error "cannot get operation for OpSegmentMatch"
    OpUnknown -> (Value -> Bool) -> Value -> Value -> Bool
forall a b. a -> b -> a
const ((Value -> Bool) -> Value -> Value -> Bool)
-> (Value -> Bool) -> Value -> Value -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Value -> Bool
forall a b. a -> b -> a
const Bool
False