persistent-mysql-haskell 0.3.0.0 → 0.3.3
raw patch · 5 files changed
+192/−18 lines, 5 files
Files
- ChangeLog.md +13/−0
- Database/Persist/MySQL.hs +134/−15
- Database/Persist/MySQLConnectInfoShowInstance.hs +22/−0
- README.md +21/−2
- persistent-mysql-haskell.cabal +2/−1
ChangeLog.md view
@@ -1,3 +1,16 @@+## 0.3.3+- Port from `mysql-haskell`: MySQL on duplicate key update [#674](https://github.com/yesodweb/persistent/pull/674).++## 0.3.2.1+- Port from `mysql-haskell`: Prevent spurious no-op migrations when `default=NULL` is specified - revised version [#672](https://github.com/yesodweb/persistent/pull/672) (which fixes bug [#671](https://github.com/yesodweb/persistent/issues/671) introduced by the earlier attempt [#641](https://github.com/yesodweb/persistent/pull/641)).++## 0.3.2.0+- Added conditional declaration of `Show` instance for mysql-haskell's `ConnectInfo` for compatibility with `mysql-haskell-0.8.1.0+`.++## 0.3.1.0+- Fixed compiler warnings in `stack --pedantic` mode so the project can run upstream tests on Travis.+- Minor README enhancements for badges and fixed URL for example when viewing outside of Github.+ ## 0.3.0.0 - Added API for setting [TLS client parameters](https://hackage.haskell.org/package/mysql-haskell-0.8.0.0/docs/Database-MySQL-TLS.html) for secure MySQL connections. - Exported [Data.TLSSetting](https://hackage.haskell.org/package/tcp-streams-1.0.0.0/docs/Data-TLSSetting.html) for convenient usage of TLS.
Database/Persist/MySQL.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE StandaloneDeriving #-} -- | A MySQL backend for @persistent@. module Database.Persist.MySQL@@ -17,6 +17,9 @@ , MySQLConf , mkMySQLConf , mockMigration+ , insertOnDuplicateKeyUpdate+ , insertManyOnDuplicateKeyUpdate+ , SomeField(..) -- * TLS configuration , setMySQLConnectInfoTLS , MySQLTLS.TrustedCAStore(..)@@ -56,6 +59,7 @@ import Database.Persist.Sql import Database.Persist.Sql.Types.Internal (mkPersistBackend)+import Database.Persist.MySQLConnectInfoShowInstance () import Data.Int (Int64) import qualified Database.MySQL.Base as MySQL@@ -479,7 +483,7 @@ stmtIdClmn <- getter "SELECT COLUMN_NAME, \ \IS_NULLABLE, \ \DATA_TYPE, \- \IF(IS_NULLABLE='YES', COALESCE(COLUMN_DEFAULT, 'NULL'), COLUMN_DEFAULT) \+ \COLUMN_DEFAULT \ \FROM INFORMATION_SCHEMA.COLUMNS \ \WHERE TABLE_SCHEMA = ? \ \AND TABLE_NAME = ? \@@ -495,7 +499,7 @@ \CHARACTER_MAXIMUM_LENGTH, \ \NUMERIC_PRECISION, \ \NUMERIC_SCALE, \- \IF(IS_NULLABLE='YES', COALESCE(COLUMN_DEFAULT, 'NULL'), COLUMN_DEFAULT) \+ \COLUMN_DEFAULT \ \FROM INFORMATION_SCHEMA.COLUMNS \ \WHERE TABLE_SCHEMA = ? \ \AND TABLE_NAME = ? \@@ -713,10 +717,12 @@ modType | showSqlType type_ maxLen False `ciEquals` showSqlType type_' maxLen' False && isNull == isNull' = [] | otherwise = [(name, Change col)] -- Default value+ -- Avoid DEFAULT NULL, since it is always unnecessary, and is an error for text/blob fields modDef | def == def' = [] | otherwise = case def of Nothing -> [(name, NoDefault)]- Just s -> [(name, Default $ T.unpack s)]+ Just s -> if T.toUpper s == "NULL" then []+ else [(name, Default $ T.unpack s)] in ( refDrop ++ modType ++ modDef ++ refAdd , filter ((name /=) . cName) cols ) @@ -737,7 +743,9 @@ , if nu then "NULL" else "NOT NULL" , case def of Nothing -> ""- Just s -> " DEFAULT " ++ T.unpack s+ Just s -> -- Avoid DEFAULT NULL, since it is always unnecessary, and is an error for text/blob fields+ if T.toUpper s == "NULL" then ""+ else " DEFAULT " ++ T.unpack s , case ref of Nothing -> "" Just (s, _) -> " REFERENCES " ++ escapeDBName s@@ -893,12 +901,16 @@ -- using @persistent@'s generic facilities. These values are the -- same that are given to 'withMySQLPool'. data MySQLConf = MySQLConf- { myConnInfo :: MySQLConnectInfo- -- ^ The connection information.- , myPoolSize :: Int- -- ^ How many connections should be held on the connection pool.- } deriving Show+ MySQLConnectInfo -- ^ The connection information.+ Int -- ^ How many connections should be held on the connection pool.+ deriving Show +myConnInfo :: MySQLConf -> MySQLConnectInfo+myConnInfo (MySQLConf c _) = c++setMyConnInfo :: MySQLConnectInfo -> MySQLConf -> MySQLConf+setMyConnInfo c (MySQLConf _ p) = MySQLConf c p+ -- | Public constructor for @MySQLConf@. mkMySQLConf :: MySQLConnectInfo -- ^ The connection information.@@ -953,9 +965,6 @@ setMySQLConnectInfoTLS tls ci = ci {innerConnTLS = Just tls} --- TODO: submit a PR to mysql-haskell to add SHOW instance-deriving instance Show MySQL.ConnectInfo- instance FromJSON MySQLConf where parseJSON v = modifyFailure ("Persistent: error loading MySQL conf: " ++) $ flip (withObject "MySQLConf") v $ \o -> do@@ -1004,7 +1013,7 @@ , MySQL.ciPassword = maybeEnv password "PASSWORD" , MySQL.ciDatabase = maybeEnv database "DATABASE" }- return conf { myConnInfo = MySQLConnectInfo innerCiNew Nothing }+ return $ setMyConnInfo (MySQLConnectInfo innerCiNew Nothing) conf mockMigrate :: MySQL.ConnectInfo -> [EntityDef]@@ -1080,6 +1089,116 @@ connLogFunc = undefined, connUpsertSql = undefined, connMaxParams = Nothing}- result = runReaderT . runWriterT . runWriterT $ mig + result = runReaderT . runWriterT . runWriterT $ mig resp <- result sqlbackend mapM_ T.putStrLn $ map snd $ snd resp++-- | MySQL specific 'upsert'. This will prevent multiple queries, when one will+-- do.+insertOnDuplicateKeyUpdate+ :: ( PersistEntityBackend record ~ BaseBackend backend+ , PersistEntity record+ , MonadIO m+ , PersistStore backend+ , backend ~ SqlBackend+ )+ => record+ -> [Update record]+ -> SqlPersistT m ()+insertOnDuplicateKeyUpdate record =+ insertManyOnDuplicateKeyUpdate [record] []++-- | This wraps values of an Entity's 'EntityField', making them have the same+-- type. This allows them to be put in lists.+data SomeField record where+ SomeField :: EntityField record typ -> SomeField record++-- | Do a bulk insert on the given records in the first parameter. In the event+-- that a key conflicts with a record currently in the database, the second and+-- third parameters determine what will happen.+--+-- The second parameter is a list of fields to copy from the original value.+-- This allows you to specify that, when a collision occurs, you'll just update+-- the value in the database with the field values that you inserted.+--+-- The third parameter is a list of updates to perform that are independent of+-- the value that is provided. You can use this to increment a counter value.+-- These updates only occur if the original record is present in the database.+--+-- Example:+-- > insertManyOnDuplicateKeyUpdate+-- [ {- a big ol' list of records you want to insert/update -} ]+-- [ SomeField UserName, SomeField UserEmail ] -- this copies the values that are being inserted to existing records+-- [ UserModified =. now, UserEncounted +=. 1 ] -- this update is performed for any field that matches the inserted records+insertManyOnDuplicateKeyUpdate+ :: ( PersistEntityBackend record ~ SqlBackend+ , PersistEntity record+ , MonadIO m+ )+ => [record] -- ^ A list of the records you want to insert, or update+ -> [SomeField record] -- ^ A list of the fields you want to copy over.+ -> [Update record] -- ^ A list of the updates to apply that aren't dependent on the record being inserted.+ -> SqlPersistT m ()+insertManyOnDuplicateKeyUpdate [] _ _ = return ()+insertManyOnDuplicateKeyUpdate records [] [] = insertMany_ records+insertManyOnDuplicateKeyUpdate records fieldValues updates =+ uncurry rawExecute $ mkBulkInsertQuery records fieldValues updates++-- | This creates the query for 'bulkInsertOnDuplicateKeyUpdate'. It will give+-- garbage results if you don't provide a list of either fields to copy or+-- fields to update.+mkBulkInsertQuery+ :: (PersistEntityBackend record ~ SqlBackend, PersistEntity record)+ => [record] -- ^ A list of the records you want to insert, or update+ -> [SomeField record] -- ^ A list of the fields you want to copy over.+ -> [Update record] -- ^ A list of the updates to apply that aren't dependent on the record being inserted.+ -> (Text, [PersistValue])+mkBulkInsertQuery records fieldValues updates =+ (q, recordValues <> updsValues)+ where+ fieldDefs = map (\x -> case x of SomeField rec -> persistFieldDef rec) fieldValues+ updateFieldNames = map (T.pack . escapeDBName . fieldDB) fieldDefs+ entityDef' = entityDef records+ entityFieldNames = map (T.pack . escapeDBName . fieldDB) (entityFields entityDef')+ tableName = T.pack . escapeDBName . entityDB $ entityDef'+ recordValues = concatMap (map toPersistValue . toPersistFields) records+ recordPlaceholders = commaSeparated $ map (parenWrapped . commaSeparated . map (const "?") . toPersistFields) records+ fieldSets = map (\n -> T.concat [n, "=VALUES(", n, ")"]) updateFieldNames+ upds = map mkUpdateText updates+ updsValues = map (\(Update _ val _) -> toPersistValue val) updates+ q = T.concat+ [ "INSERT INTO "+ , tableName+ , " ("+ , commaSeparated entityFieldNames+ , ") "+ , " VALUES "+ , recordPlaceholders+ , " ON DUPLICATE KEY UPDATE "+ , commaSeparated (fieldSets <> upds)+ ]++-- | Vendored from @persistent@.+mkUpdateText :: PersistEntity record => Update record -> Text+mkUpdateText x =+ case updateUpdate x of+ Assign -> n <> "=?"+ Add -> T.concat [n, "=", n, "+?"]+ Subtract -> T.concat [n, "=", n, "-?"]+ Multiply -> T.concat [n, "=", n, "*?"]+ Divide -> T.concat [n, "=", n, "/?"]+ BackendSpecificUpdate up ->+ error . T.unpack $ "BackendSpecificUpdate " <> up <> " not supported"+ where+ n = T.pack . escapeDBName . fieldDB . updateFieldDef $ x++commaSeparated :: [Text] -> Text+commaSeparated = T.intercalate ", "++parenWrapped :: Text -> Text+parenWrapped t = T.concat ["(", t, ")"]++-- | Gets the 'FieldDef' for an 'Update'. Vendored from @persistent@.+updateFieldDef :: PersistEntity v => Update v -> FieldDef+updateFieldDef (Update f _ _) = persistFieldDef f+updateFieldDef BackendUpdate {} = error "updateFieldDef did not expect BackendUpdate"
+ Database/Persist/MySQLConnectInfoShowInstance.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}++#if !MIN_VERSION_mysql_haskell(0,8,1)+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+#endif++{-|+Module : Database.Persist.MySQLConnectInfoShowInstance+Description : Conditionally adding Show instance for mysql-haskell's ConnectInfo++As of mysql_haskell-0.8.1.0, mysql-haskell's ConnectInfo ships _with_ a Show instance.+However, for earlier versions, we must supply our own instance.+We have a stand-alone package since CPP flags do not like multi-line string literals (widely used in sibling module).+-}++module Database.Persist.MySQLConnectInfoShowInstance where++#if !MIN_VERSION_mysql_haskell(0,8,1)+import qualified Database.MySQL.Base as MySQL+deriving instance Show MySQL.ConnectInfo+#endif
README.md view
@@ -1,11 +1,12 @@ # persistent-mysql-haskell -+[](https://hackage.haskell.org/package/persistent-mysql-haskell)+[](https://travis-ci.org/naushadh/persistent) A pure haskell backend for [persistent](https://github.com/yesodweb/persistent) using the MySQL database server. Internally it uses the [mysql-haskell](https://github.com/winterland1989/mysql-haskell) driver in order to access the database. -See [example/Main.hs](example/Main.hs) for how this MySQL backend can be used with Persistent.+See [example/Main.hs](https://github.com/naushadh/persistent/blob/persistent-mysql-haskell/persistent-mysql-haskell/example/Main.hs) for how this MySQL backend can be used with Persistent. ### Motivation @@ -56,6 +57,21 @@ ``` +- `mysql-haskell` and `mysql` have different APIs/mechanisms for securing the+connection to MySQL. `persistent-mysql-haskell` exposes an API to utilize+[TLS client params](https://hackage.haskell.org/package/mysql-haskell/docs/Database-MySQL-TLS.html)+that ships with `mysql-haskell`.++ ```diff+ connectInfoCustomCaStore :: MySQLConnectInfo+ - connectInfoCustomCaStore = connectInfo { connectSSL = Just customCaParams }+ + connectInfoCustomCaStore = setMySQLConnectInfoTLS customCaParams connectInfo+ where+ - customCaParams = defaultSSLInfo { sslCAPath = "foobar.pem" }+ + customCaParams = makeClientParams $ CustomCAStore "foobar.pem"+ ```++ Aside from connection configuration, persistent-mysql-haskell is functionally on par with persistent-mysql (as of writing this). This can be seen by [comparing persistent-test between this fork and upstream](https://github.com/yesodweb/persistent/compare/master...naushadh:persistent-mysql-haskell#diff-028f5df7b2b9c5c8b0fa670fc8c69bff). ### FAQs@@ -75,6 +91,9 @@ - It does! :) `persistent-test` is fully re-used with an additional flag to specifically test persistent-mysql-haskell. + - [CI/Travis](https://travis-ci.org/naushadh/persistent), see [.travis.yml](../.travis.yml).++ - Local, ```bash stack test persistent-test --flag persistent-test:mysql_haskell ```
persistent-mysql-haskell.cabal view
@@ -1,5 +1,5 @@ name: persistent-mysql-haskell-version: 0.3.0.0+version: 0.3.3 license: MIT license-file: LICENSE author: Naushadh <naushadh@protonmail.com>, Felipe Lessa <felipe.lessa@gmail.com>, Michael Snoyman@@ -44,6 +44,7 @@ , network >= 2.3 && < 3.0 , tls >= 1.3.5 && < 1.4 exposed-modules: Database.Persist.MySQL+ other-modules: Database.Persist.MySQLConnectInfoShowInstance ghc-options: -Wall executable persistent-mysql-haskell-example