sqlite-simple-interpolate 0.1 → 0.1.1

raw patch · 6 files changed

+108/−34 lines, 6 filesdep +sqlite-simple-interpolatedep ~basedep ~sqlite-simplePVP ok

version bump matches the API change (PVP)

Dependencies added: sqlite-simple-interpolate

Dependency ranges changed: base, sqlite-simple

API changes (from Hackage documentation)

Files

CHANGELOG.md +5/−0
README.md +13/−10
sqlite-simple-interpolate.cabal +21/−3
src/Database/SQLite/Simple/QQ/Interpolated.hs +23/−12
src/Database/SQLite/Simple/QQ/Interpolated/Parser.hs +18/−9
tests/Main.hs +28/−0

CHANGELOG.md view

@@ -1,5 +1,10 @@ # Changelog +## 0.1.1++* Add support for textual SQL injection (PR #1)+* Support GHC 8.10.7+ ## 0.1.0  * Initial version.

README.md view

@@ -4,28 +4,31 @@  ```haskell {-# LANGUAGE QuasiQuotes #-}+ module Main where +import Control.Exception (bracket) import Data.Char (toLower)+import Data.Function ((&)) import qualified Database.SQLite.Simple as SQL import Database.SQLite.Simple.QQ.Interpolated-import Control.Exception (bracket) -(&) = flip ($)-infixl 1 &+table :: String+table = "people"  main :: IO () main = bracket (SQL.open ":memory:") SQL.close $ \conn -> do-  conn & [iexecute|CREATE TABLE people (name TEXT, age INTEGER)|]-  conn & [iexecute|INSERT INTO people VALUES ("clive", 40)|]+  conn & [iexecute|CREATE TABLE !{table} (name TEXT, age INTEGER)|]++  conn & [iexecute|INSERT INTO !{table} VALUES ("clive", 40)|]   -- you can always use 'isql' directly but you'll have to use uncurry:-  (uncurry $ SQL.execute conn) [isql|INSERT INTO people VALUES ("clive", 32)|]+  (uncurry $ SQL.execute conn) [isql|INSERT INTO !{table} VALUES ("clara", 32)|] -  ageSum <- conn & [ifold|SELECT age FROM people|] 0 (\acc (SQL.Only x) -> pure (acc + x))-  print ageSum+  ageSum <- conn & [ifold|SELECT age FROM !{table}|] 0 (\acc (SQL.Only x) -> pure (acc + x))+  print (ageSum :: Int) -  let limit = 1-  ages <- conn & [iquery|SELECT age FROM people WHERE name = ${map toLower "CLIVE"} LIMIT ${limit}|]+  let limit = 1 :: Int+  ages <- conn & [iquery|SELECT age FROM !{table} WHERE name = ${map toLower "CLIVE"} LIMIT ${limit}|]   print (ages :: [SQL.Only Int]) ```

sqlite-simple-interpolate.cabal view

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               sqlite-simple-interpolate-version:            0.1+version:            0.1.1 synopsis:           Interpolated SQLite queries via quasiquotation description:   This package provides Quasiquoters for writing SQLite queries with inline interpolation of values.@@ -14,7 +14,7 @@ copyright:          ©2022 ruby0b ©2019 Elliot Cameron homepage:           https://github.com/ruby0b/sqlite-simple-interpolate category:           Database-tested-with:        GHC ==9.0.2+tested-with:        GHC ==8.10.7 || ==9.0.2 extra-source-files:   CHANGELOG.md   README.md@@ -35,7 +35,25 @@     , mtl               >=2.1  && <2.3     , parsec            ^>=3.1     , sqlite-simple     >=0.1-    , template-haskell  >=2.17 && <2.19+    , template-haskell  >=2.16 && <2.19    ghc-options:      -Wall+  default-language: Haskell2010++flag tests+  manual:  False+  default: True++test-suite sqlite-simple-interpolate-test+  type:             exitcode-stdio-1.0+  main-is:          Main.hs+  hs-source-dirs:   tests+  build-depends:+    , base                       >=4.7 && <5+    , sqlite-simple+    , sqlite-simple-interpolate++  if !flag(tests)+    buildable: False+   default-language: Haskell2010

src/Database/SQLite/Simple/QQ/Interpolated.hs view

@@ -9,12 +9,14 @@   , ifold   ) where -import Language.Haskell.TH (Exp, Q, appE, listE, sigE, tupE, varE)+import Language.Haskell.TH (Exp, Q, appE, listE, sigE, tupE, varE, litE) import Language.Haskell.TH.Quote (QuasiQuoter (..))+import Language.Haskell.TH.Syntax (Lit(..), lookupValueName) import Database.SQLite.Simple.ToField (toField)-import Database.SQLite.Simple.QQ (sql) import Text.Parsec (ParseError) import Database.SQLite.Simple+import Data.Foldable (foldrM)+import Data.String (fromString)  import Database.SQLite.Simple.QQ.Interpolated.Parser (StringPart (..), parseInterpolated) @@ -50,20 +52,29 @@   , quoteDec = error "isql quasiquoter does not support usage in declarations"   } -combineParts :: [StringPart] -> (String, [Q Exp])-combineParts = foldr step ("", [])+combineParts :: [StringPart] -> Q ([Q Exp], [Q Exp])+combineParts = foldrM step ([], [])   where     step subExpr (s, exprs) = case subExpr of-      Lit str -> (str <> s, exprs)-      Esc c -> (c : s, exprs)-      Anti e -> ('?' : s, e : exprs)+      AntiInject e -> injectExpr e (s, exprs)+      Lit str -> pure (litE (StringL str) : s, exprs)+      Esc c -> pure (litE (StringL [c]) : s, exprs)+      AntiParam e -> pure (litE (StringL "?") : s, e : exprs) +injectExpr :: String -> ([Q Exp], [Q Exp]) -> Q ([Q Exp], [Q Exp])+injectExpr name (s, exprs) = do+  valueName <- lookupValueName name+  case valueName of+    Nothing ->+      fail $ "Value `" ++ name ++ "` is not in scope"+    Just found -> do+      pure (varE found : s, exprs)+ applySql :: [StringPart] -> Q Exp-applySql parts =-  let-    (s', exps) = combineParts parts-  in-  tupE [quoteExp sql s', sigE (listE $ map (appE (varE 'toField)) exps) [t| [SQLData] |]]+applySql parts = do+  (queryParts, exps) <- combineParts parts+  let queryStr = appE [| fromString :: String -> Query |] $ appE [| concat |] $ listE queryParts+  tupE [queryStr, sigE (listE $ map (appE (varE 'toField)) exps) [t| [SQLData] |]]  -- | The internal parser used by 'isql'. quoteInterpolatedSql :: String -> Q Exp

src/Database/SQLite/Simple/QQ/Interpolated/Parser.hs view

@@ -21,7 +21,7 @@                    ) import Text.Parsec.String (Parser) -data StringPart = Lit String | Esc Char | Anti (Q Exp)+data StringPart = Lit String | Esc Char | AntiInject String | AntiParam (Q Exp)  data HsChompState = HsChompState { quoteState :: QuoteState                                  , braceCt :: Int@@ -40,20 +40,29 @@ pInterp = manyTill pStringPart eof  pStringPart :: Parser StringPart-pStringPart = pAnti <|> pEsc <|> pLit+pStringPart = pAntiInject <|> pAntiParam <|> pEsc <|> pLit -pAnti :: Parser StringPart-pAnti = Anti <$> between (try pAntiOpen) pAntiClose pAntiExpr+pAntiInject :: Parser StringPart+pAntiInject = AntiInject <$> between (try pAntiOpenInject) pAntiClose pAntiName -pAntiOpen :: Parser String-pAntiOpen = string "${"+pAntiOpenInject :: Parser String+pAntiOpenInject = string "!{" -pAntiClose :: Parser String-pAntiClose = string "}"+pAntiName :: Parser String+pAntiName = manyTill anyChar (lookAhead pAntiClose) +pAntiParam :: Parser StringPart+pAntiParam = AntiParam <$> between (try pAntiOpenParam) pAntiClose pAntiExpr++pAntiOpenParam :: Parser String+pAntiOpenParam = string "${"+ pAntiExpr :: Parser (Q Exp) pAntiExpr = pUntilUnbalancedCloseBrace >>= either fail (pure . pure) . parseExp +pAntiClose :: Parser String+pAntiClose = string "}"+ pUntilUnbalancedCloseBrace :: Parser String pUntilUnbalancedCloseBrace = evalStateT go $ HsChompState None 0 "" False   where@@ -98,6 +107,6 @@  pLit :: Parser StringPart pLit = fmap Lit $-  try (litCharTil $ try $ lookAhead pAntiOpen <|> lookAhead (string "\\"))+  try (litCharTil $ try $ lookAhead pAntiOpenInject <|> lookAhead pAntiOpenParam <|> lookAhead (string "\\"))     <|> litCharTil eof   where litCharTil = manyTill $ noneOf ['\\']

+ tests/Main.hs view

@@ -0,0 +1,28 @@+{-# LANGUAGE QuasiQuotes #-}++module Main where++import Control.Exception (bracket)+import Data.Char (toLower)+import Data.Function ((&))+import qualified Database.SQLite.Simple as SQL+import Database.SQLite.Simple.QQ.Interpolated++table :: String+table = "people"++main :: IO ()+main = bracket (SQL.open ":memory:") SQL.close $ \conn -> do+  print [isql|CREATE TABLE !{table} (name TEXT, age INTEGER)|]+  conn & [iexecute|CREATE TABLE !{table} (name TEXT, age INTEGER)|]++  print [isql|INSERT INTO !{table} VALUES ("clive", 40)|]+  conn & [iexecute|INSERT INTO !{table} VALUES ("clive", 40)|]++  ageSum <- conn & [ifold|SELECT age FROM !{table}|] 0 (\acc (SQL.Only x) -> pure (acc + x))+  print (ageSum :: Int)++  let limit = 1 :: Int+  print [isql|SELECT age FROM !{table} WHERE name = ${map toLower "CLIVE"} LIMIT ${limit}|]+  ages <- conn & [iquery|SELECT age FROM !{table} WHERE name = ${map toLower "CLIVE"} LIMIT ${limit}|]+  print (ages :: [SQL.Only Int])