diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,8 +1,12 @@ # Revision history for mysql-haskell +## 0.7.1.0 -- 2016-11-21 + +* Add `QueryParam` class and `Param` datatype for multi-valued parameter(s) by [naushadh](https://github.com/naushadh). + ## 0.7.0.0 -- 2016-11-09 -* Split openssl support to [mysql-haskell-openssl](hackage.haskell.org/package/mysql-haskell-openssl). +* Split openssl support to [mysql-haskell-openssl](http://hackage.haskell.org/package/mysql-haskell-openssl). * Expose `Database.MySQL.Connection` module due to this split, it shouldn't be used by user directly. ## 0.6.0.0 -- 2016-10-25 diff --git a/Database/MySQL/Base.hs b/Database/MySQL/Base.hs --- a/Database/MySQL/Base.hs +++ b/Database/MySQL/Base.hs @@ -51,6 +51,8 @@ , resetStmt -- * Helpers , withTransaction + , QueryParam(..) + , Param (..) , Query(..) , renderParams , command @@ -95,9 +97,12 @@ -- will be escaped before get filled into the query, please DO NOT enable @NO_BACKSLASH_ESCAPES@, -- and you should consider using prepared statement if this's not an one shot query. -- -execute :: MySQLConn -> Query -> [MySQLValue] -> IO OK +execute :: QueryParam p => MySQLConn -> Query -> [p] -> IO OK execute conn qry params = execute_ conn (renderParams qry params) +{-# SPECIALIZE execute :: MySQLConn -> Query -> [MySQLValue] -> IO OK #-} +{-# SPECIALIZE execute :: MySQLConn -> Query -> [Param] -> IO OK #-} + -- | Execute a multi-row query which don't return result-set. -- -- Leverage MySQL's multi-statement support to do batch insert\/update\/delete, @@ -106,13 +111,16 @@ -- -- @since 0.2.0.0 -- -executeMany :: MySQLConn -> Query -> [[MySQLValue]]-> IO [OK] +executeMany :: QueryParam p => MySQLConn -> Query -> [[p]] -> IO [OK] executeMany conn@(MySQLConn is os _ _) qry paramsList = do guardUnconsumed conn let qry' = L.intercalate ";" $ map (fromQuery . renderParams qry) paramsList writeCommand (COM_QUERY qry') os mapM (\ _ -> waitCommandReply is) paramsList +{-# SPECIALIZE executeMany :: MySQLConn -> Query -> [[MySQLValue]] -> IO [OK] #-} +{-# SPECIALIZE executeMany :: MySQLConn -> Query -> [[Param]] -> IO [OK] #-} + -- | Execute a MySQL query which don't return a result-set. -- execute_ :: MySQLConn -> Query -> IO OK @@ -124,15 +132,21 @@ -- the same 'MySQLConn', or an 'UnconsumedResultSet' will be thrown. -- if you want to skip the result-set, use 'Stream.skipToEof'. -- -query :: MySQLConn -> Query -> [MySQLValue] -> IO ([ColumnDef], InputStream [MySQLValue]) +query :: QueryParam p => MySQLConn -> Query -> [p] -> IO ([ColumnDef], InputStream [MySQLValue]) query conn qry params = query_ conn (renderParams qry params) +{-# SPECIALIZE query :: MySQLConn -> Query -> [MySQLValue] -> IO ([ColumnDef], InputStream [MySQLValue]) #-} +{-# SPECIALIZE query :: MySQLConn -> Query -> [Param] -> IO ([ColumnDef], InputStream [MySQLValue]) #-} + -- | 'V.Vector' version of 'query'. -- -- @since 0.5.1.0 -- -queryVector :: MySQLConn -> Query -> [MySQLValue] -> IO (V.Vector ColumnDef, InputStream (V.Vector MySQLValue)) +queryVector :: QueryParam p => MySQLConn -> Query -> [p] -> IO (V.Vector ColumnDef, InputStream (V.Vector MySQLValue)) queryVector conn qry params = queryVector_ conn (renderParams qry params) + +{-# SPECIALIZE queryVector :: MySQLConn -> Query -> [MySQLValue] -> IO (V.Vector ColumnDef, InputStream (V.Vector MySQLValue)) #-} +{-# SPECIALIZE queryVector :: MySQLConn -> Query -> [Param] -> IO (V.Vector ColumnDef, InputStream (V.Vector MySQLValue)) #-} -- | Execute a MySQL query which return a result-set. -- diff --git a/Database/MySQL/Protocol/Auth.hs b/Database/MySQL/Protocol/Auth.hs --- a/Database/MySQL/Protocol/Auth.hs +++ b/Database/MySQL/Protocol/Auth.hs @@ -97,13 +97,14 @@ status <- getWord16le capH <- getWord16le let cap = fromIntegral capH `shiftL` 16 .|. fromIntegral capL - authPluginLen <- getWord8 + authPluginLen <- getWord8 -- this will issue an unused warning, see the notes below skipN 10 -- 10 * 0x00 salt2 <- if (cap .&. CLIENT_SECURE_CONNECTION) == 0 then pure B.empty else getByteStringNul -- This is different with the MySQL document here -- The doc said we should expect a MAX(13, length of auth-plugin-data - 8) -- length bytes, but doing so stop us from login + -- anyway 'getByteStringNul' works perfectly here. authPlugin <- if (cap .&. CLIENT_PLUGIN_AUTH) == 0 then pure B.empty diff --git a/Database/MySQL/Query.hs b/Database/MySQL/Query.hs --- a/Database/MySQL/Query.hs +++ b/Database/MySQL/Query.hs @@ -36,13 +36,44 @@ instance IsString Query where fromString = Query . BB.toLazyByteString . BB.stringUtf8 -renderParams :: Query -> [MySQLValue] -> Query +-- | A type to wrap a query parameter in to allow for single and multi-valued parameters. +-- +-- The behavior of 'Param' can be illustrated by following example: +-- +-- @ +-- render $ One (MySQLText "hello") = hello +-- render $ Many [MySQLText "hello", MySQLText "world"] = hello, world +-- render $ Many [] = null +-- @ +-- +-- So you can now write a query like this: @ SELECT * FROM test WHERE _id IN (?, 888) @ +-- and use 'Many' 'Param' to fill the hole. There's no equivalent for prepared statement sadly. +-- +data Param = One MySQLValue + | Many [MySQLValue] + +-- | A type that may be used as a single parameter to a SQL query. Inspired from @mysql-simple@. +class QueryParam a where + render :: a -> Put + -- ^ Prepare a value for substitution into a query string. + +instance QueryParam Param where + render (One x) = putTextField x + render (Many []) = putTextField MySQLNull + render (Many (x:[]))= putTextField x + render (Many (x:xs))= do putTextField x + mapM_ (\f -> putCharUtf8 ',' >> putTextField f) xs + +instance QueryParam MySQLValue where + render = putTextField + +renderParams :: QueryParam p => Query -> [p] -> Query renderParams (Query qry) params = let fragments = LC.split '?' qry in Query . runPut $ merge fragments params where merge [x] [] = putLazyByteString x - merge (x:xs) (y:ys) = putLazyByteString x >> putTextField y >> merge xs ys + merge (x:xs) (y:ys) = putLazyByteString x >> render y >> merge xs ys merge _ _ = throw WrongParamsCount data WrongParamsCount = WrongParamsCount deriving (Show, Typeable) diff --git a/mysql-haskell.cabal b/mysql-haskell.cabal --- a/mysql-haskell.cabal +++ b/mysql-haskell.cabal @@ -1,5 +1,5 @@ name: mysql-haskell -version: 0.7.0.0 +version: 0.7.1.0 synopsis: pure haskell MySQL driver description: pure haskell MySQL driver license: BSD3 diff --git a/test/TextRowNew.hs b/test/TextRowNew.hs --- a/test/TextRowNew.hs +++ b/test/TextRowNew.hs @@ -107,3 +107,40 @@ ] Stream.skipToEof is + + let row0 = + [ MySQLInt32 0 + , MySQLDateTime (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59.10)) + , MySQLTimeStamp (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59.12)) + , MySQLTime 0 (TimeOfDay 199 59 59.1234) + ] + let row1 = + [ MySQLInt32 1 + , MySQLDateTime (LocalTime (fromGregorian 2016 08 09) (TimeOfDay 18 25 59.10)) + , MySQLTimeStamp (LocalTime (fromGregorian 2016 08 09) (TimeOfDay 18 25 59.12)) + , MySQLTime 0 (TimeOfDay 299 59 59.1234) + ] + execute c "UPDATE test_new SET \ + \__id = ? ,\ + \__datetime = ? ,\ + \__timestamp = ? ,\ + \__time = ? WHERE __id=0" + row0 + execute c "INSERT INTO test_new VALUES(\ + \?,\ + \?,\ + \?,\ + \? \ + \)" + row1 + + (_, is) <- query c "SELECT * FROM test_new WHERE __id IN (?) ORDER BY __id" [Many [MySQLInt32 0, MySQLInt32 1]] + Just v0 <- Stream.read is + Just v1 <- Stream.read is + + assertEqual "select list of ids" [v0, v1] [row0, row1] + + Stream.skipToEof is + execute_ c "DELETE FROM test_new where __id=1" + + return ()