{-# 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 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
$cfrom :: forall (m :: * -> *) x. StoreHandle m -> Rep (StoreHandle m) x
from :: forall x. StoreHandle m -> Rep (StoreHandle m) x
$cto :: forall (m :: * -> *) x. Rep (StoreHandle m) x -> StoreHandle m
to :: forall x. Rep (StoreHandle m) x -> StoreHandle m
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 (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM m ()
storeInitializeC = StoreHandle m
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM m ()
forall (m :: * -> *).
StoreHandle m
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM m ()
storeHandleInitialize
upsertSegmentC :: StoreHandle m
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
upsertSegmentC = StoreHandle m
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
forall (m :: * -> *).
StoreHandle m
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
storeHandleUpsertSegment
upsertFlagC :: StoreHandle m
-> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
upsertFlagC = StoreHandle m
-> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
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 = store
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM m ()
forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM m ()
storeInitializeC store
store (KeyMap Flag -> KeyMap (ItemDescriptor Flag)
forall {s}.
HasField' "version" s Natural =>
KeyMap s -> KeyMap (ItemDescriptor s)
makeVersioned KeyMap Flag
flags) (KeyMap Segment -> KeyMap (ItemDescriptor Segment)
forall {s}.
HasField' "version" s Natural =>
KeyMap s -> KeyMap (ItemDescriptor s)
makeVersioned KeyMap Segment
segments)
where
makeVersioned :: KeyMap s -> KeyMap (ItemDescriptor s)
makeVersioned = (s -> ItemDescriptor s) -> KeyMap s -> KeyMap (ItemDescriptor s)
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\s
f -> s -> Natural -> ItemDescriptor s
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 = store -> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
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) (ItemDescriptor (Maybe Flag) -> StoreResultM m ())
-> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
forall a b. (a -> b) -> a -> b
$ Maybe Flag -> Natural -> ItemDescriptor (Maybe Flag)
forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor (Flag -> Maybe Flag
forall a. a -> Maybe a
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 = store -> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store -> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
upsertFlagC store
store Text
key (ItemDescriptor (Maybe Flag) -> StoreResultM m ())
-> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
forall a b. (a -> b) -> a -> b
$ Maybe Flag -> Natural -> ItemDescriptor (Maybe Flag)
forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor Maybe Flag
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 = store
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
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) (ItemDescriptor (Maybe Segment) -> StoreResultM m ())
-> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
forall a b. (a -> b) -> a -> b
$ Maybe Segment -> Natural -> ItemDescriptor (Maybe Segment)
forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor (Segment -> Maybe Segment
forall a. a -> Maybe a
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 = store
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
forall store (m :: * -> *).
LaunchDarklyStoreWrite store m =>
store
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
upsertSegmentC store
store Text
key (ItemDescriptor (Maybe Segment) -> StoreResultM m ())
-> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
forall a b. (a -> b) -> a -> b
$ Maybe Segment -> Natural -> ItemDescriptor (Maybe Segment)
forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor Maybe Segment
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 <-
State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef
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:features:State :: KeyMap (Expirable (CacheableItem Flag))
features = KeyMap (Expirable (CacheableItem Flag))
forall v. KeyMap v
emptyObject
, $sel:segments:State :: KeyMap (Expirable (CacheableItem Segment))
segments = KeyMap (Expirable (CacheableItem 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 PersistentDataStore -> TimeSpec -> Store
Store IORef State
state Maybe PersistentDataStore
backend TimeSpec
ttl
StoreHandle IO -> IO (StoreHandle IO)
forall a. a -> IO a
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 IO () -> StoreResultM IO () -> StoreResultM IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Either Text () -> StoreResultM IO ()
forall a. a -> IO a
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
{ forall a. Expirable a -> a
value :: !a
, forall a. Expirable a -> Bool
forceExpire :: !Bool
, forall a. 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
$cfrom :: forall a x. Expirable a -> Rep (Expirable a) x
from :: forall x. Expirable a -> Rep (Expirable a) x
$cto :: forall a x. Rep (Expirable a) x -> Expirable a
to :: forall x. Rep (Expirable a) x -> Expirable a
Generic)
data ItemDescriptor a = ItemDescriptor
{ forall a. ItemDescriptor a -> a
value :: !a
, forall a. ItemDescriptor a -> Natural
version :: !Natural
}
deriving ((forall x. ItemDescriptor a -> Rep (ItemDescriptor a) x)
-> (forall x. Rep (ItemDescriptor a) x -> ItemDescriptor a)
-> Generic (ItemDescriptor a)
forall x. Rep (ItemDescriptor a) x -> ItemDescriptor a
forall x. ItemDescriptor a -> Rep (ItemDescriptor a) x
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
$cfrom :: forall a x. ItemDescriptor a -> Rep (ItemDescriptor a) x
from :: forall x. ItemDescriptor a -> Rep (ItemDescriptor a) x
$cto :: forall a x. Rep (ItemDescriptor a) x -> ItemDescriptor a
to :: forall x. Rep (ItemDescriptor a) x -> ItemDescriptor a
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. 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
$cfrom :: forall x. State -> Rep State x
from :: forall x. State -> Rep State x
$cto :: forall x. Rep State x -> State
to :: forall x. Rep State x -> State
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.
SerializedItemDescriptor -> Rep SerializedItemDescriptor x)
-> (forall x.
Rep SerializedItemDescriptor x -> SerializedItemDescriptor)
-> Generic SerializedItemDescriptor
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
$cfrom :: forall x.
SerializedItemDescriptor -> Rep SerializedItemDescriptor x
from :: forall x.
SerializedItemDescriptor -> Rep SerializedItemDescriptor x
$cto :: forall x.
Rep SerializedItemDescriptor x -> SerializedItemDescriptor
to :: forall x.
Rep SerializedItemDescriptor x -> SerializedItemDescriptor
Generic, SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
(SerializedItemDescriptor -> SerializedItemDescriptor -> Bool)
-> (SerializedItemDescriptor -> SerializedItemDescriptor -> Bool)
-> Eq SerializedItemDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
== :: SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
$c/= :: SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
/= :: SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
Eq, Int -> SerializedItemDescriptor -> ShowS
[SerializedItemDescriptor] -> ShowS
SerializedItemDescriptor -> String
(Int -> SerializedItemDescriptor -> ShowS)
-> (SerializedItemDescriptor -> String)
-> ([SerializedItemDescriptor] -> ShowS)
-> Show SerializedItemDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SerializedItemDescriptor -> ShowS
showsPrec :: Int -> SerializedItemDescriptor -> ShowS
$cshow :: SerializedItemDescriptor -> String
show :: SerializedItemDescriptor -> String
$cshowList :: [SerializedItemDescriptor] -> ShowS
showList :: [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 = Text -> Value -> KeyMap Value
forall v. Text -> v -> KeyMap v
singleton Text
"deleted" (Bool -> Value
Bool Bool
True) KeyMap Value -> (KeyMap Value -> KeyMap Value) -> KeyMap Value
forall a b. a -> (a -> b) -> b
& Text -> Value -> KeyMap Value -> KeyMap Value
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"version" (Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
version) KeyMap Value -> (KeyMap Value -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& KeyMap Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> ByteString
toStrict
byteStringToVersionedData :: ByteString -> Maybe VersionedData
byteStringToVersionedData :: ByteString -> Maybe VersionedData
byteStringToVersionedData ByteString
byteString = ByteString -> Maybe VersionedData
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe VersionedData)
-> ByteString -> Maybe VersionedData
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. VersionedData -> Rep VersionedData x)
-> (forall x. Rep VersionedData x -> VersionedData)
-> Generic VersionedData
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
$cfrom :: forall x. VersionedData -> Rep VersionedData x
from :: forall x. VersionedData -> Rep VersionedData x
$cto :: forall x. Rep VersionedData x -> VersionedData
to :: forall x. Rep VersionedData x -> VersionedData
Generic, [VersionedData] -> Value
[VersionedData] -> Encoding
VersionedData -> Bool
VersionedData -> Value
VersionedData -> Encoding
(VersionedData -> Value)
-> (VersionedData -> Encoding)
-> ([VersionedData] -> Value)
-> ([VersionedData] -> Encoding)
-> (VersionedData -> Bool)
-> ToJSON VersionedData
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: VersionedData -> Value
toJSON :: VersionedData -> Value
$ctoEncoding :: VersionedData -> Encoding
toEncoding :: VersionedData -> Encoding
$ctoJSONList :: [VersionedData] -> Value
toJSONList :: [VersionedData] -> Value
$ctoEncodingList :: [VersionedData] -> Encoding
toEncodingList :: [VersionedData] -> Encoding
$comitField :: VersionedData -> Bool
omitField :: VersionedData -> Bool
ToJSON, Maybe VersionedData
Value -> Parser [VersionedData]
Value -> Parser VersionedData
(Value -> Parser VersionedData)
-> (Value -> Parser [VersionedData])
-> Maybe VersionedData
-> FromJSON VersionedData
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser VersionedData
parseJSON :: Value -> Parser VersionedData
$cparseJSONList :: Value -> Parser [VersionedData]
parseJSONList :: Value -> Parser [VersionedData]
$comittedField :: Maybe VersionedData
omittedField :: Maybe VersionedData
FromJSON)
data Store = Store
{ Store -> IORef State
state :: !(IORef State)
, Store -> Maybe PersistentDataStore
backend :: !(Maybe PersistentDataStore)
, 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
$cfrom :: forall x. Store -> Rep Store x
from :: forall x. Store -> Rep Store x
$cto :: forall x. Rep Store x -> Store
to :: forall x. Rep Store x -> Store
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' (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 (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 (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 (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"features" ((KeyMap (Expirable (CacheableItem Flag))
-> Identity (KeyMap (Expirable (CacheableItem Flag))))
-> State -> Identity State)
-> (KeyMap (Expirable (CacheableItem Flag))
-> KeyMap (Expirable (CacheableItem Flag)))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Expirable (CacheableItem Flag) -> Expirable (CacheableItem Flag))
-> KeyMap (Expirable (CacheableItem Flag))
-> KeyMap (Expirable (CacheableItem Flag))
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues Expirable (CacheableItem Flag) -> Expirable (CacheableItem Flag)
forall {s}. HasField' "forceExpire" s Bool => s -> s
expire
State -> (State -> 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 @"segments" ((KeyMap (Expirable (CacheableItem Segment))
-> Identity (KeyMap (Expirable (CacheableItem Segment))))
-> State -> Identity State)
-> (KeyMap (Expirable (CacheableItem Segment))
-> KeyMap (Expirable (CacheableItem Segment)))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Expirable (CacheableItem Segment)
-> Expirable (CacheableItem Segment))
-> KeyMap (Expirable (CacheableItem Segment))
-> KeyMap (Expirable (CacheableItem Segment))
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues Expirable (CacheableItem Segment)
-> Expirable (CacheableItem Segment)
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 =
(Maybe PersistentDataStore -> Bool
forall a. Maybe a -> Bool
isJust (Maybe PersistentDataStore -> Bool)
-> Maybe PersistentDataStore -> Bool
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) TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+ (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 (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
IORef State -> (State -> (State, ())) -> IO ()
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) ((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 (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"features" ((ItemDescriptor (Maybe Flag) -> Expirable (CacheableItem Flag))
-> KeyMap (ItemDescriptor (Maybe Flag))
-> KeyMap (Expirable (CacheableItem Flag))
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\ItemDescriptor (Maybe Flag)
f -> CacheableItem Flag
-> Bool -> TimeSpec -> Expirable (CacheableItem Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (ItemDescriptor (Maybe Flag) -> CacheableItem Flag
forall a. a -> Maybe a
Just ItemDescriptor (Maybe Flag)
f) Bool
True TimeSpec
0) (KeyMap (ItemDescriptor (Maybe Flag))
-> KeyMap (Expirable (CacheableItem Flag)))
-> KeyMap (ItemDescriptor (Maybe Flag))
-> KeyMap (Expirable (CacheableItem Flag))
forall a b. (a -> b) -> a -> b
$ KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor (Maybe Flag))
forall {a} {v2} {a}.
HasField "value" a v2 a (Maybe a) =>
KeyMap a -> KeyMap v2
c KeyMap (ItemDescriptor Flag)
flags)
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"segments" ((ItemDescriptor (Maybe Segment)
-> Expirable (CacheableItem Segment))
-> KeyMap (ItemDescriptor (Maybe Segment))
-> KeyMap (Expirable (CacheableItem Segment))
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\ItemDescriptor (Maybe Segment)
f -> CacheableItem Segment
-> Bool -> TimeSpec -> Expirable (CacheableItem Segment)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (ItemDescriptor (Maybe Segment) -> CacheableItem Segment
forall a. a -> Maybe a
Just ItemDescriptor (Maybe Segment)
f) Bool
True TimeSpec
0) (KeyMap (ItemDescriptor (Maybe Segment))
-> KeyMap (Expirable (CacheableItem Segment)))
-> KeyMap (ItemDescriptor (Maybe Segment))
-> KeyMap (Expirable (CacheableItem Segment))
forall a b. (a -> b) -> a -> b
$ KeyMap (ItemDescriptor Segment)
-> KeyMap (ItemDescriptor (Maybe Segment))
forall {a} {v2} {a}.
HasField "value" a v2 a (Maybe a) =>
KeyMap a -> KeyMap v2
c KeyMap (ItemDescriptor Segment)
segments)
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& 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 ((ItemDescriptor Flag -> Flag)
-> KeyMap (ItemDescriptor Flag) -> KeyMap Flag
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)
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& 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 a. a -> IO a
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 PersistentDataStore
backend ->
(PersistentDataStore
-> KeyMap (KeyMap SerializedItemDescriptor) -> StoreResultM IO ()
persistentDataStoreInitialize PersistentDataStore
backend) KeyMap (KeyMap SerializedItemDescriptor)
serializedItemMap StoreResultM IO ()
-> (Either Text () -> StoreResultM IO ()) -> StoreResultM IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
err -> Either Text () -> StoreResultM IO ()
forall a. a -> IO a
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text () -> StoreResultM IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Text ()
forall a b. b -> Either a b
Right ())
where
serializedItemMap :: KeyMap (KeyMap SerializedItemDescriptor)
serializedItemMap =
KeyMap (KeyMap SerializedItemDescriptor)
forall v. KeyMap v
emptyObject
KeyMap (KeyMap SerializedItemDescriptor)
-> (KeyMap (KeyMap SerializedItemDescriptor)
-> KeyMap (KeyMap SerializedItemDescriptor))
-> KeyMap (KeyMap SerializedItemDescriptor)
forall a b. a -> (a -> b) -> b
& Text
-> KeyMap SerializedItemDescriptor
-> KeyMap (KeyMap SerializedItemDescriptor)
-> KeyMap (KeyMap SerializedItemDescriptor)
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"features" ((ItemDescriptor (Maybe Flag) -> SerializedItemDescriptor)
-> KeyMap (ItemDescriptor (Maybe Flag))
-> KeyMap SerializedItemDescriptor
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues ItemDescriptor (Maybe Flag) -> SerializedItemDescriptor
forall a.
ToJSON a =>
ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor (KeyMap (ItemDescriptor (Maybe Flag))
-> KeyMap SerializedItemDescriptor)
-> KeyMap (ItemDescriptor (Maybe Flag))
-> KeyMap SerializedItemDescriptor
forall a b. (a -> b) -> a -> b
$ KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor (Maybe Flag))
forall {a} {v2} {a}.
HasField "value" a v2 a (Maybe a) =>
KeyMap a -> KeyMap v2
c KeyMap (ItemDescriptor Flag)
flags)
KeyMap (KeyMap SerializedItemDescriptor)
-> (KeyMap (KeyMap SerializedItemDescriptor)
-> KeyMap (KeyMap SerializedItemDescriptor))
-> KeyMap (KeyMap SerializedItemDescriptor)
forall a b. a -> (a -> b) -> b
& Text
-> KeyMap SerializedItemDescriptor
-> KeyMap (KeyMap SerializedItemDescriptor)
-> KeyMap (KeyMap SerializedItemDescriptor)
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"segments" ((ItemDescriptor (Maybe Segment) -> SerializedItemDescriptor)
-> KeyMap (ItemDescriptor (Maybe Segment))
-> KeyMap SerializedItemDescriptor
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues ItemDescriptor (Maybe Segment) -> SerializedItemDescriptor
forall a.
ToJSON a =>
ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor (KeyMap (ItemDescriptor (Maybe Segment))
-> KeyMap SerializedItemDescriptor)
-> KeyMap (ItemDescriptor (Maybe Segment))
-> KeyMap SerializedItemDescriptor
forall a b. (a -> b) -> a -> b
$ KeyMap (ItemDescriptor Segment)
-> KeyMap (ItemDescriptor (Maybe Segment))
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 = (a -> v2) -> KeyMap a -> KeyMap v2
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\a
f -> a
f a -> (a -> v2) -> v2
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" ((a -> Identity (Maybe a)) -> a -> Identity v2)
-> (a -> Maybe a) -> a -> 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 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 -> ItemDescriptor (Maybe a) -> Either Text (ItemDescriptor (Maybe a))
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItemDescriptor (Maybe a)
-> Either Text (ItemDescriptor (Maybe a)))
-> ItemDescriptor (Maybe a)
-> Either Text (ItemDescriptor (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Natural -> ItemDescriptor (Maybe a)
forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor Maybe a
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 -> Text -> Either Text (ItemDescriptor (Maybe a))
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} -> ItemDescriptor (Maybe a) -> Either Text (ItemDescriptor (Maybe a))
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItemDescriptor (Maybe a)
-> Either Text (ItemDescriptor (Maybe a)))
-> ItemDescriptor (Maybe a)
-> Either Text (ItemDescriptor (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Natural -> ItemDescriptor (Maybe a)
forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor Maybe a
forall a. Maybe a
Nothing Natural
version
Just VersionedData
_ ->
let decodeResult :: Maybe a
decodeResult = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe a) -> ByteString -> Maybe a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict ByteString
buffer
in case Maybe a
decodeResult of
Maybe a
Nothing -> Text -> Either Text (ItemDescriptor (Maybe a))
forall a b. a -> Either a b
Left Text
"failed decoding into ItemDescriptor"
Just a
decoded -> ItemDescriptor (Maybe a) -> Either Text (ItemDescriptor (Maybe a))
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItemDescriptor (Maybe a)
-> Either Text (ItemDescriptor (Maybe a)))
-> ItemDescriptor (Maybe a)
-> Either Text (ItemDescriptor (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Natural -> ItemDescriptor (Maybe a)
forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor (a -> Maybe a
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
$sel:version:ItemDescriptor :: forall a. ItemDescriptor a -> Natural
version :: Natural
version} = SerializedItemDescriptor {$sel:item:SerializedItemDescriptor :: Maybe ByteString
item = Maybe ByteString
forall a. Maybe a
Nothing, Natural
$sel:version:SerializedItemDescriptor :: Natural
version :: Natural
version, $sel:deleted:SerializedItemDescriptor :: Bool
deleted = Bool
True}
createSerializedItemDescriptor ItemDescriptor {$sel:value:ItemDescriptor :: forall a. ItemDescriptor a -> a
value = Just a
item, Natural
$sel:version:ItemDescriptor :: forall a. ItemDescriptor a -> Natural
version :: Natural
version} = SerializedItemDescriptor {$sel:item:SerializedItemDescriptor :: Maybe ByteString
item = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (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
item, Natural
$sel:version:SerializedItemDescriptor :: Natural
version :: 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) StoreResult (Maybe SerializedItemDescriptor)
-> (Either Text (Maybe SerializedItemDescriptor)
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a)))))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a))))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
err -> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a))))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a)))))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a))))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Maybe (ItemDescriptor (Maybe a)))
forall a b. a -> Either a b
Left Text
err
Right Maybe SerializedItemDescriptor
Nothing -> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a))))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a)))))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a))))
forall a b. (a -> b) -> a -> b
$ Maybe (ItemDescriptor (Maybe a))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
forall a b. b -> Either a b
Right Maybe (ItemDescriptor (Maybe a))
forall a. Maybe a
Nothing
Right (Just SerializedItemDescriptor
serializedItem) -> case SerializedItemDescriptor -> Either Text (ItemDescriptor (Maybe a))
forall a.
(FromJSON a, HasField' "version" a Natural) =>
SerializedItemDescriptor -> Either Text (ItemDescriptor (Maybe a))
serializedToItemDescriptor SerializedItemDescriptor
serializedItem of
Left Text
err -> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a))))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a)))))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a))))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Maybe (ItemDescriptor (Maybe a)))
forall a b. a -> Either a b
Left Text
err
Right ItemDescriptor (Maybe a)
versioned -> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a))))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a)))))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> IO (Either Text (Maybe (ItemDescriptor (Maybe a))))
forall a b. (a -> b) -> a -> b
$ Maybe (ItemDescriptor (Maybe a))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
forall a b. b -> Either a b
Right (Maybe (ItemDescriptor (Maybe a))
-> Either Text (Maybe (ItemDescriptor (Maybe a))))
-> Maybe (ItemDescriptor (Maybe a))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
forall a b. (a -> b) -> a -> b
$ ItemDescriptor (Maybe a) -> Maybe (ItemDescriptor (Maybe a))
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 <- 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
$ 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 Text
-> KeyMap (Expirable (CacheableItem a))
-> Maybe (Expirable (CacheableItem a))
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (State
state State
-> Getting
(KeyMap (Expirable (CacheableItem a)))
State
(KeyMap (Expirable (CacheableItem a)))
-> KeyMap (Expirable (CacheableItem a))
forall s a. s -> Getting a s a -> a
^. Getting
(KeyMap (Expirable (CacheableItem a)))
State
(KeyMap (Expirable (CacheableItem a)))
Lens' State (KeyMap (Expirable (CacheableItem a)))
lens) of
Maybe (Expirable (CacheableItem a))
Nothing -> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a. a -> IO 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 (CacheableItem a)
cacheItem -> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a. a -> IO 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 (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") (ItemDescriptor (Maybe a) -> Maybe a) -> CacheableItem a -> Maybe a
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 Text
-> KeyMap (Expirable (CacheableItem a))
-> Maybe (Expirable (CacheableItem a))
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (State
state State
-> Getting
(KeyMap (Expirable (CacheableItem a)))
State
(KeyMap (Expirable (CacheableItem a)))
-> KeyMap (Expirable (CacheableItem a))
forall s a. s -> Getting a s a -> a
^. Getting
(KeyMap (Expirable (CacheableItem a)))
State
(KeyMap (Expirable (CacheableItem 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 Store -> TimeSpec -> Expirable (CacheableItem a) -> Bool
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 Either Text (Maybe a) -> StoreResult (Maybe a)
forall a. a -> IO 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 (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") (ItemDescriptor (Maybe a) -> Maybe a) -> CacheableItem a -> Maybe a
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 =
PersistentDataStore
-> Text -> Text -> StoreResult (CacheableItem a)
forall a.
(FromJSON a, HasField' "version" a Natural) =>
PersistentDataStore
-> Text -> Text -> StoreResult (Maybe (ItemDescriptor (Maybe a)))
tryGetBackend PersistentDataStore
backend Text
namespace Text
key StoreResult (CacheableItem a)
-> (Either Text (CacheableItem a) -> StoreResult (Maybe a))
-> StoreResult (Maybe a)
forall a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO 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 CacheableItem a
Nothing -> do
IORef State -> (State -> (State, ())) -> IO ()
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) ((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 (CacheableItem a))
-> Identity (KeyMap (Expirable (CacheableItem a))))
-> State -> Identity State
Lens' State (KeyMap (Expirable (CacheableItem a)))
lens
((KeyMap (Expirable (CacheableItem a))
-> Identity (KeyMap (Expirable (CacheableItem a))))
-> State -> Identity State)
-> (KeyMap (Expirable (CacheableItem a))
-> KeyMap (Expirable (CacheableItem a)))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
-> Expirable (CacheableItem a)
-> KeyMap (Expirable (CacheableItem a))
-> KeyMap (Expirable (CacheableItem a))
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key (CacheableItem a -> Bool -> TimeSpec -> Expirable (CacheableItem a)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable CacheableItem a
forall a. Maybe a
Nothing Bool
False TimeSpec
now))
Either Text (Maybe a) -> StoreResult (Maybe a)
forall a. a -> IO 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
Right (Just ItemDescriptor (Maybe a)
v) -> do
IORef State -> (State -> (State, ())) -> IO ()
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) ((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 (CacheableItem a))
-> Identity (KeyMap (Expirable (CacheableItem a))))
-> State -> Identity State
Lens' State (KeyMap (Expirable (CacheableItem a)))
lens
((KeyMap (Expirable (CacheableItem a))
-> Identity (KeyMap (Expirable (CacheableItem a))))
-> State -> Identity State)
-> (KeyMap (Expirable (CacheableItem a))
-> KeyMap (Expirable (CacheableItem a)))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
-> Expirable (CacheableItem a)
-> KeyMap (Expirable (CacheableItem a))
-> KeyMap (Expirable (CacheableItem a))
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key (CacheableItem a -> Bool -> TimeSpec -> Expirable (CacheableItem a)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (ItemDescriptor (Maybe a) -> CacheableItem a
forall a. a -> Maybe a
Just ItemDescriptor (Maybe a)
v) Bool
False TimeSpec
now))
Either Text (Maybe a) -> StoreResult (Maybe a)
forall a. a -> IO 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 (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 = Store
-> Text
-> Text
-> Lens
State
State
(KeyMap (Expirable (CacheableItem Flag)))
(KeyMap (Expirable (CacheableItem Flag)))
-> StoreResultM IO (Maybe Flag)
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 = Store
-> Text
-> Text
-> Lens
State
State
(KeyMap (Expirable (CacheableItem Segment)))
(KeyMap (Expirable (CacheableItem Segment)))
-> StoreResultM IO (Maybe Segment)
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
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' (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 a. a -> IO a
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 PersistentDataStore
backend -> do
Either Text Bool
result <- (PersistentDataStore
-> Text -> Text -> SerializedItemDescriptor -> StoreResultM IO Bool
persistentDataStoreUpsertFeature PersistentDataStore
backend) Text
namespace Text
key (ItemDescriptor (Maybe a) -> SerializedItemDescriptor
forall a.
ToJSON a =>
ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor ItemDescriptor (Maybe a)
versioned)
case Either Text Bool
result of
Left Text
err -> Either Text () -> StoreResultM IO ()
forall a. a -> IO a
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 a. a -> IO a
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' (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 (CacheableItem a))
-> Identity (KeyMap (Expirable (CacheableItem a))))
-> State -> Identity State
Lens' State (KeyMap (Expirable (CacheableItem a)))
lens ((KeyMap (Expirable (CacheableItem a))
-> Identity (KeyMap (Expirable (CacheableItem a))))
-> State -> Identity State)
-> (KeyMap (Expirable (CacheableItem a))
-> KeyMap (Expirable (CacheableItem a)))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
-> Expirable (CacheableItem a)
-> KeyMap (Expirable (CacheableItem a))
-> KeyMap (Expirable (CacheableItem a))
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key (CacheableItem a -> Bool -> TimeSpec -> Expirable (CacheableItem a)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (ItemDescriptor (Maybe a) -> CacheableItem a
forall a. a -> Maybe a
Just ItemDescriptor (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 a. a -> IO a
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 (CacheableItem a))
-> Maybe (Expirable (CacheableItem a))
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (State
state State
-> Getting
(KeyMap (Expirable (CacheableItem a)))
State
(KeyMap (Expirable (CacheableItem a)))
-> KeyMap (Expirable (CacheableItem a))
forall s a. s -> Getting a s a -> a
^. Getting
(KeyMap (Expirable (CacheableItem a)))
State
(KeyMap (Expirable (CacheableItem 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) Natural -> Natural -> Bool
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
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (KeyMap (Expirable (CacheableItem a))
-> Identity (KeyMap (Expirable (CacheableItem a))))
-> State -> Identity State
Lens' State (KeyMap (Expirable (CacheableItem a)))
lens ((KeyMap (Expirable (CacheableItem a))
-> Identity (KeyMap (Expirable (CacheableItem a))))
-> State -> Identity State)
-> (KeyMap (Expirable (CacheableItem a))
-> KeyMap (Expirable (CacheableItem a)))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
-> Expirable (CacheableItem a)
-> KeyMap (Expirable (CacheableItem a))
-> KeyMap (Expirable (CacheableItem a))
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key (CacheableItem a -> Bool -> TimeSpec -> Expirable (CacheableItem a)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (ItemDescriptor (Maybe a) -> CacheableItem a
forall a. a -> Maybe a
Just ItemDescriptor (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 -> ItemDescriptor (Maybe Flag) -> StoreResult ()
upsertFlag :: Store -> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM IO ()
upsertFlag Store
store Text
key ItemDescriptor (Maybe Flag)
versioned = Store
-> Text
-> Text
-> ItemDescriptor (Maybe Flag)
-> Lens
State
State
(KeyMap (Expirable (CacheableItem Flag)))
(KeyMap (Expirable (CacheableItem Flag)))
-> (Bool -> State -> State)
-> StoreResultM IO ()
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 State -> (State -> 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" ((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
%~ (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 (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 (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 forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" ItemDescriptor (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 -> ItemDescriptor (Maybe Segment) -> StoreResult ()
upsertSegment :: Store
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM IO ()
upsertSegment Store
store Text
key ItemDescriptor (Maybe Segment)
versioned = Store
-> Text
-> Text
-> ItemDescriptor (Maybe Segment)
-> Lens
State
State
(KeyMap (Expirable (CacheableItem Segment)))
(KeyMap (Expirable (CacheableItem Segment)))
-> (Bool -> State -> State)
-> StoreResultM IO ()
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") 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 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 = (SerializedItemDescriptor -> CacheableItem Flag)
-> KeyMap SerializedItemDescriptor
-> KeyMap (ItemDescriptor (Maybe Flag))
forall v1 v2. (v1 -> Maybe v2) -> KeyMap v1 -> KeyMap v2
mapMaybeValues (Either Text (ItemDescriptor (Maybe Flag)) -> CacheableItem Flag
forall a b. Either a b -> Maybe b
eitherToMaybe (Either Text (ItemDescriptor (Maybe Flag)) -> CacheableItem Flag)
-> (SerializedItemDescriptor
-> Either Text (ItemDescriptor (Maybe Flag)))
-> SerializedItemDescriptor
-> CacheableItem Flag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerializedItemDescriptor
-> Either Text (ItemDescriptor (Maybe Flag))
forall a.
(FromJSON a, HasField' "version" a Natural) =>
SerializedItemDescriptor -> Either Text (ItemDescriptor (Maybe a))
serializedToItemDescriptor) KeyMap SerializedItemDescriptor
serializedMap
allFlags :: KeyMap Flag
allFlags = (ItemDescriptor (Maybe Flag) -> Maybe Flag)
-> KeyMap (ItemDescriptor (Maybe Flag)) -> KeyMap Flag
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
IORef State -> (State -> (State, ())) -> IO ()
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) ((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
$
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
$
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"features" ((ItemDescriptor (Maybe Flag) -> Expirable (CacheableItem Flag))
-> KeyMap (ItemDescriptor (Maybe Flag))
-> KeyMap (Expirable (CacheableItem Flag))
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\ItemDescriptor (Maybe Flag)
x -> CacheableItem Flag
-> Bool -> TimeSpec -> Expirable (CacheableItem Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable (ItemDescriptor (Maybe Flag) -> CacheableItem Flag
forall a. a -> Maybe a
Just ItemDescriptor (Maybe Flag)
x) Bool
False TimeSpec
now) KeyMap (ItemDescriptor (Maybe Flag))
decoded) State
state
KeyMap Flag -> IO (KeyMap Flag)
forall a. a -> IO a
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
$ 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 a. a -> IO a
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 (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
$ 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 (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
$ 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 -> Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag)
forall a. a -> IO a
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 SerializedItemDescriptor
serializedMap -> do
KeyMap Flag
filtered <- Store
-> TimeSpec -> KeyMap SerializedItemDescriptor -> IO (KeyMap Flag)
filterAndCacheFlags Store
store TimeSpec
now KeyMap SerializedItemDescriptor
serializedMap
Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag)
forall a. a -> IO a
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
$ 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 Either Text Bool -> StoreResultM IO Bool
forall a. a -> IO a
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 forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
Maybe PersistentDataStore
Nothing -> Either Text Bool -> StoreResultM IO Bool
forall a. a -> IO a
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 PersistentDataStore
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 <- PersistentDataStore -> StoreResultM IO Bool
persistentDataStoreIsInitialized PersistentDataStore
backend
case Either Text Bool
result of
Left Text
err -> Either Text Bool -> StoreResultM IO Bool
forall a. a -> IO a
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' (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
$
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 a. a -> IO a
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 a. a -> IO a
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