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