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

import System.Environment
import System.Directory
import System.FilePath.Posix
import qualified Data.ByteString.Char8 as B

import Network.ZRE.Types

import Data.Default (def)
import qualified Data.Either
import qualified Data.Foldable

import Options.Applicative
import Network.ZRE.Options

import qualified Data.Text
import qualified Data.Attoparsec.Text

trueStr :: Data.Attoparsec.Text.Parser Bool
trueStr :: Parser Bool
trueStr = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (
    forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Data.Foldable.asum
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Parser Text Text
Data.Attoparsec.Text.string forall a b. (a -> b) -> a -> b
$ [ Text
"true", Text
"t", Text
"yes", Text
"y" ]
  )

falseStr :: Data.Attoparsec.Text.Parser Bool
falseStr :: Parser Bool
falseStr =  forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (
    forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Data.Foldable.asum
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Parser Text Text
Data.Attoparsec.Text.string forall a b. (a -> b) -> a -> b
$ [ Text
"false" , Text
"f" , Text
"no" , Text
"n" ]
  )

iniFileToArgs :: [String] -> String -> [String]
iniFileToArgs :: [[Char]] -> [Char] -> [[Char]]
iniFileToArgs [[Char]]
sections [Char]
file =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([Char]
k, [Char]
v) -> [[Char]
"--" forall a. [a] -> [a] -> [a]
++ [Char]
k] forall a. [a] -> [a] -> [a]
++ (if [Char]
v forall a. Eq a => a -> a -> Bool
/= [Char]
"" then [[Char]
v] else []))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
Data.Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
k, Text
v) -> if forall a b. Either a b -> Bool
Data.Either.isRight forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Text -> Either [Char] a
Data.Attoparsec.Text.parseOnly (Parser Bool
trueStr) Text
v then ([Char]
k, Text
"") else ([Char]
k, Text
v)) -- fix --flag true -> --flag
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
_, Text
v) -> case forall a. Parser a -> Text -> Either [Char] a
Data.Attoparsec.Text.parseOnly (Parser Bool
trueStr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Bool
falseStr) Text
v of
      Left [Char]
_e -> Bool
True
      Right Bool
b -> Bool
b)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Text
Data.Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
x ->
          let t :: [Char] -> [Char]
t = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem forall a b. (a -> b) -> a -> b
$ Char
'-'forall a. a -> [a] -> [a]
:[Char
'a'..Char
'z'])
          in ([Char] -> [Char]
t [Char]
x, forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'=') [Char]
x)
        )
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([Char]
_section, [[Char]]
fields) -> [[Char]]
fields)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
section, [[Char]]
_fields) -> [Char]
section forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
sections)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [([Char], [[Char]])]
groupBySections
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(Char
x:[Char]
_xs) -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'#') -- comments
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=[Char]
"") -- empty
  forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
file

-- transform [ "[zre]", "debug = false" "gossip=localhost:31337" "[zrecat]" "bufsize = 300"
-- to
-- [("zre", ["debug=false", "gossip=localhost:31337"]), ("zrecat", ["bufsize=300"])]
groupBySections :: [String] -> [(String, [String])]
groupBySections :: [[Char]] -> [([Char], [[Char]])]
groupBySections [[Char]]
lines' = [[Char]] -> [([Char], [[Char]])]
go [[Char]]
lines'
  where
    go :: [[Char]] -> [([Char], [[Char]])]
go [] = []
    go ((Char
x:[Char]
xs):[[Char]]
ls) | Char
x forall a. Eq a => a -> a -> Bool
== Char
'[' = (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem forall a b. (a -> b) -> a -> b
$ Char
'-'forall a. a -> [a] -> [a]
:[Char
'a'..Char
'z']) [Char]
xs, [[Char]] -> [[Char]]
keyVals [[Char]]
ls)forall a. a -> [a] -> [a]
:[[Char]] -> [([Char], [[Char]])]
go [[Char]]
ls
    go ([Char]
_l:[[Char]]
ls)     | Bool
otherwise = [[Char]] -> [([Char], [[Char]])]
go [[Char]]
ls
    keyVals :: [[Char]] -> [[Char]]
keyVals [] = []
    keyVals [[Char]]
ls = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Char
x:[Char]
_) -> Char
'[' forall a. Eq a => a -> a -> Bool
/= Char
x) [[Char]]
ls

-- | Override config value from new iff it differs to default value
--
-- This could be done with `gzipWithT` and Generics
overrideNonDefault :: ZRECfg -> ZRECfg -> ZRECfg
overrideNonDefault :: ZRECfg -> ZRECfg -> ZRECfg
overrideNonDefault ZRECfg
orig ZRECfg
new = ZRECfg {
    zreNamed :: ByteString
zreNamed         = forall a. Eq a => a -> a -> a -> a
ovr (ZRECfg -> ByteString
zreNamed ZRECfg
orig)         (ZRECfg -> ByteString
zreNamed ZRECfg
new)         (ZRECfg -> ByteString
zreNamed forall a. Default a => a
def)
  , zreQuietPeriod :: Float
zreQuietPeriod   = forall a. Eq a => a -> a -> a -> a
ovr (ZRECfg -> Float
zreQuietPeriod ZRECfg
orig)   (ZRECfg -> Float
zreQuietPeriod ZRECfg
new)   (ZRECfg -> Float
zreQuietPeriod forall a. Default a => a
def)
  , zreQuietPingRate :: Float
zreQuietPingRate = forall a. Eq a => a -> a -> a -> a
ovr (ZRECfg -> Float
zreQuietPingRate ZRECfg
orig) (ZRECfg -> Float
zreQuietPingRate ZRECfg
new) (ZRECfg -> Float
zreQuietPingRate forall a. Default a => a
def)
  , zreDeadPeriod :: Float
zreDeadPeriod    = forall a. Eq a => a -> a -> a -> a
ovr (ZRECfg -> Float
zreDeadPeriod ZRECfg
orig)    (ZRECfg -> Float
zreDeadPeriod ZRECfg
new)    (ZRECfg -> Float
zreDeadPeriod forall a. Default a => a
def)
  , zreBeaconPeriod :: Float
zreBeaconPeriod  = forall a. Eq a => a -> a -> a -> a
ovr (ZRECfg -> Float
zreBeaconPeriod ZRECfg
orig)  (ZRECfg -> Float
zreBeaconPeriod ZRECfg
new)  (ZRECfg -> Float
zreBeaconPeriod forall a. Default a => a
def)
  , zreInterfaces :: [ByteString]
zreInterfaces    = forall a. Eq a => a -> a -> a -> a
ovr (ZRECfg -> [ByteString]
zreInterfaces ZRECfg
orig)    (ZRECfg -> [ByteString]
zreInterfaces ZRECfg
new)    (ZRECfg -> [ByteString]
zreInterfaces forall a. Default a => a
def)
  , zreMCast :: Endpoint
zreMCast         = forall a. Eq a => a -> a -> a -> a
ovr (ZRECfg -> Endpoint
zreMCast ZRECfg
orig)         (ZRECfg -> Endpoint
zreMCast ZRECfg
new)         (ZRECfg -> Endpoint
zreMCast forall a. Default a => a
def)
  , zreZGossip :: Maybe Endpoint
zreZGossip       = forall a. Eq a => a -> a -> a -> a
ovr (ZRECfg -> Maybe Endpoint
zreZGossip ZRECfg
orig)       (ZRECfg -> Maybe Endpoint
zreZGossip ZRECfg
new)       (ZRECfg -> Maybe Endpoint
zreZGossip forall a. Default a => a
def)
  , zreDbg :: Bool
zreDbg           = forall a. Eq a => a -> a -> a -> a
ovr (ZRECfg -> Bool
zreDbg ZRECfg
orig)           (ZRECfg -> Bool
zreDbg ZRECfg
new)           (ZRECfg -> Bool
zreDbg forall a. Default a => a
def)
  }
  where
    ovr :: (Eq a) => a -> a -> a -> a
    ovr :: forall a. Eq a => a -> a -> a -> a
ovr a
_o a
n a
d | a
n forall a. Eq a => a -> a -> Bool
/= a
d = a
n
    ovr a
o a
_n a
_d | Bool
otherwise = a
o

parseZRECfg :: String -> FilePath -> IO (Either String ZRECfg)
parseZRECfg :: [Char] -> [Char] -> IO (Either [Char] ZRECfg)
parseZRECfg [Char]
exeName [Char]
fpath = do
  Bool
isFile <- [Char] -> IO Bool
doesFileExist [Char]
fpath
  case Bool
isFile of
    Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [Char]
"No such file"
    Bool
True -> do
      [Char]
f <- [Char] -> IO [Char]
readFile [Char]
fpath
      let cfg :: ParserResult ZRECfg
cfg = forall a. ParserPrefs -> ParserInfo a -> [[Char]] -> ParserResult a
execParserPure ParserPrefs
defaultPrefs ParserInfo ZRECfg
opts ([[Char]] -> [Char] -> [[Char]]
iniFileToArgs [[Char]
"zre", [Char]
exeName] [Char]
f)
      case ParserResult ZRECfg
cfg of
        -- we always fail when one of the configs fails to parse
        Failure ParserFailure ParserHelp
e -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ ParserFailure ParserHelp -> [Char] -> ([Char], ExitCode)
renderFailure ParserFailure ParserHelp
e [Char]
""
        Success ZRECfg
cfg' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ZRECfg
cfg'
        CompletionInvoked CompletionResult
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"No completion"
  where
    opts :: ParserInfo ZRECfg
opts = forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ZRECfg
parseOptions forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
      ( forall a. InfoMod a
fullDesc
     forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> InfoMod a
progDesc [Char]
"ZRE"
     forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> InfoMod a
header [Char]
"zre tools" )

-- The order is
-- * path of @ZRECFG@ env iff set
-- * @/etc/zre.conf@
-- * @~/.zre.conf@
-- * @default@
--
-- This also tries to parse subsection for zre programs according to their
-- name and construct correct command line for these so we can do
--
-- @[zrecat]@
-- @bufsize = 1024@
--
-- If @ZRENAME@ env var is set, it overrides name field in the result config.
envZRECfg :: String -> IO (ZRECfg)
envZRECfg :: [Char] -> IO ZRECfg
envZRECfg [Char]
exeName = do
  Maybe [Char]
menv  <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"ZRECFG"
  Maybe [Char]
mname <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"ZRENAME"

  [Char]
hom <- IO [Char]
getHomeDirectory

  ZRECfg
cfg <- forall {m :: * -> *} {a} {b}. Monad m => [m (Either a b)] -> m b
asumOneConfig [
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [Char]
"No ZRECFG env") ([Char] -> [Char] -> IO (Either [Char] ZRECfg)
parseZRECfg [Char]
exeName) Maybe [Char]
menv
    , [Char] -> [Char] -> IO (Either [Char] ZRECfg)
parseZRECfg [Char]
exeName [Char]
"/etc/zre.conf"
    , [Char] -> [Char] -> IO (Either [Char] ZRECfg)
parseZRECfg [Char]
exeName forall a b. (a -> b) -> a -> b
$ [Char]
hom [Char] -> [Char] -> [Char]
</> [Char]
".zre.conf"
    , forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Default a => a
def
    ]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ZRECfg -> Maybe [Char] -> ZRECfg
maybeUpdateName ZRECfg
cfg Maybe [Char]
mname
  where
    maybeUpdateName :: ZRECfg -> Maybe [Char] -> ZRECfg
maybeUpdateName ZRECfg
cfg Maybe [Char]
mname = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ZRECfg
cfg (\[Char]
x -> ZRECfg
cfg { zreNamed :: ByteString
zreNamed = [Char] -> ByteString
B.pack [Char]
x}) Maybe [Char]
mname
    asumOneConfig :: [m (Either a b)] -> m b
asumOneConfig [] = forall a. HasCallStack => [Char] -> a
error [Char]
"Can't happen"
    asumOneConfig (m (Either a b)
x:[m (Either a b)]
xs) = m (Either a b)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either a b
y -> case Either a b
y of
      Left a
_e -> [m (Either a b)] -> m b
asumOneConfig [m (Either a b)]
xs
      Right b
cfg -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ b
cfg