{-# LINE 1 "Database/MySQL/Base/C.hsc" #-}
{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-}
{-# LINE 2 "Database/MySQL/Base/C.hsc" #-}

-- |
-- Module:      Database.MySQL.Base.C
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
-- Stability:   experimental
-- Portability: portable
--
-- Direct bindings to the C @mysqlclient@ API.
module Database.MySQL.Base.C
    (
    -- * Connection management
      mysql_init
    , mysql_options
    , mysql_ssl_set
    , mysql_real_connect
    , mysql_close
    , mysql_ping
    , mysql_autocommit
    , mysql_change_user
    , mysql_select_db
    , mysql_set_character_set
    -- ** Connection information
    , mysql_thread_id
    , mysql_get_server_info
    , mysql_get_host_info
    , mysql_get_proto_info
    , mysql_character_set_name
    , mysql_get_ssl_cipher
    , mysql_stat
    -- * Querying
    , mysql_real_query
    -- ** Escaping
    , mysql_real_escape_string
    -- ** Results
    , mysql_field_count
    , mysql_affected_rows
    , mysql_store_result
    , mysql_use_result
    , mysql_fetch_lengths
    , mysql_fetch_lengths_nonblock
    , mysql_fetch_row
    , mysql_fetch_row_nonblock
    -- * Working with results
    , mysql_free_result
    , mysql_fetch_fields
    , mysql_fetch_fields_nonblock
    , mysql_data_seek
    , mysql_row_seek
    , mysql_row_tell
    -- ** Multiple results
    , mysql_next_result
    -- * Transactions
    , mysql_commit
    , mysql_rollback
    -- * General information
    , mysql_get_client_info
    , mysql_get_client_version
    -- * Error handling
    , mysql_errno
    , mysql_error
    -- * Support functions
    , withRTSSignalsBlocked
    ) where


{-# LINE 69 "Database/MySQL/Base/C.hsc" #-}

{-# LINE 70 "Database/MySQL/Base/C.hsc" #-}

import Control.Concurrent (rtsSupportsBoundThreads, runInBoundThread)
import Control.Exception (finally)
import Data.ByteString.Unsafe (unsafeUseAsCString)
import Database.MySQL.Base.Types
import Foreign.C.String (CString, withCString)
import Foreign.C.Types (CInt, CUInt, CULLong, CULong)
import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (Storable(..))
import System.IO.Unsafe (unsafePerformIO)

-- | Execute an 'IO' action with signals used by GHC's runtime signals
-- blocked.  The @mysqlclient@ C library does not correctly restart
-- system calls if they are interrupted by signals, so many MySQL API
-- calls can unexpectedly fail when called from a Haskell application.
-- This is most likely to occur if you are linking against GHC's
-- threaded runtime (using the @-threaded@ option).
--
-- This function blocks @SIGALRM@ and @SIGVTALRM@, runs your action,
-- then unblocks those signals.  If you have a series of HDBC calls
-- that may block for a period of time, it may be wise to wrap them in
-- this action.  Blocking and unblocking signals is cheap, but not
-- free.
--
-- Here is an example of an exception that could be avoided by
-- temporarily blocking GHC's runtime signals:
--
-- >  SqlError {
-- >    seState = "", 
-- >    seNativeError = 2003, 
-- >    seErrorMsg = "Can't connect to MySQL server on 'localhost' (4)"
-- >  }
withRTSSignalsBlocked :: IO a -> IO a
withRTSSignalsBlocked act
    | not rtsSupportsBoundThreads = act
    | otherwise = runInBoundThread . withForeignPtr rtsSignals $ \set -> do
  pthread_sigmask (0) set nullPtr
{-# LINE 109 "Database/MySQL/Base/C.hsc" #-}
  act `finally` pthread_sigmask (1) set nullPtr
{-# LINE 110 "Database/MySQL/Base/C.hsc" #-}

rtsSignals :: ForeignPtr SigSet
rtsSignals = unsafePerformIO $ do
               fp <- mallocForeignPtr
               withForeignPtr fp $ \set -> do
                 sigemptyset set
                 sigaddset set (14)
{-# LINE 117 "Database/MySQL/Base/C.hsc" #-}
                 sigaddset set (26)
{-# LINE 118 "Database/MySQL/Base/C.hsc" #-}
               return fp
{-# NOINLINE rtsSignals #-}

data SigSet

instance Storable SigSet where
    sizeOf    _ = (128)
{-# LINE 125 "Database/MySQL/Base/C.hsc" #-}
    alignment _ = alignment (undefined :: Ptr CInt)

foreign import ccall unsafe "signal.h sigaddset" sigaddset
    :: Ptr SigSet -> CInt -> IO ()

foreign import ccall unsafe "signal.h sigemptyset" sigemptyset
    :: Ptr SigSet -> IO ()

foreign import ccall unsafe "signal.h pthread_sigmask" pthread_sigmask
    :: CInt -> Ptr SigSet -> Ptr SigSet -> IO ()

foreign import ccall safe mysql_init
    :: Ptr MYSQL                -- ^ should usually be 'nullPtr'
    -> IO (Ptr MYSQL)

mysql_options :: Ptr MYSQL -> Option -> IO CInt
mysql_options ptr opt =
    case opt of
      ConnectTimeout secs ->
        withIntegral secs $ go (0)
{-# LINE 145 "Database/MySQL/Base/C.hsc" #-}
      Compress ->
        go (1) nullPtr
{-# LINE 147 "Database/MySQL/Base/C.hsc" #-}
      NamedPipe ->
        go (2) nullPtr
{-# LINE 149 "Database/MySQL/Base/C.hsc" #-}
      InitCommand cmd ->
        unsafeUseAsCString cmd $ go (3)
{-# LINE 151 "Database/MySQL/Base/C.hsc" #-}
      ReadDefaultFile path ->
        withCString path $ go (4)
{-# LINE 153 "Database/MySQL/Base/C.hsc" #-}
      ReadDefaultGroup group ->
        unsafeUseAsCString group $ go (5)
{-# LINE 155 "Database/MySQL/Base/C.hsc" #-}
      CharsetDir path ->
        withCString path $ go (6)
{-# LINE 157 "Database/MySQL/Base/C.hsc" #-}
      CharsetName cs ->
        withCString cs $ go (7)
{-# LINE 159 "Database/MySQL/Base/C.hsc" #-}
      LocalInFile b ->
        withBool b $ go (8)
{-# LINE 161 "Database/MySQL/Base/C.hsc" #-}
      Protocol proto ->
        withIntegral (fromEnum proto) $ go (9)
{-# LINE 163 "Database/MySQL/Base/C.hsc" #-}
      SharedMemoryBaseName name ->
        unsafeUseAsCString name $ go (10)
{-# LINE 165 "Database/MySQL/Base/C.hsc" #-}
      ReadTimeout secs ->
        withIntegral secs $ go (11)
{-# LINE 167 "Database/MySQL/Base/C.hsc" #-}
      WriteTimeout secs ->
        withIntegral secs $ go (12)
{-# LINE 169 "Database/MySQL/Base/C.hsc" #-}
      UseRemoteConnection ->
        go (14) nullPtr
{-# LINE 171 "Database/MySQL/Base/C.hsc" #-}
      UseEmbeddedConnection ->
        go (15) nullPtr
{-# LINE 173 "Database/MySQL/Base/C.hsc" #-}
      GuessConnection ->
        go (16) nullPtr
{-# LINE 175 "Database/MySQL/Base/C.hsc" #-}
      ClientIP ip ->
        unsafeUseAsCString ip $ go (17)
{-# LINE 177 "Database/MySQL/Base/C.hsc" #-}
      SecureAuth b ->
        withBool b $ go (18)
{-# LINE 179 "Database/MySQL/Base/C.hsc" #-}
      ReportDataTruncation b ->
        withBool b $ go (19)
{-# LINE 181 "Database/MySQL/Base/C.hsc" #-}
      Reconnect b ->
        withBool b $ go (20)
{-# LINE 183 "Database/MySQL/Base/C.hsc" #-}
      SSLVerifyServerCert b ->
        withBool b $ go (21)
{-# LINE 185 "Database/MySQL/Base/C.hsc" #-}
      -- Other options are accepted by mysql_real_connect, so ignore them.
      _ -> return 0
  where
    go = mysql_options_ ptr
    withBool b = with (if b then 1 else 0 :: CUInt)
    withIntegral i = with (fromIntegral i :: CUInt)

foreign import ccall safe "mysql.h mysql_options" mysql_options_
    :: Ptr MYSQL -> CInt -> Ptr a -> IO CInt

foreign import ccall unsafe mysql_real_connect
    :: Ptr MYSQL -- ^ Context (from 'mysql_init').
    -> CString   -- ^ Host name.
    -> CString   -- ^ User name.
    -> CString   -- ^ Password.
    -> CString   -- ^ Database.
    -> CInt      -- ^ Port.
    -> CString   -- ^ Unix socket.
    -> CULong    -- ^ Flags.
    -> IO (Ptr MYSQL)

foreign import ccall safe mysql_ssl_set
    :: Ptr MYSQL
    -> CString                  -- ^ Key.
    -> CString                  -- ^ Cert.
    -> CString                  -- ^ CA.
    -> CString                  -- ^ CA path.
    -> CString                  -- ^ Ciphers.
    -> IO MyBool

foreign import ccall unsafe mysql_close
    :: Ptr MYSQL -> IO ()

foreign import ccall unsafe mysql_ping
    :: Ptr MYSQL -> IO CInt

foreign import ccall safe mysql_thread_id
    :: Ptr MYSQL -> IO CULong

foreign import ccall unsafe mysql_autocommit
    :: Ptr MYSQL -> MyBool -> IO MyBool

foreign import ccall unsafe mysql_change_user
    :: Ptr MYSQL
    -> CString                  -- ^ user
    -> CString                  -- ^ password
    -> CString                  -- ^ database
    -> IO MyBool

foreign import ccall unsafe mysql_select_db
    :: Ptr MYSQL
    -> CString
    -> IO CInt

foreign import ccall safe mysql_get_server_info
    :: Ptr MYSQL -> IO CString

foreign import ccall safe mysql_get_host_info
    :: Ptr MYSQL -> IO CString

foreign import ccall safe mysql_get_proto_info
    :: Ptr MYSQL -> IO CUInt

foreign import ccall safe mysql_character_set_name
    :: Ptr MYSQL -> IO CString

foreign import ccall safe mysql_set_character_set
    :: Ptr MYSQL -> CString -> IO CInt

foreign import ccall safe mysql_get_ssl_cipher
    :: Ptr MYSQL -> IO CString

foreign import ccall unsafe mysql_stat
    :: Ptr MYSQL -> IO CString

foreign import ccall unsafe mysql_real_query
    :: Ptr MYSQL -> CString -> CULong -> IO CInt

foreign import ccall safe mysql_field_count
    :: Ptr MYSQL -> IO CUInt

foreign import ccall safe mysql_affected_rows
    :: Ptr MYSQL -> IO CULLong

foreign import ccall unsafe mysql_store_result
    :: Ptr MYSQL -> IO (Ptr MYSQL_RES)

foreign import ccall unsafe mysql_use_result
    :: Ptr MYSQL -> IO (Ptr MYSQL_RES)

foreign import ccall unsafe mysql_free_result
    :: Ptr MYSQL_RES -> IO ()

foreign import ccall unsafe mysql_fetch_fields
    :: Ptr MYSQL_RES -> IO (Ptr Field)

foreign import ccall safe "mysql.h mysql_fetch_fields" mysql_fetch_fields_nonblock
    :: Ptr MYSQL_RES -> IO (Ptr Field)

foreign import ccall safe mysql_data_seek
    :: Ptr MYSQL_RES -> CULLong -> IO ()

foreign import ccall safe mysql_row_seek
    :: Ptr MYSQL_RES -> MYSQL_ROW_OFFSET -> IO MYSQL_ROW_OFFSET

foreign import ccall safe mysql_row_tell
    :: Ptr MYSQL_RES -> IO MYSQL_ROW_OFFSET

foreign import ccall unsafe mysql_next_result
    :: Ptr MYSQL -> IO CInt

foreign import ccall unsafe mysql_commit
    :: Ptr MYSQL -> IO MyBool

foreign import ccall unsafe mysql_rollback
    :: Ptr MYSQL -> IO MyBool

foreign import ccall unsafe mysql_fetch_row
    :: Ptr MYSQL_RES -> IO MYSQL_ROW

foreign import ccall safe "mysql.h mysql_fetch_row" mysql_fetch_row_nonblock
    :: Ptr MYSQL_RES -> IO MYSQL_ROW

foreign import ccall unsafe mysql_fetch_lengths
    :: Ptr MYSQL_RES -> IO (Ptr CULong)

foreign import ccall safe "mysql.h mysql_fetch_lengths" mysql_fetch_lengths_nonblock
    :: Ptr MYSQL_RES -> IO (Ptr CULong)

foreign import ccall safe mysql_real_escape_string
    :: Ptr MYSQL -> CString -> CString -> CULong -> IO CULong

foreign import ccall safe mysql_get_client_info :: CString

foreign import ccall safe mysql_get_client_version :: CULong

foreign import ccall safe mysql_errno
    :: Ptr MYSQL -> IO CInt

foreign import ccall safe mysql_error
    :: Ptr MYSQL -> IO CString