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

{-|
Module      : Database.MySQL.BinLogProtocol.BinLogEvent
Description : Binlog event
Copyright   : (c) Winterland, 2016
License     : BSD
Maintainer  : drkoster@qq.com
Stability   : experimental
Portability : PORTABLE

Binlog event type
-}

module Database.MySQL.BinLogProtocol.BinLogEvent where

import           Control.Monad
import           Control.Monad.Loops                       (untilM)
import           Data.Binary
import           Data.Binary.Parser
import           Data.Bits
import           Data.ByteString                           (ByteString)
import qualified Data.ByteString                           as B
import qualified Data.ByteString.Lazy                      as L
import qualified Data.ByteString.Unsafe                    as B
import           Database.MySQL.BinLogProtocol.BinLogMeta
import           Database.MySQL.BinLogProtocol.BinLogValue
import           Database.MySQL.Protocol.Packet
import           Database.MySQL.Protocol.MySQLValue
import           Database.MySQL.Protocol.ColumnDef

import           Control.Exception                         (throwIO)
import           Database.MySQL.Query
import           GHC.Generics                              (Generic)

--------------------------------------------------------------------------------
-- | binlog tyoe
--
data BinLogEventType
    = BINLOG_UNKNOWN_EVENT
    | BINLOG_START_EVENT_V3
    | BINLOG_QUERY_EVENT
    | BINLOG_STOP_EVENT
    | BINLOG_ROTATE_EVENT
    | BINLOG_INTVAR_EVENT
    | BINLOG_LOAD_EVENT
    | BINLOG_SLAVE_EVENT
    | BINLOG_CREATE_FILE_EVENT
    | BINLOG_APPEND_BLOCK_EVENT
    | BINLOG_EXEC_LOAD_EVENT
    | BINLOG_DELETE_FILE_EVENT
    | BINLOG_NEW_LOAD_EVENT
    | BINLOG_RAND_EVENT
    | BINLOG_USER_VAR_EVENT
    | BINLOG_FORMAT_DESCRIPTION_EVENT
    | BINLOG_XID_EVENT
    | BINLOG_BEGIN_LOAD_QUERY_EVENT
    | BINLOG_EXECUTE_LOAD_QUERY_EVENT
    | BINLOG_TABLE_MAP_EVENT
    | BINLOG_WRITE_ROWS_EVENTv0
    | BINLOG_UPDATE_ROWS_EVENTv0
    | BINLOG_DELETE_ROWS_EVENTv0
    | BINLOG_WRITE_ROWS_EVENTv1
    | BINLOG_UPDATE_ROWS_EVENTv1
    | BINLOG_DELETE_ROWS_EVENTv1
    | BINLOG_INCIDENT_EVENT
    | BINLOG_HEARTBEAT_EVENT
    | BINLOG_IGNORABLE_EVENT
    | BINLOG_ROWS_QUERY_EVENT
    | BINLOG_WRITE_ROWS_EVENTv2
    | BINLOG_UPDATE_ROWS_EVENTv2
    | BINLOG_DELETE_ROWS_EVENTv2
    | BINLOG_GTID_EVENT
    | BINLOG_ANONYMOUS_GTID_EVENT
    | BINLOG_PREVIOUS_GTIDS_EVENT
  deriving (Int -> BinLogEventType -> ShowS
[BinLogEventType] -> ShowS
BinLogEventType -> String
(Int -> BinLogEventType -> ShowS)
-> (BinLogEventType -> String)
-> ([BinLogEventType] -> ShowS)
-> Show BinLogEventType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinLogEventType -> ShowS
showsPrec :: Int -> BinLogEventType -> ShowS
$cshow :: BinLogEventType -> String
show :: BinLogEventType -> String
$cshowList :: [BinLogEventType] -> ShowS
showList :: [BinLogEventType] -> ShowS
Show, BinLogEventType -> BinLogEventType -> Bool
(BinLogEventType -> BinLogEventType -> Bool)
-> (BinLogEventType -> BinLogEventType -> Bool)
-> Eq BinLogEventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinLogEventType -> BinLogEventType -> Bool
== :: BinLogEventType -> BinLogEventType -> Bool
$c/= :: BinLogEventType -> BinLogEventType -> Bool
/= :: BinLogEventType -> BinLogEventType -> Bool
Eq, Int -> BinLogEventType
BinLogEventType -> Int
BinLogEventType -> [BinLogEventType]
BinLogEventType -> BinLogEventType
BinLogEventType -> BinLogEventType -> [BinLogEventType]
BinLogEventType
-> BinLogEventType -> BinLogEventType -> [BinLogEventType]
(BinLogEventType -> BinLogEventType)
-> (BinLogEventType -> BinLogEventType)
-> (Int -> BinLogEventType)
-> (BinLogEventType -> Int)
-> (BinLogEventType -> [BinLogEventType])
-> (BinLogEventType -> BinLogEventType -> [BinLogEventType])
-> (BinLogEventType -> BinLogEventType -> [BinLogEventType])
-> (BinLogEventType
    -> BinLogEventType -> BinLogEventType -> [BinLogEventType])
-> Enum BinLogEventType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BinLogEventType -> BinLogEventType
succ :: BinLogEventType -> BinLogEventType
$cpred :: BinLogEventType -> BinLogEventType
pred :: BinLogEventType -> BinLogEventType
$ctoEnum :: Int -> BinLogEventType
toEnum :: Int -> BinLogEventType
$cfromEnum :: BinLogEventType -> Int
fromEnum :: BinLogEventType -> Int
$cenumFrom :: BinLogEventType -> [BinLogEventType]
enumFrom :: BinLogEventType -> [BinLogEventType]
$cenumFromThen :: BinLogEventType -> BinLogEventType -> [BinLogEventType]
enumFromThen :: BinLogEventType -> BinLogEventType -> [BinLogEventType]
$cenumFromTo :: BinLogEventType -> BinLogEventType -> [BinLogEventType]
enumFromTo :: BinLogEventType -> BinLogEventType -> [BinLogEventType]
$cenumFromThenTo :: BinLogEventType
-> BinLogEventType -> BinLogEventType -> [BinLogEventType]
enumFromThenTo :: BinLogEventType
-> BinLogEventType -> BinLogEventType -> [BinLogEventType]
Enum)

data BinLogPacket = BinLogPacket
    { BinLogPacket -> Word32
blTimestamp :: !Word32
    , BinLogPacket -> BinLogEventType
blEventType :: !BinLogEventType
    , BinLogPacket -> Word32
blServerId  :: !Word32
    , BinLogPacket -> Word32
blEventSize :: !Word32
    , BinLogPacket -> Word64
blLogPos    :: !Word64   -- ^ for future GTID compatibility
    , BinLogPacket -> Word16
blFlags     :: !Word16
    , BinLogPacket -> ByteString
blBody      :: !L.ByteString
    , BinLogPacket -> Bool
blSemiAck   :: !Bool
    } deriving (Int -> BinLogPacket -> ShowS
[BinLogPacket] -> ShowS
BinLogPacket -> String
(Int -> BinLogPacket -> ShowS)
-> (BinLogPacket -> String)
-> ([BinLogPacket] -> ShowS)
-> Show BinLogPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinLogPacket -> ShowS
showsPrec :: Int -> BinLogPacket -> ShowS
$cshow :: BinLogPacket -> String
show :: BinLogPacket -> String
$cshowList :: [BinLogPacket] -> ShowS
showList :: [BinLogPacket] -> ShowS
Show, BinLogPacket -> BinLogPacket -> Bool
(BinLogPacket -> BinLogPacket -> Bool)
-> (BinLogPacket -> BinLogPacket -> Bool) -> Eq BinLogPacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinLogPacket -> BinLogPacket -> Bool
== :: BinLogPacket -> BinLogPacket -> Bool
$c/= :: BinLogPacket -> BinLogPacket -> Bool
/= :: BinLogPacket -> BinLogPacket -> Bool
Eq)

putSemiAckResp :: Word32 -> ByteString -> Put
putSemiAckResp :: Word32 -> ByteString -> Put
putSemiAckResp Word32
pos ByteString
fn = Word32 -> Put
forall t. Binary t => t -> Put
put Word32
pos 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
forall t. Binary t => t -> Put
put ByteString
fn

getBinLogPacket :: Bool -> Bool -> Get BinLogPacket
getBinLogPacket :: Bool -> Bool -> Get BinLogPacket
getBinLogPacket Bool
checksum Bool
semi = do
    Word8
_  <- Get Word8
getWord8     -- OK byte
    Bool
ack <- if Bool
semi
        then Get Word8
getWord8 Get Word8 -> Get Bool -> Get Bool
forall a b. Get a -> Get b -> Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x01) (Word8 -> Bool) -> Get Word8 -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        else Bool -> Get Bool
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Word32
ts <- Get Word32
getWord32le
    BinLogEventType
typ <- Int -> BinLogEventType
forall a. Enum a => Int -> a
toEnum (Int -> BinLogEventType)
-> (Word8 -> Int) -> Word8 -> BinLogEventType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> BinLogEventType) -> Get Word8 -> Get BinLogEventType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    Word32
sid <- Get Word32
getWord32le
    Word32
size <- Get Word32
getWord32le
    Word32
pos <- Get Word32
getWord32le
    Word16
flgs <- Get Word16
getWord16le
    ByteString
body <- Int64 -> Get ByteString
getLazyByteString (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- if Bool
checksum then Int64
23 else Int64
19)
    BinLogPacket -> Get BinLogPacket
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
-> BinLogEventType
-> Word32
-> Word32
-> Word64
-> Word16
-> ByteString
-> Bool
-> BinLogPacket
BinLogPacket Word32
ts BinLogEventType
typ Word32
sid Word32
size (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pos) Word16
flgs ByteString
body Bool
ack)

getFromBinLogPacket :: Get a -> BinLogPacket -> IO a
getFromBinLogPacket :: forall a. Get a -> BinLogPacket -> IO a
getFromBinLogPacket Get a
g (BinLogPacket Word32
_ BinLogEventType
_ Word32
_ Word32
_ Word64
_ Word16
_ ByteString
body Bool
_ ) =
    case Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
parseDetailLazy Get a
g ByteString
body  of
        Left  (ByteString
buf, Int64
offset, String
errmsg) -> DecodePacketException -> IO a
forall e a. Exception e => e -> IO a
throwIO (ByteString -> Int64 -> String -> DecodePacketException
DecodePacketFailed ByteString
buf Int64
offset String
errmsg)
        Right (ByteString
_,   Int64
_,      a
r     ) -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

getFromBinLogPacket' :: (BinLogEventType -> Get a) -> BinLogPacket -> IO a
getFromBinLogPacket' :: forall a. (BinLogEventType -> Get a) -> BinLogPacket -> IO a
getFromBinLogPacket' BinLogEventType -> Get a
g (BinLogPacket Word32
_ BinLogEventType
typ Word32
_ Word32
_ Word64
_ Word16
_ ByteString
body Bool
_ ) =
    case Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
parseDetailLazy (BinLogEventType -> Get a
g BinLogEventType
typ) ByteString
body  of
        Left  (ByteString
buf, Int64
offset, String
errmsg) -> DecodePacketException -> IO a
forall e a. Exception e => e -> IO a
throwIO (ByteString -> Int64 -> String -> DecodePacketException
DecodePacketFailed ByteString
buf Int64
offset String
errmsg)
        Right (ByteString
_,   Int64
_,      a
r     ) -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

--------------------------------------------------------------------------------

data FormatDescription = FormatDescription
    { FormatDescription -> Word16
fdVersion              :: !Word16
    , FormatDescription -> ByteString
fdMySQLVersion         :: !ByteString
    , FormatDescription -> Word32
fdCreateTime           :: !Word32
    -- , eventHeaderLen :: !Word8  -- const 19
    , FormatDescription -> ByteString
fdEventHeaderLenVector :: !ByteString  -- ^ a array indexed by Binlog Event Type - 1
                                             -- to extract the length of the event specific header.
    } deriving (Int -> FormatDescription -> ShowS
[FormatDescription] -> ShowS
FormatDescription -> String
(Int -> FormatDescription -> ShowS)
-> (FormatDescription -> String)
-> ([FormatDescription] -> ShowS)
-> Show FormatDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormatDescription -> ShowS
showsPrec :: Int -> FormatDescription -> ShowS
$cshow :: FormatDescription -> String
show :: FormatDescription -> String
$cshowList :: [FormatDescription] -> ShowS
showList :: [FormatDescription] -> ShowS
Show, FormatDescription -> FormatDescription -> Bool
(FormatDescription -> FormatDescription -> Bool)
-> (FormatDescription -> FormatDescription -> Bool)
-> Eq FormatDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatDescription -> FormatDescription -> Bool
== :: FormatDescription -> FormatDescription -> Bool
$c/= :: FormatDescription -> FormatDescription -> Bool
/= :: FormatDescription -> FormatDescription -> Bool
Eq, (forall x. FormatDescription -> Rep FormatDescription x)
-> (forall x. Rep FormatDescription x -> FormatDescription)
-> Generic FormatDescription
forall x. Rep FormatDescription x -> FormatDescription
forall x. FormatDescription -> Rep FormatDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FormatDescription -> Rep FormatDescription x
from :: forall x. FormatDescription -> Rep FormatDescription x
$cto :: forall x. Rep FormatDescription x -> FormatDescription
to :: forall x. Rep FormatDescription x -> FormatDescription
Generic)

getFormatDescription :: Get FormatDescription
getFormatDescription :: Get FormatDescription
getFormatDescription = Word16 -> ByteString -> Word32 -> ByteString -> FormatDescription
FormatDescription (Word16 -> ByteString -> Word32 -> ByteString -> FormatDescription)
-> Get Word16
-> Get (ByteString -> Word32 -> ByteString -> FormatDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
                                         Get (ByteString -> Word32 -> ByteString -> FormatDescription)
-> Get ByteString
-> Get (Word32 -> ByteString -> FormatDescription)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
50
                                         Get (Word32 -> ByteString -> FormatDescription)
-> Get Word32 -> Get (ByteString -> FormatDescription)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32le
                                         Get (ByteString -> FormatDescription)
-> Get Word8 -> Get (ByteString -> FormatDescription)
forall a b. Get a -> Get b -> Get a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Get Word8
getWord8
                                         Get (ByteString -> FormatDescription)
-> Get ByteString -> Get FormatDescription
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString)

eventHeaderLen :: FormatDescription -> BinLogEventType -> Word8
eventHeaderLen :: FormatDescription -> BinLogEventType -> Word8
eventHeaderLen FormatDescription
fd BinLogEventType
typ = ByteString -> Int -> Word8
B.unsafeIndex (FormatDescription -> ByteString
fdEventHeaderLenVector FormatDescription
fd) (BinLogEventType -> Int
forall a. Enum a => a -> Int
fromEnum BinLogEventType
typ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

data RotateEvent = RotateEvent
    { RotateEvent -> Word64
rPos :: !Word64, RotateEvent -> ByteString
rFileName :: !ByteString } deriving (Int -> RotateEvent -> ShowS
[RotateEvent] -> ShowS
RotateEvent -> String
(Int -> RotateEvent -> ShowS)
-> (RotateEvent -> String)
-> ([RotateEvent] -> ShowS)
-> Show RotateEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RotateEvent -> ShowS
showsPrec :: Int -> RotateEvent -> ShowS
$cshow :: RotateEvent -> String
show :: RotateEvent -> String
$cshowList :: [RotateEvent] -> ShowS
showList :: [RotateEvent] -> ShowS
Show, RotateEvent -> RotateEvent -> Bool
(RotateEvent -> RotateEvent -> Bool)
-> (RotateEvent -> RotateEvent -> Bool) -> Eq RotateEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RotateEvent -> RotateEvent -> Bool
== :: RotateEvent -> RotateEvent -> Bool
$c/= :: RotateEvent -> RotateEvent -> Bool
/= :: RotateEvent -> RotateEvent -> Bool
Eq)

getRotateEvent :: Get RotateEvent
getRotateEvent :: Get RotateEvent
getRotateEvent = Word64 -> ByteString -> RotateEvent
RotateEvent (Word64 -> ByteString -> RotateEvent)
-> Get Word64 -> Get (ByteString -> RotateEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le Get (ByteString -> RotateEvent)
-> Get ByteString -> Get RotateEvent
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getRemainingByteString

-- | This's query parser for statement based binlog's query event, it's actually
-- not used in row based binlog.
--
data QueryEvent = QueryEvent
    { QueryEvent -> Word32
qSlaveProxyId :: !Word32
    , QueryEvent -> Word32
qExecTime     :: !Word32
    , QueryEvent -> Word16
qErrCode      :: !Word16
    , QueryEvent -> ByteString
qStatusVars   :: !ByteString
    , QueryEvent -> ByteString
qSchemaName   :: !ByteString
    , QueryEvent -> Query
qQuery        :: !Query
    } deriving (Int -> QueryEvent -> ShowS
[QueryEvent] -> ShowS
QueryEvent -> String
(Int -> QueryEvent -> ShowS)
-> (QueryEvent -> String)
-> ([QueryEvent] -> ShowS)
-> Show QueryEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryEvent -> ShowS
showsPrec :: Int -> QueryEvent -> ShowS
$cshow :: QueryEvent -> String
show :: QueryEvent -> String
$cshowList :: [QueryEvent] -> ShowS
showList :: [QueryEvent] -> ShowS
Show, QueryEvent -> QueryEvent -> Bool
(QueryEvent -> QueryEvent -> Bool)
-> (QueryEvent -> QueryEvent -> Bool) -> Eq QueryEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryEvent -> QueryEvent -> Bool
== :: QueryEvent -> QueryEvent -> Bool
$c/= :: QueryEvent -> QueryEvent -> Bool
/= :: QueryEvent -> QueryEvent -> Bool
Eq, (forall x. QueryEvent -> Rep QueryEvent x)
-> (forall x. Rep QueryEvent x -> QueryEvent) -> Generic QueryEvent
forall x. Rep QueryEvent x -> QueryEvent
forall x. QueryEvent -> Rep QueryEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QueryEvent -> Rep QueryEvent x
from :: forall x. QueryEvent -> Rep QueryEvent x
$cto :: forall x. Rep QueryEvent x -> QueryEvent
to :: forall x. Rep QueryEvent x -> QueryEvent
Generic)

getQueryEvent :: Get QueryEvent
getQueryEvent :: Get QueryEvent
getQueryEvent = do
    Word32
pid <- Get Word32
getWord32le
    Word32
tim <- Get Word32
getWord32le
    Word8
slen <- Get Word8
getWord8
    Word16
ecode <- Get Word16
getWord16le
    Word16
vlen <- Get Word16
getWord16le
    ByteString
svar <- Int -> Get ByteString
getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
vlen)
    ByteString
schema <- Int -> Get ByteString
getByteString (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
slen)
    Word8
_ <- Get Word8
getWord8
    ByteString
qry <- Get ByteString
getRemainingLazyByteString
    QueryEvent -> Get QueryEvent
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
-> Word32
-> Word16
-> ByteString
-> ByteString
-> Query
-> QueryEvent
QueryEvent Word32
pid Word32
tim Word16
ecode ByteString
svar ByteString
schema (ByteString -> Query
Query ByteString
qry))

-- | This's the query event in row based binlog.
--
data QueryEvent' = QueryEvent' { QueryEvent' -> Query
qQuery' :: !Query } deriving (Int -> QueryEvent' -> ShowS
[QueryEvent'] -> ShowS
QueryEvent' -> String
(Int -> QueryEvent' -> ShowS)
-> (QueryEvent' -> String)
-> ([QueryEvent'] -> ShowS)
-> Show QueryEvent'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryEvent' -> ShowS
showsPrec :: Int -> QueryEvent' -> ShowS
$cshow :: QueryEvent' -> String
show :: QueryEvent' -> String
$cshowList :: [QueryEvent'] -> ShowS
showList :: [QueryEvent'] -> ShowS
Show, QueryEvent' -> QueryEvent' -> Bool
(QueryEvent' -> QueryEvent' -> Bool)
-> (QueryEvent' -> QueryEvent' -> Bool) -> Eq QueryEvent'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryEvent' -> QueryEvent' -> Bool
== :: QueryEvent' -> QueryEvent' -> Bool
$c/= :: QueryEvent' -> QueryEvent' -> Bool
/= :: QueryEvent' -> QueryEvent' -> Bool
Eq)

getQueryEvent' :: Get QueryEvent'
getQueryEvent' :: Get QueryEvent'
getQueryEvent' = do
    Word8
_ <- Get Word8
getWord8
    Query -> QueryEvent'
QueryEvent' (Query -> QueryEvent')
-> (ByteString -> Query) -> ByteString -> QueryEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Query
Query (ByteString -> QueryEvent') -> Get ByteString -> Get QueryEvent'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString

data TableMapEvent = TableMapEvent
    { TableMapEvent -> Word64
tmTableId    :: !Word64
    , TableMapEvent -> Word16
tmFlags      :: !Word16
    , TableMapEvent -> ByteString
tmSchemaName :: !ByteString
    , TableMapEvent -> ByteString
tmTableName  :: !ByteString
    , TableMapEvent -> Int
tmColumnCnt  :: !Int
    , TableMapEvent -> [FieldType]
tmColumnType :: ![FieldType]
    , TableMapEvent -> [BinLogMeta]
tmColumnMeta :: ![BinLogMeta]
    , TableMapEvent -> ByteString
tmNullMap    :: !ByteString
    } deriving (Int -> TableMapEvent -> ShowS
[TableMapEvent] -> ShowS
TableMapEvent -> String
(Int -> TableMapEvent -> ShowS)
-> (TableMapEvent -> String)
-> ([TableMapEvent] -> ShowS)
-> Show TableMapEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableMapEvent -> ShowS
showsPrec :: Int -> TableMapEvent -> ShowS
$cshow :: TableMapEvent -> String
show :: TableMapEvent -> String
$cshowList :: [TableMapEvent] -> ShowS
showList :: [TableMapEvent] -> ShowS
Show, TableMapEvent -> TableMapEvent -> Bool
(TableMapEvent -> TableMapEvent -> Bool)
-> (TableMapEvent -> TableMapEvent -> Bool) -> Eq TableMapEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableMapEvent -> TableMapEvent -> Bool
== :: TableMapEvent -> TableMapEvent -> Bool
$c/= :: TableMapEvent -> TableMapEvent -> Bool
/= :: TableMapEvent -> TableMapEvent -> Bool
Eq, (forall x. TableMapEvent -> Rep TableMapEvent x)
-> (forall x. Rep TableMapEvent x -> TableMapEvent)
-> Generic TableMapEvent
forall x. Rep TableMapEvent x -> TableMapEvent
forall x. TableMapEvent -> Rep TableMapEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableMapEvent -> Rep TableMapEvent x
from :: forall x. TableMapEvent -> Rep TableMapEvent x
$cto :: forall x. Rep TableMapEvent x -> TableMapEvent
to :: forall x. Rep TableMapEvent x -> TableMapEvent
Generic)

getTableMapEvent :: FormatDescription -> Get TableMapEvent
getTableMapEvent :: FormatDescription -> Get TableMapEvent
getTableMapEvent FormatDescription
fd = do
    let hlen :: Word8
hlen = FormatDescription -> BinLogEventType -> Word8
eventHeaderLen FormatDescription
fd BinLogEventType
BINLOG_TABLE_MAP_EVENT
    Word64
tid <- if Word8
hlen Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
6 then Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le else Get Word64
getWord48le
    Word16
flgs <- Get Word16
getWord16le
    Word8
slen <- Get Word8
getWord8
    ByteString
schema <- Int -> Get ByteString
getByteString (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
slen)
    Word8
_ <- Get Word8
getWord8 -- 0x00
    Word8
tlen <- Get Word8
getWord8
    ByteString
table <- Int -> Get ByteString
getByteString (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
tlen)
    Word8
_ <- Get Word8
getWord8 -- 0x00
    Int
cc <- Get Int
getLenEncInt
    ByteString
colTypBS <- Int -> Get ByteString
getByteString Int
cc
    let typs :: [FieldType]
typs = (Word8 -> FieldType) -> [Word8] -> [FieldType]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> FieldType
FieldType (ByteString -> [Word8]
B.unpack ByteString
colTypBS)
    ByteString
colMetaBS <- Get ByteString
getLenEncBytes

    [BinLogMeta]
metas <- case Get [BinLogMeta]
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, [BinLogMeta])
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail ([FieldType] -> (FieldType -> Get BinLogMeta) -> Get [BinLogMeta]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FieldType]
typs FieldType -> Get BinLogMeta
getBinLogMeta) (ByteString -> ByteString
L.fromStrict ByteString
colMetaBS) of
        Left (ByteString
_, Int64
_, String
errmsg) -> String -> Get [BinLogMeta]
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errmsg
        Right (ByteString
_, Int64
_, [BinLogMeta]
r)     -> [BinLogMeta] -> Get [BinLogMeta]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return [BinLogMeta]
r

    ByteString
nullmap <- Int -> Get ByteString
getByteString ((Int
cc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
    TableMapEvent -> Get TableMapEvent
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
-> Word16
-> ByteString
-> ByteString
-> Int
-> [FieldType]
-> [BinLogMeta]
-> ByteString
-> TableMapEvent
TableMapEvent Word64
tid Word16
flgs ByteString
schema ByteString
table Int
cc [FieldType]
typs [BinLogMeta]
metas ByteString
nullmap)

data DeleteRowsEvent = DeleteRowsEvent
    { DeleteRowsEvent -> Word64
deleteTableId    :: !Word64
    , DeleteRowsEvent -> Word16
deleteFlags      :: !Word16
    -- , deleteExtraData   :: !RowsEventExtraData
    , DeleteRowsEvent -> Int
deleteColumnCnt  :: !Int
    , DeleteRowsEvent -> BitMap
deletePresentMap :: !BitMap
    , DeleteRowsEvent -> [[BinLogValue]]
deleteRowData    :: ![[BinLogValue]]
    } deriving (Int -> DeleteRowsEvent -> ShowS
[DeleteRowsEvent] -> ShowS
DeleteRowsEvent -> String
(Int -> DeleteRowsEvent -> ShowS)
-> (DeleteRowsEvent -> String)
-> ([DeleteRowsEvent] -> ShowS)
-> Show DeleteRowsEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteRowsEvent -> ShowS
showsPrec :: Int -> DeleteRowsEvent -> ShowS
$cshow :: DeleteRowsEvent -> String
show :: DeleteRowsEvent -> String
$cshowList :: [DeleteRowsEvent] -> ShowS
showList :: [DeleteRowsEvent] -> ShowS
Show, DeleteRowsEvent -> DeleteRowsEvent -> Bool
(DeleteRowsEvent -> DeleteRowsEvent -> Bool)
-> (DeleteRowsEvent -> DeleteRowsEvent -> Bool)
-> Eq DeleteRowsEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteRowsEvent -> DeleteRowsEvent -> Bool
== :: DeleteRowsEvent -> DeleteRowsEvent -> Bool
$c/= :: DeleteRowsEvent -> DeleteRowsEvent -> Bool
/= :: DeleteRowsEvent -> DeleteRowsEvent -> Bool
Eq, (forall x. DeleteRowsEvent -> Rep DeleteRowsEvent x)
-> (forall x. Rep DeleteRowsEvent x -> DeleteRowsEvent)
-> Generic DeleteRowsEvent
forall x. Rep DeleteRowsEvent x -> DeleteRowsEvent
forall x. DeleteRowsEvent -> Rep DeleteRowsEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeleteRowsEvent -> Rep DeleteRowsEvent x
from :: forall x. DeleteRowsEvent -> Rep DeleteRowsEvent x
$cto :: forall x. Rep DeleteRowsEvent x -> DeleteRowsEvent
to :: forall x. Rep DeleteRowsEvent x -> DeleteRowsEvent
Generic)

getDeleteRowEvent :: FormatDescription -> TableMapEvent -> BinLogEventType -> Get DeleteRowsEvent
getDeleteRowEvent :: FormatDescription
-> TableMapEvent -> BinLogEventType -> Get DeleteRowsEvent
getDeleteRowEvent FormatDescription
fd TableMapEvent
tme BinLogEventType
typ = do
    let hlen :: Word8
hlen = FormatDescription -> BinLogEventType -> Word8
eventHeaderLen FormatDescription
fd BinLogEventType
typ
    Word64
tid <- if Word8
hlen Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
6 then Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le else Get Word64
getWord48le
    Word16
flgs <- Get Word16
getWord16le
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BinLogEventType
typ BinLogEventType -> BinLogEventType -> Bool
forall a. Eq a => a -> a -> Bool
== BinLogEventType
BINLOG_DELETE_ROWS_EVENTv2) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
        Word16
extraLen <- Get Word16
getWord16le
        Get ByteString -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get ByteString -> Get ()) -> Get ByteString -> Get ()
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extraLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
    Int
colCnt <- Get Int
getLenEncInt
    let (Int
plen, Int
poffset) = (Int
colCnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
    BitMap
pmap <- Int -> Int -> Get BitMap
getPresentMap Int
plen Int
poffset
    Word64
-> Word16 -> Int -> BitMap -> [[BinLogValue]] -> DeleteRowsEvent
DeleteRowsEvent Word64
tid Word16
flgs Int
colCnt BitMap
pmap ([[BinLogValue]] -> DeleteRowsEvent)
-> Get [[BinLogValue]] -> Get DeleteRowsEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [BinLogValue] -> Get Bool -> Get [[BinLogValue]]
forall (m :: * -> *) a. Monad m => m a -> m Bool -> m [a]
untilM ([BinLogMeta] -> BitMap -> Get [BinLogValue]
getBinLogRow (TableMapEvent -> [BinLogMeta]
tmColumnMeta TableMapEvent
tme) BitMap
pmap) Get Bool
isEmpty

data WriteRowsEvent = WriteRowsEvent
    { WriteRowsEvent -> Word64
writeTableId    :: !Word64
    , WriteRowsEvent -> Word16
writeFlags      :: !Word16
    -- , writeExtraData   :: !RowsEventExtraData
    , WriteRowsEvent -> Int
writeColumnCnt  :: !Int
    , WriteRowsEvent -> BitMap
writePresentMap :: !BitMap
    , WriteRowsEvent -> [[BinLogValue]]
writeRowData    :: ![[BinLogValue]]
    } deriving (Int -> WriteRowsEvent -> ShowS
[WriteRowsEvent] -> ShowS
WriteRowsEvent -> String
(Int -> WriteRowsEvent -> ShowS)
-> (WriteRowsEvent -> String)
-> ([WriteRowsEvent] -> ShowS)
-> Show WriteRowsEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WriteRowsEvent -> ShowS
showsPrec :: Int -> WriteRowsEvent -> ShowS
$cshow :: WriteRowsEvent -> String
show :: WriteRowsEvent -> String
$cshowList :: [WriteRowsEvent] -> ShowS
showList :: [WriteRowsEvent] -> ShowS
Show, WriteRowsEvent -> WriteRowsEvent -> Bool
(WriteRowsEvent -> WriteRowsEvent -> Bool)
-> (WriteRowsEvent -> WriteRowsEvent -> Bool) -> Eq WriteRowsEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WriteRowsEvent -> WriteRowsEvent -> Bool
== :: WriteRowsEvent -> WriteRowsEvent -> Bool
$c/= :: WriteRowsEvent -> WriteRowsEvent -> Bool
/= :: WriteRowsEvent -> WriteRowsEvent -> Bool
Eq, (forall x. WriteRowsEvent -> Rep WriteRowsEvent x)
-> (forall x. Rep WriteRowsEvent x -> WriteRowsEvent)
-> Generic WriteRowsEvent
forall x. Rep WriteRowsEvent x -> WriteRowsEvent
forall x. WriteRowsEvent -> Rep WriteRowsEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WriteRowsEvent -> Rep WriteRowsEvent x
from :: forall x. WriteRowsEvent -> Rep WriteRowsEvent x
$cto :: forall x. Rep WriteRowsEvent x -> WriteRowsEvent
to :: forall x. Rep WriteRowsEvent x -> WriteRowsEvent
Generic)

getWriteRowEvent :: FormatDescription -> TableMapEvent -> BinLogEventType -> Get WriteRowsEvent
getWriteRowEvent :: FormatDescription
-> TableMapEvent -> BinLogEventType -> Get WriteRowsEvent
getWriteRowEvent FormatDescription
fd TableMapEvent
tme BinLogEventType
typ = do
    let hlen :: Word8
hlen = FormatDescription -> BinLogEventType -> Word8
eventHeaderLen FormatDescription
fd BinLogEventType
typ
    Word64
tid <- if Word8
hlen Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
6 then Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le else Get Word64
getWord48le
    Word16
flgs <- Get Word16
getWord16le
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BinLogEventType
typ BinLogEventType -> BinLogEventType -> Bool
forall a. Eq a => a -> a -> Bool
== BinLogEventType
BINLOG_WRITE_ROWS_EVENTv2) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
        Word16
extraLen <- Get Word16
getWord16le
        Get ByteString -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get ByteString -> Get ()) -> Get ByteString -> Get ()
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extraLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
    Int
colCnt <- Get Int
getLenEncInt
    let (Int
plen, Int
poffset) = (Int
colCnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
    BitMap
pmap <- Int -> Int -> Get BitMap
getPresentMap Int
plen Int
poffset
    Word64
-> Word16 -> Int -> BitMap -> [[BinLogValue]] -> WriteRowsEvent
WriteRowsEvent Word64
tid Word16
flgs Int
colCnt BitMap
pmap ([[BinLogValue]] -> WriteRowsEvent)
-> Get [[BinLogValue]] -> Get WriteRowsEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [BinLogValue] -> Get Bool -> Get [[BinLogValue]]
forall (m :: * -> *) a. Monad m => m a -> m Bool -> m [a]
untilM ([BinLogMeta] -> BitMap -> Get [BinLogValue]
getBinLogRow (TableMapEvent -> [BinLogMeta]
tmColumnMeta TableMapEvent
tme) BitMap
pmap) Get Bool
isEmpty

data UpdateRowsEvent = UpdateRowsEvent
    { UpdateRowsEvent -> Word64
updateTableId    :: !Word64
    , UpdateRowsEvent -> Word16
updateFlags      :: !Word16
    -- , updateExtraData   :: !RowsEventExtraData
    , UpdateRowsEvent -> Int
updateColumnCnt  :: !Int
    , UpdateRowsEvent -> (BitMap, BitMap)
updatePresentMap :: !(BitMap, BitMap)
    , UpdateRowsEvent -> [([BinLogValue], [BinLogValue])]
updateRowData    :: ![ ([BinLogValue], [BinLogValue]) ]
    } deriving (Int -> UpdateRowsEvent -> ShowS
[UpdateRowsEvent] -> ShowS
UpdateRowsEvent -> String
(Int -> UpdateRowsEvent -> ShowS)
-> (UpdateRowsEvent -> String)
-> ([UpdateRowsEvent] -> ShowS)
-> Show UpdateRowsEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateRowsEvent -> ShowS
showsPrec :: Int -> UpdateRowsEvent -> ShowS
$cshow :: UpdateRowsEvent -> String
show :: UpdateRowsEvent -> String
$cshowList :: [UpdateRowsEvent] -> ShowS
showList :: [UpdateRowsEvent] -> ShowS
Show, UpdateRowsEvent -> UpdateRowsEvent -> Bool
(UpdateRowsEvent -> UpdateRowsEvent -> Bool)
-> (UpdateRowsEvent -> UpdateRowsEvent -> Bool)
-> Eq UpdateRowsEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateRowsEvent -> UpdateRowsEvent -> Bool
== :: UpdateRowsEvent -> UpdateRowsEvent -> Bool
$c/= :: UpdateRowsEvent -> UpdateRowsEvent -> Bool
/= :: UpdateRowsEvent -> UpdateRowsEvent -> Bool
Eq, (forall x. UpdateRowsEvent -> Rep UpdateRowsEvent x)
-> (forall x. Rep UpdateRowsEvent x -> UpdateRowsEvent)
-> Generic UpdateRowsEvent
forall x. Rep UpdateRowsEvent x -> UpdateRowsEvent
forall x. UpdateRowsEvent -> Rep UpdateRowsEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdateRowsEvent -> Rep UpdateRowsEvent x
from :: forall x. UpdateRowsEvent -> Rep UpdateRowsEvent x
$cto :: forall x. Rep UpdateRowsEvent x -> UpdateRowsEvent
to :: forall x. Rep UpdateRowsEvent x -> UpdateRowsEvent
Generic)

getUpdateRowEvent :: FormatDescription -> TableMapEvent -> BinLogEventType -> Get UpdateRowsEvent
getUpdateRowEvent :: FormatDescription
-> TableMapEvent -> BinLogEventType -> Get UpdateRowsEvent
getUpdateRowEvent FormatDescription
fd TableMapEvent
tme BinLogEventType
typ = do
    let hlen :: Word8
hlen = FormatDescription -> BinLogEventType -> Word8
eventHeaderLen FormatDescription
fd BinLogEventType
typ
    Word64
tid <- if Word8
hlen Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
6 then Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le else Get Word64
getWord48le
    Word16
flgs <- Get Word16
getWord16le
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BinLogEventType
typ BinLogEventType -> BinLogEventType -> Bool
forall a. Eq a => a -> a -> Bool
== BinLogEventType
BINLOG_UPDATE_ROWS_EVENTv2) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
        Word16
extraLen <- Get Word16
getWord16le
        Get ByteString -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get ByteString -> Get ()) -> Get ByteString -> Get ()
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extraLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
    Int
colCnt <- Get Int
getLenEncInt
    let (Int
plen, Int
poffset) = (Int
colCnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
    BitMap
pmap <- Int -> Int -> Get BitMap
getPresentMap Int
plen Int
poffset
    BitMap
pmap' <- Int -> Int -> Get BitMap
getPresentMap Int
plen Int
poffset
    Word64
-> Word16
-> Int
-> (BitMap, BitMap)
-> [([BinLogValue], [BinLogValue])]
-> UpdateRowsEvent
UpdateRowsEvent Word64
tid Word16
flgs Int
colCnt (BitMap
pmap, BitMap
pmap') ([([BinLogValue], [BinLogValue])] -> UpdateRowsEvent)
-> Get [([BinLogValue], [BinLogValue])] -> Get UpdateRowsEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Get ([BinLogValue], [BinLogValue])
-> Get Bool -> Get [([BinLogValue], [BinLogValue])]
forall (m :: * -> *) a. Monad m => m a -> m Bool -> m [a]
untilM ((,) ([BinLogValue] -> [BinLogValue] -> ([BinLogValue], [BinLogValue]))
-> Get [BinLogValue]
-> Get ([BinLogValue] -> ([BinLogValue], [BinLogValue]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BinLogMeta] -> BitMap -> Get [BinLogValue]
getBinLogRow (TableMapEvent -> [BinLogMeta]
tmColumnMeta TableMapEvent
tme) BitMap
pmap Get ([BinLogValue] -> ([BinLogValue], [BinLogValue]))
-> Get [BinLogValue] -> Get ([BinLogValue], [BinLogValue])
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [BinLogMeta] -> BitMap -> Get [BinLogValue]
getBinLogRow (TableMapEvent -> [BinLogMeta]
tmColumnMeta TableMapEvent
tme) BitMap
pmap')
               Get Bool
isEmpty

getPresentMap :: Int -> Int -> Get BitMap
getPresentMap :: Int -> Int -> Get BitMap
getPresentMap Int
plen Int
poffset = do
    ByteString
pmap <- Int -> Get ByteString
getByteString Int
plen
    let pmap' :: ByteString
pmap' = if ByteString -> Bool
B.null ByteString
pmap
                then ByteString
B.empty
                else HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.init ByteString
pmap ByteString -> Word8 -> ByteString
`B.snoc` (HasCallStack => ByteString -> Word8
ByteString -> Word8
B.last ByteString
pmap Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xFF Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
poffset))
    BitMap -> Get BitMap
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> BitMap
BitMap ByteString
pmap')