From 6dd126461e8116f8a2e2960c556eeecd0f377f63 Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Mon, 28 Dec 2020 16:39:02 +0100 Subject: [PATCH] cov: Remove unused code --- src/PostgREST/ApiRequest.hs | 5 ++- src/PostgREST/App.hs | 12 +++---- src/PostgREST/Auth.hs | 4 --- src/PostgREST/Config.hs | 2 -- src/PostgREST/DbStructure.hs | 10 +++--- src/PostgREST/Error.hs | 4 +-- src/PostgREST/Types.hs | 70 ++++++++++++++++++------------------ 7 files changed, 48 insertions(+), 59 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 19609cd83..745b67f8f 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -67,8 +67,7 @@ data Action = ActionCreate | ActionRead{isHead :: Bool} data Target = TargetIdent QualifiedIdentifier | TargetProc{tProc :: ProcDescription, tpIsRootSpec :: Bool} | TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/" - | TargetUnknown [Text] - deriving Eq + | TargetUnknown -- | RPC query param value `/rpc/func?v=`, used for VARIADIC functions on form-urlencoded POST and GETs -- | It can be fixed `?v=1` or repeated `?v=1&v=2&v=3. @@ -279,7 +278,7 @@ userApiRequest confSchemas rootSpec dbStructure req reqBody Nothing -> TargetDefaultSpec schema [table] -> TargetIdent $ QualifiedIdentifier schema table ["rpc", pName] -> TargetProc (callFindProc pName) False - other -> TargetUnknown other + _ -> TargetUnknown shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke InvPost] relevantPayload = case (target, action) of diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index df1f31c4f..c6766daec 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -137,9 +137,9 @@ app dbStructure conf apiRequest = case gucs of Left err -> return $ errorResponseFor err Right (ghdrs, gstatus) -> do - total <- if | plannedCount -> H.statement () explStm + total <- if | plannedCount -> H.statement mempty explStm | estimatedCount -> if tableTotal > (fromIntegral <$> maxRows) - then do estTotal <- H.statement () explStm + then do estTotal <- H.statement mempty explStm pure $ if estTotal > tableTotal then estTotal else tableTotal else pure tableTotal | otherwise -> pure tableTotal @@ -197,7 +197,7 @@ app dbStructure conf apiRequest = row <- H.statement mempty $ createWriteStatement sq mq (contentType == CTSingularJSON) False (contentType == CTTextCSV) - (iPreferRepresentation apiRequest) [] pgVer prepared + (iPreferRepresentation apiRequest) mempty pgVer prepared let (_, queryTotal, _, body, gucHeaders, gucStatus) = row gucs = (,) <$> gucHeaders <*> gucStatus case gucs of @@ -230,7 +230,7 @@ app dbStructure conf apiRequest = else do row <- H.statement mempty $ createWriteStatement sq mq (contentType == CTSingularJSON) False - (contentType == CTTextCSV) (iPreferRepresentation apiRequest) [] pgVer prepared + (contentType == CTTextCSV) (iPreferRepresentation apiRequest) mempty pgVer prepared let (_, queryTotal, _, body, gucHeaders, gucStatus) = row gucs = (,) <$> gucHeaders <*> gucStatus case gucs of @@ -256,7 +256,7 @@ app dbStructure conf apiRequest = let stm = createWriteStatement sq mq (contentType == CTSingularJSON) False (contentType == CTTextCSV) - (iPreferRepresentation apiRequest) [] pgVer prepared + (iPreferRepresentation apiRequest) mempty pgVer prepared row <- H.statement mempty stm let (_, queryTotal, _, body, gucHeaders, gucStatus) = row gucs = (,) <$> gucHeaders <*> gucStatus @@ -338,7 +338,7 @@ app dbStructure conf apiRequest = _ -> return notFound where - notFound = responseLBS status404 [] "" + notFound = responseLBS status404 mempty "" maxRows = configDbMaxRows conf prepared = configDbPreparedStatements conf exactCount = iPreferCount apiRequest == Just ExactCount diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs index 0277c2919..1841f2786 100644 --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -27,7 +27,6 @@ import Data.Vector as V import Control.Lens (set) import Data.Time.Clock (UTCTime) -import Control.Lens.Operators import Crypto.JWT import PostgREST.Error (SimpleError (..)) @@ -41,7 +40,6 @@ import Protolude.Conv (toS) data JWTAttempt = JWTInvalid JWTError | JWTMissingSecret | JWTClaims (M.HashMap Text JSON.Value) - deriving (Eq, Show) jwtClaims :: JWTAttempt -> Either SimpleError (M.HashMap Text JSON.Value) @@ -117,7 +115,5 @@ parseSecret str = jwkFromSecret :: ByteString -> JWK jwkFromSecret key = fromKeyMaterial km - & jwkUse ?~ Sig - & jwkAlg ?~ JWSAlg HS256 where km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key)) diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 725d285c5..e04192cfe 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -86,7 +86,6 @@ data Command = CmdRun | CmdDumpConfig | CmdDumpSchema - deriving (Eq) -- | Config file settings for the server data AppConfig = AppConfig { @@ -118,7 +117,6 @@ data AppConfig = AppConfig { , configServerUnixSocket :: Maybe FilePath , configServerUnixSocketMode :: Either Text FileMode } - deriving (Show) configDbPoolTimeout' :: (Fractional a) => AppConfig -> a configDbPoolTimeout' = diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 8e02d030f..f2dff5693 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -46,11 +46,11 @@ import PostgREST.Types getDbStructure :: [Schema] -> [Schema] -> PgVersion -> Bool -> HT.Transaction DbStructure getDbStructure schemas extraSearchPath pgVer prepared = do HT.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object - tabs <- HT.statement () $ allTables prepared + tabs <- HT.statement mempty $ allTables prepared cols <- HT.statement schemas $ allColumns tabs prepared srcCols <- HT.statement (schemas, extraSearchPath) $ pfkSourceColumns cols prepared - m2oRels <- HT.statement () $ allM2ORels tabs cols prepared - keys <- HT.statement () $ allPrimaryKeys tabs prepared + m2oRels <- HT.statement mempty $ allM2ORels tabs cols prepared + keys <- HT.statement mempty $ allPrimaryKeys tabs prepared procs <- HT.statement schemas $ allProcs prepared let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels @@ -160,7 +160,7 @@ decodeProcs = qi = QualifiedIdentifier schema name pgType | isComposite = Composite qi - | otherwise = Scalar qi + | otherwise = Scalar parseVolatility :: Char -> ProcVolatility parseVolatility v | v == 'i' = Immutable @@ -835,7 +835,7 @@ pfkSourceColumns cols = order by view_schema, view_name, view_column_name; |] getPgVersion :: H.Session PgVersion -getPgVersion = H.statement () $ H.Statement sql HE.noParams versionRow False +getPgVersion = H.statement mempty $ H.Statement sql HE.noParams versionRow False where sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')" versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 608d19ebe..da18263cb 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -55,7 +55,6 @@ data ApiRequestError | UnacceptableSchema [Text] | UnknownRelation -- Unreachable? | UnsupportedVerb -- Unreachable? - deriving (Show, Eq) instance PgrstError ApiRequestError where status InvalidRange = HT.status416 @@ -114,7 +113,7 @@ compressedRel Relation{..} = "relationship" .= (constName <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relFColumns)) ] -data PgError = PgError Authenticated P.UsageError deriving Show +data PgError = PgError Authenticated P.UsageError type Authenticated = Bool instance PgrstError PgError where @@ -232,7 +231,6 @@ data SimpleError | JwtTokenInvalid Text | SingularityError Integer | ContentTypeError [ByteString] - deriving (Show, Eq) instance PgrstError SimpleError where status GucHeadersError = HT.status500 diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index 37ddd9cfb..fb1d76e77 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -32,7 +32,7 @@ import Protolude.Conv (toS) data ContentType = CTApplicationJSON | CTSingularJSON | CTTextCSV | CTTextPlain | CTOpenAPI | CTUrlEncoded | CTOctetStream - | CTAny | CTOther ByteString deriving (Show, Eq) + | CTAny | CTOther ByteString deriving (Eq) -- | Convert from ContentType to a full HTTP Header toHeader :: ContentType -> Header @@ -75,7 +75,7 @@ type SqlQuery = ByteString -- | A part of a SQL query that cannot be executed independently type SqlFragment = ByteString -data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq +data PreferResolution = MergeDuplicates | IgnoreDuplicates instance Show PreferResolution where show MergeDuplicates = "resolution=merge-duplicates" show IgnoreDuplicates = "resolution=ignore-duplicates" @@ -126,7 +126,7 @@ data DbStructure = DbStructure { , dbPrimaryKeys :: [PrimaryKey] , dbProcs :: ProcsMap , pgVersion :: PgVersion -} deriving (Show, Eq, Generic, JSON.ToJSON) +} deriving (Generic, JSON.ToJSON) -- TODO Table could hold references to all its Columns tableCols :: DbStructure -> Schema -> TableName -> [Column] @@ -141,14 +141,14 @@ data PgArg = PgArg { , pgaType :: Text , pgaReq :: Bool , pgaVar :: Bool -} deriving (Show, Eq, Ord, Generic, JSON.ToJSON) +} deriving (Eq, Ord, Generic, JSON.ToJSON) -data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier deriving (Eq, Show, Ord, Generic, JSON.ToJSON) +data PgType = Scalar | Composite QualifiedIdentifier deriving (Eq, Ord, Generic, JSON.ToJSON) -data RetType = Single PgType | SetOf PgType deriving (Eq, Show, Ord, Generic, JSON.ToJSON) +data RetType = Single PgType | SetOf PgType deriving (Eq, Ord, Generic, JSON.ToJSON) data ProcVolatility = Volatile | Stable | Immutable - deriving (Eq, Show, Ord, Generic, JSON.ToJSON) + deriving (Eq, Ord, Generic, JSON.ToJSON) data ProcDescription = ProcDescription { pdSchema :: Schema @@ -158,7 +158,7 @@ data ProcDescription = ProcDescription { , pdReturnType :: RetType , pdVolatility :: ProcVolatility , pdHasVariadic :: Bool -} deriving (Show, Eq, Generic, JSON.ToJSON) +} deriving (Eq, Generic, JSON.ToJSON) -- Order by least number of args in the case of overloaded functions instance Ord ProcDescription where @@ -203,9 +203,9 @@ specifiedProcArgs keys proc = procReturnsScalar :: ProcDescription -> Bool procReturnsScalar proc = case proc of - ProcDescription{pdReturnType = (Single (Scalar _))} -> True - ProcDescription{pdReturnType = (SetOf (Scalar _))} -> True - _ -> False + ProcDescription{pdReturnType = (Single Scalar)} -> True + ProcDescription{pdReturnType = (SetOf Scalar)} -> True + _ -> False procReturnsSingle :: ProcDescription -> Bool procReturnsSingle proc = case proc of @@ -234,7 +234,7 @@ instance Eq Table where tableQi :: Table -> QualifiedIdentifier tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n -newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord, Generic, JSON.ToJSON) +newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Eq, Ord, Generic, JSON.ToJSON) data Column = Column { @@ -247,7 +247,7 @@ data Column = , colDefault :: Maybe Text , colEnum :: [Text] , colFK :: Maybe ForeignKey - } deriving (Show, Ord, Generic, JSON.ToJSON) + } deriving (Ord, Generic, JSON.ToJSON) instance Eq Column where Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2 @@ -259,7 +259,7 @@ type ViewColumn = Column data PrimaryKey = PrimaryKey { pkTable :: Table , pkName :: Text -} deriving (Show, Eq, Generic, JSON.ToJSON) +} deriving (Generic, JSON.ToJSON) data OrderDirection = OrderAsc | OrderDesc deriving (Eq) instance Show OrderDirection where @@ -275,7 +275,7 @@ data OrderTerm = OrderTerm { otTerm :: Field , otDirection :: Maybe OrderDirection , otNullOrder :: Maybe OrderNulls -} deriving (Show, Eq) +} deriving (Eq) {-| Represents a pg identifier with a prepended schema name "schema.table" @@ -284,7 +284,7 @@ data OrderTerm = OrderTerm { data QualifiedIdentifier = QualifiedIdentifier { qiSchema :: Schema , qiName :: TableName -} deriving (Show, Eq, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey) +} deriving (Eq, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey) instance Hashable QualifiedIdentifier -- | The relationship [cardinality](https://en.wikipedia.org/wiki/Cardinality_(data_modeling)). @@ -310,7 +310,7 @@ data Relation = Relation { , relFColumns :: [Column] , relType :: Cardinality , relLink :: Link -- ^ Constraint on O2M/M2O, Junction for M2M Cardinality -} deriving (Show, Eq, Generic, JSON.ToJSON) +} deriving (Eq, Generic, JSON.ToJSON) type ConstraintName = Text @@ -324,7 +324,7 @@ data Link , junLink2 :: Link , junCols2 :: [Column] } - deriving (Show, Eq, Generic, JSON.ToJSON) + deriving (Eq, Generic, JSON.ToJSON) isSelfReference :: Relation -> Bool isSelfReference r = relTable r == relFTable r @@ -341,16 +341,16 @@ data PayloadJSON = }| RawJSON { pjRaw :: BL.ByteString - } deriving (Show, Eq) + } -data PJType = PJArray { pjaLength :: Int } | PJObject deriving (Show, Eq) +data PJType = PJArray { pjaLength :: Int } | PJObject data Proxy = Proxy { proxyScheme :: Text , proxyHost :: Text , proxyPort :: Integer , proxyPath :: Text -} deriving (Show, Eq) +} type Operator = Text operators :: M.HashMap Operator SqlFragment @@ -382,10 +382,10 @@ ftsOperators = M.fromList [ ("wfts", "@@ websearch_to_tsquery") ] -data OpExpr = OpExpr Bool Operation deriving (Eq, Show) +data OpExpr = OpExpr Bool Operation deriving (Eq) data Operation = Op Operator SingleVal | In ListVal | - Fts Operator (Maybe Language) SingleVal deriving (Eq, Show) + Fts Operator (Maybe Language) SingleVal deriving (Eq) type Language = Text -- | Represents a single value in a filter, e.g. id=eq.singleval @@ -406,7 +406,7 @@ instance Show LogicOperator where / \ id.eq.1 id.eq.2 -} -data LogicTree = Expr Bool LogicOperator [LogicTree] | Stmnt Filter deriving (Show, Eq) +data LogicTree = Expr Bool LogicOperator [LogicTree] | Stmnt Filter deriving (Eq) type FieldName = Text {-| @@ -414,9 +414,9 @@ type FieldName = Text -} type JsonPath = [JsonOperation] -- | Represents the single arrow `->` or double arrow `->>` operators -data JsonOperation = JArrow{jOp :: JsonOperand} | J2Arrow{jOp :: JsonOperand} deriving (Show, Eq) +data JsonOperation = JArrow{jOp :: JsonOperand} | J2Arrow{jOp :: JsonOperand} deriving (Eq) -- | Represents the key(`->'key'`) or index(`->'1`::int`), the index is Text because we reuse our escaping functons and let pg do the casting with '1'::int -data JsonOperand = JKey{jVal :: Text} | JIdx{jVal :: Text} deriving (Show, Eq) +data JsonOperand = JKey{jVal :: Text} | JIdx{jVal :: Text} deriving (Eq) type Field = (FieldName, JsonPath) type Alias = Text @@ -429,7 +429,6 @@ type NodeName = Text `SET LOCAL "response.headers" = '[{"Set-Cookie": ".."}]' -} newtype GucHeader = GucHeader (CI.CI ByteString, ByteString) - deriving (Show, Eq) instance JSON.FromJSON GucHeader where parseJSON (JSON.Object o) = case headMay (M.toList o) of @@ -457,9 +456,9 @@ type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe EmbedHint) type EmbedHint = Text -- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"] type EmbedPath = [Text] -data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Show, Eq) +data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Eq) data JoinCondition = JoinCondition (QualifiedIdentifier, FieldName) - (QualifiedIdentifier, FieldName) deriving (Show, Eq) + (QualifiedIdentifier, FieldName) deriving (Eq) data ReadQuery = Select { select :: [SelectItem] @@ -472,7 +471,7 @@ data ReadQuery = Select { , joinConditions :: [JoinCondition] , order :: [OrderTerm] , range_ :: NonnegRange -} deriving (Show, Eq) +} deriving (Eq) data MutateQuery = Insert { @@ -494,7 +493,7 @@ data MutateQuery = in_ :: QualifiedIdentifier , where_ :: [LogicTree] , returning :: [FieldName] - } deriving (Show, Eq) + } type ReadRequest = Tree ReadNode type MutateRequest = MutateQuery @@ -510,7 +509,7 @@ fstFieldNames (Node (sel, _) _) = data PgVersion = PgVersion { pgvNum :: Int32 , pgvName :: Text -} deriving (Eq, Show, Generic, JSON.ToJSON) +} deriving (Eq, Generic, JSON.ToJSON) instance Ord PgVersion where (PgVersion v1 _) `compare` (PgVersion v2 _) = v1 `compare` v2 @@ -552,7 +551,7 @@ sourceCTEName = "pgrst_source" -- | full jspath, e.g. .property[0].attr.detail type JSPath = [JSPathExp] -- | jspath expression, e.g. .property, .property[0] or ."property-dash" -data JSPathExp = JSPKey Text | JSPIdx Int deriving (Eq) +data JSPathExp = JSPKey Text | JSPIdx Int instance Show JSPathExp where -- TODO: this needs to be quoted properly for special chars @@ -564,16 +563,15 @@ data ConnectionStatus = NotConnected | Connected PgVersion | FatalConnectionError Text - deriving (Eq, Show) + deriving (Eq) -- | Schema cache status data SCacheStatus = SCLoaded | SCOnRetry | SCFatalFail - deriving (Eq, Show) -data LogLevel = LogCrit | LogError | LogWarn | LogInfo deriving (Eq) +data LogLevel = LogCrit | LogError | LogWarn | LogInfo instance Show LogLevel where show LogCrit = "crit"