{-# LANGUAGE
    DuplicateRecordFields
  , OverloadedStrings
  , RecordWildCards
#-}

module ClickHaskell.NativeProtocol where

-- Internal dependencies
import ClickHaskell.DbTypes
import ClickHaskell.DeSerialization (Serializable(..), Deserializable(..))
import ClickHaskell.Versioning
import Paths_ClickHaskell (version)

-- GHC included
import Control.Monad (replicateM)
import Data.Text (Text)
import Data.Typeable (Proxy (..))
import Data.Version (Version (..))
import GHC.Generics (Generic)
import GHC.TypeLits (KnownNat, natVal)
import Data.String (IsString(..))

-- * Compatibility

latestSupportedRevision :: ProtocolRevision
latestSupportedRevision :: ProtocolRevision
latestSupportedRevision = ProtocolRevision
mostRecentRevision

-- * Client packets

data ClientPacketType
  = Hello
  | Query
  | Data
  | Cancel
  | Ping
  | TablesStatusRequest
  | KeepAlive
  | Scalar
  | IgnoredPartUUIDs
  | ReadTaskResponse
  | MergeTreeReadTaskResponse
  | SSHChallengeRequest
  | SSHChallengeResponse
  deriving (Int -> ClientPacketType
ClientPacketType -> Int
ClientPacketType -> [ClientPacketType]
ClientPacketType -> ClientPacketType
ClientPacketType -> ClientPacketType -> [ClientPacketType]
ClientPacketType
-> ClientPacketType -> ClientPacketType -> [ClientPacketType]
(ClientPacketType -> ClientPacketType)
-> (ClientPacketType -> ClientPacketType)
-> (Int -> ClientPacketType)
-> (ClientPacketType -> Int)
-> (ClientPacketType -> [ClientPacketType])
-> (ClientPacketType -> ClientPacketType -> [ClientPacketType])
-> (ClientPacketType -> ClientPacketType -> [ClientPacketType])
-> (ClientPacketType
    -> ClientPacketType -> ClientPacketType -> [ClientPacketType])
-> Enum ClientPacketType
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 :: ClientPacketType -> ClientPacketType
succ :: ClientPacketType -> ClientPacketType
$cpred :: ClientPacketType -> ClientPacketType
pred :: ClientPacketType -> ClientPacketType
$ctoEnum :: Int -> ClientPacketType
toEnum :: Int -> ClientPacketType
$cfromEnum :: ClientPacketType -> Int
fromEnum :: ClientPacketType -> Int
$cenumFrom :: ClientPacketType -> [ClientPacketType]
enumFrom :: ClientPacketType -> [ClientPacketType]
$cenumFromThen :: ClientPacketType -> ClientPacketType -> [ClientPacketType]
enumFromThen :: ClientPacketType -> ClientPacketType -> [ClientPacketType]
$cenumFromTo :: ClientPacketType -> ClientPacketType -> [ClientPacketType]
enumFromTo :: ClientPacketType -> ClientPacketType -> [ClientPacketType]
$cenumFromThenTo :: ClientPacketType
-> ClientPacketType -> ClientPacketType -> [ClientPacketType]
enumFromThenTo :: ClientPacketType
-> ClientPacketType -> ClientPacketType -> [ClientPacketType]
Enum, Int -> ClientPacketType -> ShowS
[ClientPacketType] -> ShowS
ClientPacketType -> String
(Int -> ClientPacketType -> ShowS)
-> (ClientPacketType -> String)
-> ([ClientPacketType] -> ShowS)
-> Show ClientPacketType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientPacketType -> ShowS
showsPrec :: Int -> ClientPacketType -> ShowS
$cshow :: ClientPacketType -> String
show :: ClientPacketType -> String
$cshowList :: [ClientPacketType] -> ShowS
showList :: [ClientPacketType] -> ShowS
Show)

type family PacketTypeNumber (packetType :: ClientPacketType)
  where
  PacketTypeNumber Hello = 0
  PacketTypeNumber Query = 1
  PacketTypeNumber Data = 2
  PacketTypeNumber Cancel = 3
  PacketTypeNumber Ping = 4
  PacketTypeNumber TablesStatusRequest = 5
  PacketTypeNumber KeepAlive = 6
  PacketTypeNumber Scalar = 7
  PacketTypeNumber IgnoredPartUUIDs = 8
  PacketTypeNumber ReadTaskResponse = 9
  PacketTypeNumber MergeTreeReadTaskResponse = 10
  PacketTypeNumber SSHChallengeRequest = 11
  PacketTypeNumber SSHChallengeResponse = 12

data Packet (packetType :: ClientPacketType) = MkPacket
instance KnownNat (PacketTypeNumber packetType) => Show (Packet (packetType :: ClientPacketType)) where
  show :: Packet packetType -> String
show Packet packetType
_ = ClientPacketType -> String
forall a. Show a => a -> String
show (ClientPacketType -> String)
-> (UVarInt -> ClientPacketType) -> UVarInt -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum @ClientPacketType (Int -> ClientPacketType)
-> (UVarInt -> Int) -> UVarInt -> ClientPacketType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UVarInt -> String) -> UVarInt -> String
forall a b. (a -> b) -> a -> b
$ forall (packetType :: ClientPacketType).
KnownNat (PacketTypeNumber packetType) =>
UVarInt
packetNumVal @packetType

packetNumVal :: forall packetType . KnownNat (PacketTypeNumber packetType) => UVarInt
packetNumVal :: forall (packetType :: ClientPacketType).
KnownNat (PacketTypeNumber packetType) =>
UVarInt
packetNumVal = Integer -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> UVarInt)
-> (Proxy (PacketTypeNumber packetType) -> Integer)
-> Proxy (PacketTypeNumber packetType)
-> UVarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (PacketTypeNumber packetType) -> Integer
forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (PacketTypeNumber packetType) -> UVarInt)
-> Proxy (PacketTypeNumber packetType) -> UVarInt
forall a b. (a -> b) -> a -> b
$ forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(PacketTypeNumber packetType)

instance
  KnownNat (PacketTypeNumber packetType)
  =>
  Serializable (Packet (packetType :: ClientPacketType)) where
  serialize :: ProtocolRevision -> Packet packetType -> Builder
serialize ProtocolRevision
rev Packet packetType
_ = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @UVarInt ProtocolRevision
rev (forall (packetType :: ClientPacketType).
KnownNat (PacketTypeNumber packetType) =>
UVarInt
packetNumVal @packetType)

instance Deserializable (Packet (packetType :: ClientPacketType)) where
  deserialize :: ProtocolRevision -> Get (Packet packetType)
deserialize ProtocolRevision
_rev = Packet packetType -> Get (Packet packetType)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (packetType :: ClientPacketType). Packet packetType
MkPacket @packetType)


-- ** Hello

data HelloParameters = MkHelloParameters
  { HelloParameters -> Text
chDatabase :: Text
  , HelloParameters -> Text
chLogin :: Text
  , HelloParameters -> Text
chPass :: Text
  }

mkHelloPacket :: HelloParameters -> HelloPacket
mkHelloPacket :: HelloParameters -> HelloPacket
mkHelloPacket MkHelloParameters{Text
$sel:chDatabase:MkHelloParameters :: HelloParameters -> Text
chDatabase :: Text
chDatabase, Text
$sel:chLogin:MkHelloParameters :: HelloParameters -> Text
chLogin :: Text
chLogin, Text
$sel:chPass:MkHelloParameters :: HelloParameters -> Text
chPass :: Text
chPass} =
  MkHelloPacket
    { $sel:packet_type:MkHelloPacket :: Packet 'Hello
packet_type          = Packet 'Hello
forall (packetType :: ClientPacketType). Packet packetType
MkPacket
    , $sel:client_name:MkHelloPacket :: ChString
client_name          = ChString
clientNameAndVersion
    , $sel:client_version_major:MkHelloPacket :: UVarInt
client_version_major = UVarInt
clientMajorVersion
    , $sel:client_version_minor:MkHelloPacket :: UVarInt
client_version_minor = UVarInt
clientMinorVersion
    , $sel:tcp_protocol_version:MkHelloPacket :: ProtocolRevision
tcp_protocol_version = ProtocolRevision
latestSupportedRevision
    , $sel:default_database:MkHelloPacket :: ChString
default_database     = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
chDatabase
    , $sel:user:MkHelloPacket :: ChString
user                 = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
chLogin
    , $sel:password:MkHelloPacket :: ChString
password             = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
chPass
    }

data HelloPacket = MkHelloPacket
  { HelloPacket -> Packet 'Hello
packet_type          :: Packet Hello
  , 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
password             :: 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 -> HelloPacket -> Builder
(ProtocolRevision -> HelloPacket -> Builder)
-> Serializable HelloPacket
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> HelloPacket -> Builder
serialize :: ProtocolRevision -> HelloPacket -> Builder
Serializable)


mkAddendum :: Addendum
mkAddendum :: Addendum
mkAddendum = MkAddendum
  { $sel:quota_key:MkAddendum :: SinceRevision ChString DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY
quota_key = ChString
-> SinceRevision ChString DBMS_MIN_PROTOCOL_VERSION_WITH_QUOTA_KEY
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""
  }

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 -> Addendum -> Builder
(ProtocolRevision -> Addendum -> Builder) -> Serializable Addendum
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> Addendum -> Builder
serialize :: ProtocolRevision -> Addendum -> Builder
Serializable)


-- ** Ping

mkPingPacket :: PingPacket
mkPingPacket :: PingPacket
mkPingPacket = MkPingPacket{$sel:packet_type:MkPingPacket :: Packet 'Ping
packet_type = Packet 'Ping
forall (packetType :: ClientPacketType). Packet packetType
MkPacket}

data PingPacket = MkPingPacket{PingPacket -> Packet 'Ping
packet_type :: Packet Ping}
  deriving ((forall x. PingPacket -> Rep PingPacket x)
-> (forall x. Rep PingPacket x -> PingPacket) -> Generic PingPacket
forall x. Rep PingPacket x -> PingPacket
forall x. PingPacket -> Rep PingPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PingPacket -> Rep PingPacket x
from :: forall x. PingPacket -> Rep PingPacket x
$cto :: forall x. Rep PingPacket x -> PingPacket
to :: forall x. Rep PingPacket x -> PingPacket
Generic, ProtocolRevision -> PingPacket -> Builder
(ProtocolRevision -> PingPacket -> Builder)
-> Serializable PingPacket
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> PingPacket -> Builder
serialize :: ProtocolRevision -> PingPacket -> Builder
Serializable)


-- ** Query

mkQueryPacket :: ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket :: ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket ProtocolRevision
chosenRev ChString
user ChString
query = MkQueryPacket
  { $sel:query_packet:MkQueryPacket :: Packet 'Query
query_packet = Packet 'Query
forall (packetType :: ClientPacketType). Packet packetType
MkPacket
  , $sel:query_id:MkQueryPacket :: ChString
query_id = ChString
""
  , $sel:client_info:MkQueryPacket :: SinceRevision ClientInfo DBMS_MIN_REVISION_WITH_CLIENT_INFO
client_info                    = ClientInfo
-> SinceRevision ClientInfo DBMS_MIN_REVISION_WITH_CLIENT_INFO
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision MkClientInfo
    { $sel:query_kind:MkClientInfo :: QueryKind
query_kind                   = QueryKind
InitialQuery
    , $sel:initial_user:MkClientInfo :: ChString
initial_user                 = ChString
user
    , $sel:initial_query_id:MkClientInfo :: ChString
initial_query_id             = ChString
""
    , $sel:initial_adress:MkClientInfo :: ChString
initial_adress               = ChString
"0.0.0.0:0"
    , $sel:initial_time:MkClientInfo :: SinceRevision
  ChInt64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
initial_time                 = ChInt64
-> SinceRevision
     ChInt64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision ChInt64
0
    , $sel:interface_type:MkClientInfo :: ChUInt8
interface_type               = ChUInt8
1 -- [tcp - 1, http - 2]
    , $sel:os_user:MkClientInfo :: ChString
os_user                      = ChString
"dmitry"
    , $sel:hostname:MkClientInfo :: ChString
hostname                     = ChString
"desktop"
    , $sel:client_name:MkClientInfo :: ChString
client_name                  = ChString
clientNameAndVersion
    , $sel:client_major:MkClientInfo :: UVarInt
client_major                 = UVarInt
clientMajorVersion
    , $sel:client_minor:MkClientInfo :: UVarInt
client_minor                 = UVarInt
clientMinorVersion
    , $sel:client_revision:MkClientInfo :: ProtocolRevision
client_revision              = ProtocolRevision
chosenRev
    , $sel:quota_key:MkClientInfo :: 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 :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""
    , $sel:distrubuted_depth:MkClientInfo :: SinceRevision
  UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH
distrubuted_depth            = UVarInt
-> SinceRevision
     UVarInt DBMS_MIN_PROTOCOL_VERSION_WITH_DISTRIBUTED_DEPTH
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    , $sel:client_patch:MkClientInfo :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
client_patch                 = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
clientPatchVersion
    , $sel:open_telemetry:MkClientInfo :: SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
open_telemetry               = ChUInt8
-> SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision ChUInt8
0
    , $sel:collaborate_with_initiator:MkClientInfo :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
collaborate_with_initiator   = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    , $sel:count_participating_replicas:MkClientInfo :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
count_participating_replicas = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    , $sel:number_of_current_replica:MkClientInfo :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
number_of_current_replica    = UVarInt
-> SinceRevision UVarInt DBMS_MIN_REVISION_WITH_PARALLEL_REPLICAS
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision UVarInt
0
    }
  , $sel:settings:MkQueryPacket :: DbSettings
settings           = DbSettings
MkDbSettings
  , $sel:interserver_secret:MkQueryPacket :: SinceRevision ChString DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
interserver_secret = ChString
-> SinceRevision ChString DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision ChString
""
  , $sel:query_stage:MkQueryPacket :: QueryStage
query_stage        = QueryStage
Complete
  , $sel:compression:MkQueryPacket :: UVarInt
compression        = UVarInt
0
  , $sel:query:MkQueryPacket :: ChString
query              = ChString
query
  , $sel:parameters:MkQueryPacket :: SinceRevision
  QueryParameters DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
parameters         = QueryParameters
-> SinceRevision
     QueryParameters DBMS_MIN_PROTOCOL_VERSION_WITH_PARAMETERS
forall a (revisionNumber :: Natural).
a -> SinceRevision a revisionNumber
MkSinceRevision QueryParameters
MkQueryParameters
  }

data QueryPacket = MkQueryPacket
  { QueryPacket -> Packet 'Query
query_packet       :: Packet Query
  , 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 -> QueryPacket -> Builder
(ProtocolRevision -> QueryPacket -> Builder)
-> Serializable QueryPacket
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> QueryPacket -> Builder
serialize :: ProtocolRevision -> QueryPacket -> Builder
Serializable)

data DbSettings = MkDbSettings
instance Serializable DbSettings where serialize :: ProtocolRevision -> DbSettings -> Builder
serialize ProtocolRevision
rev DbSettings
_ = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChString ProtocolRevision
rev ChString
""

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
""

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

queryStageCode :: QueryStage -> UVarInt
queryStageCode :: QueryStage -> UVarInt
queryStageCode = 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

data Flags = IMPORTANT | CUSTOM | OBSOLETE
flagCode :: Flags -> ChUInt64
flagCode :: Flags -> ChUInt64
flagCode Flags
IMPORTANT = ChUInt64
0x01
flagCode Flags
CUSTOM    = ChUInt64
0x02
flagCode Flags
OBSOLETE  = ChUInt64
0x04

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
     ChInt64 DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
initial_time                 :: ChInt64 `SinceRevision` DBMS_MIN_PROTOCOL_VERSION_WITH_INITIAL_QUERY_START_TIME
  , ClientInfo -> ChUInt8
interface_type               :: ChUInt8
  , ClientInfo -> ChString
os_user                      :: ChString
  , ClientInfo -> ChString
hostname                     :: ChString
  , ClientInfo -> ChString
client_name                  :: ChString
  , ClientInfo -> UVarInt
client_major                 :: UVarInt
  , ClientInfo -> UVarInt
client_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_patch                 :: UVarInt `SinceRevision` DBMS_MIN_REVISION_WITH_VERSION_PATCH
  , ClientInfo
-> SinceRevision ChUInt8 DBMS_MIN_REVISION_WITH_OPENTELEMETRY
open_telemetry               :: ChUInt8 `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 -> ClientInfo -> Builder
(ProtocolRevision -> ClientInfo -> Builder)
-> Serializable ClientInfo
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> ClientInfo -> Builder
serialize :: ProtocolRevision -> ClientInfo -> Builder
Serializable)

data QueryKind = NoQuery | InitialQuery | SecondaryQuery
  deriving (Int -> QueryKind
QueryKind -> Int
QueryKind -> [QueryKind]
QueryKind -> QueryKind
QueryKind -> QueryKind -> [QueryKind]
QueryKind -> QueryKind -> QueryKind -> [QueryKind]
(QueryKind -> QueryKind)
-> (QueryKind -> QueryKind)
-> (Int -> QueryKind)
-> (QueryKind -> Int)
-> (QueryKind -> [QueryKind])
-> (QueryKind -> QueryKind -> [QueryKind])
-> (QueryKind -> QueryKind -> [QueryKind])
-> (QueryKind -> QueryKind -> QueryKind -> [QueryKind])
-> Enum QueryKind
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 :: QueryKind -> QueryKind
succ :: QueryKind -> QueryKind
$cpred :: QueryKind -> QueryKind
pred :: QueryKind -> QueryKind
$ctoEnum :: Int -> QueryKind
toEnum :: Int -> QueryKind
$cfromEnum :: QueryKind -> Int
fromEnum :: QueryKind -> Int
$cenumFrom :: QueryKind -> [QueryKind]
enumFrom :: QueryKind -> [QueryKind]
$cenumFromThen :: QueryKind -> QueryKind -> [QueryKind]
enumFromThen :: QueryKind -> QueryKind -> [QueryKind]
$cenumFromTo :: QueryKind -> QueryKind -> [QueryKind]
enumFromTo :: QueryKind -> QueryKind -> [QueryKind]
$cenumFromThenTo :: QueryKind -> QueryKind -> QueryKind -> [QueryKind]
enumFromThenTo :: QueryKind -> QueryKind -> QueryKind -> [QueryKind]
Enum)

instance Serializable QueryKind where
  serialize :: ProtocolRevision -> QueryKind -> Builder
serialize ProtocolRevision
rev = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @ChUInt8 ProtocolRevision
rev (ChUInt8 -> Builder)
-> (QueryKind -> ChUInt8) -> QueryKind -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ChUInt8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ChUInt8) -> (QueryKind -> Int) -> QueryKind -> ChUInt8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryKind -> Int
forall a. Enum a => a -> Int
fromEnum


-- ** Data

mkDataPacket :: ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket :: ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
table_name UVarInt
columns_count UVarInt
rows_count =
  MkDataPacket
    { $sel:packet_type:MkDataPacket :: Packet 'Data
packet_type   = Packet 'Data
forall (packetType :: ClientPacketType). Packet packetType
MkPacket
    , ChString
table_name :: ChString
$sel:table_name:MkDataPacket :: ChString
table_name
    , $sel:block_info:MkDataPacket :: BlockInfo
block_info    = MkBlockInfo
      { $sel:field_num1:MkBlockInfo :: UVarInt
field_num1   = UVarInt
1, $sel:is_overflows:MkBlockInfo :: ChUInt8
is_overflows = ChUInt8
0
      , $sel:field_num2:MkBlockInfo :: UVarInt
field_num2   = UVarInt
2, $sel:bucket_num:MkBlockInfo :: ChInt32
bucket_num   = -ChInt32
1
      , $sel:eof:MkBlockInfo :: UVarInt
eof          = UVarInt
0
      }
    , UVarInt
columns_count :: UVarInt
$sel:columns_count:MkDataPacket :: UVarInt
columns_count
    , UVarInt
rows_count :: UVarInt
$sel:rows_count:MkDataPacket :: UVarInt
rows_count
    }

data DataPacket = MkDataPacket
  { DataPacket -> Packet 'Data
packet_type   :: Packet Data
  , 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 -> DataPacket -> Builder
(ProtocolRevision -> DataPacket -> Builder)
-> Serializable DataPacket
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> DataPacket -> Builder
serialize :: ProtocolRevision -> DataPacket -> Builder
Serializable, ProtocolRevision -> Get DataPacket
(ProtocolRevision -> Get DataPacket) -> Deserializable DataPacket
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get DataPacket
deserialize :: ProtocolRevision -> Get DataPacket
Deserializable, Int -> DataPacket -> ShowS
[DataPacket] -> ShowS
DataPacket -> String
(Int -> DataPacket -> ShowS)
-> (DataPacket -> String)
-> ([DataPacket] -> ShowS)
-> Show DataPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataPacket -> ShowS
showsPrec :: Int -> DataPacket -> ShowS
$cshow :: DataPacket -> String
show :: DataPacket -> String
$cshowList :: [DataPacket] -> ShowS
showList :: [DataPacket] -> ShowS
Show)

data BlockInfo = MkBlockInfo
  { BlockInfo -> UVarInt
field_num1   :: UVarInt, BlockInfo -> ChUInt8
is_overflows :: ChUInt8
  , BlockInfo -> UVarInt
field_num2   :: UVarInt, BlockInfo -> ChInt32
bucket_num   :: ChInt32
  , 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 -> BlockInfo -> Builder
(ProtocolRevision -> BlockInfo -> Builder)
-> Serializable BlockInfo
forall chType.
(ProtocolRevision -> chType -> Builder) -> Serializable chType
$cserialize :: ProtocolRevision -> BlockInfo -> Builder
serialize :: ProtocolRevision -> BlockInfo -> Builder
Serializable, ProtocolRevision -> Get BlockInfo
(ProtocolRevision -> Get BlockInfo) -> Deserializable BlockInfo
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get BlockInfo
deserialize :: ProtocolRevision -> Get BlockInfo
Deserializable, 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
$cshowsPrec :: Int -> BlockInfo -> ShowS
showsPrec :: Int -> BlockInfo -> ShowS
$cshow :: BlockInfo -> String
show :: BlockInfo -> String
$cshowList :: [BlockInfo] -> ShowS
showList :: [BlockInfo] -> ShowS
Show)




-- * Server packets

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

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

instance Show ServerPacketType where
  show :: ServerPacketType -> String
show (HelloResponse HelloResponse
hello) = String
"HelloResponse " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HelloResponse -> String
forall a. Show a => a -> String
show HelloResponse
hello
  show (DataResponse DataPacket
dataPacket) = String
"DataResponse " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DataPacket -> String
forall a. Show a => a -> String
show DataPacket
dataPacket
  show (Exception ExceptionPacket
exception) = String
"Exception " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ExceptionPacket -> String
forall a. Show a => a -> String
show ExceptionPacket
exception
  show (Progress ProgressPacket
progress) = String
"Progress " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ProgressPacket -> String
forall a. Show a => a -> String
show ProgressPacket
progress
  show ServerPacketType
Pong = String
"Pong"
  show ServerPacketType
EndOfStream = String
"EndOfStream"
  show (ProfileInfo ProfileInfo
profileInfo) = String
"ProfileInfo " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ProfileInfo -> String
forall a. Show a => a -> String
show ProfileInfo
profileInfo 
  show ServerPacketType
Totals = String
"Totals"
  show ServerPacketType
Extremes = String
"Extremes"
  show ServerPacketType
TablesStatusResponse = String
"TablesStatusResponse"
  show ServerPacketType
Log = String
"Log"
  show (TableColumns TableColumns
tabelColumnsPacket) = String
"TableColumns " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TableColumns -> String
forall a. Show a => a -> String
show TableColumns
tabelColumnsPacket
  show ServerPacketType
UUIDs = String
"UUIDs"
  show ServerPacketType
ReadTaskRequest = String
"ReadTaskRequest"
  show ServerPacketType
ProfileEvents = String
"ProfileEvents"
  show (UnknownPacket UVarInt
packetNum) = String
"UnknownPacket: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UVarInt -> String
forall a. Show a => a -> String
show UVarInt
packetNum

-- ** HelloResponse

{-
  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
     ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
read_nonce                     :: ChUInt64 `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, Int -> HelloResponse -> ShowS
[HelloResponse] -> ShowS
HelloResponse -> String
(Int -> HelloResponse -> ShowS)
-> (HelloResponse -> String)
-> ([HelloResponse] -> ShowS)
-> Show HelloResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HelloResponse -> ShowS
showsPrec :: Int -> HelloResponse -> ShowS
$cshow :: HelloResponse -> String
show :: HelloResponse -> String
$cshowList :: [HelloResponse] -> ShowS
showList :: [HelloResponse] -> ShowS
Show)

instance Deserializable HelloResponse where
  deserialize :: ProtocolRevision -> Get HelloResponse
deserialize ProtocolRevision
revision = do
    ChString
server_name                    <- ProtocolRevision -> Get ChString
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision
    UVarInt
server_version_major           <- ProtocolRevision -> Get UVarInt
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision
    UVarInt
server_version_minor           <- ProtocolRevision -> Get UVarInt
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision
    ProtocolRevision
server_revision                <- ProtocolRevision -> Get ProtocolRevision
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision
    -- Override current protocol revision for backward compatibility
    let chosenRevision :: ProtocolRevision
chosenRevision = ProtocolRevision -> ProtocolRevision -> ProtocolRevision
forall a. Ord a => a -> a -> a
min ProtocolRevision
server_revision ProtocolRevision
revision
    SinceRevision
  UVarInt DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
server_parallel_replicas_proto <- ProtocolRevision
-> Get
     (SinceRevision
        UVarInt
        DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
server_timezone                <- ProtocolRevision
-> Get
     (SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
server_display_name            <- ProtocolRevision
-> Get
     (SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
server_version_patch           <- ProtocolRevision
-> Get (SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
proto_send_chunked_srv         <- ProtocolRevision
-> Get
     (SinceRevision
        ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
proto_recv_chunked_srv         <- ProtocolRevision
-> Get
     (SinceRevision
        ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision
  [PasswordComplexityRules]
  DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
password_complexity_rules      <- ProtocolRevision
-> Get
     (SinceRevision
        [PasswordComplexityRules]
        DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    SinceRevision ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
read_nonce                     <- ProtocolRevision
-> Get
     (SinceRevision
        ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2)
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
chosenRevision
    HelloResponse -> Get HelloResponse
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkHelloResponse{UVarInt
ChString
SinceRevision
  [PasswordComplexityRules]
  DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
SinceRevision
  UVarInt DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
SinceRevision ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
ProtocolRevision
$sel:server_name:MkHelloResponse :: ChString
$sel:server_version_major:MkHelloResponse :: UVarInt
$sel:server_version_minor:MkHelloResponse :: UVarInt
$sel:server_revision:MkHelloResponse :: ProtocolRevision
$sel:server_parallel_replicas_proto:MkHelloResponse :: SinceRevision
  UVarInt DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
$sel:server_timezone:MkHelloResponse :: SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
$sel:server_display_name:MkHelloResponse :: SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
$sel:server_version_patch:MkHelloResponse :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
$sel:proto_send_chunked_srv:MkHelloResponse :: SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
$sel:proto_recv_chunked_srv:MkHelloResponse :: SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
$sel:password_complexity_rules:MkHelloResponse :: SinceRevision
  [PasswordComplexityRules]
  DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
$sel:read_nonce:MkHelloResponse :: SinceRevision ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
server_name :: ChString
server_version_major :: UVarInt
server_version_minor :: UVarInt
server_revision :: ProtocolRevision
server_parallel_replicas_proto :: SinceRevision
  UVarInt DBMS_MIN_REVISION_WITH_VERSIONED_PARALLEL_REPLICAS_PROTOCOL
server_timezone :: SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_TIMEZONE
server_display_name :: SinceRevision ChString DBMS_MIN_REVISION_WITH_SERVER_DISPLAY_NAME
server_version_patch :: SinceRevision UVarInt DBMS_MIN_REVISION_WITH_VERSION_PATCH
proto_send_chunked_srv :: SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
proto_recv_chunked_srv :: SinceRevision
  ChString DBMS_MIN_PROTOCOL_VERSION_WITH_CHUNKED_PACKETS
password_complexity_rules :: SinceRevision
  [PasswordComplexityRules]
  DBMS_MIN_PROTOCOL_VERSION_WITH_PASSWORD_COMPLEXITY_RULES
read_nonce :: SinceRevision ChUInt64 DBMS_MIN_REVISION_WITH_INTERSERVER_SECRET_V2
..}

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 -> Get PasswordComplexityRules)
-> Deserializable PasswordComplexityRules
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get PasswordComplexityRules
deserialize :: ProtocolRevision -> Get PasswordComplexityRules
Deserializable, Int -> PasswordComplexityRules -> ShowS
[PasswordComplexityRules] -> ShowS
PasswordComplexityRules -> String
(Int -> PasswordComplexityRules -> ShowS)
-> (PasswordComplexityRules -> String)
-> ([PasswordComplexityRules] -> ShowS)
-> Show PasswordComplexityRules
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PasswordComplexityRules -> ShowS
showsPrec :: Int -> PasswordComplexityRules -> ShowS
$cshow :: PasswordComplexityRules -> String
show :: PasswordComplexityRules -> String
$cshowList :: [PasswordComplexityRules] -> ShowS
showList :: [PasswordComplexityRules] -> ShowS
Show)

instance Deserializable [PasswordComplexityRules] where
  deserialize :: ProtocolRevision -> Get [PasswordComplexityRules]
deserialize ProtocolRevision
rev = do
    UVarInt
len <- forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @UVarInt ProtocolRevision
rev
    Int -> Get PasswordComplexityRules -> Get [PasswordComplexityRules]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (UVarInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVarInt
len) (forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize @PasswordComplexityRules ProtocolRevision
rev)

-- ** Exception

data ExceptionPacket = MkExceptionPacket
  { ExceptionPacket -> ChInt32
code        :: ChInt32
  , ExceptionPacket -> ChString
name        :: ChString
  , ExceptionPacket -> ChString
message     :: ChString
  , ExceptionPacket -> ChString
stack_trace :: ChString
  , ExceptionPacket -> ChUInt8
nested      :: ChUInt8
  }
  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, ProtocolRevision -> Get ExceptionPacket
(ProtocolRevision -> Get ExceptionPacket)
-> Deserializable ExceptionPacket
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get ExceptionPacket
deserialize :: ProtocolRevision -> Get ExceptionPacket
Deserializable, 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)

-- ** Progress

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 -> Get ProgressPacket)
-> Deserializable ProgressPacket
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get ProgressPacket
deserialize :: ProtocolRevision -> Get ProgressPacket
Deserializable, Int -> ProgressPacket -> ShowS
[ProgressPacket] -> ShowS
ProgressPacket -> String
(Int -> ProgressPacket -> ShowS)
-> (ProgressPacket -> String)
-> ([ProgressPacket] -> ShowS)
-> Show ProgressPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProgressPacket -> ShowS
showsPrec :: Int -> ProgressPacket -> ShowS
$cshow :: ProgressPacket -> String
show :: ProgressPacket -> String
$cshowList :: [ProgressPacket] -> ShowS
showList :: [ProgressPacket] -> ShowS
Show)

-- ** ProfileInfo

data ProfileInfo = MkProfileInfo
  { ProfileInfo -> UVarInt
rows                         :: UVarInt
  , ProfileInfo -> UVarInt
blocks                       :: UVarInt
  , ProfileInfo -> UVarInt
bytes                        :: UVarInt
  , ProfileInfo -> ChUInt8
applied_limit                :: ChUInt8
  , ProfileInfo -> UVarInt
rows_before_limit            :: UVarInt
  , ProfileInfo -> ChUInt8
calculated_rows_before_limit :: ChUInt8
  , ProfileInfo
-> SinceRevision
     ChUInt8 DBMS_MIN_REVISION_WITH_ROWS_BEFORE_AGGREGATION
applied_aggregation          :: ChUInt8 `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 -> Get ProfileInfo) -> Deserializable ProfileInfo
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get ProfileInfo
deserialize :: ProtocolRevision -> Get ProfileInfo
Deserializable, Int -> ProfileInfo -> ShowS
[ProfileInfo] -> ShowS
ProfileInfo -> String
(Int -> ProfileInfo -> ShowS)
-> (ProfileInfo -> String)
-> ([ProfileInfo] -> ShowS)
-> Show ProfileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfileInfo -> ShowS
showsPrec :: Int -> ProfileInfo -> ShowS
$cshow :: ProfileInfo -> String
show :: ProfileInfo -> String
$cshowList :: [ProfileInfo] -> ShowS
showList :: [ProfileInfo] -> ShowS
Show)

-- ** TableColumns

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 -> Get TableColumns)
-> Deserializable TableColumns
forall chType.
(ProtocolRevision -> Get chType) -> Deserializable chType
$cdeserialize :: ProtocolRevision -> Get TableColumns
deserialize :: ProtocolRevision -> Get TableColumns
Deserializable, Int -> TableColumns -> ShowS
[TableColumns] -> ShowS
TableColumns -> String
(Int -> TableColumns -> ShowS)
-> (TableColumns -> String)
-> ([TableColumns] -> ShowS)
-> Show TableColumns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableColumns -> ShowS
showsPrec :: Int -> TableColumns -> ShowS
$cshow :: TableColumns -> String
show :: TableColumns -> String
$cshowList :: [TableColumns] -> ShowS
showList :: [TableColumns] -> ShowS
Show)




-- * Versioning

clientMajorVersion, clientMinorVersion, clientPatchVersion :: UVarInt
clientMajorVersion :: UVarInt
clientMajorVersion = case Version -> [Int]
versionBranch Version
version of (Int
x:[Int]
_) -> Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x; [Int]
_ -> UVarInt
0
clientMinorVersion :: UVarInt
clientMinorVersion = case Version -> [Int]
versionBranch Version
version of (Int
_:Int
x:[Int]
_) -> Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x; [Int]
_ -> UVarInt
0
clientPatchVersion :: UVarInt
clientPatchVersion = case Version -> [Int]
versionBranch Version
version of (Int
_:Int
_:Int
x:[Int]
_) -> Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x; [Int]
_ -> UVarInt
0

clientNameAndVersion :: ChString
clientNameAndVersion :: ChString
clientNameAndVersion = String -> ChString
forall a. IsString a => String -> a
fromString (String -> ChString) -> String -> ChString
forall a b. (a -> b) -> a -> b
$
  String
"ClickHaskell-"
  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UVarInt -> String
forall a. Show a => a -> String
show UVarInt
clientMajorVersion String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UVarInt -> String
forall a. Show a => a -> String
show UVarInt
clientMinorVersion String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UVarInt -> String
forall a. Show a => a -> String
show UVarInt
clientPatchVersion String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."