src: consistently import HashMap as HM, Map as M
With both HashMap and Map imported as M in different modules, linter rules prevented ever importing both modules in one place.
This commit is contained in:
@@ -28,7 +28,7 @@ import System.Posix.Types (FileMode)
|
|||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
|
import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
|
||||||
import qualified Hasql.Pool as SQL
|
import qualified Hasql.Pool as SQL
|
||||||
@@ -314,7 +314,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
|
|||||||
let
|
let
|
||||||
ApiRequest{..} = ctxApiRequest
|
ApiRequest{..} = ctxApiRequest
|
||||||
pkCols = if iPreferRepresentation /= None || isJust iPreferResolution
|
pkCols = if iPreferRepresentation /= None || isJust iPreferResolution
|
||||||
then maybe mempty tablePKCols $ M.lookup identifier $ dbTables ctxDbStructure
|
then maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
|
||||||
else mempty
|
else mempty
|
||||||
|
|
||||||
WriteQueryResult{..} <- writeQuery MutationCreate identifier True pkCols context
|
WriteQueryResult{..} <- writeQuery MutationCreate identifier True pkCols context
|
||||||
@@ -371,7 +371,7 @@ handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
|
|||||||
|
|
||||||
handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
|
handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
|
||||||
handleSingleUpsert identifier context@(RequestContext _ ctxDbStructure ApiRequest{..} _) = do
|
handleSingleUpsert identifier context@(RequestContext _ ctxDbStructure ApiRequest{..} _) = do
|
||||||
let pkCols = maybe mempty tablePKCols $ M.lookup identifier $ dbTables ctxDbStructure
|
let pkCols = maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
|
||||||
|
|
||||||
WriteQueryResult{..} <- writeQuery MutationSingleUpsert identifier False pkCols context
|
WriteQueryResult{..} <- writeQuery MutationSingleUpsert identifier False pkCols context
|
||||||
|
|
||||||
@@ -419,7 +419,7 @@ handleInfo identifier RequestContext{..} =
|
|||||||
Nothing ->
|
Nothing ->
|
||||||
throwError Error.NotFound
|
throwError Error.NotFound
|
||||||
where
|
where
|
||||||
tbl = M.lookup identifier (dbTables ctxDbStructure)
|
tbl = HM.lookup identifier (dbTables ctxDbStructure)
|
||||||
allOrigins = ("Access-Control-Allow-Origin", "*")
|
allOrigins = ("Access-Control-Allow-Origin", "*")
|
||||||
allowH table =
|
allowH table =
|
||||||
( HTTP.hAllow
|
( HTTP.hAllow
|
||||||
@@ -489,8 +489,8 @@ handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure
|
|||||||
<*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
<*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
||||||
OAIgnorePriv ->
|
OAIgnorePriv ->
|
||||||
OpenAPI.encode conf dbStructure
|
OpenAPI.encode conf dbStructure
|
||||||
(M.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbTables dbStructure)
|
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbTables dbStructure)
|
||||||
(M.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure)
|
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure)
|
||||||
<$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
<$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
||||||
OADisabled ->
|
OADisabled ->
|
||||||
pure mempty
|
pure mempty
|
||||||
|
|||||||
@@ -22,7 +22,7 @@ import qualified Crypto.JWT as JWT
|
|||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.Aeson.Types as JSON
|
import qualified Data.Aeson.Types as JSON
|
||||||
import qualified Data.ByteString.Lazy.Char8 as LBS
|
import qualified Data.ByteString.Lazy.Char8 as LBS
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Text.Encoding as T
|
import qualified Data.Text.Encoding as T
|
||||||
import qualified Data.Vault.Lazy as Vault
|
import qualified Data.Vault.Lazy as Vault
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
@@ -45,7 +45,7 @@ import Protolude
|
|||||||
|
|
||||||
|
|
||||||
data AuthResult = AuthResult
|
data AuthResult = AuthResult
|
||||||
{ authClaims :: M.HashMap Text JSON.Value
|
{ authClaims :: HM.HashMap Text JSON.Value
|
||||||
, authRole :: Text
|
, authRole :: Text
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -78,13 +78,13 @@ parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
|
|||||||
role <- liftEither . maybeToRight JwtTokenRequired $
|
role <- liftEither . maybeToRight JwtTokenRequired $
|
||||||
unquoted <$> walkJSPath (Just jclaims) configJwtRoleClaimKey <|> configDbAnonRole
|
unquoted <$> walkJSPath (Just jclaims) configJwtRoleClaimKey <|> configDbAnonRole
|
||||||
return AuthResult
|
return AuthResult
|
||||||
{ authClaims = mclaims & M.insert "role" (JSON.toJSON role)
|
{ authClaims = mclaims & HM.insert "role" (JSON.toJSON role)
|
||||||
, authRole = role
|
, authRole = role
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
|
walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
|
||||||
walkJSPath x [] = x
|
walkJSPath x [] = x
|
||||||
walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (M.lookup key o) rest
|
walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (HM.lookup key o) rest
|
||||||
walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
|
walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
|
||||||
walkJSPath _ _ = Nothing
|
walkJSPath _ _ = Nothing
|
||||||
|
|
||||||
@@ -92,7 +92,7 @@ parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
|
|||||||
unquoted (JSON.String t) = t
|
unquoted (JSON.String t) = t
|
||||||
unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
|
unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
|
||||||
-- impossible case - just added to please -Wincomplete-patterns
|
-- impossible case - just added to please -Wincomplete-patterns
|
||||||
parseClaims _ _ = return AuthResult { authClaims = M.empty, authRole = mempty }
|
parseClaims _ _ = return AuthResult { authClaims = HM.empty, authRole = mempty }
|
||||||
|
|
||||||
-- | Validate authorization header.
|
-- | Validate authorization header.
|
||||||
-- Parse and store JWT claims for future use in the request.
|
-- Parse and store JWT claims for future use in the request.
|
||||||
|
|||||||
@@ -27,7 +27,7 @@ module PostgREST.DbStructure
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Hasql.Decoders as HD
|
||||||
import qualified Hasql.Encoders as HE
|
import qualified Hasql.Encoders as HE
|
||||||
@@ -100,16 +100,16 @@ queryDbStructure schemas extraSearchPath prepared = do
|
|||||||
, dbProcs = procs
|
, dbProcs = procs
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
relsToMap = map sort . M.fromListWith (++) . map ((\(x, fSch, y) -> ((x, fSch), [y])) . addKey)
|
relsToMap = map sort . HM.fromListWith (++) . map ((\(x, fSch, y) -> ((x, fSch), [y])) . addKey)
|
||||||
addKey rel = (relTable rel, qiSchema $ relForeignTable rel, rel)
|
addKey rel = (relTable rel, qiSchema $ relForeignTable rel, rel)
|
||||||
|
|
||||||
-- | Remove db objects that belong to an internal schema(not exposed through the API) from the DbStructure.
|
-- | Remove db objects that belong to an internal schema(not exposed through the API) from the DbStructure.
|
||||||
removeInternal :: [Schema] -> DbStructure -> DbStructure
|
removeInternal :: [Schema] -> DbStructure -> DbStructure
|
||||||
removeInternal schemas dbStruct =
|
removeInternal schemas dbStruct =
|
||||||
DbStructure {
|
DbStructure {
|
||||||
dbTables = M.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct
|
dbTables = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct
|
||||||
, dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$>
|
, dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$>
|
||||||
M.filterWithKey (\(QualifiedIdentifier sch _, _) _ -> sch `elem` schemas ) (dbRelationships dbStruct)
|
HM.filterWithKey (\(QualifiedIdentifier sch _, _) _ -> sch `elem` schemas ) (dbRelationships dbStruct)
|
||||||
, dbProcs = dbProcs dbStruct -- procs are only obtained from the exposed schemas, no need to filter them.
|
, dbProcs = dbProcs dbStruct -- procs are only obtained from the exposed schemas, no need to filter them.
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
@@ -119,7 +119,7 @@ removeInternal schemas dbStruct =
|
|||||||
|
|
||||||
decodeTables :: HD.Result TablesMap
|
decodeTables :: HD.Result TablesMap
|
||||||
decodeTables =
|
decodeTables =
|
||||||
M.fromList . map (\tbl@Table{tableSchema, tableName} -> (QualifiedIdentifier tableSchema tableName, tbl)) <$> HD.rowList tblRow
|
HM.fromList . map (\tbl@Table{tableSchema, tableName} -> (QualifiedIdentifier tableSchema tableName, tbl)) <$> HD.rowList tblRow
|
||||||
where
|
where
|
||||||
tblRow = Table
|
tblRow = Table
|
||||||
<$> column HD.text
|
<$> column HD.text
|
||||||
@@ -176,7 +176,7 @@ viewKeyDepFromRow (s1,t1,s2,v2,cons,consType,sCols) = ViewKeyDependency (Qualifi
|
|||||||
decodeProcs :: HD.Result ProcsMap
|
decodeProcs :: HD.Result ProcsMap
|
||||||
decodeProcs =
|
decodeProcs =
|
||||||
-- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance
|
-- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance
|
||||||
map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey) <$> HD.rowList procRow
|
map sort . HM.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey) <$> HD.rowList procRow
|
||||||
where
|
where
|
||||||
procRow = ProcDescription
|
procRow = ProcDescription
|
||||||
<$> column HD.text
|
<$> column HD.text
|
||||||
@@ -385,7 +385,7 @@ addM2MRels :: TablesMap -> [Relationship] -> [Relationship]
|
|||||||
addM2MRels tbls rels = rels ++ catMaybes
|
addM2MRels tbls rels = rels ++ catMaybes
|
||||||
[ let
|
[ let
|
||||||
jtCols = S.fromList $ (fst <$> cols) ++ (fst <$> fcols)
|
jtCols = S.fromList $ (fst <$> cols) ++ (fst <$> fcols)
|
||||||
pkCols = S.fromList $ maybe mempty tablePKCols $ M.lookup jt1 tbls
|
pkCols = S.fromList $ maybe mempty tablePKCols $ HM.lookup jt1 tbls
|
||||||
in if S.isSubsetOf jtCols pkCols
|
in if S.isSubsetOf jtCols pkCols
|
||||||
then Just $ Relationship t ft (t == ft) (M2M $ Junction jt1 cons1 cons2 (swap <$> cols) (swap <$> fcols)) tblIsView fTblisView
|
then Just $ Relationship t ft (t == ft) (M2M $ Junction jt1 cons1 cons2 (swap <$> cols) (swap <$> fcols)) tblIsView fTblisView
|
||||||
else Nothing
|
else Nothing
|
||||||
|
|||||||
@@ -15,7 +15,7 @@ module PostgREST.DbStructure.Proc
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
|
|
||||||
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
|
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
|
||||||
Schema, TableName)
|
Schema, TableName)
|
||||||
@@ -66,7 +66,7 @@ instance Ord ProcDescription where
|
|||||||
|
|
||||||
-- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription).
|
-- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription).
|
||||||
-- | It uses a HashMap for a faster lookup.
|
-- | It uses a HashMap for a faster lookup.
|
||||||
type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription]
|
type ProcsMap = HM.HashMap QualifiedIdentifier [ProcDescription]
|
||||||
|
|
||||||
procReturnsScalar :: ProcDescription -> Bool
|
procReturnsScalar :: ProcDescription -> Bool
|
||||||
procReturnsScalar proc = case proc of
|
procReturnsScalar proc = case proc of
|
||||||
|
|||||||
@@ -9,7 +9,7 @@ module PostgREST.DbStructure.Relationship
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
QualifiedIdentifier, Schema)
|
QualifiedIdentifier, Schema)
|
||||||
@@ -53,4 +53,4 @@ data Junction = Junction
|
|||||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||||
|
|
||||||
-- | Key based on the source table and the foreign table schema
|
-- | Key based on the source table and the foreign table schema
|
||||||
type RelationshipsMap = M.HashMap (QualifiedIdentifier, Schema) [Relationship]
|
type RelationshipsMap = HM.HashMap (QualifiedIdentifier, Schema) [Relationship]
|
||||||
|
|||||||
@@ -8,7 +8,7 @@ module PostgREST.DbStructure.Table
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
QualifiedIdentifier (..),
|
QualifiedIdentifier (..),
|
||||||
@@ -46,4 +46,4 @@ data Column = Column
|
|||||||
}
|
}
|
||||||
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
||||||
|
|
||||||
type TablesMap = M.HashMap QualifiedIdentifier Table
|
type TablesMap = HM.HashMap QualifiedIdentifier Table
|
||||||
|
|||||||
@@ -6,7 +6,7 @@ module PostgREST.GucHeader
|
|||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
|
|
||||||
import Network.HTTP.Types.Header (Header)
|
import Network.HTTP.Types.Header (Header)
|
||||||
|
|
||||||
@@ -21,7 +21,7 @@ newtype GucHeader = GucHeader (CI.CI ByteString, ByteString)
|
|||||||
|
|
||||||
instance JSON.FromJSON GucHeader where
|
instance JSON.FromJSON GucHeader where
|
||||||
parseJSON (JSON.Object o) =
|
parseJSON (JSON.Object o) =
|
||||||
case M.toList o of
|
case HM.toList o of
|
||||||
[(k, JSON.String s)] -> pure $ GucHeader (CI.mk $ toUtf8 k, toUtf8 s)
|
[(k, JSON.String s)] -> pure $ GucHeader (CI.mk $ toUtf8 k, toUtf8 s)
|
||||||
_ -> mzero
|
_ -> mzero
|
||||||
parseJSON _ = mzero
|
parseJSON _ = mzero
|
||||||
|
|||||||
@@ -11,7 +11,7 @@ module PostgREST.Middleware
|
|||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString.Lazy.Char8 as LBS
|
import qualified Data.ByteString.Lazy.Char8 as LBS
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as T
|
import qualified Data.Text.Encoding as T
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Hasql.Decoders as HD
|
||||||
@@ -38,7 +38,7 @@ import PostgREST.Request.Preferences
|
|||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
|
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
|
||||||
runPgLocals :: AppConfig -> M.HashMap Text JSON.Value -> Text ->
|
runPgLocals :: AppConfig -> HM.HashMap Text JSON.Value -> Text ->
|
||||||
(ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) ->
|
(ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) ->
|
||||||
ApiRequest -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response
|
ApiRequest -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response
|
||||||
runPgLocals conf claims role app req jsonDbS actualPgVersion = do
|
runPgLocals conf claims role app req jsonDbS actualPgVersion = do
|
||||||
@@ -57,7 +57,7 @@ runPgLocals conf claims role app req jsonDbS actualPgVersion = do
|
|||||||
then setConfigLocal "request.cookie." <$> iCookies req
|
then setConfigLocal "request.cookie." <$> iCookies req
|
||||||
else setConfigLocalJson "request.cookies" (iCookies req)
|
else setConfigLocalJson "request.cookies" (iCookies req)
|
||||||
claimsSql = if usesLegacyGucs
|
claimsSql = if usesLegacyGucs
|
||||||
then setConfigLocal "request.jwt.claim." <$> [(toUtf8 c, toUtf8 $ unquoted v) | (c,v) <- M.toList claims]
|
then setConfigLocal "request.jwt.claim." <$> [(toUtf8 c, toUtf8 $ unquoted v) | (c,v) <- HM.toList claims]
|
||||||
else [setConfigLocal mempty ("request.jwt.claims", LBS.toStrict $ JSON.encode claims)]
|
else [setConfigLocal mempty ("request.jwt.claims", LBS.toStrict $ JSON.encode claims)]
|
||||||
roleSql = [setConfigLocal mempty ("role", toUtf8 role)]
|
roleSql = [setConfigLocal mempty ("role", toUtf8 role)]
|
||||||
appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings conf)
|
appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings conf)
|
||||||
@@ -116,6 +116,6 @@ setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [SQL.Snippet]
|
|||||||
setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]
|
setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]
|
||||||
where
|
where
|
||||||
gucJsonVal :: [(ByteString, ByteString)] -> ByteString
|
gucJsonVal :: [(ByteString, ByteString)] -> ByteString
|
||||||
gucJsonVal = LBS.toStrict . JSON.encode . M.fromList . arrayByteStringToText
|
gucJsonVal = LBS.toStrict . JSON.encode . HM.fromList . arrayByteStringToText
|
||||||
arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)]
|
arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)]
|
||||||
arrayByteStringToText keyVal = (T.decodeUtf8 *** T.decodeUtf8) <$> keyVal
|
arrayByteStringToText keyVal = (T.decodeUtf8 *** T.decodeUtf8) <$> keyVal
|
||||||
|
|||||||
@@ -9,7 +9,7 @@ module PostgREST.OpenAPI (encode) where
|
|||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashMap.Strict as M
|
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 qualified Data.Text.Encoding as T
|
||||||
@@ -41,13 +41,13 @@ import PostgREST.ContentType
|
|||||||
|
|
||||||
import Protolude hiding (Proxy, get)
|
import Protolude hiding (Proxy, get)
|
||||||
|
|
||||||
encode :: AppConfig -> DbStructure -> TablesMap -> M.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
|
encode :: AppConfig -> DbStructure -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
|
||||||
encode conf dbStructure tables procs schemaDescription =
|
encode conf dbStructure tables procs schemaDescription =
|
||||||
JSON.encode $
|
JSON.encode $
|
||||||
postgrestSpec
|
postgrestSpec
|
||||||
(dbRelationships dbStructure)
|
(dbRelationships dbStructure)
|
||||||
(concat $ M.elems procs)
|
(concat $ HM.elems procs)
|
||||||
(snd <$> M.toList tables)
|
(snd <$> HM.toList tables)
|
||||||
(proxyUri conf)
|
(proxyUri conf)
|
||||||
schemaDescription
|
schemaDescription
|
||||||
|
|
||||||
@@ -100,7 +100,7 @@ makeProperty tbl rels col = (colName col, Inline s)
|
|||||||
rel = find (\case
|
rel = find (\case
|
||||||
Relationship{relCardinality=(M2O _ relColumns)} -> [colName col] == (fst <$> relColumns)
|
Relationship{relCardinality=(M2O _ relColumns)} -> [colName col] == (fst <$> relColumns)
|
||||||
_ -> False
|
_ -> False
|
||||||
) $ fromMaybe mempty $ M.lookup (QualifiedIdentifier (tableSchema tbl) (tableName tbl), tableSchema tbl) rels
|
) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier (tableSchema tbl) (tableName tbl), tableSchema tbl) rels
|
||||||
fCol = (headMay . (\r -> snd <$> relColumns (relCardinality r)) =<< rel)
|
fCol = (headMay . (\r -> snd <$> relColumns (relCardinality r)) =<< rel)
|
||||||
fTbl = qiName . relForeignTable <$> rel
|
fTbl = qiName . relForeignTable <$> rel
|
||||||
fTblCol = (,) <$> fTbl <*> fCol
|
fTblCol = (,) <$> fTbl <*> fCol
|
||||||
|
|||||||
@@ -22,7 +22,7 @@ import qualified Data.ByteString.Char8 as BS
|
|||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.Csv as CSV
|
import qualified Data.Csv as CSV
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
import qualified Data.List.NonEmpty as NonEmptyList
|
import qualified Data.List.NonEmpty as NonEmptyList
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
@@ -129,10 +129,10 @@ toRpcParamValue proc (k, v) | prmIsVariadic k = (k, Variadic [v])
|
|||||||
jsonRpcParams :: ProcDescription -> [(Text, Text)] -> Payload
|
jsonRpcParams :: ProcDescription -> [(Text, Text)] -> Payload
|
||||||
jsonRpcParams proc prms =
|
jsonRpcParams proc prms =
|
||||||
if not $ pdHasVariadic proc then -- if proc has no variadic param, save steps and directly convert to json
|
if not $ pdHasVariadic proc then -- if proc has no variadic param, save steps and directly convert to json
|
||||||
ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> prms) (S.fromList $ fst <$> prms)
|
ProcessedJSON (JSON.encode $ HM.fromList $ second JSON.toJSON <$> prms) (S.fromList $ fst <$> prms)
|
||||||
else
|
else
|
||||||
let paramsMap = M.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
|
let paramsMap = HM.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
|
||||||
ProcessedJSON (JSON.encode paramsMap) (S.fromList $ M.keys paramsMap)
|
ProcessedJSON (JSON.encode paramsMap) (S.fromList $ HM.keys paramsMap)
|
||||||
where
|
where
|
||||||
mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
|
mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
|
||||||
mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
|
mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
|
||||||
@@ -153,7 +153,7 @@ targetToJsonRpcParams target params =
|
|||||||
-}
|
-}
|
||||||
data ApiRequest = ApiRequest {
|
data ApiRequest = ApiRequest {
|
||||||
iAction :: Action -- ^ Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
|
iAction :: Action -- ^ Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
|
||||||
, iRange :: M.HashMap Text NonnegRange -- ^ Requested range of rows within response
|
, iRange :: HM.HashMap Text NonnegRange -- ^ Requested range of rows within response
|
||||||
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
|
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
|
||||||
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
|
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
|
||||||
, iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions
|
, iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions
|
||||||
@@ -252,13 +252,13 @@ apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..
|
|||||||
json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
|
json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
|
||||||
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
|
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
|
||||||
(CTUrlEncoded, _) ->
|
(CTUrlEncoded, _) ->
|
||||||
let paramsMap = M.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in
|
let paramsMap = HM.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in
|
||||||
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (M.keys paramsMap)
|
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
|
||||||
(CTTextPlain, True) -> Right $ RawPay reqBody
|
(CTTextPlain, True) -> Right $ RawPay reqBody
|
||||||
(CTTextXML, True) -> Right $ RawPay reqBody
|
(CTTextXML, True) -> Right $ RawPay reqBody
|
||||||
(CTOctetStream, True) -> Right $ RawPay reqBody
|
(CTOctetStream, True) -> Right $ RawPay reqBody
|
||||||
(ct, _) -> Left $ "Content-Type not acceptable: " <> ContentType.toMime ct
|
(ct, _) -> Left $ "Content-Type not acceptable: " <> ContentType.toMime ct
|
||||||
topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges -- if no limit is specified, get all the request rows
|
topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows
|
||||||
action =
|
action =
|
||||||
case method of
|
case method of
|
||||||
-- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
|
-- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
|
||||||
@@ -335,12 +335,12 @@ apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..
|
|||||||
lookupHeader = flip lookup hdrs
|
lookupHeader = flip lookup hdrs
|
||||||
Preferences.Preferences{..} = Preferences.fromHeaders hdrs
|
Preferences.Preferences{..} = Preferences.fromHeaders hdrs
|
||||||
headerRange = rangeRequested hdrs
|
headerRange = rangeRequested hdrs
|
||||||
limitRange = fromMaybe allRange (M.lookup "limit" qsRanges)
|
limitRange = fromMaybe allRange (HM.lookup "limit" qsRanges)
|
||||||
headerAndLimitRange = rangeIntersection headerRange limitRange
|
headerAndLimitRange = rangeIntersection headerRange limitRange
|
||||||
|
|
||||||
-- Bypass all the ranges and send only the limit zero range (0 <= x <= -1) if
|
-- Bypass all the ranges and send only the limit zero range (0 <= x <= -1) if
|
||||||
-- limit=0 is present in the query params (not allowed for the Range header)
|
-- limit=0 is present in the query params (not allowed for the Range header)
|
||||||
ranges = M.insert "limit" (if hasLimitZero limitRange then limitZeroRange else headerAndLimitRange) qsRanges
|
ranges = HM.insert "limit" (if hasLimitZero limitRange then limitZeroRange else headerAndLimitRange) qsRanges
|
||||||
-- The only emptyRange allowed is the limit zero range
|
-- The only emptyRange allowed is the limit zero range
|
||||||
isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
|
isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
|
||||||
|
|
||||||
@@ -357,7 +357,7 @@ mutuallyAgreeable sProduces cAccepts =
|
|||||||
then listToMaybe sProduces
|
then listToMaybe sProduces
|
||||||
else exact
|
else exact
|
||||||
|
|
||||||
type CsvData = V.Vector (M.HashMap Text LBS.ByteString)
|
type CsvData = V.Vector (HM.HashMap Text LBS.ByteString)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Converts CSV like
|
Converts CSV like
|
||||||
@@ -376,7 +376,7 @@ csvToJson (_, vals) =
|
|||||||
JSON.Array $ V.map rowToJsonObj vals
|
JSON.Array $ V.map rowToJsonObj vals
|
||||||
where
|
where
|
||||||
rowToJsonObj = JSON.Object .
|
rowToJsonObj = JSON.Object .
|
||||||
M.map (\str ->
|
HM.map (\str ->
|
||||||
if str == "NULL"
|
if str == "NULL"
|
||||||
then JSON.Null
|
then JSON.Null
|
||||||
else JSON.String . T.decodeUtf8 $ LBS.toStrict str
|
else JSON.String . T.decodeUtf8 $ LBS.toStrict str
|
||||||
@@ -389,9 +389,9 @@ payloadAttributes raw json =
|
|||||||
JSON.Array arr ->
|
JSON.Array arr ->
|
||||||
case arr V.!? 0 of
|
case arr V.!? 0 of
|
||||||
Just (JSON.Object o) ->
|
Just (JSON.Object o) ->
|
||||||
let canonicalKeys = S.fromList $ M.keys o
|
let canonicalKeys = S.fromList $ HM.keys o
|
||||||
areKeysUniform = all (\case
|
areKeysUniform = all (\case
|
||||||
JSON.Object x -> S.fromList (M.keys x) == canonicalKeys
|
JSON.Object x -> S.fromList (HM.keys x) == canonicalKeys
|
||||||
_ -> False) arr in
|
_ -> False) arr in
|
||||||
if areKeysUniform
|
if areKeysUniform
|
||||||
then Just $ ProcessedJSON raw canonicalKeys
|
then Just $ ProcessedJSON raw canonicalKeys
|
||||||
@@ -399,7 +399,7 @@ payloadAttributes raw json =
|
|||||||
Just _ -> Nothing
|
Just _ -> Nothing
|
||||||
Nothing -> Just emptyPJArray
|
Nothing -> Just emptyPJArray
|
||||||
|
|
||||||
JSON.Object o -> Just $ ProcessedJSON raw (S.fromList $ M.keys o)
|
JSON.Object o -> Just $ ProcessedJSON raw (S.fromList $ HM.keys o)
|
||||||
|
|
||||||
-- truncate everything else to an empty array.
|
-- truncate everything else to an empty array.
|
||||||
_ -> Just emptyPJArray
|
_ -> Just emptyPJArray
|
||||||
@@ -449,7 +449,7 @@ findProc qi argumentsKeys paramsAsSingleObject allProcs contentType isInvPost =
|
|||||||
([proc], _) -> Right proc
|
([proc], _) -> Right proc
|
||||||
(procs, _) -> Left $ AmbiguousRpc (toList procs)
|
(procs, _) -> Left $ AmbiguousRpc (toList procs)
|
||||||
where
|
where
|
||||||
matchProc = overloadedProcPartition $ M.lookupDefault mempty qi allProcs -- first find the proc by name
|
matchProc = overloadedProcPartition $ HM.lookupDefault mempty qi allProcs -- first find the proc by name
|
||||||
-- The partition obtained has the form (overloadedProcs,fallbackProcs)
|
-- The partition obtained has the form (overloadedProcs,fallbackProcs)
|
||||||
-- where fallbackProcs are functions with a single unnamed parameter
|
-- where fallbackProcs are functions with a single unnamed parameter
|
||||||
overloadedProcPartition procs = foldr select ([],[]) procs
|
overloadedProcPartition procs = foldr select ([],[]) procs
|
||||||
|
|||||||
@@ -21,7 +21,7 @@ module PostgREST.Request.DbRequestBuilder
|
|||||||
, callRequest
|
, callRequest
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
import Data.Either.Combinators (mapLeft)
|
import Data.Either.Combinators (mapLeft)
|
||||||
@@ -206,7 +206,7 @@ findRel schema allRels origin target hint =
|
|||||||
-- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
|
-- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
|
||||||
matchJunction hnt relCardinality -- users_tasks
|
matchJunction hnt relCardinality -- users_tasks
|
||||||
)
|
)
|
||||||
) $ fromMaybe mempty $ M.lookup (QualifiedIdentifier schema origin, schema) allRels
|
) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels
|
||||||
|
|
||||||
-- previousAlias is only used for the case of self joins
|
-- previousAlias is only used for the case of self joins
|
||||||
addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
|
addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
@@ -283,7 +283,7 @@ addRanges ApiRequest{..} rReq =
|
|||||||
_ -> foldr addRangeToNode (Right rReq) =<< ranges
|
_ -> foldr addRangeToNode (Right rReq) =<< ranges
|
||||||
where
|
where
|
||||||
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
|
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
|
||||||
ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` M.toList iRange
|
ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` HM.toList iRange
|
||||||
|
|
||||||
addRangeToNode :: (EmbedPath, NonnegRange) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
addRangeToNode :: (EmbedPath, NonnegRange) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
addRangeToNode = updateNode (\r (Node (q,i) f) -> Node (q{range_=r}, i) f)
|
addRangeToNode = updateNode (\r (Node (q,i) f) -> Node (q{range_=r}, i) f)
|
||||||
|
|||||||
@@ -13,7 +13,7 @@ module PostgREST.Request.QueryParams
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
@@ -78,7 +78,7 @@ data QueryParams =
|
|||||||
-- ^ Canonical representation of the query params, sorted alphabetically
|
-- ^ Canonical representation of the query params, sorted alphabetically
|
||||||
, qsParams :: [(Text, Text)]
|
, qsParams :: [(Text, Text)]
|
||||||
-- ^ Parameters for RPC calls
|
-- ^ Parameters for RPC calls
|
||||||
, qsRanges :: M.HashMap Text (Range Integer)
|
, qsRanges :: HM.HashMap Text (Range Integer)
|
||||||
-- ^ Ranges derived from &limit and &offset params
|
-- ^ Ranges derived from &limit and &offset params
|
||||||
, qsOrder :: [(EmbedPath, [OrderTerm])]
|
, qsOrder :: [(EmbedPath, [OrderTerm])]
|
||||||
-- ^ &order parameters for each level
|
-- ^ &order parameters for each level
|
||||||
@@ -192,8 +192,8 @@ parse qs =
|
|||||||
isEmbedPath = T.isInfixOf "."
|
isEmbedPath = T.isInfixOf "."
|
||||||
replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) <> [x]
|
replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) <> [x]
|
||||||
|
|
||||||
ranges :: M.HashMap Text (Range Integer)
|
ranges :: HM.HashMap Text (Range Integer)
|
||||||
ranges = M.unionWith f limitParams offsetParams
|
ranges = HM.unionWith f limitParams offsetParams
|
||||||
where
|
where
|
||||||
f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
|
f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
|
||||||
where
|
where
|
||||||
@@ -201,10 +201,10 @@ parse qs =
|
|||||||
o = rangeOffset ro
|
o = rangeOffset ro
|
||||||
|
|
||||||
limitParams =
|
limitParams =
|
||||||
M.fromList [(k, restrictRange (readMaybe v) allRange) | (k,v) <- limits]
|
HM.fromList [(k, restrictRange (readMaybe v) allRange) | (k,v) <- limits]
|
||||||
|
|
||||||
offsetParams =
|
offsetParams =
|
||||||
M.fromList [(k, maybe allRange rangeGeq (readMaybe v)) | (k,v) <- offsets]
|
HM.fromList [(k, maybe allRange rangeGeq (readMaybe v)) | (k,v) <- offsets]
|
||||||
|
|
||||||
operator :: Text -> Maybe SimpleOperator
|
operator :: Text -> Maybe SimpleOperator
|
||||||
operator = \case
|
operator = \case
|
||||||
|
|||||||
Reference in New Issue
Block a user