Merge pull request #649 from hudayou/proxy-awareness

Add proxy awareness for OpenAPI spec generation

CHANGELOG.md

@@ -7,6 +7,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ### Added
 - Ability to generate an OpenAPI spec - @mainx07, @hudayou, @ruslantalpa, @begriffs
+- Ability to generate an OpenAPI spec behind a proxy- @hudayou
 - Ability to set addresses to listen on - @hudayou
 - Filtering, shaping and embedding with &select for the /rpc path - @ruslantalpa
 - Output names of used-defined types (instead of 'USER-DEFINED') - @martingms

main/Main.hs

@@ -8,6 +8,7 @@ import           PostgREST.Config                     (AppConfig (..),
                                                        minimumPgVersion,
                                                        prettyVersion,
                                                        readOptions)
+import           PostgREST.OpenAPI                    (isMalformedProxyUri)
 import           PostgREST.DbStructure
 
 import           Control.Monad
@@ -50,12 +51,16 @@ main = do
   conf <- readOptions
   let host = configHost conf
       port = configPort conf
+      proxy = configProxyUri conf
       pgSettings = cs (configDatabase conf)
       appSettings = setHost (fromString host)
                   . setPort port
                   . setServerName (cs $ "postgrest/" <> prettyVersion)
                   $ defaultSettings
 
+  when (isMalformedProxyUri proxy) $ error
+    "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
+
   unless (secret "secret" /= configJwtSecret conf) $
     putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
   Prelude.putStrLn $ "Listening on port " ++

postgrest.cabal

@@ -67,6 +67,7 @@ executable postgrest
                      , warp >= 3.1.0
                      , insert-ordered-containers >= 0.1.0.1
                      , swagger2 >= 2.1
+                     , network-uri >= 2.6.1.0
                      , HTTP
                      , Ranged-sets
                      , protolude >= 0.1.5 && < 0.2.0
@@ -115,6 +116,7 @@ library
                      , insert-ordered-containers >= 0.1.0.1
                      , swagger2 >= 2.1
                      , protolude >= 0.1.5 && < 0.2.0
+                     , network-uri >= 2.6.1.0
 
   Other-Modules:       Paths_postgrest
   Exposed-Modules:     PostgREST.App
@@ -197,5 +199,6 @@ Test-Suite spec
                      , hjsonpointer
                      , hjsonschema
                      , swagger2
+                     , network-uri
                      , HTTP
                      , Ranged-sets

src/PostgREST/App.hs

@@ -14,7 +14,7 @@ import           Data.List                 (find, delete)
 import           Data.Maybe                (fromMaybe, fromJust, mapMaybe)
 import           Data.Ranged.Ranges        (emptyRange)
 import           Data.String.Conversions   (cs)
-import           Data.Text                 (Text, replace, strip, isInfixOf, dropWhile, drop)
+import           Data.Text                 (Text, replace, strip, pack, isInfixOf, dropWhile, drop)
 import           Data.Tree
 
 import qualified Hasql.Pool                as P
@@ -204,9 +204,13 @@ app dbStructure conf apiRequest =
                       else cs $ encode body)
 
     (ActionRead, TargetRoot, Nothing) -> do
-      let encodeApi ti = encodeOpenAPI ti host port
+      let encodeApi ti = encodeOpenAPI ti uri'
           host = configHost conf
           port = toInteger $ configPort conf
+          proxy = pickProxy $ configProxyUri conf
+          uri Nothing = ("http", pack host, port, "/")
+          uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b)
+          uri' = uri proxy
           encodeFn = if contentType == OpenAPI then encodeApi . toTableInfo else encode
           header = if contentType == OpenAPI then openapiH else jsonH
       body <- encodeFn <$> H.query schema accessibleTables

src/PostgREST/Config.hs

@@ -38,6 +38,7 @@ import           Web.JWT                     (Secret, secret)
 data AppConfig = AppConfig {
     configDatabase  :: String
   , configAnonRole  :: String
+  , configProxyUri  :: Maybe String
   , configSchema    :: String
   , configHost      :: String
   , configPort      :: Int
@@ -51,6 +52,7 @@ argParser :: Parser AppConfig
 argParser = AppConfig
   <$> argument str (help "(REQUIRED) database connection string, e.g. postgres://user:pass@host:port/db" <> metavar "DB_URL")
   <*> strOption    (long "anonymous"  <> short 'a' <> help "(REQUIRED) postgres role to use for non-authenticated requests" <> metavar "ROLE")
+  <*> (optional . strOption) (long "proxy-uri"  <> short 'x' <> help "proxy uri of the HTTP server" <> metavar "PROXY")
   <*> strOption    (long "schema"     <> short 's' <> help "schema to use for API routes" <> metavar "NAME" <> value "public" <> showDefault)
   <*> strOption    (long "host"       <> short 'l' <> help "hostname or ip on which to run HTTP server" <> metavar "HOST" <> value "*4" <> showDefault)
   <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)

src/PostgREST/OpenAPI.hs

@@ -2,24 +2,30 @@
 
 module PostgREST.OpenAPI (
   encodeOpenAPI
+  , isMalformedProxyUri
+  , pickProxy
   ) where
 
 import           Control.Lens
 import           Data.Aeson                  (decode, encode)
 import           Data.ByteString.Lazy        (ByteString)
 import           Data.HashMap.Strict.InsOrd  (InsOrdHashMap, fromList)
+import           Data.Maybe                  (isJust, isNothing, fromJust)
 import           Data.String                 (IsString (..))
-import           Data.Text                   (Text, unpack, pack, concat, intercalate)
+import           Data.Text                   (Text, unpack, pack, concat, intercalate, init, tail, toLower)
 import qualified Data.Set                    as Set
+import           Network.URI                 (parseURI, isAbsoluteURI,
+                                              URI (..), URIAuth (..))
 
-import           Prelude hiding              (concat)
+import           Prelude hiding              (concat, init, tail)
 
 import           Data.Swagger
 
 import           PostgREST.ApiRequest        (ContentType(..))
 import           PostgREST.Config            (prettyVersion)
 import           PostgREST.QueryBuilder      (operators)
-import           PostgREST.Types             (Table(..), Column(..))
+import           PostgREST.Types             (Table(..), Column(..),
+                                              Proxy(..))
 
 makeMimeList :: [ContentType] -> MimeList
 makeMimeList cs = MimeList $ map (fromString . show) cs
@@ -215,7 +221,7 @@ makeRootPathItem = ("/", p)
 makePathItems :: [(Table, [Column], [Text])] -> InsOrdHashMap FilePath PathItem
 makePathItems ti = fromList $ makeRootPathItem : map makePathItem ti
 
-escapeHostName :: String -> String
+escapeHostName :: Text -> Text
 escapeHostName "*"  = "0.0.0.0"
 escapeHostName "*4" = "0.0.0.0"
 escapeHostName "!4" = "0.0.0.0"
@@ -223,10 +229,10 @@ escapeHostName "*6" = "0.0.0.0"
 escapeHostName "!6" = "0.0.0.0"
 escapeHostName h    = h
 
-postgrestSpec:: [(Table, [Column], [Text])] -> String -> Integer -> Swagger
+postgrestSpec:: [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Swagger
-postgrestSpec ti h p = (mempty :: Swagger)
+postgrestSpec ti (s, h, p, b) = (mempty :: Swagger)
-  & basePath ?~ "/"
+  & basePath ?~ unpack b
-  & schemes ?~ [Http]
+  & schemes ?~ [s']
   & info .~ ((mempty :: Info)
       & version .~ pack prettyVersion
       & title .~ "PostgREST API"
@@ -235,7 +241,90 @@ postgrestSpec ti h p = (mempty :: Swagger)
   & definitions .~ makeDefinitions ti
   & paths .~ makePathItems ti
     where
-      h' = Just $ Host (escapeHostName h) (Just (fromInteger p))
+      s' = if s == "http" then Http else Https
+      h' = Just $ Host (unpack $ escapeHostName h) (Just (fromInteger p))
 
-encodeOpenAPI :: [(Table, [Column], [Text])] -> String -> Integer -> ByteString
+encodeOpenAPI :: [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> ByteString
-encodeOpenAPI ti h p = encode $ postgrestSpec ti h p
+encodeOpenAPI ti uri = encode $ postgrestSpec ti uri
+
+{-|
+  Test whether a proxy uri is malformed or not.
+  A valid proxy uri should be an absolute uri without query and user info,
+  only http(s) schemes are valid, port number range is 1-65535.
+
+  For example
+  http://postgrest.com/openapi.json
+  https://postgrest.com:8080/openapi.json
+-}
+isMalformedProxyUri :: Maybe String -> Bool
+isMalformedProxyUri Nothing =  False
+isMalformedProxyUri (Just uri)
+  | isAbsoluteURI uri = not $ isUriValid $ toURI uri
+  | otherwise = True
+
+toURI :: String -> URI
+toURI uri = fromJust $ parseURI uri
+
+pickProxy :: Maybe String -> Maybe Proxy
+pickProxy proxy
+  | isNothing proxy = Nothing
+  -- should never happen
+  -- since the request would have been rejected by the middleware if proxy uri
+  -- is malformed
+  | isMalformedProxyUri proxy = Nothing
+  | otherwise = Just Proxy {
+    proxyScheme = scheme
+  , proxyHost = host'
+  , proxyPort = port''
+  , proxyPath = path'
+  }
+ where
+   uri = toURI $ fromJust proxy
+   scheme = init $ toLower $ pack $ uriScheme uri
+   path URI {uriPath = ""} =  "/"
+   path URI {uriPath = p} = p
+   path' = pack $ path uri
+   authority = fromJust $ uriAuthority uri
+   host' = pack $ uriRegName authority
+   port' = uriPort authority
+   port'' :: Integer
+   port'' = case (port', scheme) of
+             ("", "http") -> 80
+             ("", "https") -> 443
+             _ -> read $ unpack $ tail $ pack port'
+
+isUriValid:: URI -> Bool
+isUriValid = fAnd [isSchemeValid, isQueryValid, isAuthorityValid]
+
+fAnd :: [a -> Bool] -> a -> Bool
+fAnd fs x = all ($x) fs
+
+isSchemeValid :: URI -> Bool
+isSchemeValid URI {uriScheme = s}
+  | toLower (pack s) == "https:" = True
+  | toLower (pack s) == "http:" = True
+  | otherwise = False
+
+isQueryValid :: URI -> Bool
+isQueryValid URI {uriQuery = ""} = True
+isQueryValid _ = False
+
+isAuthorityValid :: URI -> Bool
+isAuthorityValid URI {uriAuthority = a}
+  | isJust a = fAnd [isUserInfoValid, isHostValid, isPortValid] $ fromJust a
+  | otherwise = False
+
+isUserInfoValid :: URIAuth -> Bool
+isUserInfoValid URIAuth {uriUserInfo = ""} = True
+isUserInfoValid _ = False
+
+isHostValid :: URIAuth -> Bool
+isHostValid URIAuth {uriRegName = ""} = False
+isHostValid _ = True
+
+isPortValid :: URIAuth -> Bool
+isPortValid URIAuth {uriPort = ""} = True
+isPortValid URIAuth {uriPort = (':':p)} =
+  let i :: Integer = read p in
+      i > 0 && i < 65536
+isPortValid _ = False

src/PostgREST/Types.hs

@@ -103,6 +103,13 @@ data Payload = PayloadJSON UniformObjects
              | PayloadParseError BS.ByteString
              deriving (Show, Eq)
 
+data Proxy = Proxy {
+  proxyScheme     :: Text
+, proxyHost       :: Text
+, proxyPort       :: Integer
+, proxyPath       :: Text
+} deriving (Show, Eq)
+
 type Operator = Text
 data FValue = VText Text | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
 type FieldName = Text

stack.yaml

@@ -18,6 +18,7 @@ extra-deps:
   - hackage-security-0.5.2.1
   - swagger2-2.1
   - hjsonpointer-0.3.0.1
+  - network-uri-2.6.1.0
 ghc-options:
   postgrest: -O2 -Werror -Wall -fwarn-identities
 

test/Feature/ProxySpec.hs

@@ -0,0 +1,13 @@
+module Feature.ProxySpec where
+
+import Test.Hspec hiding (pendingWith)
+
+import SpecHelper
+
+import Network.Wai (Application)
+
+spec :: SpecWith Application
+spec =
+  describe "GET / with proxy" $
+    it "returns a valid openapi spec with proxy" $
+      validateOpenApiResponse [("Accept", "application/openapi+json")]

test/Feature/StructureSpec.hs

@@ -3,16 +3,12 @@ module Feature.StructureSpec where
 import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
+import Network.HTTP.Types
 
 import SpecHelper
 
-import Network.HTTP.Types
 import Network.Wai (Application)
-import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))
+import Network.Wai.Test (SResponse(simpleHeaders))
-
-import Data.Maybe (fromJust)
-import Data.Aeson (decode)
-import qualified Data.JsonSchema.Draft4 as D4
 
 spec :: SpecWith Application
 spec = do
@@ -65,27 +61,8 @@ spec = do
         ] |]
         {matchStatus = 200}
 
-    it "returns a valid openapi spec" $ do
+    it "returns a valid openapi spec" $
-      r <- request methodGet "/" [("Accept", "application/openapi+json")] ""
+      validateOpenApiResponse [("Accept", "application/openapi+json")]
-      liftIO $
-        let respStatus = simpleStatus r in
-        respStatus `shouldSatisfy`
-          \s -> s == Status { statusCode = 200, statusMessage="OK" }
-      liftIO $
-        let respHeaders = simpleHeaders r in
-        respHeaders `shouldSatisfy`
-          \hs -> ("Content-Type", "application/openapi+json; charset=utf-8") `elem` hs
-      liftIO $
-        let respBody = simpleBody r
-            schema :: D4.Schema
-            schema = D4.emptySchema { D4._schemaRef = Just "openapi.json" }
-            schemaContext :: D4.SchemaWithURI D4.Schema
-            schemaContext = D4.SchemaWithURI
-              { D4._swSchema = schema
-              , D4._swURI    = Just "test/fixtures/openapi.json"
-              }
-           in
-           D4.fetchFilesystemAndValidate schemaContext ((fromJust . decode) respBody) `shouldReturn` Right ()
 
     it "should respond to openapi request on none root path with 415" $
       request methodGet "/none_root_path"

test/Main.hs

@@ -20,6 +20,7 @@ import qualified Feature.QuerySpec
 import qualified Feature.RangeSpec
 import qualified Feature.StructureSpec
 import qualified Feature.UnicodeSpec
+import qualified Feature.ProxySpec
 
 main :: IO ()
 main = do
@@ -32,6 +33,7 @@ main = do
   let withApp = return $ postgrest testCfg refDbStructure pool
       ltdApp  = return $ postgrest testLtdRowsCfg refDbStructure pool
       unicodeApp = return $ postgrest testUnicodeCfg refDbStructure pool
+      proxyApp = return $ postgrest testProxyCfg refDbStructure pool
 
   hspec $ do
     mapM_ (beforeAll_ resetDb . before withApp) specs
@@ -44,6 +46,10 @@ main = do
     beforeAll_ resetDb . before unicodeApp $
       describe "Feature.UnicodeSpec" Feature.UnicodeSpec.spec
 
+    -- this test runs with a proxy
+    beforeAll_ resetDb . before proxyApp $
+      describe "Feature.ProxySpec" Feature.ProxySpec.spec
+
  where
   specs = map (uncurry describe) [
       ("Feature.AuthSpec"         , Feature.AuthSpec.spec)

test/SpecHelper.hs

@@ -3,8 +3,6 @@ module SpecHelper where
 import Data.String.Conversions (cs)
 import Control.Monad (void)
 
-import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
-                                  hRange, hAuthorization, hAccept)
 import Codec.Binary.Base64.String (encode)
 import Data.CaseInsensitive (CI(..))
 import Text.Regex.TDFA ((=~))
@@ -14,20 +12,57 @@ import Web.JWT (secret)
 
 import PostgREST.Config (AppConfig(..))
 
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai
+
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))
+
+import Data.Maybe (fromJust)
+import Data.Aeson (decode)
+import qualified Data.JsonSchema.Draft4 as D4
+
+validateOpenApiResponse :: [Header] -> WaiSession ()
+validateOpenApiResponse headers = do
+  r <- request methodGet "/" headers ""
+  liftIO $
+    let respStatus = simpleStatus r in
+    respStatus `shouldSatisfy`
+      \s -> s == Status { statusCode = 200, statusMessage="OK" }
+  liftIO $
+    let respHeaders = simpleHeaders r in
+    respHeaders `shouldSatisfy`
+      \hs -> ("Content-Type", "application/openapi+json; charset=utf-8") `elem` hs
+  liftIO $
+    let respBody = simpleBody r
+        schema :: D4.Schema
+        schema = D4.emptySchema { D4._schemaRef = Just "openapi.json" }
+        schemaContext :: D4.SchemaWithURI D4.Schema
+        schemaContext = D4.SchemaWithURI
+          { D4._swSchema = schema
+          , D4._swURI    = Just "test/fixtures/openapi.json"
+          }
+       in
+       D4.fetchFilesystemAndValidate schemaContext ((fromJust . decode) respBody) `shouldReturn` Right ()
+
 testDbConn :: String
 testDbConn = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test"
 
 testCfg :: AppConfig
 testCfg =
-  AppConfig testDbConn "postgrest_test_anonymous" "test" "localhost" 3000 (secret "safe") 10 Nothing True
+  AppConfig testDbConn "postgrest_test_anonymous" Nothing "test" "localhost" 3000 (secret "safe") 10 Nothing True
 
 testUnicodeCfg :: AppConfig
 testUnicodeCfg =
-  AppConfig testDbConn "postgrest_test_anonymous" "تست" "localhost" 3000 (secret "safe") 10 Nothing True
+  AppConfig testDbConn "postgrest_test_anonymous" Nothing "تست" "localhost" 3000 (secret "safe") 10 Nothing True
 
 testLtdRowsCfg :: AppConfig
 testLtdRowsCfg =
-  AppConfig testDbConn "postgrest_test_anonymous" "test" "localhost" 3000 (secret "safe") 10 (Just 2) True
+  AppConfig testDbConn "postgrest_test_anonymous" Nothing "test" "localhost" 3000 (secret "safe") 10 (Just 2) True
+
+testProxyCfg :: AppConfig
+testProxyCfg =
+  AppConfig testDbConn "postgrest_test_anonymous" (Just "https://postgrest.com/openapi.json") "test" "localhost" 3000 (secret "safe") 10 Nothing True
 
 setupDb :: IO ()
 setupDb = do