module Network.Legion.Config (
parseArgs
) where
import Data.Aeson (FromJSON, Value(Object), (.:), parseJSON, eitherDecode)
import Data.Default.Class (Default(def))
import Data.List (intercalate)
import Data.List.Split (splitOn)
import Data.String (fromString)
import Network.Legion (StartupMode(JoinCluster, NewCluster),
RuntimeSettings(RuntimeSettings))
import Network.Socket (SockAddr, addrAddress, getAddrInfo)
import Safe (readMay)
import System.Console.GetOpt (OptDescr(Option), usageInfo, getOpt,
ArgOrder(Permute), ArgDescr(ReqArg))
import System.Environment (getArgs, getProgName)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
parseArgs :: (FromJSON userConfig)
=> IO (RuntimeSettings, StartupMode, userConfig)
parseArgs = do
prog <- getProgName
getOpt Permute options <$> getArgs >>= \case
(opts, [], []) ->
case foldr (.) id opts def of
Opt Nothing _ ->
fail $ "Missing config file: \n\n" ++ usageInfo prog options
Opt (Just configFile) maybeJoinTarget -> do
let
configFail m = fail $
"Couldn't decode YAML config from file "
++ configFile ++ ": " ++ show m
c <- LBS.fromStrict <$> BS.readFile configFile
case (eitherDecode c, eitherDecode c) of
(Left errMsg, _) -> configFail errMsg
(_, Left errMsg) -> configFail errMsg
(Right runtimeConfig, Right userConfig) -> do
mode <- case maybeJoinTarget of
Nothing -> pure NewCluster
Just jtDesc -> JoinCluster <$> resolveAddr (parseAddr jtDesc)
let (adminHost, adminPort) = parseAddr (adminAddr runtimeConfig)
settings <- RuntimeSettings
<$> (resolveAddr . parseAddr . peerAddr) runtimeConfig
<*> (resolveAddr . parseAddr . joinAddr) runtimeConfig
<*> pure (fromString adminHost)
<*> pure adminPort
return (settings, mode, userConfig)
(_, [], errors) ->
fail (intercalate "\n" (errors ++ [usageInfo prog options]))
(_, unknown, _) ->
fail
$ "Unknown options: " ++ intercalate ", " unknown
++ "\n" ++ usageInfo prog options
where
options = [
Option
['c']
["config"]
(ReqArg
(\name opt -> opt {oConfigFile = Just name})
"<file>"
)
"REQUIRED - Specifies the config file.",
Option
['j']
["joinTarget"]
(ReqArg
(\addr opt -> opt {oJoinTarget = Just addr})
"<host>:<port>"
)
"OPTIONAL - The address of a node in the cluster we want to join."
]
data Config = Config {
peerAddr :: AddressDescription,
joinAddr :: AddressDescription,
adminAddr :: AddressDescription
}
instance FromJSON Config where
parseJSON (Object config) = Config
<$> config .: "peerAddr"
<*> config .: "joinAddr"
<*> config .: "adminAddr"
parseJSON value =
fail $ "Couldn't parse legion runtime config from " ++ show value
type AddressDescription = String
resolveAddr :: (String, Int) -> IO SockAddr
resolveAddr (host, port) =
addrAddress . head <$> getAddrInfo Nothing (Just host) (Just (show port))
parseAddr :: AddressDescription -> (String, Int)
parseAddr desc =
case splitOn ":" desc of
[host, portStr] ->
case readMay portStr of
Nothing -> error ("Invalid address description: " ++ show desc)
Just port -> (host, port)
_ -> error ("Invalid address description: " ++ show desc)
data Opt = Opt {
oConfigFile :: Maybe FilePath,
oJoinTarget :: Maybe AddressDescription
}
instance Default Opt where
def = Opt Nothing Nothing