{-# 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)

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

-- |
-- The result type for every `PersistentDataStore` function. Instead of throwing
-- an exception, any store related error should return `Left`. Exceptions
-- unrelated to the store should not be caught.
type StoreResult a = IO (Either Text a)

class LaunchDarklyStoreRead store m where
    getFlagC :: store -> Text -> StoreResultM m (Maybe Flag)
    getSegmentC :: store -> Text -> StoreResultM m (Maybe Segment)
    getAllFlagsC :: store -> StoreResultM m (KeyMap Flag)
    getInitializedC :: store -> StoreResultM m Bool

class LaunchDarklyStoreWrite store m where
    storeInitializeC :: store -> KeyMap (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
    { StoreHandle m -> Text -> StoreResultM m (Maybe Flag)
storeHandleGetFlag :: !(Text -> StoreResultM m (Maybe Flag))
    , StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
storeHandleGetSegment :: !(Text -> StoreResultM m (Maybe Segment))
    , StoreHandle m -> StoreResultM m (KeyMap Flag)
storeHandleAllFlags :: !(StoreResultM m (KeyMap Flag))
    , StoreHandle m -> StoreResultM m Bool
storeHandleInitialized :: !(StoreResultM m Bool)
    , StoreHandle m
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM m ()
storeHandleInitialize :: !(KeyMap (ItemDescriptor Flag) -> KeyMap (ItemDescriptor Segment) -> StoreResultM m ())
    , StoreHandle m
-> Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ()
storeHandleUpsertSegment :: !(Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ())
    , StoreHandle m
-> Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ()
storeHandleUpsertFlag :: !(Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ())
    , StoreHandle m -> StoreResultM m ()
storeHandleExpireAll :: !(StoreResultM m ())
    }
    deriving ((forall x. StoreHandle m -> Rep (StoreHandle m) x)
-> (forall x. Rep (StoreHandle m) x -> StoreHandle m)
-> Generic (StoreHandle m)
forall x. Rep (StoreHandle m) x -> StoreHandle m
forall x. StoreHandle m -> Rep (StoreHandle m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) x. Rep (StoreHandle m) x -> StoreHandle m
forall (m :: * -> *) x. StoreHandle m -> Rep (StoreHandle m) x
$cto :: forall (m :: * -> *) x. Rep (StoreHandle m) x -> StoreHandle m
$cfrom :: forall (m :: * -> *) x. StoreHandle m -> Rep (StoreHandle m) x
Generic)

instance Monad m => LaunchDarklyStoreRead (StoreHandle m) m where
    getFlagC :: StoreHandle m -> Text -> StoreResultM m (Maybe Flag)
getFlagC = StoreHandle m -> Text -> StoreResultM m (Maybe Flag)
forall (m :: * -> *).
StoreHandle m -> Text -> StoreResultM m (Maybe Flag)
storeHandleGetFlag
    getSegmentC :: StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
getSegmentC = StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
forall (m :: * -> *).
StoreHandle m -> Text -> StoreResultM m (Maybe Segment)
storeHandleGetSegment
    getAllFlagsC :: StoreHandle m -> StoreResultM m (KeyMap Flag)
getAllFlagsC = StoreHandle m -> StoreResultM m (KeyMap Flag)
forall (m :: * -> *). StoreHandle m -> StoreResultM m (KeyMap Flag)
storeHandleAllFlags
    getInitializedC :: StoreHandle m -> StoreResultM m Bool
getInitializedC = StoreHandle m -> StoreResultM m Bool
forall (m :: * -> *). StoreHandle m -> StoreResultM m Bool
storeHandleInitialized

instance Monad m => LaunchDarklyStoreWrite (StoreHandle m) m where
    storeInitializeC :: StoreHandle m
-> KeyMap (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 :: store -> KeyMap Flag -> KeyMap Segment -> StoreResultM m ()
initializeStore store :: store
store flags :: KeyMap Flag
flags segments :: 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 =>
HashMap Text s -> HashMap Text (ItemDescriptor s)
makeVersioned KeyMap Flag
flags) (KeyMap Segment -> KeyMap (ItemDescriptor Segment)
forall s.
HasField' "version" s Natural =>
HashMap Text s -> HashMap Text (ItemDescriptor s)
makeVersioned KeyMap Segment
segments)
  where
    makeVersioned :: HashMap Text s -> HashMap Text (ItemDescriptor s)
makeVersioned = (s -> ItemDescriptor s)
-> HashMap Text s -> HashMap Text (ItemDescriptor s)
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues (\f :: s
f -> s -> Natural -> ItemDescriptor s
forall a. a -> Natural -> ItemDescriptor a
ItemDescriptor s
f (s -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" s
f))

insertFlag :: (LaunchDarklyStoreWrite store m, Monad m) => store -> Flag -> StoreResultM m ()
insertFlag :: store -> Flag -> StoreResultM m ()
insertFlag store :: store
store flag :: 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 (Flag -> Text
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 (f :: * -> *) a. Applicative f => a -> f a
pure Flag
flag) (Flag -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Flag
flag)

deleteFlag :: (LaunchDarklyStoreWrite store m, Monad m) => store -> Text -> Natural -> StoreResultM m ()
deleteFlag :: store -> Text -> Natural -> StoreResultM m ()
deleteFlag store :: store
store key :: Text
key version :: 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 :: store -> Segment -> StoreResultM m ()
insertSegment store :: store
store segment :: 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 (Segment -> Text
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 (f :: * -> *) a. Applicative f => a -> f a
pure Segment
segment) (Segment -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Segment
segment)

deleteSegment :: (LaunchDarklyStoreWrite store m, Monad m) => store -> Text -> Natural -> StoreResultM m ()
deleteSegment :: store -> Text -> Natural -> StoreResultM m ()
deleteSegment store :: store
store key :: Text
key version :: 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 backend :: Maybe PersistentDataStore
backend ttl :: TimeSpec
ttl = do
    IORef State
state <-
        State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef
            $WState :: Expirable (KeyMap Flag)
-> KeyMap (Expirable (CacheableItem Flag))
-> KeyMap (Expirable (CacheableItem Segment))
-> Expirable Bool
-> State
State
                { $sel:allFlags:State :: Expirable (KeyMap Flag)
allFlags = KeyMap Flag -> Bool -> TimeSpec -> Expirable (KeyMap Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable KeyMap Flag
forall v. KeyMap v
emptyObject Bool
True 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 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 (f :: * -> *) a. Applicative f => a -> f a
pure
        $WStoreHandle :: forall (m :: * -> *).
(Text -> StoreResultM m (Maybe Flag))
-> (Text -> StoreResultM m (Maybe Segment))
-> StoreResultM m (KeyMap Flag)
-> StoreResultM m Bool
-> (KeyMap (ItemDescriptor Flag)
    -> KeyMap (ItemDescriptor Segment) -> StoreResultM m ())
-> (Text -> ItemDescriptor (Maybe Segment) -> StoreResultM m ())
-> (Text -> ItemDescriptor (Maybe Flag) -> StoreResultM m ())
-> StoreResultM m ()
-> StoreHandle m
StoreHandle
            { $sel:storeHandleGetFlag:StoreHandle :: Text -> StoreResultM IO (Maybe Flag)
storeHandleGetFlag = Store -> Text -> StoreResultM IO (Maybe Flag)
getFlag Store
store
            , $sel:storeHandleGetSegment:StoreHandle :: Text -> StoreResultM IO (Maybe Segment)
storeHandleGetSegment = Store -> Text -> StoreResultM IO (Maybe Segment)
getSegment Store
store
            , $sel:storeHandleAllFlags:StoreHandle :: StoreResultM IO (KeyMap Flag)
storeHandleAllFlags = Store -> StoreResultM IO (KeyMap Flag)
getAllFlags Store
store
            , $sel:storeHandleInitialized:StoreHandle :: StoreResultM IO Bool
storeHandleInitialized = Store -> StoreResultM IO Bool
isInitialized Store
store
            , $sel:storeHandleInitialize:StoreHandle :: KeyMap (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right ())
            }

data Expirable a = Expirable
    { Expirable a -> a
value :: !a
    , Expirable a -> Bool
forceExpire :: !Bool
    , Expirable a -> TimeSpec
updatedOn :: !TimeSpec
    }
    deriving ((forall x. Expirable a -> Rep (Expirable a) x)
-> (forall x. Rep (Expirable a) x -> Expirable a)
-> Generic (Expirable a)
forall x. Rep (Expirable a) x -> Expirable a
forall x. Expirable a -> Rep (Expirable a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Expirable a) x -> Expirable a
forall a x. Expirable a -> Rep (Expirable a) x
$cto :: forall a x. Rep (Expirable a) x -> Expirable a
$cfrom :: forall a x. Expirable a -> Rep (Expirable a) x
Generic)

data ItemDescriptor a = ItemDescriptor
    { ItemDescriptor a -> a
value :: !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
$cto :: forall a x. Rep (ItemDescriptor a) x -> ItemDescriptor a
$cfrom :: forall a x. ItemDescriptor a -> Rep (ItemDescriptor a) x
Generic)

-- The CacheableItem is used to store results from a persistent store.
--
-- The type is a Maybe because it is possible that a persistent store will not
-- have a record of a flag requested. We can store that result as a Nothing and
-- prevent subsequent evaluations from reaching across the network.
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
$cto :: forall x. Rep State x -> State
$cfrom :: forall x. State -> Rep State x
Generic)

-- | Represents the key for a given feature.
type FeatureKey = Text

-- | Represents a namespace such as features or segments
type FeatureNamespace = Text

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

-- | A record representing an object that can be persisted in an external store.
data SerializedItemDescriptor = SerializedItemDescriptor
    { SerializedItemDescriptor -> Maybe ByteString
item :: !(Maybe ByteString)
    -- ^ A serialized item. If the item is deleted or does not exist this
    -- should be `Nothing`.
    , SerializedItemDescriptor -> Natural
version :: !Natural
    -- ^ The version of a given item. If the item does not exist this should
    -- be zero.
    , SerializedItemDescriptor -> Bool
deleted :: !Bool
    -- ^ True if this is a placeholder (tombstone) for a deleted item.
    }
    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
$cto :: forall x.
Rep SerializedItemDescriptor x -> SerializedItemDescriptor
$cfrom :: forall x.
SerializedItemDescriptor -> Rep SerializedItemDescriptor x
Generic, SerializedItemDescriptor -> SerializedItemDescriptor -> Bool
(SerializedItemDescriptor -> SerializedItemDescriptor -> Bool)
-> (SerializedItemDescriptor -> SerializedItemDescriptor -> Bool)
-> Eq SerializedItemDescriptor
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
(Int -> SerializedItemDescriptor -> ShowS)
-> (SerializedItemDescriptor -> String)
-> ([SerializedItemDescriptor] -> ShowS)
-> Show SerializedItemDescriptor
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)

-- |
-- Generate a 'ByteString' representation of the 'SerializedItemDescriptor'.
--
-- If the 'SerializedItemDescriptor' has either a 'Nothing' value, or is marked
-- as deleted, the ByteString representation will be a tombstone marker containing the version and deletion status.
--
-- Otherwise, the internal item representation is returned.
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 item :: ByteString
item} = ByteString
item

-- Generate the tombstone placeholder ByteString representation.
tombstonePlaceholder :: Natural -> ByteString
tombstonePlaceholder :: Natural -> ByteString
tombstonePlaceholder version :: Natural
version = Text -> Value -> HashMap Text Value
forall v. Text -> v -> HashMap Text v
singleton "deleted" (Bool -> Value
Bool Bool
True) HashMap Text Value
-> (HashMap Text Value -> HashMap Text Value) -> HashMap Text Value
forall a b. a -> (a -> b) -> b
& Text -> Value -> HashMap Text Value -> HashMap Text Value
forall v. Text -> v -> HashMap Text v -> HashMap Text v
insertKey "version" (Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
version) HashMap Text Value
-> (HashMap Text Value -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& HashMap Text Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> ByteString
toStrict

-- |
-- Partially decode the provided ByteString into a 'VersionedData' struct.
--
-- This is useful for persistent stores who need to perform version comparsions
-- before persisting data.
byteStringToVersionedData :: ByteString -> Maybe VersionedData
byteStringToVersionedData :: ByteString -> Maybe VersionedData
byteStringToVersionedData byteString :: 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
$cto :: forall x. Rep VersionedData x -> VersionedData
$cfrom :: forall x. VersionedData -> Rep VersionedData x
Generic, [VersionedData] -> Encoding
[VersionedData] -> Value
VersionedData -> Encoding
VersionedData -> Value
(VersionedData -> Value)
-> (VersionedData -> Encoding)
-> ([VersionedData] -> Value)
-> ([VersionedData] -> Encoding)
-> ToJSON VersionedData
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
(Value -> Parser VersionedData)
-> (Value -> Parser [VersionedData]) -> FromJSON 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. Store -> Rep Store x)
-> (forall x. Rep Store x -> Store) -> Generic Store
forall x. Rep Store x -> Store
forall x. Store -> Rep Store x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Store x -> Store
$cfrom :: forall x. Store -> Rep Store x
Generic)

expireAllItems :: Store -> IO ()
expireAllItems :: Store -> IO ()
expireAllItems store :: Store
store = IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \state :: State
state ->
    (,()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$
        State
state
            State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "allFlags" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"allFlags" ((Expirable (KeyMap Flag) -> Identity (Expirable (KeyMap Flag)))
 -> State -> Identity State)
-> (Expirable (KeyMap Flag) -> Expirable (KeyMap Flag))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Expirable (KeyMap Flag) -> Expirable (KeyMap Flag)
forall s. HasField' "forceExpire" s Bool => s -> s
expire
            State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "initialized" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"initialized" ((Expirable Bool -> Identity (Expirable Bool))
 -> State -> Identity State)
-> (Expirable Bool -> Expirable Bool) -> State -> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Expirable Bool -> Expirable Bool
forall s. HasField' "forceExpire" s Bool => s -> s
expire
            State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "features" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"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) -> HashMap Text v1 -> HashMap Text 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 s t a b. HasField "segments" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"segments" ((KeyMap (Expirable (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) -> HashMap Text v1 -> HashMap Text v2
mapValues Expirable (CacheableItem Segment)
-> Expirable (CacheableItem Segment)
forall s. HasField' "forceExpire" s Bool => s -> s
expire
  where
    expire :: s -> s
expire = Bool -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"forceExpire" Bool
True

isExpired :: Store -> TimeSpec -> Expirable a -> Bool
isExpired :: Store -> TimeSpec -> Expirable a -> Bool
isExpired store :: Store
store now :: TimeSpec
now item :: 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
$ Store -> Maybe PersistentDataStore
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store)
        Bool -> Bool -> Bool
&& ( (Expirable a -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"forceExpire" Expirable a
item)
                Bool -> Bool -> Bool
|| (Store -> TimeSpec
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"timeToLive" Store
store) TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+ (Expirable a -> TimeSpec
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"updatedOn" Expirable a
item) TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
< TimeSpec
now
           )

getMonotonicTime :: IO TimeSpec
getMonotonicTime :: IO TimeSpec
getMonotonicTime = Clock -> IO TimeSpec
getTime Clock
Monotonic

initialize :: Store -> KeyMap (ItemDescriptor Flag) -> KeyMap (ItemDescriptor Segment) -> StoreResult ()
initialize :: Store
-> KeyMap (ItemDescriptor Flag)
-> KeyMap (ItemDescriptor Segment)
-> StoreResultM IO ()
initialize store :: Store
store flags :: KeyMap (ItemDescriptor Flag)
flags segments :: KeyMap (ItemDescriptor Segment)
segments = case Store -> Maybe PersistentDataStore
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
    Nothing -> do
        IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \state :: State
state ->
            (,()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$
                State
state
                    State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& KeyMap (Expirable (CacheableItem Flag)) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"features" ((ItemDescriptor (Maybe Flag) -> Expirable (CacheableItem Flag))
-> HashMap Text (ItemDescriptor (Maybe Flag))
-> KeyMap (Expirable (CacheableItem Flag))
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues (\f :: 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 0) (HashMap Text (ItemDescriptor (Maybe Flag))
 -> KeyMap (Expirable (CacheableItem Flag)))
-> HashMap Text (ItemDescriptor (Maybe Flag))
-> KeyMap (Expirable (CacheableItem Flag))
forall a b. (a -> b) -> a -> b
$ KeyMap (ItemDescriptor Flag)
-> HashMap Text (ItemDescriptor (Maybe Flag))
forall s v2 a.
HasField "value" s v2 a (Maybe a) =>
HashMap Text s -> HashMap Text v2
c KeyMap (ItemDescriptor Flag)
flags)
                    State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& KeyMap (Expirable (CacheableItem Segment)) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"segments" ((ItemDescriptor (Maybe Segment)
 -> Expirable (CacheableItem Segment))
-> HashMap Text (ItemDescriptor (Maybe Segment))
-> KeyMap (Expirable (CacheableItem Segment))
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues (\f :: 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 0) (HashMap Text (ItemDescriptor (Maybe Segment))
 -> KeyMap (Expirable (CacheableItem Segment)))
-> HashMap Text (ItemDescriptor (Maybe Segment))
-> KeyMap (Expirable (CacheableItem Segment))
forall a b. (a -> b) -> a -> b
$ KeyMap (ItemDescriptor Segment)
-> HashMap Text (ItemDescriptor (Maybe Segment))
forall s v2 a.
HasField "value" s v2 a (Maybe a) =>
HashMap Text s -> HashMap Text v2
c KeyMap (ItemDescriptor Segment)
segments)
                    State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& Expirable (KeyMap Flag) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"allFlags" (KeyMap Flag -> Bool -> TimeSpec -> Expirable (KeyMap Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable ((ItemDescriptor Flag -> Flag)
-> KeyMap (ItemDescriptor Flag) -> KeyMap Flag
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues (forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") KeyMap (ItemDescriptor Flag)
flags) Bool
True 0)
                    State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& Expirable Bool -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"initialized" (Bool -> Bool -> TimeSpec -> Expirable Bool
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Bool
True Bool
False 0)
        Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right ()
    Just backend :: PersistentDataStore
backend ->
        (PersistentDataStore
-> KeyMap (KeyMap SerializedItemDescriptor) -> StoreResultM IO ()
persistentDataStoreInitialize PersistentDataStore
backend) KeyMap (KeyMap SerializedItemDescriptor)
serializedItemMap StoreResultM IO ()
-> (Either Text () -> StoreResultM IO ()) -> StoreResultM IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left err :: Text
err -> Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left Text
err
            Right () -> Store -> IO ()
expireAllItems Store
store IO () -> StoreResultM IO () -> StoreResultM IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Text ()
forall a b. b -> Either a b
Right ())
  where
    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 -> HashMap Text v -> HashMap Text v
insertKey "features" ((ItemDescriptor (Maybe Flag) -> SerializedItemDescriptor)
-> HashMap Text (ItemDescriptor (Maybe Flag))
-> KeyMap SerializedItemDescriptor
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues ItemDescriptor (Maybe Flag) -> SerializedItemDescriptor
forall a.
ToJSON a =>
ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor (HashMap Text (ItemDescriptor (Maybe Flag))
 -> KeyMap SerializedItemDescriptor)
-> HashMap Text (ItemDescriptor (Maybe Flag))
-> KeyMap SerializedItemDescriptor
forall a b. (a -> b) -> a -> b
$ KeyMap (ItemDescriptor Flag)
-> HashMap Text (ItemDescriptor (Maybe Flag))
forall s v2 a.
HasField "value" s v2 a (Maybe a) =>
HashMap Text s -> HashMap Text 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 -> HashMap Text v -> HashMap Text v
insertKey "segments" ((ItemDescriptor (Maybe Segment) -> SerializedItemDescriptor)
-> HashMap Text (ItemDescriptor (Maybe Segment))
-> KeyMap SerializedItemDescriptor
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues ItemDescriptor (Maybe Segment) -> SerializedItemDescriptor
forall a.
ToJSON a =>
ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor (HashMap Text (ItemDescriptor (Maybe Segment))
 -> KeyMap SerializedItemDescriptor)
-> HashMap Text (ItemDescriptor (Maybe Segment))
-> KeyMap SerializedItemDescriptor
forall a b. (a -> b) -> a -> b
$ KeyMap (ItemDescriptor Segment)
-> HashMap Text (ItemDescriptor (Maybe Segment))
forall s v2 a.
HasField "value" s v2 a (Maybe a) =>
HashMap Text s -> HashMap Text v2
c KeyMap (ItemDescriptor Segment)
segments)
    c :: HashMap Text s -> HashMap Text v2
c x :: HashMap Text s
x = (s -> v2) -> HashMap Text s -> HashMap Text v2
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues (\f :: s
f -> s
f s -> (s -> v2) -> v2
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "value" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"value" ((a -> Identity (Maybe a)) -> s -> Identity v2)
-> (a -> Maybe a) -> s -> v2
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> Maybe a
forall a. a -> Maybe a
Just) HashMap Text s
x

serializedToItemDescriptor :: (FromJSON a, HasField' "version" a Natural) => SerializedItemDescriptor -> Either Text (ItemDescriptor (Maybe a))
serializedToItemDescriptor :: SerializedItemDescriptor -> Either Text (ItemDescriptor (Maybe a))
serializedToItemDescriptor serializedItem :: SerializedItemDescriptor
serializedItem = case SerializedItemDescriptor -> Maybe ByteString
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"item" SerializedItemDescriptor
serializedItem of
    Nothing -> ItemDescriptor (Maybe a) -> Either Text (ItemDescriptor (Maybe 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 (SerializedItemDescriptor -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" SerializedItemDescriptor
serializedItem)
    Just buffer :: ByteString
buffer -> do
        let versionedData :: Maybe VersionedData
versionedData = ByteString -> Maybe VersionedData
byteStringToVersionedData ByteString
buffer
         in case Maybe VersionedData
versionedData of
                Nothing -> Text -> Either Text (ItemDescriptor (Maybe a))
forall a b. a -> Either a b
Left "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 (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 _ ->
                    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
                            Nothing -> Text -> Either Text (ItemDescriptor (Maybe a))
forall a b. a -> Either a b
Left "failed decoding into ItemDescriptor"
                            Just decoded :: a
decoded -> ItemDescriptor (Maybe a) -> Either Text (ItemDescriptor (Maybe 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) (a -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" a
decoded)

createSerializedItemDescriptor :: (ToJSON a) => ItemDescriptor (Maybe a) -> SerializedItemDescriptor
createSerializedItemDescriptor :: 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} = $WSerializedItemDescriptor :: Maybe ByteString -> Natural -> Bool -> SerializedItemDescriptor
SerializedItemDescriptor {$sel:item:SerializedItemDescriptor :: Maybe ByteString
item = Maybe ByteString
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 item :: a
item, Natural
version :: Natural
$sel:version:ItemDescriptor :: forall a. ItemDescriptor a -> Natural
version} = $WSerializedItemDescriptor :: Maybe ByteString -> Natural -> Bool -> SerializedItemDescriptor
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
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 :: PersistentDataStore
-> Text -> Text -> StoreResult (Maybe (ItemDescriptor (Maybe a)))
tryGetBackend backend :: PersistentDataStore
backend namespace :: Text
namespace key :: Text
key =
    ((PersistentDataStore
-> Text -> Text -> StoreResult (Maybe SerializedItemDescriptor)
persistentDataStoreGetFeature PersistentDataStore
backend) Text
namespace Text
key) StoreResult (Maybe SerializedItemDescriptor)
-> (Either Text (Maybe SerializedItemDescriptor)
    -> StoreResult (Maybe (ItemDescriptor (Maybe a))))
-> StoreResult (Maybe (ItemDescriptor (Maybe a)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left err :: Text
err -> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> StoreResult (Maybe (ItemDescriptor (Maybe a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe (ItemDescriptor (Maybe a)))
 -> StoreResult (Maybe (ItemDescriptor (Maybe a))))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> StoreResult (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 Nothing -> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> StoreResult (Maybe (ItemDescriptor (Maybe a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe (ItemDescriptor (Maybe a)))
 -> StoreResult (Maybe (ItemDescriptor (Maybe a))))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> StoreResult (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 serializedItem :: 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 err :: Text
err -> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> StoreResult (Maybe (ItemDescriptor (Maybe a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe (ItemDescriptor (Maybe a)))
 -> StoreResult (Maybe (ItemDescriptor (Maybe a))))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> StoreResult (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 versioned :: ItemDescriptor (Maybe a)
versioned -> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> StoreResult (Maybe (ItemDescriptor (Maybe a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe (ItemDescriptor (Maybe a)))
 -> StoreResult (Maybe (ItemDescriptor (Maybe a))))
-> Either Text (Maybe (ItemDescriptor (Maybe a)))
-> StoreResult (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 :: Store
-> Text
-> Text
-> Lens' State (KeyMap (Expirable (CacheableItem a)))
-> StoreResult (Maybe a)
getGeneric store :: Store
store namespace :: Text
namespace key :: Text
key lens :: 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
$ Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store
    case Store -> Maybe PersistentDataStore
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
        Nothing -> case Text
-> KeyMap (Expirable (CacheableItem a))
-> Maybe (Expirable (CacheableItem a))
forall v. Text -> HashMap Text 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
            Nothing -> Either Text (Maybe a) -> StoreResult (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe a) -> StoreResult (Maybe a))
-> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
            Just cacheItem :: Expirable (CacheableItem a)
cacheItem -> Either Text (Maybe a) -> StoreResult (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe a) -> StoreResult (Maybe a))
-> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either Text (Maybe a))
-> Maybe a -> Either Text (Maybe a)
forall a b. (a -> b) -> a -> b
$ (forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") (ItemDescriptor (Maybe a) -> Maybe a) -> CacheableItem a -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Expirable (CacheableItem a) -> CacheableItem a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable (CacheableItem a)
cacheItem)
        Just backend :: PersistentDataStore
backend -> do
            TimeSpec
now <- IO TimeSpec
getMonotonicTime
            case Text
-> KeyMap (Expirable (CacheableItem a))
-> Maybe (Expirable (CacheableItem a))
forall v. Text -> HashMap Text 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
                Nothing -> PersistentDataStore -> TimeSpec -> StoreResult (Maybe a)
updateFromBackend PersistentDataStore
backend TimeSpec
now
                Just cacheItem :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe a) -> StoreResult (Maybe a))
-> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either Text (Maybe a))
-> Maybe a -> Either Text (Maybe a)
forall a b. (a -> b) -> a -> b
$ (forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") (ItemDescriptor (Maybe a) -> Maybe a) -> CacheableItem a -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Expirable (CacheableItem a) -> CacheableItem a
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 backend :: PersistentDataStore
backend now :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left err :: Text
err -> Either Text (Maybe a) -> StoreResult (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Maybe a) -> StoreResult (Maybe a))
-> Either Text (Maybe a) -> StoreResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Maybe a)
forall a b. a -> Either a b
Left Text
err
            Right Nothing -> do
                IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \stateRef :: 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 -> HashMap Text v -> HashMap Text 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 (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 v :: ItemDescriptor (Maybe a)
v) -> do
                IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \stateRef :: 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 -> HashMap Text v -> HashMap Text 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 (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
$ ItemDescriptor (Maybe a) -> Maybe a
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
store key :: Text
key = Store
-> Text
-> Text
-> Lens' State (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 "features" Text
key (forall s t a b. HasField "features" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"features")

getSegment :: Store -> Text -> StoreResult (Maybe Segment)
getSegment :: Store -> Text -> StoreResultM IO (Maybe Segment)
getSegment store :: Store
store key :: Text
key = Store
-> Text
-> Text
-> Lens' State (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 "segments" Text
key (forall s t a b. HasField "segments" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"segments")

upsertGeneric ::
    (ToJSON a) =>
    Store ->
    Text ->
    Text ->
    ItemDescriptor (Maybe a) ->
    Lens' State (KeyMap (Expirable (CacheableItem a))) ->
    (Bool -> State -> State) ->
    StoreResult ()
upsertGeneric :: Store
-> Text
-> Text
-> ItemDescriptor (Maybe a)
-> Lens' State (KeyMap (Expirable (CacheableItem a)))
-> (Bool -> State -> State)
-> StoreResultM IO ()
upsertGeneric store :: Store
store namespace :: Text
namespace key :: Text
key versioned :: ItemDescriptor (Maybe a)
versioned lens :: Lens' State (KeyMap (Expirable (CacheableItem a)))
lens action :: Bool -> State -> State
action = do
    case Store -> Maybe PersistentDataStore
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
        Nothing -> do
            IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \stateRef :: State
stateRef -> (,()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$ State -> State
upsertMemory State
stateRef
            Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right ()
        Just backend :: 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 err :: Text
err -> Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> StoreResultM IO ())
-> Either Text () -> StoreResultM IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left Text
err
                Right updated :: Bool
updated ->
                    if Bool -> Bool
not Bool
updated
                        then Either Text () -> StoreResultM IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Text ()
forall a b. b -> Either a b
Right ())
                        else do
                            TimeSpec
now <- IO TimeSpec
getMonotonicTime
                            IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \stateRef :: 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 -> HashMap Text v -> HashMap Text 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 (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
state = case Text
-> KeyMap (Expirable (CacheableItem a))
-> Maybe (Expirable (CacheableItem a))
forall v. Text -> HashMap Text 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
        Nothing -> State -> State
updateMemory State
state
        Just cacheItem :: Expirable (CacheableItem a)
cacheItem -> case Expirable (CacheableItem a) -> CacheableItem a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable (CacheableItem a)
cacheItem of
            Nothing -> State -> State
updateMemory State
state
            Just existing :: ItemDescriptor (Maybe a)
existing ->
                if (ItemDescriptor (Maybe a) -> Natural
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
< ItemDescriptor (Maybe a) -> Natural
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) -> 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 -> HashMap Text v -> HashMap Text 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 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
store key :: Text
key versioned :: ItemDescriptor (Maybe Flag)
versioned = Store
-> Text
-> Text
-> ItemDescriptor (Maybe Flag)
-> Lens' State (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 "features" Text
key ItemDescriptor (Maybe Flag)
versioned (forall s t a b. HasField "features" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"features") Bool -> State -> State
postAction
  where
    postAction :: Bool -> State -> State
postAction external :: Bool
external state :: State
state =
        if Bool
external
            then State
state State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "allFlags" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"allFlags" ((Expirable (KeyMap Flag) -> Identity (Expirable (KeyMap Flag)))
 -> State -> Identity State)
-> (Expirable (KeyMap Flag) -> Expirable (KeyMap Flag))
-> State
-> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Bool -> Expirable (KeyMap Flag) -> Expirable (KeyMap Flag)
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"forceExpire" Bool
True)
            else State
state State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (forall s t a b. HasField "allFlags" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"allFlags" ((Expirable (KeyMap Flag) -> Identity (Expirable (KeyMap Flag)))
 -> State -> Identity State)
-> ((KeyMap Flag -> Identity (KeyMap Flag))
    -> Expirable (KeyMap Flag) -> Identity (Expirable (KeyMap Flag)))
-> (KeyMap Flag -> Identity (KeyMap Flag))
-> State
-> Identity State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. HasField "value" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"value") ((KeyMap Flag -> Identity (KeyMap Flag))
 -> State -> Identity State)
-> (KeyMap Flag -> KeyMap Flag) -> State -> State
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyMap Flag -> KeyMap Flag
updateAllFlags
    updateAllFlags :: KeyMap Flag -> KeyMap Flag
updateAllFlags allFlags :: KeyMap Flag
allFlags = case ItemDescriptor (Maybe Flag) -> Maybe Flag
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" ItemDescriptor (Maybe Flag)
versioned of
        Nothing -> Text -> KeyMap Flag -> KeyMap Flag
forall v. Text -> HashMap Text v -> HashMap Text v
deleteKey Text
key KeyMap Flag
allFlags
        Just flag :: Flag
flag -> Text -> Flag -> KeyMap Flag -> KeyMap Flag
forall v. Text -> v -> HashMap Text v -> HashMap Text 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
store key :: Text
key versioned :: ItemDescriptor (Maybe Segment)
versioned = Store
-> Text
-> Text
-> ItemDescriptor (Maybe Segment)
-> Lens' State (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 "segments" Text
key ItemDescriptor (Maybe Segment)
versioned (forall s t a b. HasField "segments" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"segments") Bool -> State -> State
forall p p. p -> p -> p
postAction
  where
    postAction :: p -> p -> p
postAction _ state :: p
state = p
state

filterAndCacheFlags :: Store -> TimeSpec -> KeyMap SerializedItemDescriptor -> IO (KeyMap Flag)
filterAndCacheFlags :: Store
-> TimeSpec -> KeyMap SerializedItemDescriptor -> IO (KeyMap Flag)
filterAndCacheFlags store :: Store
store now :: TimeSpec
now serializedMap :: KeyMap SerializedItemDescriptor
serializedMap = do
    let decoded :: HashMap Text (ItemDescriptor (Maybe Flag))
decoded = (SerializedItemDescriptor -> CacheableItem Flag)
-> KeyMap SerializedItemDescriptor
-> HashMap Text (ItemDescriptor (Maybe Flag))
forall v1 v2.
(v1 -> Maybe v2) -> HashMap Text v1 -> HashMap Text 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)
-> HashMap Text (ItemDescriptor (Maybe Flag)) -> KeyMap Flag
forall v1 v2.
(v1 -> Maybe v2) -> HashMap Text v1 -> HashMap Text v2
mapMaybeValues (forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") HashMap Text (ItemDescriptor (Maybe Flag))
decoded
    IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \state :: State
state ->
        (,()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$
            Expirable (KeyMap Flag) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"allFlags" (KeyMap Flag -> Bool -> TimeSpec -> Expirable (KeyMap Flag)
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable KeyMap Flag
allFlags Bool
False TimeSpec
now) (State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$
                KeyMap (Expirable (CacheableItem Flag)) -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"features" ((ItemDescriptor (Maybe Flag) -> Expirable (CacheableItem Flag))
-> HashMap Text (ItemDescriptor (Maybe Flag))
-> KeyMap (Expirable (CacheableItem Flag))
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues (\x :: 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) HashMap Text (ItemDescriptor (Maybe Flag))
decoded) State
state
    KeyMap Flag -> IO (KeyMap Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap Flag
allFlags

getAllFlags :: Store -> StoreResult (KeyMap Flag)
getAllFlags :: Store -> StoreResultM IO (KeyMap Flag)
getAllFlags store :: Store
store = do
    State
state <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (IORef State -> IO State) -> IORef State -> IO State
forall a b. (a -> b) -> a -> b
$ Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store
    let memoryFlags :: StoreResultM IO (KeyMap Flag)
memoryFlags = Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag))
-> Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag)
forall a b. (a -> b) -> a -> b
$ KeyMap Flag -> Either Text (KeyMap Flag)
forall a b. b -> Either a b
Right (KeyMap Flag -> Either Text (KeyMap Flag))
-> KeyMap Flag -> Either Text (KeyMap Flag)
forall a b. (a -> b) -> a -> b
$ forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" (Expirable (KeyMap Flag) -> KeyMap Flag)
-> Expirable (KeyMap Flag) -> KeyMap Flag
forall a b. (a -> b) -> a -> b
$ State -> Expirable (KeyMap Flag)
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"allFlags" State
state
    case Store -> Maybe PersistentDataStore
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
        Nothing -> StoreResultM IO (KeyMap Flag)
memoryFlags
        Just backend :: 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
$ State -> Expirable (KeyMap Flag)
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"allFlags" State
state)
                then StoreResultM IO (KeyMap Flag)
memoryFlags
                else do
                    Either Text (KeyMap SerializedItemDescriptor)
result <- (PersistentDataStore
-> Text -> StoreResult (KeyMap SerializedItemDescriptor)
persistentDataStoreAllFeatures PersistentDataStore
backend) "features"
                    case Either Text (KeyMap SerializedItemDescriptor)
result of
                        Left err :: Text
err -> Either Text (KeyMap Flag) -> StoreResultM IO (KeyMap Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text (KeyMap Flag)
forall a b. a -> Either a b
Left Text
err)
                        Right serializedMap :: 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 (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
store = do
    State
state <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (IORef State -> IO State) -> IORef State -> IO State
forall a b. (a -> b) -> a -> b
$ Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store
    let initialized :: Expirable Bool
initialized = State -> Expirable Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"initialized" State
state
    if Expirable Bool -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" Expirable Bool
initialized
        then Either Text Bool -> StoreResultM IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> StoreResultM IO Bool)
-> Either Text Bool -> StoreResultM IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True
        else case Store -> Maybe PersistentDataStore
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"backend" Store
store of
            Nothing -> Either Text Bool -> StoreResultM IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> StoreResultM IO Bool)
-> Either Text Bool -> StoreResultM IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
            Just backend :: 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 err :: Text
err -> Either Text Bool -> StoreResultM IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> StoreResultM IO Bool)
-> Either Text Bool -> StoreResultM IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
err
                            Right i :: Bool
i -> do
                                IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Store -> IORef State
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \stateRef :: State
stateRef ->
                                    (,()) (State -> (State, ())) -> State -> (State, ())
forall a b. (a -> b) -> a -> b
$
                                        Expirable Bool -> State -> State
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"initialized" (Bool -> Bool -> TimeSpec -> Expirable Bool
forall a. a -> Bool -> TimeSpec -> Expirable a
Expirable Bool
i Bool
False TimeSpec
now) State
stateRef
                                Either Text Bool -> StoreResultM IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> StoreResultM IO Bool)
-> Either Text Bool -> StoreResultM IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
i
                    else Either Text Bool -> StoreResultM IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> StoreResultM IO Bool)
-> Either Text Bool -> StoreResultM IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False