Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
A MySQL backend for persistent
.
Synopsis
- withMySQLPool :: (MonadLoggerIO m, MonadUnliftIO m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend, BackendCompatible SqlBackend backend) => MySQLConnectInfo -> Int -> (Pool backend -> m a) -> m a
- withMySQLConn :: (MonadUnliftIO m, MonadLoggerIO m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend, BackendCompatible SqlBackend backend) => MySQLConnectInfo -> (backend -> m a) -> m a
- createMySQLPool :: (MonadUnliftIO m, MonadLoggerIO m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend, BackendCompatible SqlBackend backend) => MySQLConnectInfo -> Int -> m (Pool backend)
- module Database.Persist.Sql
- data MySQLConnectInfo
- mkMySQLConnectInfo :: HostName -> ByteString -> ByteString -> ByteString -> MySQLConnectInfo
- setMySQLConnectInfoPort :: PortNumber -> MySQLConnectInfo -> MySQLConnectInfo
- setMySQLConnectInfoCharset :: Word8 -> MySQLConnectInfo -> MySQLConnectInfo
- data MySQLConf
- mkMySQLConf :: MySQLConnectInfo -> Int -> MySQLConf
- mockMigration :: Migration -> IO ()
- insertOnDuplicateKeyUpdate :: (backend ~ PersistEntityBackend record, PersistEntity record, MonadIO m, PersistStore backend, BackendCompatible SqlBackend backend) => record -> [Update record] -> ReaderT backend m ()
- insertEntityOnDuplicateKeyUpdate :: (backend ~ PersistEntityBackend record, PersistEntity record, MonadIO m, PersistStore backend, BackendCompatible SqlBackend backend) => Entity record -> [Update record] -> ReaderT backend m ()
- insertManyOnDuplicateKeyUpdate :: forall record backend m. (backend ~ PersistEntityBackend record, BackendCompatible SqlBackend backend, PersistEntity record, MonadIO m) => [record] -> [HandleUpdateCollision record] -> [Update record] -> ReaderT backend m ()
- insertEntityManyOnDuplicateKeyUpdate :: forall record backend m. (backend ~ PersistEntityBackend record, BackendCompatible SqlBackend backend, PersistEntity record, MonadIO m) => [Entity record] -> [HandleUpdateCollision record] -> [Update record] -> ReaderT backend m ()
- data HandleUpdateCollision record
- copyField :: PersistField typ => EntityField record typ -> HandleUpdateCollision record
- copyUnlessNull :: PersistField typ => EntityField record (Maybe typ) -> HandleUpdateCollision record
- copyUnlessEmpty :: (Monoid typ, PersistField typ) => EntityField record typ -> HandleUpdateCollision record
- copyUnlessEq :: PersistField typ => EntityField record typ -> typ -> HandleUpdateCollision record
- setMySQLConnectInfoTLS :: ClientParams -> MySQLConnectInfo -> MySQLConnectInfo
- data TrustedCAStore
- makeClientParams :: TrustedCAStore -> IO ClientParams
- makeClientParams' :: FilePath -> [FilePath] -> FilePath -> TrustedCAStore -> IO ClientParams
- openMySQLConn :: (IsPersistBackend backend, BaseBackend backend ~ SqlBackend) => MySQLConnectInfo -> LogFunc -> IO (MySQLConn, backend)
- myConnInfo :: MySQLConf -> MySQLConnectInfo
- myPoolSize :: MySQLConf -> Int
Documentation
:: (MonadLoggerIO m, MonadUnliftIO m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend, BackendCompatible SqlBackend backend) | |
=> MySQLConnectInfo | Connection information. |
-> Int | Number of connections to be kept open in the pool. |
-> (Pool backend -> m a) | Action to be executed that uses the connection pool. |
-> m a |
Create a MySQL connection pool and run the given action.
The pool is properly released after the action finishes using
it. Note that you should not use the given ConnectionPool
outside the action since it may be already been released.
:: (MonadUnliftIO m, MonadLoggerIO m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend, BackendCompatible SqlBackend backend) | |
=> MySQLConnectInfo | Connection information. |
-> (backend -> m a) | Action to be executed that uses the connection. |
-> m a |
Same as withMySQLPool
, but instead of opening a pool
of connections, only one connection is opened.
:: (MonadUnliftIO m, MonadLoggerIO m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend, BackendCompatible SqlBackend backend) | |
=> MySQLConnectInfo | Connection information. |
-> Int | Number of connections to be kept open in the pool. |
-> m (Pool backend) |
Create a MySQL connection pool. Note that it's your
responsibility to properly close the connection pool when
unneeded. Use withMySQLPool
for automatic resource control.
module Database.Persist.Sql
data MySQLConnectInfo Source #
MySQL connection information.
Instances
Show MySQLConnectInfo Source # | |
Defined in Database.Persist.MySQL showsPrec :: Int -> MySQLConnectInfo -> ShowS # show :: MySQLConnectInfo -> String # showList :: [MySQLConnectInfo] -> ShowS # |
:: HostName | hostname |
-> ByteString | username |
-> ByteString | password |
-> ByteString | database |
-> MySQLConnectInfo |
Public constructor for MySQLConnectInfo
.
setMySQLConnectInfoPort :: PortNumber -> MySQLConnectInfo -> MySQLConnectInfo Source #
Update port number for MySQLConnectInfo
.
setMySQLConnectInfoCharset Source #
:: Word8 | Numeric ID of collation. See https://dev.mysql.com/doc/refman/5.7/en/show-collation.html. |
-> MySQLConnectInfo | Reference connectInfo to perform update on |
-> MySQLConnectInfo |
Update character set for MySQLConnectInfo
.
Information required to connect to a MySQL database
using persistent
's generic facilities. These values are the
same that are given to withMySQLPool
.
Instances
FromJSON MySQLConf Source # | |
Show MySQLConf Source # | |
PersistConfig MySQLConf Source # | |
Defined in Database.Persist.MySQL type PersistConfigBackend MySQLConf :: (Type -> Type) -> Type -> Type # type PersistConfigPool MySQLConf # loadConfig :: Value -> Parser MySQLConf # applyEnv :: MySQLConf -> IO MySQLConf # createPoolConfig :: MySQLConf -> IO (PersistConfigPool MySQLConf) # runPool :: MonadUnliftIO m => MySQLConf -> PersistConfigBackend MySQLConf m a -> PersistConfigPool MySQLConf -> m a # | |
type PersistConfigBackend MySQLConf Source # | |
Defined in Database.Persist.MySQL | |
type PersistConfigPool MySQLConf Source # | |
Defined in Database.Persist.MySQL |
:: MySQLConnectInfo | The connection information. |
-> Int | How many connections should be held on the connection pool. |
-> MySQLConf |
Public constructor for MySQLConf
.
mockMigration :: Migration -> IO () Source #
Mock a migration even when the database is not present. This function will mock the migration for a database even when the actual database isn't already present in the system.
ON DUPLICATE KEY UPDATE
Functionality
insertOnDuplicateKeyUpdate :: (backend ~ PersistEntityBackend record, PersistEntity record, MonadIO m, PersistStore backend, BackendCompatible SqlBackend backend) => record -> [Update record] -> ReaderT backend m () Source #
MySQL specific upsert_
. This will prevent multiple queries, when one will
do. The record will be inserted into the database. In the event that the
record already exists in the database, the record will have the
relevant updates performed.
insertEntityOnDuplicateKeyUpdate :: (backend ~ PersistEntityBackend record, PersistEntity record, MonadIO m, PersistStore backend, BackendCompatible SqlBackend backend) => Entity record -> [Update record] -> ReaderT backend m () Source #
Combination of insertOnDuplicateKeyUpdate
and insertKey
.
@since 5.1.0
insertManyOnDuplicateKeyUpdate Source #
:: forall record backend m. (backend ~ PersistEntityBackend record, BackendCompatible SqlBackend backend, PersistEntity record, MonadIO m) | |
=> [record] | A list of the records you want to insert, or update |
-> [HandleUpdateCollision 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. |
-> ReaderT backend m () |
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 which fields to copy from the record you're trying to insert into the database to the preexisting row.
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.
More details on HandleUpdateCollision
usage
The [
parameter allows you to specify which fields (and
under which conditions) will be copied from the inserted rows. For
a brief example, consider the following data model and existing data set:HandleUpdateCollision
]
Item name Text description Text price Double Maybe quantity Int Maybe Primary name
items: +------+-------------+-------+----------+ | name | description | price | quantity | +------+-------------+-------+----------+ | foo | very good | | 3 | | bar | | 3.99 | | +------+-------------+-------+----------+
This record type has a single natural key on itemName
. Let's suppose
that we download a CSV of new items to store into the database. Here's
our CSV:
name,description,price,quantity foo,,2.50,6 bar,even better,,5 yes,wow,,
We parse that into a list of Haskell records:
records = [ Item { itemName = "foo", itemDescription = "" , itemPrice = Just 2.50, itemQuantity = Just 6 } , Item "bar" "even better" Nothing (Just 5) , Item "yes" "wow" Nothing Nothing ]
The new CSV data is partial. It only includes updates from the
upstream vendor. Our CSV library parses the missing description field as
an empty string. We don't want to override the existing description. So
we can use the copyUnlessEmpty
function to say: "Don't update when the
value is empty."
Likewise, the new row for bar
includes a quantity, but no price. We do
not want to overwrite the existing price in the database with a NULL
value. So we can use copyUnlessNull
to only copy the existing values
in.
The final code looks like this:
insertManyOnDuplicateKeyUpdate
records
[ copyUnlessEmpty
ItemDescription
, copyUnlessNull
ItemPrice
, copyUnlessNull
ItemQuantity
]
[]
Once we run that code on the database, the new data set looks like this:
items: +------+-------------+-------+----------+ | name | description | price | quantity | +------+-------------+-------+----------+ | foo | very good | 2.50 | 6 | | bar | even better | 3.99 | 5 | | yes | wow | | | +------+-------------+-------+----------+
insertEntityManyOnDuplicateKeyUpdate Source #
:: forall record backend m. (backend ~ PersistEntityBackend record, BackendCompatible SqlBackend backend, PersistEntity record, MonadIO m) | |
=> [Entity record] | A list of the records you want to insert, or update |
-> [HandleUpdateCollision 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. |
-> ReaderT backend m () |
Combination of insertManyOnDuplicateKeyUpdate
and insertEntityMany
@since 5.1.0
data HandleUpdateCollision record Source #
This type is used to determine how to update rows using MySQL's
INSERT ... ON DUPLICATE KEY UPDATE
functionality, exposed via
insertManyOnDuplicateKeyUpdate
in this library.
Since: 2.8.0
copyField :: PersistField typ => EntityField record typ -> HandleUpdateCollision record Source #
Copy the field directly from the record.
Since: 3.0
copyUnlessNull :: PersistField typ => EntityField record (Maybe typ) -> HandleUpdateCollision record Source #
Copy the field into the database only if the value in the
corresponding record is non-NULL
.
@since 2.6.2
copyUnlessEmpty :: (Monoid typ, PersistField typ) => EntityField record typ -> HandleUpdateCollision record Source #
Copy the field into the database only if the value in the
corresponding record is non-empty, where "empty" means the Monoid
definition for mempty
. Useful for Text
, Value
, ByteString
, etc.
The resulting HandleUpdateCollision
type is useful for the
insertManyOnDuplicateKeyUpdate
function.
@since 2.6.2
copyUnlessEq :: PersistField typ => EntityField record typ -> typ -> HandleUpdateCollision record Source #
Copy the field into the database only if the field is not equal to the provided value. This is useful to avoid copying weird nullary data into the database.
The resulting HandleUpdateCollision
type is useful for the
insertManyOnDuplicateKeyUpdate
function.
@since 2.6.2
TLS configuration
setMySQLConnectInfoTLS Source #
:: ClientParams |
|
-> MySQLConnectInfo | Reference connectInfo to perform update on |
-> MySQLConnectInfo |
Set TLS ClientParams for MySQLConnectInfo
.
data TrustedCAStore #
The whole point of TLS is that: a peer should have already trusted
some certificates, which can be used for validating other peer's certificates.
if the certificates sent by other side form a chain. and one of them is issued
by one of TrustedCAStore
, Then the peer will be trusted.
SystemCAStore | provided by your operating system. |
MozillaCAStore | provided by Mozilla. |
CustomCAStore FilePath | provided by your self, the CA file can contain multiple certificates. |
Instances
Show TrustedCAStore | |
Defined in Data.TLSSetting showsPrec :: Int -> TrustedCAStore -> ShowS # show :: TrustedCAStore -> String # showList :: [TrustedCAStore] -> ShowS # | |
Eq TrustedCAStore | |
Defined in Data.TLSSetting (==) :: TrustedCAStore -> TrustedCAStore -> Bool # (/=) :: TrustedCAStore -> TrustedCAStore -> Bool # |
:: TrustedCAStore | trusted certificates. |
-> IO ClientParams |
make a simple tls ClientParams
that will validate server and use tls connection
without providing client's own certificate. suitable for connecting server which don't
validate clients.
we defer setting of clientServerIdentification
to connecting phase.
Note, tls's default validating method require server has v3 certificate.
you can use openssl's V3 extension to issue such a certificate. or change ClientParams
before connecting.
:: FilePath | public certificate (X.509 format). |
-> [FilePath] | chain certificates (X.509 format). the root of your certificate chain should be already trusted by server, or tls will fail. |
-> FilePath | private key associated. |
-> TrustedCAStore | trusted certificates. |
-> IO ClientParams |
make a simple tls ClientParams
that will validate server and use tls connection
while providing client's own certificate as well. suitable for connecting server which
validate clients.
Also only accept v3 certificate.
openMySQLConn :: (IsPersistBackend backend, BaseBackend backend ~ SqlBackend) => MySQLConnectInfo -> LogFunc -> IO (MySQLConn, backend) Source #
Open a connection to MySQL server, initialize the SqlBackend
and return
their tuple
Since: 2.12.1.0
persistent-mysql compatibility
myConnInfo :: MySQLConf -> MySQLConnectInfo Source #
Extract connection configs from MySQLConf
@since 0.4.1