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 BinLogValue
= BinLogTiny !Int8
| BinLogShort !Int16
| BinLogInt24 !Int24
| BinLogLong !Int32
| BinLogLongLong !Int64
| BinLogFloat !Float
| BinLogDouble !Double
| BinLogBit !Word64
| BinLogTimeStamp !Word32
| BinLogTimeStamp2 !Word32 !Word32
| BinLogDateTime !Word16 !Word8 !Word8 !Word8 !Word8 !Word8
| BinLogDateTime2 !Word16 !Word8 !Word8 !Word8 !Word8 !Word8 !Word32
| BinLogDate !Word16 !Word8 !Word8
| BinLogTime !Word8 !Word16 !Word8 !Word8
| BinLogTime2 !Word8 !Word16 !Word8 !Word8 !Word32
| BinLogYear !Word16
| BinLogNewDecimal !Scientific
| BinLogEnum !Word16
| BinLogSet !Word64
| BinLogBytes !ByteString
| 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)
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
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
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)
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))
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
(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
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
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
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
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)
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)))
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
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
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
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)
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
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'