module ClickHaskell.Packets where

-- Internal
import ClickHaskell.Primitive

-- GHC
import Data.ByteString.Builder (Builder)
import Data.Int
import GHC.Generics

-- * Common Data packet

data DataPacket = MkDataPacket
  { DataPacket -> ChString
table_name    :: ChString
  , DataPacket -> BlockInfo
block_info    :: BlockInfo
  , DataPacket -> UVarInt
columns_count :: UVarInt
  , DataPacket -> UVarInt
rows_count    :: UVarInt
  }
  deriving ((forall x. DataPacket -> Rep DataPacket x)
-> (forall x. Rep DataPacket x -> DataPacket) -> Generic DataPacket
forall x. Rep DataPacket x -> DataPacket
forall x. DataPacket -> Rep DataPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DataPacket -> Rep DataPacket x
from :: forall x. DataPacket -> Rep DataPacket x
$cto :: forall x. Rep DataPacket x -> DataPacket
to :: forall x. Rep DataPacket x -> DataPacket
Generic, ProtocolRevision -> Get DataPacket
ProtocolRevision -> DataPacket -> Builder
(ProtocolRevision -> DataPacket -> Builder)
-> (ProtocolRevision -> Get DataPacket) -> Serializable DataPacket
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> DataPacket -> Builder
serialize :: ProtocolRevision -> DataPacket -> Builder
$cdeserialize :: ProtocolRevision -> Get DataPacket
deserialize :: ProtocolRevision -> Get DataPacket
Serializable)

serializeDataPacket :: ChString -> UVarInt -> UVarInt -> (ProtocolRevision -> Builder)
serializeDataPacket :: ChString -> UVarInt -> UVarInt -> ProtocolRevision -> Builder
serializeDataPacket ChString
table_name UVarInt
columns_count UVarInt
rows_count =
  (ProtocolRevision -> ClientPacket -> Builder)
-> ClientPacket -> ProtocolRevision -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip ProtocolRevision -> ClientPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize (ClientPacket -> ProtocolRevision -> Builder)
-> ClientPacket -> ProtocolRevision -> Builder
forall a b. (a -> b) -> a -> b
$ DataPacket -> ClientPacket
Data
    MkDataPacket
      { ChString
table_name :: ChString
table_name :: ChString
table_name
      , block_info :: BlockInfo
block_info    = MkBlockInfo
        { field_num1 :: UVarInt
field_num1   = UVarInt
1, is_overflows :: UInt8
is_overflows = UInt8
0
        , field_num2 :: UVarInt
field_num2   = UVarInt
2, bucket_num :: Int32
bucket_num   = -Int32
1
        , eof :: UVarInt
eof          = UVarInt
0
        }
      , UVarInt
columns_count :: UVarInt
columns_count :: UVarInt
columns_count
      , UVarInt
rows_count :: UVarInt
rows_count :: UVarInt
rows_count
      }

data BlockInfo = MkBlockInfo
  { BlockInfo -> UVarInt
field_num1   :: UVarInt, BlockInfo -> UInt8
is_overflows :: UInt8
  , BlockInfo -> UVarInt
field_num2   :: UVarInt, BlockInfo -> Int32
bucket_num   :: Int32
  , BlockInfo -> UVarInt
eof          :: UVarInt
  }
  deriving ((forall x. BlockInfo -> Rep BlockInfo x)
-> (forall x. Rep BlockInfo x -> BlockInfo) -> Generic BlockInfo
forall x. Rep BlockInfo x -> BlockInfo
forall x. BlockInfo -> Rep BlockInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockInfo -> Rep BlockInfo x
from :: forall x. BlockInfo -> Rep BlockInfo x
$cto :: forall x. Rep BlockInfo x -> BlockInfo
to :: forall x. Rep BlockInfo x -> BlockInfo
Generic, ProtocolRevision -> Get BlockInfo
ProtocolRevision -> BlockInfo -> Builder
(ProtocolRevision -> BlockInfo -> Builder)
-> (ProtocolRevision -> Get BlockInfo) -> Serializable BlockInfo
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> BlockInfo -> Builder
serialize :: ProtocolRevision -> BlockInfo -> Builder
$cdeserialize :: ProtocolRevision -> Get BlockInfo
deserialize :: ProtocolRevision -> Get BlockInfo
Serializable)








-- * 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        :: ServerPacket
  UnknownPacket        :: UVarInt -> ServerPacket

instance Serializable ServerPacket where
  serialize :: ProtocolRevision -> ServerPacket -> Builder
serialize ProtocolRevision
rev = \case
    HelloResponse HelloResponse
hello  -> 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
hello
    DataResponse DataPacket
hello   -> 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
hello
    Exception ExceptionPacket
hello      -> 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
hello
    Progress ProgressPacket
hello       -> 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
hello
    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
hello    -> 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
hello
    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
hello   -> 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
hello
    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
    ServerPacket
ProfileEvents        -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
14
    UnknownPacket UVarInt
num    -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
num
  deserialize :: ProtocolRevision -> Get ServerPacket
deserialize ProtocolRevision
rev = do
    UVarInt
packetNum <- forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    case UVarInt
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 -> ServerPacket -> Get ServerPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerPacket
ProfileEvents
      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 = \case
  (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
  (ServerPacket
ProfileEvents)   -> 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
  }
  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)








-- * Client packets

data ClientPacket where
  Hello                     :: HelloPacket -> ClientPacket
  Query                     :: QueryPacket -> ClientPacket
  Data                      :: DataPacket -> ClientPacket
  Cancel                    :: ClientPacket
  Ping                      :: ClientPacket
  TablesStatusRequest       :: ClientPacket
  KeepAlive                 :: ClientPacket
  Scalar                    :: ClientPacket
  IgnoredPartUUIDs          :: ClientPacket
  ReadTaskResponse          :: ClientPacket
  MergeTreeReadTaskResponse :: ClientPacket
  SSHChallengeRequest       :: ClientPacket
  SSHChallengeResponse      :: ClientPacket
  deriving ((forall x. ClientPacket -> Rep ClientPacket x)
-> (forall x. Rep ClientPacket x -> ClientPacket)
-> Generic ClientPacket
forall x. Rep ClientPacket x -> ClientPacket
forall x. ClientPacket -> Rep ClientPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientPacket -> Rep ClientPacket x
from :: forall x. ClientPacket -> Rep ClientPacket x
$cto :: forall x. Rep ClientPacket x -> ClientPacket
to :: forall x. Rep ClientPacket x -> ClientPacket
Generic)

instance Serializable ClientPacket where
  serialize :: ProtocolRevision -> ClientPacket -> Builder
serialize ProtocolRevision
rev ClientPacket
packet = case ClientPacket
packet of
    (Hello HelloPacket
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 -> HelloPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev HelloPacket
p
    (Query QueryPacket
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 -> QueryPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev QueryPacket
p
    (Data DataPacket
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 -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev DataPacket
p
    (ClientPacket
Cancel)                    -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
3
    (ClientPacket
Ping)                      -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
4
    (ClientPacket
TablesStatusRequest)       -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
5
    (ClientPacket
KeepAlive)                 -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
6
    (ClientPacket
Scalar)                    -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
7
    (ClientPacket
IgnoredPartUUIDs)          -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
8
    (ClientPacket
ReadTaskResponse)          -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
9
    (ClientPacket
MergeTreeReadTaskResponse) -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
10
    (ClientPacket
SSHChallengeRequest)       -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
11
    (ClientPacket
SSHChallengeResponse)      -> forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev UVarInt
12
  deserialize :: ProtocolRevision -> Get ClientPacket
deserialize ProtocolRevision
rev = forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev Get UVarInt -> (UVarInt -> Get ClientPacket) -> Get ClientPacket
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    UVarInt
0 -> HelloPacket -> ClientPacket
Hello (HelloPacket -> ClientPacket)
-> Get HelloPacket -> Get ClientPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get HelloPacket
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
    UVarInt
1 -> QueryPacket -> ClientPacket
Query (QueryPacket -> ClientPacket)
-> Get QueryPacket -> Get ClientPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolRevision -> Get QueryPacket
forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
rev
    UVarInt
2 -> DataPacket -> ClientPacket
Data (DataPacket -> ClientPacket) -> Get DataPacket -> Get ClientPacket
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
3 -> ClientPacket -> Get ClientPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientPacket
Cancel
    UVarInt
4 -> ClientPacket -> Get ClientPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientPacket
Ping
    UVarInt
5 -> ClientPacket -> Get ClientPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientPacket
TablesStatusRequest
    UVarInt
6 -> ClientPacket -> Get ClientPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientPacket
KeepAlive
    UVarInt
7 -> ClientPacket -> Get ClientPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientPacket
Scalar
    UVarInt
8 -> ClientPacket -> Get ClientPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientPacket
IgnoredPartUUIDs
    UVarInt
9 -> ClientPacket -> Get ClientPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientPacket
ReadTaskResponse
    UVarInt
10 -> ClientPacket -> Get ClientPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientPacket
MergeTreeReadTaskResponse
    UVarInt
11 -> ClientPacket -> Get ClientPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientPacket
SSHChallengeRequest
    UVarInt
12 -> ClientPacket -> Get ClientPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientPacket
SSHChallengeResponse
    UVarInt
num -> String -> Get ClientPacket
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown client packet " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UVarInt -> String
forall a. Show a => a -> String
show UVarInt
num)

-- ** Hello

data HelloPacket = MkHelloPacket
  { HelloPacket -> ChString
client_name          :: ChString
  , HelloPacket -> UVarInt
client_version_major :: UVarInt
  , HelloPacket -> UVarInt
client_version_minor :: UVarInt
  , HelloPacket -> ProtocolRevision
tcp_protocol_version :: ProtocolRevision
  , HelloPacket -> ChString
default_database     :: ChString
  , HelloPacket -> ChString
user                 :: ChString
  , HelloPacket -> ChString
pass                 :: ChString
  }
  deriving ((forall x. HelloPacket -> Rep HelloPacket x)
-> (forall x. Rep HelloPacket x -> HelloPacket)
-> Generic HelloPacket
forall x. Rep HelloPacket x -> HelloPacket
forall x. HelloPacket -> Rep HelloPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HelloPacket -> Rep HelloPacket x
from :: forall x. HelloPacket -> Rep HelloPacket x
$cto :: forall x. Rep HelloPacket x -> HelloPacket
to :: forall x. Rep HelloPacket x -> HelloPacket
Generic, ProtocolRevision -> Get HelloPacket
ProtocolRevision -> HelloPacket -> Builder
(ProtocolRevision -> HelloPacket -> Builder)
-> (ProtocolRevision -> Get HelloPacket)
-> Serializable HelloPacket
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> HelloPacket -> Builder
serialize :: ProtocolRevision -> HelloPacket -> Builder
$cdeserialize :: ProtocolRevision -> Get HelloPacket
deserialize :: ProtocolRevision -> Get HelloPacket
Serializable)

seriliazeHelloPacket :: String -> String -> String -> (ProtocolRevision -> Builder)
seriliazeHelloPacket :: String -> String -> String -> ProtocolRevision -> Builder
seriliazeHelloPacket String
db String
user String
pass =
  (ProtocolRevision -> ClientPacket -> Builder)
-> ClientPacket -> ProtocolRevision -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip ProtocolRevision -> ClientPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize (ClientPacket -> ProtocolRevision -> Builder)
-> ClientPacket -> ProtocolRevision -> Builder
forall a b. (a -> b) -> a -> b
$ HelloPacket -> ClientPacket
Hello
    MkHelloPacket
      { client_name :: ChString
client_name          = ChString
clientName
      , client_version_major :: UVarInt
client_version_major = UVarInt
major
      , client_version_minor :: UVarInt
client_version_minor = UVarInt
minor
      , tcp_protocol_version :: ProtocolRevision
tcp_protocol_version = ProtocolRevision
latestSupportedRevision
      , default_database :: ChString
default_database     = String -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType String
db
      , user :: ChString
user                 = String -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType String
user
      , pass :: ChString
pass                 = String -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType String
pass
      }


data Addendum = MkAddendum{Addendum
-> SinceRevision ChString DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY
quota_key :: ChString `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY}
  deriving ((forall x. Addendum -> Rep Addendum x)
-> (forall x. Rep Addendum x -> Addendum) -> Generic Addendum
forall x. Rep Addendum x -> Addendum
forall x. Addendum -> Rep Addendum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Addendum -> Rep Addendum x
from :: forall x. Addendum -> Rep Addendum x
$cto :: forall x. Rep Addendum x -> Addendum
to :: forall x. Rep Addendum x -> Addendum
Generic, ProtocolRevision -> Get Addendum
ProtocolRevision -> Addendum -> Builder
(ProtocolRevision -> Addendum -> Builder)
-> (ProtocolRevision -> Get Addendum) -> Serializable Addendum
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> Addendum -> Builder
serialize :: ProtocolRevision -> Addendum -> Builder
$cdeserialize :: ProtocolRevision -> Get Addendum
deserialize :: ProtocolRevision -> Get Addendum
Serializable)

-- ** Query

data QueryPacket = MkQueryPacket
  { QueryPacket -> ChString
query_id           :: ChString
  , QueryPacket
-> SinceRevision ClientInfo DBMS_MIN_REVISION_WITH_CLIENT_INFO
client_info        :: ClientInfo `SinceRevision` DBMS_MIN_REVISION_WITH_CLIENT_INFO
  , QueryPacket -> DbSettings
settings           :: DbSettings
  , QueryPacket
-> SinceRevision ChString DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
interserver_secret :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
  , QueryPacket -> QueryStage
query_stage        :: QueryStage
  , QueryPacket -> UVarInt
compression        :: UVarInt
  , QueryPacket -> ChString
query              :: ChString
  , QueryPacket
-> SinceRevision
     QueryParameters DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
parameters         :: QueryParameters `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
  }
  deriving ((forall x. QueryPacket -> Rep QueryPacket x)
-> (forall x. Rep QueryPacket x -> QueryPacket)
-> Generic QueryPacket
forall x. Rep QueryPacket x -> QueryPacket
forall x. QueryPacket -> Rep QueryPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QueryPacket -> Rep QueryPacket x
from :: forall x. QueryPacket -> Rep QueryPacket x
$cto :: forall x. Rep QueryPacket x -> QueryPacket
to :: forall x. Rep QueryPacket x -> QueryPacket
Generic, ProtocolRevision -> Get QueryPacket
ProtocolRevision -> QueryPacket -> Builder
(ProtocolRevision -> QueryPacket -> Builder)
-> (ProtocolRevision -> Get QueryPacket)
-> Serializable QueryPacket
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> QueryPacket -> Builder
serialize :: ProtocolRevision -> QueryPacket -> Builder
$cdeserialize :: ProtocolRevision -> Get QueryPacket
deserialize :: ProtocolRevision -> Get QueryPacket
Serializable)

data QueryPacketArgs = MkQueryPacketArgs
  { QueryPacketArgs -> String
user :: String
  , QueryPacketArgs -> Maybe String
mOsUser :: Maybe String
  , QueryPacketArgs -> Maybe String
mHostname :: Maybe String
  , QueryPacketArgs -> ChString
query :: ChString
  }

serializeQueryPacket :: QueryPacketArgs -> (ProtocolRevision -> Builder)
serializeQueryPacket :: QueryPacketArgs -> ProtocolRevision -> Builder
serializeQueryPacket MkQueryPacketArgs{String
user :: QueryPacketArgs -> String
user :: String
user, Maybe String
mOsUser :: QueryPacketArgs -> Maybe String
mOsUser :: Maybe String
mOsUser, Maybe String
mHostname :: QueryPacketArgs -> Maybe String
mHostname :: Maybe String
mHostname, ChString
query :: QueryPacketArgs -> ChString
query :: ChString
query} ProtocolRevision
rev =
  ProtocolRevision -> ClientPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
rev (ClientPacket -> Builder) -> ClientPacket -> Builder
forall a b. (a -> b) -> a -> b
$ QueryPacket -> ClientPacket
Query
    MkQueryPacket
      { query_id :: ChString
query_id = ChString
""
      , client_info :: SinceRevision ClientInfo DBMS_MIN_REVISION_WITH_CLIENT_INFO
client_info  = ClientInfo
-> SinceRevision ClientInfo DBMS_MIN_REVISION_WITH_CLIENT_INFO
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision MkClientInfo
        { query_kind :: QueryKind
query_kind                   = QueryKind
InitialQuery
        , initial_user :: ChString
initial_user                 = String -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType String
user
        , initial_query_id :: ChString
initial_query_id             = ChString
""
        , initial_adress :: ChString
initial_adress               = ChString
"0.0.0.0:0"
        , initial_time :: SinceRevision
  Int64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
initial_time                 = Int64
-> SinceRevision
     Int64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision Int64
0
        , interface_type :: UInt8
interface_type               = UInt8
1 -- [tcp - 1, http - 2]
        , os_user :: ChString
os_user                      = ChString -> (String -> ChString) -> Maybe String -> ChString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChString
"" String -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType Maybe String
mOsUser
        , hostname :: ChString
hostname                     = ChString -> (String -> ChString) -> Maybe String -> ChString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChString
"" String -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType Maybe String
mHostname
        , client_name :: ChString
client_name                  = ChString
clientName
        , client_version_major :: UVarInt
client_version_major         = UVarInt
major
        , client_version_minor :: UVarInt
client_version_minor         = UVarInt
minor
        , client_revision :: ProtocolRevision
client_revision              = ProtocolRevision
rev
        , quota_key :: SinceRevision
  ChString DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO
quota_key                    = ChString
-> SinceRevision
     ChString DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""
        , distrubuted_depth :: SinceRevision
  UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH
distrubuted_depth            = UVarInt
-> SinceRevision
     UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
        , client_version_patch :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
client_version_patch         = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
patch
        , open_telemetry :: SinceRevision UInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
open_telemetry               = UInt8 -> SinceRevision UInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UInt8
0
        , collaborate_with_initiator :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
collaborate_with_initiator   = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
        , count_participating_replicas :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
count_participating_replicas = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
        , number_of_current_replica :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
number_of_current_replica    = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
        }
      , settings :: DbSettings
settings           = [DbSetting] -> DbSettings
MkDbSettings []
      , interserver_secret :: SinceRevision ChString DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
interserver_secret = ChString
-> SinceRevision ChString DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""
      , query_stage :: QueryStage
query_stage        = QueryStage
Complete
      , compression :: UVarInt
compression        = UVarInt
0
      , ChString
query :: ChString
query :: ChString
query
      , parameters :: SinceRevision
  QueryParameters DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
parameters         = QueryParameters
-> SinceRevision
     QueryParameters DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
forall a (revisionNumber :: Nat).
a -> SinceRevision a revisionNumber
MkSinceRevision QueryParameters
MkQueryParameters
      }

data DbSettings = MkDbSettings [DbSetting]
data DbSetting = MkDbSetting
  { DbSetting -> ChString
setting :: ChString
  , DbSetting
-> SinceRevision
     Flags DBMS_MIN_REVISION_WITH_SETTINGS_SERIALIZED_AS_STRINGS
flags   :: Flags `SinceRevision` DBMS_MIN_REVISION_WITH_SETTINGS_SERIALIZED_AS_STRINGS
  , DbSetting -> ChString
value   :: ChString
  }
instance Serializable DbSettings where
  serialize :: ProtocolRevision -> DbSettings -> Builder
serialize ProtocolRevision
rev (MkDbSettings [DbSetting]
_setts) =
    forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChString ProtocolRevision
rev ChString
""
  deserialize :: ProtocolRevision -> Get DbSettings
deserialize ProtocolRevision
_rev =
    String -> Get DbSettings
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"DbSettings reading unimplemented"

data QueryParameters = MkQueryParameters
instance Serializable QueryParameters where
  serialize :: ProtocolRevision -> QueryParameters -> Builder
serialize ProtocolRevision
rev QueryParameters
_ =
    forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChString ProtocolRevision
rev ChString
""
  deserialize :: ProtocolRevision -> Get QueryParameters
deserialize ProtocolRevision
_rev =
    String -> Get QueryParameters
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"QueryParameters reading unimplemented"

data QueryStage
  = FetchColumns | WithMergeableState | Complete
  | WithMergeableStateAfterAggregation
  | WithMergeableStateAfterAggregationAndLimit
  deriving (Int -> QueryStage
QueryStage -> Int
QueryStage -> [QueryStage]
QueryStage -> QueryStage
QueryStage -> QueryStage -> [QueryStage]
QueryStage -> QueryStage -> QueryStage -> [QueryStage]
(QueryStage -> QueryStage)
-> (QueryStage -> QueryStage)
-> (Int -> QueryStage)
-> (QueryStage -> Int)
-> (QueryStage -> [QueryStage])
-> (QueryStage -> QueryStage -> [QueryStage])
-> (QueryStage -> QueryStage -> [QueryStage])
-> (QueryStage -> QueryStage -> QueryStage -> [QueryStage])
-> Enum QueryStage
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: QueryStage -> QueryStage
succ :: QueryStage -> QueryStage
$cpred :: QueryStage -> QueryStage
pred :: QueryStage -> QueryStage
$ctoEnum :: Int -> QueryStage
toEnum :: Int -> QueryStage
$cfromEnum :: QueryStage -> Int
fromEnum :: QueryStage -> Int
$cenumFrom :: QueryStage -> [QueryStage]
enumFrom :: QueryStage -> [QueryStage]
$cenumFromThen :: QueryStage -> QueryStage -> [QueryStage]
enumFromThen :: QueryStage -> QueryStage -> [QueryStage]
$cenumFromTo :: QueryStage -> QueryStage -> [QueryStage]
enumFromTo :: QueryStage -> QueryStage -> [QueryStage]
$cenumFromThenTo :: QueryStage -> QueryStage -> QueryStage -> [QueryStage]
enumFromThenTo :: QueryStage -> QueryStage -> QueryStage -> [QueryStage]
Enum)

instance Serializable QueryStage where
  serialize :: ProtocolRevision -> QueryStage -> Builder
serialize ProtocolRevision
rev = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (UVarInt -> Builder)
-> (QueryStage -> UVarInt) -> QueryStage -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UVarInt) -> (QueryStage -> Int) -> QueryStage -> UVarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryStage -> Int
forall a. Enum a => a -> Int
fromEnum
  deserialize :: ProtocolRevision -> Get QueryStage
deserialize ProtocolRevision
rev = do
    forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev Get UVarInt -> (UVarInt -> Get QueryStage) -> Get QueryStage
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      UVarInt
0 -> QueryStage -> Get QueryStage
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryStage
FetchColumns
      UVarInt
1 -> QueryStage -> Get QueryStage
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryStage
WithMergeableState
      UVarInt
2 -> QueryStage -> Get QueryStage
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryStage
Complete
      UVarInt
3 -> QueryStage -> Get QueryStage
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryStage
WithMergeableStateAfterAggregation
      UVarInt
4 -> QueryStage -> Get QueryStage
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryStage
WithMergeableStateAfterAggregationAndLimit
      UVarInt
num -> String -> Get QueryStage
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown QueryStage " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UVarInt -> String
forall a. Show a => a -> String
show UVarInt
num)


data Flags = IMPORTANT | CUSTOM | TIER
_flagCode :: Flags -> UInt64
_flagCode :: Flags -> UInt64
_flagCode Flags
IMPORTANT = UInt64
0x01
_flagCode Flags
CUSTOM    = UInt64
0x02
_flagCode Flags
TIER      = UInt64
0x0c

data ClientInfo = MkClientInfo
  { ClientInfo -> QueryKind
query_kind                   :: QueryKind
  , ClientInfo -> ChString
initial_user                 :: ChString
  , ClientInfo -> ChString
initial_query_id             :: ChString
  , ClientInfo -> ChString
initial_adress               :: ChString
  , ClientInfo
-> SinceRevision
     Int64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
initial_time                 :: Int64 `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
  , ClientInfo -> UInt8
interface_type               :: UInt8
  , ClientInfo -> ChString
os_user                      :: ChString
  , ClientInfo -> ChString
hostname                     :: ChString
  , ClientInfo -> ChString
client_name                  :: ChString
  , ClientInfo -> UVarInt
client_version_major         :: UVarInt
  , ClientInfo -> UVarInt
client_version_minor         :: UVarInt
  , ClientInfo -> ProtocolRevision
client_revision              :: ProtocolRevision
  , ClientInfo
-> SinceRevision
     ChString DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO
quota_key                    :: ChString `SinceRevision` DBMS_MIN_REVISION_WITH_QUOTA_KEY_IN_CLIENT_INFO
  , ClientInfo
-> SinceRevision
     UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH
distrubuted_depth            :: UVarInt `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH
  , ClientInfo
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
client_version_patch         :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_VERSION_PATCH
  , ClientInfo
-> SinceRevision UInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
open_telemetry               :: UInt8 `SinceRevision` DBMS_MIN_REVISION_WITH_OPENTELEMETRY
  , ClientInfo
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
collaborate_with_initiator   :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
  , ClientInfo
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
count_participating_replicas :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
  , ClientInfo
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
number_of_current_replica    :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
  }
  deriving ((forall x. ClientInfo -> Rep ClientInfo x)
-> (forall x. Rep ClientInfo x -> ClientInfo) -> Generic ClientInfo
forall x. Rep ClientInfo x -> ClientInfo
forall x. ClientInfo -> Rep ClientInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientInfo -> Rep ClientInfo x
from :: forall x. ClientInfo -> Rep ClientInfo x
$cto :: forall x. Rep ClientInfo x -> ClientInfo
to :: forall x. Rep ClientInfo x -> ClientInfo
Generic, ProtocolRevision -> Get ClientInfo
ProtocolRevision -> ClientInfo -> Builder
(ProtocolRevision -> ClientInfo -> Builder)
-> (ProtocolRevision -> Get ClientInfo) -> Serializable ClientInfo
forall chType.
(ProtocolRevision -> chType -> Builder)
-> (ProtocolRevision -> Get chType) -> Serializable chType
$cserialize :: ProtocolRevision -> ClientInfo -> Builder
serialize :: ProtocolRevision -> ClientInfo -> Builder
$cdeserialize :: ProtocolRevision -> Get ClientInfo
deserialize :: ProtocolRevision -> Get ClientInfo
Serializable)

data QueryKind = NoQuery | InitialQuery | SecondaryQuery
instance Serializable QueryKind where
  serialize :: ProtocolRevision -> QueryKind -> Builder
serialize ProtocolRevision
rev = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UInt8 ProtocolRevision
rev (UInt8 -> Builder) -> (QueryKind -> UInt8) -> QueryKind -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\case QueryKind
NoQuery -> UInt8
1; QueryKind
InitialQuery -> UInt8
2; QueryKind
SecondaryQuery -> UInt8
3)
  deserialize :: ProtocolRevision -> Get QueryKind
deserialize ProtocolRevision
rev = forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @UInt8 ProtocolRevision
rev Get UInt8 -> (UInt8 -> Get QueryKind) -> Get QueryKind
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      UInt8
1 -> QueryKind -> Get QueryKind
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryKind
NoQuery
      UInt8
2 -> QueryKind -> Get QueryKind
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryKind
InitialQuery
      UInt8
3 -> QueryKind -> Get QueryKind
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryKind
SecondaryQuery
      UInt8
num -> String -> Get QueryKind
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown QueryKind " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UInt8 -> String
forall a. Show a => a -> String
show UInt8
num)