refactor: Carve CLI and Version modules out of Config (#1806)

This commit is contained in:
Remo Rechkemmer
2021-04-12 19:17:47 +02:00
committed by GitHub
parent 67ca814d0b
commit 801e229c59
7 changed files with 221 additions and 201 deletions
+16 -2
View File
@@ -8,6 +8,7 @@ module Main (main) where
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map.Strict as M
import qualified Hasql.Connection as C
import qualified Hasql.Notifications as N
import qualified Hasql.Pool as P
@@ -27,11 +28,17 @@ import Data.Time.Clock (getCurrentTime)
import Network.Wai.Handler.Warp (defaultSettings, runSettings,
setHost, setPort, setServerName)
import System.CPUTime (getCPUTime)
import System.Environment (getEnvironment)
import System.IO (BufferMode (..), hSetBuffering)
import Text.Printf (hPrintf)
import PostgREST.App (postgrest)
import PostgREST.Config
import PostgREST.CLI (CLI (..), Command (..),
readCLIShowHelp)
import PostgREST.Config (AppConfig (..), Environment,
configDbPoolTimeout',
dumpAppConfig, readAppConfig,
readDbUriFile, readSecretFile)
import PostgREST.DbStructure (DbStructure, getDbStructure,
getPgVersion)
import PostgREST.DbStructure.PgVersion (PgVersion (..),
@@ -39,6 +46,9 @@ import PostgREST.DbStructure.PgVersion (PgVersion (..),
import PostgREST.Error (PgError (PgError),
checkIsFatal, errorPayload)
import PostgREST.Query.Statements (dbSettingsStatement)
import PostgREST.Version (prettyVersion)
import qualified Data.Text as T
import Protolude hiding (hPutStrLn, head, toS)
import Protolude.Conv (toS)
@@ -79,7 +89,7 @@ main = do
env <- readEnvironment
-- read command/path from commad line
CLI{cliCommand, cliPath} <- readCLIShowHelp env
CLI{cliCommand, cliPath} <- readCLIShowHelp . not $ M.null env
-- build the 'AppConfig' from the config file path and env vars
pathEnvConf <- either panic identity <$> readAppConfig mempty env cliPath Nothing Nothing
@@ -212,6 +222,10 @@ main = do
putStrLn $ ("Listening on port " :: Text) <> show port
runSettings serverSettings postgrestApplication
readEnvironment :: IO Environment
readEnvironment = getEnvironment <&> pgrst
where
pgrst env = M.filterWithKey (\k _ -> "PGRST_" `isPrefixOf` k) $ M.map T.pack $ M.fromList env
-- Time constants
_32s :: Int
+3
View File
@@ -36,6 +36,7 @@ library
hs-source-dirs: src
exposed-modules: PostgREST.App
PostgREST.Auth
PostgREST.CLI
PostgREST.Config
PostgREST.Config.JSPath
PostgREST.Config.Proxy
@@ -59,6 +60,7 @@ library
PostgREST.Request.Parsers
PostgREST.Request.Preferences
PostgREST.Request.Types
PostgREST.Version
other-modules: Paths_postgrest
build-depends: base >= 4.9 && < 4.15
, HTTP >= 4000.3.7 && < 4000.4
@@ -131,6 +133,7 @@ executable postgrest
, auto-update >= 0.1.4 && < 0.2
, base64-bytestring >= 1 && < 1.3
, bytestring >= 0.10.8 && < 0.11
, containers >= 0.5.7 && < 0.7
, directory >= 1.2.6 && < 1.4
, either >= 4.4.1 && < 5.1
, hasql >= 1.4 && < 1.5
+160
View File
@@ -0,0 +1,160 @@
{-# LANGUAGE QuasiQuotes #-}
module PostgREST.CLI
( CLI (..)
, Command (..)
, readCLIShowHelp
) where
import qualified Options.Applicative as O
import qualified Protolude.Conv as Conv
import Text.Heredoc (str)
import PostgREST.Version (prettyVersion)
import Protolude
-- | Command line interface options
data CLI = CLI
{ cliCommand :: Command
, cliPath :: Maybe FilePath
}
data Command
= CmdRun
| CmdDumpConfig
| CmdDumpSchema
-- | Read command line interface options. Also prints help.
readCLIShowHelp :: Bool -> IO CLI
readCLIShowHelp hasEnvironment =
O.customExecParser prefs opts
where
prefs = O.prefs $ O.showHelpOnError <> O.showHelpOnEmpty
opts = O.info parser $ O.fullDesc <> progDesc <> footer
parser = O.helper <*> exampleParser <*> cliParser
progDesc =
O.progDesc $
"PostgREST "
<> Conv.toS prettyVersion
<> " / create a REST API to an existing Postgres database"
footer =
O.footer $
"To run PostgREST, please pass the FILENAME argument"
<> " or set PGRST_ environment variables."
exampleParser =
O.infoOption exampleConfigFile $
O.long "example"
<> O.short 'e'
<> O.help "Show an example configuration file"
cliParser :: O.Parser CLI
cliParser =
CLI
<$> (dumpConfigFlag <|> dumpSchemaFlag)
<*> optionalIf hasEnvironment configFileOption
configFileOption =
O.strArgument $
O.metavar "FILENAME"
<> O.help "Path to configuration file (optional with PGRST_ environment variables)"
dumpConfigFlag =
O.flag CmdRun CmdDumpConfig $
O.long "dump-config"
<> O.help "Dump loaded configuration and exit"
dumpSchemaFlag =
O.flag CmdRun CmdDumpSchema $
O.long "dump-schema"
<> O.help "Dump loaded schema as JSON and exit (for debugging, output structure is unstable)"
optionalIf :: Alternative f => Bool -> f a -> f (Maybe a)
optionalIf True = O.optional
optionalIf False = fmap Just
exampleConfigFile :: [Char]
exampleConfigFile =
[str|### REQUIRED:
|db-uri = "postgres://user:pass@localhost:5432/dbname"
|db-schema = "public"
|db-anon-role = "postgres"
|
|### OPTIONAL:
|## number of open connections in the pool
|db-pool = 10
|
|## Time to live, in seconds, for an idle database pool connection.
|db-pool-timeout = 10
|
|## extra schemas to add to the search_path of every request
|db-extra-search-path = "public"
|
|## limit rows in response
|# db-max-rows = 1000
|
|## stored proc to exec immediately after auth
|# db-pre-request = "stored_proc_name"
|
|## stored proc that overrides the root "/" spec
|## it must be inside the db-schema
|# db-root-spec = "stored_proc_name"
|
|## Notification channel for reloading the schema cache
|db-channel = "pgrst"
|
|## Enable or disable the notification channel
|db-channel-enabled = false
|
|## Enable in-database configuration
|db-config = true
|
|## how to terminate database transactions
|## possible values are:
|## commit (default)
|## transaction is always committed, this can not be overriden
|## commit-allow-override
|## transaction is committed, but can be overriden with Prefer tx=rollback header
|## rollback
|## transaction is always rolled back, this can not be overriden
|## rollback-allow-override
|## transaction is rolled back, but can be overriden with Prefer tx=commit header
|db-tx-end = "commit"
|
|## enable or disable prepared statements. disabling is only necessary when behind a connection pooler.
|## when disabled, statements will be parametrized but won't be prepared.
|db-prepared-statements = true
|
|server-host = "!4"
|server-port = 3000
|
|## unix socket location
|## if specified it takes precedence over server-port
|# server-unix-socket = "/tmp/pgrst.sock"
|
|## unix socket file mode
|## when none is provided, 660 is applied by default
|# server-unix-socket-mode = "660"
|
|## base url for swagger output
|openapi-server-proxy-uri = ""
|
|## choose a secret, JSON Web Key (or set) to enable JWT auth
|## (use "@filename" to load from separate file)
|# jwt-secret = "secret_with_at_least_32_characters"
|# jwt-aud = "your_audience_claim"
|jwt-secret-is-base64 = false
|
|## jspath to the role claim key
|jwt-role-claim-key = ".role"
|
|## content types to produce raw output
|# raw-media-types="image/png, image/jpg"
|
|## logging level, the admitted values are: crit, error, warn and info.
|log-level = "error"
|]
+9 -194
View File
@@ -1,46 +1,28 @@
{-|
Module : PostgREST.Config
Description : Manages PostgREST configuration options.
Description : Manages PostgREST configuration type and parser.
This module provides a helper function to read the command line
arguments using the optparse-applicative and the AppConfig type to store
them. It also can be used to define other middleware configuration that
may be delegated to some sort of external configuration.
It currently includes a hardcoded CORS policy but this could easly be
turned in configurable behaviour if needed.
Other hardcoded options such as the minimum version number also belong here.
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module PostgREST.Config
( prettyVersion
, docsVersion
( AppConfig (..)
, Environment
, JSPath
, JSPathExp(..)
, LogLevel(..)
, CLI (..)
, Command (..)
, AppConfig (..)
, Proxy(..)
, configDbPoolTimeout'
, dumpAppConfig
, Environment
, readCLIShowHelp
, readEnvironment
, isMalformedProxyUri
, parseSecret
, readAppConfig
, readDbUriFile
, readSecretFile
, parseSecret
, JSPath
, JSPathExp(..)
, isMalformedProxyUri
, toURI
) where
@@ -65,18 +47,8 @@ import Data.List (lookup)
import Data.List.NonEmpty (fromList, toList)
import Data.Maybe (fromJust)
import Data.Scientific (floatingOrInteger)
import Data.Version (versionBranch)
import Development.GitRev (gitHash)
import Numeric (readOct, showOct)
import Options.Applicative (Parser, customExecParser, flag,
footer, fullDesc, help, helper, info,
infoOption, long, metavar, prefs,
progDesc, short, showHelpOnEmpty,
showHelpOnError, strArgument)
import Paths_postgrest (version)
import System.Environment (getEnvironment)
import System.Posix.Types (FileMode)
import Text.Heredoc (str)
import PostgREST.Config.JSPath (JSPath, JSPathExp (..), pRoleClaimKey)
import PostgREST.Config.Proxy (Proxy (..), isMalformedProxyUri,
@@ -85,17 +57,7 @@ import PostgREST.Config.Proxy (Proxy (..), isMalformedProxyUri,
import Protolude hiding (Proxy, toList, toS)
import Protolude.Conv (toS)
-- | Command line interface options
data CLI = CLI
{ cliCommand :: Command
, cliPath :: Maybe FilePath }
data Command
= CmdRun
| CmdDumpConfig
| CmdDumpSchema
-- | Config file settings for the server
data AppConfig = AppConfig {
configAppSettings :: [(Text, Text)]
, configDbAnonRole :: Text
@@ -139,148 +101,6 @@ instance Show LogLevel where
show LogWarn = "warn"
show LogInfo = "info"
-- | User friendly version number
prettyVersion :: Text
prettyVersion =
T.intercalate "." (map show $ versionBranch version) <> gitRev
where
gitRev =
if $(gitHash) == "UNKNOWN"
then mempty
else " (" <> T.take 7 $(gitHash) <> ")"
-- | Version number used in docs
docsVersion :: Text
docsVersion = "v" <> T.dropEnd 1 (T.dropWhileEnd (/= '.') prettyVersion)
-- | Read command line interface options. Also prints help.
readCLIShowHelp :: Environment -> IO CLI
readCLIShowHelp env = customExecParser parserPrefs opts
where
parserPrefs = prefs $ showHelpOnError <> showHelpOnEmpty
opts = info (helper <*> exampleParser <*> cliParser) $
fullDesc
<> progDesc (
"PostgREST "
<> toS prettyVersion
<> " / create a REST API to an existing Postgres database"
)
<> footer "To run PostgREST, please pass the FILENAME argument or set PGRST_ environment variables."
cliParser :: Parser CLI
cliParser = CLI <$>
(
flag CmdRun CmdDumpConfig (
long "dump-config" <>
help "Dump loaded configuration and exit"
)
<|>
flag CmdRun CmdDumpSchema (
long "dump-schema" <>
help "Dump loaded schema as JSON and exit (for debugging, output structure is unstable)"
)
)
<*>
optionalWithEnvironment (strArgument (
metavar "FILENAME" <>
help "Path to configuration file (optional with PGRST_ environment variables)"
))
optionalWithEnvironment :: Alternative f => f a -> f (Maybe a)
optionalWithEnvironment v
| M.null env = Just <$> v
| otherwise = optional v
exampleParser :: Parser (a -> a)
exampleParser =
infoOption example (
long "example" <>
short 'e' <>
help "Show an example configuration file"
)
example =
[str|### REQUIRED:
|db-uri = "postgres://user:pass@localhost:5432/dbname"
|db-schema = "public"
|db-anon-role = "postgres"
|
|### OPTIONAL:
|## number of open connections in the pool
|db-pool = 10
|
|## Time to live, in seconds, for an idle database pool connection.
|db-pool-timeout = 10
|
|## extra schemas to add to the search_path of every request
|db-extra-search-path = "public"
|
|## limit rows in response
|# db-max-rows = 1000
|
|## stored proc to exec immediately after auth
|# db-pre-request = "stored_proc_name"
|
|## stored proc that overrides the root "/" spec
|## it must be inside the db-schema
|# db-root-spec = "stored_proc_name"
|
|## Notification channel for reloading the schema cache
|db-channel = "pgrst"
|
|## Enable or disable the notification channel
|db-channel-enabled = false
|
|## Enable in-database configuration
|db-config = true
|
|## how to terminate database transactions
|## possible values are:
|## commit (default)
|## transaction is always committed, this can not be overriden
|## commit-allow-override
|## transaction is committed, but can be overriden with Prefer tx=rollback header
|## rollback
|## transaction is always rolled back, this can not be overriden
|## rollback-allow-override
|## transaction is rolled back, but can be overriden with Prefer tx=commit header
|db-tx-end = "commit"
|
|## enable or disable prepared statements. disabling is only necessary when behind a connection pooler.
|## when disabled, statements will be parametrized but won't be prepared.
|db-prepared-statements = true
|
|server-host = "!4"
|server-port = 3000
|
|## unix socket location
|## if specified it takes precedence over server-port
|# server-unix-socket = "/tmp/pgrst.sock"
|
|## unix socket file mode
|## when none is provided, 660 is applied by default
|# server-unix-socket-mode = "660"
|
|## base url for swagger output
|openapi-server-proxy-uri = ""
|
|## choose a secret, JSON Web Key (or set) to enable JWT auth
|## (use "@filename" to load from separate file)
|# jwt-secret = "secret_with_at_least_32_characters"
|# jwt-aud = "your_audience_claim"
|jwt-secret-is-base64 = false
|
|## jspath to the role claim key
|jwt-role-claim-key = ".role"
|
|## content types to produce raw output
|# raw-media-types="image/png, image/jpg"
|
|## logging level, the admitted values are: crit, error, warn and info.
|log-level = "error"
|]
-- | Dump the config
dumpAppConfig :: AppConfig -> Text
dumpAppConfig conf =
@@ -568,13 +388,6 @@ parseSecret bytes =
secret = JWT.JWKSet [JWT.fromKeyMaterial keyMaterial]
keyMaterial = JWT.OctKeyMaterial . JWT.OctKeyParameters $ JOSE.Base64Octets bytes
type Environment = M.Map [Char] Text
readEnvironment :: IO Environment
readEnvironment = getEnvironment <&> pgrst
where
pgrst env = M.filterWithKey (\k _ -> "PGRST_" `isPrefixOf` k) $ M.map T.pack $ M.fromList env
-- | Read the JWT secret from a file if configJwtSecret is actually a filepath(has @ as its prefix).
-- | To check if the JWT secret is provided is in fact a file path, it must be decoded as 'Text' to be processed.
readSecretFile :: Maybe B.ByteString -> IO (Maybe B.ByteString)
@@ -590,3 +403,5 @@ readDbUriFile :: Text -> IO (Maybe Text)
readDbUriFile dbUri = case T.stripPrefix "@" dbUri of
Nothing -> return Nothing
Just filename -> Just . T.strip <$> readFile (toS filename)
type Environment = M.Map [Char] Text
+2 -3
View File
@@ -22,9 +22,7 @@ import Control.Lens (at, (.~), (?~))
import Data.Swagger
import PostgREST.Config (AppConfig (..), Proxy (..),
docsVersion,
isMalformedProxyUri,
prettyVersion, toURI)
isMalformedProxyUri, toURI)
import PostgREST.DbStructure (DbStructure (..), tableCols,
tablePKCols)
import PostgREST.DbStructure.Proc (PgArg (..),
@@ -32,6 +30,7 @@ import PostgREST.DbStructure.Proc (PgArg (..),
import PostgREST.DbStructure.Relation (PrimaryKey (..))
import PostgREST.DbStructure.Table (Column (..), ForeignKey (..),
Table (..))
import PostgREST.Version (docsVersion, prettyVersion)
import PostgREST.ContentType
+29
View File
@@ -0,0 +1,29 @@
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module PostgREST.Version
( docsVersion
, prettyVersion
) where
import qualified Data.Text as T
import Data.Version (versionBranch)
import Development.GitRev (gitHash)
import Paths_postgrest (version)
import Protolude
-- | User friendly version number
prettyVersion :: Text
prettyVersion =
T.intercalate "." (map show $ versionBranch version) <> gitRev
where
gitRev =
if $(gitHash) == "UNKNOWN"
then mempty
else " (" <> T.take 7 $(gitHash) <> ")"
-- | Version number used in docs
docsVersion :: Text
docsVersion = "v" <> T.dropEnd 1 (T.dropWhileEnd (/= '.') prettyVersion)
+2 -2
View File
@@ -11,8 +11,8 @@ import Network.HTTP.Types
import Test.Hspec hiding (pendingWith)
import Test.Hspec.Wai
import PostgREST.Config (docsVersion)
import Protolude hiding (get)
import PostgREST.Version (docsVersion)
import Protolude hiding (get)
import SpecHelper
spec :: SpecWith ((), Application)