{-|
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           Data.Binary.Get
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]
(Int -> BinLogValue -> ShowS)
-> (BinLogValue -> [Char])
-> ([BinLogValue] -> ShowS)
-> Show BinLogValue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinLogValue -> ShowS
showsPrec :: Int -> BinLogValue -> ShowS
$cshow :: BinLogValue -> [Char]
show :: BinLogValue -> [Char]
$cshowList :: [BinLogValue] -> ShowS
showList :: [BinLogValue] -> ShowS
Show, BinLogValue -> BinLogValue -> Bool
(BinLogValue -> BinLogValue -> Bool)
-> (BinLogValue -> BinLogValue -> Bool) -> Eq BinLogValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinLogValue -> BinLogValue -> Bool
== :: BinLogValue -> BinLogValue -> Bool
$c/= :: BinLogValue -> BinLogValue -> Bool
/= :: BinLogValue -> BinLogValue -> Bool
Eq, (forall x. BinLogValue -> Rep BinLogValue x)
-> (forall x. Rep BinLogValue x -> BinLogValue)
-> Generic BinLogValue
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
$cfrom :: forall x. BinLogValue -> Rep BinLogValue x
from :: forall x. BinLogValue -> Rep BinLogValue x
$cto :: forall x. Rep BinLogValue x -> BinLogValue
to :: forall x. Rep BinLogValue x -> BinLogValue
Generic)

--------------------------------------------------------------------------------
-- | BinLog protocol decoder
--
getBinLogField :: BinLogMeta -> Get BinLogValue
getBinLogField :: BinLogMeta -> Get BinLogValue
getBinLogField BinLogMeta
BINLOG_TYPE_TINY                = Int8 -> BinLogValue
BinLogTiny     (Int8 -> BinLogValue) -> Get Int8 -> Get BinLogValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
getBinLogField BinLogMeta
BINLOG_TYPE_SHORT               = Int16 -> BinLogValue
BinLogShort    (Int16 -> BinLogValue) -> Get Int16 -> Get BinLogValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16le
getBinLogField BinLogMeta
BINLOG_TYPE_INT24               = Int24 -> BinLogValue
BinLogInt24 (Int24 -> BinLogValue)
-> (Word32 -> Int24) -> Word32 -> BinLogValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int24
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> BinLogValue) -> Get Word32 -> Get BinLogValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord24le
getBinLogField BinLogMeta
BINLOG_TYPE_LONG                = Int32 -> BinLogValue
BinLogLong     (Int32 -> BinLogValue) -> Get Int32 -> Get BinLogValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32le
getBinLogField BinLogMeta
BINLOG_TYPE_LONGLONG            = Int64 -> BinLogValue
BinLogLongLong (Int64 -> BinLogValue) -> Get Int64 -> Get BinLogValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64le
getBinLogField (BINLOG_TYPE_FLOAT  Word8
_         ) = Float -> BinLogValue
BinLogFloat (Float -> BinLogValue) -> Get Float -> Get BinLogValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloatle
getBinLogField (BINLOG_TYPE_DOUBLE Word8
_         ) = Double -> BinLogValue
BinLogDouble (Double -> BinLogValue) -> Get Double -> Get BinLogValue
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 (Word64 -> BinLogValue) -> Get Word64 -> Get BinLogValue
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 (Word32 -> BinLogValue) -> Get Word32 -> Get BinLogValue
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 Word32 -> Word32 -> (Word32, Word32)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word32
32
        (Word32
yyyy, Word32
mm) = Word32
i' Word32 -> Word32 -> (Word32, Word32)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word32
16
    BinLogValue -> Get BinLogValue
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Word8 -> Word8 -> BinLogValue
BinLogDate (Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
yyyy)
                     (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
mm)
                     (Word32 -> Word8
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 <- Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word32) -> Get Int32 -> Get Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Get Int32
getMicroSecond Word8
fsp
    BinLogValue -> Get BinLogValue
forall a. a -> Get a
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      Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
10000000000
        (Word64
mm, Word64
i'')    = Word64
i'     Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
100000000
        (Word64
dd, Word64
i''')   = Word64
i''    Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
1000000
        (Word64
h, Word64
i'''')   = Word64
i'''   Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
10000
        (Word64
m, Word64
s)       = Word64
i''''  Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
100
    BinLogValue -> Get BinLogValue
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> BinLogValue
BinLogDateTime (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
yyyy)
                         (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
mm)
                         (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
dd)
                         (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
h)
                         (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
m)
                         (Word64 -> Word8
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 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
22 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x01FFFF -- 0b011111111111111111
        (Word64
yyyy, Word64
mm) = Word64
yyyymm Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
13
        yyyy' :: Word16
yyyy' = Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
yyyy
        mm' :: Word8
mm' = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
mm
        dd :: Word8
dd = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
iPart Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
17 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x1F -- 0b00011111
        h :: Word8
h =  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
iPart Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
12 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x1F -- 0b00011111
        m :: Word8
m =  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
iPart Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x3F  -- 0b00111111
        s :: Word8
s =  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
iPart Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x3F             -- 0b00111111
    Word32
ms <- Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word32) -> Get Int32 -> Get Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Get Int32
getMicroSecond Word8
fsp
    BinLogValue -> Get BinLogValue
forall a. a -> Get a
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' =  Word32 -> Int24
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i :: Int24
        sign :: Word8
sign = if Int24
i' Int24 -> Int24 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int24
0 then Word8
1 else Word8
0
    let (Int24
h, Int24
i'')     = Int24
i'     Int24 -> Int24 -> (Int24, Int24)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int24
10000
        (Int24
m, Int24
s)       = Int24
i''    Int24 -> Int24 -> (Int24, Int24)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int24
100
    BinLogValue -> Get BinLogValue
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Word16 -> Word8 -> Word8 -> BinLogValue
BinLogTime Word8
sign (Int24 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int24 -> Int24
forall a. Num a => a -> a
abs Int24
h))
                          (Int24 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int24 -> Int24
forall a. Num a => a -> a
abs Int24
m))
                          (Int24 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int24 -> Int24
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 = Word24 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word24 -> Word8) -> Word24 -> Word8
forall a b. (a -> b) -> a -> b
$ Word24
iPart Word24 -> Int -> Word24
forall a. Bits a => a -> Int -> a
`shiftR` Int
23
        iPart' :: Word24
iPart' = if Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then Word24
0x800000 Word24 -> Word24 -> Word24
forall a. Num a => a -> a -> a
- Word24
iPart Word24 -> Word24 -> Word24
forall a. Num a => a -> a -> a
- Word24
1 else Word24
iPart
        h :: Word16
h = Word24 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word24
iPart' Word24 -> Int -> Word24
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x03FF -- 0b0000001111111111
        m :: Word8
m = Word24 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word24
iPart' Word24 -> Int -> Word24
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3F    -- 0b00111111
        s :: Word8
s = Word24 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word24
iPart' Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3F               -- 0b00111111
    Int32
ms <- Int32 -> Int32
forall a. Num a => a -> a
abs (Int32 -> Int32) -> Get Int32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Get Int32
getMicroSecond Word8
fsp
    let ms' :: Int
ms' = Int -> Int
forall a. Num a => a -> a
abs (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ms :: Int)
    BinLogValue -> Get BinLogValue
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Word16 -> Word8 -> Word8 -> Word32 -> BinLogValue
BinLogTime2 Word8
sign Word16
h Word8
m Word8
s (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ms'))

getBinLogField BinLogMeta
BINLOG_TYPE_YEAR                = do
    Word8
y <- Get Word8
getWord8
    BinLogValue -> Get BinLogValue
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BinLogValue -> Get BinLogValue) -> BinLogValue -> Get BinLogValue
forall a b. (a -> b) -> a -> b
$! if Word8
y Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then Word16 -> BinLogValue
BinLogYear Word16
0 else Word16 -> BinLogValue
BinLogYear (Word16
1900 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
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 = (Word8
precision Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
scale)
        (Word8
ucI, Word8
cI) = Word8
i Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
digitsPerInteger
        (Word8
ucF, Word8
cF) = Word8
scale Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
digitsPerInteger
        ucISize :: Int
ucISize = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
ucI Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2)
        ucFSize :: Int
ucFSize = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
ucF Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2)
        cISize :: Int
cISize = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
sizeTable ByteString -> Int -> Word8
`B.unsafeIndex` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
cI)
        cFSize :: Int
cFSize = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
sizeTable ByteString -> Int -> Word8
`B.unsafeIndex` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
cF)
        len :: Int
len = Int
ucISize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cISize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ucFSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cFSize

    ByteString
buf <- Int -> Get ByteString
getByteString Int
len

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

        iPart :: Integer
iPart = Word64 -> Integer
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'')) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
blockSize Integer -> Word8 -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
ucI)
              Integer -> Integer -> Integer
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 Int -> Int -> Int
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''') Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Word8 -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
cF)
              Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word64 -> Integer
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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Word8 -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
scale Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
fPart) (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
scale)
        sci' :: Scientific
sci' = if Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then Scientific -> Scientific
forall a. Num a => a -> a
negate Scientific
sci else Scientific
sci
    BinLogValue -> Get BinLogValue
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> BinLogValue
BinLogNewDecimal Scientific
sci')
  where
    digitsPerInteger :: Word8
digitsPerInteger = Word8
9
    blockSize :: Integer
blockSize = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Integer) -> Int32 -> Integer
forall a b. (a -> b) -> a -> b
$ (Int32
10 :: Int32) Int32 -> Int -> 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                         in Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
fb Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x') Word64 -> Word64 -> Word64
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 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1
                           in Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
blockSize Integer -> Word8 -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
x') Integer -> Integer -> Integer
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 -> Word16 -> BinLogValue
BinLogEnum (Word16 -> BinLogValue)
-> (Word8 -> Word16) -> Word8 -> BinLogValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> BinLogValue) -> Get Word8 -> Get BinLogValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        | Word8
size Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
2 -> Word16 -> BinLogValue
BinLogEnum (Word16 -> BinLogValue) -> Get Word16 -> Get BinLogValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
        | Bool
otherwise -> [Char] -> Get BinLogValue
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get BinLogValue) -> [Char] -> Get BinLogValue
forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.BinLogProtocol.BinLogValue: wrong \
                              \BINLOG_TYPE_ENUM size: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
size


getBinLogField (BINLOG_TYPE_SET Word16
_ Word8
bytes) = Word64 -> BinLogValue
BinLogSet (Word64 -> BinLogValue) -> Get Word64 -> Get BinLogValue
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
               | Word8
lensize Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
2 -> 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
               | Word8
lensize Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
3 -> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord24le
               | Word8
lensize Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
4 -> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
               | Bool
otherwise    -> [Char] -> Get Int
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get Int) -> [Char] -> Get Int
forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.BinLogProtocol.BinLogValue: \
                                        \wrong BINLOG_TYPE_BLOB length size: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
lensize
    ByteString -> BinLogValue
BinLogBytes (ByteString -> BinLogValue) -> Get ByteString -> Get BinLogValue
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 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
256 -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
              | Bool
otherwise  -> 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
    ByteString -> BinLogValue
BinLogBytes (ByteString -> BinLogValue) -> Get ByteString -> Get BinLogValue
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
              | Word8
lensize Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
2 -> 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
              | Word8
lensize Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
3 -> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord24le
              | Word8
lensize Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
4 -> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
              | Bool
otherwise    -> [Char] -> Get Int
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get Int) -> [Char] -> Get Int
forall a b. (a -> b) -> a -> b
$  [Char]
"Database.MySQL.BinLogProtocol.BinLogValue: \
                                        \wrong BINLOG_TYPE_GEOMETRY length size: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
lensize
    ByteString -> BinLogValue
BinLogGeometry (ByteString -> BinLogValue) -> Get ByteString -> Get BinLogValue
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 = Int32 -> Get Int32
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0
getMicroSecond Word8
1 = (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
100000) (Int32 -> Int32) -> (Int8 -> Int32) -> Int8 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int32) -> Get Int8 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
getMicroSecond Word8
2 = (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
10000) (Int32 -> Int32) -> (Int8 -> Int32) -> Int8 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int32) -> Get Int8 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
getMicroSecond Word8
3 = (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
1000) (Int32 -> Int32) -> (Int16 -> Int32) -> Int16 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int32) -> Get Int16 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be
getMicroSecond Word8
4 = (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
100) (Int32 -> Int32) -> (Int16 -> Int32) -> Int16 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int32) -> Get Int16 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be
getMicroSecond Word8
5 = (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
10) (Int32 -> Int32) -> (Int24 -> Int32) -> Int24 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int24 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int24 -> Int32) -> Get Int24 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int24
getInt24be
getMicroSecond Word8
6 = Int24 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int24 -> Int32) -> Get Int24 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int24
getInt24be
getMicroSecond Word8
_ = Int32 -> Get Int32
forall a. a -> Get a
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
8
    then Int -> Get Word64
getBits (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
bytes)
    else [Char] -> Get Word64
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get Word64) -> [Char] -> Get Word64
forall a b. (a -> b) -> a -> b
$  [Char]
"Database.MySQL.BinLogProtocol.BinLogValue: \
                 \wrong bit length size: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
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 = (Int -> Word8 -> Int) -> Int -> ByteString -> Int
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (\Int
acc Word8
word8 -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a. Bits a => a -> Int
popCount Word8
word8) Int
0 (BitMap -> ByteString
fromBitMap BitMap
pmap)
        maplen :: Int
maplen = (Int
plen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
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
_    = [BinLogValue] -> Get [BinLogValue]
forall a. a -> Get a
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 Int -> Int -> Int
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 BinLogValue -> Get BinLogValue
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return BinLogValue
BinLogNull
                    else BinLogMeta -> Get BinLogValue
getBinLogField BinLogMeta
f
            let nullpos' :: Int
nullpos' = Int
nullpos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            [BinLogValue]
rest <- Int
nullpos' Int -> Get [BinLogValue] -> Get [BinLogValue]
forall a b. a -> b -> b
`seq` Int
ppos' Int -> Get [BinLogValue] -> Get [BinLogValue]
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'
            [BinLogValue] -> Get [BinLogValue]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ([BinLogValue]
rest [BinLogValue] -> [BinLogValue] -> [BinLogValue]
forall a b. a -> b -> b
`seq` (BinLogValue
r BinLogValue -> [BinLogValue] -> [BinLogValue]
forall a. a -> [a] -> [a]
: [BinLogValue]
rest))
        else Int
ppos' Int -> Get [BinLogValue] -> Get [BinLogValue]
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'