{-# OPTIONS_GHC -funbox-strict-fields #-}
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
type StmtID = Word32
data Command
= COM_QUIT
| COM_INIT_DB !ByteString
| COM_QUERY !L.ByteString
| COM_PING
| COM_BINLOG_DUMP !Word32 !Word16 !Word32 !ByteString
| COM_REGISTER_SLAVE !Word32 !ByteString !ByteString !ByteString !Word16 !Word32 !Word32
| COM_STMT_PREPARE !L.ByteString
| COM_STMT_EXECUTE !StmtID ![MySQLValue] !BitMap
| COM_STMT_CLOSE !StmtID
| COM_STMT_RESET !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
Word32 -> Put
putWord32le Word32
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
(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"
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
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
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 #-}