{-# LANGUAGE BangPatterns #-}
module LaunchDarkly.Server.Integrations.FileData
( dataSourceFactory
)
where
import LaunchDarkly.Server.DataSource.Internal (DataSourceFactory, DataSource(..), DataSourceUpdates(..))
import qualified LaunchDarkly.Server.Features as F
import LaunchDarkly.Server.Client.Status
import LaunchDarkly.AesonCompat (KeyMap, mapWithKey)
import Data.Maybe (fromMaybe)
import qualified Data.ByteString.Lazy as BSL
import Data.HashSet (HashSet)
import Data.Text (Text)
import GHC.Generics (Generic)
import Data.Aeson (Value, FromJSON, decode)
import Data.Monoid (Monoid, mempty)
import Data.Semigroup (Semigroup)
import Data.IORef (newIORef, readIORef, writeIORef)
import GHC.Natural (Natural)
import Data.Generics.Product (getField)
import qualified Data.Yaml as Yaml
import Control.Applicative ((<|>))
data FileFlag = FileFlag
{ FileFlag -> Maybe Natural
version :: Maybe Natural
, FileFlag -> Maybe Bool
on :: Maybe Bool
, FileFlag -> Maybe [Target]
targets :: Maybe [F.Target]
, FileFlag -> Maybe [Rule]
rules :: Maybe [F.Rule]
, FileFlag -> Maybe VariationOrRollout
fallthrough :: Maybe F.VariationOrRollout
, FileFlag -> Maybe Integer
offVariation :: Maybe Integer
, FileFlag -> [Value]
variations :: ![Value]
} deriving (forall x. Rep FileFlag x -> FileFlag
forall x. FileFlag -> Rep FileFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileFlag x -> FileFlag
$cfrom :: forall x. FileFlag -> Rep FileFlag x
Generic, Value -> Parser [FileFlag]
Value -> Parser FileFlag
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileFlag]
$cparseJSONList :: Value -> Parser [FileFlag]
parseJSON :: Value -> Parser FileFlag
$cparseJSON :: Value -> Parser FileFlag
FromJSON, Int -> FileFlag -> ShowS
[FileFlag] -> ShowS
FileFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileFlag] -> ShowS
$cshowList :: [FileFlag] -> ShowS
show :: FileFlag -> String
$cshow :: FileFlag -> String
showsPrec :: Int -> FileFlag -> ShowS
$cshowsPrec :: Int -> FileFlag -> ShowS
Show, FileFlag -> FileFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileFlag -> FileFlag -> Bool
$c/= :: FileFlag -> FileFlag -> Bool
== :: FileFlag -> FileFlag -> Bool
$c== :: FileFlag -> FileFlag -> Bool
Eq)
expandSimpleFlag :: Value -> FileFlag
expandSimpleFlag :: Value -> FileFlag
expandSimpleFlag Value
value =
FileFlag
{ $sel:version:FileFlag :: Maybe Natural
version = forall a. Maybe a
Nothing
, $sel:on:FileFlag :: Maybe Bool
on = forall a. Maybe a
Nothing
, $sel:targets:FileFlag :: Maybe [Target]
targets = forall a. Maybe a
Nothing
, $sel:rules:FileFlag :: Maybe [Rule]
rules = forall a. Maybe a
Nothing
, $sel:fallthrough:FileFlag :: Maybe VariationOrRollout
fallthrough = forall a. a -> Maybe a
Just (Maybe Integer -> Maybe Rollout -> VariationOrRollout
F.VariationOrRollout (forall a. a -> Maybe a
Just Integer
0) forall a. Maybe a
Nothing)
, $sel:offVariation:FileFlag :: Maybe Integer
offVariation = forall a. a -> Maybe a
Just Integer
0
, $sel:variations:FileFlag :: [Value]
variations = [Value
value]
}
fromFileFlag :: Text -> FileFlag -> F.Flag
fromFileFlag :: Text -> FileFlag -> Flag
fromFileFlag Text
key FileFlag
fileFlag =
F.Flag{ $sel:key:Flag :: Text
F.key = Text
key
, $sel:version:Flag :: Natural
F.version = forall a. a -> Maybe a -> a
fromMaybe Natural
1 forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" FileFlag
fileFlag
, $sel:on:Flag :: Bool
F.on = forall a. a -> Maybe a -> a
fromMaybe Bool
True forall a b. (a -> b) -> a -> b
$ FileFlag -> Maybe Bool
on FileFlag
fileFlag
, $sel:trackEvents:Flag :: Bool
F.trackEvents = Bool
False
, $sel:trackEventsFallthrough:Flag :: Bool
F.trackEventsFallthrough = Bool
False
, $sel:deleted:Flag :: Bool
F.deleted = Bool
False
, $sel:prerequisites:Flag :: [Prerequisite]
F.prerequisites = []
, $sel:salt:Flag :: Text
F.salt = Text
""
, $sel:targets:Flag :: [Target]
F.targets = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ FileFlag -> Maybe [Target]
targets FileFlag
fileFlag
, $sel:rules:Flag :: [Rule]
F.rules = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" FileFlag
fileFlag
, $sel:fallthrough:Flag :: VariationOrRollout
F.fallthrough = forall a. a -> Maybe a -> a
fromMaybe VariationOrRollout
noFallthrough forall a b. (a -> b) -> a -> b
$ FileFlag -> Maybe VariationOrRollout
fallthrough FileFlag
fileFlag
, $sel:offVariation:Flag :: Maybe Integer
F.offVariation = FileFlag -> Maybe Integer
offVariation FileFlag
fileFlag
, $sel:variations:Flag :: [Value]
F.variations = FileFlag -> [Value]
variations FileFlag
fileFlag
, $sel:debugEventsUntilDate:Flag :: Maybe Natural
F.debugEventsUntilDate = forall a. Maybe a
Nothing
, $sel:clientSideAvailability:Flag :: ClientSideAvailability
F.clientSideAvailability = Bool -> Bool -> Bool -> ClientSideAvailability
F.ClientSideAvailability Bool
False Bool
False Bool
False
}
noFallthrough :: F.VariationOrRollout
noFallthrough :: VariationOrRollout
noFallthrough =
Maybe Integer -> Maybe Rollout -> VariationOrRollout
F.VariationOrRollout forall a. Maybe a
Nothing forall a. Maybe a
Nothing
data FileSegment = FileSegment
{ FileSegment -> Maybe (HashSet Text)
included :: Maybe (HashSet Text)
, FileSegment -> Maybe (HashSet Text)
excluded :: Maybe (HashSet Text)
, FileSegment -> Maybe [SegmentRule]
rules :: Maybe [F.SegmentRule]
, FileSegment -> Maybe Natural
version :: Maybe Natural
} deriving (forall x. Rep FileSegment x -> FileSegment
forall x. FileSegment -> Rep FileSegment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileSegment x -> FileSegment
$cfrom :: forall x. FileSegment -> Rep FileSegment x
Generic, Value -> Parser [FileSegment]
Value -> Parser FileSegment
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileSegment]
$cparseJSONList :: Value -> Parser [FileSegment]
parseJSON :: Value -> Parser FileSegment
$cparseJSON :: Value -> Parser FileSegment
FromJSON, Int -> FileSegment -> ShowS
[FileSegment] -> ShowS
FileSegment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileSegment] -> ShowS
$cshowList :: [FileSegment] -> ShowS
show :: FileSegment -> String
$cshow :: FileSegment -> String
showsPrec :: Int -> FileSegment -> ShowS
$cshowsPrec :: Int -> FileSegment -> ShowS
Show, FileSegment -> FileSegment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSegment -> FileSegment -> Bool
$c/= :: FileSegment -> FileSegment -> Bool
== :: FileSegment -> FileSegment -> Bool
$c== :: FileSegment -> FileSegment -> Bool
Eq)
fromFileSegment :: Text -> FileSegment -> F.Segment
fromFileSegment :: Text -> FileSegment -> Segment
fromFileSegment Text
key FileSegment
fileSegment =
F.Segment{ $sel:key:Segment :: Text
F.key = Text
key
, $sel:version:Segment :: Natural
F.version = forall a. a -> Maybe a -> a
fromMaybe Natural
1 forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" FileSegment
fileSegment
, $sel:included:Segment :: HashSet Text
F.included = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ FileSegment -> Maybe (HashSet Text)
included FileSegment
fileSegment
, $sel:excluded:Segment :: HashSet Text
F.excluded = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ FileSegment -> Maybe (HashSet Text)
excluded FileSegment
fileSegment
, $sel:salt:Segment :: Text
F.salt = Text
""
, $sel:rules:Segment :: [SegmentRule]
F.rules = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" FileSegment
fileSegment
, $sel:deleted:Segment :: Bool
F.deleted = Bool
False
}
data FileBody = FileBody
{ FileBody -> Maybe (KeyMap FileFlag)
flags :: Maybe (KeyMap FileFlag)
, FileBody -> Maybe (KeyMap Value)
flagValues :: Maybe (KeyMap Value)
, FileBody -> Maybe (KeyMap FileSegment)
segments :: Maybe (KeyMap FileSegment)
} deriving (forall x. Rep FileBody x -> FileBody
forall x. FileBody -> Rep FileBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileBody x -> FileBody
$cfrom :: forall x. FileBody -> Rep FileBody x
Generic, Int -> FileBody -> ShowS
[FileBody] -> ShowS
FileBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileBody] -> ShowS
$cshowList :: [FileBody] -> ShowS
show :: FileBody -> String
$cshow :: FileBody -> String
showsPrec :: Int -> FileBody -> ShowS
$cshowsPrec :: Int -> FileBody -> ShowS
Show, Value -> Parser [FileBody]
Value -> Parser FileBody
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileBody]
$cparseJSONList :: Value -> Parser [FileBody]
parseJSON :: Value -> Parser FileBody
$cparseJSON :: Value -> Parser FileBody
FromJSON)
instance Semigroup FileBody where
FileBody
f1 <> :: FileBody -> FileBody -> FileBody
<> FileBody
f2 =
FileBody
{ $sel:flags:FileBody :: Maybe (KeyMap FileFlag)
flags = FileBody -> Maybe (KeyMap FileFlag)
flags FileBody
f1 forall a. Semigroup a => a -> a -> a
<> FileBody -> Maybe (KeyMap FileFlag)
flags FileBody
f2
, $sel:flagValues:FileBody :: Maybe (KeyMap Value)
flagValues = FileBody -> Maybe (KeyMap Value)
flagValues FileBody
f1 forall a. Semigroup a => a -> a -> a
<> FileBody -> Maybe (KeyMap Value)
flagValues FileBody
f2
, $sel:segments:FileBody :: Maybe (KeyMap FileSegment)
segments = FileBody -> Maybe (KeyMap FileSegment)
segments FileBody
f1 forall a. Semigroup a => a -> a -> a
<> FileBody -> Maybe (KeyMap FileSegment)
segments FileBody
f2
}
instance Monoid FileBody where
mempty :: FileBody
mempty =
FileBody
{ $sel:flags:FileBody :: Maybe (KeyMap FileFlag)
flags = forall a. Monoid a => a
mempty
, $sel:flagValues:FileBody :: Maybe (KeyMap Value)
flagValues = forall a. Monoid a => a
mempty
, $sel:segments:FileBody :: Maybe (KeyMap FileSegment)
segments = forall a. Monoid a => a
mempty
}
mappend :: FileBody -> FileBody -> FileBody
mappend = forall a. Semigroup a => a -> a -> a
(<>)
dataSourceFactory :: [FilePath] -> DataSourceFactory
dataSourceFactory :: [String] -> DataSourceFactory
dataSourceFactory [String]
sources ClientContext
_clientContext DataSourceUpdates
dataSourceUpdates = do
IORef Bool
inited <- forall a. a -> IO (IORef a)
newIORef Bool
False
let dataSourceIsInitialized :: IO Bool
dataSourceIsInitialized =
forall a. IORef a -> IO a
readIORef IORef Bool
inited
dataSourceStart :: IO ()
dataSourceStart = do
FileBody Maybe (KeyMap FileFlag)
mFlags Maybe (KeyMap Value)
mFlagValues Maybe (KeyMap FileSegment)
mSegments <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO FileBody
loadFile [String]
sources
let mSimpleFlags :: Maybe (KeyMap FileFlag)
mSimpleFlags = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> FileFlag
expandSimpleFlag) Maybe (KeyMap Value)
mFlagValues
flags' :: KeyMap Flag
flags' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall v1 v2. (Text -> v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapWithKey Text -> FileFlag -> Flag
fromFileFlag) (Maybe (KeyMap FileFlag)
mFlags forall a. Semigroup a => a -> a -> a
<> Maybe (KeyMap FileFlag)
mSimpleFlags)
segments' :: KeyMap Segment
segments' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall v1 v2. (Text -> v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapWithKey Text -> FileSegment -> Segment
fromFileSegment) Maybe (KeyMap FileSegment)
mSegments
Either Text ()
_ <- DataSourceUpdates
-> KeyMap Flag -> KeyMap Segment -> IO (Either Text ())
dataSourceUpdatesInit DataSourceUpdates
dataSourceUpdates KeyMap Flag
flags' KeyMap Segment
segments'
DataSourceUpdates -> Status -> IO ()
dataSourceUpdatesSetStatus DataSourceUpdates
dataSourceUpdates Status
Initialized
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
inited Bool
True
dataSourceStop :: f ()
dataSourceStop = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DataSource{IO Bool
IO ()
forall {f :: * -> *}. Applicative f => f ()
$sel:dataSourceStop:DataSource :: IO ()
$sel:dataSourceStart:DataSource :: IO ()
$sel:dataSourceIsInitialized:DataSource :: IO Bool
dataSourceStop :: forall {f :: * -> *}. Applicative f => f ()
dataSourceStart :: IO ()
dataSourceIsInitialized :: IO Bool
..}
loadFile :: FilePath -> IO FileBody
loadFile :: String -> IO FileBody
loadFile String
filePath = do
ByteString
file <- String -> IO ByteString
BSL.readFile String
filePath
let mDecodedFile :: Maybe FileBody
mDecodedFile = forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
file forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
Yaml.decodeThrow (ByteString -> ByteString
BSL.toStrict ByteString
file)
case Maybe FileBody
mDecodedFile of
Just !FileBody
fileBody ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileBody
fileBody
Maybe FileBody
Nothing ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty