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

Do hlint 2.1 hints

Browse Source
This commit is contained in:
steve-chavez
2018-11-06 11:54:10 -05:00
committed by Steve Chávez
parent 63ead89470
commit dadfe965b9
23 changed files with 49 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/ApiRequest.hs
+4 -5
View File
@@ -110,8 +110,7 @@ userApiRequest schema req reqBody
iAction = action
, iTarget = target
, iRange = ranges
, iAccepts = fromMaybe [CTAny] $
map decodeContentType . parseHttpAccept <$> lookupHeader "accept"
, iAccepts = maybe [CTAny] (map decodeContentType . parseHttpAccept) $ lookupHeader "accept"
, iPayload = relevantPayload
, iPreferRepresentation = representation
, iPreferSingleObjectParameter = singleObject
@@ -130,7 +129,7 @@ userApiRequest schema req reqBody
$ rawQueryString req
, iJWT = tokenStr
, iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hAuthorization, k /= hCookie]
, iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie"
, iCookies = maybe [] parseCookiesText $ lookupHeader "Cookie"
}
where
-- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
@@ -143,7 +142,7 @@ userApiRequest schema req reqBody
((<> ".") <$> "not":M.keys operators) ++
((<> "(") <$> M.keys ftsOperators)
isEmbedPath = T.isInfixOf "."
isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
isTargetingProc = (== Just "rpc") $ listToMaybe path
payload =
case (decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type", action) of
(_, ActionInvoke{isReadOnly=True}) ->
@@ -215,7 +214,7 @@ userApiRequest schema req reqBody
limitParams :: M.HashMap ByteString NonnegRange
limitParams = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe =<< (toS <$> v)) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
offsetParams :: M.HashMap ByteString NonnegRange
offsetParams = M.fromList [(toS (replaceLast "limit" k), fromMaybe allRange (rangeGeq <$> (readMaybe =<< (toS <$> v)))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
offsetParams = M.fromList [(toS (replaceLast "limit" k), maybe allRange rangeGeq (readMaybe =<< (toS <$> v))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
urlRange = M.unionWith f limitParams offsetParams
where
src/PostgREST/App.hs
+4 -4
View File
@@ -109,7 +109,7 @@ transactionMode proc action =
ActionInfo -> HT.Read
ActionInspect -> HT.Read
ActionInvoke{isReadOnly=False} ->
let v = fromMaybe Volatile $ pdVolatility <$> proc in
let v = maybe Volatile pdVolatility proc in
if v == Stable || v == Immutable
then HT.Read
else HT.Write
@@ -286,7 +286,7 @@ app dbStructure proc conf apiRequest =
PJObject -> True
PJArray _ -> False
singular = contentType == CTSingularJSON
specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ fromMaybe [] (pdArgs <$> proc)
specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ maybe [] pdArgs proc
row <- H.statement (toS pjRaw) $
callProc qi specifiedPgArgs returnsScalar q cq shouldCount
singular (iPreferSingleObjectParameter apiRequest)
@@ -397,8 +397,8 @@ contentRangeH lower upper total =
rangeString
| totalNotZero && fromInRange = show lower <> "-" <> show upper
| otherwise = "*"
totalString = fromMaybe "*" (show <$> total)
totalNotZero = fromMaybe True ((/=) 0 <$> total)
totalString = maybe "*" show total
totalNotZero = maybe True (0 /=) total
fromInRange = lower <= upper
extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount
src/PostgREST/Auth.hs
+2 -2
View File
@@ -95,7 +95,7 @@ parseJWK str =
hs256jwk :: ByteString -> JWK
hs256jwk key =
fromKeyMaterial km
& jwkUse .~ Just Sig
& jwkAlg .~ (Just $ JWSAlg HS256)
& jwkUse ?~ Sig
& jwkAlg ?~ JWSAlg HS256
where
km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key))
src/PostgREST/DbRequestBuilder.hs
+2 -2
View File
@@ -36,7 +36,7 @@ import PostgREST.Parsers
import PostgREST.RangeQuery (NonnegRange, restrictRange, allRange)
import PostgREST.Types
import Protolude hiding (from, dropWhile, drop)
import Protolude hiding (from)
import Text.Regex.TDFA ((=~))
import Unsafe (unsafeHead)
@@ -229,7 +229,7 @@ getJoinConditions (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{
if | typ == Child || typ == Parent ->
zipWith (toJoinCondition tN ftN) cols fCols
| typ == Many ->
let ltN = fromMaybe "" (tableName <$> lt) in
let ltN = maybe "" tableName lt in
zipWith (toJoinCondition tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toJoinCondition ftN ltN) fCols (fromMaybe [] lc2)
| typ == Root -> witness
where
src/PostgREST/DbStructure.hs
+1 -1
View File
@@ -538,7 +538,7 @@ columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn <
buildColumn tbl = Column tbl n desc pos nul typ u l p d (parseEnum e) Nothing
table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
parseEnum :: Maybe Text -> [Text]
parseEnum str = fromMaybe [] $ split (==',') <$> str
parseEnum = maybe [] (split (==','))
allChildRelations :: [Table] -> [Column] -> H.Statement () [Relation]
allChildRelations tabs cols =
src/PostgREST/Middleware.hs
+1 -1
View File
@@ -21,7 +21,7 @@ import PostgREST.Config (AppConfig (..), corsPolicy)
import PostgREST.Error (simpleError)
import PostgREST.QueryBuilder (pgFmtLit, unquoted, pgFmtSetLocal)
import Protolude hiding (concat, null)
import Protolude
runWithClaims :: AppConfig -> JWTAttempt ->
(ApiRequest -> H.Transaction Response) ->
src/PostgREST/OpenAPI.hs
+1 -1
View File
@@ -60,7 +60,7 @@ makeProperty pks c = (colName c, Inline s)
]
d =
if length n > 1 then
Just $ append (fromMaybe "" ((`append` "\n\n") <$> colDescription c)) (intercalate "\n" n)
Just $ append (maybe "" (`append` "\n\n") $ colDescription c) (intercalate "\n" n)
else
colDescription c
s =
src/PostgREST/Parsers.hs
+10 -8
View File
@@ -3,6 +3,7 @@ module PostgREST.Parsers where
import Protolude hiding (try, intercalate, replace, option)
import Control.Monad ((>>))
import Data.Foldable (foldl1)
import Data.Functor (($>))
import qualified Data.HashMap.Strict as M
import Data.Text (intercalate, replace, strip)
import Data.List (init, last)
@@ -68,17 +69,18 @@ pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
Node <$> pFieldSelect <*> pure []
pStar :: Parser Text
pStar = toS <$> (string "*" *> pure ("*"::ByteString))
pStar = toS <$> (string "*" $> ("*"::ByteString))
pFieldName :: Parser Text
pFieldName = do
matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) <?> "field name (* or [a..z0..9_])"
return $ intercalate "-" $ map toS matches
pFieldName =
intercalate "-" . map toS <$>
(many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) <?>
"field name (* or [a..z0..9_])"
where
isDash :: GenParser Char st ()
isDash = try ( char '-' >> notFollowedBy (char '>') )
dash :: Parser Char
dash = isDash *> pure '-'
dash = isDash $> '-'
pJsonPath :: Parser JsonPath
pJsonPath = many pJsonOperation
@@ -184,12 +186,12 @@ pLogicTree = Stmnt <$> try pLogicFilter
pLogicFilter :: Parser Filter
pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
pNot :: Parser Bool
pNot = try (string "not" *> pDelimiter *> pure True)
pNot = try (string "not" *> pDelimiter $> True)
<|> pure False
<?> "negation operator (not)"
pLogicOp :: Parser LogicOperator
pLogicOp = try (string "and" *> pure And)
<|> string "or" *> pure Or
pLogicOp = try (string "and" $> And)
<|> string "or" $> Or
<?> "logic operator (and, or)"
pLogicSingleVal :: Parser SingleVal
src/PostgREST/QueryBuilder.hs
+3 -3
View File
@@ -47,7 +47,7 @@ import Data.Scientific ( FPFormat (..)
, formatScientific
, isInteger
)
import Protolude hiding (from, intercalate, ord, cast, replace)
import Protolude hiding ( intercalate, cast, replace)
import PostgREST.ApiRequest (PreferRepresentation (..))
{-| The generic query result format used by API responses. The location header
@@ -229,7 +229,7 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest
("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (isParent || range == allRange) ]
where
mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
mainTbl = maybe nodeName (tableName . relTable) maybeRelation
isSelfJoin = maybe False (\r -> relType r /= Root && relTable r == relFTable r) maybeRelation
(qi, tables, joinConds) =
let depthAlias name dpth = if dpth /= 0 then name <> "_" <> show dpth else name in -- Root node doesn't get aliased
@@ -413,7 +413,7 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper
In vals -> pgFmtField table fld <> " " <>
let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
case ((&&) (length vals == 1) . T.null) <$> headMay vals of
case (&&) (length vals == 1) . T.null <$> headMay vals of
Just False -> sqlOperator "in" <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
Just True -> emptyValForIn
Nothing -> emptyValForIn
src/PostgREST/RangeQuery.hs
+3 -4
View File
@@ -32,14 +32,13 @@ rangeParse range = do
case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
Just parsedRange ->
let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange
lower = fromMaybe emptyRange (rangeGeq <$> mLower)
upper = fromMaybe allRange (rangeLeq <$> mUpper) in
lower = maybe emptyRange rangeGeq mLower
upper = maybe allRange rangeLeq mUpper in
rangeIntersection lower upper
Nothing -> allRange
rangeRequested :: RequestHeaders -> NonnegRange
rangeRequested headers = fromMaybe allRange $
rangeParse <$> lookup hRange headers
rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers
restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
restrictRange Nothing r = r
test/Feature/AsymmetricJwtSpec.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
import Protolude
-- }}}
spec :: SpecWith Application
test/Feature/BinaryJwtSecretSpec.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
import Protolude
-- }}}
spec :: SpecWith Application
test/Feature/ConcurrentSpec.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Control.Monad.Base
import Control.Monad.Trans.Control
import Control.Concurrent.Async (mapConcurrently)
import Test.Hspec hiding (pendingWith)
import Test.Hspec
import Test.Hspec.Wai.Internal
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
test/Feature/CorsSpec.hs
+1 -1
View File
@@ -11,7 +11,7 @@ import SpecHelper
import Network.HTTP.Types
import Network.Wai (Application)
import Protolude hiding (get)
import Protolude
-- }}}
spec :: SpecWith Application
test/Feature/NoJwtSpec.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
import Protolude
-- }}}
spec :: SpecWith Application
test/Feature/PgVersion95Spec.hs
+1 -1
View File
@@ -1,6 +1,6 @@
module Feature.PgVersion95Spec where
import Test.Hspec hiding (pendingWith)
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
test/Feature/PgVersion96Spec.hs
+1 -1
View File
@@ -1,6 +1,6 @@
module Feature.PgVersion96Spec where
import Test.Hspec hiding (pendingWith)
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
test/Feature/ProxySpec.hs
+2 -2
View File
@@ -1,12 +1,12 @@
module Feature.ProxySpec where
import Test.Hspec hiding (pendingWith)
import Test.Hspec
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
import Protolude
spec :: SpecWith Application
spec =
test/Feature/QueryLimitedSpec.hs
+1 -1
View File
@@ -1,6 +1,6 @@
module Feature.QueryLimitedSpec where
import Test.Hspec hiding (pendingWith)
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
test/Feature/QuerySpec.hs
+1 -1
View File
@@ -1,6 +1,6 @@
module Feature.QuerySpec where
import Test.Hspec hiding (pendingWith)
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
test/Feature/RpcSpec.hs
+2 -2
View File
@@ -1,6 +1,6 @@
module Feature.RpcSpec where
import Test.Hspec hiding (pendingWith)
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
@@ -372,7 +372,7 @@ spec =
[json|[{"text_search_vector":"'amus':5 'fair':7 'impossibl':9 'peu':4"},{"text_search_vector":"'art':4 'spass':5 'unmog':7"}]|]
{ matchHeaders = [matchContentTypeJson] }
it "should work with an argument of custom type in public schema" $ do
it "should work with an argument of custom type in public schema" $
get "/rpc/test_arg?my_arg=something" `shouldRespondWith`
[json|"foobar"|]
{ matchHeaders = [matchContentTypeJson] }
test/Feature/StructureSpec.hs
+1 -1
View File
@@ -1,6 +1,6 @@
module Feature.StructureSpec where
import Test.Hspec hiding (pendingWith)
import Test.Hspec
import Test.Hspec.Wai
import Network.HTTP.Types
test/SpecHelper.hs
+4 -5
View File
@@ -19,7 +19,7 @@ import Text.Heredoc
import PostgREST.Config (AppConfig(..))
import PostgREST.Types (JSPathExp(..))
import Test.Hspec hiding (pendingWith)
import Test.Hspec
import Test.Hspec.Wai
import Network.HTTP.Types
@@ -61,9 +61,8 @@ validateOpenApiResponse headers = do
D4.fetchFilesystemAndValidate schemaContext ((fromJust . decode) respBody) `shouldReturn` Right ()
getEnvVarWithDefault :: Text -> Text -> IO Text
getEnvVarWithDefault var def = do
varValue <- getEnv (toS var) `E.catchIOError` const (return $ toS def)
return $ toS varValue
getEnvVarWithDefault var def = toS <$>
getEnv (toS var) `E.catchIOError` const (return $ toS def)
_baseCfg :: AppConfig
_baseCfg = -- Connection Settings
@@ -166,5 +165,5 @@ isErrorFormat s =
S.null (S.difference keys validKeys)
where
obj = decode s :: Maybe (M.Map Text Value)
keys = fromMaybe S.empty (M.keysSet <$> obj)
keys = maybe S.empty M.keysSet obj
validKeys = S.fromList ["message", "details", "hint", "code"]