refactor: Remove GHC.Show instances from QualifiedIdentifier and Config
This commit is contained in:
+20
-19
@@ -35,8 +35,6 @@ import qualified Data.Configurator as C
|
|||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import qualified GHC.Show (show)
|
|
||||||
|
|
||||||
import Control.Lens (preview)
|
import Control.Lens (preview)
|
||||||
import Control.Monad (fail)
|
import Control.Monad (fail)
|
||||||
import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri)
|
import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri)
|
||||||
@@ -55,7 +53,8 @@ import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
|
|||||||
pRoleClaimKey)
|
pRoleClaimKey)
|
||||||
import PostgREST.Config.Proxy (Proxy (..),
|
import PostgREST.Config.Proxy (Proxy (..),
|
||||||
isMalformedProxyUri, toURI)
|
isMalformedProxyUri, toURI)
|
||||||
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, toQi)
|
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,
|
||||||
|
toQi)
|
||||||
import PostgREST.Request.Types (JoinType (..))
|
import PostgREST.Request.Types (JoinType (..))
|
||||||
|
|
||||||
import Protolude hiding (Proxy, toList, toS)
|
import Protolude hiding (Proxy, toList, toS)
|
||||||
@@ -99,19 +98,21 @@ data AppConfig = AppConfig
|
|||||||
|
|
||||||
data LogLevel = LogCrit | LogError | LogWarn | LogInfo
|
data LogLevel = LogCrit | LogError | LogWarn | LogInfo
|
||||||
|
|
||||||
instance Show LogLevel where
|
dumpLogLevel :: LogLevel -> Text
|
||||||
show LogCrit = "crit"
|
dumpLogLevel = \case
|
||||||
show LogError = "error"
|
LogCrit -> "crit"
|
||||||
show LogWarn = "warn"
|
LogError -> "error"
|
||||||
show LogInfo = "info"
|
LogWarn -> "warn"
|
||||||
|
LogInfo -> "info"
|
||||||
|
|
||||||
data OpenAPIMode = OAFollowPriv | OAIgnorePriv | OADisabled
|
data OpenAPIMode = OAFollowPriv | OAIgnorePriv | OADisabled
|
||||||
deriving Eq
|
deriving Eq
|
||||||
|
|
||||||
instance Show OpenAPIMode where
|
dumpOpenApiMode :: OpenAPIMode -> Text
|
||||||
show OAFollowPriv = "follow-privileges"
|
dumpOpenApiMode = \case
|
||||||
show OAIgnorePriv = "ignore-privileges"
|
OAFollowPriv -> "follow-privileges"
|
||||||
show OADisabled = "disabled"
|
OAIgnorePriv -> "ignore-privileges"
|
||||||
|
OADisabled -> "disabled"
|
||||||
|
|
||||||
-- | Dump the config
|
-- | Dump the config
|
||||||
toText :: AppConfig -> Text
|
toText :: AppConfig -> Text
|
||||||
@@ -127,21 +128,21 @@ toText conf =
|
|||||||
,("db-max-rows", maybe "\"\"" show . configDbMaxRows)
|
,("db-max-rows", maybe "\"\"" show . configDbMaxRows)
|
||||||
,("db-pool", show . configDbPoolSize)
|
,("db-pool", show . configDbPoolSize)
|
||||||
,("db-pool-timeout", show . floor . configDbPoolTimeout)
|
,("db-pool-timeout", show . floor . configDbPoolTimeout)
|
||||||
,("db-pre-request", q . maybe mempty show . configDbPreRequest)
|
,("db-pre-request", q . maybe mempty dumpQi . configDbPreRequest)
|
||||||
,("db-prepared-statements", T.toLower . show . configDbPreparedStatements)
|
,("db-prepared-statements", T.toLower . show . configDbPreparedStatements)
|
||||||
,("db-root-spec", q . maybe mempty show . configDbRootSpec)
|
,("db-root-spec", q . maybe mempty dumpQi . configDbRootSpec)
|
||||||
,("db-schemas", q . T.intercalate "," . toList . configDbSchemas)
|
,("db-schemas", q . T.intercalate "," . toList . configDbSchemas)
|
||||||
,("db-config", q . T.toLower . show . configDbConfig)
|
,("db-config", q . T.toLower . show . configDbConfig)
|
||||||
,("db-tx-end", q . showTxEnd)
|
,("db-tx-end", q . showTxEnd)
|
||||||
,("db-uri", q . configDbUri)
|
,("db-uri", q . configDbUri)
|
||||||
,("db-embed-default-join", q . innerJoin . configDbEmbedDefaultJoin)
|
,("db-embed-default-join", q . dumpJoin . configDbEmbedDefaultJoin)
|
||||||
,("db-use-legacy-gucs", T.toLower . show . configDbUseLegacyGucs)
|
,("db-use-legacy-gucs", T.toLower . show . configDbUseLegacyGucs)
|
||||||
,("jwt-aud", toS . encode . maybe "" toJSON . configJwtAudience)
|
,("jwt-aud", toS . encode . maybe "" toJSON . configJwtAudience)
|
||||||
,("jwt-role-claim-key", q . T.intercalate mempty . fmap show . configJwtRoleClaimKey)
|
,("jwt-role-claim-key", q . T.intercalate mempty . fmap show . configJwtRoleClaimKey)
|
||||||
,("jwt-secret", q . toS . showJwtSecret)
|
,("jwt-secret", q . toS . showJwtSecret)
|
||||||
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
|
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
|
||||||
,("log-level", q . show . configLogLevel)
|
,("log-level", q . dumpLogLevel . configLogLevel)
|
||||||
,("openapi-mode", q . show . configOpenApiMode)
|
,("openapi-mode", q . dumpOpenApiMode . configOpenApiMode)
|
||||||
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
|
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
|
||||||
,("raw-media-types", q . toS . BS.intercalate "," . configRawMediaTypes)
|
,("raw-media-types", q . toS . BS.intercalate "," . configRawMediaTypes)
|
||||||
,("server-host", q . configServerHost)
|
,("server-host", q . configServerHost)
|
||||||
@@ -168,8 +169,8 @@ toText conf =
|
|||||||
secret = fromMaybe mempty $ configJwtSecret c
|
secret = fromMaybe mempty $ configJwtSecret c
|
||||||
showSocketMode c = showOct (configServerUnixSocketMode c) mempty
|
showSocketMode c = showOct (configServerUnixSocketMode c) mempty
|
||||||
|
|
||||||
innerJoin JTInner = "inner"
|
dumpJoin JTInner = "inner"
|
||||||
innerJoin JTLeft = "left"
|
dumpJoin JTLeft = "left"
|
||||||
|
|
||||||
-- This class is needed for the polymorphism of overrideFromDbOrEnvironment
|
-- This class is needed for the polymorphism of overrideFromDbOrEnvironment
|
||||||
-- because C.required and C.optional have different signatures
|
-- because C.required and C.optional have different signatures
|
||||||
|
|||||||
@@ -6,12 +6,12 @@ module PostgREST.DbStructure.Identifiers
|
|||||||
, Schema
|
, Schema
|
||||||
, TableName
|
, TableName
|
||||||
, FieldName
|
, FieldName
|
||||||
|
, dumpQi
|
||||||
, toQi
|
, toQi
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified GHC.Show
|
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
@@ -26,9 +26,9 @@ data QualifiedIdentifier = QualifiedIdentifier
|
|||||||
|
|
||||||
instance Hashable QualifiedIdentifier
|
instance Hashable QualifiedIdentifier
|
||||||
|
|
||||||
instance Show QualifiedIdentifier where
|
dumpQi :: QualifiedIdentifier -> Text
|
||||||
show (QualifiedIdentifier s i) =
|
dumpQi (QualifiedIdentifier s i) =
|
||||||
(if T.null s then mempty else toS s <> ".") <> toS i
|
(if T.null s then mempty else s <> ".") <> i
|
||||||
|
|
||||||
-- TODO: Handle a case where the QI comes like this: "my.fav.schema"."my.identifier"
|
-- TODO: Handle a case where the QI comes like this: "my.fav.schema"."my.identifier"
|
||||||
-- Right now it only handles the schema.identifier case
|
-- Right now it only handles the schema.identifier case
|
||||||
|
|||||||
@@ -52,12 +52,15 @@ import PostgREST.DbStructure.Identifiers (FieldName,
|
|||||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||||
rangeLimit, rangeOffset)
|
rangeLimit, rangeOffset)
|
||||||
import PostgREST.Request.Types (Alias, Field, Filter (..),
|
import PostgREST.Request.Types (Alias, Field, Filter (..),
|
||||||
OrderNulls(..), OrderDirection(..), LogicOperator(..),
|
|
||||||
JoinCondition (..),
|
JoinCondition (..),
|
||||||
JsonOperand (..),
|
JsonOperand (..),
|
||||||
JsonOperation (..),
|
JsonOperation (..),
|
||||||
JsonPath, LogicTree (..),
|
JsonPath,
|
||||||
OpExpr (..), Operation (..),
|
LogicOperator (..),
|
||||||
|
LogicTree (..), OpExpr (..),
|
||||||
|
Operation (..),
|
||||||
|
OrderDirection (..),
|
||||||
|
OrderNulls (..),
|
||||||
OrderTerm (..), SelectItem)
|
OrderTerm (..), SelectItem)
|
||||||
|
|
||||||
import Protolude hiding (cast, toS)
|
import Protolude hiding (cast, toS)
|
||||||
@@ -268,7 +271,7 @@ pgFmtLogicTree qi (Expr hasNot op forest) = SQL.sql notOp <> " (" <> intercalate
|
|||||||
notOp = if hasNot then "NOT" else mempty
|
notOp = if hasNot then "NOT" else mempty
|
||||||
|
|
||||||
opSql And = " AND "
|
opSql And = " AND "
|
||||||
opSql Or = " OR "
|
opSql Or = " OR "
|
||||||
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
|
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
|
||||||
|
|
||||||
pgFmtJsonPath :: JsonPath -> SQL.Snippet
|
pgFmtJsonPath :: JsonPath -> SQL.Snippet
|
||||||
|
|||||||
@@ -65,7 +65,7 @@ import PostgREST.Request.Preferences (PreferCount (..),
|
|||||||
PreferResolution (..),
|
PreferResolution (..),
|
||||||
PreferTransaction (..))
|
PreferTransaction (..))
|
||||||
|
|
||||||
import qualified PostgREST.ContentType as ContentType
|
import qualified PostgREST.ContentType as ContentType
|
||||||
import qualified PostgREST.Request.Preferences as Preferences
|
import qualified PostgREST.Request.Preferences as Preferences
|
||||||
|
|
||||||
import Protolude hiding (head, toS)
|
import Protolude hiding (head, toS)
|
||||||
|
|||||||
@@ -9,20 +9,20 @@ module PostgREST.Request.Preferences
|
|||||||
, ToAppliedHeader(..)
|
, ToAppliedHeader(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
|
import qualified Data.Map as Map
|
||||||
import qualified Network.HTTP.Types.Header as HTTP
|
import qualified Network.HTTP.Types.Header as HTTP
|
||||||
import qualified Data.Map as Map
|
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
|
|
||||||
data Preferences
|
data Preferences
|
||||||
= Preferences
|
= Preferences
|
||||||
{ preferResolution :: Maybe PreferResolution
|
{ preferResolution :: Maybe PreferResolution
|
||||||
, preferRepresentation :: PreferRepresentation
|
, preferRepresentation :: PreferRepresentation
|
||||||
, preferParameters :: Maybe PreferParameters
|
, preferParameters :: Maybe PreferParameters
|
||||||
, preferCount :: Maybe PreferCount
|
, preferCount :: Maybe PreferCount
|
||||||
, preferTransaction :: Maybe PreferTransaction
|
, preferTransaction :: Maybe PreferTransaction
|
||||||
}
|
}
|
||||||
|
|
||||||
fromHeaders :: [HTTP.Header] -> Preferences
|
fromHeaders :: [HTTP.Header] -> Preferences
|
||||||
|
|||||||
Reference in New Issue
Block a user