-- 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 NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric     #-}

-- | Implementation of data types for internal use  Most users should
-- import "ClickHouseDriver.Core" instead.
--

module Database.ClickHouseDriver.Types
  ( ServerInfo (..),
    TCPConnection (..),
    getServerInfo,
    getClientInfo,
    getClientSetting,
    ClientInfo (..),
    ClientSetting(..),
    Context (..),
    Interface (..),
    QueryKind (..),
    getDefaultClientInfo,
    Packet (..),
    readProgress,
    readBlockStreamProfileInfo,
    QueryInfo(..),
    Progress(..),
    BlockStreamProfileInfo(..),
    storeElasped,
    storeProfile,
    storeProgress,
    defaultProfile,
    defaultProgress,
    defaultQueryInfo,
    ClickhouseType(..),
    BlockInfo(..),
    Block(..),
    CKResult(..),
    writeBlockInfo,
    ConnParams(..),
    setClientInfo,
    setClientSetting,
    setServerInfo
  )
where

import qualified Database.ClickHouseDriver.Defines      as Defines
import Database.ClickHouseDriver.IO.BufferedReader
    ( Reader, readVarInt, readBinaryUInt8 )
import Database.ClickHouseDriver.IO.BufferedWriter
    ( Writer, writeVarUInt, writeBinaryUInt8, writeBinaryInt32)
import           Data.ByteString                    (ByteString)
import Data.ByteString.Builder ( Builder )
import Data.Default.Class ( Default(..) )
import Data.Int ( Int8, Int16, Int32, Int64 )
import           Data.Vector                        (Vector)
import Data.Word ( Word8, Word16, Word32, Word64 )
import GHC.Generics ( Generic )
import           Network.Socket                     (SockAddr, Socket)

-----------------------------------------------------------

-----------------------------------------------------------
data BlockInfo = Info
  { BlockInfo -> Bool
is_overflows :: !Bool,
    BlockInfo -> Int32
bucket_num :: {-# UNPACK #-} !Int32
  } 
  deriving Int -> BlockInfo -> ShowS
[BlockInfo] -> ShowS
BlockInfo -> String
(Int -> BlockInfo -> ShowS)
-> (BlockInfo -> String)
-> ([BlockInfo] -> ShowS)
-> Show BlockInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockInfo] -> ShowS
$cshowList :: [BlockInfo] -> ShowS
show :: BlockInfo -> String
$cshow :: BlockInfo -> String
showsPrec :: Int -> BlockInfo -> ShowS
$cshowsPrec :: Int -> BlockInfo -> ShowS
Show

writeBlockInfo :: BlockInfo->Writer Builder
writeBlockInfo :: BlockInfo -> Writer Builder
writeBlockInfo Info{Bool
is_overflows :: Bool
is_overflows :: BlockInfo -> Bool
is_overflows, Int32
bucket_num :: Int32
bucket_num :: BlockInfo -> Int32
bucket_num} = do
  Word -> Writer Builder
forall w. MonoidMap ByteString w => Word -> Writer w
writeVarUInt Word
1
  Word8 -> Writer Builder
forall w. MonoidMap ByteString w => Word8 -> Writer w
writeBinaryUInt8 (if Bool
is_overflows then Word8
1 else Word8
0)
  Word -> Writer Builder
forall w. MonoidMap ByteString w => Word -> Writer w
writeVarUInt Word
2
  Int32 -> Writer Builder
forall w. MonoidMap ByteString w => Int32 -> Writer w
writeBinaryInt32 Int32
bucket_num
  Word -> Writer Builder
forall w. MonoidMap ByteString w => Word -> Writer w
writeVarUInt Word
0

data Block = ColumnOrientedBlock
  { Block -> Vector (ByteString, ByteString)
columns_with_type :: Vector (ByteString, ByteString),
    Block -> Vector (Vector ClickhouseType)
cdata :: Vector (Vector ClickhouseType),
    Block -> BlockInfo
info :: BlockInfo
  }
  deriving Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show
------------------------------------------------------------
data ClickhouseType
  = CKInt8 Int8
  | CKInt16 Int16
  | CKInt32 Int32
  | CKInt64 Int64
  | CKInt128 Int64 Int64
  | CKUInt8 Word8
  | CKUInt16 Word16
  | CKUInt32 Word32
  | CKUInt64 Word64
  | CKUInt128 Word64 Word64
  | CKString ByteString
  | CKTuple (Vector ClickhouseType)
  | CKArray (Vector ClickhouseType)
  | CKDecimal Float
  | CKDecimal32 Float
  | CKDecimal64 Double
  | CKDecimal128 Double
  | CKIPv4 (Word8, Word8, Word8, Word8)
  | CKIPv6 (Word16, Word16, Word16, Word16,
         Word16, Word16, Word16, Word16)
  | CKDate {
    ClickhouseType -> Integer
year :: !Integer,
    ClickhouseType -> Int
month :: !Int,
    ClickhouseType -> Int
day :: !Int 
  }
  | CKNull
  deriving (Int -> ClickhouseType -> ShowS
[ClickhouseType] -> ShowS
ClickhouseType -> String
(Int -> ClickhouseType -> ShowS)
-> (ClickhouseType -> String)
-> ([ClickhouseType] -> ShowS)
-> Show ClickhouseType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClickhouseType] -> ShowS
$cshowList :: [ClickhouseType] -> ShowS
show :: ClickhouseType -> String
$cshow :: ClickhouseType -> String
showsPrec :: Int -> ClickhouseType -> ShowS
$cshowsPrec :: Int -> ClickhouseType -> ShowS
Show, ClickhouseType -> ClickhouseType -> Bool
(ClickhouseType -> ClickhouseType -> Bool)
-> (ClickhouseType -> ClickhouseType -> Bool) -> Eq ClickhouseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClickhouseType -> ClickhouseType -> Bool
$c/= :: ClickhouseType -> ClickhouseType -> Bool
== :: ClickhouseType -> ClickhouseType -> Bool
$c== :: ClickhouseType -> ClickhouseType -> Bool
Eq)

----------------------------------------------------------
data ServerInfo = ServerInfo
  { ServerInfo -> ByteString
name :: {-# UNPACK #-} !ByteString,
    ServerInfo -> Word
version_major :: {-# UNPACK #-} !Word,
    ServerInfo -> Word
version_minor :: {-# UNPACK #-} !Word,
    ServerInfo -> Word
version_patch :: {-# UNPACK #-} !Word,
    ServerInfo -> Word
revision :: !Word,
    ServerInfo -> Maybe ByteString
timezone :: Maybe ByteString,
    ServerInfo -> ByteString
display_name :: {-# UNPACK #-} !ByteString
  }
  deriving (Int -> ServerInfo -> ShowS
[ServerInfo] -> ShowS
ServerInfo -> String
(Int -> ServerInfo -> ShowS)
-> (ServerInfo -> String)
-> ([ServerInfo] -> ShowS)
-> Show ServerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerInfo] -> ShowS
$cshowList :: [ServerInfo] -> ShowS
show :: ServerInfo -> String
$cshow :: ServerInfo -> String
showsPrec :: Int -> ServerInfo -> ShowS
$cshowsPrec :: Int -> ServerInfo -> ShowS
Show)

setServerInfo :: Maybe ServerInfo->TCPConnection->TCPConnection
setServerInfo :: Maybe ServerInfo -> TCPConnection -> TCPConnection
setServerInfo Maybe ServerInfo
server_info tcp :: TCPConnection
tcp@TCPConnection{context :: TCPConnection -> Context
context=Context
ctx} 
  = TCPConnection
tcp{context :: Context
context=Context
ctx{server_info :: Maybe ServerInfo
server_info=Maybe ServerInfo
server_info}}
---------------------------------------------------------
data TCPConnection = TCPConnection
  { TCPConnection -> ByteString
tcpHost :: {-# UNPACK #-} !ByteString,
    -- ^ host name, default = "localhost" 
    TCPConnection -> ByteString
tcpPort :: {-# UNPACK #-} !ByteString,
    -- ^ port number, default = "8123"
    TCPConnection -> ByteString
tcpUsername :: {-# UNPACK #-} !ByteString,
    -- ^ username, default = "default"
    TCPConnection -> ByteString
tcpPassword :: {-# UNPACK #-} !ByteString,
    -- ^ password, dafault = ""
    TCPConnection -> Socket
tcpSocket :: !Socket,
    -- ^ socket for communication
    TCPConnection -> SockAddr
tcpSockAdrr :: !SockAddr,
    TCPConnection -> Context
context :: !Context,
    -- ^ server and client informations
    TCPConnection -> Word
tcpCompression :: {-# UNPACK #-} !Word
    -- ^ should the data be compressed or not. Not applied yet. 
  }
  deriving (Int -> TCPConnection -> ShowS
[TCPConnection] -> ShowS
TCPConnection -> String
(Int -> TCPConnection -> ShowS)
-> (TCPConnection -> String)
-> ([TCPConnection] -> ShowS)
-> Show TCPConnection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TCPConnection] -> ShowS
$cshowList :: [TCPConnection] -> ShowS
show :: TCPConnection -> String
$cshow :: TCPConnection -> String
showsPrec :: Int -> TCPConnection -> ShowS
$cshowsPrec :: Int -> TCPConnection -> ShowS
Show)

getServerInfo :: TCPConnection->Maybe ServerInfo
getServerInfo :: TCPConnection -> Maybe ServerInfo
getServerInfo TCPConnection{context :: TCPConnection -> Context
context=Context{server_info :: Context -> Maybe ServerInfo
server_info=Maybe ServerInfo
server_info}} = Maybe ServerInfo
server_info

getClientInfo :: TCPConnection->Maybe ClientInfo
getClientInfo :: TCPConnection -> Maybe ClientInfo
getClientInfo TCPConnection{context :: TCPConnection -> Context
context=Context{client_info :: Context -> Maybe ClientInfo
client_info=Maybe ClientInfo
client_info}} = Maybe ClientInfo
client_info

getClientSetting :: TCPConnection->Maybe ClientSetting
getClientSetting :: TCPConnection -> Maybe ClientSetting
getClientSetting TCPConnection{context :: TCPConnection -> Context
context=Context{client_setting :: Context -> Maybe ClientSetting
client_setting=Maybe ClientSetting
client_setting}} = Maybe ClientSetting
client_setting
------------------------------------------------------------------
data ClientInfo = ClientInfo
  { ClientInfo -> ByteString
client_name :: {-# UNPACK #-} !ByteString,
    ClientInfo -> Interface
interface :: Interface,
    ClientInfo -> Word
client_version_major :: {-# UNPACK #-} !Word,
    ClientInfo -> Word
client_version_minor :: {-# UNPACK #-} !Word,
    ClientInfo -> Word
client_version_patch :: {-# UNPACK #-} !Word,
    ClientInfo -> Word
client_revision :: {-# UNPACK #-} !Word,
    ClientInfo -> ByteString
initial_user :: {-# UNPACK #-} !ByteString,
    ClientInfo -> ByteString
initial_query_id :: {-# UNPACK #-} !ByteString,
    ClientInfo -> ByteString
initial_address :: {-# UNPACK #-} !ByteString,
    ClientInfo -> ByteString
quota_key :: {-# UNPACK #-} !ByteString,
    ClientInfo -> QueryKind
query_kind :: QueryKind
  }
  deriving (Int -> ClientInfo -> ShowS
[ClientInfo] -> ShowS
ClientInfo -> String
(Int -> ClientInfo -> ShowS)
-> (ClientInfo -> String)
-> ([ClientInfo] -> ShowS)
-> Show ClientInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientInfo] -> ShowS
$cshowList :: [ClientInfo] -> ShowS
show :: ClientInfo -> String
$cshow :: ClientInfo -> String
showsPrec :: Int -> ClientInfo -> ShowS
$cshowsPrec :: Int -> ClientInfo -> ShowS
Show)

getDefaultClientInfo :: ByteString -> ClientInfo
getDefaultClientInfo :: ByteString -> ClientInfo
getDefaultClientInfo ByteString
name =
  ClientInfo :: ByteString
-> Interface
-> Word
-> Word
-> Word
-> Word
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> QueryKind
-> ClientInfo
ClientInfo
    { client_name :: ByteString
client_name = ByteString
name,
      interface :: Interface
interface = Interface
TCP,
      client_version_major :: Word
client_version_major = Word
Defines._CLIENT_VERSION_MAJOR,
      client_version_minor :: Word
client_version_minor = Word
Defines._CLIENT_VERSION_MINOR,
      client_version_patch :: Word
client_version_patch = Word
Defines._CLIENT_VERSION_PATCH,
      client_revision :: Word
client_revision = Word
Defines._CLIENT_REVISION,
      initial_user :: ByteString
initial_user = ByteString
"",
      initial_query_id :: ByteString
initial_query_id = ByteString
"",
      initial_address :: ByteString
initial_address = ByteString
"0.0.0.0:0",
      quota_key :: ByteString
quota_key = ByteString
"",
      query_kind :: QueryKind
query_kind = QueryKind
INITIAL_QUERY
    }

setClientInfo :: Maybe ClientInfo -> TCPConnection -> TCPConnection
setClientInfo :: Maybe ClientInfo -> TCPConnection -> TCPConnection
setClientInfo Maybe ClientInfo
client_info tcp :: TCPConnection
tcp@TCPConnection{context :: TCPConnection -> Context
context=Context
ctx}
  = TCPConnection
tcp{context :: Context
context=Context
ctx{client_info :: Maybe ClientInfo
client_info=Maybe ClientInfo
client_info}}
-------------------------------------------------------------------
data ClientSetting 
  = ClientSetting {
      ClientSetting -> Word
insert_block_size ::{-# UNPACK #-} !Word,
      ClientSetting -> Bool
strings_as_bytes :: !Bool,
      ClientSetting -> ByteString
strings_encoding ::{-# UNPACK #-} !ByteString
  }
  deriving Int -> ClientSetting -> ShowS
[ClientSetting] -> ShowS
ClientSetting -> String
(Int -> ClientSetting -> ShowS)
-> (ClientSetting -> String)
-> ([ClientSetting] -> ShowS)
-> Show ClientSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientSetting] -> ShowS
$cshowList :: [ClientSetting] -> ShowS
show :: ClientSetting -> String
$cshow :: ClientSetting -> String
showsPrec :: Int -> ClientSetting -> ShowS
$cshowsPrec :: Int -> ClientSetting -> ShowS
Show

setClientSetting :: Maybe ClientSetting->TCPConnection->TCPConnection
setClientSetting :: Maybe ClientSetting -> TCPConnection -> TCPConnection
setClientSetting Maybe ClientSetting
client_setting tcp :: TCPConnection
tcp@TCPConnection{context :: TCPConnection -> Context
context=Context
ctx} 
  = TCPConnection
tcp{context :: Context
context=Context
ctx{client_setting :: Maybe ClientSetting
client_setting=Maybe ClientSetting
client_setting}}

-------------------------------------------------------------------
data Interface = TCP | HTTP
  deriving (Int -> Interface -> ShowS
[Interface] -> ShowS
Interface -> String
(Int -> Interface -> ShowS)
-> (Interface -> String)
-> ([Interface] -> ShowS)
-> Show Interface
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interface] -> ShowS
$cshowList :: [Interface] -> ShowS
show :: Interface -> String
$cshow :: Interface -> String
showsPrec :: Int -> Interface -> ShowS
$cshowsPrec :: Int -> Interface -> ShowS
Show, Interface -> Interface -> Bool
(Interface -> Interface -> Bool)
-> (Interface -> Interface -> Bool) -> Eq Interface
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interface -> Interface -> Bool
$c/= :: Interface -> Interface -> Bool
== :: Interface -> Interface -> Bool
$c== :: Interface -> Interface -> Bool
Eq)

data QueryKind = NO_QUERY | INITIAL_QUERY | SECOND_QUERY
  deriving (Int -> QueryKind -> ShowS
[QueryKind] -> ShowS
QueryKind -> String
(Int -> QueryKind -> ShowS)
-> (QueryKind -> String)
-> ([QueryKind] -> ShowS)
-> Show QueryKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryKind] -> ShowS
$cshowList :: [QueryKind] -> ShowS
show :: QueryKind -> String
$cshow :: QueryKind -> String
showsPrec :: Int -> QueryKind -> ShowS
$cshowsPrec :: Int -> QueryKind -> ShowS
Show, QueryKind -> QueryKind -> Bool
(QueryKind -> QueryKind -> Bool)
-> (QueryKind -> QueryKind -> Bool) -> Eq QueryKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryKind -> QueryKind -> Bool
$c/= :: QueryKind -> QueryKind -> Bool
== :: QueryKind -> QueryKind -> Bool
$c== :: QueryKind -> QueryKind -> Bool
Eq)

data Context = Context
  { Context -> Maybe ClientInfo
client_info :: Maybe ClientInfo,
    Context -> Maybe ServerInfo
server_info :: Maybe ServerInfo,
    Context -> Maybe ClientSetting
client_setting :: Maybe ClientSetting
  }
  deriving Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show

data Packet
  = Block {Packet -> Block
queryData :: !Block}
  | Progress {Packet -> Progress
prog :: !Progress}
  | StreamProfileInfo {Packet -> BlockStreamProfileInfo
profile :: !BlockStreamProfileInfo}
  | MultiString !(ByteString, ByteString)
  | ErrorMessage !String
  | Hello
  | EndOfStream
  deriving (Int -> Packet -> ShowS
[Packet] -> ShowS
Packet -> String
(Int -> Packet -> ShowS)
-> (Packet -> String) -> ([Packet] -> ShowS) -> Show Packet
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)
------------------------------------------------------------
data Progress = Prog
  { Progress -> Word
rows :: {-# UNPACK #-} !Word,
    Progress -> Word
bytes :: {-# UNPACK #-} !Word,
    Progress -> Word
total_rows :: {-# UNPACK #-} !Word,
    Progress -> Word
written_rows :: {-# UNPACK #-} !Word,
    Progress -> Word
written_bytes :: {-# UNPACK #-} !Word
  }
  deriving (Int -> Progress -> ShowS
[Progress] -> ShowS
Progress -> String
(Int -> Progress -> ShowS)
-> (Progress -> String) -> ([Progress] -> ShowS) -> Show Progress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Progress] -> ShowS
$cshowList :: [Progress] -> ShowS
show :: Progress -> String
$cshow :: Progress -> String
showsPrec :: Int -> Progress -> ShowS
$cshowsPrec :: Int -> Progress -> ShowS
Show)

instance Default Progress where
  def :: Progress
def = Progress
defaultProgress

increment :: Progress -> Progress -> Progress
increment :: Progress -> Progress -> Progress
increment (Prog Word
a Word
b Word
c Word
d Word
e) (Prog Word
a' Word
b' Word
c' Word
d' Word
e') =
  Word -> Word -> Word -> Word -> Word -> Progress
Prog (Word
a Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
a') (Word
b Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
b') (Word
c Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
c') (Word
d Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
d') (Word
e Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
e')

readProgress :: Word -> Reader Progress
readProgress :: Word -> Reader Progress
readProgress Word
server_revision = do
  Word
rows <- Reader Word
readVarInt
  Word
bytes <- Reader Word
readVarInt

  let revision :: Word
revision = Word
server_revision
  Word
total_rows <-
    if Word
revision Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
Defines._DBMS_MIN_REVISION_WITH_TOTAL_ROWS_IN_PROGRESS
      then Reader Word
readVarInt
      else Word -> Reader Word
forall (m :: * -> *) a. Monad m => a -> m a
return Word
0
  if Word
revision Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
Defines._DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO
    then do
      Word
written_rows <- Reader Word
readVarInt
      Word
written_bytes <- Reader Word
readVarInt
      Progress -> Reader Progress
forall (m :: * -> *) a. Monad m => a -> m a
return (Progress -> Reader Progress) -> Progress -> Reader Progress
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> Word -> Progress
Prog Word
rows Word
bytes Word
total_rows Word
written_rows Word
written_bytes
    else do
      Progress -> Reader Progress
forall (m :: * -> *) a. Monad m => a -> m a
return (Progress -> Reader Progress) -> Progress -> Reader Progress
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> Word -> Progress
Prog Word
rows Word
bytes Word
total_rows Word
0 Word
0

defaultProgress :: Progress
defaultProgress :: Progress
defaultProgress = Word -> Word -> Word -> Word -> Word -> Progress
Prog Word
0 Word
0 Word
0 Word
0 Word
0
----------------------------------------------------------------------
data BlockStreamProfileInfo = ProfileInfo
  { BlockStreamProfileInfo -> Word
number_rows :: {-# UNPACK #-} !Word,
    BlockStreamProfileInfo -> Word
blocks :: {-# UNPACK #-} !Word,
    BlockStreamProfileInfo -> Word
number_bytes :: {-# UNPACK #-} !Word,
    BlockStreamProfileInfo -> Bool
applied_limit :: !Bool,
    BlockStreamProfileInfo -> Word
rows_before_limit :: {-# UNPACK #-} !Word,
    BlockStreamProfileInfo -> Bool
calculated_rows_before_limit :: !Bool
  }
  deriving Int -> BlockStreamProfileInfo -> ShowS
[BlockStreamProfileInfo] -> ShowS
BlockStreamProfileInfo -> String
(Int -> BlockStreamProfileInfo -> ShowS)
-> (BlockStreamProfileInfo -> String)
-> ([BlockStreamProfileInfo] -> ShowS)
-> Show BlockStreamProfileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockStreamProfileInfo] -> ShowS
$cshowList :: [BlockStreamProfileInfo] -> ShowS
show :: BlockStreamProfileInfo -> String
$cshow :: BlockStreamProfileInfo -> String
showsPrec :: Int -> BlockStreamProfileInfo -> ShowS
$cshowsPrec :: Int -> BlockStreamProfileInfo -> ShowS
Show

instance Default BlockStreamProfileInfo where
  def :: BlockStreamProfileInfo
def = BlockStreamProfileInfo
defaultProfile

defaultProfile :: BlockStreamProfileInfo
defaultProfile :: BlockStreamProfileInfo
defaultProfile = Word
-> Word -> Word -> Bool -> Word -> Bool -> BlockStreamProfileInfo
ProfileInfo Word
0 Word
0 Word
0 Bool
False Word
0 Bool
False

readBlockStreamProfileInfo :: Reader BlockStreamProfileInfo
readBlockStreamProfileInfo :: Reader BlockStreamProfileInfo
readBlockStreamProfileInfo = do
  Word
rows <- Reader Word
readVarInt
  Word
blocks <- Reader Word
readVarInt
  Word
bytes <- Reader Word
readVarInt
  Bool
applied_limit <- (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0) (Word8 -> Bool) -> StateT Buffer IO Word8 -> StateT Buffer IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Buffer IO Word8
readBinaryUInt8
  Word
rows_before_limit <- Reader Word
readVarInt
  Bool
calculated_rows_before_limit <- (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0) (Word8 -> Bool) -> StateT Buffer IO Word8 -> StateT Buffer IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Buffer IO Word8
readBinaryUInt8
  BlockStreamProfileInfo -> Reader BlockStreamProfileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockStreamProfileInfo -> Reader BlockStreamProfileInfo)
-> BlockStreamProfileInfo -> Reader BlockStreamProfileInfo
forall a b. (a -> b) -> a -> b
$ Word
-> Word -> Word -> Bool -> Word -> Bool -> BlockStreamProfileInfo
ProfileInfo Word
rows Word
blocks Word
bytes Bool
applied_limit Word
rows_before_limit Bool
calculated_rows_before_limit
-----------------------------------------------------------------------
data QueryInfo = QueryInfo 
 { QueryInfo -> BlockStreamProfileInfo
profile_info :: !BlockStreamProfileInfo,
   QueryInfo -> Progress
progress :: !Progress,
   QueryInfo -> Word
elapsed :: {-# UNPACK #-} !Word
 } deriving Int -> QueryInfo -> ShowS
[QueryInfo] -> ShowS
QueryInfo -> String
(Int -> QueryInfo -> ShowS)
-> (QueryInfo -> String)
-> ([QueryInfo] -> ShowS)
-> Show QueryInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryInfo] -> ShowS
$cshowList :: [QueryInfo] -> ShowS
show :: QueryInfo -> String
$cshow :: QueryInfo -> String
showsPrec :: Int -> QueryInfo -> ShowS
$cshowsPrec :: Int -> QueryInfo -> ShowS
Show

instance Default QueryInfo where
  def :: QueryInfo
def = QueryInfo
defaultQueryInfo

storeProfile :: QueryInfo->BlockStreamProfileInfo->QueryInfo
storeProfile :: QueryInfo -> BlockStreamProfileInfo -> QueryInfo
storeProfile (QueryInfo BlockStreamProfileInfo
_ Progress
progress Word
elapsed) BlockStreamProfileInfo
new_profile 
              = BlockStreamProfileInfo -> Progress -> Word -> QueryInfo
QueryInfo BlockStreamProfileInfo
new_profile Progress
progress Word
elapsed

storeProgress :: QueryInfo->Progress->QueryInfo
storeProgress :: QueryInfo -> Progress -> QueryInfo
storeProgress (QueryInfo BlockStreamProfileInfo
profile Progress
progress Word
elapsed) Progress
new_progress 
              = BlockStreamProfileInfo -> Progress -> Word -> QueryInfo
QueryInfo BlockStreamProfileInfo
profile (Progress -> Progress -> Progress
increment Progress
progress Progress
new_progress) Word
elapsed

storeElasped :: QueryInfo->Word->QueryInfo
storeElasped :: QueryInfo -> Word -> QueryInfo
storeElasped (QueryInfo BlockStreamProfileInfo
profile Progress
progress Word
_)
              = BlockStreamProfileInfo -> Progress -> Word -> QueryInfo
QueryInfo BlockStreamProfileInfo
profile Progress
progress 

defaultQueryInfo :: QueryInfo
defaultQueryInfo :: QueryInfo
defaultQueryInfo = 
  QueryInfo :: BlockStreamProfileInfo -> Progress -> Word -> QueryInfo
QueryInfo
  { progress :: Progress
progress = Progress
defaultProgress,
    profile_info :: BlockStreamProfileInfo
profile_info = BlockStreamProfileInfo
defaultProfile,
    elapsed :: Word
elapsed = Word
0
  }
-------------------------------------------------------------------------
data CKResult = CKResult
 { CKResult -> Vector (Vector ClickhouseType)
query_result :: Vector (Vector ClickhouseType),
   CKResult -> QueryInfo
query_info :: !QueryInfo
 }
 deriving Int -> CKResult -> ShowS
[CKResult] -> ShowS
CKResult -> String
(Int -> CKResult -> ShowS)
-> (CKResult -> String) -> ([CKResult] -> ShowS) -> Show CKResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CKResult] -> ShowS
$cshowList :: [CKResult] -> ShowS
show :: CKResult -> String
$cshow :: CKResult -> String
showsPrec :: Int -> CKResult -> ShowS
$cshowsPrec :: Int -> CKResult -> ShowS
Show
-------------------------------------------------------------------------
data ConnParams = ConnParams{
      ConnParams -> ByteString
username'    :: !ByteString,
      ConnParams -> ByteString
host'        :: !ByteString,
      ConnParams -> ByteString
port'        :: !ByteString,
      ConnParams -> ByteString
password'    :: !ByteString,
      ConnParams -> Bool
compression' :: !Bool,
      ConnParams -> ByteString
database'    :: !ByteString
    }
  deriving (Int -> ConnParams -> ShowS
[ConnParams] -> ShowS
ConnParams -> String
(Int -> ConnParams -> ShowS)
-> (ConnParams -> String)
-> ([ConnParams] -> ShowS)
-> Show ConnParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnParams] -> ShowS
$cshowList :: [ConnParams] -> ShowS
show :: ConnParams -> String
$cshow :: ConnParams -> String
showsPrec :: Int -> ConnParams -> ShowS
$cshowsPrec :: Int -> ConnParams -> ShowS
Show, (forall x. ConnParams -> Rep ConnParams x)
-> (forall x. Rep ConnParams x -> ConnParams) -> Generic ConnParams
forall x. Rep ConnParams x -> ConnParams
forall x. ConnParams -> Rep ConnParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConnParams x -> ConnParams
$cfrom :: forall x. ConnParams -> Rep ConnParams x
Generic)