refactor: Response rm Paths_postgrest dependency

This allows using doctests on the Response.hs module
This commit is contained in:
steve-chavez
2023-08-02 16:28:48 -05:00
committed by Steve Chavez
parent d0a71de2da
commit 0fce7ca361
3 changed files with 12 additions and 12 deletions
+3 -2
View File
@@ -27,6 +27,7 @@ import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
import System.Posix.Types (FileMode) import System.Posix.Types (FileMode)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Data.Text.Encoding as T
import qualified Hasql.Transaction.Sessions as SQL import qualified Hasql.Transaction.Sessions as SQL
import qualified Network.Wai as Wai import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp as Warp
@@ -53,7 +54,7 @@ import PostgREST.Error (Error)
import PostgREST.Query (DbHandler) import PostgREST.Query (DbHandler)
import PostgREST.SchemaCache (SchemaCache (..)) import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Routine (Routine (..)) import PostgREST.SchemaCache.Routine (Routine (..))
import PostgREST.Version (prettyVersion) import PostgREST.Version (docsVersion, prettyVersion)
import Protolude hiding (Handler) import Protolude hiding (Handler)
@@ -199,7 +200,7 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A
(ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
oaiResult <- runQuery roleIsoLvl Plan.inspectPlanTxMode $ Query.openApiQuery sCache pgVer conf tSchema oaiResult <- runQuery roleIsoLvl Plan.inspectPlanTxMode $ Query.openApiQuery sCache pgVer conf tSchema
return $ Response.openApiResponse headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile return $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
(ActionInfo, TargetIdent identifier) -> (ActionInfo, TargetIdent identifier) ->
return $ Response.infoIdentResponse identifier sCache return $ Response.infoIdentResponse identifier sCache
+3 -3
View File
@@ -223,11 +223,11 @@ invokeResponse invMethod proc ctxApiRequest@ApiRequest{..} resultSet = case resu
RSPlan plan -> RSPlan plan ->
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
openApiResponse :: Bool -> Maybe (TablesMap, RoutineMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Wai.Response openApiResponse :: (Text, Text) -> Bool -> Maybe (TablesMap, RoutineMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Wai.Response
openApiResponse headersOnly body conf sCache schema negotiatedByProfile = openApiResponse versions headersOnly body conf sCache schema negotiatedByProfile =
Wai.responseLBS HTTP.status200 Wai.responseLBS HTTP.status200
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile)) (MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile))
(maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode conf sCache x y z) body) (maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode versions conf sCache x y z) body)
-- | Response with headers and status overridden from GUCs. -- | Response with headers and status overridden from GUCs.
gucResponse gucResponse
+6 -7
View File
@@ -12,7 +12,6 @@ import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet.InsOrd as Set import qualified Data.HashSet.InsOrd as Set
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Control.Arrow ((&&&)) import Control.Arrow ((&&&))
import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList) import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
@@ -36,16 +35,16 @@ import PostgREST.SchemaCache.Routine (Routine (..),
import PostgREST.SchemaCache.Table (Column (..), Table (..), import PostgREST.SchemaCache.Table (Column (..), Table (..),
TablesMap, TablesMap,
tableColumnsList) tableColumnsList)
import PostgREST.Version (docsVersion, prettyVersion)
import PostgREST.MediaType import PostgREST.MediaType
import Protolude hiding (Proxy, get) import Protolude hiding (Proxy, get)
encode :: AppConfig -> SchemaCache -> TablesMap -> HM.HashMap k [Routine] -> Maybe Text -> LBS.ByteString encode :: (Text, Text) -> AppConfig -> SchemaCache -> TablesMap -> HM.HashMap k [Routine] -> Maybe Text -> LBS.ByteString
encode conf sCache tables procs schemaDescription = encode versions conf sCache tables procs schemaDescription =
JSON.encode $ JSON.encode $
postgrestSpec postgrestSpec
versions
(dbRelationships sCache) (dbRelationships sCache)
(concat $ HM.elems procs) (concat $ HM.elems procs)
(snd <$> HM.toList tables) (snd <$> HM.toList tables)
@@ -392,12 +391,12 @@ escapeHostName "*6" = "0.0.0.0"
escapeHostName "!6" = "0.0.0.0" escapeHostName "!6" = "0.0.0.0"
escapeHostName h = h escapeHostName h = h
postgrestSpec :: RelationshipsMap -> [Routine] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger postgrestSpec :: (Text, Text) -> RelationshipsMap -> [Routine] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
postgrestSpec rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger) postgrestSpec (prettyVersion, docsVersion) rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
& basePath ?~ T.unpack b & basePath ?~ T.unpack b
& schemes ?~ [s'] & schemes ?~ [s']
& info .~ ((mempty :: Info) & info .~ ((mempty :: Info)
& version .~ T.decodeUtf8 prettyVersion & version .~ prettyVersion
& title .~ fromMaybe "PostgREST API" dTitle & title .~ fromMaybe "PostgREST API" dTitle
& description ?~ fromMaybe "This is a dynamic API generated by PostgREST" dDesc) & description ?~ fromMaybe "This is a dynamic API generated by PostgREST" dDesc)
& externalDocs ?~ ((mempty :: ExternalDocs) & externalDocs ?~ ((mempty :: ExternalDocs)