module ClickHaskell.Protocol.Server where

-- Internal
import ClickHaskell.Primitive
import ClickHaskell.Protocol.Data (DataPacket(..))
import ClickHaskell.Protocol.Settings (DbSettings)

-- GHC
import Data.Int
import GHC.Generics
import ClickHaskell.Columns (Column, deserializeColumn, ColumnHeader, serializeColumn, mkHeader)
import Control.Monad (when)

-- * Server packets

data ServerPacket where
  HelloResponse        :: HelloResponse -> ServerPacket
  DataResponse         :: DataPacket -> ServerPacket
  Exception            :: ExceptionPacket -> ServerPacket
  Progress             :: ProgressPacket -> ServerPacket
  Pong                 :: ServerPacket
  EndOfStream          :: ServerPacket
  ProfileInfo          :: ProfileInfo -> ServerPacket
  Totals               :: ServerPacket
  Extremes             :: ServerPacket
  TablesStatusResponse :: ServerPacket
  Log                  :: ServerPacket
  TableColumns         :: TableColumns -> ServerPacket
  UUIDs                :: ServerPacket
  ReadTaskRequest      :: ServerPacket
  ProfileEvents        :: ProfileEventsPacket -> ServerPacket
  UnknownPacket        :: UVarInt -> ServerPacket

instance Serializable ServerPacket where
  serialize :: ProtocolRevision -> ServerPacket -> Builder
serialize ProtocolRevision
rev ServerPacket
packet = case ServerPacket
packet of
    HelloResponse HelloResponse
p      -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> HelloResponse -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev HelloResponse
p
    DataResponse DataPacket
p       -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev DataPacket
p
    Exception ExceptionPacket
p          -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ExceptionPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev ExceptionPacket
p
    Progress ProgressPacket
p           -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ProgressPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev ProgressPacket
p
    ServerPacket
Pong                 -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
4
    ServerPacket
EndOfStream          -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
5
    ProfileInfo ProfileInfo
p        -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
6 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ProfileInfo -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev ProfileInfo
p
    ServerPacket
Totals               -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
7
    ServerPacket
Extremes             -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
8
    ServerPacket
TablesStatusResponse -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
9
    ServerPacket
Log                  -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
10
    TableColumns TableColumns
p       -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
11 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> TableColumns -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev TableColumns
p
    ServerPacket
UUIDs                -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
12
    ServerPacket
ReadTaskRequest      -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
13
    ProfileEvents ProfileEventsPacket
p      -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
14 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ProfileEventsPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev ProfileEventsPacket
p
    UnknownPacket UVarInt
num    -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
num
  deserialize :: ProtocolRevision -> Get ServerPacket
deserialize ProtocolRevision
rev = do
    packetNum <- forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    case packetNum of
      UVarInt
0  -> HelloResponse -> ServerPacket
HelloResponse (HelloResponse -> ServerPacket)
-> Get HelloResponse -> Get ServerPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get HelloResponse
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
1  -> DataPacket -> ServerPacket
DataResponse (DataPacket -> ServerPacket) -> Get DataPacket -> Get ServerPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get DataPacket
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
2  -> ExceptionPacket -> ServerPacket
Exception (ExceptionPacket -> ServerPacket)
-> Get ExceptionPacket -> Get ServerPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get ExceptionPacket
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
3  -> ProgressPacket -> ServerPacket
Progress (ProgressPacket -> ServerPacket)
-> Get ProgressPacket -> Get ServerPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get ProgressPacket
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
4  -> ServerPacket -> Get ServerPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacket
Pong
      UVarInt
5  -> ServerPacket -> Get ServerPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacket
EndOfStream
      UVarInt
6  -> ProfileInfo -> ServerPacket
ProfileInfo (ProfileInfo -> ServerPacket)
-> Get ProfileInfo -> Get ServerPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get ProfileInfo
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
7  -> ServerPacket -> Get ServerPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacket
Totals
      UVarInt
8  -> ServerPacket -> Get ServerPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacket
Extremes
      UVarInt
9  -> ServerPacket -> Get ServerPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacket
TablesStatusResponse
      UVarInt
10 -> ServerPacket -> Get ServerPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacket
Log
      UVarInt
11 -> TableColumns -> ServerPacket
TableColumns (TableColumns -> ServerPacket)
-> Get TableColumns -> Get ServerPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get TableColumns
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
12 -> ServerPacket -> Get ServerPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacket
UUIDs
      UVarInt
13 -> ServerPacket -> Get ServerPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacket
ReadTaskRequest
      UVarInt
14 -> ProfileEventsPacket -> ServerPacket
ProfileEvents (ProfileEventsPacket -> ServerPacket)
-> Get ProfileEventsPacket -> Get ServerPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get ProfileEventsPacket
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
      UVarInt
_  -> ServerPacket -> Get ServerPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerPacket -> Get ServerPacket)
-> ServerPacket -> Get ServerPacket
forall a b. (a -> b) -> a -> b
$ UVarInt -> ServerPacket
UnknownPacket UVarInt
packetNum

serverPacketToNum :: ServerPacket -> UVarInt
serverPacketToNum :: ServerPacket -> UVarInt
serverPacketToNum ServerPacket
p = case ServerPacket
p of
  (HelloResponse HelloResponse
_) -> UVarInt
0; (DataResponse DataPacket
_)       -> UVarInt
1
  (Exception ExceptionPacket
_)     -> UVarInt
2; (Progress ProgressPacket
_)           -> UVarInt
3;
  (ServerPacket
Pong)            -> UVarInt
4; (ServerPacket
EndOfStream)          -> UVarInt
5
  (ProfileInfo ProfileInfo
_)   -> UVarInt
6; (ServerPacket
Totals)               -> UVarInt
7
  (ServerPacket
Extremes)        -> UVarInt
8; (ServerPacket
TablesStatusResponse) -> UVarInt
9
  (ServerPacket
Log)             -> UVarInt
10; (TableColumns TableColumns
_)      -> UVarInt
11;
  (ServerPacket
UUIDs)           -> UVarInt
12; (ServerPacket
ReadTaskRequest)     -> UVarInt
13
  (ProfileEvents ProfileEventsPacket
_) -> UVarInt
14; (UnknownPacket UVarInt
num)   -> UVarInt
num


{-
  https://github.com/ClickHouse/ClickHouse/blob/eb4a74d7412a1fcf52727cd8b00b365d6b9ed86c/src/Client/Connection.cpp#L520
-}
data HelloResponse = MkHelloResponse
  { HelloResponse -> ChString
server_name                    :: ChString
  , HelloResponse -> UVarInt
server_version_major           :: UVarInt
  , HelloResponse -> UVarInt
server_version_minor           :: UVarInt
  , HelloResponse -> ProtocolRevision
server_revision                :: ProtocolRevision
  , HelloResponse
-> SinceRevision
     UVarInt DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
server_parallel_replicas_proto :: UVarInt  `SinceRevision` DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
  , HelloResponse
-> SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
server_timezone                :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
  , HelloResponse
-> SinceRevision
     ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
server_display_name            :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
  , HelloResponse
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
server_version_patch           :: UVarInt  `SinceRevision` DBMS_MIN_REVISION_WITH_VERSION_PATCH
  , HelloResponse
-> SinceRevision
     ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
proto_send_chunked_srv         :: ChString `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
  , HelloResponse
-> SinceRevision
     ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
proto_recv_chunked_srv         :: ChString `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
  , HelloResponse
-> SinceRevision
     [PasswordComplexityRules]
     DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
password_complexity_rules      :: [PasswordComplexityRules] `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
  , HelloResponse
-> SinceRevision
     UInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
read_nonce                     :: UInt64 `SinceRevision` DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
  , HelloResponse
-> SinceRevision DbSettings DBMS_MIN_REVISION_WITH_SERVER_SETTINGS
settings                       :: DbSettings `SinceRevision` DBMS_MIN_REVISION_WITH_SERVER_SETTINGS
  , HelloResponse
-> SinceRevision
     UVarInt DBMS_MIN_REVISION_WITH_QUERY_PLAN_SERIALIZATION
server_query_plan_serialization_version :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_QUERY_PLAN_SERIALIZATION
  }
  deriving ((forall x. HelloResponse -> Rep HelloResponse x)
-> (forall x. Rep HelloResponse x -> HelloResponse)
-> Generic HelloResponse
forall x. Rep HelloResponse x -> HelloResponse
forall x. HelloResponse -> Rep HelloResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HelloResponse -> Rep HelloResponse x
from :: forall x. HelloResponse -> Rep HelloResponse x
$cto :: forall x. Rep HelloResponse x -> HelloResponse
to :: forall x. Rep HelloResponse x -> HelloResponse
Generic, ProtocolRevision -> Get HelloResponse
ProtocolRevision -> HelloResponse -> Builder
(ProtocolRevision -> HelloResponse -> Builder)
-> (ProtocolRevision -> Get HelloResponse)
-> Serializable HelloResponse
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> HelloResponse -> Builder
serialize :: ProtocolRevision -> HelloResponse -> Builder
$cdeserialize :: ProtocolRevision -> Get HelloResponse
deserialize :: ProtocolRevision -> Get HelloResponse
Serializable)

data PasswordComplexityRules = MkPasswordComplexityRules
  { PasswordComplexityRules -> ChString
original_pattern  :: ChString
  , PasswordComplexityRules -> ChString
exception_message :: ChString
  }
  deriving ((forall x.
 PasswordComplexityRules -> Rep PasswordComplexityRules x)
-> (forall x.
    Rep PasswordComplexityRules x -> PasswordComplexityRules)
-> Generic PasswordComplexityRules
forall x. Rep PasswordComplexityRules x -> PasswordComplexityRules
forall x. PasswordComplexityRules -> Rep PasswordComplexityRules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PasswordComplexityRules -> Rep PasswordComplexityRules x
from :: forall x. PasswordComplexityRules -> Rep PasswordComplexityRules x
$cto :: forall x. Rep PasswordComplexityRules x -> PasswordComplexityRules
to :: forall x. Rep PasswordComplexityRules x -> PasswordComplexityRules
Generic, ProtocolRevision -> Get PasswordComplexityRules
ProtocolRevision -> PasswordComplexityRules -> Builder
(ProtocolRevision -> PasswordComplexityRules -> Builder)
-> (ProtocolRevision -> Get PasswordComplexityRules)
-> Serializable PasswordComplexityRules
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> PasswordComplexityRules -> Builder
serialize :: ProtocolRevision -> PasswordComplexityRules -> Builder
$cdeserialize :: ProtocolRevision -> Get PasswordComplexityRules
deserialize :: ProtocolRevision -> Get PasswordComplexityRules
Serializable)


data ExceptionPacket = MkExceptionPacket
  { ExceptionPacket -> Int32
code        :: Int32
  , ExceptionPacket -> ChString
name        :: ChString
  , ExceptionPacket -> ChString
message     :: ChString
  , ExceptionPacket -> ChString
stack_trace :: ChString
  , ExceptionPacket -> UInt8
nested      :: UInt8
  }
  deriving ((forall x. ExceptionPacket -> Rep ExceptionPacket x)
-> (forall x. Rep ExceptionPacket x -> ExceptionPacket)
-> Generic ExceptionPacket
forall x. Rep ExceptionPacket x -> ExceptionPacket
forall x. ExceptionPacket -> Rep ExceptionPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExceptionPacket -> Rep ExceptionPacket x
from :: forall x. ExceptionPacket -> Rep ExceptionPacket x
$cto :: forall x. Rep ExceptionPacket x -> ExceptionPacket
to :: forall x. Rep ExceptionPacket x -> ExceptionPacket
Generic, Int -> ExceptionPacket -> ShowS
[ExceptionPacket] -> ShowS
ExceptionPacket -> String
(Int -> ExceptionPacket -> ShowS)
-> (ExceptionPacket -> String)
-> ([ExceptionPacket] -> ShowS)
-> Show ExceptionPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExceptionPacket -> ShowS
showsPrec :: Int -> ExceptionPacket -> ShowS
$cshow :: ExceptionPacket -> String
show :: ExceptionPacket -> String
$cshowList :: [ExceptionPacket] -> ShowS
showList :: [ExceptionPacket] -> ShowS
Show, ProtocolRevision -> Get ExceptionPacket
ProtocolRevision -> ExceptionPacket -> Builder
(ProtocolRevision -> ExceptionPacket -> Builder)
-> (ProtocolRevision -> Get ExceptionPacket)
-> Serializable ExceptionPacket
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> ExceptionPacket -> Builder
serialize :: ProtocolRevision -> ExceptionPacket -> Builder
$cdeserialize :: ProtocolRevision -> Get ExceptionPacket
deserialize :: ProtocolRevision -> Get ExceptionPacket
Serializable)

data ProgressPacket = MkProgressPacket
  { ProgressPacket -> UVarInt
rows        :: UVarInt
  , ProgressPacket -> UVarInt
bytes       :: UVarInt
  , ProgressPacket -> UVarInt
total_rows  :: UVarInt
  , ProgressPacket
-> SinceRevision
     UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS
total_bytes :: UVarInt `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS
  , ProgressPacket
-> SinceRevision
     UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS
wrote_rows  :: UVarInt `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_TOTAL_BYTES_IN_PROGRESS
  , ProgressPacket
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO
wrote_bytes :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO
  , ProgressPacket
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO
elapsed_ns  :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_CLIENT_WRITE_INFO
  }
  deriving ((forall x. ProgressPacket -> Rep ProgressPacket x)
-> (forall x. Rep ProgressPacket x -> ProgressPacket)
-> Generic ProgressPacket
forall x. Rep ProgressPacket x -> ProgressPacket
forall x. ProgressPacket -> Rep ProgressPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProgressPacket -> Rep ProgressPacket x
from :: forall x. ProgressPacket -> Rep ProgressPacket x
$cto :: forall x. Rep ProgressPacket x -> ProgressPacket
to :: forall x. Rep ProgressPacket x -> ProgressPacket
Generic, ProtocolRevision -> Get ProgressPacket
ProtocolRevision -> ProgressPacket -> Builder
(ProtocolRevision -> ProgressPacket -> Builder)
-> (ProtocolRevision -> Get ProgressPacket)
-> Serializable ProgressPacket
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> ProgressPacket -> Builder
serialize :: ProtocolRevision -> ProgressPacket -> Builder
$cdeserialize :: ProtocolRevision -> Get ProgressPacket
deserialize :: ProtocolRevision -> Get ProgressPacket
Serializable)

data ProfileInfo = MkProfileInfo
  { ProfileInfo -> UVarInt
rows                         :: UVarInt
  , ProfileInfo -> UVarInt
blocks                       :: UVarInt
  , ProfileInfo -> UVarInt
bytes                        :: UVarInt
  , ProfileInfo -> UInt8
applied_limit                :: UInt8
  , ProfileInfo -> UVarInt
rows_before_limit            :: UVarInt
  , ProfileInfo -> UInt8
calculated_rows_before_limit :: UInt8
  , ProfileInfo
-> SinceRevision
     UInt8 DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION
applied_aggregation          :: UInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION
  , ProfileInfo
-> SinceRevision
     UVarInt DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION
rows_before_aggregation      :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION
  }
  deriving ((forall x. ProfileInfo -> Rep ProfileInfo x)
-> (forall x. Rep ProfileInfo x -> ProfileInfo)
-> Generic ProfileInfo
forall x. Rep ProfileInfo x -> ProfileInfo
forall x. ProfileInfo -> Rep ProfileInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProfileInfo -> Rep ProfileInfo x
from :: forall x. ProfileInfo -> Rep ProfileInfo x
$cto :: forall x. Rep ProfileInfo x -> ProfileInfo
to :: forall x. Rep ProfileInfo x -> ProfileInfo
Generic, ProtocolRevision -> Get ProfileInfo
ProtocolRevision -> ProfileInfo -> Builder
(ProtocolRevision -> ProfileInfo -> Builder)
-> (ProtocolRevision -> Get ProfileInfo)
-> Serializable ProfileInfo
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> ProfileInfo -> Builder
serialize :: ProtocolRevision -> ProfileInfo -> Builder
$cdeserialize :: ProtocolRevision -> Get ProfileInfo
deserialize :: ProtocolRevision -> Get ProfileInfo
Serializable)

data TableColumns = MkTableColumns
  { TableColumns -> ChString
table_name :: ChString
  , TableColumns -> ChString
table_columns :: ChString
  }
  deriving ((forall x. TableColumns -> Rep TableColumns x)
-> (forall x. Rep TableColumns x -> TableColumns)
-> Generic TableColumns
forall x. Rep TableColumns x -> TableColumns
forall x. TableColumns -> Rep TableColumns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableColumns -> Rep TableColumns x
from :: forall x. TableColumns -> Rep TableColumns x
$cto :: forall x. Rep TableColumns x -> TableColumns
to :: forall x. Rep TableColumns x -> TableColumns
Generic, ProtocolRevision -> Get TableColumns
ProtocolRevision -> TableColumns -> Builder
(ProtocolRevision -> TableColumns -> Builder)
-> (ProtocolRevision -> Get TableColumns)
-> Serializable TableColumns
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> TableColumns -> Builder
serialize :: ProtocolRevision -> TableColumns -> Builder
$cdeserialize :: ProtocolRevision -> Get TableColumns
deserialize :: ProtocolRevision -> Get TableColumns
Serializable)

data ProfileEventsPacket = MkProfileEventsPacket
  { ProfileEventsPacket -> DataPacket
dataPacket :: DataPacket
  , ProfileEventsPacket -> [ChString]
host_name :: [ChString]
  , ProfileEventsPacket -> [DateTime ""]
current_time :: [DateTime ""]
  , ProfileEventsPacket -> [UInt64]
thread_id :: [UInt64]
  , ProfileEventsPacket -> [Int8]
type_ :: [Int8]
  , ProfileEventsPacket -> [ChString]
name :: [ChString]
  , ProfileEventsPacket -> [UInt64]
value :: [UInt64]
  } deriving ((forall x. ProfileEventsPacket -> Rep ProfileEventsPacket x)
-> (forall x. Rep ProfileEventsPacket x -> ProfileEventsPacket)
-> Generic ProfileEventsPacket
forall x. Rep ProfileEventsPacket x -> ProfileEventsPacket
forall x. ProfileEventsPacket -> Rep ProfileEventsPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProfileEventsPacket -> Rep ProfileEventsPacket x
from :: forall x. ProfileEventsPacket -> Rep ProfileEventsPacket x
$cto :: forall x. Rep ProfileEventsPacket x -> ProfileEventsPacket
to :: forall x. Rep ProfileEventsPacket x -> ProfileEventsPacket
Generic)

-- ToDo: Simplify
instance Serializable ProfileEventsPacket where
  serialize :: ProtocolRevision -> ProfileEventsPacket -> Builder
serialize ProtocolRevision
rev MkProfileEventsPacket{[Int8]
[UInt64]
[DateTime ""]
[ChString]
DataPacket
dataPacket :: ProfileEventsPacket -> DataPacket
host_name :: ProfileEventsPacket -> [ChString]
current_time :: ProfileEventsPacket -> [DateTime ""]
thread_id :: ProfileEventsPacket -> [UInt64]
type_ :: ProfileEventsPacket -> [Int8]
name :: ProfileEventsPacket -> [ChString]
value :: ProfileEventsPacket -> [UInt64]
dataPacket :: DataPacket
host_name :: [ChString]
current_time :: [DateTime ""]
thread_id :: [UInt64]
type_ :: [Int8]
name :: [ChString]
value :: [UInt64]
..}
    =  ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev DataPacket
dataPacket
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ColumnHeader -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall column. KnownColumn column => ColumnHeader
mkHeader @(Column "host_name" ChString)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall column a.
SerializableColumn column =>
ProtocolRevision -> (a -> GetColumnType column) -> [a] -> Builder
serializeColumn @(Column "host_name" ChString) ProtocolRevision
rev ChString -> ChString
ChString -> GetColumnType (Column "host_name" ChString)
forall a. a -> a
id [ChString]
host_name
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ColumnHeader -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall column. KnownColumn column => ColumnHeader
mkHeader @(Column "current_time" (DateTime ""))) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall column a.
SerializableColumn column =>
ProtocolRevision -> (a -> GetColumnType column) -> [a] -> Builder
serializeColumn @(Column "current_time" (DateTime "")) ProtocolRevision
rev DateTime "" -> DateTime ""
DateTime "" -> GetColumnType (Column "current_time" (DateTime ""))
forall a. a -> a
id [DateTime ""]
current_time
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ColumnHeader -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall column. KnownColumn column => ColumnHeader
mkHeader @(Column "thread_id" UInt64)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall column a.
SerializableColumn column =>
ProtocolRevision -> (a -> GetColumnType column) -> [a] -> Builder
serializeColumn @(Column "thread_id" UInt64) ProtocolRevision
rev UInt64 -> UInt64
UInt64 -> GetColumnType (Column "thread_id" UInt64)
forall a. a -> a
id [UInt64]
thread_id
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ColumnHeader -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall column. KnownColumn column => ColumnHeader
mkHeader @(Column "type" Int8)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall column a.
SerializableColumn column =>
ProtocolRevision -> (a -> GetColumnType column) -> [a] -> Builder
serializeColumn @(Column "type" Int8) ProtocolRevision
rev Int8 -> Int8
Int8 -> GetColumnType (Column "type" Int8)
forall a. a -> a
id [Int8]
type_
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ColumnHeader -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall column. KnownColumn column => ColumnHeader
mkHeader @(Column "name" ChString)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall column a.
SerializableColumn column =>
ProtocolRevision -> (a -> GetColumnType column) -> [a] -> Builder
serializeColumn @(Column "name" ChString) ProtocolRevision
rev ChString -> ChString
ChString -> GetColumnType (Column "name" ChString)
forall a. a -> a
id [ChString]
name
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> ColumnHeader -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (forall column. KnownColumn column => ColumnHeader
mkHeader @(Column "value" UInt64)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall column a.
SerializableColumn column =>
ProtocolRevision -> (a -> GetColumnType column) -> [a] -> Builder
serializeColumn @(Column "value" UInt64) ProtocolRevision
rev UInt64 -> UInt64
UInt64 -> GetColumnType (Column "value" UInt64)
forall a. a -> a
id [UInt64]
value
  deserialize :: ProtocolRevision -> Get ProfileEventsPacket
deserialize ProtocolRevision
rev = do
    dataPacket@MkDataPacket{rows_count, columns_count} <- ProtocolRevision -> Get DataPacket
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
    validateColumnsCount columns_count
    !host_name    <- deserialize @ColumnHeader rev *> deserializeColumn @(Column "host_name" ChString) rev rows_count id
    !current_time <- deserialize @ColumnHeader rev *> deserializeColumn @(Column "current_time" (DateTime "")) rev rows_count id
    !thread_id    <- deserialize @ColumnHeader rev *> deserializeColumn @(Column "thread_id" UInt64) rev rows_count id
    !type_        <- deserialize @ColumnHeader rev *> deserializeColumn @(Column "type" Int8) rev rows_count id
    !name         <- deserialize @ColumnHeader rev *> deserializeColumn @(Column "name" ChString) rev rows_count id
    !value        <- deserialize @ColumnHeader rev *> deserializeColumn @(Column "value" UInt64) rev rows_count id
    pure $ MkProfileEventsPacket{..}
    where
    validateColumnsCount :: a -> f ()
validateColumnsCount a
count = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
count a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
6) (f () -> f ()) -> (String -> f ()) -> String -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> f ()
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$
      String
"Unable to parse ProfileEvents packet. Expected 6 columns but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
count