{-# 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