Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Fix question marks in strings #1371 #1375

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Fix question marks in strings #1371 #1375

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
b9dbc64
Expose Raw.Internal module for testing
parsonsmatt Mar 17, 2022
12b43d1
Tests
parsonsmatt Mar 17, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions persistent-postgresql/test/PgInit.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -227,3 +227,6 @@ instance Arbitrary AValue where
$ listOf -- [(,)] -> (,)
. liftA2 (,) arbText -- (,) -> Text and Value
$ limitIt 4 (fmap getValue arbitrary) -- Again, precaution against divergent recursion.

itDb :: String -> SqlPersistT (LoggingT (ResourceT IO)) a -> SpecWith (Arg (IO ()))
itDb msg action = it msg $ runConnAssert $ void action
3 changes: 0 additions & 3 deletions persistent-postgresql/test/UpsertWhere.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -46,9 +46,6 @@ wipe = runConnAssert $ do
deleteWhere ([] :: [Filter Item])
deleteWhere ([] :: [Filter ItemMigOnly])

itDb :: String -> SqlPersistT (LoggingT (ResourceT IO)) a -> SpecWith (Arg (IO ()))
itDb msg action = it msg $ runConnAssert $ void action

specs :: Spec
specs = describe "UpsertWhere" $ do
let item1 = Item "item1" "" (Just 3) Nothing
Expand Down
270 changes: 143 additions & 127 deletions persistent-test/src/RawSqlTest.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
module RawSqlTest where

import Data.Coerce
import qualified Conduit as C
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.Text as T
Expand All @@ -13,133 +14,148 @@ import PersistTestPetType
import PersistentTestModels

specsWith :: Runner SqlBackend m => RunDb SqlBackend m -> Spec
specsWith runDb = describe "rawSql" $ do
it "2+2" $ runDb $ do
ret <- rawSql "SELECT 2+2" []
liftIO $ ret @?= [Single (4::Int)]

it "?-?" $ runDb $ do
ret <- rawSql "SELECT ?-?" [PersistInt64 5, PersistInt64 3]
liftIO $ ret @?= [Single (2::Int)]

it "NULL" $ runDb $ do
ret <- rawSql "SELECT NULL" []
liftIO $ ret @?= [Nothing :: Maybe (Single Int)]

it "entity" $ runDb $ do
Entity p1k p1 <- insertEntity $ Person "Mathias" 23 Nothing
Entity p2k p2 <- insertEntity $ Person "Norbert" 44 Nothing
Entity p3k _ <- insertEntity $ Person "Cassandra" 19 Nothing
Entity _ _ <- insertEntity $ Person "Thiago" 19 Nothing
Entity a1k a1 <- insertEntity $ Pet p1k "Rodolfo" Cat
Entity a2k a2 <- insertEntity $ Pet p1k "Zeno" Cat
Entity a3k a3 <- insertEntity $ Pet p2k "Lhama" Dog
Entity _ _ <- insertEntity $ Pet p3k "Abacate" Cat
escape <- getEscape
person <- getTableName (error "rawSql Person" :: Person)
name_ <- getFieldName PersonName
pet <- getTableName (error "rawSql Pet" :: Pet)
petName_ <- getFieldName PetName
let query = T.concat [ "SELECT ??, ?? "
, "FROM ", person
, ", ", escape "Pet"
, " WHERE ", person, ".", escape "age", " >= ? "
, "AND ", escape "Pet", ".", escape "ownerId", " = "
, person, ".", escape "id"
, " ORDER BY ", person, ".", name_, ", ", pet, ".", petName_
]
ret <- rawSql query [PersistInt64 20]
liftIO $ ret @?= [ (Entity p1k p1, Entity a1k a1)
, (Entity p1k p1, Entity a2k a2)
, (Entity p2k p2, Entity a3k a3) ]
ret2 <- rawSql query [PersistInt64 20]
liftIO $ ret2 @?= [ (Just (Entity p1k p1), Just (Entity a1k a1))
, (Just (Entity p1k p1), Just (Entity a2k a2))
, (Just (Entity p2k p2), Just (Entity a3k a3)) ]
ret3 <- rawSql query [PersistInt64 20]
liftIO $ ret3 @?= [ Just (Entity p1k p1, Entity a1k a1)
, Just (Entity p1k p1, Entity a2k a2)
, Just (Entity p2k p2, Entity a3k a3) ]

it "order-proof" $ runDb $ do
let p1 = Person "Zacarias" 93 Nothing
p1k <- insert p1
escape <- getEscape
let query = T.concat [ "SELECT ?? "
, "FROM ", escape "Person"
]
ret1 <- rawSql query []
ret2 <- rawSql query [] :: MonadIO m => SqlPersistT m [Entity (ReverseFieldOrder Person)]
liftIO $ ret1 @?= [Entity p1k p1]
liftIO $ ret2 @?= [Entity (RFOKey $ unPersonKey p1k) (RFO p1)]

it "permits prefixes" $ runDb $ do
let r1 = Relationship "Foo" Nothing
r1k <- insert r1
let r2 = Relationship "Bar" (Just r1k)
r2k <- insert r2
let r3 = Relationship "Lmao" (Just r1k)
r3k <- insert r3
let r4 = Relationship "Boring" (Just r2k)
r4k <- insert r4
escape <- getEscape
let query = T.concat
[ "SELECT ??, ?? "
, "FROM ", escape "Relationship", " AS parent "
, "LEFT OUTER JOIN ", escape "Relationship", " AS child "
, "ON parent.id = child.parent"
]

result :: [(EntityWithPrefix "parent" Relationship, Maybe (EntityWithPrefix "child" Relationship))] <-
rawSql query []

liftIO $
coerce result `shouldMatchList`
[ (Entity r1k r1, Just (Entity r2k r2))
, (Entity r1k r1, Just (Entity r3k r3))
, (Entity r2k r2, Just (Entity r4k r4))
, (Entity r3k r3, Nothing)
, (Entity r4k r4, Nothing)
]


it "OUTER JOIN" $ runDb $ do
let insert' :: (PersistStore backend, PersistEntity val, PersistEntityBackend val ~ BaseBackend backend, MonadIO m)
=> val -> ReaderT backend m (Key val, val)
insert' v = insert v >>= \k -> return (k, v)
(p1k, p1) <- insert' $ Person "Mathias" 23 Nothing
(p2k, p2) <- insert' $ Person "Norbert" 44 Nothing
(a1k, a1) <- insert' $ Pet p1k "Rodolfo" Cat
(a2k, a2) <- insert' $ Pet p1k "Zeno" Cat
escape <- getEscape
let query = T.concat [ "SELECT ??, ?? "
, "FROM ", person
, "LEFT OUTER JOIN ", pet
, " ON ", person, ".", escape "id"
, " = ", pet, ".", escape "ownerId"
, " ORDER BY ", person, ".", escape "name"
, ", ", pet, ".", escape "id" ]
person = escape "Person"
pet = escape "Pet"
ret <- rawSql query []
liftIO $ ret @?= [ (Entity p1k p1, Just (Entity a1k a1))
, (Entity p1k p1, Just (Entity a2k a2))
, (Entity p2k p2, Nothing) ]

it "handles lower casing" $
runDb $ do
C.runConduitRes $ rawQuery "SELECT full_name from lower_case_table WHERE my_id=5" [] C..| CL.sinkNull
C.runConduitRes $ rawQuery "SELECT something_else from ref_table WHERE id=4" [] C..| CL.sinkNull

it "commit/rollback" $ do
caseCommitRollback runDb
runDb cleanDB

it "queries with large number of results" $ runDb $ do
-- max size of a GHC tuple is 62, but Eq instances currently only exist up to 15-tuples
-- See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3369
ret <- rawSql "SELECT ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?" $ map PersistInt64 [1..15]
liftIO $ ret @?= [(Single (1::Int), Single (2::Int), Single (3::Int), Single (4::Int), Single (5::Int), Single (6::Int), Single (7::Int), Single (8::Int), Single (9::Int), Single (10::Int), Single (11::Int), Single (12::Int), Single (13::Int), Single (14::Int), Single (15::Int))]
specsWith runDb = do
describe "rawSql" $ do
it "2+2" $ runDb $ do
ret <- rawSql "SELECT 2+2" []
liftIO $ ret @?= [Single (4::Int)]

it "?-?" $ runDb $ do
ret <- rawSql "SELECT ?-?" [PersistInt64 5, PersistInt64 3]
liftIO $ ret @?= [Single (2::Int)]

it "NULL" $ runDb $ do
ret <- rawSql "SELECT NULL" []
liftIO $ ret @?= [Nothing :: Maybe (Single Int)]

it "entity" $ runDb $ do
Entity p1k p1 <- insertEntity $ Person "Mathias" 23 Nothing
Entity p2k p2 <- insertEntity $ Person "Norbert" 44 Nothing
Entity p3k _ <- insertEntity $ Person "Cassandra" 19 Nothing
Entity _ _ <- insertEntity $ Person "Thiago" 19 Nothing
Entity a1k a1 <- insertEntity $ Pet p1k "Rodolfo" Cat
Entity a2k a2 <- insertEntity $ Pet p1k "Zeno" Cat
Entity a3k a3 <- insertEntity $ Pet p2k "Lhama" Dog
Entity _ _ <- insertEntity $ Pet p3k "Abacate" Cat
escape <- getEscape
person <- getTableName (error "rawSql Person" :: Person)
name_ <- getFieldName PersonName
pet <- getTableName (error "rawSql Pet" :: Pet)
petName_ <- getFieldName PetName
let query = T.concat [ "SELECT ??, ?? "
, "FROM ", person
, ", ", escape "Pet"
, " WHERE ", person, ".", escape "age", " >= ? "
, "AND ", escape "Pet", ".", escape "ownerId", " = "
, person, ".", escape "id"
, " ORDER BY ", person, ".", name_, ", ", pet, ".", petName_
]
ret <- rawSql query [PersistInt64 20]
liftIO $ ret @?= [ (Entity p1k p1, Entity a1k a1)
, (Entity p1k p1, Entity a2k a2)
, (Entity p2k p2, Entity a3k a3) ]
ret2 <- rawSql query [PersistInt64 20]
liftIO $ ret2 @?= [ (Just (Entity p1k p1), Just (Entity a1k a1))
, (Just (Entity p1k p1), Just (Entity a2k a2))
, (Just (Entity p2k p2), Just (Entity a3k a3)) ]
ret3 <- rawSql query [PersistInt64 20]
liftIO $ ret3 @?= [ Just (Entity p1k p1, Entity a1k a1)
, Just (Entity p1k p1, Entity a2k a2)
, Just (Entity p2k p2, Entity a3k a3) ]

it "order-proof" $ runDb $ do
let p1 = Person "Zacarias" 93 Nothing
p1k <- insert p1
escape <- getEscape
let query = T.concat [ "SELECT ?? "
, "FROM ", escape "Person"
]
ret1 <- rawSql query []
ret2 <- rawSql query [] :: MonadIO m => SqlPersistT m [Entity (ReverseFieldOrder Person)]
liftIO $ ret1 @?= [Entity p1k p1]
liftIO $ ret2 @?= [Entity (RFOKey $ unPersonKey p1k) (RFO p1)]

it "permits prefixes" $ runDb $ do
let r1 = Relationship "Foo" Nothing
r1k <- insert r1
let r2 = Relationship "Bar" (Just r1k)
r2k <- insert r2
let r3 = Relationship "Lmao" (Just r1k)
r3k <- insert r3
let r4 = Relationship "Boring" (Just r2k)
r4k <- insert r4
escape <- getEscape
let query = T.concat
[ "SELECT ??, ?? "
, "FROM ", escape "Relationship", " AS parent "
, "LEFT OUTER JOIN ", escape "Relationship", " AS child "
, "ON parent.id = child.parent"
]

result :: [(EntityWithPrefix "parent" Relationship, Maybe (EntityWithPrefix "child" Relationship))] <-
rawSql query []

liftIO $
coerce result `shouldMatchList`
[ (Entity r1k r1, Just (Entity r2k r2))
, (Entity r1k r1, Just (Entity r3k r3))
, (Entity r2k r2, Just (Entity r4k r4))
, (Entity r3k r3, Nothing)
, (Entity r4k r4, Nothing)
]


it "OUTER JOIN" $ runDb $ do
let insert' :: (PersistStore backend, PersistEntity val, PersistEntityBackend val ~ BaseBackend backend, MonadIO m)
=> val -> ReaderT backend m (Key val, val)
insert' v = insert v >>= \k -> return (k, v)
(p1k, p1) <- insert' $ Person "Mathias" 23 Nothing
(p2k, p2) <- insert' $ Person "Norbert" 44 Nothing
(a1k, a1) <- insert' $ Pet p1k "Rodolfo" Cat
(a2k, a2) <- insert' $ Pet p1k "Zeno" Cat
escape <- getEscape
let query = T.concat [ "SELECT ??, ?? "
, "FROM ", person
, "LEFT OUTER JOIN ", pet
, " ON ", person, ".", escape "id"
, " = ", pet, ".", escape "ownerId"
, " ORDER BY ", person, ".", escape "name"
, ", ", pet, ".", escape "id" ]
person = escape "Person"
pet = escape "Pet"
ret <- rawSql query []
liftIO $ ret @?= [ (Entity p1k p1, Just (Entity a1k a1))
, (Entity p1k p1, Just (Entity a2k a2))
, (Entity p2k p2, Nothing) ]

it "commit/rollback" $ do
caseCommitRollback runDb
runDb cleanDB

it "queries with large number of results" $ runDb $ do
-- max size of a GHC tuple is 62, but Eq instances currently only exist up to 15-tuples
-- See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3369
ret <- rawSql "SELECT ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?" $ map PersistInt64 [1..15]
liftIO $ ret @?= [(Single (1::Int), Single (2::Int), Single (3::Int), Single (4::Int), Single (5::Int), Single (6::Int), Single (7::Int), Single (8::Int), Single (9::Int), Single (10::Int), Single (11::Int), Single (12::Int), Single (13::Int), Single (14::Int), Single (15::Int))]

it "can handle a question mark in a string" $ runDb $ do
[Single ret] <- rawSql "SELECT 'hello\\?'" []
liftIO $
ret @== ("hello?" :: Text)

describe "rawQuery" $ do
let conduitToList c = C.runConduitRes $ c C..| C.sinkList
it "handles question marks in a string literal" $ do
runDb $ do
[[PersistText result]] <-
conduitToList $ rawQuery "SELECT 'hello?'" []
liftIO $
result @== "hello?"
it "handles lower casing" $
runDb $ do
void $ conduitToList $ rawQuery "SELECT full_name from lower_case_table WHERE my_id=5" []
void $ conduitToList $ rawQuery "SELECT something_else from ref_table WHERE id=4" []


getEscape :: MonadReader SqlBackend m => m (Text -> Text)
getEscape = getEscapeRawNameFunction
Expand Down
2 changes: 1 addition & 1 deletion persistent/Database/Persist/Sql.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -66,7 +66,7 @@ import Database.Persist
import Database.Persist.Sql.Class
import Database.Persist.Sql.Internal
import Database.Persist.Sql.Migration
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Raw.Internal
import Database.Persist.Sql.Run hiding (rawAcquireSqlConn, rawRunSqlPool)
import Database.Persist.Sql.Types
import Database.Persist.Sql.Types.Internal (IsolationLevel(..), SqlBackend(..))
Expand Down
2 changes: 1 addition & 1 deletion persistent/Database/Persist/Sql/Migration.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@ import System.IO
import System.IO.Silently (hSilence)

import Database.Persist.Sql.Orphan.PersistStore ()
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Raw.Internal
import Database.Persist.Sql.Types
import Database.Persist.Sql.Types.Internal
import Database.Persist.Types
Expand Down
2 changes: 1 addition & 1 deletion persistent/Database/Persist/Sql/Orphan/PersistQuery.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ import qualified Data.Text as T

import Database.Persist hiding (updateField)
import Database.Persist.Sql.Orphan.PersistStore (withRawQuery)
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Raw.Internal
import Database.Persist.Sql.Types.Internal
(SqlBackend(..), SqlReadBackend, SqlWriteBackend)
import Database.Persist.Sql.Util
Expand Down
2 changes: 1 addition & 1 deletion persistent/Database/Persist/Sql/Orphan/PersistStore.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ import Web.PathPieces (PathPiece)
import Database.Persist
import Database.Persist.Class ()
import Database.Persist.Sql.Class (PersistFieldSql)
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Raw.Internal
import Database.Persist.Sql.Types
import Database.Persist.Sql.Types.Internal
import Database.Persist.Sql.Util
Expand Down
2 changes: 1 addition & 1 deletion persistent/Database/Persist/Sql/Orphan/PersistUnique.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ import Database.Persist
import Database.Persist.Class.PersistUnique (defaultUpsertBy, defaultPutMany, persistUniqueKeyValues)

import Database.Persist.Sql.Types.Internal
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Raw.Internal
import Database.Persist.Sql.Orphan.PersistStore (withRawQuery)
import Database.Persist.Sql.Util (dbColumns, parseEntityValues, updatePersistValue, mkUpdateText')

Expand Down
8 changes: 5 additions & 3 deletions persistent/Database/Persist/Sql/Raw.hs → ...tent/Database/Persist/Sql/Raw/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
module Database.Persist.Sql.Raw where
-- | This module is a internal. Breaking changes to the API of this module will
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Extra a?

-- not be reflected in a major version bump.
module Database.Persist.Sql.Raw.Internal where

import Control.Exception (throwIO)
import Control.Monad (liftM, when)
Expand Down Expand Up @@ -216,10 +218,10 @@ rawSql stmt = run
process = rawSqlProcessRow

withStmt' colSubsts params sink = do
srcRes <- rawQueryRes sql params
srcRes <- rawQueryRes sql' params
liftIO $ with srcRes (\src -> runConduit $ src .| sink)
where
sql = T.concat $ makeSubsts colSubsts $ T.splitOn placeholder stmt
sql' = T.concat $ makeSubsts colSubsts $ T.splitOn placeholder stmt
placeholder = "??"
makeSubsts (s:ss) (t:ts) = t : s : makeSubsts ss ts
makeSubsts [] [] = []
Expand Down
2 changes: 1 addition & 1 deletion persistent/Database/Persist/Sql/Run.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ import qualified Data.Text as T
import qualified UnliftIO.Exception as UE

import Database.Persist.Class.PersistStore
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Raw.Internal
import Database.Persist.Sql.Types
import Database.Persist.Sql.Types.Internal
import Database.Persist.SqlBackend.Internal.StatementCache
Expand Down
2 changes: 1 addition & 1 deletion persistent/Database/Persist/SqlBackend/SqlPoolHooks.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ module Database.Persist.SqlBackend.SqlPoolHooks

import Control.Exception
import Control.Monad.IO.Class
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Raw.Internal
import Database.Persist.SqlBackend.Internal
import Database.Persist.SqlBackend.Internal.SqlPoolHooks
import Database.Persist.SqlBackend.Internal.IsolationLevel
Expand Down
Loading