{-# 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           Control.Applicative
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]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BinLogMeta] -> ShowS
$cshowList :: [BinLogMeta] -> ShowS
show :: BinLogMeta -> [Char]
$cshow :: BinLogMeta -> [Char]
showsPrec :: Int -> BinLogMeta -> ShowS
$cshowsPrec :: Int -> BinLogMeta -> ShowS
Show, BinLogMeta -> BinLogMeta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinLogMeta -> BinLogMeta -> Bool
$c/= :: BinLogMeta -> BinLogMeta -> Bool
== :: BinLogMeta -> BinLogMeta -> Bool
$c== :: BinLogMeta -> BinLogMeta -> Bool
Eq)

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

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

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

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

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