content: {-# 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 (Show, Eq, Enum)
  
  data BinLogPacket = BinLogPacket
      { blTimestamp :: !Word32
      , blEventType :: !BinLogEventType
      , blServerId  :: !Word32
      , blEventSize :: !Word32
      , blLogPos    :: !Word64   -- ^ for future GTID compatibility
      , blFlags     :: !Word16
      , blBody      :: !L.ByteString
      , blSemiAck   :: !Bool
      } deriving (Show, Eq)
  
  putSemiAckResp :: Word32 -> ByteString -> Put
  putSemiAckResp pos fn = put pos >> put fn
  
  getBinLogPacket :: Bool -> Bool -> Get BinLogPacket
  getBinLogPacket checksum semi = do
      _  <- getWord8     -- OK byte
      ack <- if semi
          then getWord8 >> (== 0x01) <$> getWord8
          else return False
      ts <- getWord32le
      typ <- toEnum . fromIntegral <$> getWord8
      sid <- getWord32le
      size <- getWord32le
      pos <- getWord32le
      flgs <- getWord16le
      body <- getLazyByteString (fromIntegral size - if checksum then 23 else 19)
      return (BinLogPacket ts typ sid size (fromIntegral pos) flgs body ack)
  
  getFromBinLogPacket :: Get a -> BinLogPacket -> IO a
  getFromBinLogPacket g (BinLogPacket _ _ _ _ _ _ body _ ) =
      case parseDetailLazy g body  of
          Left  (buf, offset, errmsg) -> throwIO (DecodePacketFailed buf offset errmsg)
          Right (_,   _,      r     ) -> return r
  
  getFromBinLogPacket' :: (BinLogEventType -> Get a) -> BinLogPacket -> IO a
  getFromBinLogPacket' g (BinLogPacket _ typ _ _ _ _ body _ ) =
      case parseDetailLazy (g typ) body  of
          Left  (buf, offset, errmsg) -> throwIO (DecodePacketFailed buf offset errmsg)
          Right (_,   _,      r     ) -> return r
  
  --------------------------------------------------------------------------------
  
  data FormatDescription = FormatDescription
      { fdVersion              :: !Word16
      , fdMySQLVersion         :: !ByteString
      , fdCreateTime           :: !Word32
      -- , eventHeaderLen :: !Word8  -- const 19
      , fdEventHeaderLenVector :: !ByteString  -- ^ a array indexed by Binlog Event Type - 1
                                               -- to extract the length of the event specific header.
      } deriving (Show, Eq, Generic)
  
  getFormatDescription :: Get FormatDescription
  getFormatDescription = FormatDescription <$> getWord16le
                                           <*> getByteString 50
                                           <*> getWord32le
                                           <*  getWord8
                                           <*> (L.toStrict <$> getRemainingLazyByteString)
  
  eventHeaderLen :: FormatDescription -> BinLogEventType -> Word8
  eventHeaderLen fd typ = B.unsafeIndex (fdEventHeaderLenVector fd) (fromEnum typ - 1)
  
  data RotateEvent = RotateEvent
      { rPos :: !Word64, rFileName :: !ByteString } deriving (Show, Eq)
  
  getRotateEvent :: Get RotateEvent
  getRotateEvent = RotateEvent <$> getWord64le <*> getRemainingByteString
  
  -- | This's query parser for statement based binlog's query event, it's actually
  -- not used in row based binlog.
  --
  data QueryEvent = QueryEvent
      { qSlaveProxyId :: !Word32
      , qExecTime     :: !Word32
      , qErrCode      :: !Word16
      , qStatusVars   :: !ByteString
      , qSchemaName   :: !ByteString
      , qQuery        :: !Query
      } deriving (Show, Eq, Generic)
  
  getQueryEvent :: Get QueryEvent
  getQueryEvent = do
      pid <- getWord32le
      tim <- getWord32le
      slen <- getWord8
      ecode <- getWord16le
      vlen <- getWord16le
      svar <- getByteString (fromIntegral vlen)
      schema <- getByteString (fromIntegral slen)
      _ <- getWord8
      qry <- getRemainingLazyByteString
      return (QueryEvent pid tim ecode svar schema (Query qry))
  
  -- | This's the query event in row based binlog.
  --
  data QueryEvent' = QueryEvent' { qQuery' :: !Query } deriving (Show, Eq)
  
  getQueryEvent' :: Get QueryEvent'
  getQueryEvent' = do
      _ <- getWord8
      QueryEvent' . Query <$> getRemainingLazyByteString
  
  data TableMapEvent = TableMapEvent
      { tmTableId    :: !Word64
      , tmFlags      :: !Word16
      , tmSchemaName :: !ByteString
      , tmTableName  :: !ByteString
      , tmColumnCnt  :: !Int
      , tmColumnType :: ![FieldType]
      , tmColumnMeta :: ![BinLogMeta]
      , tmNullMap    :: !ByteString
      } deriving (Show, Eq, Generic)
  
  getTableMapEvent :: FormatDescription -> Get TableMapEvent
  getTableMapEvent fd = do
      let hlen = eventHeaderLen fd BINLOG_TABLE_MAP_EVENT
      tid <- if hlen == 6 then fromIntegral <$> getWord32le else getWord48le
      flgs <- getWord16le
      slen <- getWord8
      schema <- getByteString (fromIntegral slen)
      _ <- getWord8 -- 0x00
      tlen <- getWord8
      table <- getByteString (fromIntegral tlen)
      _ <- getWord8 -- 0x00
      cc <- getLenEncInt
      colTypBS <- getByteString cc
      let typs = map FieldType (B.unpack colTypBS)
      colMetaBS <- getLenEncBytes
  
      metas <- case runGetOrFail (forM typs getBinLogMeta) (L.fromStrict colMetaBS) of
          Left (_, _, errmsg) -> fail errmsg
          Right (_, _, r)     -> return r
  
      nullmap <- getByteString ((cc + 7) `div` 8)
      return (TableMapEvent tid flgs schema table cc typs metas nullmap)
  
  data DeleteRowsEvent = DeleteRowsEvent
      { deleteTableId    :: !Word64
      , deleteFlags      :: !Word16
      -- , deleteExtraData   :: !RowsEventExtraData
      , deleteColumnCnt  :: !Int
      , deletePresentMap :: !BitMap
      , deleteRowData    :: ![[BinLogValue]]
      } deriving (Show, Eq, Generic)
  
  getDeleteRowEvent :: FormatDescription -> TableMapEvent -> BinLogEventType -> Get DeleteRowsEvent
  getDeleteRowEvent fd tme typ = do
      let hlen = eventHeaderLen fd typ
      tid <- if hlen == 6 then fromIntegral <$> getWord32le else getWord48le
      flgs <- getWord16le
      when (typ == BINLOG_DELETE_ROWS_EVENTv2) $ do
          extraLen <- getWord16le
          void $ getByteString (fromIntegral extraLen - 2)
      colCnt <- getLenEncInt
      let (plen, poffset) = (colCnt + 7) `quotRem` 8
      pmap <- getPresentMap plen poffset
      DeleteRowsEvent tid flgs colCnt pmap <$> untilM (getBinLogRow (tmColumnMeta tme) pmap) isEmpty
  
  data WriteRowsEvent = WriteRowsEvent
      { writeTableId    :: !Word64
      , writeFlags      :: !Word16
      -- , writeExtraData   :: !RowsEventExtraData
      , writeColumnCnt  :: !Int
      , writePresentMap :: !BitMap
      , writeRowData    :: ![[BinLogValue]]
      } deriving (Show, Eq, Generic)
  
  getWriteRowEvent :: FormatDescription -> TableMapEvent -> BinLogEventType -> Get WriteRowsEvent
  getWriteRowEvent fd tme typ = do
      let hlen = eventHeaderLen fd typ
      tid <- if hlen == 6 then fromIntegral <$> getWord32le else getWord48le
      flgs <- getWord16le
      when (typ == BINLOG_WRITE_ROWS_EVENTv2) $ do
          extraLen <- getWord16le
          void $ getByteString (fromIntegral extraLen - 2)
      colCnt <- getLenEncInt
      let (plen, poffset) = (colCnt + 7) `quotRem` 8
      pmap <- getPresentMap plen poffset
      WriteRowsEvent tid flgs colCnt pmap <$> untilM (getBinLogRow (tmColumnMeta tme) pmap) isEmpty
  
  data UpdateRowsEvent = UpdateRowsEvent
      { updateTableId    :: !Word64
      , updateFlags      :: !Word16
      -- , updateExtraData   :: !RowsEventExtraData
      , updateColumnCnt  :: !Int
      , updatePresentMap :: !(BitMap, BitMap)
      , updateRowData    :: ![ ([BinLogValue], [BinLogValue]) ]
      } deriving (Show, Eq, Generic)
  
  getUpdateRowEvent :: FormatDescription -> TableMapEvent -> BinLogEventType -> Get UpdateRowsEvent
  getUpdateRowEvent fd tme typ = do
      let hlen = eventHeaderLen fd typ
      tid <- if hlen == 6 then fromIntegral <$> getWord32le else getWord48le
      flgs <- getWord16le
      when (typ == BINLOG_UPDATE_ROWS_EVENTv2) $ do
          extraLen <- getWord16le
          void $ getByteString (fromIntegral extraLen - 2)
      colCnt <- getLenEncInt
      let (plen, poffset) = (colCnt + 7) `quotRem` 8
      pmap <- getPresentMap plen poffset
      pmap' <- getPresentMap plen poffset
      UpdateRowsEvent tid flgs colCnt (pmap, pmap') <$>
          untilM ((,) <$> getBinLogRow (tmColumnMeta tme) pmap <*> getBinLogRow (tmColumnMeta tme) pmap')
                 isEmpty
  
  getPresentMap :: Int -> Int -> Get BitMap
  getPresentMap plen poffset = do
      pmap <- getByteString plen
      let pmap' = if B.null pmap
                  then B.empty
                  else B.init pmap `B.snoc` (B.last pmap .&. 0xFF `shiftR` (7 - poffset))
      pure (BitMap pmap')
  
  