{-# 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
  -- ^ Each connection will 'select' the database with the given index.
  , RedisConfig -> Int
redisMaxConnections :: Int
  -- ^ Maximum number of connections to keep open. The smallest acceptable
  --   value is 1.
  , RedisConfig -> NominalDiffTime
redisMaxIdleTime    :: NominalDiffTime
  -- ^ Amount of time for which an unused connection is kept open. The
  --   smallest acceptable value is 0.5 seconds. If the @timeout@ value in
  --   your redis.conf file is non-zero, it should be larger than
  --   'redisMaxIdleTime'.
  , RedisConfig -> Bool
redisEnable         :: Bool
  , RedisConfig -> Int
redisHaxlNumThreads :: Int
  -- numThreads of fetch async for haxl
  }
  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