jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: Remove GHC.Show instances from QualifiedIdentifier and Config

Browse Source
This commit is contained in:
monacoremo
2021-11-09 19:13:52 +01:00
committed by Remo
parent 5dc37fc8e8
commit cd3013569e
5 changed files with 38 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/Config.hs
+20 -19
View File
@@ -35,8 +35,6 @@ import qualified Data.Configurator as C
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified GHC.Show (show)
import Control.Lens (preview)
import Control.Monad (fail)
import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri)
@@ -55,7 +53,8 @@ import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
pRoleClaimKey)
import PostgREST.Config.Proxy (Proxy (..),
isMalformedProxyUri, toURI)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, toQi)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,
toQi)
import PostgREST.Request.Types (JoinType (..))
import Protolude hiding (Proxy, toList, toS)
@@ -99,19 +98,21 @@ data AppConfig = AppConfig
data LogLevel = LogCrit | LogError | LogWarn | LogInfo
instance Show LogLevel where
show LogCrit = "crit"
show LogError = "error"
show LogWarn = "warn"
show LogInfo = "info"
dumpLogLevel :: LogLevel -> Text
dumpLogLevel = \case
LogCrit -> "crit"
LogError -> "error"
LogWarn -> "warn"
LogInfo -> "info"
data OpenAPIMode = OAFollowPriv | OAIgnorePriv | OADisabled
deriving Eq
instance Show OpenAPIMode where
show OAFollowPriv = "follow-privileges"
show OAIgnorePriv = "ignore-privileges"
show OADisabled = "disabled"
dumpOpenApiMode :: OpenAPIMode -> Text
dumpOpenApiMode = \case
OAFollowPriv -> "follow-privileges"
OAIgnorePriv -> "ignore-privileges"
OADisabled -> "disabled"
-- | Dump the config
toText :: AppConfig -> Text
@@ -127,21 +128,21 @@ toText conf =
,("db-max-rows", maybe "\"\"" show . configDbMaxRows)
,("db-pool", show . configDbPoolSize)
,("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-root-spec", q . maybe mempty show . configDbRootSpec)
,("db-root-spec", q . maybe mempty dumpQi . configDbRootSpec)
,("db-schemas", q . T.intercalate "," . toList . configDbSchemas)
,("db-config", q . T.toLower . show . configDbConfig)
,("db-tx-end", q . showTxEnd)
,("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)
,("jwt-aud", toS . encode . maybe "" toJSON . configJwtAudience)
,("jwt-role-claim-key", q . T.intercalate mempty . fmap show . configJwtRoleClaimKey)
,("jwt-secret", q . toS . showJwtSecret)
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
,("log-level", q . show . configLogLevel)
,("openapi-mode", q . show . configOpenApiMode)
,("log-level", q . dumpLogLevel . configLogLevel)
,("openapi-mode", q . dumpOpenApiMode . configOpenApiMode)
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
,("raw-media-types", q . toS . BS.intercalate "," . configRawMediaTypes)
,("server-host", q . configServerHost)
@@ -168,8 +169,8 @@ toText conf =
secret = fromMaybe mempty $ configJwtSecret c
showSocketMode c = showOct (configServerUnixSocketMode c) mempty
innerJoin JTInner = "inner"
innerJoin JTLeft = "left"
dumpJoin JTInner = "inner"
dumpJoin JTLeft = "left"
-- This class is needed for the polymorphism of overrideFromDbOrEnvironment
-- because C.required and C.optional have different signatures
src/PostgREST/DbStructure/Identifiers.hs
+4 -4
View File
@@ -6,12 +6,12 @@ module PostgREST.DbStructure.Identifiers
, Schema
, TableName
, FieldName
, dumpQi
, toQi
) where
import qualified Data.Aeson as JSON
import qualified Data.Text as T
import qualified GHC.Show
import Protolude
@@ -26,9 +26,9 @@ data QualifiedIdentifier = QualifiedIdentifier
instance Hashable QualifiedIdentifier
instance Show QualifiedIdentifier where
show (QualifiedIdentifier s i) =
(if T.null s then mempty else toS s <> ".") <> toS i
dumpQi :: QualifiedIdentifier -> Text
dumpQi (QualifiedIdentifier s 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"
-- Right now it only handles the schema.identifier case
src/PostgREST/Query/SqlFragment.hs
+7 -4
View File
@@ -52,12 +52,15 @@ import PostgREST.DbStructure.Identifiers (FieldName,
import PostgREST.RangeQuery (NonnegRange, allRange,
rangeLimit, rangeOffset)
import PostgREST.Request.Types (Alias, Field, Filter (..),
OrderNulls(..), OrderDirection(..), LogicOperator(..),
JoinCondition (..),
JsonOperand (..),
JsonOperation (..),
JsonPath, LogicTree (..),
OpExpr (..), Operation (..),
JsonPath,
LogicOperator (..),
LogicTree (..), OpExpr (..),
Operation (..),
OrderDirection (..),
OrderNulls (..),
OrderTerm (..), SelectItem)
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
opSql And = " AND "
opSql Or = " OR "
opSql Or = " OR "
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
pgFmtJsonPath :: JsonPath -> SQL.Snippet
src/PostgREST/Request/ApiRequest.hs
+1 -1
View File
@@ -65,7 +65,7 @@ import PostgREST.Request.Preferences (PreferCount (..),
PreferResolution (..),
PreferTransaction (..))
import qualified PostgREST.ContentType as ContentType
import qualified PostgREST.ContentType as ContentType
import qualified PostgREST.Request.Preferences as Preferences
import Protolude hiding (head, toS)
src/PostgREST/Request/Preferences.hs
+6 -6
View File
@@ -9,20 +9,20 @@ module PostgREST.Request.Preferences
, ToAppliedHeader(..)
) 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 Data.Map as Map
import Protolude
data Preferences
= Preferences
{ preferResolution :: Maybe PreferResolution
{ preferResolution :: Maybe PreferResolution
, preferRepresentation :: PreferRepresentation
, preferParameters :: Maybe PreferParameters
, preferCount :: Maybe PreferCount
, preferTransaction :: Maybe PreferTransaction
, preferParameters :: Maybe PreferParameters
, preferCount :: Maybe PreferCount
, preferTransaction :: Maybe PreferTransaction
}
fromHeaders :: [HTTP.Header] -> Preferences