{-# OPTIONS_GHC -funbox-strict-fields #-}
module Database.MySQL.Protocol.Packet where
import Control.Applicative
import Control.Exception (Exception (..), throwIO)
import Data.Binary.Parser
import Data.Binary.Put
import Data.Binary (Binary(..), encode)
import Data.Bits
import qualified Data.ByteString as B
import Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as L
import Data.Int.Int24
import Data.Int
import Data.Word
import Data.Typeable
import Data.Word.Word24
data Packet = Packet
{ Packet -> Int64
pLen :: !Int64
, Packet -> Word8
pSeqN :: !Word8
, Packet -> ByteString
pBody :: !L.ByteString
} deriving (Int -> Packet -> ShowS
[Packet] -> ShowS
Packet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Packet] -> ShowS
$cshowList :: [Packet] -> ShowS
show :: Packet -> String
$cshow :: Packet -> String
showsPrec :: Int -> Packet -> ShowS
$cshowsPrec :: Int -> Packet -> ShowS
Show, Packet -> Packet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Packet -> Packet -> Bool
$c/= :: Packet -> Packet -> Bool
== :: Packet -> Packet -> Bool
$c== :: Packet -> Packet -> Bool
Eq)
putPacket :: Packet -> Put
putPacket :: Packet -> Put
putPacket (Packet Int64
len Word8
seqN ByteString
body) = do
Word32 -> Put
putWord24le (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len)
Word8 -> Put
putWord8 Word8
seqN
ByteString -> Put
putLazyByteString ByteString
body
{-# INLINE putPacket #-}
getPacket :: Get Packet
getPacket :: Get Packet
getPacket = do
Int64
len <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord24le
Word8
seqN <- Get Word8
getWord8
ByteString
body <- Int64 -> Get ByteString
getLazyByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Word8 -> ByteString -> Packet
Packet Int64
len Word8
seqN ByteString
body)
{-# INLINE getPacket #-}
instance Binary Packet where
put :: Packet -> Put
put = Packet -> Put
putPacket
{-# INLINE put #-}
get :: Get Packet
get = Get Packet
getPacket
{-# INLINE get #-}
isERR :: Packet -> Bool
isERR :: Packet -> Bool
isERR Packet
p = HasCallStack => ByteString -> Int64 -> Word8
L.index (Packet -> ByteString
pBody Packet
p) Int64
0 forall a. Eq a => a -> a -> Bool
== Word8
0xFF
{-# INLINE isERR #-}
isOK :: Packet -> Bool
isOK :: Packet -> Bool
isOK Packet
p = HasCallStack => ByteString -> Int64 -> Word8
L.index (Packet -> ByteString
pBody Packet
p) Int64
0 forall a. Eq a => a -> a -> Bool
== Word8
0x00
{-# INLINE isOK #-}
isEOF :: Packet -> Bool
isEOF :: Packet -> Bool
isEOF Packet
p = HasCallStack => ByteString -> Int64 -> Word8
L.index (Packet -> ByteString
pBody Packet
p) Int64
0 forall a. Eq a => a -> a -> Bool
== Word8
0xFE
{-# INLINE isEOF #-}
isThereMore :: OK -> Bool
isThereMore :: OK -> Bool
isThereMore OK
p = OK -> Word16
okStatus OK
p forall a. Bits a => a -> a -> a
.&. Word16
0x08 forall a. Eq a => a -> a -> Bool
/= Word16
0
{-# INLINE isThereMore #-}
decodeFromPacket :: Binary a => Packet -> IO a
decodeFromPacket :: forall a. Binary a => Packet -> IO a
decodeFromPacket = forall a. Get a -> Packet -> IO a
getFromPacket forall t. Binary t => Get t
get
{-# INLINE decodeFromPacket #-}
getFromPacket :: Get a -> Packet -> IO a
getFromPacket :: forall a. Get a -> Packet -> IO a
getFromPacket Get a
g (Packet Int64
_ Word8
_ ByteString
body) = case forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
parseDetailLazy Get a
g ByteString
body of
Left (ByteString
buf, Int64
offset, String
errmsg) -> forall e a. Exception e => e -> IO a
throwIO (ByteString -> Int64 -> String -> DecodePacketException
DecodePacketFailed ByteString
buf Int64
offset String
errmsg)
Right (ByteString
_, Int64
_, a
r ) -> forall (m :: * -> *) a. Monad m => a -> m a
return a
r
{-# INLINE getFromPacket #-}
data DecodePacketException = DecodePacketFailed ByteString ByteOffset String
deriving (Typeable, Int -> DecodePacketException -> ShowS
[DecodePacketException] -> ShowS
DecodePacketException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodePacketException] -> ShowS
$cshowList :: [DecodePacketException] -> ShowS
show :: DecodePacketException -> String
$cshow :: DecodePacketException -> String
showsPrec :: Int -> DecodePacketException -> ShowS
$cshowsPrec :: Int -> DecodePacketException -> ShowS
Show)
instance Exception DecodePacketException
encodeToPacket :: Binary a => Word8 -> a -> Packet
encodeToPacket :: forall a. Binary a => Word8 -> a -> Packet
encodeToPacket Word8
seqN a
payload =
let s :: ByteString
s = forall a. Binary a => a -> ByteString
encode a
payload
l :: Int64
l = ByteString -> Int64
L.length ByteString
s
in Int64 -> Word8 -> ByteString -> Packet
Packet (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
l) Word8
seqN ByteString
s
{-# INLINE encodeToPacket #-}
putToPacket :: Word8 -> Put -> Packet
putToPacket :: Word8 -> Put -> Packet
putToPacket Word8
seqN Put
payload =
let s :: ByteString
s = Put -> ByteString
runPut Put
payload
l :: Int64
l = ByteString -> Int64
L.length ByteString
s
in Int64 -> Word8 -> ByteString -> Packet
Packet (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
l) Word8
seqN ByteString
s
{-# INLINE putToPacket #-}
data OK = OK
{ OK -> Int
okAffectedRows :: !Int
, OK -> Int
okLastInsertID :: !Int
, OK -> Word16
okStatus :: !Word16
, OK -> Word16
okWarningCnt :: !Word16
} deriving (Int -> OK -> ShowS
[OK] -> ShowS
OK -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OK] -> ShowS
$cshowList :: [OK] -> ShowS
show :: OK -> String
$cshow :: OK -> String
showsPrec :: Int -> OK -> ShowS
$cshowsPrec :: Int -> OK -> ShowS
Show, OK -> OK -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OK -> OK -> Bool
$c/= :: OK -> OK -> Bool
== :: OK -> OK -> Bool
$c== :: OK -> OK -> Bool
Eq)
getOK :: Get OK
getOK :: Get OK
getOK = Int -> Int -> Word16 -> Word16 -> OK
OK forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> Get ()
skipN Int
1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getLenEncInt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getLenEncInt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le
{-# INLINE getOK #-}
putOK :: OK -> Put
putOK :: OK -> Put
putOK (OK Int
row Int
lid Word16
stat Word16
wcnt) = do
Word8 -> Put
putWord8 Word8
0x00
Int -> Put
putLenEncInt Int
row
Int -> Put
putLenEncInt Int
lid
Word16 -> Put
putWord16le Word16
stat
Word16 -> Put
putWord16le Word16
wcnt
{-# INLINE putOK #-}
instance Binary OK where
get :: Get OK
get = Get OK
getOK
{-# INLINE get #-}
put :: OK -> Put
put = OK -> Put
putOK
{-# INLINE put #-}
data ERR = ERR
{ ERR -> Word16
errCode :: !Word16
, ERR -> ByteString
errState :: !ByteString
, ERR -> ByteString
errMsg :: !ByteString
} deriving (Int -> ERR -> ShowS
[ERR] -> ShowS
ERR -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ERR] -> ShowS
$cshowList :: [ERR] -> ShowS
show :: ERR -> String
$cshow :: ERR -> String
showsPrec :: Int -> ERR -> ShowS
$cshowsPrec :: Int -> ERR -> ShowS
Show, ERR -> ERR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ERR -> ERR -> Bool
$c/= :: ERR -> ERR -> Bool
== :: ERR -> ERR -> Bool
$c== :: ERR -> ERR -> Bool
Eq)
getERR :: Get ERR
getERR :: Get ERR
getERR = Word16 -> ByteString -> ByteString -> ERR
ERR forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> Get ()
skipN Int
1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Get ()
skipN Int
1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
5
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getRemainingByteString
{-# INLINE getERR #-}
putERR :: ERR -> Put
putERR :: ERR -> Put
putERR (ERR Word16
code ByteString
stat ByteString
msg) = do
Word8 -> Put
putWord8 Word8
0xFF
Word16 -> Put
putWord16le Word16
code
Word8 -> Put
putWord8 Word8
35
ByteString -> Put
putByteString ByteString
stat
ByteString -> Put
putByteString ByteString
msg
{-# INLINE putERR #-}
instance Binary ERR where
get :: Get ERR
get = Get ERR
getERR
{-# INLINE get #-}
put :: ERR -> Put
put = ERR -> Put
putERR
{-# INLINE put #-}
data EOF = EOF
{ EOF -> Word16
eofWarningCnt :: !Word16
, EOF -> Word16
eofStatus :: !Word16
} deriving (Int -> EOF -> ShowS
[EOF] -> ShowS
EOF -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EOF] -> ShowS
$cshowList :: [EOF] -> ShowS
show :: EOF -> String
$cshow :: EOF -> String
showsPrec :: Int -> EOF -> ShowS
$cshowsPrec :: Int -> EOF -> ShowS
Show, EOF -> EOF -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EOF -> EOF -> Bool
$c/= :: EOF -> EOF -> Bool
== :: EOF -> EOF -> Bool
$c== :: EOF -> EOF -> Bool
Eq)
getEOF :: Get EOF
getEOF :: Get EOF
getEOF = Word16 -> Word16 -> EOF
EOF forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> Get ()
skipN Int
1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le
{-# INLINE getEOF #-}
putEOF :: EOF -> Put
putEOF :: EOF -> Put
putEOF (EOF Word16
wcnt Word16
stat) = do
Word8 -> Put
putWord8 Word8
0xFE
Word16 -> Put
putWord16le Word16
wcnt
Word16 -> Put
putWord16le Word16
stat
{-# INLINE putEOF #-}
instance Binary EOF where
get :: Get EOF
get = Get EOF
getEOF
{-# INLINE get #-}
put :: EOF -> Put
put = EOF -> Put
putEOF
{-# INLINE put #-}
getByteStringNul :: Get ByteString
getByteStringNul :: Get ByteString
getByteStringNul = ByteString -> ByteString
L.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLazyByteStringNul
{-# INLINE getByteStringNul #-}
getRemainingByteString :: Get ByteString
getRemainingByteString :: Get ByteString
getRemainingByteString = ByteString -> ByteString
L.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
{-# INLINE getRemainingByteString #-}
putLenEncBytes :: ByteString -> Put
putLenEncBytes :: ByteString -> Put
putLenEncBytes ByteString
c = do
Int -> Put
putLenEncInt (ByteString -> Int
B.length ByteString
c)
ByteString -> Put
putByteString ByteString
c
{-# INLINE putLenEncBytes #-}
getLenEncBytes :: Get ByteString
getLenEncBytes :: Get ByteString
getLenEncBytes = Get Int
getLenEncInt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getByteString
{-# INLINE getLenEncBytes #-}
getLenEncInt:: Get Int
getLenEncInt :: Get Int
getLenEncInt = Get Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {a}. (Integral a, Num a, Show a) => a -> Get a
word2Len
where
word2Len :: a -> Get a
word2Len a
l
| a
l forall a. Ord a => a -> a -> Bool
< a
0xFB = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
l)
| a
l forall a. Eq a => a -> a -> Bool
== a
0xFC = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
| a
l forall a. Eq a => a -> a -> Bool
== a
0xFD = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord24le
| a
l forall a. Eq a => a -> a -> Bool
== a
0xFE = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid length val " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
l
{-# INLINE getLenEncInt #-}
putLenEncInt:: Int -> Put
putLenEncInt :: Int -> Put
putLenEncInt Int
x
| Int
x forall a. Ord a => a -> a -> Bool
< Int
251 = Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
| Int
x forall a. Ord a => a -> a -> Bool
< Int
65536 = Word8 -> Put
putWord8 Word8
0xFC forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16le (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
| Int
x forall a. Ord a => a -> a -> Bool
< Int
16777216 = Word8 -> Put
putWord8 Word8
0xFD forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord24le (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
| Bool
otherwise = Word8 -> Put
putWord8 Word8
0xFE forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
{-# INLINE putLenEncInt #-}
putWord24le :: Word32 -> Put
putWord24le :: Word32 -> Put
putWord24le Word32
v = do
Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v
Word8 -> Put
putWord8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
v forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
{-# INLINE putWord24le #-}
getWord24le :: Get Word32
getWord24le :: Get Word32
getWord24le = do
Word32
a <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
Word32
b <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word32
a forall a. Bits a => a -> a -> a
.|. (Word32
b forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
{-# INLINE getWord24le #-}
putWord48le :: Word64 -> Put
putWord48le :: Word64 -> Put
putWord48le Word64
v = do
Word32 -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v
Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
v forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
{-# INLINE putWord48le #-}
getWord48le :: Get Word64
getWord48le :: Get Word64
getWord48le = do
Word64
a <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
Word64
b <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word64
a forall a. Bits a => a -> a -> a
.|. (Word64
b forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
{-# INLINE getWord48le #-}
getWord24be :: Get Word24
getWord24be :: Get Word24
getWord24be = do
Word24
a <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
Word24
b <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word24
b forall a. Bits a => a -> a -> a
.|. (Word24
a forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
{-# INLINE getWord24be #-}
getInt24be :: Get Int24
getInt24be :: Get Int24
getInt24be = do
Word24
a <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
Word24
b <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Word24
b forall a. Bits a => a -> a -> a
.|. (Word24
a forall a. Bits a => a -> Int -> a
`shiftL` Int
8) :: Word24)
{-# INLINE getInt24be #-}
getWord40be, getWord48be, getWord56be :: Get Word64
getWord40be :: Get Word64
getWord40be = do
Word64
a <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Word64
b <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Word64
a forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. Word64
b
getWord48be :: Get Word64
getWord48be = do
Word64
a <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Word64
b <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Word64
a forall a. Bits a => a -> Int -> a
`shiftL` Int
16) forall a. Bits a => a -> a -> a
.|. Word64
b
getWord56be :: Get Word64
getWord56be = do
Word64
a <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Word64
b <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word24
getWord24be
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Word64
a forall a. Bits a => a -> Int -> a
`shiftL` Int
24) forall a. Bits a => a -> a -> a
.|. Word64
b
{-# INLINE getWord40be #-}
{-# INLINE getWord48be #-}
{-# INLINE getWord56be #-}