module Database.Redis.Config
( RedisConfig(..)
, connectRedis
) where
import Control.Applicative
import Data.Aeson
import Data.Scientific
import Data.Time
import Database.Redis
import qualified Data.Aeson.Types as A
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text.Encoding as T
newtype RedisConfig =
RedisConfig
{ getConnectInfo :: ConnectInfo
}
parsePort :: Object -> A.Parser (Maybe PortID)
parsePort o =
optional
$ fmap (\a -> PortNumber $ floor (a :: Scientific)) (o .: "port")
<|> fmap UnixSocket (o .: "socket")
<|> fmap Service (o .: "service")
parsePassword :: Object -> A.Parser (Maybe BS.ByteString)
parsePassword o = do
mp <- o .:? "password"
pure $ case mp of
Nothing -> Nothing
Just "" -> Nothing
Just ps -> Just $ T.encodeUtf8 ps
realToFrac' :: Scientific -> NominalDiffTime
realToFrac' = realToFrac
parseTimeout :: Object -> A.Parser (Maybe (Maybe NominalDiffTime))
parseTimeout o = o .:? "timeout" >>= \mt -> pure (pure (realToFrac' <$> mt))
instance FromJSON RedisConfig where
parseJSON v = RedisConfig <$> withObject "RedisConfig" go v
where
go o =
ConnInfo
<$> o .:? "host" .!= connectHost defaultConnectInfo
<*> parsePort o .!= connectPort defaultConnectInfo
<*> parsePassword o
<*> o .:? "database" .!= connectDatabase defaultConnectInfo
<*> o .:? "max-connections" .!= connectMaxConnections defaultConnectInfo
<*> fmap (fmap realToFrac') (o .:? "max-idle-time") .!= connectMaxIdleTime defaultConnectInfo
<*> parseTimeout o .!= connectTimeout defaultConnectInfo
connectRedis :: RedisConfig -> IO Connection
connectRedis = connect . getConnectInfo