{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.ZRE.Config where

import System.Environment
import System.Directory
import System.FilePath.Posix
import System.Exit (exitFailure)
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

import Network.ZRE.Types
import System.ZMQ4.Endpoint

import Data.Ini.Config
import Data.Default

iniParser :: IniParser ZRECfg
iniParser :: IniParser ZRECfg
iniParser = Text -> SectionParser ZRECfg -> IniParser ZRECfg
forall a. Text -> SectionParser a -> IniParser a
section "zre" (SectionParser ZRECfg -> IniParser ZRECfg)
-> SectionParser ZRECfg -> IniParser ZRECfg
forall a b. (a -> b) -> a -> b
$ do
  ByteString
zreNamed        <- String -> ByteString
B.pack (String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ByteString)
-> SectionParser Text -> SectionParser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> SectionParser Text
fieldDef "name" (String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ZRECfg -> ByteString
zreNamed ZRECfg
forall a. Default a => a
def)
  [ByteString]
zreInterfaces   <- Text
-> (Text -> Either String [ByteString])
-> [ByteString]
-> SectionParser [ByteString]
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf "interfaces" ([ByteString] -> Either String [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> Either String [ByteString])
-> (Text -> [ByteString]) -> Text -> Either String [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
B.pack ([String] -> [ByteString])
-> (Text -> [String]) -> Text -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) []
  Int
zreQuietPeriod  <- Text -> (Text -> Either String Int) -> Int -> SectionParser Int
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf "quiet-period"  ((Int -> Int) -> Either String Int -> Either String Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a. Num a => a -> a
isec (Either String Int -> Either String Int)
-> (Text -> Either String Int) -> Text -> Either String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Int
forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number) (ZRECfg -> Int
zreQuietPeriod ZRECfg
forall a. Default a => a
def)
  Int
zreDeadPeriod   <- Text -> (Text -> Either String Int) -> Int -> SectionParser Int
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf "dead-period"   ((Int -> Int) -> Either String Int -> Either String Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a. Num a => a -> a
isec (Either String Int -> Either String Int)
-> (Text -> Either String Int) -> Text -> Either String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Int
forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number) (ZRECfg -> Int
zreDeadPeriod ZRECfg
forall a. Default a => a
def)
  Int
zreBeaconPeriod <- Text -> (Text -> Either String Int) -> Int -> SectionParser Int
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf "beacon-period" ((Int -> Int) -> Either String Int -> Either String Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a. Num a => a -> a
isec (Either String Int -> Either String Int)
-> (Text -> Either String Int) -> Text -> Either String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Int
forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number) (ZRECfg -> Int
zreBeaconPeriod ZRECfg
forall a. Default a => a
def)
  Maybe Endpoint
zreZGossip      <- Text
-> (Text -> Either String (Maybe Endpoint))
-> Maybe Endpoint
-> SectionParser (Maybe Endpoint)
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf "gossip" ((Endpoint -> Maybe Endpoint)
-> Either String Endpoint -> Either String (Maybe Endpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just (Either String Endpoint -> Either String (Maybe Endpoint))
-> (Text -> Either String Endpoint)
-> Text
-> Either String (Maybe Endpoint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Endpoint
parseAttoTCPEndpoint (ByteString -> Either String Endpoint)
-> (Text -> ByteString) -> Text -> Either String Endpoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack (String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (ZRECfg -> Maybe Endpoint
zreZGossip ZRECfg
forall a. Default a => a
def)
  Endpoint
zreMCast        <- Text
-> (Text -> Either String Endpoint)
-> Endpoint
-> SectionParser Endpoint
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf "multicast-group" (ByteString -> Either String Endpoint
parseAttoTCPEndpoint (ByteString -> Either String Endpoint)
-> (Text -> ByteString) -> Text -> Either String Endpoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack (String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (ZRECfg -> Endpoint
zreMCast ZRECfg
forall a. Default a => a
def)
  Bool
zreDbg          <- Text -> (Text -> Either String Bool) -> Bool -> SectionParser Bool
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf "debug" Text -> Either String Bool
flag (ZRECfg -> Bool
zreDbg ZRECfg
forall a. Default a => a
def)
  ZRECfg -> SectionParser ZRECfg
forall (m :: * -> *) a. Monad m => a -> m a
return (ZRECfg -> SectionParser ZRECfg) -> ZRECfg -> SectionParser ZRECfg
forall a b. (a -> b) -> a -> b
$ ZRECfg :: ByteString
-> Int
-> Int
-> Int
-> [ByteString]
-> Endpoint
-> Maybe Endpoint
-> Bool
-> ZRECfg
ZRECfg {..}

parseZRECfg :: FilePath -> IO (Either String ZRECfg)
parseZRECfg :: String -> IO (Either String ZRECfg)
parseZRECfg fpath :: String
fpath = do
    Text
rs <- String -> IO Text
TIO.readFile String
fpath
    Either String ZRECfg -> IO (Either String ZRECfg)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ZRECfg -> IO (Either String ZRECfg))
-> Either String ZRECfg -> IO (Either String ZRECfg)
forall a b. (a -> b) -> a -> b
$ Text -> IniParser ZRECfg -> Either String ZRECfg
forall a. Text -> IniParser a -> Either String a
parseIniFile Text
rs IniParser ZRECfg
iniParser

-- If ZRECFG env var is set, try parsing config file it is pointing to,
-- return default config otherwise.
--
-- if ZRENAME env var is set, it overrides name field in ZRECFG config
-- or default config respectively.
envZRECfg :: IO (ZRECfg)
envZRECfg :: IO ZRECfg
envZRECfg = do
  Maybe String
menv <- String -> IO (Maybe String)
lookupEnv "ZRECFG"
  Maybe String
mname <- String -> IO (Maybe String)
lookupEnv "ZRENAME"
  case Maybe String
menv of
    Nothing -> do
      String
hom <- IO String
getHomeDirectory
      let homPth :: String
homPth = String
hom String -> String -> String
</> ".zre.conf"
      Bool
tst <- String -> IO Bool
doesFileExist String
homPth
      case Bool
tst of
        False -> ZRECfg -> IO ZRECfg
forall (m :: * -> *) a. Monad m => a -> m a
return (ZRECfg -> IO ZRECfg) -> ZRECfg -> IO ZRECfg
forall a b. (a -> b) -> a -> b
$ ZRECfg -> Maybe String -> ZRECfg
maybeUpdateName ZRECfg
forall a. Default a => a
def Maybe String
mname
        True -> do
          Either String ZRECfg
res <- String -> IO (Either String ZRECfg)
parseZRECfg String
homPth
          case Either String ZRECfg
res of
           Left err :: String
err -> String -> IO ()
putStrLn ("Unable to parse config: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err) IO () -> IO ZRECfg -> IO ZRECfg
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ZRECfg
forall a. IO a
exitFailure
           Right cfg :: ZRECfg
cfg -> ZRECfg -> IO ZRECfg
forall (m :: * -> *) a. Monad m => a -> m a
return (ZRECfg -> IO ZRECfg) -> ZRECfg -> IO ZRECfg
forall a b. (a -> b) -> a -> b
$ ZRECfg -> Maybe String -> ZRECfg
maybeUpdateName ZRECfg
cfg Maybe String
mname
    Just env :: String
env -> do
      Either String ZRECfg
res <- String -> IO (Either String ZRECfg)
parseZRECfg String
env
      case Either String ZRECfg
res of
        Left err :: String
err -> String -> IO ()
putStrLn ("Unable to parse config: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err) IO () -> IO ZRECfg -> IO ZRECfg
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ZRECfg
forall a. IO a
exitFailure
        Right cfg :: ZRECfg
cfg -> ZRECfg -> IO ZRECfg
forall (m :: * -> *) a. Monad m => a -> m a
return (ZRECfg -> IO ZRECfg) -> ZRECfg -> IO ZRECfg
forall a b. (a -> b) -> a -> b
$ ZRECfg -> Maybe String -> ZRECfg
maybeUpdateName ZRECfg
cfg Maybe String
mname
  where
    maybeUpdateName :: ZRECfg -> Maybe String -> ZRECfg
maybeUpdateName cfg :: ZRECfg
cfg mname :: Maybe String
mname = ZRECfg -> (String -> ZRECfg) -> Maybe String -> ZRECfg
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ZRECfg
cfg (\x :: String
x -> ZRECfg
cfg { zreNamed :: ByteString
zreNamed = String -> ByteString
B.pack String
x}) Maybe String
mname