{-# LANGUAGE NamedFieldPuns #-}
module LaunchDarkly.Server.Store.Internal
( isInitialized
, getAllFlags
, getFlag
, getSegment
, upsertFlag
, upsertSegment
, initialize
, StoreResult
, StoreResultM
, PersistentDataStore (..)
, SerializedItemDescriptor (..)
, StoreHandle (..)
, LaunchDarklyStoreRead (..)
, LaunchDarklyStoreWrite (..)
, ItemDescriptor (..)
, makeStoreIO
, insertFlag
, deleteFlag
, insertSegment
, deleteSegment
, initializeStore
, createSerializedItemDescriptor
, FeatureKey
, FeatureNamespace
, serializeWithPlaceholder
, byteStringToVersionedData
) where
import Control.Lens (Lens', (%~), (^.))
import Control.Monad (void)
import Data.Aeson (FromJSON, ToJSON (toJSON), decode, encode)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.Function ((&))
import Data.Generics.Product (HasField', field, getField, setField)
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
import Data.Maybe (isJust)
import Data.Text (Text)
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import System.Clock (Clock (Monotonic), TimeSpec, getTime)
import Data.Aeson.Types (Value (Bool))
import Data.Either.Extra (eitherToMaybe)
import LaunchDarkly.AesonCompat (KeyMap, deleteKey, emptyObject, insertKey, lookupKey, mapMaybeValues, mapValues, singleton)
import LaunchDarkly.Server.Features (Flag, Segment)
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 (KeyMap Flag)
getInitializedC :: store -> StoreResultM m Bool
class LaunchDarklyStoreWrite store m where
storeInitializeC :: store -> KeyMap (ItemDescriptor Flag) -> KeyMap (ItemDescriptor Segment) -> StoreResultM m ()
upsertSegmentC :: store -> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
upsertFlagC :: store -> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
data StoreHandle m = StoreHandle
{ forall (m :: * -> *).
StoreHandle m -> Text -> StoreResultM m (Maybe Flag)
storeHandleGetFlag :: !(Text -> StoreResultM m (Maybe Flag))
, forall (m :: * -> *).
StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
storeHandleGetSegment :: !(Text -> StoreResultM m (Maybe Segment))
, forall (m :: * -> *). StoreHandle m -> StoreResultM m (KeyMap Flag)
storeHandleAllFlags :: !(StoreResultM m (KeyMap Flag))
, forall (m :: * -> *). StoreHandle m -> StoreResultM m Bool
storeHandleInitialized :: !(StoreResultM m Bool)
, forall (m :: * -> *).
StoreHandle m
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM m ()
storeHandleInitialize :: !(KeyMap (ItemDescriptor Flag) -> KeyMap (ItemDescriptor Segment) -> StoreResultM m ())
, forall (m :: * -> *).
StoreHandle m
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
storeHandleUpsertSegment :: !(Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ())
, forall (m :: * -> *).
StoreHandle m
-> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
storeHandleUpsertFlag :: !(Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ())
, forall (m :: * -> *). StoreHandle m -> StoreResultM m ()
storeHandleExpireAll :: !(StoreResultM m ())
}
deriving (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 = forall (m :: * -> *).
StoreHandle m -> Text -> StoreResultM m (Maybe Flag)
storeHandleGetFlag
getSegmentC :: StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
getSegmentC = forall (m :: * -> *).
StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
storeHandleGetSegment
getAllFlagsC :: StoreHandle m -> StoreResultM m (KeyMap Flag)
getAllFlagsC = forall (m :: * -> *). StoreHandle m -> StoreResultM m (KeyMap Flag)
storeHandleAllFlags
getInitializedC :: StoreHandle m -> StoreResultM m Bool
getInitializedC = forall (m :: * -> *). StoreHandle m -> StoreResultM m Bool
storeHandleInitialized
instance Monad m => LaunchDarklyStoreWrite (StoreHandle m) m where
storeInitializeC :: StoreHandle m
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM m ()
storeInitializeC = forall (m :: * -> *).
StoreHandle m
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM m ()
storeHandleInitialize
upsertSegmentC :: StoreHandle m
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
upsertSegmentC = forall (m :: * -> *).
StoreHandle m
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
storeHandleUpsertSegment
upsertFlagC :: StoreHandle m
-> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
upsertFlagC = forall (m :: * -> *).
StoreHandle m
-> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
storeHandleUpsertFlag
initializeStore ::
(LaunchDarklyStoreWrite store m, Monad m) =>
store ->
KeyMap Flag ->
KeyMap Segment ->
StoreResultM m ()
initializeStore :: forall store (m :: * -> *).
(LaunchDarklyStoreWrite store m, Monad m) =>
store -> KeyMap Flag -> KeyMap Segment -> StoreResultM m ()
initializeStore store
store KeyMap Flag
flags KeyMap Segment
segments = forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM m ()
storeInitializeC store
store (forall {s}.
HasField' "version" s Natural =>
KeyMap s -> KeyMap (ItemDescriptor s)
makeVersioned KeyMap Flag
flags) (forall {s}.
HasField' "version" s Natural =>
KeyMap s -> KeyMap (ItemDescriptor s)
makeVersioned KeyMap Segment
segments)
where
makeVersioned :: KeyMap s -> KeyMap (ItemDescriptor s)
makeVersioned = forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\s
f -> forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor s
f (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 :: forall store (m :: * -> *).
(LaunchDarklyStoreWrite store m, Monad m) =>
store -> Flag -> StoreResultM m ()
insertFlag store
store Flag
flag = forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store -> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
upsertFlagC store
store (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag) forall a b. (a -> b) -> a -> b
$ forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor (forall (f :: * -> *) a. Applicative f => a -> f a
pure Flag
flag) (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 :: forall store (m :: * -> *).
(LaunchDarklyStoreWrite store m, Monad m) =>
store -> Text -> Natural -> StoreResultM m ()
deleteFlag store
store Text
key Natural
version = forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store -> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
upsertFlagC store
store Text
key forall a b. (a -> b) -> a -> b
$ forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor forall a. Maybe a
Nothing Natural
version
insertSegment :: (LaunchDarklyStoreWrite store m, Monad m) => store -> Segment -> StoreResultM m ()
insertSegment :: forall store (m :: * -> *).
(LaunchDarklyStoreWrite store m, Monad m) =>
store -> Segment -> StoreResultM m ()
insertSegment store
store Segment
segment = forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
upsertSegmentC store
store (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Segment
segment) forall a b. (a -> b) -> a -> b
$ forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor (forall (f :: * -> *) a. Applicative f => a -> f a
pure Segment
segment) (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 :: forall store (m :: * -> *).
(LaunchDarklyStoreWrite store m, Monad m) =>
store -> Text -> Natural -> StoreResultM m ()
deleteSegment store
store Text
key Natural
version = forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
upsertSegmentC store
store Text
key forall a b. (a -> b) -> a -> b
$ forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor forall a. Maybe a
Nothing Natural
version
makeStoreIO :: Maybe PersistentDataStore -> TimeSpec -> IO (StoreHandle IO)
makeStoreIO :: Maybe PersistentDataStore -> TimeSpec -> IO (StoreHandle IO)
makeStoreIO Maybe PersistentDataStore
backend TimeSpec
ttl = do
IORef State
state <-
forall a. a -> IO (IORef a)
newIORef
State
{ $sel:allFlags:State :: Expirable (KeyMap Flag)
allFlags = forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable forall v. KeyMap v
emptyObject Bool
True TimeSpec
0
, $sel:features:State :: KeyMap (Expirable (CacheableItem Flag))
features = forall v. KeyMap v
emptyObject
, $sel:segments:State :: KeyMap (Expirable (CacheableItem Segment))
segments = forall v. KeyMap v
emptyObject
, $sel:initialized:State :: Expirable Bool
initialized = forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Bool
False Bool
True TimeSpec
0
}
let store :: Store
store = IORef State -> Maybe PersistentDataStore -> TimeSpec -> Store
Store IORef State
state Maybe PersistentDataStore
backend TimeSpec
ttl
forall (f :: * -> *) a. Applicative f => a -> f a
pure
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 (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment) -> StoreResultM IO ()
storeHandleInitialize = Store
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM IO ()
initialize Store
store
, $sel:storeHandleUpsertSegment:StoreHandle :: Text -> ItemDescriptor (Maybe Segment) -> StoreResultM IO ()
storeHandleUpsertSegment = Store
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM IO ()
upsertSegment Store
store
, $sel:storeHandleUpsertFlag:StoreHandle :: Text -> ItemDescriptor (Maybe Flag) -> StoreResultM IO ()
storeHandleUpsertFlag = Store -> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM IO ()
upsertFlag Store
store
, $sel:storeHandleExpireAll:StoreHandle :: StoreResultM IO ()
storeHandleExpireAll = Store -> IO ()
expireAllItems Store
store forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ())
}
data Expirable a = Expirable
{ forall a. Expirable a -> a
value :: !a
, forall a. Expirable a -> Bool
forceExpire :: !Bool
, forall a. Expirable a -> TimeSpec
updatedOn :: !TimeSpec
}
deriving (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 ItemDescriptor a = ItemDescriptor
{ forall a. ItemDescriptor a -> a
value :: !a
, forall a. ItemDescriptor a -> Natural
version :: !Natural
}
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ItemDescriptor a) x -> ItemDescriptor a
forall a x. ItemDescriptor a -> Rep (ItemDescriptor a) x
$cto :: forall a x. Rep (ItemDescriptor a) x -> ItemDescriptor a
$cfrom :: forall a x. ItemDescriptor a -> Rep (ItemDescriptor a) x
Generic)
type CacheableItem a = Maybe (ItemDescriptor (Maybe a))
data State = State
{ State -> Expirable (KeyMap Flag)
allFlags :: !(Expirable (KeyMap Flag))
, State -> KeyMap (Expirable (CacheableItem Flag))
features :: !(KeyMap (Expirable (CacheableItem Flag)))
, State -> KeyMap (Expirable (CacheableItem Segment))
segments :: !(KeyMap (Expirable (CacheableItem Segment)))
, State -> Expirable Bool
initialized :: !(Expirable Bool)
}
deriving (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 PersistentDataStore = PersistentDataStore
{ PersistentDataStore
-> Text -> StoreResult (KeyMap SerializedItemDescriptor)
persistentDataStoreAllFeatures :: !(FeatureNamespace -> StoreResult (KeyMap SerializedItemDescriptor))
, PersistentDataStore
-> Text -> Text -> StoreResult (Maybe SerializedItemDescriptor)
persistentDataStoreGetFeature :: !(FeatureNamespace -> FeatureKey -> StoreResult (Maybe SerializedItemDescriptor))
, PersistentDataStore
-> Text -> Text -> SerializedItemDescriptor -> StoreResultM IO Bool
persistentDataStoreUpsertFeature :: !(FeatureNamespace -> FeatureKey -> SerializedItemDescriptor -> StoreResult Bool)
, PersistentDataStore -> StoreResultM IO Bool
persistentDataStoreIsInitialized :: !(StoreResult Bool)
, PersistentDataStore
-> KeyMap (KeyMap SerializedItemDescriptor) -> StoreResultM IO ()
persistentDataStoreInitialize :: !(KeyMap (KeyMap SerializedItemDescriptor) -> StoreResult ())
}
data SerializedItemDescriptor = SerializedItemDescriptor
{ SerializedItemDescriptor -> Maybe ByteString
item :: !(Maybe ByteString)
, SerializedItemDescriptor -> Natural
version :: !Natural
, SerializedItemDescriptor -> Bool
deleted :: !Bool
}
deriving (forall x.
Rep SerializedItemDescriptor x -> SerializedItemDescriptor
forall x.
SerializedItemDescriptor -> Rep SerializedItemDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SerializedItemDescriptor x -> SerializedItemDescriptor
$cfrom :: forall x.
SerializedItemDescriptor -> Rep SerializedItemDescriptor x
Generic, SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
$c/= :: SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
== :: SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
$c== :: SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
Eq, Int -> SerializedItemDescriptor -> ShowS
[SerializedItemDescriptor] -> ShowS
SerializedItemDescriptor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerializedItemDescriptor] -> ShowS
$cshowList :: [SerializedItemDescriptor] -> ShowS
show :: SerializedItemDescriptor -> String
$cshow :: SerializedItemDescriptor -> String
showsPrec :: Int -> SerializedItemDescriptor -> ShowS
$cshowsPrec :: Int -> SerializedItemDescriptor -> ShowS
Show)
serializeWithPlaceholder :: SerializedItemDescriptor -> ByteString
serializeWithPlaceholder :: SerializedItemDescriptor -> ByteString
serializeWithPlaceholder SerializedItemDescriptor {$sel:item:SerializedItemDescriptor :: SerializedItemDescriptor -> Maybe ByteString
item = Maybe ByteString
Nothing, $sel:version:SerializedItemDescriptor :: SerializedItemDescriptor -> Natural
version = Natural
version} = Natural -> ByteString
tombstonePlaceholder Natural
version
serializeWithPlaceholder SerializedItemDescriptor {$sel:deleted:SerializedItemDescriptor :: SerializedItemDescriptor -> Bool
deleted = Bool
True, $sel:version:SerializedItemDescriptor :: SerializedItemDescriptor -> Natural
version = Natural
version} = Natural -> ByteString
tombstonePlaceholder Natural
version
serializeWithPlaceholder SerializedItemDescriptor {$sel:item:SerializedItemDescriptor :: SerializedItemDescriptor -> Maybe ByteString
item = Just ByteString
item} = ByteString
item
tombstonePlaceholder :: Natural -> ByteString
tombstonePlaceholder :: Natural -> ByteString
tombstonePlaceholder Natural
version = forall v. Text -> v -> KeyMap v
singleton Text
"deleted" (Bool -> Value
Bool Bool
True) forall a b. a -> (a -> b) -> b
& forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"version" (forall a. ToJSON a => a -> Value
toJSON Natural
version) forall a b. a -> (a -> b) -> b
& forall a. ToJSON a => a -> ByteString
encode forall a b. a -> (a -> b) -> b
& ByteString -> ByteString
toStrict
byteStringToVersionedData :: ByteString -> Maybe VersionedData
byteStringToVersionedData :: ByteString -> Maybe VersionedData
byteStringToVersionedData ByteString
byteString = forall a. FromJSON a => ByteString -> Maybe a
decode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict ByteString
byteString
data VersionedData = VersionedData
{ VersionedData -> Natural
version :: !Natural
, VersionedData -> Bool
deleted :: !Bool
}
deriving (forall x. Rep VersionedData x -> VersionedData
forall x. VersionedData -> Rep VersionedData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VersionedData x -> VersionedData
$cfrom :: forall x. VersionedData -> Rep VersionedData x
Generic, [VersionedData] -> Encoding
[VersionedData] -> Value
VersionedData -> Encoding
VersionedData -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VersionedData] -> Encoding
$ctoEncodingList :: [VersionedData] -> Encoding
toJSONList :: [VersionedData] -> Value
$ctoJSONList :: [VersionedData] -> Value
toEncoding :: VersionedData -> Encoding
$ctoEncoding :: VersionedData -> Encoding
toJSON :: VersionedData -> Value
$ctoJSON :: VersionedData -> Value
ToJSON, Value -> Parser [VersionedData]
Value -> Parser VersionedData
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VersionedData]
$cparseJSONList :: Value -> Parser [VersionedData]
parseJSON :: Value -> Parser VersionedData
$cparseJSON :: Value -> Parser VersionedData
FromJSON)
data Store = Store
{ Store -> IORef State
state :: !(IORef State)
, Store -> Maybe PersistentDataStore
backend :: !(Maybe PersistentDataStore)
, Store -> TimeSpec
timeToLive :: !TimeSpec
}
deriving (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 = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) forall a b. (a -> b) -> a -> b
$ \State
state ->
(,()) forall a b. (a -> b) -> a -> b
$
State
state
forall a b. a -> (a -> b) -> b
& forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"allFlags" forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {s}. HasField' "forceExpire" s Bool => s -> s
expire
forall a b. a -> (a -> b) -> b
& forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"initialized" forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {s}. HasField' "forceExpire" s Bool => s -> s
expire
forall a b. a -> (a -> b) -> b
& forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"features" forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues forall {s}. HasField' "forceExpire" s Bool => s -> s
expire
forall a b. a -> (a -> b) -> b
& forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"segments" forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues forall {s}. HasField' "forceExpire" s Bool => s -> s
expire
where
expire :: s -> s
expire = forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"forceExpire" Bool
True
isExpired :: Store -> TimeSpec -> Expirable a -> Bool
isExpired :: forall a. Store -> TimeSpec -> Expirable a -> Bool
isExpired Store
store TimeSpec
now Expirable a
item =
(forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store)
Bool -> Bool -> Bool
&& ( (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"forceExpire" Expirable a
item)
Bool -> Bool -> Bool
|| (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"timeToLive" Store
store) forall a. Num a => a -> a -> a
+ (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"updatedOn" Expirable a
item) 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 (ItemDescriptor Flag) -> KeyMap (ItemDescriptor Segment) -> StoreResult ()
initialize :: Store
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM IO ()
initialize Store
store KeyMap (ItemDescriptor Flag)
flags KeyMap (ItemDescriptor Segment)
segments = case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe PersistentDataStore
Nothing -> do
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) forall a b. (a -> b) -> a -> b
$ \State
state ->
(,()) forall a b. (a -> b) -> a -> b
$
State
state
forall a b. a -> (a -> b) -> b
& forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"features" (forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\ItemDescriptor (Maybe Flag)
f -> forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (forall a. a -> Maybe a
Just ItemDescriptor (Maybe Flag)
f) Bool
True TimeSpec
0) forall a b. (a -> b) -> a -> b
$ forall {a} {v2} {a}.
HasField "value" a v2 a (Maybe a) =>
KeyMap a -> KeyMap v2
c KeyMap (ItemDescriptor Flag)
flags)
forall a b. a -> (a -> b) -> b
& forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"segments" (forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\ItemDescriptor (Maybe Segment)
f -> forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (forall a. a -> Maybe a
Just ItemDescriptor (Maybe Segment)
f) Bool
True TimeSpec
0) forall a b. (a -> b) -> a -> b
$ forall {a} {v2} {a}.
HasField "value" a v2 a (Maybe a) =>
KeyMap a -> KeyMap v2
c KeyMap (ItemDescriptor Segment)
segments)
forall a b. a -> (a -> b) -> b
& forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"allFlags" (forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") KeyMap (ItemDescriptor Flag)
flags) Bool
True TimeSpec
0)
forall a b. a -> (a -> b) -> b
& forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"initialized" (forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Bool
True Bool
False TimeSpec
0)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
Just PersistentDataStore
backend ->
(PersistentDataStore
-> KeyMap (KeyMap SerializedItemDescriptor) -> StoreResultM IO ()
persistentDataStoreInitialize PersistentDataStore
backend) KeyMap (KeyMap SerializedItemDescriptor)
serializedItemMap forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
err
Right () -> Store -> IO ()
expireAllItems Store
store forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ())
where
serializedItemMap :: KeyMap (KeyMap SerializedItemDescriptor)
serializedItemMap =
forall v. KeyMap v
emptyObject
forall a b. a -> (a -> b) -> b
& forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"features" (forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues forall a.
ToJSON a =>
ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor forall a b. (a -> b) -> a -> b
$ forall {a} {v2} {a}.
HasField "value" a v2 a (Maybe a) =>
KeyMap a -> KeyMap v2
c KeyMap (ItemDescriptor Flag)
flags)
forall a b. a -> (a -> b) -> b
& forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"segments" (forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues forall a.
ToJSON a =>
ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor forall a b. (a -> b) -> a -> b
$ forall {a} {v2} {a}.
HasField "value" a v2 a (Maybe a) =>
KeyMap a -> KeyMap v2
c KeyMap (ItemDescriptor Segment)
segments)
c :: KeyMap a -> KeyMap v2
c KeyMap a
x = forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\a
f -> a
f forall a b. a -> (a -> b) -> b
& forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"value" forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. a -> Maybe a
Just) KeyMap a
x
serializedToItemDescriptor :: (FromJSON a, HasField' "version" a Natural) => SerializedItemDescriptor -> Either Text (ItemDescriptor (Maybe a))
serializedToItemDescriptor :: forall a.
(FromJSON a, HasField' "version" a Natural) =>
SerializedItemDescriptor -> Either Text (ItemDescriptor (Maybe a))
serializedToItemDescriptor SerializedItemDescriptor
serializedItem = case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"item" SerializedItemDescriptor
serializedItem of
Maybe ByteString
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor forall a. Maybe a
Nothing (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" SerializedItemDescriptor
serializedItem)
Just ByteString
buffer -> do
let versionedData :: Maybe VersionedData
versionedData = ByteString -> Maybe VersionedData
byteStringToVersionedData ByteString
buffer
in case Maybe VersionedData
versionedData of
Maybe VersionedData
Nothing -> forall a b. a -> Either a b
Left Text
"failed decoding into VersionedData"
Just VersionedData {$sel:deleted:VersionedData :: VersionedData -> Bool
deleted = Bool
True, $sel:version:VersionedData :: VersionedData -> Natural
version = Natural
version} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor forall a. Maybe a
Nothing Natural
version
Just VersionedData
_ ->
let decodeResult :: Maybe a
decodeResult = forall a. FromJSON a => ByteString -> Maybe a
decode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict ByteString
buffer
in case Maybe a
decodeResult of
Maybe a
Nothing -> forall a b. a -> Either a b
Left Text
"failed decoding into ItemDescriptor"
Just a
decoded -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor (forall a. a -> Maybe a
Just a
decoded) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" a
decoded)
createSerializedItemDescriptor :: (ToJSON a) => ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor :: forall a.
ToJSON a =>
ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor ItemDescriptor {$sel:value:ItemDescriptor :: forall a. ItemDescriptor a -> a
value = Maybe a
Nothing, Natural
version :: Natural
$sel:version:ItemDescriptor :: forall a. ItemDescriptor a -> Natural
version} = SerializedItemDescriptor {$sel:item:SerializedItemDescriptor :: Maybe ByteString
item = forall a. Maybe a
Nothing, Natural
version :: Natural
$sel:version:SerializedItemDescriptor :: Natural
version, $sel:deleted:SerializedItemDescriptor :: Bool
deleted = Bool
True}
createSerializedItemDescriptor ItemDescriptor {$sel:value:ItemDescriptor :: forall a. ItemDescriptor a -> a
value = Just a
item, Natural
version :: Natural
$sel:version:ItemDescriptor :: forall a. ItemDescriptor a -> Natural
version} = SerializedItemDescriptor {$sel:item:SerializedItemDescriptor :: Maybe ByteString
item = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode a
item, Natural
version :: Natural
$sel:version:SerializedItemDescriptor :: Natural
version, $sel:deleted:SerializedItemDescriptor :: Bool
deleted = Bool
False}
tryGetBackend :: (FromJSON a, HasField' "version" a Natural) => PersistentDataStore -> Text -> Text -> StoreResult (Maybe (ItemDescriptor (Maybe a)))
tryGetBackend :: forall a.
(FromJSON a, HasField' "version" a Natural) =>
PersistentDataStore
-> Text -> Text -> StoreResult (Maybe (ItemDescriptor (Maybe a)))
tryGetBackend PersistentDataStore
backend Text
namespace Text
key =
((PersistentDataStore
-> Text -> Text -> StoreResult (Maybe SerializedItemDescriptor)
persistentDataStoreGetFeature PersistentDataStore
backend) Text
namespace Text
key) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
err
Right Maybe SerializedItemDescriptor
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
Right (Just SerializedItemDescriptor
serializedItem) -> case forall a.
(FromJSON a, HasField' "version" a Natural) =>
SerializedItemDescriptor -> Either Text (ItemDescriptor (Maybe a))
serializedToItemDescriptor SerializedItemDescriptor
serializedItem of
Left Text
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
err
Right ItemDescriptor (Maybe a)
versioned -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ItemDescriptor (Maybe a)
versioned
getGeneric ::
(FromJSON a, HasField' "version" a Natural) =>
Store ->
Text ->
Text ->
Lens' State (KeyMap (Expirable (CacheableItem a))) ->
StoreResult (Maybe a)
getGeneric :: forall a.
(FromJSON a, HasField' "version" a Natural) =>
Store
-> Text
-> Text
-> Lens' State (KeyMap (Expirable (CacheableItem a)))
-> StoreResult (Maybe a)
getGeneric Store
store Text
namespace Text
key Lens' State (KeyMap (Expirable (CacheableItem a)))
lens = do
State
state <- forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store
case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe PersistentDataStore
Nothing -> case forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (State
state forall s a. s -> Getting a s a -> a
^. Lens' State (KeyMap (Expirable (CacheableItem a)))
lens) of
Maybe (Expirable (CacheableItem a))
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
Just Expirable (CacheableItem a)
cacheItem -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable (CacheableItem a)
cacheItem)
Just PersistentDataStore
backend -> do
TimeSpec
now <- IO TimeSpec
getMonotonicTime
case forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (State
state forall s a. s -> Getting a s a -> a
^. Lens' State (KeyMap (Expirable (CacheableItem a)))
lens) of
Maybe (Expirable (CacheableItem a))
Nothing -> PersistentDataStore -> TimeSpec -> StoreResult (Maybe a)
updateFromBackend PersistentDataStore
backend TimeSpec
now
Just Expirable (CacheableItem a)
cacheItem ->
if forall a. Store -> TimeSpec -> Expirable a -> Bool
isExpired Store
store TimeSpec
now Expirable (CacheableItem a)
cacheItem
then PersistentDataStore -> TimeSpec -> StoreResult (Maybe a)
updateFromBackend PersistentDataStore
backend TimeSpec
now
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable (CacheableItem a)
cacheItem)
where
updateFromBackend :: PersistentDataStore -> TimeSpec -> StoreResult (Maybe a)
updateFromBackend PersistentDataStore
backend TimeSpec
now =
forall a.
(FromJSON a, HasField' "version" a Natural) =>
PersistentDataStore
-> Text -> Text -> StoreResult (Maybe (ItemDescriptor (Maybe a)))
tryGetBackend PersistentDataStore
backend Text
namespace Text
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
err
Right CacheableItem a
Nothing -> do
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) forall a b. (a -> b) -> a -> b
$ \State
stateRef ->
(,()) forall a b. (a -> b) -> a -> b
$
State
stateRef
forall a b. a -> (a -> b) -> b
& Lens' State (KeyMap (Expirable (CacheableItem a)))
lens
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key (forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable forall a. Maybe a
Nothing Bool
False TimeSpec
now))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
Right (Just ItemDescriptor (Maybe a)
v) -> do
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) forall a b. (a -> b) -> a -> b
$ \State
stateRef ->
(,()) forall a b. (a -> b) -> a -> b
$
State
stateRef
forall a b. a -> (a -> b) -> b
& Lens' State (KeyMap (Expirable (CacheableItem a)))
lens
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key (forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (forall a. a -> Maybe a
Just ItemDescriptor (Maybe a)
v) Bool
False TimeSpec
now))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" ItemDescriptor (Maybe a)
v
getFlag :: Store -> Text -> StoreResult (Maybe Flag)
getFlag :: Store -> Text -> StoreResultM IO (Maybe Flag)
getFlag Store
store Text
key = forall a.
(FromJSON a, HasField' "version" a Natural) =>
Store
-> Text
-> Text
-> Lens' State (KeyMap (Expirable (CacheableItem a)))
-> StoreResult (Maybe a)
getGeneric Store
store Text
"features" Text
key (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"features")
getSegment :: Store -> Text -> StoreResult (Maybe Segment)
getSegment :: Store -> Text -> StoreResultM IO (Maybe Segment)
getSegment Store
store Text
key = forall a.
(FromJSON a, HasField' "version" a Natural) =>
Store
-> Text
-> Text
-> Lens' State (KeyMap (Expirable (CacheableItem a)))
-> StoreResult (Maybe a)
getGeneric Store
store Text
"segments" Text
key (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 ->
ItemDescriptor (Maybe a) ->
Lens' State (KeyMap (Expirable (CacheableItem a))) ->
(Bool -> State -> State) ->
StoreResult ()
upsertGeneric :: forall a.
ToJSON a =>
Store
-> Text
-> Text
-> ItemDescriptor (Maybe a)
-> Lens' State (KeyMap (Expirable (CacheableItem a)))
-> (Bool -> State -> State)
-> StoreResultM IO ()
upsertGeneric Store
store Text
namespace Text
key ItemDescriptor (Maybe a)
versioned Lens' State (KeyMap (Expirable (CacheableItem a)))
lens Bool -> State -> State
action = do
case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe PersistentDataStore
Nothing -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) forall a b. (a -> b) -> a -> b
$ \State
stateRef -> (,()) forall a b. (a -> b) -> a -> b
$ State -> State
upsertMemory State
stateRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
Just PersistentDataStore
backend -> do
Either Text Bool
result <- (PersistentDataStore
-> Text -> Text -> SerializedItemDescriptor -> StoreResultM IO Bool
persistentDataStoreUpsertFeature PersistentDataStore
backend) Text
namespace Text
key (forall a.
ToJSON a =>
ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor ItemDescriptor (Maybe a)
versioned)
case Either Text Bool
result of
Left Text
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
err
Right Bool
updated ->
if Bool -> Bool
not Bool
updated
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ())
else do
TimeSpec
now <- IO TimeSpec
getMonotonicTime
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) forall a b. (a -> b) -> a -> b
$ \State
stateRef ->
(,()) forall a b. (a -> b) -> a -> b
$
State
stateRef
forall a b. a -> (a -> b) -> b
& Lens' State (KeyMap (Expirable (CacheableItem a)))
lens forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key (forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (forall a. a -> Maybe a
Just ItemDescriptor (Maybe a)
versioned) Bool
False TimeSpec
now))
forall a b. a -> (a -> b) -> b
& Bool -> State -> State
action Bool
True
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
where
upsertMemory :: State -> State
upsertMemory State
state = case forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (State
state forall s a. s -> Getting a s a -> a
^. Lens' State (KeyMap (Expirable (CacheableItem a)))
lens) of
Maybe (Expirable (CacheableItem a))
Nothing -> State -> State
updateMemory State
state
Just Expirable (CacheableItem a)
cacheItem -> case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable (CacheableItem a)
cacheItem of
CacheableItem a
Nothing -> State -> State
updateMemory State
state
Just ItemDescriptor (Maybe a)
existing ->
if (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" ItemDescriptor (Maybe a)
existing) forall a. Ord a => a -> a -> Bool
< forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" ItemDescriptor (Maybe a)
versioned
then State -> State
updateMemory State
state
else State
state
updateMemory :: State -> State
updateMemory State
state =
State
state
forall a b. a -> (a -> b) -> b
& Lens' State (KeyMap (Expirable (CacheableItem a)))
lens forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key (forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (forall a. a -> Maybe a
Just ItemDescriptor (Maybe a)
versioned) Bool
False TimeSpec
0))
forall a b. a -> (a -> b) -> b
& Bool -> State -> State
action Bool
False
upsertFlag :: Store -> Text -> ItemDescriptor (Maybe Flag) -> StoreResult ()
upsertFlag :: Store -> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM IO ()
upsertFlag Store
store Text
key ItemDescriptor (Maybe Flag)
versioned = forall a.
ToJSON a =>
Store
-> Text
-> Text
-> ItemDescriptor (Maybe a)
-> Lens' State (KeyMap (Expirable (CacheableItem a)))
-> (Bool -> State -> State)
-> StoreResultM IO ()
upsertGeneric Store
store Text
"features" Text
key ItemDescriptor (Maybe Flag)
versioned (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"features") Bool -> State -> State
postAction
where
postAction :: Bool -> State -> State
postAction Bool
external State
state =
if Bool
external
then State
state forall a b. a -> (a -> b) -> b
& forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"allFlags" forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"forceExpire" Bool
True)
else State
state forall a b. a -> (a -> b) -> b
& (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"allFlags" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"value") 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 forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" ItemDescriptor (Maybe Flag)
versioned of
Maybe Flag
Nothing -> forall v. Text -> KeyMap v -> KeyMap v
deleteKey Text
key KeyMap Flag
allFlags
Just Flag
flag -> forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key Flag
flag KeyMap Flag
allFlags
upsertSegment :: Store -> Text -> ItemDescriptor (Maybe Segment) -> StoreResult ()
upsertSegment :: Store
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM IO ()
upsertSegment Store
store Text
key ItemDescriptor (Maybe Segment)
versioned = forall a.
ToJSON a =>
Store
-> Text
-> Text
-> ItemDescriptor (Maybe a)
-> Lens' State (KeyMap (Expirable (CacheableItem a)))
-> (Bool -> State -> State)
-> StoreResultM IO ()
upsertGeneric Store
store Text
"segments" Text
key ItemDescriptor (Maybe Segment)
versioned (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"segments") forall {p} {p}. p -> p -> p
postAction
where
postAction :: p -> p -> p
postAction p
_ p
state = p
state
filterAndCacheFlags :: Store -> TimeSpec -> KeyMap SerializedItemDescriptor -> IO (KeyMap Flag)
filterAndCacheFlags :: Store
-> TimeSpec -> KeyMap SerializedItemDescriptor -> IO (KeyMap Flag)
filterAndCacheFlags Store
store TimeSpec
now KeyMap SerializedItemDescriptor
serializedMap = do
let decoded :: KeyMap (ItemDescriptor (Maybe Flag))
decoded = forall v1 v2. (v1 -> Maybe v2) -> KeyMap v1 -> KeyMap v2
mapMaybeValues (forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(FromJSON a, HasField' "version" a Natural) =>
SerializedItemDescriptor -> Either Text (ItemDescriptor (Maybe a))
serializedToItemDescriptor) KeyMap SerializedItemDescriptor
serializedMap
allFlags :: KeyMap Flag
allFlags = forall v1 v2. (v1 -> Maybe v2) -> KeyMap v1 -> KeyMap v2
mapMaybeValues (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") KeyMap (ItemDescriptor (Maybe Flag))
decoded
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) forall a b. (a -> b) -> a -> b
$ \State
state ->
(,()) forall a b. (a -> b) -> a -> b
$
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"allFlags" (forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable KeyMap Flag
allFlags Bool
False TimeSpec
now) forall a b. (a -> b) -> a -> b
$
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"features" (forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\ItemDescriptor (Maybe Flag)
x -> forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (forall a. a -> Maybe a
Just ItemDescriptor (Maybe Flag)
x) Bool
False TimeSpec
now) KeyMap (ItemDescriptor (Maybe Flag))
decoded) State
state
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 <- forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store
let memoryFlags :: StoreResultM IO (KeyMap Flag)
memoryFlags = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"allFlags" State
state
case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe PersistentDataStore
Nothing -> StoreResultM IO (KeyMap Flag)
memoryFlags
Just PersistentDataStore
backend -> do
TimeSpec
now <- IO TimeSpec
getMonotonicTime
if Bool -> Bool
not (forall a. Store -> TimeSpec -> Expirable a -> Bool
isExpired Store
store TimeSpec
now forall a b. (a -> b) -> a -> b
$ 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 SerializedItemDescriptor)
result <- (PersistentDataStore
-> Text -> StoreResult (KeyMap SerializedItemDescriptor)
persistentDataStoreAllFeatures PersistentDataStore
backend) Text
"features"
case Either Text (KeyMap SerializedItemDescriptor)
result of
Left Text
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left Text
err)
Right KeyMap SerializedItemDescriptor
serializedMap -> do
KeyMap Flag
filtered <- Store
-> TimeSpec -> KeyMap SerializedItemDescriptor -> IO (KeyMap Flag)
filterAndCacheFlags Store
store TimeSpec
now KeyMap SerializedItemDescriptor
serializedMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 <- forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store
let initialized :: Expirable Bool
initialized = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"initialized" State
state
if forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable Bool
initialized
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
True
else case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe PersistentDataStore
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
False
Just PersistentDataStore
backend -> do
TimeSpec
now <- IO TimeSpec
getMonotonicTime
if forall a. Store -> TimeSpec -> Expirable a -> Bool
isExpired Store
store TimeSpec
now Expirable Bool
initialized
then do
Either Text Bool
result <- PersistentDataStore -> StoreResultM IO Bool
persistentDataStoreIsInitialized PersistentDataStore
backend
case Either Text Bool
result of
Left Text
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
err
Right Bool
i -> do
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) forall a b. (a -> b) -> a -> b
$ \State
stateRef ->
(,()) forall a b. (a -> b) -> a -> b
$
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"initialized" (forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Bool
i Bool
False TimeSpec
now) State
stateRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
i
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
False