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

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

This module provide column meta decoder for binlog protocol.

There're certain type won't appear in binlog event, and some types are compressed into 'mySQLTypeString'
, please take python version as a reference:  <https://github.com/noplay/python-mysql-replication>

You will not directly meet following 'FieldType' namely:

    * mySQLTypeDecimal
    * mySQLTypeNewdate
    * mySQLTypeEnum
    * mySQLTypeSet
    * mySQLTypeTinyBlob
    * mySQLTypeMediumBlOb
    * mySQLTypeLongBlob

-}

module Database.MySQL.BinLogProtocol.BinLogMeta where

import           Data.Binary.Get
import           Data.Bits
import           Data.Word
import           Database.MySQL.Protocol.ColumnDef

-- | An intermedia date type for decoding row-based event's values.
--
data BinLogMeta
    = BINLOG_TYPE_TINY
    | BINLOG_TYPE_SHORT
    | BINLOG_TYPE_INT24
    | BINLOG_TYPE_LONG
    | BINLOG_TYPE_LONGLONG
    | BINLOG_TYPE_FLOAT       !Word8         -- ^ size
    | BINLOG_TYPE_DOUBLE      !Word8         -- ^ size
    | BINLOG_TYPE_BIT         !Word16 !Word8 -- ^ bits, bytes
    | BINLOG_TYPE_TIMESTAMP
    | BINLOG_TYPE_DATETIME
    | BINLOG_TYPE_DATE
    | BINLOG_TYPE_TIME
    | BINLOG_TYPE_TIMESTAMP2  !Word8         -- ^ fsp
    | BINLOG_TYPE_DATETIME2   !Word8         -- ^ fsp
    | BINLOG_TYPE_TIME2       !Word8         -- ^ fsp
    | BINLOG_TYPE_YEAR
    | BINLOG_TYPE_NEWDECIMAL  !Word8 !Word8  -- ^ precision, scale
    | BINLOG_TYPE_ENUM        !Word8         -- ^ 1 or 2('Word8' or 'Word16'), enum index size
    | BINLOG_TYPE_SET         !Word16 !Word8 -- ^ bitmap bits, bytes
    | BINLOG_TYPE_BLOB        !Word8         -- ^ length size
    | BINLOG_TYPE_STRING      !Word16        -- ^ meta length(if < 256, then length is 8bit,
                                             -- if > 256 then length is 16bit)
    | BINLOG_TYPE_GEOMETRY    !Word8         -- ^ length size
  deriving (Int -> BinLogMeta -> ShowS
[BinLogMeta] -> ShowS
BinLogMeta -> [Char]
(Int -> BinLogMeta -> ShowS)
-> (BinLogMeta -> [Char])
-> ([BinLogMeta] -> ShowS)
-> Show BinLogMeta
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinLogMeta -> ShowS
showsPrec :: Int -> BinLogMeta -> ShowS
$cshow :: BinLogMeta -> [Char]
show :: BinLogMeta -> [Char]
$cshowList :: [BinLogMeta] -> ShowS
showList :: [BinLogMeta] -> ShowS
Show, BinLogMeta -> BinLogMeta -> Bool
(BinLogMeta -> BinLogMeta -> Bool)
-> (BinLogMeta -> BinLogMeta -> Bool) -> Eq BinLogMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinLogMeta -> BinLogMeta -> Bool
== :: BinLogMeta -> BinLogMeta -> Bool
$c/= :: BinLogMeta -> BinLogMeta -> Bool
/= :: BinLogMeta -> BinLogMeta -> Bool
Eq)

getBinLogMeta :: FieldType -> Get BinLogMeta
getBinLogMeta :: FieldType -> Get BinLogMeta
getBinLogMeta FieldType
t
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTiny       = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_TINY
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeShort      = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_SHORT
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeInt24      = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_INT24
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLong       = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_LONG
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeLongLong   = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_LONGLONG
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeFloat      = Word8 -> BinLogMeta
BINLOG_TYPE_FLOAT (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDouble     = Word8 -> BinLogMeta
BINLOG_TYPE_DOUBLE (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeBit        = do
        Word8
byte0 <- Get Word8
getWord8
        Word8
byte1 <- Get Word8
getWord8
        let nbits :: Word16
nbits = (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|.  Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte0
            nbytes :: Word8
nbytes = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word16
nbits Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
7) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
        BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Word8 -> BinLogMeta
BINLOG_TYPE_BIT Word16
nbits Word8
nbytes)

    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp  = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_TIMESTAMP
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime   = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_DATETIME
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDate       = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_DATE
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime       = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_TIME
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTimestamp2 = Word8 -> BinLogMeta
BINLOG_TYPE_TIMESTAMP2 (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeDateTime2  = Word8 -> BinLogMeta
BINLOG_TYPE_DATETIME2 (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeTime2      = Word8 -> BinLogMeta
BINLOG_TYPE_TIME2 (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeYear       = BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinLogMeta
BINLOG_TYPE_YEAR
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeNewDecimal = Word8 -> Word8 -> BinLogMeta
BINLOG_TYPE_NEWDECIMAL (Word8 -> Word8 -> BinLogMeta)
-> Get Word8 -> Get (Word8 -> BinLogMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeVarChar    = Word16 -> BinLogMeta
BINLOG_TYPE_STRING (Word16 -> BinLogMeta) -> Get Word16 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeVarString  = Word16 -> BinLogMeta
BINLOG_TYPE_STRING (Word16 -> BinLogMeta) -> Get Word16 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le

    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeString     = do
        Word8
byte0 <- Get Word8
getWord8
        Word8
byte1 <- Get Word8
getWord8
        -- http://bugs.mysql.com/37426
        if  Word8
byte0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0
        then if (Word8
byte0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x30) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x30
             then if Word8 -> FieldType
FieldType (Word8
byte0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x30) FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeString
                  then let len :: Word16
len = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> Word8 -> Word16
forall a b. (a -> b) -> a -> b
$ (Word8
byte0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x30) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
0x30
                           len' :: Word16
len' = Word16
len Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
4 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1
                       in BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BinLogMeta -> Get BinLogMeta) -> BinLogMeta -> Get BinLogMeta
forall a b. (a -> b) -> a -> b
$! Word16 -> BinLogMeta
BINLOG_TYPE_STRING Word16
len'
                  else let len :: Word16
len = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte0 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 :: Word16
                           len' :: Word16
len' = Word16
len Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1
                       in BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BinLogMeta -> Get BinLogMeta) -> BinLogMeta -> Get BinLogMeta
forall a b. (a -> b) -> a -> b
$! Word16 -> BinLogMeta
BINLOG_TYPE_STRING Word16
len'
             else let t' :: FieldType
t' = Word8 -> FieldType
FieldType Word8
byte0
                  in if | FieldType
t' FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeSet    -> let nbits :: Word16
nbits = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
3
                                                       nbytes :: Word8
nbytes = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word16
nbits Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
7) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
8
                                                   in BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Word8 -> BinLogMeta
BINLOG_TYPE_SET Word16
nbits Word8
nbytes)
                        | FieldType
t' FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeEnum   -> BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> BinLogMeta
BINLOG_TYPE_ENUM Word8
byte1)
                        | FieldType
t' FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeString -> BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> BinLogMeta
BINLOG_TYPE_STRING (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1))
                        | Bool
otherwise             -> [Char] -> Get BinLogMeta
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get BinLogMeta) -> [Char] -> Get BinLogMeta
forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.BinLogProtocol.BinLogMeta:\
                                                           \ impossible type inside binlog string: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldType -> [Char]
forall a. Show a => a -> [Char]
show FieldType
t'
        else BinLogMeta -> Get BinLogMeta
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> BinLogMeta
BINLOG_TYPE_STRING (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1))

    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeBlob       = Word8 -> BinLogMeta
BINLOG_TYPE_BLOB (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
mySQLTypeGeometry   = Word8 -> BinLogMeta
BINLOG_TYPE_GEOMETRY (Word8 -> BinLogMeta) -> Get Word8 -> Get BinLogMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    | Bool
otherwise                = [Char] -> Get BinLogMeta
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get BinLogMeta) -> [Char] -> Get BinLogMeta
forall a b. (a -> b) -> a -> b
$ [Char]
"Database.MySQL.BinLogProtocol.BinLogMeta:\
                                        \ impossible type in binlog: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldType -> [Char]
forall a. Show a => a -> [Char]
show FieldType
t