{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Haxl.RedisConfig
( RedisConfig (..)
, genRedisConnection
, defaultRedisConfig
) where
import Data.Aeson (FromJSON, parseJSON, withObject, (.!=), (.:?))
import Data.String (fromString)
import Data.Time (NominalDiffTime)
import Database.Redis (ConnectInfo (..), Connection,
PortID (PortNumber), connect,
defaultConnectInfo)
data RedisConfig = RedisConfig
{ RedisConfig -> String
redisHost :: String
, RedisConfig -> Int
redisPort :: Int
, RedisConfig -> String
redisAuth :: String
, RedisConfig -> Integer
redisDB :: Integer
, RedisConfig -> Int
redisMaxConnections :: Int
, RedisConfig -> NominalDiffTime
redisMaxIdleTime :: NominalDiffTime
, RedisConfig -> Bool
redisEnable :: Bool
, RedisConfig -> Int
redisHaxlNumThreads :: Int
}
deriving (Int -> RedisConfig -> ShowS
[RedisConfig] -> ShowS
RedisConfig -> String
(Int -> RedisConfig -> ShowS)
-> (RedisConfig -> String)
-> ([RedisConfig] -> ShowS)
-> Show RedisConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedisConfig] -> ShowS
$cshowList :: [RedisConfig] -> ShowS
show :: RedisConfig -> String
$cshow :: RedisConfig -> String
showsPrec :: Int -> RedisConfig -> ShowS
$cshowsPrec :: Int -> RedisConfig -> ShowS
Show)
instance FromJSON RedisConfig where
parseJSON :: Value -> Parser RedisConfig
parseJSON = String
-> (Object -> Parser RedisConfig) -> Value -> Parser RedisConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "RedisConfig" ((Object -> Parser RedisConfig) -> Value -> Parser RedisConfig)
-> (Object -> Parser RedisConfig) -> Value -> Parser RedisConfig
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
Integer
redisDB <- Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "db" Parser (Maybe Integer) -> Integer -> Parser Integer
forall a. Parser (Maybe a) -> a -> Parser a
.!= 0
String
redisHost <- Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "host" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= "127.0.0.1"
Int
redisPort <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "port" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= 6379
String
redisAuth <- Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "auth" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= ""
Bool
redisEnable <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "enable" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
Int
redisMaxConnections <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "maxConnections" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= 50
NominalDiffTime
redisMaxIdleTime <- Object
o Object -> Text -> Parser (Maybe NominalDiffTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "idleTime" Parser (Maybe NominalDiffTime)
-> NominalDiffTime -> Parser NominalDiffTime
forall a. Parser (Maybe a) -> a -> Parser a
.!= 30
Int
redisHaxlNumThreads <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "numThreads" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= 1
RedisConfig -> Parser RedisConfig
forall (m :: * -> *) a. Monad m => a -> m a
return RedisConfig :: String
-> Int
-> String
-> Integer
-> Int
-> NominalDiffTime
-> Bool
-> Int
-> RedisConfig
RedisConfig{..}
defaultRedisConfig :: RedisConfig
defaultRedisConfig :: RedisConfig
defaultRedisConfig = RedisConfig :: String
-> Int
-> String
-> Integer
-> Int
-> NominalDiffTime
-> Bool
-> Int
-> RedisConfig
RedisConfig
{ redisHost :: String
redisHost = "127.0.0.1"
, redisPort :: Int
redisPort = 6379
, redisAuth :: String
redisAuth = ""
, redisDB :: Integer
redisDB = 0
, redisMaxConnections :: Int
redisMaxConnections = 50
, redisMaxIdleTime :: NominalDiffTime
redisMaxIdleTime = 30
, redisHaxlNumThreads :: Int
redisHaxlNumThreads = 1
, redisEnable :: Bool
redisEnable = Bool
False
}
genRedisConnection :: RedisConfig -> IO (Maybe Connection)
genRedisConnection :: RedisConfig -> IO (Maybe Connection)
genRedisConnection conf :: RedisConfig
conf =
if Bool
enable then do
Connection
conn <- ConnectInfo -> IO Connection
connect (ConnectInfo -> IO Connection) -> ConnectInfo -> IO Connection
forall a b. (a -> b) -> a -> b
$ ConnectInfo
defaultConnectInfo
{ connectHost :: String
connectHost = String
h
, connectPort :: PortID
connectPort = PortNumber -> PortID
PortNumber PortNumber
p
, connectAuth :: Maybe ByteString
connectAuth = Maybe ByteString
auth
, connectDatabase :: Integer
connectDatabase = Integer
db
, connectMaxConnections :: Int
connectMaxConnections = Int
maxConnections
, connectMaxIdleTime :: NominalDiffTime
connectMaxIdleTime = NominalDiffTime
maxIdleTime
}
Maybe Connection -> IO (Maybe Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
conn)
else Maybe Connection -> IO (Maybe Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Connection
forall a. Maybe a
Nothing
where db :: Integer
db = RedisConfig -> Integer
redisDB RedisConfig
conf
h :: String
h = RedisConfig -> String
redisHost RedisConfig
conf
p :: PortNumber
p = Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> PortNumber) -> Int -> PortNumber
forall a b. (a -> b) -> a -> b
$ RedisConfig -> Int
redisPort RedisConfig
conf
enable :: Bool
enable = RedisConfig -> Bool
redisEnable RedisConfig
conf
maxConnections :: Int
maxConnections = RedisConfig -> Int
redisMaxConnections RedisConfig
conf
maxIdleTime :: NominalDiffTime
maxIdleTime = RedisConfig -> NominalDiffTime
redisMaxIdleTime RedisConfig
conf
auth :: Maybe ByteString
auth = if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RedisConfig -> String
redisAuth RedisConfig
conf)) then
ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString (RedisConfig -> String
redisAuth RedisConfig
conf) else Maybe ByteString
forall a. Maybe a
Nothing