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

Binlog protocol

-}

module Database.MySQL.BinLogProtocol.BinLogValue where

import           Control.Applicative
import           Data.Binary.Get
import           Data.Binary.IEEE754
import           Data.Binary.Put                          ()
import           Data.Bits
import           Data.ByteString                          (ByteString)
import qualified Data.ByteString                          as B
import qualified Data.ByteString.Unsafe                   as B
import           Data.Int
import           Data.Int.Int24
import           Data.Scientific
import           Data.Word
import           Database.MySQL.BinLogProtocol.BinLogMeta
import           Database.MySQL.Protocol.MySQLValue
import           Database.MySQL.Protocol.Packet
import           GHC.Generics                             (Generic)

-- | Data type for representing binlog values.
--
-- This data type DOES NOT try to parse binlog values into detailed haskell values,
-- because you may not want to waste performance in situations like database middleware.
--
-- Due to the lack of signedness infomation in binlog meta, we cannot distinguish,
-- for example, between unsigned tiny 255 and tiny -1, so we use int to present
-- @TINY,SHORT,INT,LONG@. If you have unsigned columns, use 'fromIntegral' to convert it
-- to word to get real unsigned value back, for example, @fromIntegral (-1 :: Int) == 255 :: Word@
--
-- For above reason, we use 'Int24' to present MySQL's @INT24@ type, you can get back the
-- unsigned value using @word24@ package's 'Word24' type.
--
-- Timestamp types('BinLogTimeStamp' and 'BinLogTimeStamp2') are values converted into UTC already,
-- see 'MySQLVaule' 's note.
--
-- There's also no infomation about charset, so we use 'ByteString' to present both text
-- and blob types, if you want to get text representation back, you have to query column charset
-- infomation, and use icu or iconv to decode. IT MAY NOT BE UTF-8.
--
-- The @SET@ and @ENUM@ values are presented by their index's value and bitmap respectively,
-- if you need get the string value back, you have to perform a 'DESC tablename' to get the
-- set or enum table.
--
data BinLogValue
    = BinLogTiny       !Int8
    | BinLogShort      !Int16
    | BinLogInt24      !Int24
    | BinLogLong       !Int32
    | BinLogLongLong   !Int64
    | BinLogFloat      !Float
    | BinLogDouble     !Double
    | BinLogBit        !Word64          -- ^ a 64bit bitmap.
    | BinLogTimeStamp  !Word32          -- ^ a utc timestamp, note 0 doesn't mean @1970-01-01 00:00:00@,
                                        -- because mysql choose 0 to present '0000-00-00 00:00:00'
    | BinLogTimeStamp2 !Word32 !Word32  -- ^ like 'BinLogTimeStamp' with an addtional microseconds field.
    | BinLogDateTime   !Word16 !Word8 !Word8 !Word8 !Word8 !Word8         -- ^ YYYY MM DD hh mm ss
    | BinLogDateTime2  !Word16 !Word8 !Word8 !Word8 !Word8 !Word8 !Word32 -- ^ YYYY MM DD hh mm ss microsecond
    | BinLogDate       !Word16 !Word8 !Word8                   -- ^ YYYY MM DD
    | BinLogTime       !Word8  !Word16 !Word8 !Word8           -- ^ sign(1= non-negative, 0= negative) hh mm ss
    | BinLogTime2      !Word8  !Word16 !Word8 !Word8 !Word32   -- ^ sign(1= non-negative, 0= negative) hh mm ss microsecond
    | BinLogYear       !Word16                                 -- ^ year value, 0 stand for '0000'
    | BinLogNewDecimal !Scientific                             -- ^ sign(1= non-negative, 0= negative) integeral part, fractional part
    | BinLogEnum       !Word16                                 -- ^ enum indexing value
    | BinLogSet        !Word64                                 -- ^ set indexing 64bit bitmap.
    | BinLogBytes      !ByteString                             -- ^ all string and blob values.
    | BinLogGeometry   !ByteString
    | BinLogNull
  deriving (Int -> BinLogValue -> ShowS
[BinLogValue] -> ShowS
BinLogValue -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BinLogValue] -> ShowS
$cshowList :: [BinLogValue] -> ShowS
show :: BinLogValue -> [Char]
$cshow :: BinLogValue -> [Char]
showsPrec :: Int -> BinLogValue -> ShowS
$cshowsPrec :: Int -> BinLogValue -> ShowS
Show, BinLogValue -> BinLogValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinLogValue -> BinLogValue -> Bool
$c/= :: BinLogValue -> BinLogValue -> Bool
== :: BinLogValue -> BinLogValue -> Bool
$c== :: BinLogValue -> BinLogValue -> Bool
Eq, forall x. Rep BinLogValue x -> BinLogValue
forall x. BinLogValue -> Rep BinLogValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinLogValue x -> BinLogValue
$cfrom :: forall x. BinLogValue -> Rep BinLogValue x
Generic)

--------------------------------------------------------------------------------
-- | BinLog protocol decoder
--
getBinLogField :: BinLogMeta -> Get BinLogValue
getBinLogField :: BinLogMeta -> Get BinLogValue
getBinLogField BinLogMeta
BINLOG_TYPE_TINY                = Int8 -> BinLogValue
BinLogTiny     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
getBinLogField BinLogMeta
BINLOG_TYPE_SHORT               = Int16 -> BinLogValue
BinLogShort    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16le
getBinLogField BinLogMeta
BINLOG_TYPE_INT24               = Int24 -> BinLogValue
BinLogInt24 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord24le
getBinLogField BinLogMeta
BINLOG_TYPE_LONG                = Int32 -> BinLogValue
BinLogLong     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32le
getBinLogField BinLogMeta
BINLOG_TYPE_LONGLONG            = Int64 -> BinLogValue
BinLogLongLong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64le
getBinLogField (BINLOG_TYPE_FLOAT  Word8
_         ) = Float -> BinLogValue
BinLogFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloatle
getBinLogField (BINLOG_TYPE_DOUBLE Word8
_         ) = Double -> BinLogValue
BinLogDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getDoublele
getBinLogField (BINLOG_TYPE_BIT    Word16
_    Word8
bytes) = Word64 -> BinLogValue
BinLogBit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Get Word64
getBits' Word8
bytes
getBinLogField BinLogMeta
BINLOG_TYPE_TIMESTAMP           = Word32 -> BinLogValue
BinLogTimeStamp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le

-- A integer in @YYYYMMDD@ format, for example:
-- 99991231 stand for @9999-12-31@
getBinLogField BinLogMeta
BINLOG_TYPE_DATE = do
    Word32
i <- Get Word32
getWord24le
    let (Word32
i', Word32
dd) = Word32
i forall a. Integral a => a -> a -> (a, a)
`quotRem` Word32
32
        (Word32
yyyy, Word32
mm) = Word32
i' forall a. Integral a => a -> a -> (a, a)
`quotRem` Word32
16
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Word8 -> Word8 -> BinLogValue
BinLogDate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
yyyy)
                     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
mm)
                     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dd))

getBinLogField (BINLOG_TYPE_TIMESTAMP2  Word8
fsp) = do
    Word32
s <- Get Word32
getWord32be -- big-endian here!
    Word32
ms <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Get Int32
getMicroSecond Word8
fsp
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Word32 -> BinLogValue
BinLogTimeStamp2 Word32
s Word32
ms)

-- A integer in @YYYYMMDDhhmmss@, for example:
-- 99991231235959 stand for @9999-12-31 23:59:59@
getBinLogField BinLogMeta
BINLOG_TYPE_DATETIME = do
    Word64
i <- Get Word64
getWord64le
    let (Word64
yyyy, Word64
i')   = Word64
i      forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
10000000000
        (Word64
mm, Word64
i'')    = Word64
i'     forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
100000000
        (Word64
dd, Word64
i''')   = Word64
i''    forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
1000000
        (Word64
h, Word64
i'''')   = Word64
i'''   forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
10000
        (Word64
m, Word64
s)       = Word64
i''''  forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
100
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> BinLogValue
BinLogDateTime (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
yyyy)
                         (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
mm)
                         (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
dd)
                         (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
h)
                         (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
m)
                         (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
s))

-- BINLOG_TYPE_DATETIME2(big endian)
--
-- 1 bit sign (used when on disk)
-- 17 bits year * 13 + month (year 0-9999, month 0-12)
-- 5 bits day (0-31)
-- 5 bits hour (0-23)
-- 6 bits minute (0-59)
-- 6 bits second (0-59)
-- (5 bytes in total)
--
-- fractional-seconds storage (size depends on meta)
--
getBinLogField (BINLOG_TYPE_DATETIME2 Word8
fsp) = do
    Word64
iPart <- Get Word64
getWord40be
    let yyyymm :: Word64
yyyymm = Word64
iPart forall a. Bits a => a -> Int -> a
`shiftR` Int
22 forall a. Bits a => a -> a -> a
.&. Word64
0x01FFFF -- 0b011111111111111111
        (Word64
yyyy, Word64
mm) = Word64
yyyymm forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
13
        yyyy' :: Word16
yyyy' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
yyyy
        mm' :: Word8
mm' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
mm
        dd :: Word8
dd = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
iPart forall a. Bits a => a -> Int -> a
`shiftR` Int
17 forall a. Bits a => a -> a -> a
.&. Word64
0x1F -- 0b00011111
        h :: Word8
h =  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
iPart forall a. Bits a => a -> Int -> a
`shiftR` Int
12 forall a. Bits a => a -> a -> a
.&. Word64
0x1F -- 0b00011111
        m :: Word8
m =  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
iPart forall a. Bits a => a -> Int -> a
`shiftR` Int
6 forall a. Bits a => a -> a -> a
.&. Word64
0x3F  -- 0b00111111
        s :: Word8
s =  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
iPart forall a. Bits a => a -> a -> a
.&. Word64
0x3F             -- 0b00111111
    Word32
ms <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Get Int32
getMicroSecond Word8
fsp
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word32
-> BinLogValue
BinLogDateTime2 Word16
yyyy' Word8
mm' Word8
dd Word8
h Word8
m Word8
s Word32
ms)

-- A integer in @hhmmss@ format(can be negative), for example:
-- 8385959 stand for @838:59:59@
getBinLogField BinLogMeta
BINLOG_TYPE_TIME = do
    Word32
i <- Get Word32
getWord24le
    let i' :: Int24
i' =  forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i :: Int24
        sign :: Word8
sign = if Int24
i' forall a. Ord a => a -> a -> Bool
>= Int24
0 then Word8
1 else Word8
0
    let (Int24
h, Int24
i'')     = Int24
i'     forall a. Integral a => a -> a -> (a, a)
`quotRem` Int24
10000
        (Int24
m, Int24
s)       = Int24
i''    forall a. Integral a => a -> a -> (a, a)
`quotRem` Int24
100
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Word16 -> Word8 -> Word8 -> BinLogValue
BinLogTime Word8
sign (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a
abs Int24
h))
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a
abs Int24
m))
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a
abs Int24
s)))

-- BINLOG_TYPE_TIME2(big endian)
--
-- 1 bit sign  (1= non-negative, 0= negative)
-- 1 bit unused (Reserved for wider hour range, e.g. for intervals)
-- 10 bit hour (0-836)
-- 6 bit minute (0-59)
-- 6 bit second (0-59)
-- (3 bytes in total)
--
-- fractional-seconds storage (size depends on meta)
--
getBinLogField (BINLOG_TYPE_TIME2 Word8
fsp) = do
    Word24
iPart <- Get Word24
getWord24be
    let sign :: Word8
sign = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word24
iPart forall a. Bits a => a -> Int -> a
`shiftR` Int
23
        iPart' :: Word24
iPart' = if Word8
sign forall a. Eq a => a -> a -> Bool
== Word8
0 then Word24
0x800000 forall a. Num a => a -> a -> a
- Word24
iPart forall a. Num a => a -> a -> a
- Word24
1 else Word24
iPart
        h :: Word16
h = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word24
iPart' forall a. Bits a => a -> Int -> a
`shiftR` Int
12) forall a. Bits a => a -> a -> a
.&. Word16
0x03FF -- 0b0000001111111111
        m :: Word8
m = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word24
iPart' forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Word8
0x3F    -- 0b00111111
        s :: Word8
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word24
iPart' forall a. Bits a => a -> a -> a
.&. Word8
0x3F               -- 0b00111111
    Int32
ms <- forall a. Num a => a -> a
abs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Get Int32
getMicroSecond Word8
fsp
    let ms' :: Int
ms' = forall a. Num a => a -> a
abs (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ms :: Int)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Word16 -> Word8 -> Word8 -> Word32 -> BinLogValue
BinLogTime2 Word8
sign Word16
h Word8
m Word8
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ms'))

getBinLogField BinLogMeta
BINLOG_TYPE_YEAR                = do
    Word8
y <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! if Word8
y forall a. Eq a => a -> a -> Bool
== Word8
0 then Word16 -> BinLogValue
BinLogYear Word16
0 else Word16 -> BinLogValue
BinLogYear (Word16
1900 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
y)

-- Decimal representation in binlog seems to be as follows:
--
-- 1st bit - sign such that set == +, unset == -
-- every 4 bytes represent 9 digits in big-endian order.
--
-- 80 00 00 05 1b 38 b0 60 00 means:
--
--   0x80 - positive
--   0x00000005 - 5
--   0x1b38b060 - 456700000
--   0x00       - 0
--
-- 54567000000 / 10^{10} = 5.4567
--
-- if there're < 9 digits at first, it will be compressed into suitable length words
-- following a simple lookup table.
--
getBinLogField (BINLOG_TYPE_NEWDECIMAL Word8
precision Word8
scale) = do
    let i :: Word8
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
precision forall a. Num a => a -> a -> a
- Word8
scale)
        (Word8
ucI, Word8
cI) = Word8
i forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
digitsPerInteger
        (Word8
ucF, Word8
cF) = Word8
scale forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
digitsPerInteger
        ucISize :: Int
ucISize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
ucI forall a. Bits a => a -> Int -> a
`shiftL` Int
2)
        ucFSize :: Int
ucFSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
ucF forall a. Bits a => a -> Int -> a
`shiftL` Int
2)
        cISize :: Int
cISize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
sizeTable ByteString -> Int -> Word8
`B.unsafeIndex` forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
cI)
        cFSize :: Int
cFSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
sizeTable ByteString -> Int -> Word8
`B.unsafeIndex` forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
cF)
        len :: Int
len = Int
ucISize forall a. Num a => a -> a -> a
+ Int
cISize forall a. Num a => a -> a -> a
+ Int
ucFSize forall a. Num a => a -> a -> a
+ Int
cFSize

    ByteString
buf <- Int -> Get ByteString
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

    let fb :: Word8
fb = ByteString
buf ByteString -> Int -> Word8
`B.unsafeIndex` Int
0
        sign :: Word8
sign = if Word8
fb forall a. Bits a => a -> a -> a
.&. Word8
0x80 forall a. Eq a => a -> a -> Bool
== Word8
0x80 then Word8
1 else Word8
0 :: Word8
        buf' :: ByteString
buf' = (Word8
fb forall a. Bits a => a -> a -> a
`xor` Word8
0x80) Word8 -> ByteString -> ByteString
`B.cons` HasCallStack => ByteString -> ByteString
B.tail ByteString
buf
        buf'' :: ByteString
buf'' = if Word8
sign forall a. Eq a => a -> a -> Bool
== Word8
1 then ByteString
buf'
                            else (Word8 -> Word8) -> ByteString -> ByteString
B.map (forall a. Bits a => a -> a -> a
xor Word8
0xFF) ByteString
buf'

        iPart :: Integer
iPart = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteString -> Word64
getCompressed Int
cISize (Int -> ByteString -> ByteString
B.unsafeTake Int
cISize ByteString
buf'')) forall a. Num a => a -> a -> a
* (Integer
blockSize forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
ucI)
              forall a. Num a => a -> a -> a
+ Word8 -> ByteString -> Integer
getUncompressed Word8
ucI (Int -> ByteString -> ByteString
B.unsafeDrop Int
cISize ByteString
buf'')

    let buf''' :: ByteString
buf''' = Int -> ByteString -> ByteString
B.unsafeDrop (Int
ucISize forall a. Num a => a -> a -> a
+ Int
cISize) ByteString
buf''

        fPart :: Integer
fPart = Word8 -> ByteString -> Integer
getUncompressed Word8
ucF (Int -> ByteString -> ByteString
B.unsafeTake Int
ucFSize ByteString
buf''') forall a. Num a => a -> a -> a
* (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
cF)
              forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteString -> Word64
getCompressed Int
cFSize (Int -> ByteString -> ByteString
B.unsafeDrop Int
ucFSize ByteString
buf'''))

    let sci :: Scientific
sci = Integer -> Int -> Scientific
scientific (Integer
iPart forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
scale forall a. Num a => a -> a -> a
+ Integer
fPart) (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
scale)
        sci' :: Scientific
sci' = if Word8
sign forall a. Eq a => a -> a -> Bool
== Word8
0 then forall a. Num a => a -> a
negate Scientific
sci else Scientific
sci
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> BinLogValue
BinLogNewDecimal Scientific
sci')
  where
    digitsPerInteger :: Word8
digitsPerInteger = Word8
9
    blockSize :: Integer
blockSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int32
10 :: Int32) forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
9 :: Int)
    sizeTable :: ByteString
sizeTable = [Word8] -> ByteString
B.pack [Word8
0, Word8
1, Word8
1, Word8
2, Word8
2, Word8
3, Word8
3, Word8
4, Word8
4, Word8
4]

    getCompressed :: Int -> ByteString -> Word64
    getCompressed :: Int -> ByteString -> Word64
getCompressed Int
0 ByteString
_  = Word64
0
    getCompressed Int
x ByteString
bs = let fb :: Word8
fb = ByteString
bs ByteString -> Int -> Word8
`B.unsafeIndex` Int
0
                             x' :: Int
x' = Int
x forall a. Num a => a -> a -> a
- Int
1
                         in forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
fb forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 forall a. Num a => a -> a -> a
* Int
x') forall a. Bits a => a -> a -> a
.|. Int -> ByteString -> Word64
getCompressed Int
x' (Int -> ByteString -> ByteString
B.unsafeDrop Int
1 ByteString
bs)

    getUncompressed :: Word8 -> ByteString -> Integer
    getUncompressed :: Word8 -> ByteString -> Integer
getUncompressed Word8
0 ByteString
_ = Integer
0
    getUncompressed Word8
x ByteString
bs = let v :: Word64
v = Int -> ByteString -> Word64
getCompressed Int
4 (Int -> ByteString -> ByteString
B.unsafeTake Int
4 ByteString
bs)
                               x' :: Word8
x' = Word8
x forall a. Num a => a -> a -> a
- Word8
1
                           in forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v forall a. Num a => a -> a -> a
* (Integer
blockSize forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
x') forall a. Num a => a -> a -> a
+ Word8 -> ByteString -> Integer
getUncompressed Word8
x' (Int -> ByteString -> ByteString
B.unsafeDrop Int
4 ByteString
bs)


getBinLogField (BINLOG_TYPE_ENUM Word8
size) =
    if  | Word8
size forall a. Eq a => a -> a -> Bool
== Word8
1 -> Word16 -> BinLogValue
BinLogEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        | Word8
size forall a. Eq a => a -> a -> Bool
== Word8
2 -> Word16 -> BinLogValue
BinLogEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
        | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.BinLogProtocol.BinLogValue: wrong \
                              \BINLOG_TYPE_ENUM size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
size


getBinLogField (BINLOG_TYPE_SET Word16
_ Word8
bytes) = Word64 -> BinLogValue
BinLogSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Get Word64
getBits' Word8
bytes
getBinLogField (BINLOG_TYPE_BLOB Word8
lensize) = do
    Int
len <- if  | Word8
lensize forall a. Eq a => a -> a -> Bool
== Word8
1 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
               | Word8
lensize forall a. Eq a => a -> a -> Bool
== Word8
2 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
               | Word8
lensize forall a. Eq a => a -> a -> Bool
== Word8
3 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord24le
               | Word8
lensize forall a. Eq a => a -> a -> Bool
== Word8
4 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
               | Bool
otherwise    -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.BinLogProtocol.BinLogValue: \
                                        \wrong BINLOG_TYPE_BLOB length size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
lensize
    ByteString -> BinLogValue
BinLogBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
len

getBinLogField (BINLOG_TYPE_STRING Word16
size) = do
    Int
len <- if | Word16
size forall a. Ord a => a -> a -> Bool
< Word16
256 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
              | Bool
otherwise  -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    ByteString -> BinLogValue
BinLogBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
len

getBinLogField (BINLOG_TYPE_GEOMETRY Word8
lensize) = do
    Int
len <- if | Word8
lensize forall a. Eq a => a -> a -> Bool
== Word8
1 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
              | Word8
lensize forall a. Eq a => a -> a -> Bool
== Word8
2 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
              | Word8
lensize forall a. Eq a => a -> a -> Bool
== Word8
3 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord24le
              | Word8
lensize forall a. Eq a => a -> a -> Bool
== Word8
4 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
              | Bool
otherwise    -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$  [Char]
"Database.MySQL.BinLogProtocol.BinLogValue: \
                                        \wrong BINLOG_TYPE_GEOMETRY length size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
lensize
    ByteString -> BinLogValue
BinLogGeometry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
len

getMicroSecond :: Word8 -> Get Int32
getMicroSecond :: Word8 -> Get Int32
getMicroSecond Word8
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0
getMicroSecond Word8
1 = (forall a. Num a => a -> a -> a
* Int32
100000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
getMicroSecond Word8
2 = (forall a. Num a => a -> a -> a
* Int32
10000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
getMicroSecond Word8
3 = (forall a. Num a => a -> a -> a
* Int32
1000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be
getMicroSecond Word8
4 = (forall a. Num a => a -> a -> a
* Int32
100) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be
getMicroSecond Word8
5 = (forall a. Num a => a -> a -> a
* Int32
10) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int24
getInt24be
getMicroSecond Word8
6 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int24
getInt24be
getMicroSecond Word8
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0

getBits' :: Word8 -> Get Word64
getBits' :: Word8 -> Get Word64
getBits' Word8
bytes = if Word8
bytes forall a. Ord a => a -> a -> Bool
<= Word8
8
    then Int -> Get Word64
getBits (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
bytes)
    else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$  [Char]
"Database.MySQL.BinLogProtocol.BinLogValue: \
                 \wrong bit length size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
bytes

--------------------------------------------------------------------------------
-- | BinLog row decoder
--
getBinLogRow :: [BinLogMeta] -> BitMap -> Get [BinLogValue]
getBinLogRow :: [BinLogMeta] -> BitMap -> Get [BinLogValue]
getBinLogRow [BinLogMeta]
metas BitMap
pmap = do
    let plen :: Int
plen = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (\Int
acc Word8
word8 -> Int
acc forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int
popCount Word8
word8) Int
0 (BitMap -> ByteString
fromBitMap BitMap
pmap)
        maplen :: Int
maplen = (Int
plen forall a. Num a => a -> a -> a
+ Int
7) forall a. Bits a => a -> Int -> a
`shiftR` Int
3
    ByteString
nullmap <- Int -> Get ByteString
getByteString Int
maplen
    [BinLogMeta] -> BitMap -> Int -> BitMap -> Int -> Get [BinLogValue]
go [BinLogMeta]
metas (ByteString -> BitMap
BitMap ByteString
nullmap) Int
0 BitMap
pmap Int
0
  where
    go :: [BinLogMeta] -> BitMap -> Int -> BitMap -> Int -> Get [BinLogValue]
    go :: [BinLogMeta] -> BitMap -> Int -> BitMap -> Int -> Get [BinLogValue]
go []     BitMap
_       Int
_       BitMap
_     Int
_    = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go (BinLogMeta
f:[BinLogMeta]
fs) BitMap
nullmap Int
nullpos BitMap
pmap' Int
ppos = do
        let ppos' :: Int
ppos' = Int
ppos forall a. Num a => a -> a -> a
+ Int
1
        if BitMap -> Int -> Bool
isColumnSet BitMap
pmap' Int
ppos
        then do
            BinLogValue
r <- if BitMap -> Int -> Bool
isColumnSet BitMap
nullmap Int
nullpos
                    then forall (m :: * -> *) a. Monad m => a -> m a
return BinLogValue
BinLogNull
                    else BinLogMeta -> Get BinLogValue
getBinLogField BinLogMeta
f
            let nullpos' :: Int
nullpos' = Int
nullpos forall a. Num a => a -> a -> a
+ Int
1
            [BinLogValue]
rest <- Int
nullpos' seq :: forall a b. a -> b -> b
`seq` Int
ppos' seq :: forall a b. a -> b -> b
`seq` [BinLogMeta] -> BitMap -> Int -> BitMap -> Int -> Get [BinLogValue]
go [BinLogMeta]
fs BitMap
nullmap Int
nullpos' BitMap
pmap' Int
ppos'
            forall (m :: * -> *) a. Monad m => a -> m a
return ([BinLogValue]
rest seq :: forall a b. a -> b -> b
`seq` (BinLogValue
r forall a. a -> [a] -> [a]
: [BinLogValue]
rest))
        else Int
ppos' seq :: forall a b. a -> b -> b
`seq` [BinLogMeta] -> BitMap -> Int -> BitMap -> Int -> Get [BinLogValue]
go [BinLogMeta]
fs BitMap
nullmap Int
nullpos BitMap
pmap' Int
ppos'