module LaunchDarkly.Server.Store.Redis.Internal
    ( RedisStoreConfig
    , makeRedisStoreConfig
    , redisConfigSetNamespace
    , makeRedisStore
    ) where

import Control.Exception (throwIO)
import Control.Monad (forM_, void)
import Control.Monad.Catch (Exception, Handler (..), catches)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import Data.Functor ((<&>))
import Data.Generics.Product (getField)
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Typeable (Typeable)
import Database.Redis
    ( Connection
    , ConnectionLostException
    , Redis
    , Reply
    , TxResult (..)
    , del
    , get
    , hget
    , hgetall
    , hset
    , multiExec
    , runRedis
    , set
    , watch
    )

import LaunchDarkly.AesonCompat (KeyMap, fromList, mapValues, objectKeys, toList)
import LaunchDarkly.Server.Store (PersistentDataStore (..), SerializedItemDescriptor (..), StoreResult, byteStringToVersionedData, serializeWithPlaceholder)

-- | Opaque type used to configure the Redis store integration.
data RedisStoreConfig = RedisStoreConfig
    { RedisStoreConfig -> Text
namespace :: Text
    , RedisStoreConfig -> Connection
connection :: Connection
    }

-- | Create a default config from a given connection pool.
makeRedisStoreConfig :: Connection -> RedisStoreConfig
makeRedisStoreConfig :: Connection -> RedisStoreConfig
makeRedisStoreConfig con :: Connection
con =
    RedisStoreConfig :: Text -> Connection -> RedisStoreConfig
RedisStoreConfig
        { namespace :: Text
namespace = "launchdarkly"
        , connection :: Connection
connection = Connection
con
        }

-- |
-- Configure the Redis key prefix. All keys are prefixed by default before
-- being inserted into Redis. The default prefix is "launchdarkly".
redisConfigSetNamespace :: Text -> RedisStoreConfig -> RedisStoreConfig
redisConfigSetNamespace :: Text -> RedisStoreConfig -> RedisStoreConfig
redisConfigSetNamespace namespace' :: Text
namespace' config :: RedisStoreConfig
config = RedisStoreConfig
config {namespace :: Text
namespace = Text
namespace'}

-- |
-- Construct a `PersistentDataStore` that can then be used during SDK
-- configuration.
makeRedisStore :: RedisStoreConfig -> IO PersistentDataStore
makeRedisStore :: RedisStoreConfig -> IO PersistentDataStore
makeRedisStore config :: RedisStoreConfig
config =
    PersistentDataStore -> IO PersistentDataStore
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        $WPersistentDataStore :: (Text -> StoreResult (KeyMap SerializedItemDescriptor))
-> (Text -> Text -> StoreResult (Maybe SerializedItemDescriptor))
-> (Text -> Text -> SerializedItemDescriptor -> StoreResult Bool)
-> StoreResult Bool
-> (KeyMap (KeyMap SerializedItemDescriptor) -> StoreResult ())
-> PersistentDataStore
PersistentDataStore
            { $sel:persistentDataStoreUpsertFeature:PersistentDataStore :: Text -> Text -> SerializedItemDescriptor -> StoreResult Bool
persistentDataStoreUpsertFeature = RedisStoreConfig
-> Text -> Text -> SerializedItemDescriptor -> StoreResult Bool
redisUpsert RedisStoreConfig
config
            , $sel:persistentDataStoreGetFeature:PersistentDataStore :: Text -> Text -> StoreResult (Maybe SerializedItemDescriptor)
persistentDataStoreGetFeature = RedisStoreConfig
-> Text -> Text -> StoreResult (Maybe SerializedItemDescriptor)
redisGetFeature RedisStoreConfig
config
            , $sel:persistentDataStoreInitialize:PersistentDataStore :: KeyMap (KeyMap SerializedItemDescriptor) -> StoreResult ()
persistentDataStoreInitialize = RedisStoreConfig
-> KeyMap (KeyMap SerializedItemDescriptor) -> StoreResult ()
redisInitialize RedisStoreConfig
config
            , $sel:persistentDataStoreIsInitialized:PersistentDataStore :: StoreResult Bool
persistentDataStoreIsInitialized = RedisStoreConfig -> StoreResult Bool
redisIsInitialized RedisStoreConfig
config
            , $sel:persistentDataStoreAllFeatures:PersistentDataStore :: Text -> StoreResult (KeyMap SerializedItemDescriptor)
persistentDataStoreAllFeatures = RedisStoreConfig
-> Text -> StoreResult (KeyMap SerializedItemDescriptor)
redisGetAll RedisStoreConfig
config
            }

newtype RedisError = RedisError Text deriving (Typeable, Int -> RedisError -> ShowS
[RedisError] -> ShowS
RedisError -> String
(Int -> RedisError -> ShowS)
-> (RedisError -> String)
-> ([RedisError] -> ShowS)
-> Show RedisError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedisError] -> ShowS
$cshowList :: [RedisError] -> ShowS
show :: RedisError -> String
$cshow :: RedisError -> String
showsPrec :: Int -> RedisError -> ShowS
$cshowsPrec :: Int -> RedisError -> ShowS
Show, Show RedisError
Typeable RedisError
(Typeable RedisError, Show RedisError) =>
(RedisError -> SomeException)
-> (SomeException -> Maybe RedisError)
-> (RedisError -> String)
-> Exception RedisError
SomeException -> Maybe RedisError
RedisError -> String
RedisError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
displayException :: RedisError -> String
$cdisplayException :: RedisError -> String
fromException :: SomeException -> Maybe RedisError
$cfromException :: SomeException -> Maybe RedisError
toException :: RedisError -> SomeException
$ctoException :: RedisError -> SomeException
$cp2Exception :: Show RedisError
$cp1Exception :: Typeable RedisError
Exception)

makeKey :: RedisStoreConfig -> Text -> ByteString
makeKey :: RedisStoreConfig -> Text -> ByteString
makeKey config :: RedisStoreConfig
config key :: Text
key = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [RedisStoreConfig -> Text
namespace RedisStoreConfig
config, ":", Text
key]

exceptOnReply :: (MonadIO m) => Either Reply a -> m a
exceptOnReply :: Either Reply a -> m a
exceptOnReply = \case
    Left err :: Reply
err -> IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ RedisError -> IO a
forall e a. Exception e => e -> IO a
throwIO (RedisError -> IO a) -> RedisError -> IO a
forall a b. (a -> b) -> a -> b
$ Text -> RedisError
RedisError (Text -> RedisError) -> Text -> RedisError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Reply -> String
forall a. Show a => a -> String
show Reply
err
    Right x :: a
x -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

run :: RedisStoreConfig -> Redis a -> StoreResult a
run :: RedisStoreConfig -> Redis a -> StoreResult a
run config :: RedisStoreConfig
config action :: Redis a
action =
    StoreResult a -> [Handler IO (Either Text a)] -> StoreResult a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadCatch m) =>
m a -> f (Handler m a) -> m a
catches
        (Connection -> Redis a -> IO a
forall a. Connection -> Redis a -> IO a
runRedis (RedisStoreConfig -> Connection
connection RedisStoreConfig
config) Redis a
action IO a -> (a -> Either Text a) -> StoreResult a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
        [ (ConnectionLostException -> StoreResult a)
-> Handler IO (Either Text a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((ConnectionLostException -> StoreResult a)
 -> Handler IO (Either Text a))
-> (ConnectionLostException -> StoreResult a)
-> Handler IO (Either Text a)
forall a b. (a -> b) -> a -> b
$ \(ConnectionLostException
e :: ConnectionLostException) -> Either Text a -> StoreResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text a -> StoreResult a) -> Either Text a -> StoreResult a
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ConnectionLostException -> String
forall a. Show a => a -> String
show ConnectionLostException
e
        , (RedisError -> StoreResult a) -> Handler IO (Either Text a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((RedisError -> StoreResult a) -> Handler IO (Either Text a))
-> (RedisError -> StoreResult a) -> Handler IO (Either Text a)
forall a b. (a -> b) -> a -> b
$ \(RedisError err :: Text
err) -> Either Text a -> StoreResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text a -> StoreResult a) -> Either Text a -> StoreResult a
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a b. a -> Either a b
Left Text
err
        ]

createSerializedItemDescriptor :: ByteString -> SerializedItemDescriptor
createSerializedItemDescriptor :: ByteString -> SerializedItemDescriptor
createSerializedItemDescriptor byteString :: ByteString
byteString = Maybe ByteString -> Natural -> Bool -> SerializedItemDescriptor
SerializedItemDescriptor (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
byteString) 0 Bool
False

redisInitialize :: RedisStoreConfig -> KeyMap (KeyMap SerializedItemDescriptor) -> StoreResult ()
redisInitialize :: RedisStoreConfig
-> KeyMap (KeyMap SerializedItemDescriptor) -> StoreResult ()
redisInitialize config :: RedisStoreConfig
config values :: KeyMap (KeyMap SerializedItemDescriptor)
values = RedisStoreConfig -> Redis () -> StoreResult ()
forall a. RedisStoreConfig -> Redis a -> StoreResult a
run RedisStoreConfig
config (Redis () -> StoreResult ()) -> Redis () -> StoreResult ()
forall a b. (a -> b) -> a -> b
$ do
    [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
del ((Text -> ByteString) -> [Text] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (RedisStoreConfig -> Text -> ByteString
makeKey RedisStoreConfig
config) ([Text] -> [ByteString]) -> [Text] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ KeyMap (KeyMap SerializedItemDescriptor) -> [Text]
forall v. HashMap Text v -> [Text]
objectKeys KeyMap (KeyMap SerializedItemDescriptor)
values) Redis (Either Reply Integer)
-> (Either Reply Integer -> Redis ()) -> Redis ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Redis Integer -> Redis ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Redis Integer -> Redis ())
-> (Either Reply Integer -> Redis Integer)
-> Either Reply Integer
-> Redis ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Reply Integer -> Redis Integer
forall (m :: * -> *) a. MonadIO m => Either Reply a -> m a
exceptOnReply
    [(Text, KeyMap SerializedItemDescriptor)]
-> ((Text, KeyMap SerializedItemDescriptor) -> Redis ())
-> Redis ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (KeyMap (KeyMap SerializedItemDescriptor)
-> [(Text, KeyMap SerializedItemDescriptor)]
forall v. HashMap Text v -> [(Text, v)]
toList KeyMap (KeyMap SerializedItemDescriptor)
values) (((Text, KeyMap SerializedItemDescriptor) -> Redis ()) -> Redis ())
-> ((Text, KeyMap SerializedItemDescriptor) -> Redis ())
-> Redis ()
forall a b. (a -> b) -> a -> b
$ \(kind :: Text
kind, features :: KeyMap SerializedItemDescriptor
features) -> [(Text, SerializedItemDescriptor)]
-> ((Text, SerializedItemDescriptor) -> Redis ()) -> Redis ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (KeyMap SerializedItemDescriptor
-> [(Text, SerializedItemDescriptor)]
forall v. HashMap Text v -> [(Text, v)]
toList KeyMap SerializedItemDescriptor
features) (((Text, SerializedItemDescriptor) -> Redis ()) -> Redis ())
-> ((Text, SerializedItemDescriptor) -> Redis ()) -> Redis ()
forall a b. (a -> b) -> a -> b
$ \(key :: Text
key, feature :: SerializedItemDescriptor
feature) ->
        ByteString -> ByteString -> ByteString -> Redis (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Bool)
hset (RedisStoreConfig -> Text -> ByteString
makeKey RedisStoreConfig
config Text
kind) (Text -> ByteString
encodeUtf8 Text
key) (SerializedItemDescriptor -> ByteString
serializeWithPlaceholder SerializedItemDescriptor
feature) Redis (Either Reply Bool)
-> (Either Reply Bool -> Redis ()) -> Redis ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Redis Bool -> Redis ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Redis Bool -> Redis ())
-> (Either Reply Bool -> Redis Bool)
-> Either Reply Bool
-> Redis ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Reply Bool -> Redis Bool
forall (m :: * -> *) a. MonadIO m => Either Reply a -> m a
exceptOnReply
    ByteString -> ByteString -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
set (RedisStoreConfig -> Text -> ByteString
makeKey RedisStoreConfig
config "$inited") "" Redis (Either Reply Status)
-> (Either Reply Status -> Redis ()) -> Redis ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Redis Status -> Redis ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Redis Status -> Redis ())
-> (Either Reply Status -> Redis Status)
-> Either Reply Status
-> Redis ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Reply Status -> Redis Status
forall (m :: * -> *) a. MonadIO m => Either Reply a -> m a
exceptOnReply

redisUpsert :: RedisStoreConfig -> Text -> Text -> SerializedItemDescriptor -> StoreResult Bool
redisUpsert :: RedisStoreConfig
-> Text -> Text -> SerializedItemDescriptor -> StoreResult Bool
redisUpsert = IO ()
-> RedisStoreConfig
-> Text
-> Text
-> SerializedItemDescriptor
-> StoreResult Bool
redisUpsertInternal (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

redisUpsertInternal :: IO () -> RedisStoreConfig -> Text -> Text -> SerializedItemDescriptor -> StoreResult Bool
redisUpsertInternal :: IO ()
-> RedisStoreConfig
-> Text
-> Text
-> SerializedItemDescriptor
-> StoreResult Bool
redisUpsertInternal hook :: IO ()
hook config :: RedisStoreConfig
config kind :: Text
kind key :: Text
key opaque :: SerializedItemDescriptor
opaque = RedisStoreConfig -> Redis Bool -> StoreResult Bool
forall a. RedisStoreConfig -> Redis a -> StoreResult a
run RedisStoreConfig
config Redis Bool
tryUpsert
  where
    tryUpsert :: Redis Bool
tryUpsert =
        [ByteString] -> Redis (Either Reply Status)
watch [ByteString
space]
            Redis (Either Reply Status)
-> (Either Reply Status -> Redis ()) -> Redis ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Redis Status -> Redis ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Redis Status -> Redis ())
-> (Either Reply Status -> Redis Status)
-> Either Reply Status
-> Redis ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Reply Status -> Redis Status
forall (m :: * -> *) a. MonadIO m => Either Reply a -> m a
exceptOnReply
            Redis ()
-> Redis (Either Reply (Maybe ByteString))
-> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe ByteString))
hget ByteString
space (Text -> ByteString
encodeUtf8 Text
key)
            Redis (Either Reply (Maybe ByteString))
-> (Either Reply (Maybe ByteString) -> Redis (Maybe ByteString))
-> Redis (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Reply (Maybe ByteString) -> Redis (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => Either Reply a -> m a
exceptOnReply
            Redis (Maybe ByteString)
-> (Maybe ByteString -> Redis Bool) -> Redis Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x :: Maybe ByteString
x ->
                IO () -> Redis ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
hook Redis () -> Redis Bool -> Redis Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case Maybe ByteString
x of
                    Nothing -> Redis Bool
doInsert
                    (Just byteString :: ByteString
byteString) -> case ByteString -> Maybe VersionedData
byteStringToVersionedData ByteString
byteString of
                        Nothing -> Bool -> Redis Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                        Just decodedVersion :: VersionedData
decodedVersion ->
                            if VersionedData -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" VersionedData
decodedVersion Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= SerializedItemDescriptor -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" SerializedItemDescriptor
opaque
                                then Bool -> Redis Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                                else Redis Bool
doInsert
    space :: ByteString
space = RedisStoreConfig -> Text -> ByteString
makeKey RedisStoreConfig
config Text
kind
    doInsert :: Redis Bool
doInsert =
        RedisTx (Queued Bool) -> Redis (TxResult Bool)
forall a. RedisTx (Queued a) -> Redis (TxResult a)
multiExec (ByteString -> ByteString -> ByteString -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Bool)
hset ByteString
space (Text -> ByteString
encodeUtf8 Text
key) (SerializedItemDescriptor -> ByteString
serializeWithPlaceholder SerializedItemDescriptor
opaque)) Redis (TxResult Bool)
-> (TxResult Bool -> Redis Bool) -> Redis Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            TxSuccess _ -> Bool -> Redis Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            TxError err :: String
err -> IO Bool -> Redis Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Redis Bool) -> IO Bool -> Redis Bool
forall a b. (a -> b) -> a -> b
$ RedisError -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (RedisError -> IO Bool) -> RedisError -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> RedisError
RedisError (Text -> RedisError) -> Text -> RedisError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
err
            TxAborted -> Redis Bool
tryUpsert

redisGetFeature :: RedisStoreConfig -> Text -> Text -> StoreResult (Maybe SerializedItemDescriptor)
redisGetFeature :: RedisStoreConfig
-> Text -> Text -> StoreResult (Maybe SerializedItemDescriptor)
redisGetFeature config :: RedisStoreConfig
config kind :: Text
kind key :: Text
key =
    RedisStoreConfig
-> Redis (Maybe SerializedItemDescriptor)
-> StoreResult (Maybe SerializedItemDescriptor)
forall a. RedisStoreConfig -> Redis a -> StoreResult a
run RedisStoreConfig
config (Redis (Maybe SerializedItemDescriptor)
 -> StoreResult (Maybe SerializedItemDescriptor))
-> Redis (Maybe SerializedItemDescriptor)
-> StoreResult (Maybe SerializedItemDescriptor)
forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe ByteString))
hget (RedisStoreConfig -> Text -> ByteString
makeKey RedisStoreConfig
config Text
kind) (Text -> ByteString
encodeUtf8 Text
key)
            Redis (Either Reply (Maybe ByteString))
-> (Either Reply (Maybe ByteString) -> Redis (Maybe ByteString))
-> Redis (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Reply (Maybe ByteString) -> Redis (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => Either Reply a -> m a
exceptOnReply
            Redis (Maybe ByteString)
-> (Maybe ByteString -> Redis (Maybe SerializedItemDescriptor))
-> Redis (Maybe SerializedItemDescriptor)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \result :: Maybe ByteString
result -> Maybe SerializedItemDescriptor
-> Redis (Maybe SerializedItemDescriptor)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SerializedItemDescriptor
 -> Redis (Maybe SerializedItemDescriptor))
-> Maybe SerializedItemDescriptor
-> Redis (Maybe SerializedItemDescriptor)
forall a b. (a -> b) -> a -> b
$ ByteString -> SerializedItemDescriptor
createSerializedItemDescriptor (ByteString -> SerializedItemDescriptor)
-> Maybe ByteString -> Maybe SerializedItemDescriptor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
result

redisIsInitialized :: RedisStoreConfig -> StoreResult Bool
redisIsInitialized :: RedisStoreConfig -> StoreResult Bool
redisIsInitialized config :: RedisStoreConfig
config =
    RedisStoreConfig -> Redis Bool -> StoreResult Bool
forall a. RedisStoreConfig -> Redis a -> StoreResult a
run RedisStoreConfig
config (Redis Bool -> StoreResult Bool) -> Redis Bool -> StoreResult Bool
forall a b. (a -> b) -> a -> b
$ (ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
get (RedisStoreConfig -> Text -> ByteString
makeKey RedisStoreConfig
config "$inited") Redis (Either Reply (Maybe ByteString))
-> (Either Reply (Maybe ByteString) -> Redis (Maybe ByteString))
-> Redis (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Reply (Maybe ByteString) -> Redis (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => Either Reply a -> m a
exceptOnReply) Redis (Maybe ByteString)
-> (Maybe ByteString -> Bool) -> Redis Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe ByteString -> Bool
forall a. Maybe a -> Bool
isJust

redisGetAll :: RedisStoreConfig -> Text -> StoreResult (KeyMap SerializedItemDescriptor)
redisGetAll :: RedisStoreConfig
-> Text -> StoreResult (KeyMap SerializedItemDescriptor)
redisGetAll config :: RedisStoreConfig
config kind :: Text
kind =
    RedisStoreConfig
-> Redis (KeyMap SerializedItemDescriptor)
-> StoreResult (KeyMap SerializedItemDescriptor)
forall a. RedisStoreConfig -> Redis a -> StoreResult a
run RedisStoreConfig
config (Redis (KeyMap SerializedItemDescriptor)
 -> StoreResult (KeyMap SerializedItemDescriptor))
-> Redis (KeyMap SerializedItemDescriptor)
-> StoreResult (KeyMap SerializedItemDescriptor)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Redis (Either Reply [(ByteString, ByteString)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [(ByteString, ByteString)])
hgetall (RedisStoreConfig -> Text -> ByteString
makeKey RedisStoreConfig
config Text
kind) Redis (Either Reply [(ByteString, ByteString)])
-> (Either Reply [(ByteString, ByteString)]
    -> Redis [(ByteString, ByteString)])
-> Redis [(ByteString, ByteString)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Reply [(ByteString, ByteString)]
-> Redis [(ByteString, ByteString)]
forall (m :: * -> *) a. MonadIO m => Either Reply a -> m a
exceptOnReply) Redis [(ByteString, ByteString)]
-> ([(ByteString, ByteString)] -> KeyMap SerializedItemDescriptor)
-> Redis (KeyMap SerializedItemDescriptor)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((ByteString -> SerializedItemDescriptor)
-> HashMap Text ByteString -> KeyMap SerializedItemDescriptor
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues ByteString -> SerializedItemDescriptor
createSerializedItemDescriptor (HashMap Text ByteString -> KeyMap SerializedItemDescriptor)
-> ([(ByteString, ByteString)] -> HashMap Text ByteString)
-> [(ByteString, ByteString)]
-> KeyMap SerializedItemDescriptor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, ByteString)] -> HashMap Text ByteString
forall v. [(Text, v)] -> KeyMap v
fromList ([(Text, ByteString)] -> HashMap Text ByteString)
-> ([(ByteString, ByteString)] -> [(Text, ByteString)])
-> [(ByteString, ByteString)]
-> HashMap Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString) -> (Text, ByteString))
-> [(ByteString, ByteString)] -> [(Text, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> Text)
-> (ByteString, ByteString) -> (Text, ByteString)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByteString -> Text
decodeUtf8))