module Database.Redis.Envy
( connectInfoFromEnv
, connectInfoFromEnvWithDefault
, parsePortId
) where
import Data.Foldable (asum)
import Data.Scientific (Scientific)
import Data.Time (NominalDiffTime)
import Data.Typeable (Typeable)
import qualified Database.Redis as R
import System.Envy (Parser, Var, env, envMaybe, fromVar, toVar,
(.!=))
import Text.Read (readMaybe)
newtype ReadShowVar a = ReadShowVar { unReadShowVar :: a }
instance (Typeable a, Show a, Read a) => Var (ReadShowVar a) where
toVar = show . unReadShowVar
fromVar = fmap ReadShowVar . readMaybe
connectInfoFromEnv :: Parser R.ConnectInfo
connectInfoFromEnv = connectInfoFromEnvWithDefault R.defaultConnectInfo
connectInfoFromEnvWithDefault :: R.ConnectInfo -> Parser R.ConnectInfo
connectInfoFromEnvWithDefault def = R.ConnInfo
<$> envMaybe "REDIS_HOST" .!= R.connectHost def
<*> pPortId
<*> env "REDIS_AUTH" .!= R.connectAuth def
<*> envMaybe "REDIS_DATABASE_INDEX" .!= R.connectDatabase def
<*> envMaybe "REDIS_MAX_CONNECTIONS" .!= R.connectMaxConnections def
<*>
(fmap nominalDiffTimeFromVal <$> envMaybe "REDIS_MAX_IDLE_TIME")
.!= R.connectMaxIdleTime def
<*> timeout
<*> pure (R.connectTLSParams def)
where
nominalDiffTimeFromVal :: ReadShowVar Scientific -> NominalDiffTime
nominalDiffTimeFromVal = realToFrac . unReadShowVar
timeout :: Parser (Maybe NominalDiffTime)
timeout =
maybe
(R.connectTimeout def)
(Just . nominalDiffTimeFromVal)
<$> envMaybe "REDIS_TIMEOUT"
pPortId =
maybe
(pure (R.connectPort def))
parsePortId
=<< envMaybe "REDIS_PORT_ID"
parsePortId
:: String
-> Parser R.PortID
parsePortId envVarVal = maybe (fail emsg) pure $ asum
[ R.PortNumber <$> readMaybe envVarVal
, R.UnixSocket <$> parsePath envVarVal
]
where
parsePath path@('/': _) = Just path
parsePath _other = Nothing
emsg =
"The value of PortID must be a number (TCP port), or an absolute path to the UNIX domain socket!"