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

-- | Settings required to initiate a redis connection.
data Settings = Settings
  { -- | Full redis connection string.
    --
    -- Default env var name is REDIS_CONNECTION_STRING
    -- default is "redis://localhost:6379"
    Settings -> ConnectInfo
connectionInfo :: ConnectInfo,
    -- | Set to 1 for cluster, everything else is not.
    --
    -- Default env var name is REDIS_CLUSTER
    -- Default is 0
    Settings -> ClusterMode
clusterMode :: ClusterMode,
    -- | 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.
    --
    -- Default env var name is REDIS_DEFAULT_EXPIRY_SECONDS
    -- default is 0
    Settings -> DefaultExpiry
defaultExpiry :: DefaultExpiry,
    -- | 0 means no timeout, every other value is a timeout in milliseconds.
    --
    -- Default env var name is REDIS_QUERY_TIMEOUT_MILLISECONDS
    -- default is 1000
    Settings -> QueryTimeout
queryTimeout :: QueryTimeout,
    Settings -> MaxKeySize
maxKeySize :: MaxKeySize
  }

data MaxKeySize = NoMaxKeySize | MaxKeySize Int

data DefaultExpiry = NoDefaultExpiry | ExpireKeysAfterSeconds Int

data QueryTimeout = NoQueryTimeout | TimeoutQueryAfterMilliseconds Int

-- | decodes Settings from environmental variables
decoder :: Environment.Decoder Settings
decoder :: Decoder Settings
decoder =
  Text -> Decoder Settings
decoderWithEnvVarPrefix Text
""

-- | decodes Settings from environmental variables prefixed with a Text
-- >>> decoderWithEnvVarPrefix "WORKER_"
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)
        )
    )