From 01302cf443b9293461f42e85ac92d35fed5f1aa8 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 17 Mar 2022 16:50:08 -0600 Subject: [PATCH 1/7] Failing test --- test/main.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/test/main.hs b/test/main.hs index 4def253..3aebc20 100644 --- a/test/main.hs +++ b/test/main.hs @@ -24,8 +24,8 @@ main :: IO () main = bracket (connect testConn) close $ \conn -> hspec $ do - unitSpec - integrationSpec conn + describe "Database.MySQL.Simple.unitSpec" unitSpec + describe "Database.MySQL.Simple.integrationSpec" $ integrationSpec conn unitSpec :: Spec unitSpec = do @@ -48,7 +48,14 @@ unitSpec = do integrationSpec :: Connection -> Spec integrationSpec conn = do - describe "the library" $ do + describe "query_" $ do it "can connect to a database" $ do result <- query_ conn "select 1 + 1" result `shouldBe` [Only (2::Int)] + it "can have question marks in string literals" $ do + result <- query_ conn "select 'hello?'" + result `shouldBe` [Only ("hello?" :: Text)] + describe "query" $ do + it "can have question marks in string literals" $ do + result <- query conn "select 'hello?'" ([] :: [Int]) + result `shouldBe` [Only ("hello?" :: Text)] From df2f48b4daf6f627375b7a18b3e245379306fde8 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 17 Mar 2022 17:07:25 -0600 Subject: [PATCH 2/7] Extract logic, more focused test --- Database/MySQL/Simple.hs | 10 +++++++++- mysql-simple.cabal | 1 + test/main.hs | 28 ++++++++++++++++++++++++++-- 3 files changed, 36 insertions(+), 3 deletions(-) diff --git a/Database/MySQL/Simple.hs b/Database/MySQL/Simple.hs index d2e7ad4..f61455d 100644 --- a/Database/MySQL/Simple.hs +++ b/Database/MySQL/Simple.hs @@ -80,6 +80,7 @@ module Database.MySQL.Simple -- * Helper functions , formatMany , formatQuery + , splitQuery ) where import Blaze.ByteString.Builder (Builder, fromByteString, toByteString) @@ -181,6 +182,13 @@ buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs " '?' characters, but " ++ show (length xs) ++ " parameters") q xs +-- | Split a query into fragments separated by @?@ characters. Does not +-- break a fragment if the question mark is in a string literal. +splitQuery :: ByteString -> [Builder] +splitQuery s = fromByteString h : if B.null t then [] else splitQuery (B.tail t) + where + (h,t) = B.break (=='?') s + -- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not -- expected to return results. -- @@ -373,7 +381,7 @@ fmtError msg q xs = throw FormatError { -- facility to address both ease of use and security. -- $querytype --- +-- -- A 'Query' is a @newtype@-wrapped 'ByteString'. It intentionally -- exposes a tiny API that is not compatible with the 'ByteString' -- API; this makes it difficult to construct queries from fragments of diff --git a/mysql-simple.cabal b/mysql-simple.cabal index cbd99bf..40946b1 100644 --- a/mysql-simple.cabal +++ b/mysql-simple.cabal @@ -84,6 +84,7 @@ test-suite test ghc-options: -Wall default-language: Haskell2010 build-depends: base >= 4 && < 5 + , bytestring , blaze-builder , hspec , mysql-simple diff --git a/test/main.hs b/test/main.hs index 3aebc20..348883f 100644 --- a/test/main.hs +++ b/test/main.hs @@ -1,5 +1,8 @@ -{-# LANGUAGE CPP, OverloadedStrings #-} +{-# LANGUAGE CPP, StandaloneDeriving, OverloadedStrings #-} +{-# options_ghc -fno-warn-orphans #-} + +import Data.ByteString.Builder as BS import Control.Exception (bracket) import Data.Text (Text) import Database.MySQL.Simple @@ -46,6 +49,22 @@ unitSpec = do Many [Plain _, Escape "foo", Plain _, Escape "bar", Plain _] -> pure () _ -> expectationFailure "expected a Many with specific contents" + describe "splitQuery" $ do + it "works for a single question mark" $ do + splitQuery "select * from foo where name = ?" + `shouldBe` + ["select * from foo where name =", ""] + it "works with a question mark in a string literal" $ do + splitQuery "select 'hello?'" + `shouldBe` + ["select 'hello?'"] + +instance Show BS.Builder where + show = show . BS.toLazyByteString + +instance Eq BS.Builder where + a == b = BS.toLazyByteString a == BS.toLazyByteString b + integrationSpec :: Connection -> Spec integrationSpec conn = do describe "query_" $ do @@ -57,5 +76,10 @@ integrationSpec conn = do result `shouldBe` [Only ("hello?" :: Text)] describe "query" $ do it "can have question marks in string literals" $ do - result <- query conn "select 'hello?'" ([] :: [Int]) + result <- query conn "select 'hello?'" () result `shouldBe` [Only ("hello?" :: Text)] + describe "formatQuery" $ do + it "should not blow up on a question mark in string literal" $ do + formatQuery conn "select 'hello?'" () + `shouldReturn` + "select 'hello?'" From a7f4cb081bc1639723dc2b12c6125a10ee4ad876 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 17 Mar 2022 17:24:17 -0600 Subject: [PATCH 3/7] Fixed --- Database/MySQL/Simple.hs | 30 +++++++++++++++++++++++++----- test/main.hs | 6 +++++- 2 files changed, 30 insertions(+), 6 deletions(-) diff --git a/Database/MySQL/Simple.hs b/Database/MySQL/Simple.hs index f61455d..e243eb5 100644 --- a/Database/MySQL/Simple.hs +++ b/Database/MySQL/Simple.hs @@ -89,6 +89,7 @@ import Control.Applicative ((<$>), pure) import Control.Exception (Exception, bracket, onException, throw, throwIO) import Control.Monad.Fix (fix) import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS import Data.Int (Int64) import Data.List (intersperse) import Data.Monoid (mappend, mconcat) @@ -103,6 +104,7 @@ import Database.MySQL.Simple.Types (Binary(..), In(..), VaArgs(..), Only(..), Qu import Text.Regex.PCRE.Light (compile, caseless, match) import qualified Data.ByteString.Char8 as B import qualified Database.MySQL.Base as Base +-- import Data.Attoparsec.ByteString.Char8 hiding (Result, match) -- | Exception thrown if a 'Query' could not be formatted correctly. -- This may occur if the number of \'@?@\' characters in the query @@ -170,12 +172,10 @@ formatMany conn q@(Query template) qs = do [caseless] buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder -buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs +buildQuery conn q template xs = zipParams (splitQuery template) <$> mapM sub xs where sub (Plain b) = pure b sub (Escape s) = (inQuotes . fromByteString) <$> Base.escape conn s sub (Many ys) = mconcat <$> mapM sub ys - split s = fromByteString h : if B.null t then [] else split (B.tail t) - where (h,t) = B.break (=='?') s zipParams (t:ts) (p:ps) = t `mappend` p `mappend` zipParams ts ps zipParams [t] [] = t zipParams _ _ = fmtError (show (B.count '?' template) ++ @@ -185,9 +185,29 @@ buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs -- | Split a query into fragments separated by @?@ characters. Does not -- break a fragment if the question mark is in a string literal. splitQuery :: ByteString -> [Builder] -splitQuery s = fromByteString h : if B.null t then [] else splitQuery (B.tail t) +splitQuery s = reverse $ fmap (fromByteString . BS.pack . reverse) $ begin [] (BS.unpack s) where - (h,t) = B.break (=='?') s + begin = normal [] + + normal ret acc [] = + acc : ret + normal ret acc (c : cs) = + case c of + '?' -> + normal (acc : ret) [] cs + '\'' -> + inQuotes ret (c : acc) cs + _ -> + normal ret (c : acc) cs + + inQuotes ret acc [] = + ret + inQuotes ret acc (c : cs) = + case c of + '\'' -> + normal ret (c : acc) cs + _ -> + inQuotes ret (c : acc) cs -- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not -- expected to return results. diff --git a/test/main.hs b/test/main.hs index 348883f..0281d38 100644 --- a/test/main.hs +++ b/test/main.hs @@ -53,11 +53,15 @@ unitSpec = do it "works for a single question mark" $ do splitQuery "select * from foo where name = ?" `shouldBe` - ["select * from foo where name =", ""] + ["select * from foo where name = ", ""] it "works with a question mark in a string literal" $ do splitQuery "select 'hello?'" `shouldBe` ["select 'hello?'"] + it "works with many question marks" $ do + splitQuery "select ? + ? + what from foo where bar = ?" + `shouldBe` + ["select ", " + ", " + what from foo where bar = ", ""] instance Show BS.Builder where show = show . BS.toLazyByteString From 72e34a4a3fb3700007480e29a010b3e0ec8d20a7 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 17 Mar 2022 17:33:52 -0600 Subject: [PATCH 4/7] more tests, fixes --- Database/MySQL/Simple.hs | 6 ++++-- test/main.hs | 10 ++++++++++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/Database/MySQL/Simple.hs b/Database/MySQL/Simple.hs index e243eb5..e08190e 100644 --- a/Database/MySQL/Simple.hs +++ b/Database/MySQL/Simple.hs @@ -172,15 +172,17 @@ formatMany conn q@(Query template) qs = do [caseless] buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder -buildQuery conn q template xs = zipParams (splitQuery template) <$> mapM sub xs +buildQuery conn q template xs = zipParams queryFragments <$> mapM sub xs where sub (Plain b) = pure b sub (Escape s) = (inQuotes . fromByteString) <$> Base.escape conn s sub (Many ys) = mconcat <$> mapM sub ys zipParams (t:ts) (p:ps) = t `mappend` p `mappend` zipParams ts ps zipParams [t] [] = t - zipParams _ _ = fmtError (show (B.count '?' template) ++ + zipParams _ _ = fmtError (show fragmentCount ++ " '?' characters, but " ++ show (length xs) ++ " parameters") q xs + fragmentCount = length queryFragments - 1 + queryFragments = splitQuery template -- | Split a query into fragments separated by @?@ characters. Does not -- break a fragment if the question mark is in a string literal. diff --git a/test/main.hs b/test/main.hs index 0281d38..6861b39 100644 --- a/test/main.hs +++ b/test/main.hs @@ -82,6 +82,16 @@ integrationSpec conn = do it "can have question marks in string literals" $ do result <- query conn "select 'hello?'" () result `shouldBe` [Only ("hello?" :: Text)] + describe "with too many query params" $ do + it "should have the right message" $ do + (query conn "select 'hello?'" (Only ['a']) :: IO [Only Text]) + `shouldThrow` + (\e -> fmtMessage e == "0 '?' characters, but 1 parameters") + describe "with too few query params" $ do + it "should have the right message" $ do + (query conn "select 'hello?' = ?" () :: IO [Only Text]) + `shouldThrow` + (\e -> fmtMessage e == "1 '?' characters, but 0 parameters") describe "formatQuery" $ do it "should not blow up on a question mark in string literal" $ do formatQuery conn "select 'hello?'" () From d3d399cd8574db6ce8d6124c4eed5a95b96dc6a9 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 17 Mar 2022 17:37:27 -0600 Subject: [PATCH 5/7] warns, imporst --- Database/MySQL/Simple.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/Database/MySQL/Simple.hs b/Database/MySQL/Simple.hs index e08190e..617b9ab 100644 --- a/Database/MySQL/Simple.hs +++ b/Database/MySQL/Simple.hs @@ -104,7 +104,6 @@ import Database.MySQL.Simple.Types (Binary(..), In(..), VaArgs(..), Only(..), Qu import Text.Regex.PCRE.Light (compile, caseless, match) import qualified Data.ByteString.Char8 as B import qualified Database.MySQL.Base as Base --- import Data.Attoparsec.ByteString.Char8 hiding (Result, match) -- | Exception thrown if a 'Query' could not be formatted correctly. -- This may occur if the number of \'@?@\' characters in the query @@ -198,18 +197,18 @@ splitQuery s = reverse $ fmap (fromByteString . BS.pack . reverse) $ begin [] (B '?' -> normal (acc : ret) [] cs '\'' -> - inQuotes ret (c : acc) cs + quotes ret (c : acc) cs _ -> normal ret (c : acc) cs - inQuotes ret acc [] = - ret - inQuotes ret acc (c : cs) = + quotes ret acc [] = + acc : ret + quotes ret acc (c : cs) = case c of '\'' -> normal ret (c : acc) cs _ -> - inQuotes ret (c : acc) cs + quotes ret (c : acc) cs -- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not -- expected to return results. From 15195329df0fb95e1fb3acad0ffda4024b94a5c4 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 17 Mar 2022 17:38:40 -0600 Subject: [PATCH 6/7] format --- Database/MySQL/Simple.hs | 46 +++++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/Database/MySQL/Simple.hs b/Database/MySQL/Simple.hs index 617b9ab..ceb3c30 100644 --- a/Database/MySQL/Simple.hs +++ b/Database/MySQL/Simple.hs @@ -186,29 +186,31 @@ buildQuery conn q template xs = zipParams queryFragments <$> mapM sub xs -- | Split a query into fragments separated by @?@ characters. Does not -- break a fragment if the question mark is in a string literal. splitQuery :: ByteString -> [Builder] -splitQuery s = reverse $ fmap (fromByteString . BS.pack . reverse) $ begin [] (BS.unpack s) +splitQuery s = + reverse $ fmap (fromByteString . BS.pack . reverse) $ + begin [] (BS.unpack s) where - begin = normal [] - - normal ret acc [] = - acc : ret - normal ret acc (c : cs) = - case c of - '?' -> - normal (acc : ret) [] cs - '\'' -> - quotes ret (c : acc) cs - _ -> - normal ret (c : acc) cs - - quotes ret acc [] = - acc : ret - quotes ret acc (c : cs) = - case c of - '\'' -> - normal ret (c : acc) cs - _ -> - quotes ret (c : acc) cs + begin = normal [] + + normal ret acc [] = + acc : ret + normal ret acc (c : cs) = + case c of + '?' -> + normal (acc : ret) [] cs + '\'' -> + quotes ret (c : acc) cs + _ -> + normal ret (c : acc) cs + + quotes ret acc [] = + acc : ret + quotes ret acc (c : cs) = + case c of + '\'' -> + normal ret (c : acc) cs + _ -> + quotes ret (c : acc) cs -- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not -- expected to return results. From bb67c0c4c77d20b754224a41e83fdf050083a5f8 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 17 Mar 2022 17:43:23 -0600 Subject: [PATCH 7/7] ok --- test/main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/main.hs b/test/main.hs index 6861b39..85ed2ed 100644 --- a/test/main.hs +++ b/test/main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, StandaloneDeriving, OverloadedStrings #-} +{-# LANGUAGE CPP, OverloadedStrings #-} {-# options_ghc -fno-warn-orphans #-}