{-# LANGUAGE ApplicativeDo #-}

module Hasura.Server.Init.Arg
  ( -- * Main Opt.Parser
    parseHgeOpts,
    parsePostgresConnInfo,
    parseMetadataDbUrl,
    mainCmdFooter,
    metadataDbUrlOption,
    retriesNumOption,
    databaseUrlOption,

    -- * Command Opt.Parsers
    module Downgrade,
    module Serve,
  )
where

--------------------------------------------------------------------------------

import Data.URL.Template qualified as Template
import Hasura.Logging qualified as Logging
import Hasura.Prelude
import Hasura.Server.Init.Arg.Command.Downgrade as Downgrade
import Hasura.Server.Init.Arg.Command.Serve as Serve
import Hasura.Server.Init.Arg.PrettyPrinter qualified as PP
import Hasura.Server.Init.Config (HGECommand, HGEOptionsRaw, Option, PostgresConnDetailsRaw, PostgresConnInfo, PostgresConnInfoRaw, ServeOptionsRaw)
import Hasura.Server.Init.Config qualified as Config
import Hasura.Server.Init.Env qualified as Env
import Options.Applicative qualified as Opt

--------------------------------------------------------------------------------

-- | The Main Arg 'Opt.Parser'. It constructs a 'HGEOptionsRaw' term:
--
-- 1. '(Config.PostgresConnInfo (Maybe PostgresConnInfoRaw))' - The DB connection.
-- 2: 'Maybe String' - Representing the metadata connection.
-- 3: 'Config.HGECommand' @a@ - The result of the supplied Subcommand.
parseHgeOpts :: (Logging.EnabledLogTypes impl) => Opt.Parser (HGEOptionsRaw (ServeOptionsRaw impl))
parseHgeOpts :: forall impl.
EnabledLogTypes impl =>
Parser (HGEOptionsRaw (ServeOptionsRaw impl))
parseHgeOpts =
  PostgresConnInfo (Maybe PostgresConnInfoRaw)
-> Maybe String
-> HGECommand (ServeOptionsRaw impl)
-> HGEOptionsRaw (ServeOptionsRaw impl)
forall impl.
PostgresConnInfo (Maybe PostgresConnInfoRaw)
-> Maybe String -> HGECommand impl -> HGEOptionsRaw impl
Config.HGEOptionsRaw (PostgresConnInfo (Maybe PostgresConnInfoRaw)
 -> Maybe String
 -> HGECommand (ServeOptionsRaw impl)
 -> HGEOptionsRaw (ServeOptionsRaw impl))
-> Parser (PostgresConnInfo (Maybe PostgresConnInfoRaw))
-> Parser
     (Maybe String
      -> HGECommand (ServeOptionsRaw impl)
      -> HGEOptionsRaw (ServeOptionsRaw impl))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (PostgresConnInfo (Maybe PostgresConnInfoRaw))
parsePostgresConnInfo Parser
  (Maybe String
   -> HGECommand (ServeOptionsRaw impl)
   -> HGEOptionsRaw (ServeOptionsRaw impl))
-> Parser (Maybe String)
-> Parser
     (HGECommand (ServeOptionsRaw impl)
      -> HGEOptionsRaw (ServeOptionsRaw impl))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe String)
parseMetadataDbUrl Parser
  (HGECommand (ServeOptionsRaw impl)
   -> HGEOptionsRaw (ServeOptionsRaw impl))
-> Parser (HGECommand (ServeOptionsRaw impl))
-> Parser (HGEOptionsRaw (ServeOptionsRaw impl))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (HGECommand (ServeOptionsRaw impl))
forall impl.
EnabledLogTypes impl =>
Parser (HGECommand (ServeOptionsRaw impl))
parseHGECommand

parseHGECommand :: (Logging.EnabledLogTypes impl) => Opt.Parser (HGECommand (ServeOptionsRaw impl))
parseHGECommand :: forall impl.
EnabledLogTypes impl =>
Parser (HGECommand (ServeOptionsRaw impl))
parseHGECommand =
  Mod CommandFields (HGECommand (ServeOptionsRaw impl))
-> Parser (HGECommand (ServeOptionsRaw impl))
forall a. Mod CommandFields a -> Parser a
Opt.subparser
    ( String
-> ParserInfo (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
        String
"serve"
        ( Parser (HGECommand (ServeOptionsRaw impl))
-> InfoMod (HGECommand (ServeOptionsRaw impl))
-> ParserInfo (HGECommand (ServeOptionsRaw impl))
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
            (Parser
  (HGECommand (ServeOptionsRaw impl)
   -> HGECommand (ServeOptionsRaw impl))
forall a. Parser (a -> a)
Opt.helper Parser
  (HGECommand (ServeOptionsRaw impl)
   -> HGECommand (ServeOptionsRaw impl))
-> Parser (HGECommand (ServeOptionsRaw impl))
-> Parser (HGECommand (ServeOptionsRaw impl))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ServeOptionsRaw impl -> HGECommand (ServeOptionsRaw impl)
forall a. a -> HGECommand a
Config.HCServe (ServeOptionsRaw impl -> HGECommand (ServeOptionsRaw impl))
-> Parser (ServeOptionsRaw impl)
-> Parser (HGECommand (ServeOptionsRaw impl))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ServeOptionsRaw impl)
forall impl. EnabledLogTypes impl => Parser (ServeOptionsRaw impl)
serveCommandParser))
            ( String -> InfoMod (HGECommand (ServeOptionsRaw impl))
forall a. String -> InfoMod a
Opt.progDesc String
"Start the GraphQL Engine Server"
                InfoMod (HGECommand (ServeOptionsRaw impl))
-> InfoMod (HGECommand (ServeOptionsRaw impl))
-> InfoMod (HGECommand (ServeOptionsRaw impl))
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod (HGECommand (ServeOptionsRaw impl))
forall a. Maybe Doc -> InfoMod a
Opt.footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
serveCmdFooter)
            )
        )
        Mod CommandFields (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
forall a. Semigroup a => a -> a -> a
<> String
-> ParserInfo (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"export"
          ( Parser (HGECommand (ServeOptionsRaw impl))
-> InfoMod (HGECommand (ServeOptionsRaw impl))
-> ParserInfo (HGECommand (ServeOptionsRaw impl))
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              (HGECommand (ServeOptionsRaw impl)
-> Parser (HGECommand (ServeOptionsRaw impl))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HGECommand (ServeOptionsRaw impl)
forall a. HGECommand a
Config.HCExport)
              (String -> InfoMod (HGECommand (ServeOptionsRaw impl))
forall a. String -> InfoMod a
Opt.progDesc String
"Export graphql-engine's metadata to stdout")
          )
        Mod CommandFields (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
forall a. Semigroup a => a -> a -> a
<> String
-> ParserInfo (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"clean"
          ( Parser (HGECommand (ServeOptionsRaw impl))
-> InfoMod (HGECommand (ServeOptionsRaw impl))
-> ParserInfo (HGECommand (ServeOptionsRaw impl))
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              (HGECommand (ServeOptionsRaw impl)
-> Parser (HGECommand (ServeOptionsRaw impl))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HGECommand (ServeOptionsRaw impl)
forall a. HGECommand a
Config.HCClean)
              (String -> InfoMod (HGECommand (ServeOptionsRaw impl))
forall a. String -> InfoMod a
Opt.progDesc String
"Clean graphql-engine's metadata to start afresh")
          )
        Mod CommandFields (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
forall a. Semigroup a => a -> a -> a
<> String
-> ParserInfo (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"downgrade"
          ( Parser (HGECommand (ServeOptionsRaw impl))
-> InfoMod (HGECommand (ServeOptionsRaw impl))
-> ParserInfo (HGECommand (ServeOptionsRaw impl))
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              (DowngradeOptions -> HGECommand (ServeOptionsRaw impl)
forall a. DowngradeOptions -> HGECommand a
Config.HCDowngrade (DowngradeOptions -> HGECommand (ServeOptionsRaw impl))
-> Parser DowngradeOptions
-> Parser (HGECommand (ServeOptionsRaw impl))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DowngradeOptions
downgradeCommandParser)
              (String -> InfoMod (HGECommand (ServeOptionsRaw impl))
forall a. String -> InfoMod a
Opt.progDesc String
"Downgrade the GraphQL Engine schema to the specified version")
          )
        Mod CommandFields (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
forall a. Semigroup a => a -> a -> a
<> String
-> ParserInfo (HGECommand (ServeOptionsRaw impl))
-> Mod CommandFields (HGECommand (ServeOptionsRaw impl))
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"version"
          ( Parser (HGECommand (ServeOptionsRaw impl))
-> InfoMod (HGECommand (ServeOptionsRaw impl))
-> ParserInfo (HGECommand (ServeOptionsRaw impl))
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              (HGECommand (ServeOptionsRaw impl)
-> Parser (HGECommand (ServeOptionsRaw impl))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HGECommand (ServeOptionsRaw impl)
forall a. HGECommand a
Config.HCVersion)
              (String -> InfoMod (HGECommand (ServeOptionsRaw impl))
forall a. String -> InfoMod a
Opt.progDesc String
"Prints the version of GraphQL Engine")
          )
    )

--------------------------------------------------------------------------------

parsePostgresConnInfo :: Opt.Parser (PostgresConnInfo (Maybe PostgresConnInfoRaw))
parsePostgresConnInfo :: Parser (PostgresConnInfo (Maybe PostgresConnInfoRaw))
parsePostgresConnInfo = do
  Maybe Int
retries' <- Parser (Maybe Int)
retries
  Maybe PostgresConnInfoRaw
maybeRawConnInfo <-
    ((Template -> PostgresConnInfoRaw)
-> Maybe Template -> Maybe PostgresConnInfoRaw
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Template -> PostgresConnInfoRaw
Config.PGConnDatabaseUrl (Maybe Template -> Maybe PostgresConnInfoRaw)
-> Parser (Maybe Template) -> Parser (Maybe PostgresConnInfoRaw)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Template)
parseDatabaseUrl)
      Parser (Maybe PostgresConnInfoRaw)
-> Parser (Maybe PostgresConnInfoRaw)
-> Parser (Maybe PostgresConnInfoRaw)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((PostgresConnDetailsRaw -> PostgresConnInfoRaw)
-> Maybe PostgresConnDetailsRaw -> Maybe PostgresConnInfoRaw
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PostgresConnDetailsRaw -> PostgresConnInfoRaw
Config.PGConnDetails (Maybe PostgresConnDetailsRaw -> Maybe PostgresConnInfoRaw)
-> Parser (Maybe PostgresConnDetailsRaw)
-> Parser (Maybe PostgresConnInfoRaw)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe PostgresConnDetailsRaw)
parseRawConnDetails)
  pure $ Maybe PostgresConnInfoRaw
-> Maybe Int -> PostgresConnInfo (Maybe PostgresConnInfoRaw)
forall a. a -> Maybe Int -> PostgresConnInfo a
Config.PostgresConnInfo Maybe PostgresConnInfoRaw
maybeRawConnInfo Maybe Int
retries'
  where
    retries :: Parser (Maybe Int)
retries =
      Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser Int -> Parser (Maybe Int))
-> Parser Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ReadM Int
forall a. Read a => ReadM a
Opt.auto
          ( String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"retries"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NO OF RETRIES"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
retriesNumOption)
          )

retriesNumOption :: Option ()
retriesNumOption :: Option ()
retriesNumOption =
  Config.Option
    { _default :: ()
Config._default = (),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_NO_OF_RETRIES",
      _helpMessage :: String
Config._helpMessage = String
"No.of retries if Postgres connection error occurs (default: 1)"
    }

parseDatabaseUrl :: Opt.Parser (Maybe Template.Template)
parseDatabaseUrl :: Parser (Maybe Template)
parseDatabaseUrl =
  Parser Template -> Parser (Maybe Template)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser Template -> Parser (Maybe Template))
-> Parser Template -> Parser (Maybe Template)
forall a b. (a -> b) -> a -> b
$ ReadM Template -> Mod OptionFields Template -> Parser Template
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String Template) -> ReadM Template
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String Template
forall a. FromEnv a => String -> Either String a
Env.fromEnv)
      ( String -> Mod OptionFields Template
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"database-url"
          Mod OptionFields Template
-> Mod OptionFields Template -> Mod OptionFields Template
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Template
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<DATABASE-URL>"
          Mod OptionFields Template
-> Mod OptionFields Template -> Mod OptionFields Template
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Template
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
databaseUrlOption)
      )

databaseUrlOption :: Option ()
databaseUrlOption :: Option ()
databaseUrlOption =
  Config.Option
    { _default :: ()
Config._default = (),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_DATABASE_URL",
      _helpMessage :: String
Config._helpMessage = String
"Postgres database URL. Example postgres://foo:bar@example.com:2345/database"
    }

parseRawConnDetails :: Opt.Parser (Maybe PostgresConnDetailsRaw)
parseRawConnDetails :: Parser (Maybe PostgresConnDetailsRaw)
parseRawConnDetails = do
  Maybe String
host' <- Parser (Maybe String)
host
  Maybe Int
port' <- Parser (Maybe Int)
port
  Maybe String
user' <- Parser (Maybe String)
user
  String
password' <- Parser String
password
  Maybe String
dbName' <- Parser (Maybe String)
dbName
  Maybe String
options' <- Parser (Maybe String)
options
  pure
    $ String
-> Int
-> String
-> String
-> String
-> Maybe String
-> PostgresConnDetailsRaw
Config.PostgresConnDetailsRaw
    (String
 -> Int
 -> String
 -> String
 -> String
 -> Maybe String
 -> PostgresConnDetailsRaw)
-> Maybe String
-> Maybe
     (Int
      -> String
      -> String
      -> String
      -> Maybe String
      -> PostgresConnDetailsRaw)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
host'
    Maybe
  (Int
   -> String
   -> String
   -> String
   -> Maybe String
   -> PostgresConnDetailsRaw)
-> Maybe Int
-> Maybe
     (String
      -> String -> String -> Maybe String -> PostgresConnDetailsRaw)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
port'
    Maybe
  (String
   -> String -> String -> Maybe String -> PostgresConnDetailsRaw)
-> Maybe String
-> Maybe
     (String -> String -> Maybe String -> PostgresConnDetailsRaw)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String
user'
    Maybe (String -> String -> Maybe String -> PostgresConnDetailsRaw)
-> Maybe String
-> Maybe (String -> Maybe String -> PostgresConnDetailsRaw)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe String
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
password'
    Maybe (String -> Maybe String -> PostgresConnDetailsRaw)
-> Maybe String -> Maybe (Maybe String -> PostgresConnDetailsRaw)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String
dbName'
    Maybe (Maybe String -> PostgresConnDetailsRaw)
-> Maybe (Maybe String) -> Maybe PostgresConnDetailsRaw
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String -> Maybe (Maybe String)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
options'
  where
    host :: Parser (Maybe String)
host =
      Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser String -> Parser (Maybe String))
-> Parser String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"host"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<HOST>"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Postgres server host"
          )

    port :: Parser (Maybe Int)
port =
      Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser Int -> Parser (Maybe Int))
-> Parser Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ReadM Int
forall a. Read a => ReadM a
Opt.auto
          ( String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"port"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'p'
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<PORT>"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Postgres server port"
          )

    user :: Parser (Maybe String)
user =
      Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser String -> Parser (Maybe String))
-> Parser String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"user"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'u'
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<USER>"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Database user name"
          )

    password :: Parser String
password =
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"password"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<PASSWORD>"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value String
""
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Password of the user"
        )

    dbName :: Parser (Maybe String)
dbName =
      Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser String -> Parser (Maybe String))
-> Parser String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"dbname"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'd'
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<DBNAME>"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Database name to connect to"
          )

    options :: Parser (Maybe String)
options =
      Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
        (Parser String -> Parser (Maybe String))
-> Parser String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pg-connection-options"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'o'
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<DATABASE-OPTIONS>"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"PostgreSQL options"
          )

-- TODO(SOLOMON): Should we parse the URL here?
parseMetadataDbUrl :: Opt.Parser (Maybe String)
parseMetadataDbUrl :: Parser (Maybe String)
parseMetadataDbUrl =
  Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
    (Parser String -> Parser (Maybe String))
-> Parser String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"metadata-database-url"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<METADATA-DATABASE-URL>"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Option () -> String
forall def. Option def -> String
Config._helpMessage Option ()
metadataDbUrlOption)
      )

metadataDbUrlOption :: Option ()
metadataDbUrlOption :: Option ()
metadataDbUrlOption =
  Config.Option
    { _default :: ()
Config._default = (),
      _envVar :: String
Config._envVar = String
"HASURA_GRAPHQL_METADATA_DATABASE_URL",
      _helpMessage :: String
Config._helpMessage = String
"Postgres database URL for Metadata storage. Example postgres://foo:bar@example.com:2345/database"
    }

--------------------------------------------------------------------------------
-- Pretty Printer

mainCmdFooter :: PP.Doc
mainCmdFooter :: Doc
mainCmdFooter =
  Doc
examplesDoc Doc -> Doc -> Doc
PP.<$> String -> Doc
PP.text String
"" Doc -> Doc -> Doc
PP.<$> Doc
envVarDoc
  where
    examplesDoc :: Doc
examplesDoc = [[String]] -> Doc
PP.mkExamplesDoc [[String]]
examples
    examples :: [[String]]
examples =
      [ [ String
"# Serve GraphQL Engine on default port (8080) with console disabled",
          String
"graphql-engine --database-url <database-url> serve"
        ],
        [ String
"# For more options, checkout",
          String
"graphql-engine serve --help"
        ]
      ]

    envVarDoc :: Doc
envVarDoc =
      [(String, String)] -> Doc
PP.mkEnvVarDoc
        [ Option () -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ()
databaseUrlOption,
          Option () -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ()
metadataDbUrlOption,
          Option () -> (String, String)
forall a. Option a -> (String, String)
Config.optionPP Option ()
retriesNumOption
        ]