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.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)
import           LaunchDarkly.AesonCompat     (KeyMap, mapValues, emptyObject, insertKey, lookupKey, insertKey, deleteKey, mapMaybeValues)

-- Store result not defined in terms of StoreResultM so we dont have to export.
type StoreResultM m a = m (Either Text a)

-- | The result type for every `StoreInterface` function. Instead of throwing
-- an exception, any store related error should return `Left`. Exceptions
-- unrelated to the store should not be caught.
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 (KeyMap Flag)
    getInitializedC :: store -> StoreResultM m Bool

class LaunchDarklyStoreWrite store m where
    storeInitializeC :: store -> KeyMap (Versioned Flag) -> KeyMap (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 (KeyMap Flag)
storeHandleAllFlags      :: !(StoreResultM m (KeyMap Flag))
    , StoreHandle m -> StoreResultM m Bool
storeHandleInitialized   :: !(StoreResultM m Bool)
    , StoreHandle m
-> KeyMap (Versioned Flag)
-> KeyMap (Versioned Segment)
-> StoreResultM m ()
storeHandleInitialize    :: !(KeyMap (Versioned Flag) -> KeyMap (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 (KeyMap Flag)
getAllFlagsC    = StoreHandle m -> StoreResultM m (KeyMap Flag)
forall (m :: * -> *). StoreHandle m -> StoreResultM m (KeyMap 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
-> KeyMap (Versioned Flag)
-> KeyMap (Versioned Segment)
-> StoreResultM m ()
storeInitializeC = StoreHandle m
-> KeyMap (Versioned Flag)
-> KeyMap (Versioned Segment)
-> StoreResultM m ()
forall (m :: * -> *).
StoreHandle m
-> KeyMap (Versioned Flag)
-> KeyMap (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
    -> KeyMap Flag -> KeyMap Segment -> StoreResultM m ()
initializeStore :: store -> KeyMap Flag -> KeyMap Segment -> StoreResultM m ()
initializeStore store
store KeyMap Flag
flags KeyMap Segment
segments = store
-> KeyMap (Versioned Flag)
-> KeyMap (Versioned Segment)
-> StoreResultM m ()
forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store
-> KeyMap (Versioned Flag)
-> KeyMap (Versioned Segment)
-> StoreResultM m ()
storeInitializeC store
store (KeyMap Flag -> KeyMap (Versioned Flag)
forall s.
HasField' "version" s Natural =>
KeyMap s -> KeyMap (Versioned s)
makeVersioned KeyMap Flag
flags) (KeyMap Segment -> KeyMap (Versioned Segment)
forall s.
HasField' "version" s Natural =>
KeyMap s -> KeyMap (Versioned s)
makeVersioned KeyMap Segment
segments)
    where makeVersioned :: KeyMap s -> KeyMap (Versioned s)
makeVersioned = (s -> Versioned s) -> KeyMap s -> KeyMap (Versioned s)
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\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 (KeyMap Flag)
-> KeyMap (Expirable (Versioned (Maybe Flag)))
-> KeyMap (Expirable (Versioned (Maybe Segment)))
-> Expirable Bool
-> State
State
        { $sel:allFlags:State :: Expirable (KeyMap Flag)
allFlags    = KeyMap Flag -> Bool -> TimeSpec -> Expirable (KeyMap Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable KeyMap Flag
forall v. KeyMap v
emptyObject Bool
True TimeSpec
0
        , $sel:flags:State :: KeyMap (Expirable (Versioned (Maybe Flag)))
flags       = KeyMap (Expirable (Versioned (Maybe Flag)))
forall v. KeyMap v
emptyObject
        , $sel:segments:State :: KeyMap (Expirable (Versioned (Maybe Segment)))
segments    = KeyMap (Expirable (Versioned (Maybe Segment)))
forall v. KeyMap v
emptyObject
        , $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 (KeyMap Flag)
-> StoreResultM m Bool
-> (KeyMap (Versioned Flag)
    -> KeyMap (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 (KeyMap Flag)
storeHandleAllFlags      = Store -> StoreResultM IO (KeyMap Flag)
getAllFlags    Store
store
        , $sel:storeHandleInitialized:StoreHandle :: StoreResultM IO Bool
storeHandleInitialized   = Store -> StoreResultM IO Bool
isInitialized  Store
store
        , $sel:storeHandleInitialize:StoreHandle :: KeyMap (Versioned Flag)
-> KeyMap (Versioned Segment) -> StoreResultM IO ()
storeHandleInitialize    = Store
-> KeyMap (Versioned Flag)
-> KeyMap (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 (KeyMap Flag)
allFlags    :: !(Expirable (KeyMap Flag))
    , State -> KeyMap (Expirable (Versioned (Maybe Flag)))
flags       :: !(KeyMap (Expirable (Versioned (Maybe Flag))))
    , State -> KeyMap (Expirable (Versioned (Maybe Segment)))
segments    :: !(KeyMap (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)

-- | Represents the key for a given feature.
type FeatureKey       = Text
-- | Represents a namespace such as flags or segments
type FeatureNamespace = Text

-- | The interface implemented by external stores for use by the SDK.
data StoreInterface = StoreInterface
    { StoreInterface -> Text -> StoreResult (KeyMap RawFeature)
storeInterfaceAllFeatures   :: !(FeatureNamespace -> StoreResult (KeyMap RawFeature))
      -- ^ A map of all features in a given namespace including deleted.
    , StoreInterface -> Text -> Text -> StoreResult RawFeature
storeInterfaceGetFeature    :: !(FeatureNamespace -> FeatureKey -> StoreResult RawFeature)
      -- ^ Return the value of a key in a namespace.
    , StoreInterface
-> Text -> Text -> RawFeature -> StoreResultM IO Bool
storeInterfaceUpsertFeature :: !(FeatureNamespace -> FeatureKey -> RawFeature -> StoreResult Bool)
      -- ^ Upsert a given feature. Versions should be compared before upsert.
      -- The result should indicate if the feature was replaced or not.
    , StoreInterface -> StoreResultM IO Bool
storeInterfaceIsInitialized :: !(StoreResult Bool)
      -- ^ Checks if the external store has been initialized, which may
      -- have been done by another instance of the SDK.
    , StoreInterface -> KeyMap (KeyMap RawFeature) -> StoreResultM IO ()
storeInterfaceInitialize    :: !(KeyMap (KeyMap RawFeature) -> StoreResult ())
      -- ^ A map of namespaces, and items in namespaces. The entire store state
      -- should be replaced with these values.
    }

-- | An abstract representation of a store object.
data RawFeature = RawFeature
    { RawFeature -> Maybe ByteString
rawFeatureBuffer  :: !(Maybe ByteString)
      -- ^ A serialized item. If the item is deleted or does not exist this
      -- should be `Nothing`.
    , RawFeature -> Natural
rawFeatureVersion :: !Natural
      -- ^ The version of a given item. If the item does not exist this should
      -- be zero.
    }

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 (KeyMap Flag) -> Identity (Expirable (KeyMap Flag)))
 -> State -> Identity State)
-> (Expirable (KeyMap Flag) -> Expirable (KeyMap Flag))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Expirable (KeyMap Flag) -> Expirable (KeyMap 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"       ((KeyMap (Expirable (Versioned (Maybe Flag)))
  -> Identity (KeyMap (Expirable (Versioned (Maybe Flag)))))
 -> State -> Identity State)
-> (KeyMap (Expirable (Versioned (Maybe Flag)))
    -> KeyMap (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)))
-> KeyMap (Expirable (Versioned (Maybe Flag)))
-> KeyMap (Expirable (Versioned (Maybe Flag)))
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues 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"    ((KeyMap (Expirable (Versioned (Maybe Segment)))
  -> Identity (KeyMap (Expirable (Versioned (Maybe Segment)))))
 -> State -> Identity State)
-> (KeyMap (Expirable (Versioned (Maybe Segment)))
    -> KeyMap (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)))
-> KeyMap (Expirable (Versioned (Maybe Segment)))
-> KeyMap (Expirable (Versioned (Maybe Segment)))
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues 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 -> KeyMap (Versioned Flag) -> KeyMap (Versioned Segment) -> StoreResult ()
initialize :: Store
-> KeyMap (Versioned Flag)
-> KeyMap (Versioned Segment)
-> StoreResultM IO ()
initialize Store
store KeyMap (Versioned Flag)
flags KeyMap (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
& KeyMap (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)))
-> KeyMap (Versioned (Maybe Flag))
-> KeyMap (Expirable (Versioned (Maybe Flag)))
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\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) (KeyMap (Versioned (Maybe Flag))
 -> KeyMap (Expirable (Versioned (Maybe Flag))))
-> KeyMap (Versioned (Maybe Flag))
-> KeyMap (Expirable (Versioned (Maybe Flag)))
forall a b. (a -> b) -> a -> b
$ KeyMap (Versioned Flag) -> KeyMap (Versioned (Maybe Flag))
forall s v2 a.
HasField "value" s v2 a (Maybe a) =>
KeyMap s -> KeyMap v2
c KeyMap (Versioned Flag)
flags)
            State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& KeyMap (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)))
-> KeyMap (Versioned (Maybe Segment))
-> KeyMap (Expirable (Versioned (Maybe Segment)))
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\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) (KeyMap (Versioned (Maybe Segment))
 -> KeyMap (Expirable (Versioned (Maybe Segment))))
-> KeyMap (Versioned (Maybe Segment))
-> KeyMap (Expirable (Versioned (Maybe Segment)))
forall a b. (a -> b) -> a -> b
$ KeyMap (Versioned Segment) -> KeyMap (Versioned (Maybe Segment))
forall s v2 a.
HasField "value" s v2 a (Maybe a) =>
KeyMap s -> KeyMap v2
c KeyMap (Versioned Segment)
segments)
            State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& Expirable (KeyMap Flag) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"allFlags"    (KeyMap Flag -> Bool -> TimeSpec -> Expirable (KeyMap Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable ((Versioned Flag -> Flag) -> KeyMap (Versioned Flag) -> KeyMap Flag
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") KeyMap (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 -> KeyMap (KeyMap RawFeature) -> StoreResultM IO ()
storeInterfaceInitialize StoreInterface
backend) KeyMap (KeyMap 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 :: KeyMap (KeyMap RawFeature)
raw = KeyMap (KeyMap RawFeature)
forall v. KeyMap v
emptyObject
            KeyMap (KeyMap RawFeature)
-> (KeyMap (KeyMap RawFeature) -> KeyMap (KeyMap RawFeature))
-> KeyMap (KeyMap RawFeature)
forall a b. a -> (a -> b) -> b
& Text
-> KeyMap RawFeature
-> KeyMap (KeyMap RawFeature)
-> KeyMap (KeyMap RawFeature)
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"flags"    ((Versioned (Maybe Flag) -> RawFeature)
-> KeyMap (Versioned (Maybe Flag)) -> KeyMap RawFeature
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues Versioned (Maybe Flag) -> RawFeature
forall a. ToJSON a => Versioned (Maybe a) -> RawFeature
versionedToRaw (KeyMap (Versioned (Maybe Flag)) -> KeyMap RawFeature)
-> KeyMap (Versioned (Maybe Flag)) -> KeyMap RawFeature
forall a b. (a -> b) -> a -> b
$ KeyMap (Versioned Flag) -> KeyMap (Versioned (Maybe Flag))
forall s v2 a.
HasField "value" s v2 a (Maybe a) =>
KeyMap s -> KeyMap v2
c KeyMap (Versioned Flag)
flags)
            KeyMap (KeyMap RawFeature)
-> (KeyMap (KeyMap RawFeature) -> KeyMap (KeyMap RawFeature))
-> KeyMap (KeyMap RawFeature)
forall a b. a -> (a -> b) -> b
& Text
-> KeyMap RawFeature
-> KeyMap (KeyMap RawFeature)
-> KeyMap (KeyMap RawFeature)
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"segments" ((Versioned (Maybe Segment) -> RawFeature)
-> KeyMap (Versioned (Maybe Segment)) -> KeyMap RawFeature
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues Versioned (Maybe Segment) -> RawFeature
forall a. ToJSON a => Versioned (Maybe a) -> RawFeature
versionedToRaw (KeyMap (Versioned (Maybe Segment)) -> KeyMap RawFeature)
-> KeyMap (Versioned (Maybe Segment)) -> KeyMap RawFeature
forall a b. (a -> b) -> a -> b
$ KeyMap (Versioned Segment) -> KeyMap (Versioned (Maybe Segment))
forall s v2 a.
HasField "value" s v2 a (Maybe a) =>
KeyMap s -> KeyMap v2
c KeyMap (Versioned Segment)
segments)
        c :: KeyMap s -> KeyMap v2
c KeyMap s
x = (s -> v2) -> KeyMap s -> KeyMap v2
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\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) KeyMap 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 (KeyMap (Expirable (Versioned (Maybe a))))
    -> StoreResult (Maybe a)
getGeneric :: Store
-> Text
-> Text
-> Lens' State (KeyMap (Expirable (Versioned (Maybe a))))
-> StoreResult (Maybe a)
getGeneric Store
store Text
namespace Text
key Lens' State (KeyMap (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
-> KeyMap (Expirable (Versioned (Maybe a)))
-> Maybe (Expirable (Versioned (Maybe a)))
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (State
state State
-> Getting
     (KeyMap (Expirable (Versioned (Maybe a))))
     State
     (KeyMap (Expirable (Versioned (Maybe a))))
-> KeyMap (Expirable (Versioned (Maybe a)))
forall s a. s -> Getting a s a -> a
^. Getting
  (KeyMap (Expirable (Versioned (Maybe a))))
  State
  (KeyMap (Expirable (Versioned (Maybe a))))
Lens' State (KeyMap (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
-> KeyMap (Expirable (Versioned (Maybe a)))
-> Maybe (Expirable (Versioned (Maybe a)))
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (State
state State
-> Getting
     (KeyMap (Expirable (Versioned (Maybe a))))
     State
     (KeyMap (Expirable (Versioned (Maybe a))))
-> KeyMap (Expirable (Versioned (Maybe a)))
forall s a. s -> Getting a s a -> a
^. Getting
  (KeyMap (Expirable (Versioned (Maybe a))))
  State
  (KeyMap (Expirable (Versioned (Maybe a))))
Lens' State (KeyMap (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
& (KeyMap (Expirable (Versioned (Maybe a)))
 -> Identity (KeyMap (Expirable (Versioned (Maybe a)))))
-> State -> Identity State
Lens' State (KeyMap (Expirable (Versioned (Maybe a))))
lens ((KeyMap (Expirable (Versioned (Maybe a)))
  -> Identity (KeyMap (Expirable (Versioned (Maybe a)))))
 -> State -> Identity State)
-> (KeyMap (Expirable (Versioned (Maybe a)))
    -> KeyMap (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))
-> KeyMap (Expirable (Versioned (Maybe a)))
-> KeyMap (Expirable (Versioned (Maybe a)))
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey 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 (KeyMap (Expirable (Versioned (Maybe Flag))))
-> StoreResultM IO (Maybe Flag)
forall a.
FromJSON a =>
Store
-> Text
-> Text
-> Lens' State (KeyMap (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 (KeyMap (Expirable (Versioned (Maybe Segment))))
-> StoreResultM IO (Maybe Segment)
forall a.
FromJSON a =>
Store
-> Text
-> Text
-> Lens' State (KeyMap (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 (KeyMap (Expirable (Versioned (Maybe a))))
    -> (Bool -> State -> State)
    -> StoreResult ()
upsertGeneric :: Store
-> Text
-> Text
-> Versioned (Maybe a)
-> Lens' State (KeyMap (Expirable (Versioned (Maybe a))))
-> (Bool -> State -> State)
-> StoreResultM IO ()
upsertGeneric Store
store Text
namespace Text
key Versioned (Maybe a)
versioned Lens' State (KeyMap (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
& (KeyMap (Expirable (Versioned (Maybe a)))
 -> Identity (KeyMap (Expirable (Versioned (Maybe a)))))
-> State -> Identity State
Lens' State (KeyMap (Expirable (Versioned (Maybe a))))
lens ((KeyMap (Expirable (Versioned (Maybe a)))
  -> Identity (KeyMap (Expirable (Versioned (Maybe a)))))
 -> State -> Identity State)
-> (KeyMap (Expirable (Versioned (Maybe a)))
    -> KeyMap (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))
-> KeyMap (Expirable (Versioned (Maybe a)))
-> KeyMap (Expirable (Versioned (Maybe a)))
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey 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
-> KeyMap (Expirable (Versioned (Maybe a)))
-> Maybe (Expirable (Versioned (Maybe a)))
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (State
state State
-> Getting
     (KeyMap (Expirable (Versioned (Maybe a))))
     State
     (KeyMap (Expirable (Versioned (Maybe a))))
-> KeyMap (Expirable (Versioned (Maybe a)))
forall s a. s -> Getting a s a -> a
^. Getting
  (KeyMap (Expirable (Versioned (Maybe a))))
  State
  (KeyMap (Expirable (Versioned (Maybe a))))
Lens' State (KeyMap (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
& (KeyMap (Expirable (Versioned (Maybe a)))
 -> Identity (KeyMap (Expirable (Versioned (Maybe a)))))
-> State -> Identity State
Lens' State (KeyMap (Expirable (Versioned (Maybe a))))
lens ((KeyMap (Expirable (Versioned (Maybe a)))
  -> Identity (KeyMap (Expirable (Versioned (Maybe a)))))
 -> State -> Identity State)
-> (KeyMap (Expirable (Versioned (Maybe a)))
    -> KeyMap (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))
-> KeyMap (Expirable (Versioned (Maybe a)))
-> KeyMap (Expirable (Versioned (Maybe a)))
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey 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 (KeyMap (Expirable (Versioned (Maybe Flag))))
-> (Bool -> State -> State)
-> StoreResultM IO ()
forall a.
ToJSON a =>
Store
-> Text
-> Text
-> Versioned (Maybe a)
-> Lens' State (KeyMap (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 (KeyMap Flag) -> Identity (Expirable (KeyMap Flag)))
 -> State -> Identity State)
-> (Expirable (KeyMap Flag) -> Expirable (KeyMap Flag))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Bool -> Expirable (KeyMap Flag) -> Expirable (KeyMap 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 (KeyMap Flag) -> Identity (Expirable (KeyMap Flag)))
 -> State -> Identity State)
-> ((KeyMap Flag -> Identity (KeyMap Flag))
    -> Expirable (KeyMap Flag) -> Identity (Expirable (KeyMap Flag)))
-> (KeyMap Flag -> Identity (KeyMap 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") ((KeyMap Flag -> Identity (KeyMap Flag))
 -> State -> Identity State)
-> (KeyMap Flag -> KeyMap Flag) -> State -> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyMap Flag -> KeyMap Flag
updateAllFlags
    updateAllFlags :: KeyMap Flag -> KeyMap Flag
updateAllFlags KeyMap 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 -> KeyMap Flag -> KeyMap Flag
forall v. Text -> KeyMap v -> KeyMap v
deleteKey Text
key KeyMap Flag
allFlags
        Just Flag
flag -> Text -> Flag -> KeyMap Flag -> KeyMap Flag
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key Flag
flag KeyMap 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 (KeyMap (Expirable (Versioned (Maybe Segment))))
-> (Bool -> State -> State)
-> StoreResultM IO ()
forall a.
ToJSON a =>
Store
-> Text
-> Text
-> Versioned (Maybe a)
-> Lens' State (KeyMap (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 -> KeyMap RawFeature -> IO (KeyMap Flag)
filterAndCacheFlags :: Store -> TimeSpec -> KeyMap RawFeature -> IO (KeyMap Flag)
filterAndCacheFlags Store
store TimeSpec
now KeyMap RawFeature
raw = do
    let decoded :: KeyMap (Versioned (Maybe Flag))
decoded  = (RawFeature -> Maybe (Versioned (Maybe Flag)))
-> KeyMap RawFeature -> KeyMap (Versioned (Maybe Flag))
forall v1 v2. (v1 -> Maybe v2) -> KeyMap v1 -> KeyMap v2
mapMaybeValues RawFeature -> Maybe (Versioned (Maybe Flag))
forall a. FromJSON a => RawFeature -> Maybe (Versioned (Maybe a))
rawToVersioned KeyMap RawFeature
raw
        allFlags :: KeyMap Flag
allFlags = (Versioned (Maybe Flag) -> Maybe Flag)
-> KeyMap (Versioned (Maybe Flag)) -> KeyMap Flag
forall v1 v2. (v1 -> Maybe v2) -> KeyMap v1 -> KeyMap v2
mapMaybeValues (forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") KeyMap (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 (KeyMap Flag) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"allFlags" (KeyMap Flag -> Bool -> TimeSpec -> Expirable (KeyMap Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable KeyMap Flag
allFlags Bool
False TimeSpec
now) (State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$
            KeyMap (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)))
-> KeyMap (Versioned (Maybe Flag))
-> KeyMap (Expirable (Versioned (Maybe Flag)))
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\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) KeyMap (Versioned (Maybe Flag))
decoded) State
state
    KeyMap Flag -> IO (KeyMap Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap Flag
allFlags

getAllFlags :: Store -> StoreResult (KeyMap Flag)
getAllFlags :: Store -> StoreResultM IO (KeyMap 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 (KeyMap Flag)
memoryFlags = Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag))
-> Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag)
forall a b. (a -> b) -> a -> b
$ KeyMap Flag -> Either Text (KeyMap Flag)
forall a b. b -> Either a b
Right (KeyMap Flag -> Either Text (KeyMap Flag))
-> KeyMap Flag -> Either Text (KeyMap 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 (KeyMap Flag) -> KeyMap Flag)
-> Expirable (KeyMap Flag) -> KeyMap Flag
forall a b. (a -> b) -> a -> b
$ State -> Expirable (KeyMap 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 (KeyMap Flag)
memoryFlags
        Just StoreInterface
backend -> do
            TimeSpec
now <- IO TimeSpec
getMonotonicTime
            if Bool -> Bool
not (Store -> TimeSpec -> Expirable (KeyMap Flag) -> Bool
forall a. Store -> TimeSpec -> Expirable a -> Bool
isExpired Store
store TimeSpec
now (Expirable (KeyMap Flag) -> Bool)
-> Expirable (KeyMap Flag) -> Bool
forall a b. (a -> b) -> a -> b
$ State -> Expirable (KeyMap Flag)
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"allFlags" State
state)
                then StoreResultM IO (KeyMap Flag)
memoryFlags
                else do
                    Either Text (KeyMap RawFeature)
result <- (StoreInterface -> Text -> StoreResult (KeyMap RawFeature)
storeInterfaceAllFeatures StoreInterface
backend) Text
"flags"
                    case Either Text (KeyMap RawFeature)
result of
                        Left Text
err  -> Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text (KeyMap Flag)
forall a b. a -> Either a b
Left Text
err)
                        Right KeyMap RawFeature
raw -> do
                            KeyMap Flag
filtered <- Store -> TimeSpec -> KeyMap RawFeature -> IO (KeyMap Flag)
filterAndCacheFlags Store
store TimeSpec
now KeyMap RawFeature
raw
                            Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMap Flag -> Either Text (KeyMap Flag)
forall a b. b -> Either a b
Right KeyMap 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