{-# 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
    , mysql_insert_id
    -- ** 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 70 "Database/MySQL/Base/C.hsc" #-}

{-# LINE 71 "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 110 "Database/MySQL/Base/C.hsc" #-}
  act `finally` pthread_sigmask (1) set nullPtr
{-# LINE 111 "Database/MySQL/Base/C.hsc" #-}

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

data SigSet

instance Storable SigSet where
    sizeOf    _ = (128)
{-# LINE 126 "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 146 "Database/MySQL/Base/C.hsc" #-}
      Compress ->
        go (1) nullPtr
{-# LINE 148 "Database/MySQL/Base/C.hsc" #-}
      NamedPipe ->
        go (2) nullPtr
{-# LINE 150 "Database/MySQL/Base/C.hsc" #-}
      InitCommand cmd ->
        unsafeUseAsCString cmd $ go (3)
{-# LINE 152 "Database/MySQL/Base/C.hsc" #-}
      ReadDefaultFile path ->
        withCString path $ go (4)
{-# LINE 154 "Database/MySQL/Base/C.hsc" #-}
      ReadDefaultGroup group ->
        unsafeUseAsCString group $ go (5)
{-# LINE 156 "Database/MySQL/Base/C.hsc" #-}
      CharsetDir path ->
        withCString path $ go (6)
{-# LINE 158 "Database/MySQL/Base/C.hsc" #-}
      CharsetName cs ->
        withCString cs $ go (7)
{-# LINE 160 "Database/MySQL/Base/C.hsc" #-}
      LocalInFile b ->
        withBool b $ go (8)
{-# LINE 162 "Database/MySQL/Base/C.hsc" #-}
      Protocol proto ->
        withIntegral (fromEnum proto) $ go (9)
{-# LINE 164 "Database/MySQL/Base/C.hsc" #-}
      SharedMemoryBaseName name ->
        unsafeUseAsCString name $ go (10)
{-# LINE 166 "Database/MySQL/Base/C.hsc" #-}
      ReadTimeout secs ->
        withIntegral secs $ go (11)
{-# LINE 168 "Database/MySQL/Base/C.hsc" #-}
      WriteTimeout secs ->
        withIntegral secs $ go (12)
{-# LINE 170 "Database/MySQL/Base/C.hsc" #-}
      UseRemoteConnection ->
        go (14) nullPtr
{-# LINE 172 "Database/MySQL/Base/C.hsc" #-}
      UseEmbeddedConnection ->
        go (15) nullPtr
{-# LINE 174 "Database/MySQL/Base/C.hsc" #-}
      GuessConnection ->
        go (16) nullPtr
{-# LINE 176 "Database/MySQL/Base/C.hsc" #-}
      ClientIP ip ->
        unsafeUseAsCString ip $ go (17)
{-# LINE 178 "Database/MySQL/Base/C.hsc" #-}
      SecureAuth b ->
        withBool b $ go (18)
{-# LINE 180 "Database/MySQL/Base/C.hsc" #-}
      ReportDataTruncation b ->
        withBool b $ go (19)
{-# LINE 182 "Database/MySQL/Base/C.hsc" #-}
      Reconnect b ->
        withBool b $ go (20)
{-# LINE 184 "Database/MySQL/Base/C.hsc" #-}
      SSLVerifyServerCert b ->
        withBool b $ go (21)
{-# LINE 186 "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_insert_id
    :: Ptr MYSQL -> IO CULLong

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