module Redis.Settings
( Settings (..),
ClusterMode (..),
DefaultExpiry (..),
QueryTimeout (..),
MaxKeySize (..),
decoder,
decoderWithEnvVarPrefix,
)
where
import Database.Redis hiding (Ok)
import qualified Environment
import qualified Text
import Prelude (Either (Left, Right))
data ClusterMode = Cluster | NotCluster
data Settings = Settings
{
Settings -> ConnectInfo
connectionInfo :: ConnectInfo,
Settings -> ClusterMode
clusterMode :: ClusterMode,
Settings -> DefaultExpiry
defaultExpiry :: DefaultExpiry,
Settings -> QueryTimeout
queryTimeout :: QueryTimeout,
Settings -> MaxKeySize
maxKeySize :: MaxKeySize
}
data MaxKeySize = NoMaxKeySize | MaxKeySize Int
data DefaultExpiry = NoDefaultExpiry | ExpireKeysAfterSeconds Int
data QueryTimeout = NoQueryTimeout | TimeoutQueryAfterMilliseconds Int
decoder :: Environment.Decoder Settings
decoder :: Decoder Settings
decoder =
Text -> Decoder Settings
decoderWithEnvVarPrefix Text
""
decoderWithEnvVarPrefix :: Text -> Environment.Decoder Settings
decoderWithEnvVarPrefix :: Text -> Decoder Settings
decoderWithEnvVarPrefix Text
prefix =
(ConnectInfo
-> ClusterMode
-> DefaultExpiry
-> QueryTimeout
-> MaxKeySize
-> Settings)
-> Decoder ConnectInfo
-> Decoder ClusterMode
-> Decoder DefaultExpiry
-> Decoder QueryTimeout
-> Decoder MaxKeySize
-> Decoder Settings
forall (m :: * -> *) a b c d e value.
Applicative m =>
(a -> b -> c -> d -> e -> value)
-> m a -> m b -> m c -> m d -> m e -> m value
map5
ConnectInfo
-> ClusterMode
-> DefaultExpiry
-> QueryTimeout
-> MaxKeySize
-> Settings
Settings
(Text -> Decoder ConnectInfo
decoderConnectInfo Text
prefix)
(Text -> Decoder ClusterMode
decoderClusterMode Text
prefix)
(Text -> Decoder DefaultExpiry
decoderDefaultExpiry Text
prefix)
(Text -> Decoder QueryTimeout
decoderQueryTimeout Text
prefix)
(Text -> Decoder MaxKeySize
decoderMaxKeySize Text
prefix)
decoderClusterMode :: Text -> Environment.Decoder ClusterMode
decoderClusterMode :: Text -> Decoder ClusterMode
decoderClusterMode Text
prefix =
Variable -> Parser ClusterMode -> Decoder ClusterMode
forall a. Variable -> Parser a -> Decoder a
Environment.variable
Variable :: Text -> Text -> Text -> Variable
Environment.Variable
{ name :: Text
Environment.name = Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"REDIS_CLUSTER",
description :: Text
Environment.description = Text
"Set to 1 for cluster, everything else is not",
defaultValue :: Text
Environment.defaultValue = Text
"0"
}
( Parser Text
-> (Text -> Result Text ClusterMode) -> Parser ClusterMode
forall a b. Parser a -> (a -> Result Text b) -> Parser b
Environment.custom
Parser Text
Environment.text
( \Text
str ->
if Text -> Text
Text.trim Text
str Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"1"
then ClusterMode -> Result Text ClusterMode
forall error value. value -> Result error value
Ok ClusterMode
Cluster
else ClusterMode -> Result Text ClusterMode
forall error value. value -> Result error value
Ok ClusterMode
NotCluster
)
)
decoderConnectInfo :: Text -> Environment.Decoder ConnectInfo
decoderConnectInfo :: Text -> Decoder ConnectInfo
decoderConnectInfo Text
prefix =
Variable -> Parser ConnectInfo -> Decoder ConnectInfo
forall a. Variable -> Parser a -> Decoder a
Environment.variable
Variable :: Text -> Text -> Text -> Variable
Environment.Variable
{ name :: Text
Environment.name = Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"REDIS_CONNECTION_STRING",
description :: Text
Environment.description = Text
"Full redis connection string",
defaultValue :: Text
Environment.defaultValue = Text
"redis://localhost:6379"
}
( Parser Text
-> (Text -> Result Text ConnectInfo) -> Parser ConnectInfo
forall a b. Parser a -> (a -> Result Text b) -> Parser b
Environment.custom
Parser Text
Environment.text
( \Text
str ->
case Text
str Text -> (Text -> List Char) -> List Char
forall a b. a -> (a -> b) -> b
|> Text -> List Char
Text.toList List Char
-> (List Char -> Either (List Char) ConnectInfo)
-> Either (List Char) ConnectInfo
forall a b. a -> (a -> b) -> b
|> List Char -> Either (List Char) ConnectInfo
parseConnectInfo of
Right ConnectInfo
info' -> ConnectInfo -> Result Text ConnectInfo
forall error value. value -> Result error value
Ok ConnectInfo
info'
Left List Char
parseError -> Text -> Result Text ConnectInfo
forall error value. error -> Result error value
Err (Text
"Invalid Redis connection string: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ List Char -> Text
Text.fromList List Char
parseError)
)
)
decoderDefaultExpiry :: Text -> Environment.Decoder DefaultExpiry
decoderDefaultExpiry :: Text -> Decoder DefaultExpiry
decoderDefaultExpiry Text
prefix =
Variable -> Parser Int64 -> Decoder Int64
forall a. Variable -> Parser a -> Decoder a
Environment.variable
Variable :: Text -> Text -> Text -> Variable
Environment.Variable
{ name :: Text
Environment.name = Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"REDIS_DEFAULT_EXPIRY_SECONDS",
description :: Text
Environment.description = Text
"Set a default amount of seconds after which all keys touched by this handler will expire. The expire time of a key is reset every time it is read or written. A value of 0 means no default expiry.",
defaultValue :: Text
Environment.defaultValue = Text
"0"
}
Parser Int64
forall a. Integral a => Parser a
Environment.int
Decoder Int64
-> (Decoder Int64 -> Decoder DefaultExpiry)
-> Decoder DefaultExpiry
forall a b. a -> (a -> b) -> b
|> (Int64 -> DefaultExpiry) -> Decoder Int64 -> Decoder DefaultExpiry
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map
( \Int64
secs ->
if Int64
secs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
then DefaultExpiry
NoDefaultExpiry
else Int64 -> DefaultExpiry
ExpireKeysAfterSeconds Int64
secs
)
decoderQueryTimeout :: Text -> Environment.Decoder QueryTimeout
decoderQueryTimeout :: Text -> Decoder QueryTimeout
decoderQueryTimeout Text
prefix =
Variable -> Parser QueryTimeout -> Decoder QueryTimeout
forall a. Variable -> Parser a -> Decoder a
Environment.variable
Variable :: Text -> Text -> Text -> Variable
Environment.Variable
{ name :: Text
Environment.name = Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"REDIS_QUERY_TIMEOUT_MILLISECONDS",
description :: Text
Environment.description = Text
"0 means no timeout, every other value is a timeout in milliseconds.",
defaultValue :: Text
Environment.defaultValue = Text
"1000"
}
( Parser Int64
-> (Int64 -> Result Text QueryTimeout) -> Parser QueryTimeout
forall a b. Parser a -> (a -> Result Text b) -> Parser b
Environment.custom
Parser Int64
forall a. Integral a => Parser a
Environment.int
( \Int64
milliseconds ->
if Int64
milliseconds Int64 -> Int64 -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
<= Int64
0
then QueryTimeout -> Result Text QueryTimeout
forall error value. value -> Result error value
Ok QueryTimeout
NoQueryTimeout
else QueryTimeout -> Result Text QueryTimeout
forall error value. value -> Result error value
Ok (Int64 -> QueryTimeout
TimeoutQueryAfterMilliseconds Int64
milliseconds)
)
)
decoderMaxKeySize :: Text -> Environment.Decoder MaxKeySize
decoderMaxKeySize :: Text -> Decoder MaxKeySize
decoderMaxKeySize Text
prefix =
Variable -> Parser MaxKeySize -> Decoder MaxKeySize
forall a. Variable -> Parser a -> Decoder a
Environment.variable
Variable :: Text -> Text -> Text -> Variable
Environment.Variable
{ name :: Text
Environment.name = Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"REDIS_MAX_KEY_SIZE",
description :: Text
Environment.description = Text
"0 means no max key size, every other value is a max key size.",
defaultValue :: Text
Environment.defaultValue = Text
"0"
}
( Parser Int64
-> (Int64 -> Result Text MaxKeySize) -> Parser MaxKeySize
forall a b. Parser a -> (a -> Result Text b) -> Parser b
Environment.custom
Parser Int64
forall a. Integral a => Parser a
Environment.int
( \Int64
maxKeySize ->
if Int64
maxKeySize Int64 -> Int64 -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
<= Int64
0
then MaxKeySize -> Result Text MaxKeySize
forall error value. value -> Result error value
Ok MaxKeySize
NoMaxKeySize
else MaxKeySize -> Result Text MaxKeySize
forall error value. value -> Result error value
Ok (Int64 -> MaxKeySize
MaxKeySize Int64
maxKeySize)
)
)