From 9bcf39f41f747e5b78b7825caa3b7c5151555505 Mon Sep 17 00:00:00 2001 From: Robert Date: Mon, 17 Jun 2019 23:54:45 +0200 Subject: [PATCH] Upgrade hasql to 1.4 (#1325) --- postgrest.cabal | 12 ++--- src/PostgREST/DbStructure.hs | 94 ++++++++++++++++++++--------------- src/PostgREST/QueryBuilder.hs | 28 ++++++++--- stack.yaml | 6 +++ 4 files changed, 85 insertions(+), 55 deletions(-) diff --git a/postgrest.cabal b/postgrest.cabal index fe2780ef2..48fa148a7 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -56,9 +56,9 @@ library , cookie >= 0.4.2 && < 0.5 , either >= 4.4.1 && < 5.1 , gitrev >= 1.2 && < 1.4 - , hasql >= 1.3 && < 1.4 + , hasql >= 1.4 && < 1.5 , hasql-pool >= 0.5 && < 0.6 - , hasql-transaction >= 0.7 && < 0.8 + , hasql-transaction >= 0.7.2 && < 0.8 , heredoc >= 0.2 && < 0.3 , http-types >= 0.12.2 && < 0.13 , insert-ordered-containers >= 0.1 && < 0.3 @@ -94,9 +94,9 @@ executable postgrest , base64-bytestring >= 1 && < 1.1 , bytestring >= 0.10.8 && < 0.11 , directory >= 1.2.6 && < 1.4 - , hasql >= 1.3 && < 1.4 + , hasql >= 1.4 && < 1.5 , hasql-pool >= 0.5 && < 0.6 - , hasql-transaction >= 0.7 && < 0.8 + , hasql-transaction >= 0.7.2 && < 0.8 , network < 2.9 , postgrest , protolude >= 0.2.2 && < 0.3 @@ -155,9 +155,9 @@ test-suite spec , cassava >= 0.4.5 && < 0.6 , containers >= 0.5.7 && < 0.7 , contravariant >= 1.4 && < 1.6 - , hasql >= 1.3 && < 1.4 + , hasql >= 1.4 && < 1.5 , hasql-pool >= 0.5 && < 0.6 - , hasql-transaction >= 0.7 && < 0.8 + , hasql-transaction >= 0.7.2 && < 0.8 , heredoc >= 0.2 && < 0.3 , hspec >= 2.3 && < 2.8 , hspec-wai >= 0.7 && < 0.10 diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index eb6df3e6e..69213e95f 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -43,6 +43,18 @@ import Control.Applicative import PostgREST.Types import Protolude +column :: HD.Value a -> HD.Row a +column = HD.column . HD.nonNullable + +nullableColumn :: HD.Value a -> HD.Row (Maybe a) +nullableColumn = HD.column . HD.nullable + +element :: HD.Value a -> HD.Array a +element = HD.element . HD.nonNullable + +param :: HE.Value a -> HE.Params a +param = HE.param . HE.nonNullable + getDbStructure :: Schema -> PgVersion -> HT.Transaction DbStructure getDbStructure schema pgVer = do HT.sql "set local schema ''" -- for getting the fully qualified name(schema.name) of every db object @@ -70,10 +82,10 @@ decodeTables :: HD.Result [Table] decodeTables = HD.rowList tblRow where - tblRow = Table <$> HD.column HD.text - <*> HD.column HD.text - <*> HD.nullableColumn HD.text - <*> HD.column HD.bool + tblRow = Table <$> column HD.text + <*> column HD.text + <*> nullableColumn HD.text + <*> column HD.bool decodeColumns :: [Table] -> HD.Result [Column] decodeColumns tables = @@ -81,41 +93,41 @@ decodeColumns tables = where colRow = (,,,,,,,,,,,) - <$> HD.column HD.text <*> HD.column HD.text - <*> HD.column HD.text <*> HD.nullableColumn HD.text - <*> HD.column HD.int4 <*> HD.column HD.bool - <*> HD.column HD.text <*> HD.column HD.bool - <*> HD.nullableColumn HD.int4 - <*> HD.nullableColumn HD.int4 - <*> HD.nullableColumn HD.text - <*> HD.nullableColumn HD.text + <$> column HD.text <*> column HD.text + <*> column HD.text <*> nullableColumn HD.text + <*> column HD.int4 <*> column HD.bool + <*> column HD.text <*> column HD.bool + <*> nullableColumn HD.int4 + <*> nullableColumn HD.int4 + <*> nullableColumn HD.text + <*> nullableColumn HD.text decodeRelations :: [Table] -> [Column] -> HD.Result [Relation] decodeRelations tables cols = mapMaybe (relationFromRow tables cols) <$> HD.rowList relRow where relRow = (,,,,,) - <$> HD.column HD.text - <*> HD.column HD.text - <*> HD.column (HD.array (HD.dimension replicateM (HD.element HD.text))) - <*> HD.column HD.text - <*> HD.column HD.text - <*> HD.column (HD.array (HD.dimension replicateM (HD.element HD.text))) + <$> column HD.text + <*> column HD.text + <*> column (HD.array (HD.dimension replicateM (element HD.text))) + <*> column HD.text + <*> column HD.text + <*> column (HD.array (HD.dimension replicateM (element HD.text))) decodePks :: [Table] -> HD.Result [PrimaryKey] decodePks tables = mapMaybe (pkFromRow tables) <$> HD.rowList pkRow where - pkRow = (,,) <$> HD.column HD.text <*> HD.column HD.text <*> HD.column HD.text + pkRow = (,,) <$> column HD.text <*> column HD.text <*> column HD.text decodeSynonyms :: [Column] -> HD.Result [Synonym] decodeSynonyms cols = mapMaybe (synonymFromRow cols) <$> HD.rowList synRow where synRow = (,,,,,) - <$> HD.column HD.text <*> HD.column HD.text - <*> HD.column HD.text <*> HD.column HD.text - <*> HD.column HD.text <*> HD.column HD.text + <$> column HD.text <*> column HD.text + <*> column HD.text <*> column HD.text + <*> column HD.text <*> column HD.text decodeProcs :: HD.Result (M.HashMap Text [ProcDescription]) decodeProcs = @@ -123,15 +135,15 @@ decodeProcs = map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addName) <$> HD.rowList tblRow where tblRow = ProcDescription - <$> HD.column HD.text - <*> HD.nullableColumn HD.text - <*> (parseArgs <$> HD.column HD.text) + <$> column HD.text + <*> nullableColumn HD.text + <*> (parseArgs <$> column HD.text) <*> (parseRetType - <$> HD.column HD.text - <*> HD.column HD.text - <*> HD.column HD.bool - <*> HD.column HD.char) - <*> (parseVolatility <$> HD.column HD.char) + <$> column HD.text + <*> column HD.text + <*> column HD.bool + <*> column HD.char) + <*> (parseVolatility <$> column HD.char) addName :: ProcDescription -> (Text, ProcDescription) addName pd = (pdName pd, pd) @@ -168,10 +180,10 @@ decodeProcs = | otherwise = Volatile -- only 'v' can happen here allProcs :: H.Statement Schema (M.HashMap Text [ProcDescription]) -allProcs = H.Statement (toS procsSqlQuery) (HE.param HE.text) decodeProcs True +allProcs = H.Statement (toS procsSqlQuery) (param HE.text) decodeProcs True accessibleProcs :: H.Statement Schema (M.HashMap Text [ProcDescription]) -accessibleProcs = H.Statement (toS sql) (HE.param HE.text) decodeProcs True +accessibleProcs = H.Statement (toS sql) (param HE.text) decodeProcs True where sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')" @@ -196,7 +208,7 @@ procsSqlQuery = [q| schemaDescription :: H.Statement Schema (Maybe Text) schemaDescription = - H.Statement sql (HE.param HE.text) (join <$> HD.rowMaybe (HD.nullableColumn HD.text)) True + H.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text)) True where sql = [q| select @@ -209,7 +221,7 @@ schemaDescription = accessibleTables :: H.Statement Schema [Table] accessibleTables = - H.Statement sql (HE.param HE.text) decodeTables True + H.Statement sql (param HE.text) decodeTables True where sql = [q| select @@ -351,7 +363,7 @@ addViewPrimaryKeys syns = concatMap (\pk -> allTables :: H.Statement () [Table] allTables = - H.Statement sql HE.unit decodeTables True + H.Statement sql HE.noParams decodeTables True where sql = [q| SELECT @@ -374,7 +386,7 @@ allTables = allColumns :: [Table] -> H.Statement Schema [Column] allColumns tabs = - H.Statement sql (HE.param HE.text) (decodeColumns tabs) True + H.Statement sql (param HE.text) (decodeColumns tabs) True where sql = [q| SELECT DISTINCT @@ -561,7 +573,7 @@ columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn < allChildRelations :: [Table] -> [Column] -> H.Statement () [Relation] allChildRelations tabs cols = - H.Statement sql HE.unit (decodeRelations tabs cols) True + H.Statement sql HE.noParams (decodeRelations tabs cols) True where sql = [q| SELECT ns1.nspname AS table_schema, @@ -602,7 +614,7 @@ relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) = allPrimaryKeys :: [Table] -> H.Statement () [PrimaryKey] allPrimaryKeys tabs = - H.Statement sql HE.unit (decodePks tabs) True + H.Statement sql HE.noParams (decodePks tabs) True where sql = [q| /* @@ -712,7 +724,7 @@ pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n allSynonyms :: [Column] -> PgVersion -> H.Statement Schema [Synonym] allSynonyms cols pgVer = - H.Statement sql (HE.param HE.text) (decodeSynonyms cols) True + H.Statement sql (param HE.text) (decodeSynonyms cols) True -- query explanation at https://gist.github.com/steve-chavez/7ee0e6590cddafb532e5f00c46275569 where subselectRegex :: Text @@ -787,7 +799,7 @@ synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2 findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols getPgVersion :: H.Session PgVersion -getPgVersion = H.statement () $ H.Statement sql HE.unit versionRow False +getPgVersion = H.statement () $ H.Statement sql HE.noParams versionRow False where sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')" - versionRow = HD.singleRow $ PgVersion <$> HD.column HD.int4 <*> HD.column HD.text + versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index 658a37064..3ccdc6245 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -51,6 +51,18 @@ import PostgREST.RangeQuery (allRange, rangeLimit, rangeOffset) import PostgREST.Types import Protolude hiding (cast, intercalate, replace) +column :: HD.Value a -> HD.Row a +column = HD.column . HD.nonNullable + +nullableColumn :: HD.Value a -> HD.Row (Maybe a) +nullableColumn = HD.column . HD.nullable + +element :: HD.Value a -> HD.Array a +element = HD.element . HD.nonNullable + +param :: HE.Value a -> HE.Params a +param = HE.param . HE.nonNullable + {-| The generic query result format used by API responses. The location header is represented as a list of strings containing variable bindings like @"k1=eq.42"@, or the empty list if there is no location header. @@ -58,10 +70,10 @@ import Protolude hiding (cast, intercalate, replace) type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString) standardRow :: HD.Row ResultsWithCount -standardRow = (,,,) <$> HD.nullableColumn HD.int8 <*> HD.column HD.int8 - <*> HD.column header <*> HD.column HD.bytea +standardRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8 + <*> column header <*> column HD.bytea where - header = HD.array $ HD.dimension replicateM $ HD.element HD.bytea + header = HD.array $ HD.dimension replicateM $ element HD.bytea noLocationF :: Text noLocationF = "array[]::text[]" @@ -81,7 +93,7 @@ decodeStandardMay = createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName -> H.Statement () ResultsWithCount createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField = - unicodeStatement sql HE.unit decodeStandard False + unicodeStatement sql HE.noParams decodeStandard False where sql = [qc| WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols} @@ -104,7 +116,7 @@ createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> PreferRepresentation -> [Text] -> H.Statement ByteString (Maybe ResultsWithCount) createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys = - unicodeStatement sql (HE.param HE.unknown) decodeStandardMay True + unicodeStatement sql (param HE.unknown) decodeStandardMay True where sql = case rep of @@ -146,7 +158,7 @@ callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bo Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> H.Statement ByteString (Maybe ProcResults) callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField pgVer = - unicodeStatement sql (HE.param HE.unknown) decodeProc True + unicodeStatement sql (param HE.unknown) decodeProc True where sql =[qc| WITH @@ -210,8 +222,8 @@ callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle para else "'[]'" :: Text decodeProc = HD.rowMaybe procRow - procRow = (,,,) <$> HD.nullableColumn HD.int8 <*> HD.column HD.int8 - <*> HD.column HD.bytea <*> HD.column HD.bytea + procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8 + <*> column HD.bytea <*> column HD.bytea pgFmtIdent :: SqlFragment -> SqlFragment pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\"" diff --git a/stack.yaml b/stack.yaml index d094fbda8..8ded0bc5e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,6 +6,12 @@ extra-deps: - Ranged-sets-0.4.0 - configurator-pg-0.1.0.3 - http-types-0.12.3 +- hasql-1.4 +- hasql-pool-0.5.1 +- hasql-transaction-0.7.2 +- text-builder-0.6.5.1 +- deferred-folds-0.9.10.1 +- primitive-0.6.4.0 ghc-options: postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints nix: