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. 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 String "Op" ((Text -> Parser Op) -> Value -> Parser Op) -> (Text -> Parser Op) -> Value -> Parser Op forall a b. (a -> b) -> a -> b $ \Text v -> case Text v of Text "in" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpIn Text "endsWith" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpEndsWith Text "startsWith" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpStartsWith Text "matches" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpMatches Text "contains" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpContains Text "lessThan" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpLessThan Text "lessThanOrEqual" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpLessThanOrEqual Text "greaterThan" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpGreaterThan Text "greaterThanOrEqual" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpGreaterThanOrEqual Text "before" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpBefore Text "after" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpAfter Text "semVerEqual" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpSemVerEqual Text "semVerLessThan" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpSemVerLessThan Text "semVerGreaterThan" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpSemVerGreaterThan Text "segmentMatch" -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpSegmentMatch Text _ -> Op -> Parser Op forall (f :: * -> *) a. Applicative f => a -> f a pure Op OpUnknown instance ToJSON Op where toJSON :: Op -> Value toJSON Op op = Text -> Value String (Text -> Value) -> Text -> Value 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 = Double -> POSIXTime forall a b. (Real a, Fractional b) => a -> b realToFrac parseTime :: Value -> Maybe UTCTime parseTime :: Value -> Maybe UTCTime parseTime (Number 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 / Double 1000 parseTime (String 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 Value _ = Maybe UTCTime 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 = 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 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 Char -> Char -> Bool 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 Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 2 then Int -> Text -> Text T.replicate (Int 2 Int -> Int -> Int 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 = (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 >>= \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 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 = 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 = case ByteString -> [PCREOption] -> Either String Regex compileM (Text -> ByteString encodeUtf8 Text pattern) [] of Left String _ -> Bool False Right 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 = case Op op of Op OpIn -> Value -> Value -> Bool forall a. Eq a => a -> a -> Bool (==) Op 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) Op 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) Op 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) Op OpMatches -> (Text -> Text -> Bool) -> Value -> Value -> Bool checkString Text -> Text -> Bool matches Op OpLessThan -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool checkNumber Scientific -> Scientific -> Bool forall a. Ord a => a -> a -> Bool (<) Op OpLessThanOrEqual -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool checkNumber Scientific -> Scientific -> Bool forall a. Ord a => a -> a -> Bool (<=) Op OpGreaterThan -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool checkNumber Scientific -> Scientific -> Bool forall a. Ord a => a -> a -> Bool (>) Op OpGreaterThanOrEqual -> (Scientific -> Scientific -> Bool) -> Value -> Value -> Bool checkNumber Scientific -> Scientific -> Bool forall a. Ord a => a -> a -> Bool (>=) Op OpBefore -> (UTCTime -> UTCTime -> Bool) -> Value -> Value -> Bool compareTime UTCTime -> UTCTime -> Bool forall a. Ord a => a -> a -> Bool (<) Op OpAfter -> (UTCTime -> UTCTime -> Bool) -> Value -> Value -> Bool compareTime UTCTime -> UTCTime -> Bool forall a. Ord a => a -> a -> Bool (>) Op 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 (==) Op 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 (<) Op 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 (>) Op OpSegmentMatch -> String -> Value -> Value -> Bool forall a. HasCallStack => String -> a error String "cannot get operation for OpSegmentMatch" Op 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