Command.hs

{-# OPTIONS_GHC -funbox-strict-fields #-}

{-|
Module      : Database.MySQL.Protocol.Command
Description : MySQL commands
Copyright   : (c) Winterland, 2016
License     : BSD
Maintainer  : drkoster@qq.com
Stability   : experimental
Portability : PORTABLE

Common MySQL commands supports.

-}

module Database.MySQL.Protocol.Command where

import           Control.Applicative
import           Control.Monad
import           Data.Binary
import           Data.Binary.Get
import           Data.Binary.Put
import           Data.ByteString                    (ByteString)
import qualified Data.ByteString.Lazy               as L
import           Database.MySQL.Protocol.MySQLValue
import           Database.MySQL.Protocol.Packet

--------------------------------------------------------------------------------
--  Commands

type StmtID = Word32

-- | All support MySQL commands.
--
data Command
    = COM_QUIT                                    -- ^ 0x01
    | COM_INIT_DB        !ByteString              -- ^ 0x02
    | COM_QUERY          !L.ByteString            -- ^ 0x03
    | COM_PING                                    -- ^ 0x0E
    | COM_BINLOG_DUMP    !Word32 !Word16 !Word32 !ByteString -- ^ 0x12
            -- binlog-pos, flags(0x01), server-id, binlog-filename
    | COM_REGISTER_SLAVE !Word32 !ByteString !ByteString !ByteString !Word16 !Word32 !Word32 -- ^ 0x15
            -- server-id, slaves hostname, slaves user, slaves password,  slaves port, replication rank(ignored), master-id(usually 0)
    | COM_STMT_PREPARE   !L.ByteString            -- ^ 0x16 statement
    | COM_STMT_EXECUTE   !StmtID ![MySQLValue]    -- ^ 0x17 stmtId, params
    | COM_STMT_CLOSE     !StmtID                  -- ^ 0x19 stmtId
    | COM_STMT_RESET     !StmtID                  -- ^ 0x1A stmtId
    | COM_UNSUPPORTED
   deriving (Show, Eq)

putCommand :: Command -> Put
putCommand COM_QUIT              = putWord8 0x01
putCommand (COM_INIT_DB db)      = putWord8 0x02 >> putByteString db
putCommand (COM_QUERY q)         = putWord8 0x03 >> putLazyByteString q
putCommand COM_PING              = putWord8 0x0E
putCommand (COM_BINLOG_DUMP pos flags sid fname) = do
    putWord8 0x12
    putWord32le pos
    putWord16le flags
    putWord32le sid
    putByteString fname
putCommand (COM_REGISTER_SLAVE sid shost susr spass sport rrank mid) = do
    putWord8 0x15
    putWord32le sid
    putLenEncBytes shost
    putLenEncBytes susr
    putLenEncBytes spass
    putWord16le sport
    putWord32le rrank
    putWord32le mid
putCommand (COM_STMT_PREPARE stmt) = putWord8 0x16 >> putLazyByteString stmt
putCommand (COM_STMT_EXECUTE stid params) = do
    putWord8 0x17
    putWord32le stid
    putWord8 0x00 -- we only use @CURSOR_TYPE_NO_CURSOR@ here
    putWord32le 1 -- const 1
    unless (null params) $ do
        putByteString . fromBitMap $ makeNullMap params
        putWord8 0x01    -- always use new-params-bound-flag
        mapM_ putParamMySQLType params
        forM_ params putBinaryField

putCommand (COM_STMT_CLOSE stid) = putWord8 0x19 >> putWord32le stid
putCommand (COM_STMT_RESET stid) = putWord8 0x1A >> putWord32le stid
putCommand _                     = fail "unsupported command"

--------------------------------------------------------------------------------
--  Prepared statment related

-- | call 'isOK' with this packet return true
data StmtPrepareOK = StmtPrepareOK
    { stmtId        :: !StmtID
    , stmtColumnCnt :: !Int
    , stmtParamCnt  :: !Int
    , stmtWarnCnt   :: !Int
    } deriving (Show, Eq)

getStmtPrepareOK :: Get StmtPrepareOK
getStmtPrepareOK = do
    skip 1 -- OK byte
    stmtid <- getWord32le
    cc <- fromIntegral <$> getWord16le
    pc <- fromIntegral <$> getWord16le
    skip 1 -- reserved
    wc <- fromIntegral <$> getWord16le
    return (StmtPrepareOK stmtid cc pc wc)
{-# INLINE getStmtPrepareOK #-}