Replace configurator-ng by configurator-pg (#1312)

The change should not affect parse results for valid
configuration files. Error messages should be somewhat
improved.

postgrest.cabal

@@ -33,17 +33,17 @@ executable postgrest
   default-language:    Haskell2010
   build-depends:       auto-update
                      , base >= 4.8 && < 4.10
+                     , base64-bytestring
+                     , bytestring
                      , hasql >= 1.3 && < 1.4
                      , hasql-pool >= 0.5 && < 0.6
                      , hasql-transaction >= 0.7 && < 0.8
                      , postgrest
                      , protolude == 0.2.2
+                     , retry
                      , text
                      , time
                      , warp
-                     , bytestring
-                     , base64-bytestring
-                     , retry
   if !os(windows)
     build-depends:     unix
 
@@ -59,10 +59,11 @@ library
                      , bytestring
                      , case-insensitive
                      , cassava
-                     , configurator-ng == 0.0.0.1
+                     , configurator-pg >= 0.1 && < 0.2
                      , containers
                      , contravariant
                      , contravariant-extras
+                     , cookie
                      , either
                      , gitrev
                      , hasql >= 1.3 && < 1.4
@@ -92,7 +93,6 @@ library
                      , wai-cors
                      , wai-extra
                      , wai-middleware-static
-                     , cookie
 
   Other-Modules:       Paths_postgrest
   Exposed-Modules:     PostgREST.ApiRequest

src/PostgREST/Config.hs

@@ -12,8 +12,9 @@ turned in configurable behaviour if needed.
 
 Other hardcoded options such as the minimum version number also belong here.
 -}
-{-# LANGUAGE LambdaCase      #-}
+{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 
 module PostgREST.Config ( prettyVersion
@@ -29,26 +30,23 @@ import qualified Data.ByteString              as B
 import qualified Data.ByteString.Char8        as BS
 import qualified Data.CaseInsensitive         as CI
 import qualified Data.Configurator            as C
-import qualified Data.Configurator.Parser     as C
-import           Data.Configurator.Types      as C
 import qualified Text.PrettyPrint.ANSI.Leijen as L
 
+import Control.Exception           (Handler (..))
 import Control.Lens                (preview)
 import Control.Monad               (fail)
 import Crypto.JWT                  (StringOrURI, stringOrUri)
 import Data.List                   (lookup)
 import Data.Scientific             (floatingOrInteger)
-import Data.String                 (String)
 import Data.Text                   (dropEnd, dropWhileEnd,
                                     intercalate, lines, splitOn,
-                                    strip, take)
+                                    strip, take, unpack)
 import Data.Text.Encoding          (encodeUtf8)
 import Data.Text.IO                (hPutStrLn)
 import Data.Version                (versionBranch)
 import Development.GitRev          (gitHash)
 import Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
 import Paths_postgrest             (version)
-import System.IO                   (hPrint)
 import System.IO.Error             (IOError)
 
 import Control.Applicative
@@ -131,68 +129,77 @@ readOptions = do
   -- First read the config file path from command line
   cfgPath <- customExecParser parserPrefs opts
   -- Now read the actual config file
-  conf <- catch
+  conf <- catches (C.load cfgPath)
-    (C.readConfig =<< C.load [C.Required cfgPath])
+    [ Handler (\(ex :: IOError)    -> exitErr $ "Cannot open config file:\n\t" <> show ex)
-    configNotfoundHint
+    , Handler (\(C.ParseError err) -> exitErr $ "Error parsing config file:\n\t" <> err)
+    ]
 
-  let (mAppConf, errs) = flip C.runParserM conf $
+  case C.runParser parseConfig conf of
-        AppConfig
+    Left err ->
-          <$> C.key "db-uri"
+      exitErr $ "Error parsing config file:\n\t" <> err
-          <*> C.key "db-anon-role"
+    Right appConf ->
-          <*> (mfilter (/= "") <$> C.key "server-proxy-uri")
-          <*> C.key "db-schema"
-          <*> (fromMaybe "!4" . mfilter (/= "") <$> C.key "server-host")
-          <*> (fromMaybe 3000 . join . fmap coerceInt <$> C.key "server-port")
-          <*> (fmap encodeUtf8 . mfilter (/= "") <$> C.key "jwt-secret")
-          <*> (fromMaybe False . join . fmap coerceBool <$> C.key "secret-is-base64")
-          <*> parseJwtAudience "jwt-aud"
-          <*> (fromMaybe 10 . join . fmap coerceInt <$> C.key "db-pool")
-          <*> (fromMaybe 10 . join . fmap coerceInt <$> C.key "db-pool-timeout")
-          <*> (join . fmap coerceInt <$> C.key "max-rows")
-          <*> (mfilter (/= "") <$> C.key "pre-request")
-          <*> pure False
-          <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings")
-          <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> C.key "role-claim-key")
-          <*> (maybe ["public"] splitExtraSearchPath <$> C.key "db-extra-search-path")
-
-  case mAppConf of
-    Nothing -> do
-      forM_ errs $ hPrint stderr
-      exitFailure
-    Just appConf ->
       return appConf
 
   where
-    parseJwtAudience :: Name -> C.ConfigParserM (Maybe StringOrURI)
+    parseConfig =
+      AppConfig
+        <$> reqString "db-uri"
+        <*> reqString "db-anon-role"
+        <*> (mfilter (/= "") <$> optString "server-proxy-uri")
+        <*> reqString "db-schema"
+        <*> (fromMaybe "!4" . mfilter (/= "") <$> optString "server-host")
+        <*> (fromMaybe 3000 . join . fmap coerceInt <$> optValue "server-port")
+        <*> (fmap encodeUtf8 . mfilter (/= "") <$> optString "jwt-secret")
+        <*> (fromMaybe False . join . fmap coerceBool <$> optValue "secret-is-base64")
+        <*> parseJwtAudience "jwt-aud"
+        <*> (fromMaybe 10 . join . fmap coerceInt <$> optValue "db-pool")
+        <*> (fromMaybe 10 . join . fmap coerceInt <$> optValue "db-pool-timeout")
+        <*> (join . fmap coerceInt <$> optValue "max-rows")
+        <*> (mfilter (/= "") <$> optString "pre-request")
+        <*> pure False
+        <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings" C.value)
+        <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optValue "role-claim-key")
+        <*> (maybe ["public"] splitExtraSearchPath <$> optValue "db-extra-search-path")
+
+    parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI)
     parseJwtAudience k =
-      C.key k >>= \case
+      C.optional k C.string >>= \case
         Nothing -> pure Nothing -- no audience in config file
-        Just aud -> case preview stringOrUri (aud :: String) of
+        Just aud -> case preview stringOrUri (unpack aud) of
           Nothing -> fail "Invalid Jwt audience. Check your configuration."
           (Just "") -> pure Nothing
           aud' -> pure aud'
 
-    coerceText :: Value -> Text
+    reqString :: C.Key -> C.Parser C.Config Text
-    coerceText (String s) = s
+    reqString k = C.required k C.string
-    coerceText v          = show v
 
-    coerceInt :: (Read i, Integral i) => Value -> Maybe i
+    optString :: C.Key -> C.Parser C.Config (Maybe Text)
-    coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
+    optString k = C.optional k C.string
-    coerceInt (String x) = readMaybe $ toS x
-    coerceInt _          = Nothing
 
-    coerceBool :: Value -> Maybe Bool
+    optValue :: C.Key -> C.Parser C.Config (Maybe C.Value)
-    coerceBool (Bool b)   = Just b
+    optValue k = C.optional k C.value
-    coerceBool (String b) = readMaybe $ toS b
-    coerceBool _          = Nothing
 
-    parseRoleClaimKey :: Value -> Either ApiRequestError JSPath
+    coerceText :: C.Value -> Text
-    parseRoleClaimKey (String s) = pRoleClaimKey s
+    coerceText (C.String s) = s
-    parseRoleClaimKey v          = pRoleClaimKey $ show v
+    coerceText v            = show v
 
-    splitExtraSearchPath :: Value -> [Text]
+    coerceInt :: (Read i, Integral i) => C.Value -> Maybe i
-    splitExtraSearchPath (String s) = strip <$> splitOn "," s
+    coerceInt (C.Number x) = rightToMaybe $ floatingOrInteger x
-    splitExtraSearchPath _          = []
+    coerceInt (C.String x) = readMaybe $ toS x
+    coerceInt _            = Nothing
+
+    coerceBool :: C.Value -> Maybe Bool
+    coerceBool (C.Bool b)   = Just b
+    coerceBool (C.String b) = readMaybe $ toS b
+    coerceBool _            = Nothing
+
+    parseRoleClaimKey :: C.Value -> Either ApiRequestError JSPath
+    parseRoleClaimKey (C.String s) = pRoleClaimKey s
+    parseRoleClaimKey v            = pRoleClaimKey $ show v
+
+    splitExtraSearchPath :: C.Value -> [Text]
+    splitExtraSearchPath (C.String s) = strip <$> splitOn "," s
+    splitExtraSearchPath _            = []
 
     opts = info (helper <*> pathParser) $
              fullDesc
@@ -208,10 +215,9 @@ readOptions = do
 
     parserPrefs = prefs showHelpOnError
 
-    configNotfoundHint :: IOError -> IO a
+    exitErr :: Text -> IO a
-    configNotfoundHint e = do
+    exitErr err = do
-      hPutStrLn stderr $
+      hPutStrLn stderr err
-        "Cannot open config file:\n\t" <> show e
       exitFailure
 
     exampleCfg :: Doc

stack.yaml

@@ -1,7 +1,5 @@
 resolver: lts-9.6
 extra-deps:
-  - configurator-ng-0.0.0.1
-  - critbit-0.2.0.0
   - Ranged-sets-0.3.0
   - protolude-0.2.2
   - hasql-1.3
@@ -12,6 +10,7 @@ extra-deps:
   - postgresql-libpq-0.9.4.1
   - http-types-0.12.3
   - wai-middleware-static-0.8.2
+  - configurator-pg-0.1.0.1
 ghc-options:
   postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
 nix: