Config.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
  This module contains a common pattern for parsing the legion runtime
  settings and application-specific configuration from the command
  line. The intent of this module is to implement a very specific and
  simple pattern that some people find useful and to get them there
  with minimum effort; not to be a flexible solution to every problem
  in the domain of configuration, or even to endorse the use of this
  pattern if you think you might need something different.

  This 'parseArgs' function implements a command line parser that accepts
  the usage:

  > <your-program-name>
  >  -c <file>         --config=<file>             REQUIRED - Specifies the config file.
  >  -j <host>:<port>  --joinTarget=<host>:<port>  OPTIONAL - The address of a node in the cluster we want to join.

  The config file is a YAML file, which has the following format:

  > adminAddr: localhost:8080
  > peerAddr: localhost:8022
  > joinAddr: localhost:8023

  In addition to these bindings, an arbitrary set of additional bindings
  may be supplied, and which will be decoded into some 'FromJSON' instance
  type of your choosing. (Note that the @yaml@ package is implemented by
  transforming the YAML input to JSON and then delegating to @aeson@,
  which is why your custom config type must be 'FromJSON', even though
  the config file is YAML format.)

  After parsing the command line and config file, 'parseArgs' will then
  return a tuple containing the legionary runtime settings, the startup
  mode that should be used, and custom application configuration.
-}
module Network.Legion.Config (
  parseArgs
) where

import Data.Aeson (FromJSON, Value(Object), (.:), parseJSON)
import Data.Default.Class (Default(def))
import Data.List (intercalate)
import Data.List.Split (splitOn)
import Data.String (fromString)
import Data.Yaml (decodeEither)
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


{- | Parse the command line arguments.  -}
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 _ ->
            {- No config file.  -}
            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 <- BS.readFile configFile
            case (decodeEither c, decodeEither 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 :: [OptDescr (Opt -> Opt)]
    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


{- |
  An address description is really just an synonym for a formatted string.

  Examples: @"0.0.0.0:8080"@, @"www.google.com:80"@,
-}
type AddressDescription = String


{- | Resolve an address description into an actual socket addr. -}
resolveAddr :: (String, Int) -> IO SockAddr
resolveAddr (host, port) =
  addrAddress . head <$> getAddrInfo Nothing (Just host) (Just (show port))


{- | Parse a <host>:<port> string into its component parts.  -}
{- TODO do this better, using a real parser technology, and supporting IPv6. -}
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