module LaunchDarkly.Server.Store.Internal
( isInitialized
, getAllFlags
, getFlag
, getSegment
, upsertFlag
, upsertSegment
, initialize
, StoreResult
, StoreResultM
, StoreInterface(..)
, RawFeature(..)
, StoreHandle(..)
, LaunchDarklyStoreRead(..)
, LaunchDarklyStoreWrite(..)
, Versioned(..)
, makeStoreIO
, insertFlag
, deleteFlag
, insertSegment
, deleteSegment
, initializeStore
, versionedToRaw
, FeatureKey
, FeatureNamespace
) where
import Control.Monad (void)
import Control.Lens (Lens', (%~), (^.))
import Data.Aeson (ToJSON, FromJSON, encode, decode)
import Data.IORef (IORef, readIORef, atomicModifyIORef', newIORef)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (toStrict, fromStrict)
import Data.Text (Text)
import Data.Function ((&))
import Data.Maybe (isJust)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Generics.Product (setField, getField, field)
import System.Clock (TimeSpec, Clock(Monotonic), getTime)
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import LaunchDarkly.Server.Features (Segment, Flag)
type StoreResultM m a = m (Either Text a)
type StoreResult a = IO (Either Text a)
class LaunchDarklyStoreRead store m where
getFlagC :: store -> Text -> StoreResultM m (Maybe Flag)
getSegmentC :: store -> Text -> StoreResultM m (Maybe Segment)
getAllFlagsC :: store -> StoreResultM m (HashMap Text Flag)
getInitializedC :: store -> StoreResultM m Bool
class LaunchDarklyStoreWrite store m where
storeInitializeC :: store -> HashMap Text (Versioned Flag) -> HashMap Text (Versioned Segment) -> StoreResultM m ()
upsertSegmentC :: store -> Text -> Versioned (Maybe Segment) -> StoreResultM m ()
upsertFlagC :: store -> Text -> Versioned (Maybe Flag) -> StoreResultM m ()
data StoreHandle m = StoreHandle
{ StoreHandle m -> Text -> StoreResultM m (Maybe Flag)
storeHandleGetFlag :: !(Text -> StoreResultM m (Maybe Flag))
, StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
storeHandleGetSegment :: !(Text -> StoreResultM m (Maybe Segment))
, StoreHandle m -> StoreResultM m (HashMap Text Flag)
storeHandleAllFlags :: !(StoreResultM m (HashMap Text Flag))
, StoreHandle m -> StoreResultM m Bool
storeHandleInitialized :: !(StoreResultM m Bool)
, StoreHandle m
-> HashMap Text (Versioned Flag)
-> HashMap Text (Versioned Segment)
-> StoreResultM m ()
storeHandleInitialize :: !(HashMap Text (Versioned Flag) -> HashMap Text (Versioned Segment) -> StoreResultM m ())
, StoreHandle m
-> Text -> Versioned (Maybe Segment) -> StoreResultM m ()
storeHandleUpsertSegment :: !(Text -> Versioned (Maybe Segment) -> StoreResultM m ())
, StoreHandle m
-> Text -> Versioned (Maybe Flag) -> StoreResultM m ()
storeHandleUpsertFlag :: !(Text -> Versioned (Maybe Flag) -> StoreResultM m ())
, StoreHandle m -> StoreResultM m ()
storeHandleExpireAll :: !(StoreResultM m ())
} deriving ((forall x. StoreHandle m -> Rep (StoreHandle m) x)
-> (forall x. Rep (StoreHandle m) x -> StoreHandle m)
-> Generic (StoreHandle m)
forall x. Rep (StoreHandle m) x -> StoreHandle m
forall x. StoreHandle m -> Rep (StoreHandle m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) x. Rep (StoreHandle m) x -> StoreHandle m
forall (m :: * -> *) x. StoreHandle m -> Rep (StoreHandle m) x
$cto :: forall (m :: * -> *) x. Rep (StoreHandle m) x -> StoreHandle m
$cfrom :: forall (m :: * -> *) x. StoreHandle m -> Rep (StoreHandle m) x
Generic)
instance Monad m => LaunchDarklyStoreRead (StoreHandle m) m where
getFlagC :: StoreHandle m -> Text -> StoreResultM m (Maybe Flag)
getFlagC = StoreHandle m -> Text -> StoreResultM m (Maybe Flag)
forall (m :: * -> *).
StoreHandle m -> Text -> StoreResultM m (Maybe Flag)
storeHandleGetFlag
getSegmentC :: StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
getSegmentC = StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
forall (m :: * -> *).
StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
storeHandleGetSegment
getAllFlagsC :: StoreHandle m -> StoreResultM m (HashMap Text Flag)
getAllFlagsC = StoreHandle m -> StoreResultM m (HashMap Text Flag)
forall (m :: * -> *).
StoreHandle m -> StoreResultM m (HashMap Text Flag)
storeHandleAllFlags
getInitializedC :: StoreHandle m -> StoreResultM m Bool
getInitializedC = StoreHandle m -> StoreResultM m Bool
forall (m :: * -> *). StoreHandle m -> StoreResultM m Bool
storeHandleInitialized
instance Monad m => LaunchDarklyStoreWrite (StoreHandle m) m where
storeInitializeC :: StoreHandle m
-> HashMap Text (Versioned Flag)
-> HashMap Text (Versioned Segment)
-> StoreResultM m ()
storeInitializeC = StoreHandle m
-> HashMap Text (Versioned Flag)
-> HashMap Text (Versioned Segment)
-> StoreResultM m ()
forall (m :: * -> *).
StoreHandle m
-> HashMap Text (Versioned Flag)
-> HashMap Text (Versioned Segment)
-> StoreResultM m ()
storeHandleInitialize
upsertSegmentC :: StoreHandle m
-> Text -> Versioned (Maybe Segment) -> StoreResultM m ()
upsertSegmentC = StoreHandle m
-> Text -> Versioned (Maybe Segment) -> StoreResultM m ()
forall (m :: * -> *).
StoreHandle m
-> Text -> Versioned (Maybe Segment) -> StoreResultM m ()
storeHandleUpsertSegment
upsertFlagC :: StoreHandle m
-> Text -> Versioned (Maybe Flag) -> StoreResultM m ()
upsertFlagC = StoreHandle m
-> Text -> Versioned (Maybe Flag) -> StoreResultM m ()
forall (m :: * -> *).
StoreHandle m
-> Text -> Versioned (Maybe Flag) -> StoreResultM m ()
storeHandleUpsertFlag
initializeStore :: (LaunchDarklyStoreWrite store m, Monad m) => store
-> HashMap Text Flag -> HashMap Text Segment -> StoreResultM m ()
initializeStore :: store
-> HashMap Text Flag -> HashMap Text Segment -> StoreResultM m ()
initializeStore store
store HashMap Text Flag
flags HashMap Text Segment
segments = store
-> HashMap Text (Versioned Flag)
-> HashMap Text (Versioned Segment)
-> StoreResultM m ()
forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store
-> HashMap Text (Versioned Flag)
-> HashMap Text (Versioned Segment)
-> StoreResultM m ()
storeInitializeC store
store (HashMap Text Flag -> HashMap Text (Versioned Flag)
forall s k.
HasField' "version" s Natural =>
HashMap k s -> HashMap k (Versioned s)
makeVersioned HashMap Text Flag
flags) (HashMap Text Segment -> HashMap Text (Versioned Segment)
forall s k.
HasField' "version" s Natural =>
HashMap k s -> HashMap k (Versioned s)
makeVersioned HashMap Text Segment
segments)
where makeVersioned :: HashMap k s -> HashMap k (Versioned s)
makeVersioned = (s -> Versioned s) -> HashMap k s -> HashMap k (Versioned s)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (\s
f -> s -> Natural -> Versioned s
forall a. a -> Natural -> Versioned a
Versioned s
f (s -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" s
f))
insertFlag :: (LaunchDarklyStoreWrite store m, Monad m) => store -> Flag -> StoreResultM m ()
insertFlag :: store -> Flag -> StoreResultM m ()
insertFlag store
store Flag
flag = store -> Text -> Versioned (Maybe Flag) -> StoreResultM m ()
forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store -> Text -> Versioned (Maybe Flag) -> StoreResultM m ()
upsertFlagC store
store (Flag -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag) (Versioned (Maybe Flag) -> StoreResultM m ())
-> Versioned (Maybe Flag) -> StoreResultM m ()
forall a b. (a -> b) -> a -> b
$ Maybe Flag -> Natural -> Versioned (Maybe Flag)
forall a. a -> Natural -> Versioned a
Versioned (Flag -> Maybe Flag
forall (f :: * -> *) a. Applicative f => a -> f a
pure Flag
flag) (Flag -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Flag
flag)
deleteFlag :: (LaunchDarklyStoreWrite store m, Monad m) => store -> Text -> Natural -> StoreResultM m ()
deleteFlag :: store -> Text -> Natural -> StoreResultM m ()
deleteFlag store
store Text
key Natural
version = store -> Text -> Versioned (Maybe Flag) -> StoreResultM m ()
forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store -> Text -> Versioned (Maybe Flag) -> StoreResultM m ()
upsertFlagC store
store Text
key (Versioned (Maybe Flag) -> StoreResultM m ())
-> Versioned (Maybe Flag) -> StoreResultM m ()
forall a b. (a -> b) -> a -> b
$ Maybe Flag -> Natural -> Versioned (Maybe Flag)
forall a. a -> Natural -> Versioned a
Versioned Maybe Flag
forall a. Maybe a
Nothing Natural
version
insertSegment :: (LaunchDarklyStoreWrite store m, Monad m) => store -> Segment -> StoreResultM m ()
insertSegment :: store -> Segment -> StoreResultM m ()
insertSegment store
store Segment
segment = store -> Text -> Versioned (Maybe Segment) -> StoreResultM m ()
forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store -> Text -> Versioned (Maybe Segment) -> StoreResultM m ()
upsertSegmentC store
store (Segment -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Segment
segment) (Versioned (Maybe Segment) -> StoreResultM m ())
-> Versioned (Maybe Segment) -> StoreResultM m ()
forall a b. (a -> b) -> a -> b
$ Maybe Segment -> Natural -> Versioned (Maybe Segment)
forall a. a -> Natural -> Versioned a
Versioned (Segment -> Maybe Segment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Segment
segment) (Segment -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Segment
segment)
deleteSegment :: (LaunchDarklyStoreWrite store m, Monad m) => store -> Text -> Natural -> StoreResultM m ()
deleteSegment :: store -> Text -> Natural -> StoreResultM m ()
deleteSegment store
store Text
key Natural
version = store -> Text -> Versioned (Maybe Segment) -> StoreResultM m ()
forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store -> Text -> Versioned (Maybe Segment) -> StoreResultM m ()
upsertSegmentC store
store Text
key (Versioned (Maybe Segment) -> StoreResultM m ())
-> Versioned (Maybe Segment) -> StoreResultM m ()
forall a b. (a -> b) -> a -> b
$ Maybe Segment -> Natural -> Versioned (Maybe Segment)
forall a. a -> Natural -> Versioned a
Versioned Maybe Segment
forall a. Maybe a
Nothing Natural
version
makeStoreIO :: Maybe StoreInterface -> TimeSpec -> IO (StoreHandle IO)
makeStoreIO :: Maybe StoreInterface -> TimeSpec -> IO (StoreHandle IO)
makeStoreIO Maybe StoreInterface
backend TimeSpec
ttl = do
IORef State
state <- State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef State :: Expirable (HashMap Text Flag)
-> HashMap Text (Expirable (Versioned (Maybe Flag)))
-> HashMap Text (Expirable (Versioned (Maybe Segment)))
-> Expirable Bool
-> State
State
{ $sel:allFlags:State :: Expirable (HashMap Text Flag)
allFlags = HashMap Text Flag
-> Bool -> TimeSpec -> Expirable (HashMap Text Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable HashMap Text Flag
forall k v. HashMap k v
HM.empty Bool
True TimeSpec
0
, $sel:flags:State :: HashMap Text (Expirable (Versioned (Maybe Flag)))
flags = HashMap Text (Expirable (Versioned (Maybe Flag)))
forall k v. HashMap k v
HM.empty
, $sel:segments:State :: HashMap Text (Expirable (Versioned (Maybe Segment)))
segments = HashMap Text (Expirable (Versioned (Maybe Segment)))
forall k v. HashMap k v
HM.empty
, $sel:initialized:State :: Expirable Bool
initialized = Bool -> Bool -> TimeSpec -> Expirable Bool
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Bool
False Bool
True TimeSpec
0
}
let store :: Store
store = IORef State -> Maybe StoreInterface -> TimeSpec -> Store
Store IORef State
state Maybe StoreInterface
backend TimeSpec
ttl
StoreHandle IO -> IO (StoreHandle IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StoreHandle :: forall (m :: * -> *).
(Text -> StoreResultM m (Maybe Flag))
-> (Text -> StoreResultM m (Maybe Segment))
-> StoreResultM m (HashMap Text Flag)
-> StoreResultM m Bool
-> (HashMap Text (Versioned Flag)
-> HashMap Text (Versioned Segment) -> StoreResultM m ())
-> (Text -> Versioned (Maybe Segment) -> StoreResultM m ())
-> (Text -> Versioned (Maybe Flag) -> StoreResultM m ())
-> StoreResultM m ()
-> StoreHandle m
StoreHandle
{ $sel:storeHandleGetFlag:StoreHandle :: Text -> StoreResultM IO (Maybe Flag)
storeHandleGetFlag = Store -> Text -> StoreResultM IO (Maybe Flag)
getFlag Store
store
, $sel:storeHandleGetSegment:StoreHandle :: Text -> StoreResultM IO (Maybe Segment)
storeHandleGetSegment = Store -> Text -> StoreResultM IO (Maybe Segment)
getSegment Store
store
, $sel:storeHandleAllFlags:StoreHandle :: StoreResultM IO (HashMap Text Flag)
storeHandleAllFlags = Store -> StoreResultM IO (HashMap Text Flag)
getAllFlags Store
store
, $sel:storeHandleInitialized:StoreHandle :: StoreResultM IO Bool
storeHandleInitialized = Store -> StoreResultM IO Bool
isInitialized Store
store
, $sel:storeHandleInitialize:StoreHandle :: HashMap Text (Versioned Flag)
-> HashMap Text (Versioned Segment) -> StoreResultM IO ()
storeHandleInitialize = Store
-> HashMap Text (Versioned Flag)
-> HashMap Text (Versioned Segment)
-> StoreResultM IO ()
initialize Store
store
, $sel:storeHandleUpsertSegment:StoreHandle :: Text -> Versioned (Maybe Segment) -> StoreResultM IO ()
storeHandleUpsertSegment = Store -> Text -> Versioned (Maybe Segment) -> StoreResultM IO ()
upsertSegment Store
store
, $sel:storeHandleUpsertFlag:StoreHandle :: Text -> Versioned (Maybe Flag) -> StoreResultM IO ()
storeHandleUpsertFlag = Store -> Text -> Versioned (Maybe Flag) -> StoreResultM IO ()
upsertFlag Store
store
, $sel:storeHandleExpireAll:StoreHandle :: StoreResultM IO ()
storeHandleExpireAll = Store -> IO ()
expireAllItems Store
store IO () -> StoreResultM IO () -> StoreResultM IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right ())
}
data Expirable a = Expirable
{ Expirable a -> a
value :: !a
, Expirable a -> Bool
forceExpire :: !Bool
, Expirable a -> TimeSpec
updatedOn :: !TimeSpec
} deriving ((forall x. Expirable a -> Rep (Expirable a) x)
-> (forall x. Rep (Expirable a) x -> Expirable a)
-> Generic (Expirable a)
forall x. Rep (Expirable a) x -> Expirable a
forall x. Expirable a -> Rep (Expirable a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Expirable a) x -> Expirable a
forall a x. Expirable a -> Rep (Expirable a) x
$cto :: forall a x. Rep (Expirable a) x -> Expirable a
$cfrom :: forall a x. Expirable a -> Rep (Expirable a) x
Generic)
data Versioned a = Versioned
{ Versioned a -> a
value :: !a
, Versioned a -> Natural
version :: !Natural
} deriving ((forall x. Versioned a -> Rep (Versioned a) x)
-> (forall x. Rep (Versioned a) x -> Versioned a)
-> Generic (Versioned a)
forall x. Rep (Versioned a) x -> Versioned a
forall x. Versioned a -> Rep (Versioned a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Versioned a) x -> Versioned a
forall a x. Versioned a -> Rep (Versioned a) x
$cto :: forall a x. Rep (Versioned a) x -> Versioned a
$cfrom :: forall a x. Versioned a -> Rep (Versioned a) x
Generic)
data State = State
{ State -> Expirable (HashMap Text Flag)
allFlags :: !(Expirable (HashMap Text Flag))
, State -> HashMap Text (Expirable (Versioned (Maybe Flag)))
flags :: !(HashMap Text (Expirable (Versioned (Maybe Flag))))
, State -> HashMap Text (Expirable (Versioned (Maybe Segment)))
segments :: !(HashMap Text (Expirable (Versioned (Maybe Segment))))
, State -> Expirable Bool
initialized :: !(Expirable Bool)
} deriving ((forall x. State -> Rep State x)
-> (forall x. Rep State x -> State) -> Generic State
forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep State x -> State
$cfrom :: forall x. State -> Rep State x
Generic)
type FeatureKey = Text
type FeatureNamespace = Text
data StoreInterface = StoreInterface
{ StoreInterface -> Text -> StoreResult (HashMap Text RawFeature)
storeInterfaceAllFeatures :: !(FeatureNamespace -> StoreResult (HashMap Text RawFeature))
, StoreInterface -> Text -> Text -> StoreResult RawFeature
storeInterfaceGetFeature :: !(FeatureNamespace -> FeatureKey -> StoreResult RawFeature)
, StoreInterface
-> Text -> Text -> RawFeature -> StoreResultM IO Bool
storeInterfaceUpsertFeature :: !(FeatureNamespace -> FeatureKey -> RawFeature -> StoreResult Bool)
, StoreInterface -> StoreResultM IO Bool
storeInterfaceIsInitialized :: !(StoreResult Bool)
, StoreInterface
-> HashMap Text (HashMap Text RawFeature) -> StoreResultM IO ()
storeInterfaceInitialize :: !(HashMap FeatureNamespace (HashMap FeatureKey RawFeature) -> StoreResult ())
}
data RawFeature = RawFeature
{ RawFeature -> Maybe ByteString
rawFeatureBuffer :: !(Maybe ByteString)
, RawFeature -> Natural
rawFeatureVersion :: !Natural
}
data Store = Store
{ Store -> IORef State
state :: !(IORef State)
, Store -> Maybe StoreInterface
backend :: !(Maybe StoreInterface)
, Store -> TimeSpec
timeToLive :: !TimeSpec
} deriving ((forall x. Store -> Rep Store x)
-> (forall x. Rep Store x -> Store) -> Generic Store
forall x. Rep Store x -> Store
forall x. Store -> Rep Store x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Store x -> Store
$cfrom :: forall x. Store -> Rep Store x
Generic)
expireAllItems :: Store -> IO ()
expireAllItems :: Store -> IO ()
expireAllItems Store
store = IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
state -> (, ()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$ State
state
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "allFlags" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"allFlags" ((Expirable (HashMap Text Flag)
-> Identity (Expirable (HashMap Text Flag)))
-> State -> Identity State)
-> (Expirable (HashMap Text Flag) -> Expirable (HashMap Text Flag))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Expirable (HashMap Text Flag) -> Expirable (HashMap Text Flag)
forall s. HasField' "forceExpire" s Bool => s -> s
expire
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "initialized" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"initialized" ((Expirable Bool -> Identity (Expirable Bool))
-> State -> Identity State)
-> (Expirable Bool -> Expirable Bool) -> State -> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Expirable Bool -> Expirable Bool
forall s. HasField' "forceExpire" s Bool => s -> s
expire
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "flags" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"flags" ((HashMap Text (Expirable (Versioned (Maybe Flag)))
-> Identity (HashMap Text (Expirable (Versioned (Maybe Flag)))))
-> State -> Identity State)
-> (HashMap Text (Expirable (Versioned (Maybe Flag)))
-> HashMap Text (Expirable (Versioned (Maybe Flag))))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Expirable (Versioned (Maybe Flag))
-> Expirable (Versioned (Maybe Flag)))
-> HashMap Text (Expirable (Versioned (Maybe Flag)))
-> HashMap Text (Expirable (Versioned (Maybe Flag)))
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Expirable (Versioned (Maybe Flag))
-> Expirable (Versioned (Maybe Flag))
forall s. HasField' "forceExpire" s Bool => s -> s
expire
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "segments" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"segments" ((HashMap Text (Expirable (Versioned (Maybe Segment)))
-> Identity (HashMap Text (Expirable (Versioned (Maybe Segment)))))
-> State -> Identity State)
-> (HashMap Text (Expirable (Versioned (Maybe Segment)))
-> HashMap Text (Expirable (Versioned (Maybe Segment))))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Expirable (Versioned (Maybe Segment))
-> Expirable (Versioned (Maybe Segment)))
-> HashMap Text (Expirable (Versioned (Maybe Segment)))
-> HashMap Text (Expirable (Versioned (Maybe Segment)))
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Expirable (Versioned (Maybe Segment))
-> Expirable (Versioned (Maybe Segment))
forall s. HasField' "forceExpire" s Bool => s -> s
expire
where expire :: s -> s
expire = Bool -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"forceExpire" Bool
True
isExpired :: Store -> TimeSpec -> Expirable a -> Bool
isExpired :: Store -> TimeSpec -> Expirable a -> Bool
isExpired Store
store TimeSpec
now Expirable a
item = (Maybe StoreInterface -> Bool
forall a. Maybe a -> Bool
isJust (Maybe StoreInterface -> Bool) -> Maybe StoreInterface -> Bool
forall a b. (a -> b) -> a -> b
$ Store -> Maybe StoreInterface
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store) Bool -> Bool -> Bool
&& ((Expirable a -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"forceExpire" Expirable a
item)
Bool -> Bool -> Bool
|| (Store -> TimeSpec
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"timeToLive" Store
store) TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+ (Expirable a -> TimeSpec
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"updatedOn" Expirable a
item) TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
< TimeSpec
now)
getMonotonicTime :: IO TimeSpec
getMonotonicTime :: IO TimeSpec
getMonotonicTime = Clock -> IO TimeSpec
getTime Clock
Monotonic
initialize :: Store -> HashMap Text (Versioned Flag) -> HashMap Text (Versioned Segment) -> StoreResult ()
initialize :: Store
-> HashMap Text (Versioned Flag)
-> HashMap Text (Versioned Segment)
-> StoreResultM IO ()
initialize Store
store HashMap Text (Versioned Flag)
flags HashMap Text (Versioned Segment)
segments = case Store -> Maybe StoreInterface
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe StoreInterface
Nothing -> do
IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
state -> (, ()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$ State
state
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& HashMap Text (Expirable (Versioned (Maybe Flag))) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"flags" ((Versioned (Maybe Flag) -> Expirable (Versioned (Maybe Flag)))
-> HashMap Text (Versioned (Maybe Flag))
-> HashMap Text (Expirable (Versioned (Maybe Flag)))
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (\Versioned (Maybe Flag)
f -> Versioned (Maybe Flag)
-> Bool -> TimeSpec -> Expirable (Versioned (Maybe Flag))
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Versioned (Maybe Flag)
f Bool
True TimeSpec
0) (HashMap Text (Versioned (Maybe Flag))
-> HashMap Text (Expirable (Versioned (Maybe Flag))))
-> HashMap Text (Versioned (Maybe Flag))
-> HashMap Text (Expirable (Versioned (Maybe Flag)))
forall a b. (a -> b) -> a -> b
$ HashMap Text (Versioned Flag)
-> HashMap Text (Versioned (Maybe Flag))
forall s v2 a k.
HasField "value" s v2 a (Maybe a) =>
HashMap k s -> HashMap k v2
c HashMap Text (Versioned Flag)
flags)
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& HashMap Text (Expirable (Versioned (Maybe Segment)))
-> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"segments" ((Versioned (Maybe Segment)
-> Expirable (Versioned (Maybe Segment)))
-> HashMap Text (Versioned (Maybe Segment))
-> HashMap Text (Expirable (Versioned (Maybe Segment)))
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (\Versioned (Maybe Segment)
f -> Versioned (Maybe Segment)
-> Bool -> TimeSpec -> Expirable (Versioned (Maybe Segment))
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Versioned (Maybe Segment)
f Bool
True TimeSpec
0) (HashMap Text (Versioned (Maybe Segment))
-> HashMap Text (Expirable (Versioned (Maybe Segment))))
-> HashMap Text (Versioned (Maybe Segment))
-> HashMap Text (Expirable (Versioned (Maybe Segment)))
forall a b. (a -> b) -> a -> b
$ HashMap Text (Versioned Segment)
-> HashMap Text (Versioned (Maybe Segment))
forall s v2 a k.
HasField "value" s v2 a (Maybe a) =>
HashMap k s -> HashMap k v2
c HashMap Text (Versioned Segment)
segments)
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& Expirable (HashMap Text Flag) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"allFlags" (HashMap Text Flag
-> Bool -> TimeSpec -> Expirable (HashMap Text Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable ((Versioned Flag -> Flag)
-> HashMap Text (Versioned Flag) -> HashMap Text Flag
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") HashMap Text (Versioned Flag)
flags) Bool
True TimeSpec
0)
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& Expirable Bool -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"initialized" (Bool -> Bool -> TimeSpec -> Expirable Bool
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Bool
True Bool
False TimeSpec
0)
Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right ()
Just StoreInterface
backend -> (StoreInterface
-> HashMap Text (HashMap Text RawFeature) -> StoreResultM IO ()
storeInterfaceInitialize StoreInterface
backend) HashMap Text (HashMap Text RawFeature)
raw StoreResultM IO ()
-> (Either Text () -> StoreResultM IO ()) -> StoreResultM IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
err -> Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left Text
err
Right () -> Store -> IO ()
expireAllItems Store
store IO () -> StoreResultM IO () -> StoreResultM IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Text ()
forall a b. b -> Either a b
Right ())
where
raw :: HashMap Text (HashMap Text RawFeature)
raw = HashMap Text (HashMap Text RawFeature)
forall k v. HashMap k v
HM.empty
HashMap Text (HashMap Text RawFeature)
-> (HashMap Text (HashMap Text RawFeature)
-> HashMap Text (HashMap Text RawFeature))
-> HashMap Text (HashMap Text RawFeature)
forall a b. a -> (a -> b) -> b
& Text
-> HashMap Text RawFeature
-> HashMap Text (HashMap Text RawFeature)
-> HashMap Text (HashMap Text RawFeature)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"flags" ((Versioned (Maybe Flag) -> RawFeature)
-> HashMap Text (Versioned (Maybe Flag)) -> HashMap Text RawFeature
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Versioned (Maybe Flag) -> RawFeature
forall a. ToJSON a => Versioned (Maybe a) -> RawFeature
versionedToRaw (HashMap Text (Versioned (Maybe Flag)) -> HashMap Text RawFeature)
-> HashMap Text (Versioned (Maybe Flag)) -> HashMap Text RawFeature
forall a b. (a -> b) -> a -> b
$ HashMap Text (Versioned Flag)
-> HashMap Text (Versioned (Maybe Flag))
forall s v2 a k.
HasField "value" s v2 a (Maybe a) =>
HashMap k s -> HashMap k v2
c HashMap Text (Versioned Flag)
flags)
HashMap Text (HashMap Text RawFeature)
-> (HashMap Text (HashMap Text RawFeature)
-> HashMap Text (HashMap Text RawFeature))
-> HashMap Text (HashMap Text RawFeature)
forall a b. a -> (a -> b) -> b
& Text
-> HashMap Text RawFeature
-> HashMap Text (HashMap Text RawFeature)
-> HashMap Text (HashMap Text RawFeature)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"segments" ((Versioned (Maybe Segment) -> RawFeature)
-> HashMap Text (Versioned (Maybe Segment))
-> HashMap Text RawFeature
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Versioned (Maybe Segment) -> RawFeature
forall a. ToJSON a => Versioned (Maybe a) -> RawFeature
versionedToRaw (HashMap Text (Versioned (Maybe Segment))
-> HashMap Text RawFeature)
-> HashMap Text (Versioned (Maybe Segment))
-> HashMap Text RawFeature
forall a b. (a -> b) -> a -> b
$ HashMap Text (Versioned Segment)
-> HashMap Text (Versioned (Maybe Segment))
forall s v2 a k.
HasField "value" s v2 a (Maybe a) =>
HashMap k s -> HashMap k v2
c HashMap Text (Versioned Segment)
segments)
c :: HashMap k s -> HashMap k v2
c HashMap k s
x = (s -> v2) -> HashMap k s -> HashMap k v2
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (\s
f -> s
f s -> (s -> v2) -> v2
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "value" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"value" ((a -> Identity (Maybe a)) -> s -> Identity v2)
-> (a -> Maybe a) -> s -> v2
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> Maybe a
forall a. a -> Maybe a
Just) HashMap k s
x
rawToVersioned :: (FromJSON a) => RawFeature -> Maybe (Versioned (Maybe a))
rawToVersioned :: RawFeature -> Maybe (Versioned (Maybe a))
rawToVersioned RawFeature
raw = case RawFeature -> Maybe ByteString
rawFeatureBuffer RawFeature
raw of
Maybe ByteString
Nothing -> Versioned (Maybe a) -> Maybe (Versioned (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Versioned (Maybe a) -> Maybe (Versioned (Maybe a)))
-> Versioned (Maybe a) -> Maybe (Versioned (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Natural -> Versioned (Maybe a)
forall a. a -> Natural -> Versioned a
Versioned Maybe a
forall a. Maybe a
Nothing (RawFeature -> Natural
rawFeatureVersion RawFeature
raw)
Just ByteString
buffer -> case ByteString -> Maybe (Maybe a)
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe (Maybe a)) -> ByteString -> Maybe (Maybe a)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict ByteString
buffer of
Maybe (Maybe a)
Nothing -> Maybe (Versioned (Maybe a))
forall a. Maybe a
Nothing
Just Maybe a
decoded -> Versioned (Maybe a) -> Maybe (Versioned (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Versioned (Maybe a) -> Maybe (Versioned (Maybe a)))
-> Versioned (Maybe a) -> Maybe (Versioned (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Natural -> Versioned (Maybe a)
forall a. a -> Natural -> Versioned a
Versioned Maybe a
decoded (RawFeature -> Natural
rawFeatureVersion RawFeature
raw)
versionedToRaw :: (ToJSON a) => Versioned (Maybe a) -> RawFeature
versionedToRaw :: Versioned (Maybe a) -> RawFeature
versionedToRaw Versioned (Maybe a)
versioned = case Versioned (Maybe a) -> Maybe a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Versioned (Maybe a)
versioned of
Maybe a
Nothing -> Maybe ByteString -> Natural -> RawFeature
RawFeature Maybe ByteString
forall a. Maybe a
Nothing (Natural -> RawFeature) -> Natural -> RawFeature
forall a b. (a -> b) -> a -> b
$ Versioned (Maybe a) -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Versioned (Maybe a)
versioned
Just a
x -> Maybe ByteString -> Natural -> RawFeature
RawFeature (ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
x) (Natural -> RawFeature) -> Natural -> RawFeature
forall a b. (a -> b) -> a -> b
$ Versioned (Maybe a) -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Versioned (Maybe a)
versioned
tryGetBackend :: (FromJSON a) => StoreInterface -> Text -> Text -> StoreResult (Versioned (Maybe a))
tryGetBackend :: StoreInterface -> Text -> Text -> StoreResult (Versioned (Maybe a))
tryGetBackend StoreInterface
backend Text
namespace Text
key =
((StoreInterface -> Text -> Text -> StoreResult RawFeature
storeInterfaceGetFeature StoreInterface
backend) Text
namespace Text
key) StoreResult RawFeature
-> (Either Text RawFeature -> StoreResult (Versioned (Maybe a)))
-> StoreResult (Versioned (Maybe a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
err -> Either Text (Versioned (Maybe a))
-> StoreResult (Versioned (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Versioned (Maybe a))
-> StoreResult (Versioned (Maybe a)))
-> Either Text (Versioned (Maybe a))
-> StoreResult (Versioned (Maybe a))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Versioned (Maybe a))
forall a b. a -> Either a b
Left Text
err
Right RawFeature
raw -> case RawFeature -> Maybe (Versioned (Maybe a))
forall a. FromJSON a => RawFeature -> Maybe (Versioned (Maybe a))
rawToVersioned RawFeature
raw of
Maybe (Versioned (Maybe a))
Nothing -> Either Text (Versioned (Maybe a))
-> StoreResult (Versioned (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Versioned (Maybe a))
-> StoreResult (Versioned (Maybe a)))
-> Either Text (Versioned (Maybe a))
-> StoreResult (Versioned (Maybe a))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Versioned (Maybe a))
forall a b. a -> Either a b
Left Text
"failed to decode from external store"
Just Versioned (Maybe a)
versioned -> Either Text (Versioned (Maybe a))
-> StoreResult (Versioned (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Versioned (Maybe a))
-> StoreResult (Versioned (Maybe a)))
-> Either Text (Versioned (Maybe a))
-> StoreResult (Versioned (Maybe a))
forall a b. (a -> b) -> a -> b
$ Versioned (Maybe a) -> Either Text (Versioned (Maybe a))
forall a b. b -> Either a b
Right Versioned (Maybe a)
versioned
getGeneric :: FromJSON a => Store -> Text -> Text
-> Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
-> StoreResult (Maybe a)
getGeneric :: Store
-> Text
-> Text
-> Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
-> StoreResult (Maybe a)
getGeneric Store
store Text
namespace Text
key Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
lens = do
State
state <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (IORef State -> IO State) -> IORef State -> IO State
forall a b. (a -> b) -> a -> b
$ Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store
case Store -> Maybe StoreInterface
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe StoreInterface
Nothing -> case Text
-> HashMap Text (Expirable (Versioned (Maybe a)))
-> Maybe (Expirable (Versioned (Maybe a)))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
key (State
state State
-> Getting
(HashMap Text (Expirable (Versioned (Maybe a))))
State
(HashMap Text (Expirable (Versioned (Maybe a))))
-> HashMap Text (Expirable (Versioned (Maybe a)))
forall s a. s -> Getting a s a -> a
^. Getting
(HashMap Text (Expirable (Versioned (Maybe a))))
State
(HashMap Text (Expirable (Versioned (Maybe a))))
Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
lens) of
Maybe (Expirable (Versioned (Maybe a)))
Nothing -> Either Text (Maybe a) -> StoreResult (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe a) -> StoreResult (Maybe a))
-> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
Just Expirable (Versioned (Maybe a))
x -> Either Text (Maybe a) -> StoreResult (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe a) -> StoreResult (Maybe a))
-> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either Text (Maybe a))
-> Maybe a -> Either Text (Maybe a)
forall a b. (a -> b) -> a -> b
$ forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" (Versioned (Maybe a) -> Maybe a) -> Versioned (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ Expirable (Versioned (Maybe a)) -> Versioned (Maybe a)
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable (Versioned (Maybe a))
x
Just StoreInterface
backend -> do
TimeSpec
now <- IO TimeSpec
getMonotonicTime
case Text
-> HashMap Text (Expirable (Versioned (Maybe a)))
-> Maybe (Expirable (Versioned (Maybe a)))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
key (State
state State
-> Getting
(HashMap Text (Expirable (Versioned (Maybe a))))
State
(HashMap Text (Expirable (Versioned (Maybe a))))
-> HashMap Text (Expirable (Versioned (Maybe a)))
forall s a. s -> Getting a s a -> a
^. Getting
(HashMap Text (Expirable (Versioned (Maybe a))))
State
(HashMap Text (Expirable (Versioned (Maybe a))))
Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
lens) of
Maybe (Expirable (Versioned (Maybe a)))
Nothing -> StoreInterface -> TimeSpec -> StoreResult (Maybe a)
updateFromBackend StoreInterface
backend TimeSpec
now
Just Expirable (Versioned (Maybe a))
x -> if Store -> TimeSpec -> Expirable (Versioned (Maybe a)) -> Bool
forall a. Store -> TimeSpec -> Expirable a -> Bool
isExpired Store
store TimeSpec
now Expirable (Versioned (Maybe a))
x
then StoreInterface -> TimeSpec -> StoreResult (Maybe a)
updateFromBackend StoreInterface
backend TimeSpec
now
else Either Text (Maybe a) -> StoreResult (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe a) -> StoreResult (Maybe a))
-> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either Text (Maybe a))
-> Maybe a -> Either Text (Maybe a)
forall a b. (a -> b) -> a -> b
$ forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" (Versioned (Maybe a) -> Maybe a) -> Versioned (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ Expirable (Versioned (Maybe a)) -> Versioned (Maybe a)
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable (Versioned (Maybe a))
x
where
updateFromBackend :: StoreInterface -> TimeSpec -> StoreResult (Maybe a)
updateFromBackend StoreInterface
backend TimeSpec
now = StoreInterface -> Text -> Text -> StoreResult (Versioned (Maybe a))
forall a.
FromJSON a =>
StoreInterface -> Text -> Text -> StoreResult (Versioned (Maybe a))
tryGetBackend StoreInterface
backend Text
namespace Text
key StoreResult (Versioned (Maybe a))
-> (Either Text (Versioned (Maybe a)) -> StoreResult (Maybe a))
-> StoreResult (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
err -> Either Text (Maybe a) -> StoreResult (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe a) -> StoreResult (Maybe a))
-> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Maybe a)
forall a b. a -> Either a b
Left Text
err
Right Versioned (Maybe a)
v -> do
IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
stateRef -> (, ()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$ State
stateRef State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (HashMap Text (Expirable (Versioned (Maybe a)))
-> Identity (HashMap Text (Expirable (Versioned (Maybe a)))))
-> State -> Identity State
Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
lens ((HashMap Text (Expirable (Versioned (Maybe a)))
-> Identity (HashMap Text (Expirable (Versioned (Maybe a)))))
-> State -> Identity State)
-> (HashMap Text (Expirable (Versioned (Maybe a)))
-> HashMap Text (Expirable (Versioned (Maybe a))))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
(Text
-> Expirable (Versioned (Maybe a))
-> HashMap Text (Expirable (Versioned (Maybe a)))
-> HashMap Text (Expirable (Versioned (Maybe a)))
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
key (Versioned (Maybe a)
-> Bool -> TimeSpec -> Expirable (Versioned (Maybe a))
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Versioned (Maybe a)
v Bool
False TimeSpec
now))
Either Text (Maybe a) -> StoreResult (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe a) -> StoreResult (Maybe a))
-> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either Text (Maybe a))
-> Maybe a -> Either Text (Maybe a)
forall a b. (a -> b) -> a -> b
$ Versioned (Maybe a) -> Maybe a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Versioned (Maybe a)
v
getFlag :: Store -> Text -> StoreResult (Maybe Flag)
getFlag :: Store -> Text -> StoreResultM IO (Maybe Flag)
getFlag Store
store Text
key = Store
-> Text
-> Text
-> Lens' State (HashMap Text (Expirable (Versioned (Maybe Flag))))
-> StoreResultM IO (Maybe Flag)
forall a.
FromJSON a =>
Store
-> Text
-> Text
-> Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
-> StoreResult (Maybe a)
getGeneric Store
store Text
"flags" Text
key (forall s t a b. HasField "flags" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"flags")
getSegment :: Store -> Text -> StoreResult (Maybe Segment)
getSegment :: Store -> Text -> StoreResultM IO (Maybe Segment)
getSegment Store
store Text
key = Store
-> Text
-> Text
-> Lens'
State (HashMap Text (Expirable (Versioned (Maybe Segment))))
-> StoreResultM IO (Maybe Segment)
forall a.
FromJSON a =>
Store
-> Text
-> Text
-> Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
-> StoreResult (Maybe a)
getGeneric Store
store Text
"segments" Text
key (forall s t a b. HasField "segments" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"segments")
upsertGeneric :: (ToJSON a) => Store -> Text -> Text -> Versioned (Maybe a)
-> Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
-> (Bool -> State -> State)
-> StoreResult ()
upsertGeneric :: Store
-> Text
-> Text
-> Versioned (Maybe a)
-> Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
-> (Bool -> State -> State)
-> StoreResultM IO ()
upsertGeneric Store
store Text
namespace Text
key Versioned (Maybe a)
versioned Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
lens Bool -> State -> State
action = do
case Store -> Maybe StoreInterface
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe StoreInterface
Nothing -> do
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
stateRef -> (, ()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$ State -> State
upsertMemory State
stateRef
Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right ()
Just StoreInterface
backend -> do
Either Text Bool
result <- (StoreInterface
-> Text -> Text -> RawFeature -> StoreResultM IO Bool
storeInterfaceUpsertFeature StoreInterface
backend) Text
namespace Text
key (Versioned (Maybe a) -> RawFeature
forall a. ToJSON a => Versioned (Maybe a) -> RawFeature
versionedToRaw Versioned (Maybe a)
versioned)
case Either Text Bool
result of
Left Text
err -> Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left Text
err
Right Bool
updated -> if Bool -> Bool
not Bool
updated then Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Text ()
forall a b. b -> Either a b
Right ()) else do
TimeSpec
now <- IO TimeSpec
getMonotonicTime
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
stateRef -> (, ()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$ State
stateRef
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (HashMap Text (Expirable (Versioned (Maybe a)))
-> Identity (HashMap Text (Expirable (Versioned (Maybe a)))))
-> State -> Identity State
Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
lens ((HashMap Text (Expirable (Versioned (Maybe a)))
-> Identity (HashMap Text (Expirable (Versioned (Maybe a)))))
-> State -> Identity State)
-> (HashMap Text (Expirable (Versioned (Maybe a)))
-> HashMap Text (Expirable (Versioned (Maybe a))))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
-> Expirable (Versioned (Maybe a))
-> HashMap Text (Expirable (Versioned (Maybe a)))
-> HashMap Text (Expirable (Versioned (Maybe a)))
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
key (Versioned (Maybe a)
-> Bool -> TimeSpec -> Expirable (Versioned (Maybe a))
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Versioned (Maybe a)
versioned Bool
False TimeSpec
now))
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& Bool -> State -> State
action Bool
True
Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right ()
where
upsertMemory :: State -> State
upsertMemory State
state = case Text
-> HashMap Text (Expirable (Versioned (Maybe a)))
-> Maybe (Expirable (Versioned (Maybe a)))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
key (State
state State
-> Getting
(HashMap Text (Expirable (Versioned (Maybe a))))
State
(HashMap Text (Expirable (Versioned (Maybe a))))
-> HashMap Text (Expirable (Versioned (Maybe a)))
forall s a. s -> Getting a s a -> a
^. Getting
(HashMap Text (Expirable (Versioned (Maybe a))))
State
(HashMap Text (Expirable (Versioned (Maybe a))))
Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
lens) of
Maybe (Expirable (Versioned (Maybe a)))
Nothing -> State -> State
updateMemory State
state
Just Expirable (Versioned (Maybe a))
existing -> if (forall a s. HasField' "version" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" (Versioned (Maybe a) -> Natural) -> Versioned (Maybe a) -> Natural
forall a b. (a -> b) -> a -> b
$ Expirable (Versioned (Maybe a)) -> Versioned (Maybe a)
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable (Versioned (Maybe a))
existing) Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Versioned (Maybe a) -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Versioned (Maybe a)
versioned
then State -> State
updateMemory State
state else State
state
updateMemory :: State -> State
updateMemory State
state = State
state
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (HashMap Text (Expirable (Versioned (Maybe a)))
-> Identity (HashMap Text (Expirable (Versioned (Maybe a)))))
-> State -> Identity State
Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
lens ((HashMap Text (Expirable (Versioned (Maybe a)))
-> Identity (HashMap Text (Expirable (Versioned (Maybe a)))))
-> State -> Identity State)
-> (HashMap Text (Expirable (Versioned (Maybe a)))
-> HashMap Text (Expirable (Versioned (Maybe a))))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
-> Expirable (Versioned (Maybe a))
-> HashMap Text (Expirable (Versioned (Maybe a)))
-> HashMap Text (Expirable (Versioned (Maybe a)))
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
key (Versioned (Maybe a)
-> Bool -> TimeSpec -> Expirable (Versioned (Maybe a))
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Versioned (Maybe a)
versioned Bool
False TimeSpec
0))
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& Bool -> State -> State
action Bool
False
upsertFlag :: Store -> Text -> Versioned (Maybe Flag) -> StoreResult ()
upsertFlag :: Store -> Text -> Versioned (Maybe Flag) -> StoreResultM IO ()
upsertFlag Store
store Text
key Versioned (Maybe Flag)
versioned = Store
-> Text
-> Text
-> Versioned (Maybe Flag)
-> Lens' State (HashMap Text (Expirable (Versioned (Maybe Flag))))
-> (Bool -> State -> State)
-> StoreResultM IO ()
forall a.
ToJSON a =>
Store
-> Text
-> Text
-> Versioned (Maybe a)
-> Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
-> (Bool -> State -> State)
-> StoreResultM IO ()
upsertGeneric Store
store Text
"flags" Text
key Versioned (Maybe Flag)
versioned (forall s t a b. HasField "flags" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"flags") Bool -> State -> State
postAction where
postAction :: Bool -> State -> State
postAction Bool
external State
state = if Bool
external
then State
state State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "allFlags" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"allFlags" ((Expirable (HashMap Text Flag)
-> Identity (Expirable (HashMap Text Flag)))
-> State -> Identity State)
-> (Expirable (HashMap Text Flag) -> Expirable (HashMap Text Flag))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Bool
-> Expirable (HashMap Text Flag) -> Expirable (HashMap Text Flag)
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"forceExpire" Bool
True)
else State
state State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (forall s t a b. HasField "allFlags" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"allFlags" ((Expirable (HashMap Text Flag)
-> Identity (Expirable (HashMap Text Flag)))
-> State -> Identity State)
-> ((HashMap Text Flag -> Identity (HashMap Text Flag))
-> Expirable (HashMap Text Flag)
-> Identity (Expirable (HashMap Text Flag)))
-> (HashMap Text Flag -> Identity (HashMap Text Flag))
-> State
-> Identity State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. HasField "value" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"value") ((HashMap Text Flag -> Identity (HashMap Text Flag))
-> State -> Identity State)
-> (HashMap Text Flag -> HashMap Text Flag) -> State -> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ HashMap Text Flag -> HashMap Text Flag
updateAllFlags
updateAllFlags :: HashMap Text Flag -> HashMap Text Flag
updateAllFlags HashMap Text Flag
allFlags = case Versioned (Maybe Flag) -> Maybe Flag
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Versioned (Maybe Flag)
versioned of
Maybe Flag
Nothing -> Text -> HashMap Text Flag -> HashMap Text Flag
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
key HashMap Text Flag
allFlags
Just Flag
flag -> Text -> Flag -> HashMap Text Flag -> HashMap Text Flag
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
key Flag
flag HashMap Text Flag
allFlags
upsertSegment :: Store -> Text -> Versioned (Maybe Segment) -> StoreResult ()
upsertSegment :: Store -> Text -> Versioned (Maybe Segment) -> StoreResultM IO ()
upsertSegment Store
store Text
key Versioned (Maybe Segment)
versioned = Store
-> Text
-> Text
-> Versioned (Maybe Segment)
-> Lens'
State (HashMap Text (Expirable (Versioned (Maybe Segment))))
-> (Bool -> State -> State)
-> StoreResultM IO ()
forall a.
ToJSON a =>
Store
-> Text
-> Text
-> Versioned (Maybe a)
-> Lens' State (HashMap Text (Expirable (Versioned (Maybe a))))
-> (Bool -> State -> State)
-> StoreResultM IO ()
upsertGeneric Store
store Text
"segments" Text
key Versioned (Maybe Segment)
versioned (forall s t a b. HasField "segments" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"segments") Bool -> State -> State
forall p p. p -> p -> p
postAction where
postAction :: p -> p -> p
postAction p
_ p
state = p
state
filterAndCacheFlags :: Store -> TimeSpec -> HashMap Text RawFeature -> IO (HashMap Text Flag)
filterAndCacheFlags :: Store
-> TimeSpec -> HashMap Text RawFeature -> IO (HashMap Text Flag)
filterAndCacheFlags Store
store TimeSpec
now HashMap Text RawFeature
raw = do
let decoded :: HashMap Text (Versioned (Maybe Flag))
decoded = (RawFeature -> Maybe (Versioned (Maybe Flag)))
-> HashMap Text RawFeature -> HashMap Text (Versioned (Maybe Flag))
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe RawFeature -> Maybe (Versioned (Maybe Flag))
forall a. FromJSON a => RawFeature -> Maybe (Versioned (Maybe a))
rawToVersioned HashMap Text RawFeature
raw
allFlags :: HashMap Text Flag
allFlags = (Versioned (Maybe Flag) -> Maybe Flag)
-> HashMap Text (Versioned (Maybe Flag)) -> HashMap Text Flag
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe (forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") HashMap Text (Versioned (Maybe Flag))
decoded
IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
state -> (, ()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$
Expirable (HashMap Text Flag) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"allFlags" (HashMap Text Flag
-> Bool -> TimeSpec -> Expirable (HashMap Text Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable HashMap Text Flag
allFlags Bool
False TimeSpec
now) (State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$
HashMap Text (Expirable (Versioned (Maybe Flag))) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"flags" ((Versioned (Maybe Flag) -> Expirable (Versioned (Maybe Flag)))
-> HashMap Text (Versioned (Maybe Flag))
-> HashMap Text (Expirable (Versioned (Maybe Flag)))
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (\Versioned (Maybe Flag)
x -> Versioned (Maybe Flag)
-> Bool -> TimeSpec -> Expirable (Versioned (Maybe Flag))
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Versioned (Maybe Flag)
x Bool
False TimeSpec
now) HashMap Text (Versioned (Maybe Flag))
decoded) State
state
HashMap Text Flag -> IO (HashMap Text Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Flag
allFlags
getAllFlags :: Store -> StoreResult (HashMap Text Flag)
getAllFlags :: Store -> StoreResultM IO (HashMap Text Flag)
getAllFlags Store
store = do
State
state <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (IORef State -> IO State) -> IORef State -> IO State
forall a b. (a -> b) -> a -> b
$ Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store
let memoryFlags :: StoreResultM IO (HashMap Text Flag)
memoryFlags = Either Text (HashMap Text Flag)
-> StoreResultM IO (HashMap Text Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (HashMap Text Flag)
-> StoreResultM IO (HashMap Text Flag))
-> Either Text (HashMap Text Flag)
-> StoreResultM IO (HashMap Text Flag)
forall a b. (a -> b) -> a -> b
$ HashMap Text Flag -> Either Text (HashMap Text Flag)
forall a b. b -> Either a b
Right (HashMap Text Flag -> Either Text (HashMap Text Flag))
-> HashMap Text Flag -> Either Text (HashMap Text Flag)
forall a b. (a -> b) -> a -> b
$ forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" (Expirable (HashMap Text Flag) -> HashMap Text Flag)
-> Expirable (HashMap Text Flag) -> HashMap Text Flag
forall a b. (a -> b) -> a -> b
$ State -> Expirable (HashMap Text Flag)
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"allFlags" State
state
case Store -> Maybe StoreInterface
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe StoreInterface
Nothing -> StoreResultM IO (HashMap Text Flag)
memoryFlags
Just StoreInterface
backend -> do
TimeSpec
now <- IO TimeSpec
getMonotonicTime
if Bool -> Bool
not (Store -> TimeSpec -> Expirable (HashMap Text Flag) -> Bool
forall a. Store -> TimeSpec -> Expirable a -> Bool
isExpired Store
store TimeSpec
now (Expirable (HashMap Text Flag) -> Bool)
-> Expirable (HashMap Text Flag) -> Bool
forall a b. (a -> b) -> a -> b
$ State -> Expirable (HashMap Text Flag)
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"allFlags" State
state)
then StoreResultM IO (HashMap Text Flag)
memoryFlags
else do
Either Text (HashMap Text RawFeature)
result <- (StoreInterface -> Text -> StoreResult (HashMap Text RawFeature)
storeInterfaceAllFeatures StoreInterface
backend) Text
"flags"
case Either Text (HashMap Text RawFeature)
result of
Left Text
err -> Either Text (HashMap Text Flag)
-> StoreResultM IO (HashMap Text Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text (HashMap Text Flag)
forall a b. a -> Either a b
Left Text
err)
Right HashMap Text RawFeature
raw -> do
HashMap Text Flag
filtered <- Store
-> TimeSpec -> HashMap Text RawFeature -> IO (HashMap Text Flag)
filterAndCacheFlags Store
store TimeSpec
now HashMap Text RawFeature
raw
Either Text (HashMap Text Flag)
-> StoreResultM IO (HashMap Text Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text Flag -> Either Text (HashMap Text Flag)
forall a b. b -> Either a b
Right HashMap Text Flag
filtered)
isInitialized :: Store -> StoreResult Bool
isInitialized :: Store -> StoreResultM IO Bool
isInitialized Store
store = do
State
state <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (IORef State -> IO State) -> IORef State -> IO State
forall a b. (a -> b) -> a -> b
$ Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store
let initialized :: Expirable Bool
initialized = State -> Expirable Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"initialized" State
state
if Expirable Bool -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable Bool
initialized
then Either Text Bool -> StoreResultM IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> StoreResultM IO Bool)
-> Either Text Bool -> StoreResultM IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True
else case Store -> Maybe StoreInterface
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe StoreInterface
Nothing -> Either Text Bool -> StoreResultM IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> StoreResultM IO Bool)
-> Either Text Bool -> StoreResultM IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
Just StoreInterface
backend -> do
TimeSpec
now <- IO TimeSpec
getMonotonicTime
if Store -> TimeSpec -> Expirable Bool -> Bool
forall a. Store -> TimeSpec -> Expirable a -> Bool
isExpired Store
store TimeSpec
now Expirable Bool
initialized
then do
Either Text Bool
result <- StoreInterface -> StoreResultM IO Bool
storeInterfaceIsInitialized StoreInterface
backend
case Either Text Bool
result of
Left Text
err -> Either Text Bool -> StoreResultM IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> StoreResultM IO Bool)
-> Either Text Bool -> StoreResultM IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
err
Right Bool
i -> do
IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
stateRef -> (, ()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$
Expirable Bool -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"initialized" (Bool -> Bool -> TimeSpec -> Expirable Bool
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Bool
i Bool
False TimeSpec
now) State
stateRef
Either Text Bool -> StoreResultM IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> StoreResultM IO Bool)
-> Either Text Bool -> StoreResultM IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
i
else Either Text Bool -> StoreResultM IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> StoreResultM IO Bool)
-> Either Text Bool -> StoreResultM IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False