{-# 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.Monad
import           Data.Binary
import           Data.Binary.Get
import           Data.Binary.Parser
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] !BitMap -- ^ 0x17 stmtId, params
    | COM_STMT_CLOSE     !StmtID                  -- ^ 0x19 stmtId
    | COM_STMT_RESET     !StmtID                  -- ^ 0x1A stmtId
    | COM_UNSUPPORTED
   deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Command -> ShowS
showsPrec :: Int -> Command -> ShowS
$cshow :: Command -> String
show :: Command -> String
$cshowList :: [Command] -> ShowS
showList :: [Command] -> ShowS
Show, Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
/= :: Command -> Command -> Bool
Eq)

putCommand :: Command -> Put
putCommand :: Command -> Put
putCommand Command
COM_QUIT              = Word8 -> Put
putWord8 Word8
0x01
putCommand (COM_INIT_DB ByteString
db)      = Word8 -> Put
putWord8 Word8
0x02 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putByteString ByteString
db
putCommand (COM_QUERY ByteString
q)         = Word8 -> Put
putWord8 Word8
0x03 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLazyByteString ByteString
q
putCommand Command
COM_PING              = Word8 -> Put
putWord8 Word8
0x0E
putCommand (COM_BINLOG_DUMP Word32
pos Word16
flags Word32
sid ByteString
fname) = do
    Word8 -> Put
putWord8 Word8
0x12
    Word32 -> Put
putWord32le Word32
pos
    Word16 -> Put
putWord16le Word16
flags
    Word32 -> Put
putWord32le Word32
sid
    ByteString -> Put
putByteString ByteString
fname
putCommand (COM_REGISTER_SLAVE Word32
sid ByteString
shost ByteString
susr ByteString
spass Word16
sport Word32
rrank Word32
mid) = do
    Word8 -> Put
putWord8 Word8
0x15
    Word32 -> Put
putWord32le Word32
sid
    ByteString -> Put
putLenEncBytes ByteString
shost
    ByteString -> Put
putLenEncBytes ByteString
susr
    ByteString -> Put
putLenEncBytes ByteString
spass
    Word16 -> Put
putWord16le Word16
sport
    Word32 -> Put
putWord32le Word32
rrank
    Word32 -> Put
putWord32le Word32
mid
putCommand (COM_STMT_PREPARE ByteString
stmt) = Word8 -> Put
putWord8 Word8
0x16 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLazyByteString ByteString
stmt
putCommand (COM_STMT_EXECUTE Word32
stid [MySQLValue]
params BitMap
nullmap) = do
    Word8 -> Put
putWord8 Word8
0x17
    Word32 -> Put
putWord32le Word32
stid
    Word8 -> Put
putWord8 Word8
0x00 -- we only use @CURSOR_TYPE_NO_CURSOR@ here
    Word32 -> Put
putWord32le Word32
1 -- const 1
    Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([MySQLValue] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MySQLValue]
params) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> Put
putByteString (BitMap -> ByteString
fromBitMap BitMap
nullmap)
        Word8 -> Put
putWord8 Word8
0x01    -- always use new-params-bound-flag
        (MySQLValue -> Put) -> [MySQLValue] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MySQLValue -> Put
putParamMySQLType [MySQLValue]
params
        [MySQLValue] -> (MySQLValue -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [MySQLValue]
params MySQLValue -> Put
putBinaryField

putCommand (COM_STMT_CLOSE Word32
stid) = Word8 -> Put
putWord8 Word8
0x19 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32le Word32
stid
putCommand (COM_STMT_RESET Word32
stid) = Word8 -> Put
putWord8 Word8
0x1A Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32le Word32
stid
putCommand Command
_                     = String -> Put
forall a. HasCallStack => String -> a
error String
"unsupported command"

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

-- | call 'isOK' with this packet return true
data StmtPrepareOK = StmtPrepareOK
    { StmtPrepareOK -> Word32
stmtId        :: !StmtID
    , StmtPrepareOK -> Int
stmtColumnCnt :: !Int
    , StmtPrepareOK -> Int
stmtParamCnt  :: !Int
    , StmtPrepareOK -> Int
stmtWarnCnt   :: !Int
    } deriving (Int -> StmtPrepareOK -> ShowS
[StmtPrepareOK] -> ShowS
StmtPrepareOK -> String
(Int -> StmtPrepareOK -> ShowS)
-> (StmtPrepareOK -> String)
-> ([StmtPrepareOK] -> ShowS)
-> Show StmtPrepareOK
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtPrepareOK -> ShowS
showsPrec :: Int -> StmtPrepareOK -> ShowS
$cshow :: StmtPrepareOK -> String
show :: StmtPrepareOK -> String
$cshowList :: [StmtPrepareOK] -> ShowS
showList :: [StmtPrepareOK] -> ShowS
Show, StmtPrepareOK -> StmtPrepareOK -> Bool
(StmtPrepareOK -> StmtPrepareOK -> Bool)
-> (StmtPrepareOK -> StmtPrepareOK -> Bool) -> Eq StmtPrepareOK
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtPrepareOK -> StmtPrepareOK -> Bool
== :: StmtPrepareOK -> StmtPrepareOK -> Bool
$c/= :: StmtPrepareOK -> StmtPrepareOK -> Bool
/= :: StmtPrepareOK -> StmtPrepareOK -> Bool
Eq)

getStmtPrepareOK :: Get StmtPrepareOK
getStmtPrepareOK :: Get StmtPrepareOK
getStmtPrepareOK = do
    Int -> Get ()
skipN Int
1 -- OK byte
    Word32
stmtid <- Get Word32
getWord32le
    Int
cc <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    Int
pc <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    Int -> Get ()
skipN Int
1 -- reserved
    Int
wc <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    StmtPrepareOK -> Get StmtPrepareOK
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Int -> Int -> Int -> StmtPrepareOK
StmtPrepareOK Word32
stmtid Int
cc Int
pc Int
wc)
{-# INLINE getStmtPrepareOK #-}