{-# LANGUAGE DeriveDataTypeable, ForeignFunctionInterface, RecordWildCards #-}-- |-- Module: Database.MySQL.Base-- Copyright: (c) 2011 MailRank, Inc.-- License: BSD3-- Maintainer: Bryan O'Sullivan <bos@mailrank.com>-- Stability: experimental-- Portability: portable---- A low-level client library for the MySQL database, implemented as-- bindings to the C @mysqlclient@ API.moduleDatabase.MySQL.Base(-- * Licensing-- $license-- * Resource management-- $mgmt-- * TypesConnectInfo(..),SSLInfo(..),Seconds,Protocol(..),Option(..),defaultConnectInfo,defaultSSLInfo,Connection,Result,Type(..),Row,MySQLError(errFunction,errNumber,errMessage)-- * Connection management,connect,close,autocommit,ping,changeUser,selectDB,setCharacterSet-- ** Connection information,threadId,serverInfo,hostInfo,protocolInfo,characterSet,sslCipher,serverStatus-- * Querying,query,insertID-- ** Escaping,escape-- ** Results,fieldCount,affectedRows-- * Working with results,isResultValid,freeResult,storeResult,useResult,fetchRow,fetchFields,dataSeek,rowSeek,rowTell-- ** Multiple results,nextResult-- * Transactions,commit,rollback-- * General information,clientInfo,clientVersion)whereimportControl.Applicative((<$>),(<*>))importControl.Exception(Exception,throw)importControl.Monad(forM_,unless,when)importData.ByteString.Char8()importData.ByteString.Internal(ByteString,create,createAndTrim,memcpy)importData.ByteString.Unsafe(unsafeUseAsCStringLen)importData.IORef(IORef,atomicModifyIORef,newIORef,readIORef,writeIORef)importData.Int(Int64)importData.List(foldl')importData.Typeable(Typeable)importData.Word(Word,Word16,Word64)importDatabase.MySQL.Base.CimportDatabase.MySQL.Base.TypesimportForeign.C.String(CString,peekCString,withCString)importForeign.C.Types(CULong)importForeign.Concurrent(newForeignPtr)importForeign.ForeignPtrhiding(newForeignPtr)importForeign.Marshal.Array(peekArray)importForeign.Ptr(Ptr,castPtr,nullPtr)importSystem.IO.Unsafe(unsafePerformIO)importSystem.Mem.Weak(Weak,deRefWeak,mkWeakPtr)-- $license---- /Important licensing note/: This library is BSD-licensed under the-- terms of the MySQL FOSS License Exception-- <http://www.mysql.com/about/legal/licensing/foss-exception/>.---- Since this library links against the GPL-licensed @mysqlclient@-- library, a non-open-source application that uses it /may/ be-- subject to the terms of the GPL.-- $mgmt---- Our rules for managing 'Connection' and 'Result' values are-- unfortunately complicated, thanks to MySQL's lifetime rules.---- At the C @libmysqlclient@ level, a single @MYSQL@ connection may-- cause multiple @MYSQL_RES@ result values to be created over the-- course of multiple queries, but only one of these @MYSQL_RES@-- values may be alive at a time. The programmer is responsible for-- knowing when to call @mysql_free_result@.---- Meanwhile, up in Haskell-land, we'd like both 'Connection' and-- 'Result' values to be managed either manually or automatically. In-- particular, we want finalizers to tidy up after a messy programmer,-- and we'd prefer it if people didn't need to be mindful of calling-- @mysql_free_result@. This means that we must wrestle with the-- lifetime rules. An obvious approach would be to use some monad and-- type magic to enforce those rules, but then we'd end up with an-- awkward API.---- Instead, we allow 'Result' values to stay alive for arbitrarily-- long times, while preserving the right to mark them as-- invalid. When a @Result@ is marked invalid, its associated-- @MYSQL_RES@ is freed, and can no longer be used.---- Since all functions over @Result@ values are in the 'IO' monad, we-- don't risk disrupting pure code by introducing this notion of-- invalidity. If code tries to use an invalid @Result@, a-- 'MySQLError' will be thrown. This should /not/ occur in normal-- code, so there should be no need to use 'isResultValid' to test a-- @Result@ for validity.---- Each of the following functions will invalidate a 'Result':---- * 'close'---- * 'freeResult'---- * 'nextResult'---- * 'storeResult'---- * 'useResult'---- A 'Result' must be able to keep a 'Connection' alive so that a-- streaming @Result@ constructed by 'useResult' can continue to pull-- data from the server, but a @Connection@ must (a) be able to cause-- the @MYSQL_RES@ behind a @Result@ to be deleted at a moment's notice,-- while (b) not artificially prolonging the life of either the @Result@-- or its @MYSQL_RES@.dataConnectInfo=ConnectInfo{connectHost::String,connectPort::Word16,connectUser::String,connectPassword::String,connectDatabase::String,connectOptions::[Option],connectPath::FilePath,connectSSL::MaybeSSLInfo}deriving(Eq,Read,Show,Typeable)dataSSLInfo=SSLInfo{sslKey::FilePath,sslCert::FilePath,sslCA::FilePath,sslCAPath::FilePath,sslCiphers::String-- ^ Comma-separated list of cipher names.}deriving(Eq,Read,Show,Typeable)dataMySQLError=ConnectionError{errFunction::String,errNumber::Int,errMessage::String}|ResultError{errFunction::String,errNumber::Int,errMessage::String}deriving(Eq,Show,Typeable)instanceExceptionMySQLError-- | Connection to a MySQL database.dataConnection=Connection{connFP::ForeignPtrMYSQL,connClose::IO(),connResult::IORef(Maybe(WeakResult))}-- | Result of a database query.dataResult=Result{resFP::ForeignPtrMYSQL_RES,resFields::{-# UNPACK #-}!Int,resConnection::Connection,resValid::IORefBool,resFetchFields::PtrMYSQL_RES->IO(PtrField),resFetchRow::PtrMYSQL_RES->IOMYSQL_ROW,resFetchLengths::PtrMYSQL_RES->IO(PtrCULong)}|EmptyResult-- | A row cursor, used by 'rowSeek' and 'rowTell'.newtypeRow=RowMYSQL_ROW_OFFSET-- | Default information for setting up a connection.---- Defaults are as follows:---- * Server on @localhost@---- * User @root@---- * No password---- * Database @test@---- * Character set @utf8@---- Use as in the following example:---- > connect defaultConnectInfo { connectHost = "db.example.com" }defaultConnectInfo::ConnectInfodefaultConnectInfo=ConnectInfo{connectHost="localhost",connectPort=3306,connectUser="root",connectPassword="",connectDatabase="test",connectOptions=[CharsetName"utf8"],connectPath="",connectSSL=Nothing}-- | Default (empty) information for setting up an SSL connection.defaultSSLInfo::SSLInfodefaultSSLInfo=SSLInfo{sslKey="",sslCert="",sslCA="",sslCAPath="",sslCiphers=""}-- | Connect to a database.connect::ConnectInfo->IOConnectionconnectConnectInfo{..}=doclosed<-newIORefFalseptr0<-mysql_initnullPtrcaseconnectSSLofNothing->return()JustSSLInfo{..}->withStringsslKey$\ckey->withStringsslCert$\ccert->withStringsslCA$\cca->withStringsslCAPath$\ccapath->withStringsslCiphers$\ccipher->mysql_ssl_setptr0ckeyccertccaccapathccipher>>return()forM_connectOptions$\opt->dor<-mysql_optionsptr0optunless(r==0)$connectionError_"connect"ptr0letflags=foldl'(+)0.maptoConnectFlag$connectOptionsptr<-withStringconnectHost$\chost->withStringconnectUser$\cuser->withStringconnectPassword$\cpass->withStringconnectDatabase$\cdb->withStringconnectPath$\cpath->mysql_real_connectptr0chostcusercpasscdb(fromIntegralconnectPort)cpathflagswhen(ptr==nullPtr)$connectionError_"connect"ptr0res<-newIORefNothingletrealClose=docleanupConnResultreswasClosed<-atomicModifyIORefclosed$\prev->(True,prev)unlesswasClosed$mysql_closeptrfp<-newForeignPtrptrrealClosereturnConnection{connFP=fp,connClose=realClose,connResult=res}-- | Delete the 'MYSQL_RES' behind a 'Result' immediately, and mark-- the 'Result' as invalid.cleanupConnResult::IORef(Maybe(WeakResult))->IO()cleanupConnResultres=doprev<-readIORefrescaseprevofNothing->return()Justw->maybe(return())freeResult=<<deRefWeakw-- | Close a connection, and mark any outstanding 'Result' as-- invalid.close::Connection->IO()close=connClose{-# INLINE close #-}ping::Connection->IO()pingconn=withConnconn$\ptr->mysql_pingptr>>=check"ping"connthreadId::Connection->IOWordthreadIdconn=fromIntegral<$>withConnconnmysql_thread_idserverInfo::Connection->IOStringserverInfoconn=withConnconn$\ptr->peekCString=<<mysql_get_server_infoptrhostInfo::Connection->IOStringhostInfoconn=withConnconn$\ptr->peekCString=<<mysql_get_host_infoptrprotocolInfo::Connection->IOWordprotocolInfoconn=withConnconn$\ptr->fromIntegral<$>mysql_get_proto_infoptrsetCharacterSet::Connection->String->IO()setCharacterSetconncs=withCStringcs$\ccs->withConnconn$\ptr->mysql_set_character_setptrccs>>=check"setCharacterSet"conncharacterSet::Connection->IOStringcharacterSetconn=withConnconn$\ptr->peekCString=<<mysql_character_set_nameptrsslCipher::Connection->IO(MaybeString)sslCipherconn=withConnconn$\ptr->withPtrpeekCString=<<mysql_get_ssl_cipherptrserverStatus::Connection->IOStringserverStatusconn=withConnconn$\ptr->dost<-mysql_statptrcheckNull"serverStatus"connstpeekCStringstclientInfo::StringclientInfo=unsafePerformIO$peekCStringmysql_get_client_info{-# NOINLINE clientInfo #-}clientVersion::WordclientVersion=fromIntegralmysql_get_client_version{-# NOINLINE clientVersion #-}-- | Turn autocommit on or off.---- By default, MySQL runs with autocommit mode enabled. In this mode,-- as soon as you modify a table, MySQL stores your modification-- permanently.autocommit::Connection->Bool->IO()autocommitconnonOff=withConnconn$\ptr->mysql_autocommitptrb>>=check"autocommit"connwhereb=ifonOffthen1else0changeUser::Connection->String->String->MaybeString->IO()changeUserconnuserpassmdb=withCStringuser$\cuser->withCStringpass$\cpass->withMaybeStringmdb$\cdb->withConnconn$\ptr->mysql_change_userptrcusercpasscdb>>=check"changeUser"connselectDB::Connection->String->IO()selectDBconndb=withCStringdb$\cdb->withConnconn$\ptr->mysql_select_dbptrcdb>>=check"selectDB"connquery::Connection->ByteString->IO()queryconnq=withConnconn$\ptr->unsafeUseAsCStringLenq$\(p,l)->mysql_real_queryptrp(fromIntegrall)>>=check"query"conn-- | Return the value generated for an @AUTO_INCREMENT@ column by the-- previous @INSERT@ or @UPDATE@ statement.---- See <http://dev.mysql.com/doc/refman/5.5/en/mysql-insert-id.html>insertID::Connection->IOWord64insertIDconn=fromIntegral<$>(withConnconn$mysql_insert_id)-- | Return the number of fields (columns) in a result.---- * If 'Left' 'Connection', returns the number of columns for the most-- recent query on the connection.---- * For 'Right' 'Result', returns the number of columns in each row-- of this result.---- The number of columns may legitimately be zero.fieldCount::EitherConnectionResult->IOIntfieldCount(RightEmptyResult)=return0fieldCount(Rightres)=return(resFieldsres)fieldCount(Leftconn)=withConnconn$fmapfromIntegral.mysql_field_countaffectedRows::Connection->IOInt64affectedRowsconn=withConnconn$fmapfromIntegral.mysql_affected_rows-- | Retrieve a complete result.---- Any previous outstanding 'Result' is first marked as invalid.storeResult::Connection->IOResultstoreResult=frobResult"storeResult"mysql_store_resultmysql_fetch_fields_nonblockmysql_fetch_row_nonblockmysql_fetch_lengths_nonblock-- | Initiate a row-by-row retrieval of a result.---- Any previous outstanding 'Result' is first marked as invalid.useResult::Connection->IOResultuseResult=frobResult"useResult"mysql_use_resultmysql_fetch_fieldsmysql_fetch_rowmysql_fetch_lengthsfrobResult::String->(PtrMYSQL->IO(PtrMYSQL_RES))->(PtrMYSQL_RES->IO(PtrField))->(PtrMYSQL_RES->IOMYSQL_ROW)->(PtrMYSQL_RES->IO(PtrCULong))->Connection->IOResultfrobResultfuncfrobfetchFieldsFuncfetchRowFuncfetchLengthsFuncconn=withConnconn$\ptr->docleanupConnResult(connResultconn)res<-frobptrfields<-mysql_field_countptrvalid<-newIORefTrueifres==nullPtrtheniffields==0thenreturnEmptyResultelseconnectionErrorfuncconnelsedofp<-newForeignPtrres$freeResult_validresletret=Result{resFP=fp,resFields=fromIntegralfields,resConnection=conn,resValid=valid,resFetchFields=fetchFieldsFunc,resFetchRow=fetchRowFunc,resFetchLengths=fetchLengthsFunc}weak<-mkWeakPtrret(Just(freeResult_validres))writeIORef(connResultconn)(Justweak)returnret-- | Immediately free the @MYSQL_RES@ value associated with this-- 'Result', and mark the @Result@ as invalid.freeResult::Result->IO()freeResultResult{..}=withForeignPtrresFP$freeResult_resValidfreeResultEmptyResult{..}=return()-- | Check whether a 'Result' is still valid, i.e. backed by a live-- @MYSQL_RES@ value.isResultValid::Result->IOBoolisResultValidResult{..}=readIORefresValidisResultValidEmptyResult=returnFalsefreeResult_::IORefBool->PtrMYSQL_RES->IO()freeResult_validptr=dowasValid<-atomicModifyIORefvalid$\prev->(False,prev)whenwasValid$mysql_free_resultptrfetchRow::Result->IO[MaybeByteString]fetchRowres@Result{..}=withRes"fetchRow"res$\ptr->dorowPtr<-resFetchRowptrifrowPtr==nullPtrthenreturn[]elsedolenPtr<-resFetchLengthsptrcheckNull"fetchRow"resConnectionlenPtrletgolen=withPtr$\colPtr->create(fromIntegrallen)$\d->memcpyd(castPtrcolPtr)(fromIntegrallen)sequence=<<zipWithgo<$>peekArrayresFieldslenPtr<*>peekArrayresFieldsrowPtrfetchRowEmptyResult{..}=return[]fetchFields::Result->IO[Field]fetchFieldsres@Result{..}=withRes"fetchFields"res$\ptr->dopeekArrayresFields=<<resFetchFieldsptrfetchFieldsEmptyResult{..}=return[]dataSeek::Result->Int64->IO()dataSeekresrow=withRes"dataSeek"res$\ptr->mysql_data_seekptr(fromIntegralrow)rowTell::Result->IORowrowTellres=withRes"rowTell"res$\ptr->Row<$>mysql_row_tellptrrowSeek::Result->Row->IORowrowSeekres(Rowrow)=withRes"rowSeek"res$\ptr->Row<$>mysql_row_seekptrrow-- | Read the next statement result. Returns 'True' if another result-- is available, 'False' otherwise.---- This function marks the current 'Result' as invalid, if one exists.nextResult::Connection->IOBoolnextResultconn=withConnconn$\ptr->docleanupConnResult(connResultconn)i<-mysql_next_resultptrcaseiof0->returnTrue-1->returnFalse_->connectionError"nextResult"conn-- | Commit the current transaction.commit::Connection->IO()commitconn=withConnconn$\ptr->mysql_commitptr>>=check"commit"conn-- | Roll back the current transaction.rollback::Connection->IO()rollbackconn=withConnconn$\ptr->mysql_rollbackptr>>=check"rollback"connescape::Connection->ByteString->IOByteStringescapeconnbs=withConnconn$\ptr->unsafeUseAsCStringLenbs$\(p,l)->createAndTrim(l*2+1)$\to->fromIntegral<$>mysql_real_escape_stringptr(castPtrto)p(fromIntegrall)withConn::Connection->(PtrMYSQL->IOa)->IOawithConnconn=withForeignPtr(connFPconn)withRes::String->Result->(PtrMYSQL_RES->IOa)->IOawithResfuncresact=dovalid<-readIORef(resValidres)unlessvalid.throw$ResultErrorfunc0"result is no longer usable"withForeignPtr(resFPres)actwithString::String->(CString->IOa)->IOawithString[]act=actnullPtrwithStringxsact=withCStringxsactwithMaybeString::MaybeString->(CString->IOa)->IOawithMaybeStringNothingact=actnullPtrwithMaybeString(Justxs)act=withCStringxsactcheck::Numa=>String->Connection->a->IO()checkfuncconnr=unless(r==0)$connectionErrorfuncconn{-# INLINE check #-}checkNull::String->Connection->Ptra->IO()checkNullfuncconnp=when(p==nullPtr)$connectionErrorfuncconn{-# INLINE checkNull #-}withPtr::(Ptra->IOb)->Ptra->IO(Maybeb)withPtractp|p==nullPtr=returnNothing|otherwise=Just<$>actpconnectionError::String->Connection->IOaconnectionErrorfuncconn=withConnconn$connectionError_funcconnectionError_::String->PtrMYSQL->IOaconnectionError_funcptr=doerrno<-mysql_errnoptrmsg<-peekCString=<<mysql_errorptrthrow$ConnectionErrorfunc(fromIntegralerrno)msg