-- Copyright (c) 2014-present, EMQX, Inc.
-- All rights reserved.
--
-- This source code is distributed under the terms of a MIT license,
-- found in the LICENSE file.

{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiParamTypeClasses    #-}
{-# LANGUAGE OverloadedStrings        #-}

-- | Tools to serialize data sent server. This module is for internal use only.

module Database.ClickHouseDriver.IO.BufferedWriter
  ( writeBinaryStr,
    writeBinaryFixedLengthStr,
    writeVarUInt,
    c_write_varint,
    writeBinaryInt8,
    writeBinaryInt16,
    writeBinaryInt32,
    writeBinaryInt64,
    writeBinaryUInt8,
    writeBinaryUInt16,
    writeBinaryUInt32,
    writeBinaryUInt64,
    writeBinaryUInt128,
    writeIn,
    transform,
    Writer,
    MonoidMap,
  )
where

import Control.Monad.IO.Class ( MonadIO(liftIO) )
import           Control.Monad.Writer         (WriterT, tell)
import qualified Data.Binary                  as Binary
import           Data.ByteString              (ByteString)
import qualified Data.ByteString              as BS
import Data.ByteString.Builder
    ( Builder, toLazyByteString, byteString )
import qualified Data.ByteString.Lazy         as L
import           Data.ByteString.Lazy.Builder (lazyByteString)
import Data.ByteString.Unsafe
    ( unsafePackCString, unsafePackCStringLen )
import           Data.DoubleWord              (Word128 (..))
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Word ( Word8, Word16, Word32, Word64 )
import Foreign.C ( CString )

-- Monoid Homomorphism.
class (Monoid w, Monoid m)=>MonoidMap w m where
  transform :: w->m

instance MonoidMap ByteString L.ByteString where
  transform :: ByteString -> ByteString
transform = ByteString -> ByteString
L.fromStrict

instance MonoidMap L.ByteString ByteString where
  transform :: ByteString -> ByteString
transform = ByteString -> ByteString
L.toStrict

instance MonoidMap ByteString Builder where
  transform :: ByteString -> Builder
transform = ByteString -> Builder
byteString

instance MonoidMap L.ByteString Builder where
  transform :: ByteString -> Builder
transform = ByteString -> Builder
lazyByteString

instance MonoidMap Builder L.ByteString where
  transform :: Builder -> ByteString
transform = Builder -> ByteString
toLazyByteString

instance MonoidMap Builder ByteString where
  transform :: Builder -> ByteString
transform = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString

instance (Monoid w)=>MonoidMap w w where
  transform :: w -> w
transform = w -> w
forall a. a -> a
id

-- | The writer monad writes bytestring builders and combine them as a monoid. 
type Writer w = WriterT w IO ()

writeBinaryFixedLengthStr :: (MonoidMap ByteString w)=>Word->ByteString->Writer w
writeBinaryFixedLengthStr :: Word -> ByteString -> Writer w
writeBinaryFixedLengthStr Word
len ByteString
str = do
  let l :: Word
l = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
str
  if Word
len Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
l
    then [Char] -> Writer w
forall a. HasCallStack => [Char] -> a
error [Char]
"Error: the length of the given bytestring does not equal to the given length"
    else do
      ByteString -> Writer w
forall m w. MonoidMap m w => m -> Writer w
writeIn ByteString
str

writeBinaryStr :: (MonoidMap ByteString w)=>ByteString->Writer w
writeBinaryStr :: ByteString -> Writer w
writeBinaryStr ByteString
str = do
  let l :: Int
l = ByteString -> Int
BS.length ByteString
str
  Word -> Writer w
forall w. MonoidMap ByteString w => Word -> Writer w
writeVarUInt (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
  ByteString -> Writer w
forall m w. MonoidMap m w => m -> Writer w
writeIn ByteString
str

writeVarUInt ::(MonoidMap ByteString w)=>Word->Writer w
writeVarUInt :: Word -> Writer w
writeVarUInt Word
n = do
   ByteString
varuint <- IO ByteString -> WriterT w IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> WriterT w IO ByteString)
-> IO ByteString -> WriterT w IO ByteString
forall a b. (a -> b) -> a -> b
$ Word -> IO ByteString
leb128 Word
n
   ByteString -> Writer w
forall m w. MonoidMap m w => m -> Writer w
writeIn ByteString
varuint 
   where
      leb128 :: Word->IO ByteString
      leb128 :: Word -> IO ByteString
leb128 Word
0 = do
        CString
ostr' <- Word -> IO CString
c_write_varint Word
0
        CStringLen -> IO ByteString
unsafePackCStringLen (CString
ostr', Int
1)
      leb128 Word
n = do
        CString
ostr' <- Word -> IO CString
c_write_varint Word
n
        CString -> IO ByteString
unsafePackCString CString
ostr'

writeBinaryUInt8 :: (MonoidMap L.ByteString w)=>Word8->Writer w
writeBinaryUInt8 :: Word8 -> Writer w
writeBinaryUInt8 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Word8 -> w) -> Word8 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Word8 -> ByteString) -> Word8 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Word8 -> ByteString) -> Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode

writeBinaryInt8 :: (MonoidMap L.ByteString w)=>Int8->Writer w
writeBinaryInt8 :: Int8 -> Writer w
writeBinaryInt8 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Int8 -> w) -> Int8 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Int8 -> ByteString) -> Int8 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Int8 -> ByteString) -> Int8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode

writeBinaryInt16 :: (MonoidMap L.ByteString w)=>Int16->Writer w
writeBinaryInt16 :: Int16 -> Writer w
writeBinaryInt16 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Int16 -> w) -> Int16 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Int16 -> ByteString) -> Int16 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Int16 -> ByteString) -> Int16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode

writeBinaryInt32 :: (MonoidMap L.ByteString w)=>Int32->Writer w
writeBinaryInt32 :: Int32 -> Writer w
writeBinaryInt32 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Int32 -> w) -> Int32 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Int32 -> ByteString) -> Int32 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Int32 -> ByteString) -> Int32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode

writeBinaryInt64 :: (MonoidMap L.ByteString w)=>Int64->Writer w
writeBinaryInt64 :: Int64 -> Writer w
writeBinaryInt64 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Int64 -> w) -> Int64 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Int64 -> ByteString) -> Int64 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Int64 -> ByteString) -> Int64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode

writeBinaryUInt16 :: (MonoidMap L.ByteString w)=>Word16->Writer w
writeBinaryUInt16 :: Word16 -> Writer w
writeBinaryUInt16 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Word16 -> w) -> Word16 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Word16 -> ByteString) -> Word16 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Word16 -> ByteString) -> Word16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode

writeBinaryUInt32 :: (MonoidMap L.ByteString w)=>Word32->Writer w
writeBinaryUInt32 :: Word32 -> Writer w
writeBinaryUInt32 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Word32 -> w) -> Word32 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Word32 -> ByteString) -> Word32 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Word32 -> ByteString) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode

writeBinaryUInt64 :: (MonoidMap L.ByteString w)=>Word64->Writer w
writeBinaryUInt64 :: Word64 -> Writer w
writeBinaryUInt64 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Word64 -> w) -> Word64 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Word64 -> ByteString) -> Word64 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Word64 -> ByteString) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode

writeBinaryUInt128 :: (MonoidMap L.ByteString w)=>Word128->Writer w
writeBinaryUInt128 :: Word128 -> Writer w
writeBinaryUInt128 (Word128 Word64
hi Word64
lo) = do
  Word64 -> Writer w
forall w. MonoidMap ByteString w => Word64 -> Writer w
writeBinaryUInt64 Word64
hi
  Word64 -> Writer w
forall w. MonoidMap ByteString w => Word64 -> Writer w
writeBinaryUInt64 Word64
lo

writeIn :: (MonoidMap m w)=>m->Writer w
writeIn :: m -> Writer w
writeIn = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (m -> w) -> m -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> w
forall w m. MonoidMap w m => w -> m
transform

foreign import ccall unsafe "varuint.h write_varint" c_write_varint :: Word -> IO CString