Merge remote-tracking branch 'begriffs/v3' into v3

src/PostgREST/App.hs

@@ -6,7 +6,6 @@ module PostgREST.App (
 , isSqlError
 , contentTypeForAccept
 , jsonH
-, requestedSchema
 , TableOptions(..)
 ) where
 
@@ -29,7 +28,6 @@ import           Data.Ranged.Ranges        (emptyRange)
 import qualified Data.Set                  as S
 import           Data.String.Conversions   (cs)
 import           Data.Text                 (Text, replace, strip)
-import           Text.Regex.TDFA           ((=~))
 
 import           Text.Parsec.Error
 
@@ -59,8 +57,8 @@ import           PostgREST.Types
 
 import           Prelude
 
-app :: DbStructure -> AppConfig -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
-app dbstructure conf reqBody dbrole req =
+app :: DbStructure -> AppConfig -> DbRole -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
+app dbstructure conf authenticator reqBody dbrole req =
   case (path, verb) of
 
     ([], _) -> do
@@ -216,7 +214,7 @@ app dbstructure conf reqBody dbrole req =
 
       -- check that proc exists
       -- check that arg names are all specified
-      -- select * from "1".proc(a := "foo"::undefined) where whereT limit limitT
+      -- select * from public.proc(a := "foo"::undefined) where whereT limit limitT
 
     ([table], "PUT") ->
       handleJsonObj reqBody $ \obj -> do
@@ -296,8 +294,7 @@ app dbstructure conf reqBody dbrole req =
     lookupHeader  = flip lookup hdrs
     hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
     accept        = lookupHeader hAccept
-    schema        = requestedSchema (cs $ configV1Schema conf) accept
-    authenticator = cs $ configDbUser conf
+    schema        = cs $ configSchema conf
     jwtSecret     = cs $ configJwtSecret conf
     range         = rangeRequested hdrs
     allOrigins    = ("Access-Control-Allow-Origin", "*") :: Header
@@ -329,17 +326,6 @@ contentRangeH from to total =
       totalNotZero  = fromMaybe True ((/=) 0 <$> total)
       fromInRange   = from <= to
 
-requestedSchema :: Text -> Maybe BS.ByteString -> Text
-requestedSchema v1schema accept =
-  case verStr of
-    Just [[_, ver]] -> if ver == "1" then v1schema else cs ver
-    _ -> v1schema
-
-  where
-    verRegex = "version[ ]*=[ ]*([0-9]+)" :: BS.ByteString
-    verStr = (=~ verRegex) <$> accept :: Maybe [[BS.ByteString]]
-
-
 jsonMT :: BS.ByteString
 jsonMT = "application/json"
 

src/PostgREST/Config.hs

@@ -34,34 +34,25 @@ import           Prelude
 
 -- | Data type to store all command line options
 data AppConfig = AppConfig {
-    configDbName    :: String
-  , configDbPort    :: Int
-  , configDbUser    :: String
-  , configDbPass    :: String
-  , configDbHost    :: String
-
+    configDatabase  :: String
   , configPort      :: Int
   , configAnonRole  :: String
+  , configSchema    :: String
   , configSecure    :: Bool
-  , configPool      :: Int
-  , configV1Schema  :: String
   , configJwtSecret :: String
+  , configPool      :: Int
   }
 
 argParser :: Parser AppConfig
 argParser = AppConfig
-  <$> strOption (long "db-name" <> short 'd' <> metavar "NAME" <> help "name of database")
-  <*> option auto (long "db-port" <> short 'P' <> metavar "PORT" <> value 5432 <> help "postgres server port" <> showDefault)
-  <*> strOption (long "db-user" <> short 'U' <> metavar "ROLE" <> help "postgres authenticator role")
-  <*> strOption (long "db-pass" <> metavar "PASS" <> value "" <> help "password for authenticator role")
-  <*> strOption (long "db-host" <> metavar "HOST" <> value "localhost" <> help "postgres server hostname" <> showDefault)
+  <$> argument str (help "database connection string" <> metavar "STRING")
 
-  <*> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3000 <> help "port number on which to run HTTP server" <> showDefault)
-  <*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE" <> help "postgres role to use for non-authenticated requests")
-  <*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS")
-  <*> option auto (long "db-pool" <> metavar "COUNT" <> value 10 <> help "Max connections in database pool" <> showDefault)
-  <*> strOption (long "v1schema" <> metavar "NAME" <> value "1" <> help "Schema to use for nonspecified version (or explicit v1)" <> showDefault)
-  <*> strOption (long "jwt-secret" <> metavar "SECRET" <> value "secret" <> help "Secret used to encrypt and decrypt JWT tokens)" <> showDefault)
+  <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
+  <*> strOption    (long "anonymous"  <> short 'a' <> help "postgres role to use for non-authenticated requests" <> metavar "ROLE")
+  <*> strOption    (long "schema"     <> short 'S' <> help "schema to use for API routes" <> metavar "NAME" <> value "1" <> showDefault)
+  <*> switch       (long "secure"     <> short 's' <> help "redirect all requests to HTTPS")
+  <*> strOption    (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET" <> value "secret" <> showDefault)
+  <*> option auto  (long "pool"       <> short 'o' <> help "max connections in database pool" <> metavar "COUNT" <> value 10 <> showDefault)
 
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing

src/PostgREST/Main.hs

@@ -1,39 +1,41 @@
 module Main where
 
 
+import           PostgREST.App
+import           PostgREST.Config                     (AppConfig (..),
+                                                       minimumPgVersion,
+                                                       prettyVersion,
+                                                       readOptions)
+import           PostgREST.Error                      (errResponse, PgError)
+import           PostgREST.Middleware
 import           PostgREST.PgStructure
 import           PostgREST.Types
-import           Network.Wai
-
-import           PostgREST.App
-import           PostgREST.Error                      (errResponse)
-import           PostgREST.Middleware
 
 import           Control.Monad                        (unless)
 import           Control.Monad.IO.Class               (liftIO)
+import           Data.Aeson.Encode.Pretty             (encodePretty)
 import           Data.Functor.Identity
 import           Data.Monoid                          ((<>))
 import           Data.String.Conversions              (cs)
 import           Data.Text                            (Text)
 import qualified Hasql                                as H
 import qualified Hasql.Postgres                       as P
+import           Network.Wai
 import           Network.Wai.Handler.Warp             hiding (Connection)
 import           Network.Wai.Middleware.RequestLogger (logStdout)
-
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering, stderr,
                                                        stdin, stdout)
 
-import           PostgREST.Config                     (AppConfig (..),
-                                                       prettyVersion,
-                                                       readOptions,
-                                                       minimumPgVersion)
 
 isServerVersionSupported :: H.Session P.Postgres IO Bool
 isServerVersionSupported = do
-  Identity (row :: Text) <- H.tx Nothing $ H.singleEx $ [H.stmt|SHOW server_version_num|]
+  Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
   return $ read (cs row) >= minimumPgVersion
 
+hasqlError :: PgError -> IO a
+hasqlError = error . cs . encodePretty
+
 main :: IO ()
 main = do
   hSetBuffering stdout LineBuffering
@@ -50,11 +52,7 @@ main = do
   Prelude.putStrLn $ "Listening on port " ++
     (show $ configPort conf :: String)
 
-  let pgSettings = P.ParamSettings (cs $ configDbHost conf)
-                     (fromIntegral $ configDbPort conf)
-                     (cs $ configDbUser conf)
-                     (cs $ configDbPass conf)
-                     (cs $ configDbName conf)
+  let pgSettings = P.StringSettings $ cs (configDatabase conf)
       appSettings = setPort port
                   . setServerName (cs $ "postgrest/" <> prettyVersion)
                   $ defaultSettings
@@ -65,12 +63,20 @@ main = do
   pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
 
   supportedOrError <- H.session pool isServerVersionSupported
-  either (fail . show)
+  either hasqlError
     (\supported ->
       unless supported $
-        fail "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0"
+        error (
+          "Cannot run in this PostgreSQL version, PostgREST needs at least "
+          <> show minimumPgVersion)
     ) supportedOrError
 
+  roleOrError <- H.session pool $ do
+    Identity (role :: Text) <- H.tx Nothing $ H.singleEx
+      [H.stmt|SELECT SESSION_USER|]
+    return role
+  authenticator <- either hasqlError return roleOrError
+
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
     tabs <- allTables
@@ -79,19 +85,18 @@ main = do
     keys <- allPrimaryKeys
     return (tabs, rels, cols, keys)
 
-  dbstructure <- case metadata of
-    Left e -> fail $ show e
-    Right (tabs, rels, cols, keys) ->
+  dbstructure <- either hasqlError
+    (\(tabs, rels, cols, keys) ->
       return DbStructure {
           tables=tabs
         , columns=cols
         , relations=rels
         , primaryKeys=keys
         }
-
+    ) metadata
 
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      authenticated conf (app dbstructure conf body) req
+      authenticated conf authenticator (app dbstructure conf authenticator body) req
     either (respond . errResponse) respond resOrError

src/PostgREST/Middleware.hs

@@ -33,22 +33,21 @@ import           PostgREST.Config              (AppConfig (..), corsPolicy)
 
 import           Prelude
 
-authenticated :: forall s. AppConfig ->
+authenticated :: forall s. AppConfig -> DbRole ->
                  (DbRole -> Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
-authenticated conf app req = do
+authenticated conf authenticator app req = do
   attempt <- httpRequesterRole (requestHeaders req)
   case attempt of
     MalformedAuth ->
       return $ responseLBS status400 [] "Malformed basic auth header"
     LoginFailed ->
       return $ responseLBS status401 [] "Invalid username or password"
-    LoginSuccess role uid -> if role /= currentRole then runInRole role uid else app currentRole req
-    NoCredentials         -> if anon /= currentRole then runInRole anon "" else app currentRole req
+    LoginSuccess role uid -> if role /= authenticator then runInRole role uid else app authenticator req
+    NoCredentials         -> if anon /= authenticator then runInRole anon "" else app authenticator req
 
  where
    jwtSecret = cs $ configJwtSecret conf
-   currentRole = cs $ configDbUser conf
    anon = cs $ configAnonRole conf
    httpRequesterRole :: RequestHeaders -> H.Tx P.Postgres s LoginAttempt
    httpRequesterRole hdrs = do